diff options
Diffstat (limited to 'sandbox/controls.pl')
| -rw-r--r-- | sandbox/controls.pl | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/sandbox/controls.pl b/sandbox/controls.pl new file mode 100644 index 0000000..fcddda5 --- /dev/null +++ b/sandbox/controls.pl @@ -0,0 +1,168 @@ +$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}); |