diff options
Diffstat (limited to 'demos/transforms.tcl')
-rw-r--r-- | demos/transforms.tcl | 413 |
1 files changed, 193 insertions, 220 deletions
diff --git a/demos/transforms.tcl b/demos/transforms.tcl index 3c6f5b6..c5222dd 100644 --- a/demos/transforms.tcl +++ b/demos/transforms.tcl @@ -80,20 +80,20 @@ tk_optionMenu $w.f.types itemType Rectangle Arc Curve Icon Tabular \ Text Track Triangles WayPoint grid $w.f.types -row 0 -column 1 -sticky w -button $w.f.add -text {Add item} -command addItem +button $w.f.add -text {Add item} -command "addItem $w.zinc" grid $w.f.add -row 0 -column 2 -padx 10 -sticky ew -button $w.f.addg -text {Add group} -command addGroup +button $w.f.addg -text {Add group} -command "addGroup $w.zinc" grid $w.f.addg -row 0 -column 3 -padx 10 -sticky ew -button $w.f.remove -text Remove -command removeItem +button $w.f.remove -text Remove -command "removeItem $w.zinc" grid $w.f.remove -row 0 -column 4 -padx 10 -sticky ew -checkbutton $w.f.cscale -text -composescale -command toggleComposeScale \ +checkbutton $w.f.cscale -text -composescale -command "toggleComposeScale $w.zinc" \ -variable composeScale grid $w.f.cscale -row 0 -column 6 -sticky w -checkbutton $w.f.crot -text -composesrotation -command toggleComposeRot \ +checkbutton $w.f.crot -text -composesrotation -command "toggleComposeRot $w.zinc" \ -variable composeRot grid $w.f.crot -row 1 -column 6 -sticky w @@ -101,57 +101,57 @@ grid $w.f.crot -row 1 -column 6 -sticky w set world [$w.zinc add group $top] set currentGroup $world $w.zinc add curve $top {0 0 80 0} -linewidth 3 \ - -linecolor $worldAxisColor -lastend {6 8 3} -tags "axis:$world" + -linecolor $worldAxisColor -lastend {6 8 3} -tags axis:$world $w.zinc add curve $top {0 0 0 80} -linewidth 3 \ - -linecolor $worldAxisColor -lastend {6 8 3} -tags "axis:$world" + -linecolor $worldAxisColor -lastend {6 8 3} -tags axis:$world $w.zinc add rectangle $top {-2 -2 2 2} -filled 1 \ -fillcolor $worldAxisColor -linecolor $worldAxisColor \ - -linewidth 3 -tags "axis:$world" + -linewidth 3 -tags axis:$world $w.zinc add text $top -text "This is the origin\nof the world" \ -anchor s -color $worldAxisColor -alignment center \ -tags [list "axis:$world" text] - - -bind $w.zinc <1> "mouseAdd Item %x %y" -bind $w.zinc <2> "mouseAdd Group %x %y" -bind $w.zinc <Up> moveUp -bind $w.zinc <Left> moveLeft -bind $w.zinc <Right> moveRight -bind $w.zinc <Down> moveDown -bind $w.zinc <minus> scaleDown -bind $w.zinc <KP_Subtract> scaleDown -bind $w.zinc <plus> scaleUp -bind $w.zinc <KP_Add> scaleUp -bind $w.zinc <Home> reset -bind $w.zinc <Shift-Home> resetChildren -bind $w.zinc <Control-Left> rotateLeft -bind $w.zinc <Control-Right> rotateRight -bind $w.zinc <Shift-Up> {swapAxis y} -bind $w.zinc <Shift-Down> {swapAxis y} -bind $w.zinc <Shift-Left> {swapAxis x} -bind $w.zinc <Shift-Right> {swapAxis x} -bind $w.zinc <Delete> deleteItem - -bind $w.zinc <Configure> "resize %w %h" +$w.zinc lower axis:$world + +bind $w.zinc <1> {mouseAdd %W Item %x %y} +bind $w.zinc <2> {mouseAdd %W Group %x %y} +bind $w.zinc <Up> {moveUp %W} +bind $w.zinc <Left> {moveLeft %W} +bind $w.zinc <Right> {moveRight %W} +bind $w.zinc <Down> {moveDown %W} +bind $w.zinc <minus> {scaleDown %W} +bind $w.zinc <KP_Subtract> {scaleDown %W} +bind $w.zinc <plus> {scaleUp %W} +bind $w.zinc <KP_Add> {scaleUp %W} +bind $w.zinc <Home> {reset %W} +bind $w.zinc <Shift-Home> {resetChildren %W} +bind $w.zinc <Control-Left> {rotateLeft %W} +bind $w.zinc <Control-Right> {rotateRight %W} +bind $w.zinc <Shift-Up> {swapAxis %W y} +bind $w.zinc <Shift-Down> {swapAxis %W y} +bind $w.zinc <Shift-Left> {swapAxis %W x} +bind $w.zinc <Shift-Right> {swapAxis %W x} +bind $w.zinc <Delete> {removeItem %W} + +bind $w.zinc <Configure> {resize %W %w %h} focus $w.zinc tk_focusFollowsMouse -proc resize {width height} { - global w world +proc resize {z width height} { + global world set x [expr $width/2] set y [expr $height/2] - $w.zinc treset $world - $w.zinc treset "axis:$world" - $w.zinc translate $world $x $y - $w.zinc translate "axis:$world" $x $y + $z treset $world + $z treset axis:$world + $z translate $world $x $y + $z translate axis:$world $x $y } -proc swapAxis {axis} { - global w currentItem +proc swapAxis {z axis} { + global currentItem set sx 1 set sy 1 @@ -161,361 +161,334 @@ proc swapAxis {axis} { set sy -1 } if {$currentItem != 0} { - $w.zinc scale $currentItem $sx $sy - $w.zinc scale "axisgrp:$currentItem" $sx $sy + $z scale $currentItem $sx $sy + $z scale axisgrp:$currentItem $sx $sy } } -proc toggleComposeRot {} { - global w currentItem composeRot +proc toggleComposeRot {z} { + global currentItem composeRot if {$currentItem != 0} { - $w.zinc itemconfigure $currentItem -composerotation $composeRot - $w.zinc itemconfigure "axisgrp:$currentItem" -composerotation $composeRot + $z itemconfigure $currentItem -composerotation $composeRot + $z itemconfigure axisgrp:$currentItem -composerotation $composeRot } } -proc toggleComposeScale {} { - global w currentItem composeScale +proc toggleComposeScale {z} { + global currentItem composeScale if {$currentItem != 0} { - $w.zinc itemconfigure $currentItem -composescale $composeScale - $w.zinc itemconfigure "axisgrp:$currentItem" -composescale $composeScale + $z itemconfigure $currentItem -composescale $composeScale + $z itemconfigure axisgrp:$currentItem -composescale $composeScale } } -proc deleteItem {} { - global w currentItem currentGroup world - +proc removeItem {z} { + global currentGroup currentItem world + if {$currentItem != 0} { - $w.zinc remove $currentItem - $w.zinc remove axisgrp:$currentItem - if { $currentGroup == $currentItem } { + $z remove $currentItem axisgrp:$currentItem + if {$currentItem == $currentGroup} { set currentGroup $world } set currentItem 0 + set composeScale 1 + set composeRot 1 } } -proc dragItem {x y} { - global w drag currentItem +proc dragItem {z x y} { + global drag currentItem set drag 1 if {$currentItem == 0} { return } - set group [$w.zinc group $currentItem] - foreach {x y} [$w.zinc transform $group "$x $y"] break + set group [$z group $currentItem] + foreach {x y} [$z transform $group [list $x $y]] break - $w.zinc treset $currentItem - $w.zinc treset "axisgrp:$currentItem" - $w.zinc translate $currentItem $x $y - $w.zinc translate "axisgrp:$currentItem" $x $y + $z treset $currentItem + $z treset axisgrp:$currentItem + $z translate $currentItem $x $y + $z translate axisgrp:$currentItem $x $y } -proc select {} { - global w - - foreach t [$w.zinc gettags current] { +proc select {z} { + foreach t [$z gettags current] { if {[regexp {^axis:(\d+)} $t m item]} { - changeItem $item + changeItem $z $item } } } -proc changeItem {item} { - global w currentItem currentGroup +proc changeItem {z item} { + global currentItem currentGroup global composeRot composeScale global drag activeAxisColor inactiveAxisColor if {($currentItem != 0) && !$drag} { - $w.zinc itemconfigure "axis:$currentItem && !text" \ + $z itemconfigure axis:$currentItem&&!text \ -linecolor $inactiveAxisColor -fillcolor $inactiveAxisColor - if {$currentItem != $currentGroup} { - $w.zinc itemconfigure "axis:$currentItem && !text" -linewidth 1 - } } if {($currentItem == 0) || ($item != $currentItem)} { - $w.zinc itemconfigure "axis:$item && !text" \ + $z itemconfigure axis:$item&&!text \ -linecolor $activeAxisColor -fillcolor $activeAxisColor -linewidth 3 set currentItem $item - set composeRot [$w.zinc itemcget $currentItem -composerotation] - $w.zinc itemconfigure "axisgrp:$currentItem" -composerotation $composeRot - set composeScale [$w.zinc itemcget $currentItem -composescale] - $w.zinc itemconfigure "axisgrp:$currentItem" -composescale $composeScale + set composeRot [$z itemcget $currentItem -composerotation] + $z itemconfigure axisgrp:$currentItem -composerotation $composeRot + set composeScale [$z itemcget $currentItem -composescale] + $z itemconfigure axisgrp:$currentItem -composescale $composeScale } elseif {!$drag} { set currentItem 0 set composeRot 1 set composeScale 1 } - set drag 0 } -proc selectGroup {} { - global w - - foreach t [$w.zinc gettags current] { +proc selectGroup {z} { + foreach t [$z gettags current] { if {[regexp {^axis:(\d+)} $t m item]} { - changeGroup $item + changeGroup $z $item + return } } } -proc changeGroup {grp} { - global w currentItem currentGroup world +proc changeGroup {z grp} { + global currentItem currentGroup world - changeItem $grp - $w.zinc itemconfigure "axis:$currentGroup && !text" -linewidth 1 + changeItem $z $grp if {$currentItem != 0} { set currentGroup $currentItem } else { set currentGroup $world } - - $w.zinc itemconfigure "axis:$currentGroup && !text" -linewidth 3 } -proc reset {} { - global w currentItem +proc reset {z } { + global currentItem if {$currentItem != 0} { - $w.zinc treset $currentItem - $w.zinc treset "axisgrp:$currentItem" + $z treset $currentItem + $z treset axisgrp:$currentItem } } -proc resetChildren {} { - global w currentItem +proc resetChildren {z} { + global currentItem - if {($currentItem != 0) && ([$w.zinc type $currentItem] == "group")} { - $w.zinc addtag rt withtag .$currentItem. - $w.zinc treset rt - $w.zinc dtag rt rt + if {($currentItem != 0) && ([$z type $currentItem] == "group")} { + $z addtag rt withtag .$currentItem. + $z treset rt + $z dtag rt rt } } -proc moveUp {} { - move 0 20 +proc moveUp {z} { + move $z 0 20 } -proc moveDown {} { - move 0 -20 +proc moveDown {z} { + move $z 0 -20 } -proc moveRight {} { - move 20 0 +proc moveRight {z} { + move $z 20 0 } -proc moveLeft {} { - move -20 0 +proc moveLeft {z} { + move $z -20 0 } -proc move {dx dy} { - global w currentItem +proc move {z dx dy} { + global currentItem if {$currentItem != 0} { - $w.zinc translate $currentItem $dx $dy - $w.zinc translate "axisgrp:$currentItem" $dx $dy + $z translate $currentItem $dx $dy + $z translate axisgrp:$currentItem $dx $dy } } -proc scaleUp {} { - scale 1.1 1.1 +proc scaleUp {z} { + scale $z 1.1 1.1 } -proc scaleDown {} { - scale 0.9 0.9 +proc scaleDown {z} { + scale $z 0.9 0.9 } -proc scale {dx dy} { - global w currentItem +proc scale {z dx dy} { + global currentItem if {$currentItem != 0} { - $w.zinc scale $currentItem $dx $dy - $w.zinc scale "axisgrp:$currentItem" $dx $dy + $z scale $currentItem $dx $dy + $z scale axisgrp:$currentItem $dx $dy } } -proc rotateLeft {} { - rotate [expr -3.14159/18] +proc rotateLeft {z} { + rotate $z [expr -3.14159/18] } -proc rotateRight {} { - rotate [expr 3.14159/18] +proc rotateRight {z} { + rotate $z [expr 3.14159/18] } -proc rotate {angle} { - global w currentItem +proc rotate {z angle} { + global currentItem if {$currentItem != 0} { - $w.zinc rotate $currentItem $angle - $w.zinc rotate "axisgrp:$currentItem" $angle + $z rotate $currentItem $angle + $z rotate axisgrp:$currentItem $angle } } -proc newRectangle {} { - global w currentGroup +proc newRectangle {z} { + global currentGroup - return [$w.zinc add rectangle $currentGroup {-15 -15 15 15} \ + return [$z add rectangle $currentGroup {-15 -15 15 15} \ -filled 1 -linewidth 0 -fillcolor tan] } -proc newArc {} { - global w currentGroup +proc newArc {z} { + global currentGroup - return [$w.zinc add arc $currentGroup {-25 -15 25 15} \ + return [$z add arc $currentGroup {-25 -15 25 15} \ -filled 1 -linewidth 0 -fillcolor tan] } -proc newCurve {} { - global w currentGroup +proc newCurve {z} { + global currentGroup - return [$w.zinc add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \ + return [$z add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \ -filled 1 -linewidth 0 -fillcolor tan] } -proc newText {} { - global w currentGroup +proc newText {z} { + global currentGroup - set item [$w.zinc add text $currentGroup -anchor s] - $w.zinc itemconfigure $item -text "Item id: $item" + set item [$z add text $currentGroup -anchor s] + $z itemconfigure $item -text "Item id: $item" return $item; } -proc newIcon {} { - global w currentGroup +proc newIcon {z} { + global currentGroup - return [$w.zinc add icon $currentGroup -image logo -anchor center] + return [$z add icon $currentGroup -image logo -anchor center] } -proc newTriangles {} { - global w currentGroup +proc newTriangles {z} { + global currentGroup - return [$w.zinc add triangles $currentGroup \ + return [$z add triangles $currentGroup \ {-25 15 -10 -15 5 15 20 -15 35 15 50 -30} \ -colors {tan wheat tan wheat}] } -proc newTrack {} { - global w currentGroup +proc newTrack {z} { + global currentGroup set labelformat {x80x50+0+0 a0a0^0^0 a0a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2} - set item [$w.zinc add track $currentGroup 6 -labelformat $labelformat \ + set item [$z add track $currentGroup 6 -labelformat $labelformat \ -speedvector {30 -15} -markersize 20] - $w.zinc itemconfigure $item 0 -filled 0 -bordercolor DarkGreen -border contour - $w.zinc itemconfigure $item 1 -filled 1 -backcolor gray60 -text AFR6128 - $w.zinc itemconfigure $item 2 -filled 0 -backcolor gray65 -text 390 - $w.zinc itemconfigure $item 3 -filled 0 -backcolor gray65 -text / - $w.zinc itemconfigure $item 4 -filled 0 -backcolor gray65 -text 350 - $w.zinc itemconfigure $item 5 -filled 0 -backcolor gray65 -text TUR + $z itemconfigure $item 0 -filled 0 -bordercolor DarkGreen -border contour + $z itemconfigure $item 1 -filled 1 -backcolor gray60 -text AFR6128 + $z itemconfigure $item 2 -filled 0 -backcolor gray65 -text 390 + $z itemconfigure $item 3 -filled 0 -backcolor gray65 -text / + $z itemconfigure $item 4 -filled 0 -backcolor gray65 -text 350 + $z itemconfigure $item 5 -filled 0 -backcolor gray65 -text TUR return $item; } -proc newWayPoint {} { - global w currentGroup +proc newWayPoint {z} { + global currentGroup set labelformat {a0a0+0+0 a0a0>0^1} - set item [$w.zinc add waypoint $currentGroup 2 -labelformat $labelformat] - $w.zinc itemconfigure $item 0 -filled 1 -backcolor DarkGreen -text TUR - $w.zinc itemconfigure $item 1 -text >>> + set item [$z add waypoint $currentGroup 2 -labelformat $labelformat] + $z itemconfigure $item 0 -filled 1 -backcolor DarkGreen -text TUR + $z itemconfigure $item 1 -text >>> return $item; } -proc newTabular {} { - global w currentGroup +proc newTabular {z} { + global currentGroup set labelformat {f700f600+0+0 f700a0^0^0 f700a0^0>1 \ f700a0^0>2 f700a0^0>3 f700a0^0>4 f700a0^0>5} - set item [$w.zinc add tabular $currentGroup 7 -labelformat $labelformat] - $w.zinc itemconfigure $item 0 -filled 1 -border contour \ + set item [$z add tabular $currentGroup 7 -labelformat $labelformat] + $z itemconfigure $item 0 -filled 1 -border contour \ -bordercolor black -backcolor gray60 - $w.zinc itemconfigure $item 1 -alignment center -text AFR6128 - $w.zinc itemconfigure $item 2 -alignment center -text 390 - $w.zinc itemconfigure $item 3 -alignment center -text 370 - $w.zinc itemconfigure $item 4 -alignment center -text 350 - $w.zinc itemconfigure $item 5 -alignment center -text 330 - $w.zinc itemconfigure $item 6 -alignment center -text TUR + $z itemconfigure $item 1 -alignment center -text AFR6128 + $z itemconfigure $item 2 -alignment center -text 390 + $z itemconfigure $item 3 -alignment center -text 370 + $z itemconfigure $item 4 -alignment center -text 350 + $z itemconfigure $item 5 -alignment center -text 330 + $z itemconfigure $item 6 -alignment center -text TUR return $item; } -proc addAxes {item length command inFront} { - global w currentGroup +proc addAxes {z item length command inFront} { + global currentGroup - set axesGroup [$w.zinc add group $currentGroup -tags "axisgrp:$item"] - $w.zinc add curve $axesGroup "0 0 $length 0" -linewidth 2 \ - -lastend {6 8 3} -tags "axis:$item" - $w.zinc add curve $axesGroup "0 0 0 $length" -linewidth 2 \ - -lastend {6 8 3} -tags "axis:$item" - $w.zinc add rectangle $axesGroup {-2 -2 2 2} -filled 1 \ - -linewidth 0 -composescale 0 -tags "axis:$item" + set axesGroup [$z add group $currentGroup -tags axisgrp:$item] + $z add curve $axesGroup [list 0 0 $length 0] -linewidth 3 \ + -lastend {6 8 3} -tags axis:$item + $z add curve $axesGroup [list 0 0 0 $length] -linewidth 3 \ + -lastend {6 8 3} -tags axis:$item + $z add rectangle $axesGroup {-3 -3 3 3} -filled 1 \ + -linewidth 0 -composescale 0 -tags axis:$item if {$inFront} { - $w.zinc raise $item $axesGroup + $z raise $item $axesGroup } - $w.zinc bind "axis:$item" <B1-Motion> "dragItem %x %y" - $w.zinc bind "axis:$item" <ButtonRelease-1> $command + $z bind axis:$item <B1-Motion> {dragItem %W %x %y} + $z bind axis:$item <ButtonRelease-1> "$command %W; set drag 0" } -proc addItem {} { +proc addItem {z} { global itemType set length 25 set itemOnTop 0 - set item [eval "new$itemType"] + set item [eval "new$itemType $z"] if {($itemType == "Track") || ($itemType == "WayPoint")} { set itemOnTop 1 } - addAxes $item 25 select $itemOnTop - changeItem $item + addAxes $z $item 25 select $itemOnTop + changeItem $z $item } -proc addGroup {} { - global w currentGroup +proc addGroup {z} { + global currentGroup - set item [$w.zinc add group $currentGroup] + set item [$z add group $currentGroup] - addAxes $item 80 selectGroup 1 - changeGroup $item + addAxes $z $item 80 selectGroup 1 + changeGroup $z $item } -proc mouseAdd {itemOrGroup x y} { - global w currentGroup currentItem - - foreach {x y} [$w.zinc transform $currentGroup "$x $y"] break - set item [$w.zinc find withtag current] +proc mouseAdd {z itemOrGroup x y} { + global currentGroup currentItem - if {[llength $item] != 0} { - foreach t [$w.zinc gettags [lindex $item 0]] { - if {[regexp {^axis} $t]} { - return; - } - } + if {[llength [$z find withtag current]] != 0} { + return } - eval "add$itemOrGroup" + foreach {x y} [$z transform $currentGroup [list $x $y]] break - $w.zinc translate $currentItem $x $y - $w.zinc translate "axisgrp:$currentItem" $x $y -} + eval "add$itemOrGroup $z" -proc removeItem {} { - global w currentGroup currentItem world - - if {$currentItem != 0} { - $w.zinc remove $currentItem "axisgrp:$currentItem" - if {$currentItem == $currentGroup} { - set currentGroup $world - } - set currentItem 0 - set composeScale 1 - set composeRot 1 - } + $z translate $currentItem $x $y + $z translate axisgrp:$currentItem $x $y } + |