aboutsummaryrefslogtreecommitdiff
path: root/sandbox/controls.pl
diff options
context:
space:
mode:
authorlecoanet2001-02-19 15:01:03 +0000
committerlecoanet2001-02-19 15:01:03 +0000
commita41e2eb20ce6db5dfb65791b47d0cf145458f8f1 (patch)
tree3160e734cec693ae43febd6bfbf2583be1fcc7d9 /sandbox/controls.pl
parent968124cdc1995aea26647a3515c63858233c44cf (diff)
downloadtkzinc-a41e2eb20ce6db5dfb65791b47d0cf145458f8f1.zip
tkzinc-a41e2eb20ce6db5dfb65791b47d0cf145458f8f1.tar.gz
tkzinc-a41e2eb20ce6db5dfb65791b47d0cf145458f8f1.tar.bz2
tkzinc-a41e2eb20ce6db5dfb65791b47d0cf145458f8f1.tar.xz
*** empty log message ***
Diffstat (limited to 'sandbox/controls.pl')
-rw-r--r--sandbox/controls.pl168
1 files changed, 0 insertions, 168 deletions
diff --git a/sandbox/controls.pl b/sandbox/controls.pl
deleted file mode 100644
index fcddda5..0000000
--- a/sandbox/controls.pl
+++ /dev/null
@@ -1,168 +0,0 @@
-$tlbbox = $zinc->add('group', $top,
- -sensitive => 0, -visible => 0,
- -tags 'currentbbox');
-$zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]);
-$trbbox = $zinc->add('group', $top,
- -sensitive => 0, -visible => 0,
- -tags => 'currentbbox');
-$zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]);
-$blbbox = $zinc->add('group', $top,
- -sensitive => 0, -visible => 0,
- -tags => 'currentbbox');
-$zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]);
-$brbbox = $zinc->add('group', $top,
- -sensitive => 0, -visible => 0,
- -tags 'currentbbox');
-$zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]);
-$zinc->add('rectangle', $top, [0, 0, 1, 1],
- -linecolor => 'red', -tags => 'lasso',
- -visible => 0, -sensitive => 0);
-
-#
-# Controls for the window transform.
-#
-proc press {lx ly action} {
- global x y angle
- set x $lx
- set y $ly
- set angle [expr atan2($y, $x)]
- bind .r "<Motion>" "$action %x %y"
-}
-
-proc motion {lx ly} {
- global x y
- set it [.r find withtag controls]
- if {$it != ""} {
- set it [.r group [lindex $it 0]]
- }
- set res [.r transform $it "$lx $ly $x $y"]
- set nx [lindex $res 0]
- set ny [lindex $res 1]
- set ox [lindex $res 2]
- set oy [lindex $res 3]
- .r translate controls [expr $nx - $ox] [expr $ny - $oy]
- set x $lx
- set y $ly
-}
-
-proc zoom {lx ly} {
- global x y
-
- if {$lx > $x} {
- set maxx $lx
- } else {
- set maxx $x
- }
- if {$ly > $y} {
- set maxy $ly
- } else {
- set maxy $y
- }
- set sx [expr 1.0 + double($lx - $x)/$maxx]
- set sy [expr 1.0 + double($ly - $y)/$maxy]
- set x $lx
- set y $ly
- .r scale controls $sx $sy
-}
-
-proc rotate {lx ly} {
- global angle
-
- set langle [expr atan2($ly, $lx)]
- .r rotate controls [expr -($langle-$angle)]
- set angle $langle
-}
-
-proc release {} {
- bind .r "<Motion>" ""
-}
-
-proc start_lasso {lx ly} {
- global top x y cx cy
- set x $lx
- set y $ly
- set cx $lx
- set cy $ly
- set coords [.r transform $top "$x $y"]
- set fx [lindex $coords 0]
- set fy [lindex $coords 1]
- .r coords lasso "$fx $fy $fx $fy"
- .r itemconfigure lasso -visible t
- .r raise lasso
- bind .r "<Motion>" "lasso %x %y"
-}
-
-proc lasso {lx ly} {
- global top x y cx cy
- set cx $lx
- set cy $ly
- set coords [.r transform $top "$x $y $lx $ly"]
- set fx [lindex $coords 0]
- set fy [lindex $coords 1]
- set fcx [lindex $coords 2]
- set fcy [lindex $coords 3]
- .r coords lasso "$fx $fy $fcx $fcy"
-}
-
-proc fin_lasso {} {
- global x y cx cy
-
- bind .r "<Motion>" ""
- .r itemconfigure lasso -visible f
-# puts "x=$x, y=$y, cx=$cx, cy=$cy"
- puts "enclosed='[.r find enclosed $x $y $cx $cy]', overlapping='[.r find overlapping $x $y $cx $cy]'"
-}
-
-proc getrect {x y} {
- list [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3]
-}
-
-proc showbox {} {
- global top tlbbox trbbox blbbox brbbox
-
- if { ! [.r hastag current currentbbox]} {
- if {[catch {.r find withtag current} item] } {
- return
- }
- set coords [.r transform $top [.r bbox current]]
- set xo [lindex $coords 0]
- set yo [lindex $coords 1]
- set xc [lindex $coords 2]
- set yc [lindex $coords 3]
-
- .r coords $tlbbox "$xo $yo"
- .r coords $trbbox "$xc $yo"
- .r coords $brbbox "$xc $yc"
- .r coords $blbbox "$xo $yc"
- .r itemconfigure currentbbox -visible t
- }
-}
-
-proc hidebox {lx ly} {
- set next [.r find closest $lx $ly]
- if {[llength $next] > 1} {
- set next [lindex $next 0]
- }
- if { $next == "" || ! [.r hastag $next currentbbox] ||\
- [.r hastag current currentbbox]} {
- .r itemconfigure currentbbox -visible f
- }
-}
-
-
-$zinc->bind('<ButtonPress-1>', "start_lasso %x %y");
-$zinc->bind('<ButtonRelease-1>', \&fin_lasso);
-$zinc->bind('<ButtonPress-2>', sub { $closest = $zinc->find('closest', %x %y);
- print "at point=$closest\n" });
-
-$zinc->bind('<ButtonPress-3>', "press %x %y motion");
-$zinc->bind('<ButtonRelease-3>', \&release);
-
-$zinc->bind('<Shift-ButtonPress-3>', "press %x %y zoom");
-$zinc->bind('<Shift-ButtonRelease-3>', \&release);
-
-$zinc->bind('<Control-ButtonPress-3>' "press %x %y rotate");
-$zinc->bind('<Control-ButtonRelease-3>', \&release);
-
-$zinc->bind('current', '<Enter>', \&showbox);
-$zinc->bind('current', '<Leave>', {hidebox %x %y});