From 960cdf29197bc3f5922110cf26627aa9709ac79b Mon Sep 17 00:00:00 2001
From: cvs2svn
Date: Fri, 10 Jun 2005 10:29:11 +0000
Subject: This commit was manufactured by cvs2svn to create branch 'bogue40'.

---
 sandbox/controls.tcl | 158 ---------------------------------------------------
 1 file changed, 158 deletions(-)
 delete mode 100644 sandbox/controls.tcl

(limited to 'sandbox/controls.tcl')

diff --git a/sandbox/controls.tcl b/sandbox/controls.tcl
deleted file mode 100644
index d865020..0000000
--- a/sandbox/controls.tcl
+++ /dev/null
@@ -1,158 +0,0 @@
-set tlbbox [.r add group $top -sensitive f -visible f -tags currentbbox]
-.r add rectangle $tlbbox "-3 -3 +3 +3"
-set trbbox [.r add group $top -sensitive f -visible f -tags currentbbox]
-.r add rectangle $trbbox "-3 -3 +3 +3"
-set blbbox [.r add group $top -sensitive f -visible f -tags currentbbox]
-.r add rectangle $blbbox "-3 -3 +3 +3"
-set brbbox [.r add group $top -sensitive f -visible f -tags currentbbox]
-.r add rectangle $brbbox "-3 -3 +3 +3"
-.r add rectangle $top "0 0 1 1" -linecolor red -tags "lasso" -visible f -sensitive f
-
-#
-# 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
-    }
-}
-
-
-bind  .r "<ButtonPress-1>" "start_lasso %x %y"
-bind  .r "<ButtonRelease-1>" fin_lasso
-
-bind  .r "<ButtonPress-2>" {puts "at point='[.r find closest %x %y]'"}
-
-bind  .r "<ButtonPress-3>" "press %x %y motion"
-bind  .r "<ButtonRelease-3>" release
-
-bind  .r "<Shift-ButtonPress-3>" "press %x %y zoom"
-bind  .r "<Shift-ButtonRelease-3>" release
-
-bind  .r "<Control-ButtonPress-3>" "press %x %y rotate"
-bind  .r "<Control-ButtonRelease-3>" release
-
-.r bind current "<Enter>" showbox
-.r bind current "<Leave>" {hidebox %x %y}
-- 
cgit v1.1