diff options
Diffstat (limited to 'library/demos/arrow.tcl')
| -rw-r--r-- | library/demos/arrow.tcl | 124 |
1 files changed, 63 insertions, 61 deletions
diff --git a/library/demos/arrow.tcl b/library/demos/arrow.tcl index 5011f6f..af367f1 100644 --- a/library/demos/arrow.tcl +++ b/library/demos/arrow.tcl @@ -18,13 +18,13 @@ package require Tk # Arguments: # c - Name of the canvas widget. -proc arrowSetup c { +proc arrowSetup {c} { upvar #0 demo_arrowInfo v # Remember the current box, if there is one. set tags [$c gettags current] - if {$tags != ""} { + if {$tags ne ""} { set cur [lindex $tags [lsearch -glob $tags box?]] } else { set cur "" @@ -33,81 +33,81 @@ proc arrowSetup c { # Create the arrow and outline. $c delete all - eval {$c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \ - -width [expr {10*$v(width)}] -arrowshape [list \ - [expr {10*$v(a)}] [expr {10*$v(b)}] [expr {10*$v(c)}]]} \ - $v(bigLineStyle) - set xtip [expr {$v(x2)-10*$v(b)}] - set deltaY [expr {10*$v(c)+5*$v(width)}] - $c create line $v(x2) $v(y) $xtip [expr {$v(y)+$deltaY}] \ - [expr {$v(x2)-10*$v(a)}] $v(y) $xtip [expr {$v(y)-$deltaY}] \ + $c create line $v(x1) $v(y) $v(x2) $v(y) -arrow last \ + -width [expr {10 * $v(width)}] \ + -arrowshape [list [expr {10 * $v(a)}] [expr {10 * $v(b)}] [expr {10 * $v(c)}]] \ + {*}$v(bigLineStyle) + set xtip [expr {$v(x2) - (10 * $v(b))}] + set deltaY [expr {(10 * $v(c)) + (5 * $v(width))}] + $c create line $v(x2) $v(y) $xtip [expr {$v(y) + $deltaY}] \ + [expr {$v(x2) - (10 * $v(a))}] $v(y) $xtip [expr {$v(y) - $deltaY}] \ $v(x2) $v(y) -width 2 -capstyle round -joinstyle round # Create the boxes for reshaping the line and arrowhead. - eval {$c create rect [expr {$v(x2)-10*$v(a)-5}] [expr {$v(y)-5}] \ - [expr {$v(x2)-10*$v(a)+5}] [expr {$v(y)+5}] \ - -tags {box1 box}} $v(boxStyle) - eval {$c create rect [expr {$xtip-5}] [expr {$v(y)-$deltaY-5}] \ - [expr {$xtip+5}] [expr {$v(y)-$deltaY+5}] \ - -tags {box2 box}} $v(boxStyle) - eval {$c create rect [expr {$v(x1)-5}] [expr {$v(y)-5*$v(width)-5}] \ - [expr {$v(x1)+5}] [expr {$v(y)-5*$v(width)+5}] \ - -tags {box3 box}} $v(boxStyle) - if {$cur != ""} { - eval $c itemconfigure $cur $v(activeStyle) + $c create rect [expr {$v(x2) - (10 * $v(a)) - 5}] [expr {$v(y) - 5}] \ + [expr {$v(x2) - (10 * $v(a)) + 5}] [expr {$v(y) + 5}] \ + -tags {box1 box} {*}$v(boxStyle) + $c create rect [expr {$xtip - 5}] [expr {$v(y) - $deltaY - 5}] \ + [expr {$xtip + 5}] [expr {($v(y) - $deltaY) + 5}] \ + -tags {box2 box} {*}$v(boxStyle) + $c create rect [expr {$v(x1) - 5}] [expr {$v(y) - (5 * $v(width)) - 5}] \ + [expr {$v(x1) + 5}] [expr {$v(y) - (5 * $v(width)) + 5}] \ + -tags {box3 box} {*}$v(boxStyle) + if {$cur ne ""} { + $c itemconfigure $cur {*}$v(activeStyle) } # Create three arrows in actual size with the same parameters - $c create line [expr {$v(x2)+50}] 0 [expr {$v(x2)+50}] 1000 \ + $c create line [expr {$v(x2) + 50}] 0 [expr {$v(x2) + 50}] 1000 \ -width 2 - set tmp [expr {$v(x2)+100}] - $c create line $tmp [expr {$v(y)-125}] $tmp [expr {$v(y)-75}] \ + set tmp [expr {$v(x2) + 100}] + $c create line $tmp [expr {$v(y) - 125}] $tmp [expr {$v(y) - 75}] \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr {$tmp-25}] $v(y) [expr {$tmp+25}] $v(y) \ + $c create line [expr {$tmp - 25}] $v(y) [expr {$tmp + 25}] $v(y) \ -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" - $c create line [expr {$tmp-25}] [expr {$v(y)+75}] [expr {$tmp+25}] \ - [expr {$v(y)+125}] -width $v(width) \ + $c create line [expr {$tmp - 25}] [expr {$v(y) + 75}] [expr {$tmp + 25}] \ + [expr {$v(y) + 125}] -width $v(width) \ -arrow both -arrowshape "$v(a) $v(b) $v(c)" # Create a bunch of other arrows and text items showing the # current dimensions. - set tmp [expr {$v(x2)+10}] - $c create line $tmp [expr {$v(y)-5*$v(width)}] \ - $tmp [expr {$v(y)-$deltaY}] \ + set tmp [expr {$v(x2) + 10}] + $c create line $tmp [expr {$v(y) - (5 * $v(width))}] \ + $tmp [expr {$v(y) - $deltaY}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)+15}] [expr {$v(y)-$deltaY+5*$v(c)}] \ + $c create text [expr {$v(x2) + 15}] [expr {($v(y) - $deltaY) + (5 * $v(c))}] \ -text $v(c) -anchor w - set tmp [expr {$v(x1)-10}] - $c create line $tmp [expr {$v(y)-5*$v(width)}] \ - $tmp [expr {$v(y)+5*$v(width)}] \ + set tmp [expr {$v(x1) - 10}] + $c create line $tmp [expr {$v(y) - (5 * $v(width))}] \ + $tmp [expr {$v(y) + (5 * $v(width))}] \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x1)-15}] $v(y) -text $v(width) -anchor e - set tmp [expr {$v(y)+5*$v(width)+10*$v(c)+10}] - $c create line [expr {$v(x2)-10*$v(a)}] $tmp $v(x2) $tmp \ + $c create text [expr {$v(x1) - 15}] $v(y) -text $v(width) -anchor e + set tmp [expr {$v(y) + (5 * $v(width)) + (10 * $v(c)) + 10}] + $c create line [expr {$v(x2) - (10 * $v(a))}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)-5*$v(a)}] [expr {$tmp+5}] \ + $c create text [expr {$v(x2) - (5 * $v(a))}] [expr {$tmp + 5}] \ -text $v(a) -anchor n - set tmp [expr {$tmp+25}] - $c create line [expr {$v(x2)-10*$v(b)}] $tmp $v(x2) $tmp \ + set tmp [expr {$tmp + 25}] + $c create line [expr {$v(x2) - (10 * $v(b))}] $tmp $v(x2) $tmp \ -arrow both -arrowshape $v(smallTips) - $c create text [expr {$v(x2)-5*$v(b)}] [expr {$tmp+5}] \ + $c create text [expr {$v(x2) - (5 * $v(b))}] [expr {$tmp + 5}] \ -text $v(b) -anchor n $c create text $v(x1) 310 -text "-width $v(width)" \ - -anchor w -font {Helvetica 18} + -anchor w -font "Helvetica 18" $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \ - -anchor w -font {Helvetica 18} + -anchor w -font "Helvetica 18" incr v(count) } set w .arrow -catch {destroy $w} +destroy $w toplevel $w wm title $w "Arrowhead Editor Demonstration" wm iconname $w "arrow" @@ -124,16 +124,18 @@ pack $btns -side bottom -fill x canvas $c -width 500 -height 350 -relief sunken -borderwidth 2 pack $c -expand yes -fill both -set demo_arrowInfo(a) 8 -set demo_arrowInfo(b) 10 -set demo_arrowInfo(c) 3 -set demo_arrowInfo(width) 2 -set demo_arrowInfo(motionProc) arrowMoveNull -set demo_arrowInfo(x1) 40 -set demo_arrowInfo(x2) 350 -set demo_arrowInfo(y) 150 -set demo_arrowInfo(smallTips) {5 5 2} -set demo_arrowInfo(count) 0 +array set demo_arrowInfo { + a 8 + b 10 + c 3 + width 2 + motionProc arrowMoveNull + x1 40 + x2 350 + y 150 + smallTips "5 5 2" + count 0 +} if {[winfo depth $c] > 1} { set demo_arrowInfo(bigLineStyle) "-fill SkyBlue1" set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1" @@ -167,7 +169,7 @@ bind $c <Any-ButtonRelease-1> "arrowSetup $c" proc arrowMove1 {c x y} { upvar #0 demo_arrowInfo v - set newA [expr {($v(x2)+5-round([$c canvasx $x]))/10}] + set newA [expr {(($v(x2) + 5) - ( round ([$c canvasx $x]))) / 10}] if {$newA < 0} { set newA 0 } @@ -175,7 +177,7 @@ proc arrowMove1 {c x y} { set newA 25 } if {$newA != $v(a)} { - $c move box1 [expr {10*($v(a)-$newA)}] 0 + $c move box1 [expr {10 * ($v(a) - $newA)}] 0 set v(a) $newA } } @@ -191,14 +193,14 @@ proc arrowMove1 {c x y} { proc arrowMove2 {c x y} { upvar #0 demo_arrowInfo v - set newB [expr {($v(x2)+5-round([$c canvasx $x]))/10}] + set newB [expr {(($v(x2) + 5) - ( round ([$c canvasx $x]))) / 10}] if {$newB < 0} { set newB 0 } if {$newB > 25} { set newB 25 } - set newC [expr {($v(y)+5-round([$c canvasy $y])-5*$v(width))/10}] + set newC [expr {(($v(y) + 5) - ( round ([$c canvasy $y])) - (5 * $v(width))) / 10}] if {$newC < 0} { set newC 0 } @@ -206,7 +208,7 @@ proc arrowMove2 {c x y} { set newC 20 } if {($newB != $v(b)) || ($newC != $v(c))} { - $c move box2 [expr {10*($v(b)-$newB)}] [expr {10*($v(c)-$newC)}] + $c move box2 [expr {10 * ($v(b) - $newB)}] [expr {10 * ($v(c) - $newC)}] set v(b) $newB set v(c) $newC } @@ -223,7 +225,7 @@ proc arrowMove2 {c x y} { proc arrowMove3 {c x y} { upvar #0 demo_arrowInfo v - set newWidth [expr {($v(y)+2-round([$c canvasy $y]))/5}] + set newWidth [expr {(($v(y) + 2) - ( round ([$c canvasy $y]))) / 5}] if {$newWidth < 0} { set newWidth 0 } @@ -231,7 +233,7 @@ proc arrowMove3 {c x y} { set newWidth 20 } if {$newWidth != $v(width)} { - $c move box3 0 [expr {5*($v(width)-$newWidth)}] + $c move box3 0 [expr {5 * ($v(width) - $newWidth)}] set v(width) $newWidth } } |