Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / sun4-solaris / Tk / demos / widget_lib / mkRuler.pl

sub rulerMkTab {

   my($c, $x, $y) = @_;

   return $c->create('polygon', $x, $y, $x+$ruler_info{'size'}, $y+$ruler_info{'size'}, $x-$ruler_info{'size'},
                     $y+$ruler_info{'size'});

} # end rulerMkTab


sub rulerMoveTab {

   my($c) = @_;

   return if not defined $c->find('withtag', 'active');
   my $e = $c->XEvent;
   my($x, $y) = ($e->x, $e->y);
   my $cx = $c->canvasx($x, $ruler_info{'grid'});
   my $cy = $c->canvasy($y);
   if ($cx < $ruler_info{'left'}) {
       $cx =  $ruler_info{'left'};
   }
   if ($cx > $ruler_info{'right'}) {
       $cx =  $ruler_info{'right'};
   }
   if (($cy >= $ruler_info{'top'}) and ($cy <= $ruler_info{'bottom'})) {
       $cy =  $ruler_info{'top'} + 2;
       $c->itemconfigure('active', @{$ruler_info{'activeStyle'}});
   } else {
       $cy =  $cy - $ruler_info{'size'} - 2;
       $c->itemconfigure('active', @{$ruler_info{'deleteStyle'}});
   }
   $c->move('active',  $cx-$ruler_info{'x'}, $cy-$ruler_info{'y'});
   $ruler_info{'x'} = $cx;
   $ruler_info{'y'} = $cy;

} # end rulerMoveTab


sub rulerNewTab {
   
   my($c) = @_;

   my $e = $c->XEvent;
   my($x, $y) = ($e->x, $e->y);
   $c->addtag('active', 'withtag', rulerMkTab($c, $x, $y));
   $c->addtag('tab', 'withtag', 'active');
   $ruler_info{'x'} = $x;
   $ruler_info{'y'} = $y;
   rulerMoveTab($c, $e);

} # end rulerNewTab


sub rulerReleaseTab {

   my($c) = @_;

   return if not defined $c->find('withtag', 'active');
   if ($ruler_info{'y'} != $ruler_info{'top'} + 2) {
       $c->delete('active');
   } else {
       $c->itemconfigure('active', @{$ruler_info{'normalStyle'}});
       $c->dtag('active');
   }

} # end rulerReleaseTab


sub rulerSelectTab {

   my($c) = @_;

   my $e = $c->XEvent;
   my($x, $y) = ($e->x, $e->y);
   $ruler_info{'x'} = $c->canvasx($x, $ruler_info{'grid'});
   $ruler_info{'y'} = $ruler_info{'top'} + 2;
   $c->addtag('active', 'withtag', 'current');
   $c->itemconfigure('active', @{$ruler_info{'activeStyle'}});
   $c->raise('active');

} # end rulerSelectTab

sub mkRuler {

   # Create a canvas demonstration consisting of a ruler displays a ruler with tab stops that can be set individually.

   $mkRuler->destroy if Exists($mkRuler);
   $mkRuler = $top->Toplevel();
   my $w = $mkRuler;
   dpos $w;
   $w->title('Ruler Demonstration');
   $w->iconname('Ruler');

   my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*', -wraplength => '13c',
                            -justify => 'left', -text => 'This canvas widget shows a mock-up of a ruler.  You can create tab ' .
                            'stops by dragging them out of the well to the right of the ruler.  You can also drag ' .
                            'existing tab stops.  If you drag a tab stop far enough up or down so that it turns dim, it ' .
                            'will be deleted when you release the mouse button.');
   my $c = $w->Canvas(-width => '14.8c', -height => '2.5c');
   my $w_ok = $w->Button(-text => 'OK', -width => 8, -command => ['destroy', $w]);
   $w_msg->pack(-side => 'top', -fill => 'x');
   $c->pack(-side => 'top', -fill => 'x');
   $w_ok->pack(-side => 'bottom', -pady => '5');

   $ruler_info{'grid'} = '.25c';
   $ruler_info{'left'} = $c->fpixels('1c');
   $ruler_info{'right'} = $c->fpixels('13c');
   $ruler_info{'top'} = $c->fpixels('1c');
   $ruler_info{'bottom'} = $c->fpixels('1.5c');
   $ruler_info{'size'} = $c->fpixels('.2c');
   $ruler_info{'normalStyle'} = [-fill => 'black'];
   if ($mkRuler->depth > 1) {
       $ruler_info{'activeStyle'} = [-fill => 'red',   -stipple => undef];
       $ruler_info{'deleteStyle'} = [-fill => 'red',   -stipple => '@'.Tk->findINC('demos/images/grey.25')];
   } else {
       $ruler_info{'activeStyle'} = [-fill => 'black', -stipple => undef];
       $ruler_info{'deleteStyle'} = [-fill => 'black', -stipple => '@'.Tk->findINC('demos/images/grey.25')];
   }

   $c->create(qw(line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1));
   for ($i = 0; $i < 12; $i++) {
       my $x = $i+1;
       $c->create('line', "$x.c",  '1c', "$x.c",  '0.6c', -width => 1);
       $c->create('line', "$x.25c", '1c', "$x.25c", '0.8c', -width => 1);
       $c->create('line', "$x.5c",  '1c', "$x.5c",  '0.7c', -width => 1);
       $c->create('line', "$x.75c", '1c', "$x.75c", '0.8c', -width => 1);
       $c->create('text', "$x.15c", '.75c',-text => $i, -anchor => 'sw');
   }
   $c->addtag('well', 'withtag', $c->create(qw(rect 13.2c 1c 13.8c 0.5c -outline black -fill), ($c->configure(-bg))[4]));
   $c->addtag('well', 'withtag', rulerMkTab($c, $c->pixels('13.5c'), $c->pixels('.65c')));

   $c->bind('well', '<1>' => sub{rulerNewTab(@_)});
   $c->bind('tab', '<1>' => sub {rulerSelectTab(@_)});
   $c->Tk::bind('<B1-Motion>' => sub {rulerMoveTab(@_)});
   $c->Tk::bind('<Any-ButtonRelease-1>', sub {rulerReleaseTab(@_)});

} # end mkRuler

1;