mgm/lib/widget

   1 # -*-Perl-*-
   2 use Tk;
   3 require "$libdir/xpm";
   4
   5 # single bar graph pseudo-widget, built out of Tk canvases.
   6
   7 package MGM::Bar;
   8 use vars qw($font);
   9
  10 $font=MGM::Font::new(MGM::Xpm::read($main::fontfile));
  11
  12 sub drawborder{
  13     my($w,$width,$height,$relief,$dim,$lit)=@_;
  14     $z=0;
  15
  16     if($relief eq 'sunken' ||
  17        $relief eq 'groove'){
  18         $w->createLine($width-1,0, 0,0, 0,$height-1, -capstyle=>'projecting',
  19                        -fill=>$dim);
  20         $w->createLine($width-1,0, $width-1,$height-1, 0,$height-1,
  21                        -capstyle=>'projecting',-fill=>$lit);
  22
  23         if($relief eq 'groove'){
  24             $z=1;
  25             $width-=1;
  26             $height-=1;
  27             $relief='raised';
  28         }
  29     }
  30     if($relief eq 'raised'){
  31         $w->createLine($width-1,$z, $width-1,$height-1, $z,$height-1,
  32                        -capstyle=>'projecting',-fill=>$dim);
  33         $w->createLine($width-1,$z, $z,$z, $z,$height-1,
  34                        -capstyle=>'projecting',-fill=>$lit);
  35     }
  36 }
  37
  38 sub place{
  39     my$this=shift;
  40     $this->{"below"}->place(@_);
  41     $this;
  42 }
  43
  44 sub new{
  45     my ($ref,$p,$width,$height,$num)=@_;
  46
  47     $orient=$main::orient;
  48
  49     # we're not as flat as we like to think
  50     my$this=bless {};
  51
  52     my$below=$this->{"below"}=$p->Canvas(Name=>$num);
  53
  54     my$above=$this->{"above"}=$below->Canvas()->place(-relx=>0,-rely=>0,
  55                                                       -anchor=>'nw',
  56                                                       -bordermode=>'outside');
  57
  58     # we configure the color and label via a configurable X resource;
  59     # it's cleaner than setting up a system that alters a single X resource
  60
  61     $this->{"aforeXr"}='litforeground';
  62     $this->{"abackXr"}='litbackground';
  63     $this->{"labelXr"}='label';
  64
  65     $this->{"width"}=$width;
  66     $this->{"height"}=$height;
  67     $this->{"num"}=$num;
  68     $this->{"value"}=0;
  69
  70     $this->drawit;
  71     $this;
  72 }
  73
  74 sub configure{
  75     my$this=shift;
  76     my ($arg,$val);
  77     while(defined($arg=shift)){
  78         $val=shift;
  79
  80         if(!defined($val)){last;}
  81         $this->{"$arg"}=$val;
  82     }
  83
  84     $this->{'below'}->delete('xpmlabel');
  85     $this->{'above'}->delete('xpmlabel');
  86
  87     $this->drawit;
  88     $this->set($this->{'value'});
  89 }
  90
  91 sub drawit{
  92     my$this=shift;
  93     my$below=$this->{'below'};
  94     my$above=$this->{'above'};
  95
  96     $orient=$main::orient;
  97
  98     my$width=$this->{"width"};
  99     my$height=$this->{"height"};
 100     my$num=$this->{"num"};
 101
 102     my $pad=$below->optionGet("textpad","");
 103     my $relief=$below->optionGet('dimrelief','');
 104     my $arelief=$below->optionGet('litrelief','');
 105
 106     my $afore=$below->optionGet($this->{"aforeXr"},'');
 107     my $aback=$below->optionGet($this->{"abackXr"},'');
 108     my $label=$below->optionGet($this->{"labelXr"},'');
 109
 110     my $fore=$below->optionGet('dimforeground','');
 111     my $back=$below->optionGet('dimbackground','');
 112     my $ratio=$below->optionGet('ratio','');
 113
 114     my$border=0;
 115 #    $border=2 if ($relief eq 'groove');
 116 #    $border=1 if ($relief eq 'sunken');
 117 #    $border=1 if ($relief eq 'raised');
 118
 119     my$aborder=0;
 120     $aborder=2 if ($arelief eq 'groove');
 121     $aborder=1 if ($arelief eq 'sunken');
 122     $aborder=1 if ($arelief eq 'raised');
 123
 124     my($r,$g,$b)=$below->rgb($back);
 125     $r/=256;
 126     $g/=256;
 127     $b/=256;
 128     my$lum=$r*.3+$g*.5+$b*.2;
 129     my$dimdim=sprintf "#%02x%02x%02x", $r*.5,$g*.5,$b*.5;
 130     my$dimlit=sprintf "#%02x%02x%02x",
 131           &main::min($r+$lum*.7,255),&main::min($g+$lum*.7,255),
 132           &main::min($b+$lum*.7,255);
 133
 134     if($orient eq 'vertical'){
 135         my$text=$font->maketext($label,$width-($pad*2),$height-($pad*2),
 136                               $ratio,1,1);
 137
 138         my$unlittext=$below->Pixmap($below->PathName.".unlittext",
 139                                     -data=>$text->write($fore,$back,32));
 140         my$littext=$below->Pixmap($below->PathName.".littext",
 141                                   -data=>$text->write($afore,$aback,32));
 142
 143         $this->{"barlength"}=$height;
 144         $this->{"litrelief"}=$arelief;
 145         $this->{"cfborder"}=$aborder;
 146
 147         $below->configure(-borderwidth=>$aborder,
 148                           -background=>$aback,
 149                           -highlightthickness=>0,
 150                           -width=>($width-$aborder*2),
 151                           -height=>($height-$aborder*2),
 152                           -relief=>$arelief);
 153
 154         $above->configure(-borderwidth=>0,
 155                           -background=>$back,
 156                           -highlightthickness=>0,
 157                           -width=>$width,
 158                           -height=>$height,
 159                           -relief=>'flat');
 160
 161         $this->{"reliefhack"}->destroy if(defined($this->{"reliefhack"}));
 162         if($aborder){
 163             $this->{"reliefhack"}=$above->
 164                 Label(-borderwidth=>$aborder,
 165                       -background=>$aback,
 166                       -highlightthickness=>0,
 167                       -width=>($width-$aborder*2),
 168                       -height=>4,
 169                       -relief=>$arelief)->
 170                           place('-x'=>0,-rely=>1.0,'-y'=>-$aborder,
 171                                 -anchor=>'nw',-bordermode=>'outside');
 172         }
 173
 174
 175
 176         $below->createImage($pad,$height-$pad,-image=>$littext,-anchor=>'sw',
 177                             -tags=>['xpmlabel']);
 178         $above->createImage($pad,$height-$pad,-image=>$unlittext,
 179                             -anchor=>'sw',-tags=>['xpmlabel']);
 180         &drawborder($above,$width,$height,$relief,$dimdim,$dimlit);
 181
 182     }else{
 183         my$text=$font->maketext($label,$height-($pad*2),$width-($pad*2),
 184                               $ratio,0,1);
 185         my$unlittext=$below->Pixmap($below->PathName.".unlittext",
 186                                     -data=>$text->write($fore,$back,32));
 187         my$littext=$below->Pixmap($below->PathName.".littext",
 188                                   -data=>$text->write($afore,$aback,32));
 189
 190         $this->{"barlength"}=$width;
 191         $this->{"cfborder"}=$aborder;
 192         $below->configure(-borderwidth=>0,
 193                           -background=>$back,
 194                           -highlightthickness=>0,
 195                           -width=>$width,
 196                           -height=>$height-$border*2,
 197                           -relief=>'flat');
 198
 199         $above->configure(-borderwidth=>$aborder,
 200                           -background=>$aback,
 201                           -highlightthickness=>0,
 202                           -width=>($width-2*$aborder),
 203                           -height=>($height-2*$aborder),
 204                           -relief=>$arelief);
 205
 206         $above->createImage($pad,$height-$pad,-image=>$littext,-anchor=>'sw',
 207                             -tags=>['xpmlabel']);
 208         $below->createImage($pad,$height-$pad,-image=>$unlittext,
 209                             -anchor=>'sw',-tags=>['xpmlabel']);
 210         &drawborder($below,$width,$height,$relief,$dimdim,$dimlit);
 211
 212     }
 213
 214     $this;
 215 }
 216
 217 sub set{
 218     my$bar=shift;
 219     my$per=shift;
 220
 221     $bar->{'value'}=$per;
 222     my $orient=$main::orient;
 223     if($orient eq 'vertical'){
 224         $bar->{'above'}->
 225             configure('-height'=>($bar->{"barlength"}-
 226                                   $per+$bar->{"cfborder"}));
 227     }else{
 228         # handle another one-off bug in Tk
 229         my $border=$bar->{"cfborder"};
 230         if($per-2*$border > 0){
 231             $bar->{'above'}->
 232                 place('-x'=>0);
 233             $bar->{'above'}->
 234                 configure('-width'=>($per-2*$border));
 235         }else{
 236             $bar->{'above'}->
 237                 configure('-width'=>(0));
 238             $bar->{'above'}->
 239                 place('-x'=>-1);
 240         }
 241     }
 242 }
 243
 244 package MGM::Graph;
 245 use vars qw(%numbers %prompts);
 246
 247 # all the labels are the same size/color, but we have to do this after the toplevel is created so we have the size/color resources
 248
 249 sub cacheem{
 250     my$size=$main::toplevel->optionGet("labelsize","");
 251     my$fg=$main::foreground;
 252     my$bg=$main::background;
 253     my$orient=$main::orient;
 254     while(defined(my$num=shift)){
 255         if(!defined($numbers{"$num"})){
 256             $numbers{"$num"}=$main::toplevel->
 257                 Pixmap(-data=>$MGM::Bar::font->
 258                        maketext("$num",$size,undef,1,
 259                                 $orient eq 'vertical'?1:undef)->
 260                        write($fg,$bg,32,32));
 261         }
 262     }
 263 }
 264
 265 sub cacheinit{
 266     if(!defined($numbers)){
 267         &cacheem("0","1","2","4","8","16","32","64","128","256","512");
 268     }
 269 }
 270
 271 sub cacheprompt{
 272     my$prompt=shift;
 273
 274     if(!defined($prompts{"$prompt"})){
 275         my$size=$main::toplevel->optionGet("labelsize","");
 276         my$fg=$main::foreground;
 277         my$bg=$main::background;
 278         my$orient=$main::orient;
 279
 280         $prompts{"$prompt"}=$main::toplevel->Pixmap(-data=>
 281             $MGM::Bar::font->maketext("$prompt",$size,undef,1,
 282                                       $orient eq 'vertical'?1:undef)->
 283                                           write($fg,$bg,32,32));
 284         $prompts{"k$prompt"}=$main::toplevel->Pixmap(-data=>
 285             $MGM::Bar::font->maketext("k$prompt",$size,undef,1,
 286                                       $orient eq 'vertical'?1:undef)->
 287                                           write($fg,$bg,32,32));
 288         $prompts{"M$prompt"}=$main::toplevel->Pixmap(-data=>
 289             $MGM::Bar::font->maketext("M$prompt",$size,undef,1,
 290                                       $orient eq 'vertical'?1:undef)->
 291                                           write($fg,$bg,32,32));
 292         $prompts{"G$prompt"}=$main::toplevel->Pixmap(-data=>
 293             $MGM::Bar::font->maketext("G$prompt",$size,undef,1,
 294                                       $orient eq 'vertical'?1:undef)->
 295                                           write($fg,$bg,32,32));
 296     }
 297 }
 298
 299 sub promptsize{
 300     my($prompt,$setting)=@_;
 301
 302     if($main::orient eq 'vertical'){
 303         ($numbers{"$setting"}->width,
 304          $numbers{"$setting"}->height+$prompts{"$prompt"}->height);
 305     }else{
 306         ($numbers{"$setting"}->height,
 307          $numbers{"$setting"}->width+$prompts{"$prompt"}->width);
 308     }
 309 }
 310
 311 sub scalemod{
 312     my$scaleset=shift;
 313     my$multiplier='';
 314
 315     if($scaleset>512){
 316         $scaleset/=1024;
 317         $multiplier="k";
 318         if($scaleset>512){
 319             $scaleset/=1024;
 320             $multiplier="M";
 321             if($scaleset>512){
 322                 $scaleset/=1024;
 323                 $multiplier="G";
 324             }
 325         }
 326     }
 327     $scaleset=int($scaleset+.5);
 328     ($scaleset,$multiplier);
 329 }
 330
 331 sub promptlabel{
 332     my($p,$scaleset,$prompt)=@_;
 333     my $orient=$main::orient;
 334     my $mult;
 335
 336     if($p->{'scalep'}){
 337         ($scaleset,$mult)=&scalemod($scaleset);
 338         my$label;
 339
 340         my($textw,$textl)=&promptsize("$mult$prompt",$scaleset);
 341
 342         if($orient eq 'vertical'){
 343             $label=$p->{"widget"}->Canvas(Name=>'scalerange',
 344                                           -borderwidth=>0,
 345                                           -highlightthickness=>0,
 346                                           -width=>$textw,
 347                                           -height=>$textl,
 348                                           -relief=>'flat')->
 349                                               place('-x'=>0,'-y'=>2,-anchor=>'nw');
 350             $label->createImage(0,0,
 351                                 -image=>$prompts{"$mult$prompt"},-anchor=>'nw');
 352             $label->createImage(0,$prompts{"$mult$prompt"}->height,
 353                                 -image=>$numbers{"$scaleset"},-anchor=>'nw');
 354         }else{
 355             $label=$p->{"widget"}->Canvas(Name=>'scalerange',
 356                                           -borderwidth=>0,
 357                                           -highlightthickness=>0,
 358                                           -width=>$textl,
 359                                           -height=>$textw,
 360                                           -relief=>'flat')->
 361                                               place(-relx=>1.0,
 362                                                     '-x'=>-2,'-y'=>0,
 363                                                     -anchor=>'ne');
 364             $label->createImage($numbers{"$scaleset"}->width,0,
 365                                 -image=>$prompts{"$mult$prompt"},-anchor=>'nw');
 366             $label->createImage(0,0,
 367                                 -image=>$numbers{"$scaleset"},-anchor=>'nw');
 368         }
 369         $label;
 370     }
 371 }
 372
 373 sub new{
 374     my$class=shift;
 375     my$p=shift;
 376     my$toplevel=$p->{"toplevel"};
 377
 378     my$ret=bless {( 'width'=> $p->{"width"},
 379                   'height'=> $p->{"height"},
 380                   'name' => $p->{"name"},
 381                   'rangesetting'=>1,
 382                   'rangecurrent'=>1,
 383                   'minscale'=>1,
 384                   'num' => '1',
 385                   'fixed' => '0')};
 386     $ret->{"scaletimer"}=0;
 387     $ret->{"scalemax"}=0;
 388
 389     $ret->_configure(@_);
 390
 391     my$widget=$ret->{"widget"}=
 392         $toplevel->Canvas(-class=>$ret->{"name"},
 393                                  Name=>$p->{"sequence"});
 394
 395     $ret->{"scalep"}=($widget->optionGet("scale","") eq 'true');
 396     $ret->{"scroll"}=($widget->optionGet("scalescroll","") eq 'true');
 397     $ret->{"scalereturn"}=$widget->optionGet("scalereturn","");
 398     $ret->{"scalethresh"}=$widget->optionGet("scalethresh","");
 399     $ret->drawit;
 400     $ret->{"meter"}=[(map{-1}(1..$ret->{"num"}))];
 401     $ret;
 402 }
 403
 404 sub calcsize{
 405     my($this,$scaleset,$prompt,$num)=@_;
 406
 407     my$barw=4*$num;
 408     my$barl=10;
 409     my$scalew=0;
 410     my$textl=0;
 411     my$textw=0;
 412
 413     if (&main::moption($this,"scale") eq 'true'){
 414         my($set,$mult)=&scalemod($scaleset);
 415         &cacheinit();
 416         &cacheprompt($prompt);
 417         &cacheem($set);
 418
 419         ($textw,$textl)=&promptsize("$mult$prompt",$set);
 420         $textw+=3;
 421         $textl+=4;
 422         $scalew=6;
 423     }
 424
 425     $scalew=&main::max($scalew,$textw);
 426     $barl=&main::max($barl,$textl);
 427
 428     ($barw+$scalew,$barl,$scalew);
 429 }
 430
 431 sub calcxysize{
 432     my($w,$l)=&calcsize(@_);
 433
 434     if($main::orient eq 'vertical'){
 435         ($w,$l);
 436     }else{
 437         ($l,$w);
 438     }
 439 }
 440
 441 sub drawit{
 442     my$this=shift;
 443
 444     # a 'graph' consists of a scale, and <n> bars under central control
 445
 446     my $num=$this->{"num"};
 447     if($num){
 448
 449         my $name=$this->{"name"};
 450         my $prompt=$this->{"prompt"};
 451         my $fixed=$this->{"fixed"};
 452
 453         my $height=$this->{"height"};
 454         my $width=$this->{"width"};
 455         my $widget=$this->{"widget"};
 456
 457         $widget->configure(-borderwidth=>0,
 458                            -highlightthickness=>0,
 459                            -width=>$width,
 460                            -height=>$height,
 461                            -relief=>'flat');
 462
 463         my $rangesetting=$this->{"rangesetting"};
 464         my($dummy,$dummy2,$scalew)=&calcsize($this,$rangesetting,$prompt,$num);
 465         $this->{"scalew"}=$scalew;
 466         $this->{"numlabel"}=$this->promptlabel($rangesetting,$prompt);
 467
 468         my $orient=$main::orient;
 469         if($orient eq 'vertical'){
 470             $this->drawvscale if($scalew);
 471
 472             $this->{"barlength"}=$height;
 473             my$barwidth=$width-$scalew;
 474             my$frame=$this->{"barframe"}=
 475                 $widget->Frame(Name=>'bar',
 476                                -width=>$barwidth,
 477                                -height=>$height,
 478                                -borderwidth=>0)->
 479                                    place('-x'=>$scalew,
 480                                          '-y'=>0,
 481                                          '-anchor'=>'nw');
 482
 483             $barwidth/=$num;
 484             $barwidth=int($barwidth);
 485             my$x=0;
 486             for(my$i=0;$i<$num;$i++){
 487                 $this->{$i}=MGM::Bar->new($frame,$barwidth-1,
 488                                           $height,
 489                                           $i)->place('-x'=>$x,'-y'=>0,
 490                                                      '-anchor'=>'nw');
 491                 $x+=$barwidth;
 492             }
 493         }else{
 494             $this->drawhscale if($scalew);
 495
 496             $this->{"barlength"}=$width;
 497             my$barwidth=$height-$scalew;
 498             my$frame=$this->{"barframe"}=
 499                 $widget->Frame(Name=>'bar',
 500                                -width=>$width,
 501                                -height=>$barwidth,
 502                                -borderwidth=>0)->
 503                                    place('-y'=>$scalew,
 504                                          '-x'=>0,
 505                                          -anchor=>'nw');
 506
 507             $barwidth/=$num;
 508             $barwidth=int($barwidth);
 509             my$y=0;
 510             for(my$i=0;$i<$num;$i++){
 511                 $this->{$i}=MGM::Bar->new($frame,$width,
 512                                           $barwidth-1,
 513                                           $i)->place('-x'=>0,'-y'=>$y,
 514                                                      -anchor=>'nw');
 515                 $y+=$barwidth;
 516             }
 517         }
 518     }
 519 }
 520
 521 sub place{
 522     my$this=shift;
 523     $this->{"widget"}->place(@_);
 524     $this;
 525 }
 526
 527 sub _configure{
 528     my$this=shift;
 529     my ($arg,$val);
 530     while(defined($arg=shift)){
 531         $val=shift;
 532
 533         if(!defined($val)){last;}
 534         $this->{"$arg"}=$val;
 535     }
 536
 537     # enforce power of two dynamic ranging
 538     $this->{"rangesetting"}=$this->{"minscale"} if($this->{"minscale"}>
 539                                                    $this->{"rangesetting"});
 540     $this->{"rangecurrent"}=$this->{"minscale"} if($this->{"minscale"}>
 541                                                    $this->{"rangecurrent"});
 542     if($this->{"fixed"}==0){
 543         my$i=1;
 544         while($i<$this->{"rangesetting"}){
 545             $i*=2;
 546         }
 547         $this->{"rangesetting"}=$i;
 548     }
 549     $this->{"rangediff"}=$this->{"rangesetting"}-
 550         $this->{"rangecurrent"};
 551 }
 552
 553 # we can't configure anything that requires size changes.
 554 sub configure{
 555     my$this=shift;
 556     my%copy=%$this;
 557
 558     $this->_configure(@_);
 559
 560     if($copy{"rangesetting"} != $this->{"rangesetting"}){
 561         my$val=int($this->{'rangesetting'});
 562
 563         $this->{"numlabel"}->destroy;
 564         $this->{"numlabel"}=$this->promptlabel($val,$this->{'prompt'});
 565         $this->{"rangediff"}=$this->{"rangesetting"}-
 566             $this->{"rangecurrent"};
 567         $this->{"scaletimer"}=0; # reset the timer
 568         $this->{"scalemax"}=0;
 569         $this->_animate();
 570     }
 571 }
 572
 573 # a way to configure individual bars
 574 sub barconfigure{
 575     my$this=shift;
 576     my$bar=shift;
 577     $bar=$this->{$bar};
 578     $bar->configure(@_);
 579 }
 580
 581 sub drawvscale{
 582     my$this=shift;
 583
 584     # length is in barlength
 585     # current scale setting in rangecurrent
 586     # scale 'goal' in rangesetting (may smooth-scroll)
 587     # current max meter setting in metermax
 588     # (other meter settings in meter0, meter1, meter2....)
 589
 590     # build new scale
 591     my$widget=$this->{"widget"};
 592     my$color=$widget->optionGet("scalecolor","");
 593     my$height=$this->{"height"};
 594     my$width=4;
 595     my$xo=$this->{"scalew"}-2;
 596
 597     $widget->createLine($xo,0,$xo,$height-1,$xo-$width,$height-1,
 598                         -tags=>['newscale'],-fill=>$color,
 599                         -capstyle=>'projecting');
 600
 601     # powers of two. tics no closer than every 4 pixels
 602
 603     my$max=0.;
 604     if($this->{"rangesetting"}){
 605         $max=$height/$this->{"rangecurrent"}*$this->{"rangesetting"};
 606     }else{
 607         if($this->{"rangecurrent"}){
 608             $max=$height/$this->{"rangecurrent"};
 609         }
 610     }
 611     if($this->{"rangecurrent"}==$this->{"rangesetting"}){
 612         $widget->createLine($xo,0,$xo-$width,0,
 613                             -tags=>['newscale'],-fill=>$color,
 614                             -capstyle=>'projecting');
 615     }
 616
 617     my$step=1;
 618     for(my$div=2;;$div*=2){
 619         my$flag=0;
 620         last if($width<1);
 621         last if($max/$div<4);
 622         for(my$tic=1;;$tic+=$step){
 623             my$y=$height-$max/$div*$tic;
 624             if($y>=0){
 625                 $widget->createLine($xo,$y,$xo-$width,$y,
 626                                     -tags=>['newscale'],-fill=>$color,
 627                                     -capstyle=>'projecting');
 628                 $flag=1;
 629             }else{
 630                 last;
 631             }
 632         }
 633         $width-- if ($flag);
 634         $step=2;
 635     }
 636
 637     # replace old scale with new scale
 638
 639     $widget->delete('scale');
 640     $widget->addtag('scale',withtag=>'newscale');
 641 }
 642
 643 sub drawhscale{
 644     my$this=shift;
 645
 646     # length is in barlength
 647     # current scale setting in rangecurrent
 648     # scale 'goal' in rangesetting (may smooth-scroll)
 649     # current max meter setting in metermax
 650     # (other meter settings in meter0, meter1, meter2....)
 651
 652     # build new scale
 653     my$widget=$this->{"widget"};
 654     my$color=$widget->optionGet("scalecolor","Scalecolor");
 655     my$yo=$this->{"scalew"}-2;
 656     my$width=$this->{"width"};
 657     my$height=4;
 658
 659     $widget->createLine(0,$yo-$height,0,$yo,$width-1,$yo,
 660                         -tags=>['newscale'],-fill=>$color,
 661                         -capstyle=>'projecting');
 662
 663     # powers of two. tics no closer than every 4 pixels
 664     my$max=0.;
 665     if($this->{"rangesetting"}){
 666         $max=$width/$this->{"rangecurrent"}*$this->{"rangesetting"};
 667     }else{
 668         if($this->{"rangecurrent"}){
 669             $max=$width/$this->{"rangecurrent"};
 670         }
 671     }
 672     if($this->{"rangecurrent"}==$this->{"rangesetting"}){
 673         $widget->createLine($width-1,$yo-$height,$width-1,$yo,
 674                             -tags=>['newscale'],-fill=>$color,
 675                             -capstyle=>'projecting');
 676     }
 677
 678     my$step=1;
 679     for(my$div=2;;$div*=2){
 680         my$flag=0;
 681         last if($max/$div<4);
 682         last if($height<1);
 683         for(my$tic=1;;$tic+=$step){
 684             my$x=$max/$div*$tic;
 685             if($x<$width){
 686                 $widget->createLine($x,$yo-$height,$x,$yo,
 687                                     -tags=>['newscale'],-fill=>$color,
 688                                     -capstyle=>'projecting');
 689                 $flag=1;
 690             }else{
 691                 last;
 692             }
 693         }
 694         $height-- if ($flag);
 695         $step=2;
 696     }
 697
 698     # replace old scale with new scale
 699
 700     $widget->delete('scale');
 701     $widget->addtag('scale',withtag=>'newscale');
 702 }
 703
 704 sub _newscale{
 705     my$this=shift;
 706     my$val=$this->{'rangesetting'};
 707
 708     $this->{"numlabel"}->destroy;
 709     $this->{"numlabel"}=$this->promptlabel($val,$this->{'prompt'});
 710     $this->{"rangediff"}=$this->{"rangesetting"}-$this->{"rangecurrent"};
 711     $this->_animate();
 712 }
 713
 714 sub _animate{
 715     my $this=shift;
 716
 717     $scalep=$this->{"scalep"};
 718     $scrollp=$this->{"scroll"};
 719
 720     if(!$scalep || !$scrollp){
 721         $this->{"rangecurrent"}=$this->{"rangesetting"};
 722         undef $this->{"anitimer"};
 723     }else{
 724         if($this->{"rangesetting"}==0){
 725             if($this->{"rangecurrent"}<.02){
 726                 $this->{"rangecurrent"}=$this->{"rangesetting"};
 727                 undef $this->{"anitimer"};
 728             }else{
 729                 $this->{"rangecurrent"}+=$this->{"rangediff"}*.1;
 730                 $this->{"anitimer"}->cancel if(defined($this->{"anitimer"}));
 731                 $this->{"anitimer"}=$this->{"widget"}->after(30,sub{$this->set;});
 732             }
 733         }else{
 734             if(abs($this->{"rangecurrent"}/($this->{"rangesetting"})-1)<.02){
 735                 $this->{"rangecurrent"}=$this->{"rangesetting"};
 736                 undef $this->{"anitimer"};
 737             }else{
 738                 $this->{"rangecurrent"}+=$this->{"rangediff"}*.1;
 739                 $this->{"anitimer"}->cancel if(defined($this->{"anitimer"}));
 740                 $this->{"anitimer"}=$this->{"widget"}->after(30,sub{$this->set;});
 741             }
 742         }
 743     }
 744
 745     if($main::orient eq 'vertical'){
 746         $this->drawvscale;
 747     }else{
 748         $this->drawhscale;
 749     }
 750     my$length=$this->{"barlength"};
 751     my$num=$this->{"num"};
 752     if($this->{"rangecurrent"}){
 753         for(my$i=0;$i<$num;$i++){
 754             $this->{$i}->
 755                 set($this->{"meter"}->[$i]*$length/$this->{"rangecurrent"});
 756         }
 757     }else{
 758         for(my$i=0;$i<$num;$i++){
 759             $this->{$i}->
 760                 set(0);
 761         }
 762     }
 763 }
 764
 765 sub set{
 766     my$this=shift;
 767     my$num=$this->{"num"};
 768
 769     if($num){
 770         my$length=$this->{"barlength"};
 771
 772         # length is in barlength
 773         # current scale setting in rangecurrent
 774         # scale 'goal' in rangesetting (may smooth-scroll)
 775
 776         if($#_>=0){
 777             # we have new values incoming.  We need to do full maneuvers
 778
 779             if($#_!=$num-1){
 780                 # might as well.  prevents spurious error printing when
 781                 # something unexpected happens to a module (like a CPU
 782                 # disappearing ;-)
 783
 784                 push @_,$#_+1,map{0}(1..$num); #lazy
 785                 $#_=$num-1;
 786             }
 787
 788             # find the largest value for scale adjustment
 789             my$metermax=0;
 790             map{$metermax=$_ if ($metermax<$_)}(@_, @{$this->{"meter"}},
 791                                                 $this->{"scalemax"});
 792             $this->{"scalemax"}=$metermax;
 793             my$fixed=$this->{"fixed"};
 794
 795             # raise the scale range?
 796             my$redrawflag=0;
 797             if($fixed==0 && $metermax>$this->{"rangesetting"}){
 798                 splice @{$this->{"meter"}},0,$#_+1,@_;
 799                 while($metermax>$this->{"rangesetting"}){
 800                     if($this->{"rangesetting"} == 0){
 801                         $this->{"rangesetting"}=1;
 802                     }else{
 803                         $this->{"rangesetting"}*=2;
 804                     }
 805                     $this->{"scaletimer"}=0; # reset the timer
 806                     $this->{"scalemax"}=$metermax;
 807                     $this->_newscale();
 808                 }
 809             }else{
 810                 # lower the scale range?
 811                 my$scaletimer=$this->{"scaletimer"}+1;
 812                 if($fixed==0 && $scaletimer>=$this->{"scalereturn"} &&
 813                    $this->{"rangesetting"}>$this->{"minscale"} &&
 814                    $metermax*$this->{"scalethresh"}<$this->{"rangesetting"} &&
 815                    $this->{"rangesetting"}==$this->{"rangecurrent"}){
 816
 817                     $this->{"rangesetting"}=int($this->{"rangesetting"}/2);
 818                     $this->{"scaletimer"}=0;
 819                     $this->{"scalemax"}=0;
 820                     splice @{$this->{"meter"}},0,$#_+1,@_;
 821                     $this->_newscale();
 822
 823                 }else{
 824                     my$meter=$this->{"meter"};
 825                     for(my$i=0;defined(my$val=shift);$i++){
 826                         if($meter->[$i]!=$val){
 827                             $meter->[$i]=$val;
 828                             $val*=$length/$this->{"rangecurrent"};
 829                             $this->{$i}->set($val);
 830                         }
 831                     }
 832
 833                     if($scaletimer>=$this->{"scalereturn"}){
 834                         $this->{"scaletimer"}=0;
 835                         $this->{"scalemax"}=0;
 836                     }else{
 837                         $this->{"scaletimer"}=$scaletimer;
 838                         $this->{"scalemax"}=$metermax;
 839                     }
 840                 }
 841             }
 842
 843         }else{
 844             # just scale animation.  No reconfig
 845             $this->_animate();
 846         }
 847     }
 848 }
 849
 850 1;
 851
 852