| 1 | # ruler.pl |
| 2 | |
| 3 | use subs qw/ruler_make_tab ruler_move_tab ruler_new_tab ruler_release_tab |
| 4 | ruler_select_tab/; |
| 5 | use vars qw/$TOP/; |
| 6 | |
| 7 | sub ruler { |
| 8 | |
| 9 | # Create a canvas demonstration consisting of a ruler displays a ruler |
| 10 | # with tab stops that can be set individually. |
| 11 | |
| 12 | my($demo) = @_; |
| 13 | $TOP = $MW->WidgetDemo( |
| 14 | -name => $demo, |
| 15 | -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.', qw/-wraplength 5i/], |
| 16 | -title => 'Ruler Demonstration', |
| 17 | -iconname => 'ruler', |
| 18 | ); |
| 19 | |
| 20 | my $c = $TOP->Canvas(qw/-width 14.8c -height 2.5c/); |
| 21 | $c->pack(qw/-side top -fill x/); |
| 22 | |
| 23 | my %rinfo; # ruler information hash |
| 24 | $rinfo{grid} = '.25c'; |
| 25 | $rinfo{left} = $c->fpixels('1c'); |
| 26 | $rinfo{right} = $c->fpixels('13c'); |
| 27 | $rinfo{top} = $c->fpixels('1c'); |
| 28 | $rinfo{bottom} = $c->fpixels('1.5c'); |
| 29 | $rinfo{size} = $c->fpixels('.2c'); |
| 30 | $rinfo{normalStyle} = [qw/-fill black/]; |
| 31 | if ($TOP->depth > 1) { |
| 32 | $rinfo{activeStyle} = [qw/-fill red -stipple/ => undef]; |
| 33 | $rinfo{deleteStyle} = [ |
| 34 | -fill => 'red', |
| 35 | -stipple => '@'.Tk->findINC('demos/images/grey.25'), |
| 36 | ]; |
| 37 | } else { |
| 38 | $rinfo{activeStyle} = [qw/-fill black -stipple/ => undef]; |
| 39 | $rinfo{deleteStyle} = [ |
| 40 | -fill => 'black', |
| 41 | -stipple => '@'.Tk->findINC('demos/images/grey.25'), |
| 42 | ]; |
| 43 | } |
| 44 | |
| 45 | $c->create(qw/line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1/); |
| 46 | my $i; |
| 47 | for ($i = 0; $i < 12; $i++) { |
| 48 | my $x = $i+1; |
| 49 | $c->create('line', "$x.c", '1c', "$x.c", '0.6c', -width => 1); |
| 50 | $c->create('line', "$x.25c", '1c', "$x.25c", '0.8c', -width => 1); |
| 51 | $c->create('line', "$x.5c", '1c', "$x.5c", '0.7c', -width => 1); |
| 52 | $c->create('line', "$x.75c", '1c', "$x.75c", '0.8c', -width => 1); |
| 53 | $c->create('text', "$x.15c", '.75c',-text => $i, -anchor => 'sw'); |
| 54 | } |
| 55 | $c->addtag('well', 'withtag', $c->create(qw/rect 13.2c 1c 13.8c 0.5c |
| 56 | -outline black -fill/, ($c->configure(-bg))[4])); |
| 57 | $c->addtag('well', 'withtag', ruler_make_tab($c, $c->pixels('13.5c'), |
| 58 | $c->pixels('.65c'), \%rinfo)); |
| 59 | |
| 60 | $c->bind('well', '<1>' => [\&ruler_new_tab, \%rinfo]); |
| 61 | $c->bind('tab', '<1>' => [\&ruler_select_tab, \%rinfo]); |
| 62 | $c->Tk::bind('<B1-Motion>' => [\&ruler_move_tab, \%rinfo]); |
| 63 | $c->Tk::bind('<Any-ButtonRelease-1>', [\&ruler_release_tab, \%rinfo]); |
| 64 | |
| 65 | } # end ruler |
| 66 | |
| 67 | sub ruler_make_tab { |
| 68 | |
| 69 | my($c, $x, $y, $rinfo) = @_; |
| 70 | |
| 71 | return $c->create('polygon', $x, $y, $x+$rinfo->{size}, $y+$rinfo->{size}, |
| 72 | $x-$rinfo->{size}, $y+$rinfo->{size}); |
| 73 | |
| 74 | } # end ruler_make_tab |
| 75 | |
| 76 | sub ruler_move_tab { |
| 77 | |
| 78 | my($c, $rinfo) = @_; |
| 79 | |
| 80 | return if not defined $c->find('withtag', 'active'); |
| 81 | my $e = $c->XEvent; |
| 82 | my($x, $y) = ($e->x, $e->y); |
| 83 | my $cx = $c->canvasx($x, $rinfo->{grid}); |
| 84 | my $cy = $c->canvasy($y); |
| 85 | if ($cx < $rinfo->{left}) { |
| 86 | $cx = $rinfo->{left}; |
| 87 | } |
| 88 | if ($cx > $rinfo->{right}) { |
| 89 | $cx = $rinfo->{right}; |
| 90 | } |
| 91 | if (($cy >= $rinfo->{top}) and ($cy <= $rinfo->{bottom})) { |
| 92 | $cy = $rinfo->{top} + 2; |
| 93 | $c->itemconfigure('active', @{$rinfo->{activeStyle}}); |
| 94 | } else { |
| 95 | $cy = $cy - $rinfo->{size} - 2; |
| 96 | $c->itemconfigure('active', @{$rinfo->{deleteStyle}}); |
| 97 | } |
| 98 | $c->move('active', $cx-$rinfo->{'x'}, $cy-$rinfo->{'y'}); |
| 99 | $rinfo->{'x'} = $cx; |
| 100 | $rinfo->{'y'} = $cy; |
| 101 | |
| 102 | } # end ruler_move_tab |
| 103 | |
| 104 | sub ruler_new_tab { |
| 105 | |
| 106 | my($c, $rinfo) = @_; |
| 107 | |
| 108 | my $e = $c->XEvent; |
| 109 | my($x, $y) = ($e->x, $e->y); |
| 110 | $c->addtag('active', 'withtag', ruler_make_tab($c, $x, $y, $rinfo)); |
| 111 | $c->addtag('tab', 'withtag', 'active'); |
| 112 | $rinfo->{'x'} = $x; |
| 113 | $rinfo->{'y'} = $y; |
| 114 | ruler_move_tab($c, $rinfo); |
| 115 | |
| 116 | } # end ruler_new_tab |
| 117 | |
| 118 | sub ruler_release_tab { |
| 119 | |
| 120 | my($c, $rinfo) = @_; |
| 121 | |
| 122 | return if not defined $c->find('withtag', 'active'); |
| 123 | if ($rinfo->{'y'} != $rinfo->{top} + 2) { |
| 124 | $c->delete('active'); |
| 125 | } else { |
| 126 | $c->itemconfigure('active', @{$rinfo->{normalStyle}}); |
| 127 | $c->dtag('active'); |
| 128 | } |
| 129 | |
| 130 | } # end ruler_release_tab |
| 131 | |
| 132 | sub ruler_select_tab { |
| 133 | |
| 134 | my($c, $rinfo) = @_; |
| 135 | |
| 136 | my $e = $c->XEvent; |
| 137 | my($x, $y) = ($e->x, $e->y); |
| 138 | $rinfo->{'x'} = $c->canvasx($x, $rinfo->{grid}); |
| 139 | $rinfo->{'y'} = $rinfo->{top} + 2; |
| 140 | $c->addtag('active', 'withtag', 'current'); |
| 141 | $c->itemconfigure('active', @{$rinfo->{activeStyle}}); |
| 142 | $c->raise('active'); |
| 143 | |
| 144 | } # end ruler_select_tab |
| 145 | |
| 146 | 1; |