diff options
author | lecoanet | 2004-05-07 10:51:56 +0000 |
---|---|---|
committer | lecoanet | 2004-05-07 10:51:56 +0000 |
commit | 0c518c95e4d1c3270fbc67143a6351ee81bb68f0 (patch) | |
tree | 3801ddfa41a67c88f216698d1e96257c2ee2a598 /demos/transforms.tcl | |
parent | 1761ee2e8ad9f23ef9231ec9952c25ab2ac88439 (diff) | |
download | tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.zip tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.gz tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.bz2 tkzinc-0c518c95e4d1c3270fbc67143a6351ee81bb68f0.tar.xz |
Switched from pack to grid; Demos are put in a namespace
Diffstat (limited to 'demos/transforms.tcl')
-rw-r--r-- | demos/transforms.tcl | 816 |
1 files changed, 414 insertions, 402 deletions
diff --git a/demos/transforms.tcl b/demos/transforms.tcl index c5222dd..9588044 100644 --- a/demos/transforms.tcl +++ b/demos/transforms.tcl @@ -11,484 +11,496 @@ if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } -set w .transforms -catch {destroy $w} -toplevel $w -wm title $w "Zinc Transformation Demonstration" -wm iconname $w Transformation - -set defaultfont [font create -family Helvetica -size 10 -weight bold] - -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 - - -########################################### -# Text zone -########################################### -text $w.text -relief sunken -borderwidth 2 -setgrid true -height 12 - -pack $w.text -expand yes -fill x - -$w.text insert 0.0 {Items are always added to the current group. -The available commands are: - Button 1 on the background, add an item with initial translation - Button 2 on the background, add a group with initial translation - Button 1 on item/group axes, select/deselect that item coordinates - Drag Button 1 on item/group axes, translate that item coordinates - Home reset the transformation - Shift-Home reset a group direct children transformations - +/- scale the selected item up/down - Ctrl-Left/Right rotate the selected item right/left - Shift-Up/Down swap the selected item Y axis - Shift-Left/Right swap the selected item X axis - 4 arrows translate in the 4 directions - Delete destroy the selected item} -$w.text configure -state disabled - -########################################### -# Zinc -########################################### -set zinc_width 600 -set zinc_height 500; -zinc $w.zinc -width $zinc_width -height $zinc_height \ - -font 10x20 -borderwidth 3 -relief sunken -takefocus 1 -render 0 -pack $w.zinc -expand y -fill both - - -set top 1 - -set inactiveAxisColor blue -set activeAxisColor red -set worldAxisColor \#a5a5a5 - -set composeRot 1 -set composeScale 1 -set drag 0 -set itemType Rectangle -set currentItem 0 - -image create photo logo -file [file join $zinc_library demos images zinc.gif] - -frame $w.f -pack $w.f -expand 0 -fill x - -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 $w.zinc" -grid $w.f.add -row 0 -column 2 -padx 10 -sticky ew - -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 $w.zinc" -grid $w.f.remove -row 0 -column 4 -padx 10 -sticky ew - -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 $w.zinc" \ - -variable composeRot -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 -$w.zinc add curve $top {0 0 0 80} -linewidth 3 \ - -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 -$w.zinc add text $top -text "This is the origin\nof the world" \ - -anchor s -color $worldAxisColor -alignment center \ - -tags [list "axis:$world" text] -$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 {z width height} { - global world - - set x [expr $width/2] - set y [expr $height/2] - - $z treset $world - $z treset axis:$world - $z translate $world $x $y - $z translate axis:$world $x $y -} +namespace eval transforms { + variable w .transforms + catch {destroy $w} + toplevel $w + wm title $w "Zinc Transformation Demonstration" + wm iconname $w Transformation + + variable defaultfont [font create -family Helvetica -size 10 -weight bold] + + grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 3 -column 0 -pady 10 + grid [button $w.code -text "See Code" -command "showCode $w"] -row 3 -column 1 -pady 10 + + + ########################################### + # Text zone + ########################################### + grid [text $w.text -relief sunken -borderwidth 2 -setgrid true -height 12] \ + -row 0 -column 0 -columnspan 2 -sticky ew + + $w.text insert 0.0 {Items are always added to the current group. + The available commands are: + Button 1 on the background, add an item with initial translation + Button 2 on the background, add a group with initial translation + Button 1 on item/group axes, select/deselect that item coordinates + Drag Button 1 on item/group axes, translate that item coordinates + Home reset the transformation + Shift-Home reset a group direct children transformations + +/- scale the selected item up/down + Ctrl-Left/Right rotate the selected item right/left + Shift-Up/Down swap the selected item Y axis + Shift-Left/Right swap the selected item X axis + 4 arrows translate in the 4 directions + Delete destroy the selected item} + $w.text configure -state disabled + + ########################################### + # Zinc + ########################################### + variable zincWidth 600 + variable zincHeight 500 + + grid [zinc $w.zinc -width $zincWidth -height $zincHeight \ + -font 10x20 -borderwidth 3 -relief sunken -takefocus 1 -render 0] \ + -row 1 -column 0 -columnspan 2 -sticky news + grid columnconfigure $w 0 -weight 1 + grid columnconfigure $w 1 -weight 1 + grid rowconfigure $w 1 -weight 2 + + variable top 1 + + variable inactiveAxisColor blue + variable activeAxisColor red + variable worldAxisColor \#a5a5a5 + + variable composeRot 1 + variable composeScale 1 + variable drag 0 + variable itemType Rectangle + variable currentItem 0 + + image create photo logo -file [file join $zinc_library demos images zinc.gif] + + grid [frame $w.f] -row 2 -column 0 -columnspan 2 -sticky w + + 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 "::transforms::addItem $w.zinc" + grid $w.f.add -row 0 -column 2 -padx 10 -sticky ew + + button $w.f.addg -text {Add group} -command "::transforms::addGroup $w.zinc" + grid $w.f.addg -row 0 -column 3 -padx 10 -sticky ew + + button $w.f.remove -text Remove -command "::transforms::removeItem $w.zinc" + grid $w.f.remove -row 0 -column 4 -padx 10 -sticky ew + + checkbutton $w.f.cscale -text -composescale -command "::transforms::toggleComposeScale $w.zinc" \ + -variable ::transforms::composeScale + grid $w.f.cscale -row 0 -column 6 -sticky w + + checkbutton $w.f.crot -text -composesrotation -command "::transforms::toggleComposeRot $w.zinc" \ + -variable ::transforms::composeRot + grid $w.f.crot -row 1 -column 6 -sticky w + + + variable world [$w.zinc add group $top] + variable currentGroup $world + $w.zinc add curve $top {0 0 80 0} -linewidth 3 \ + -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 + $w.zinc add rectangle $top {-2 -2 2 2} -filled 1 \ + -fillcolor $worldAxisColor -linecolor $worldAxisColor \ + -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] + $w.zinc lower axis:$world + + bind $w.zinc <1> {::transforms::mouseAdd %W Item %x %y} + bind $w.zinc <2> {::transforms::mouseAdd %W Group %x %y} + bind $w.zinc <Up> {::transforms::moveUp %W} + bind $w.zinc <Left> {::transforms::moveLeft %W} + bind $w.zinc <Right> {::transforms::moveRight %W} + bind $w.zinc <Down> {::transforms::moveDown %W} + bind $w.zinc <minus> {::transforms::scaleDown %W} + bind $w.zinc <KP_Subtract> {::transforms::scaleDown %W} + bind $w.zinc <plus> {::transforms::scaleUp %W} + bind $w.zinc <KP_Add> {::transforms::scaleUp %W} + bind $w.zinc <Home> {::transforms::reset %W} + bind $w.zinc <Shift-Home> {::transforms::resetChildren %W} + bind $w.zinc <Control-Left> {::transforms::rotateLeft %W} + bind $w.zinc <Control-Right> {::transforms::rotateRight %W} + bind $w.zinc <Shift-Up> {::transforms::swapAxis %W y} + bind $w.zinc <Shift-Down> {::transforms::swapAxis %W y} + bind $w.zinc <Shift-Left> {::transforms::swapAxis %W x} + bind $w.zinc <Shift-Right> {::transforms::swapAxis %W x} + bind $w.zinc <Delete> {::transforms::removeItem %W} + + bind $w.zinc <Configure> {::transforms::resize %W %w %h} + + focus $w.zinc + tk_focusFollowsMouse + + + proc resize {z width height} { + variable world + + set x [expr $width/2] + set y [expr $height/2] + + $z treset $world + $z treset axis:$world + $z translate $world $x $y + $z translate axis:$world $x $y + } -proc swapAxis {z axis} { - global currentItem + proc swapAxis {z axis} { + variable currentItem - set sx 1 - set sy 1 - if { $axis eq "x" } { - set sx -1 - } elseif { $axis eq "y" } { - set sy -1 - } - if {$currentItem != 0} { - $z scale $currentItem $sx $sy - $z scale axisgrp:$currentItem $sx $sy + set sx 1 + set sy 1 + if { $axis eq "x" } { + set sx -1 + } elseif { $axis eq "y" } { + set sy -1 + } + if {$currentItem != 0} { + $z scale $currentItem $sx $sy + $z scale axisgrp:$currentItem $sx $sy + } } -} -proc toggleComposeRot {z} { - global currentItem composeRot + proc toggleComposeRot {z} { + variable currentItem + variable composeRot - if {$currentItem != 0} { - $z itemconfigure $currentItem -composerotation $composeRot - $z itemconfigure axisgrp:$currentItem -composerotation $composeRot - } -} + if {$currentItem != 0} { + $z itemconfigure $currentItem -composerotation $composeRot + $z itemconfigure axisgrp:$currentItem -composerotation $composeRot + } + } -proc toggleComposeScale {z} { - global currentItem composeScale - - if {$currentItem != 0} { - $z itemconfigure $currentItem -composescale $composeScale - $z itemconfigure axisgrp:$currentItem -composescale $composeScale + proc toggleComposeScale {z} { + variable currentItem + variable composeScale + + if {$currentItem != 0} { + $z itemconfigure $currentItem -composescale $composeScale + $z itemconfigure axisgrp:$currentItem -composescale $composeScale + } } -} -proc removeItem {z} { - global currentGroup currentItem world - - if {$currentItem != 0} { - $z remove $currentItem axisgrp:$currentItem - if {$currentItem == $currentGroup} { - set currentGroup $world + proc removeItem {z} { + variable currentGroup + variable currentItem + variable world + + if {$currentItem != 0} { + $z remove $currentItem axisgrp:$currentItem + if {$currentItem == $currentGroup} { + set currentGroup $world + } + set currentItem 0 + set composeScale 1 + set composeRot 1 } - set currentItem 0 - set composeScale 1 - set composeRot 1 } -} -proc dragItem {z x y} { - global drag currentItem - - set drag 1 - if {$currentItem == 0} { - return - } - - set group [$z group $currentItem] - foreach {x y} [$z transform $group [list $x $y]] break - - $z treset $currentItem - $z treset axisgrp:$currentItem - $z translate $currentItem $x $y - $z translate axisgrp:$currentItem $x $y -} + proc dragItem {z x y} { + variable drag + variable currentItem -proc select {z} { - foreach t [$z gettags current] { - if {[regexp {^axis:(\d+)} $t m item]} { - changeItem $z $item + set drag 1 + if {$currentItem == 0} { + return } + + set group [$z group $currentItem] + foreach {x y} [$z transform $group [list $x $y]] break + + $z treset $currentItem + $z treset axisgrp:$currentItem + $z translate $currentItem $x $y + $z translate axisgrp:$currentItem $x $y } -} -proc changeItem {z item} { - global currentItem currentGroup - global composeRot composeScale - global drag activeAxisColor inactiveAxisColor - - if {($currentItem != 0) && !$drag} { - $z itemconfigure axis:$currentItem&&!text \ - -linecolor $inactiveAxisColor -fillcolor $inactiveAxisColor - } - if {($currentItem == 0) || ($item != $currentItem)} { - $z itemconfigure axis:$item&&!text \ - -linecolor $activeAxisColor -fillcolor $activeAxisColor -linewidth 3 - set currentItem $item - 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 + proc select {z} { + foreach t [$z gettags current] { + if {[regexp {^axis:(\d+)} $t m item]} { + changeItem $z $item + } + } } -} -proc selectGroup {z} { - foreach t [$z gettags current] { - if {[regexp {^axis:(\d+)} $t m item]} { - changeGroup $z $item - return + proc changeItem {z item} { + variable currentItem + variable currentGroup + variable composeRot + variable composeScale + variable drag + variable activeAxisColor + variable inactiveAxisColor + + if {($currentItem != 0) && !$drag} { + $z itemconfigure axis:$currentItem&&!text \ + -linecolor $inactiveAxisColor -fillcolor $inactiveAxisColor + } + if {($currentItem == 0) || ($item != $currentItem)} { + $z itemconfigure axis:$item&&!text \ + -linecolor $activeAxisColor -fillcolor $activeAxisColor -linewidth 3 + set currentItem $item + 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 } } -} -proc changeGroup {z grp} { - global currentItem currentGroup world - - changeItem $z $grp - if {$currentItem != 0} { - set currentGroup $currentItem - } else { - set currentGroup $world + proc selectGroup {z} { + foreach t [$z gettags current] { + if {[regexp {^axis:(\d+)} $t m item]} { + changeGroup $z $item + return + } + } } -} -proc reset {z } { - global currentItem - - if {$currentItem != 0} { - $z treset $currentItem - $z treset axisgrp:$currentItem + proc changeGroup {z grp} { + variable currentItem + variable currentGroup + variable world + + changeItem $z $grp + if {$currentItem != 0} { + set currentGroup $currentItem + } else { + set currentGroup $world + } } -} -proc resetChildren {z} { - global currentItem + proc reset {z } { + variable currentItem - if {($currentItem != 0) && ([$z type $currentItem] == "group")} { - $z addtag rt withtag .$currentItem. - $z treset rt - $z dtag rt rt + if {$currentItem != 0} { + $z treset $currentItem + $z treset axisgrp:$currentItem + } } -} -proc moveUp {z} { - move $z 0 20 -} - -proc moveDown {z} { - move $z 0 -20 -} + proc resetChildren {z} { + variable currentItem -proc moveRight {z} { - move $z 20 0 -} + if {($currentItem != 0) && ([$z type $currentItem] == "group")} { + $z addtag rt withtag .$currentItem. + $z treset rt + $z dtag rt rt + } + } -proc moveLeft {z} { - move $z -20 0 -} + proc moveUp {z} { + move $z 0 20 + } -proc move {z dx dy} { - global currentItem + proc moveDown {z} { + move $z 0 -20 + } - if {$currentItem != 0} { - $z translate $currentItem $dx $dy - $z translate axisgrp:$currentItem $dx $dy + proc moveRight {z} { + move $z 20 0 } -} -proc scaleUp {z} { - scale $z 1.1 1.1 -} + proc moveLeft {z} { + move $z -20 0 + } -proc scaleDown {z} { - scale $z 0.9 0.9 -} + proc move {z dx dy} { + variable currentItem -proc scale {z dx dy} { - global currentItem + if {$currentItem != 0} { + $z translate $currentItem $dx $dy + $z translate axisgrp:$currentItem $dx $dy + } + } - if {$currentItem != 0} { - $z scale $currentItem $dx $dy - $z scale axisgrp:$currentItem $dx $dy + proc scaleUp {z} { + scale $z 1.1 1.1 } -} -proc rotateLeft {z} { - rotate $z [expr -3.14159/18] -} + proc scaleDown {z} { + scale $z 0.9 0.9 + } -proc rotateRight {z} { - rotate $z [expr 3.14159/18] -} + proc scale {z dx dy} { + variable currentItem -proc rotate {z angle} { - global currentItem - - if {$currentItem != 0} { - $z rotate $currentItem $angle - $z rotate axisgrp:$currentItem $angle + if {$currentItem != 0} { + $z scale $currentItem $dx $dy + $z scale axisgrp:$currentItem $dx $dy + } } -} -proc newRectangle {z} { - global currentGroup + proc rotateLeft {z} { + rotate $z [expr -3.14159/18] + } - return [$z add rectangle $currentGroup {-15 -15 15 15} \ - -filled 1 -linewidth 0 -fillcolor tan] -} + proc rotateRight {z} { + rotate $z [expr 3.14159/18] + } -proc newArc {z} { - global currentGroup + proc rotate {z angle} { + variable currentItem + + if {$currentItem != 0} { + $z rotate $currentItem $angle + $z rotate axisgrp:$currentItem $angle + } + } - return [$z add arc $currentGroup {-25 -15 25 15} \ - -filled 1 -linewidth 0 -fillcolor tan] -} + proc newRectangle {z} { + variable currentGroup -proc newCurve {z} { - global currentGroup + return [$z add rectangle $currentGroup {-15 -15 15 15} \ + -filled 1 -linewidth 0 -fillcolor tan] + } - return [$z add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \ - -filled 1 -linewidth 0 -fillcolor tan] -} + proc newArc {z} { + variable currentGroup -proc newText {z} { - global currentGroup + return [$z add arc $currentGroup {-25 -15 25 15} \ + -filled 1 -linewidth 0 -fillcolor tan] + } - set item [$z add text $currentGroup -anchor s] - $z itemconfigure $item -text "Item id: $item" - return $item; -} + proc newCurve {z} { + variable currentGroup -proc newIcon {z} { - global currentGroup + return [$z add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \ + -filled 1 -linewidth 0 -fillcolor tan] + } - return [$z add icon $currentGroup -image logo -anchor center] -} + proc newText {z} { + variable currentGroup -proc newTriangles {z} { - global currentGroup + set item [$z add text $currentGroup -anchor s] + $z itemconfigure $item -text "Item id: $item" + return $item; + } - return [$z add triangles $currentGroup \ - {-25 15 -10 -15 5 15 20 -15 35 15 50 -30} \ - -colors {tan wheat tan wheat}] -} + proc newIcon {z} { + variable 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 [$z add track $currentGroup 6 -labelformat $labelformat \ - -speedvector {30 -15} -markersize 20] - $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; -} + return [$z add icon $currentGroup -image logo -anchor center] + } -proc newWayPoint {z} { - global currentGroup + proc newTriangles {z} { + variable currentGroup - set labelformat {a0a0+0+0 a0a0>0^1} + return [$z add triangles $currentGroup \ + {-25 15 -10 -15 5 15 20 -15 35 15 50 -30} \ + -colors {tan wheat tan wheat}] + } - set item [$z add waypoint $currentGroup 2 -labelformat $labelformat] - $z itemconfigure $item 0 -filled 1 -backcolor DarkGreen -text TUR - $z itemconfigure $item 1 -text >>> + proc newTrack {z} { + variable currentGroup + + set labelformat {x80x50+0+0 a0a0^0^0 a0a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2} + + set item [$z add track $currentGroup 6 -labelformat $labelformat \ + -speedvector {30 -15} -markersize 20] + $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; + } - return $item; -} + proc newWayPoint {z} { + variable currentGroup -proc newTabular {z} { - global currentGroup + set labelformat {a0a0+0+0 a0a0>0^1} - 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 [$z add waypoint $currentGroup 2 -labelformat $labelformat] + $z itemconfigure $item 0 -filled 1 -backcolor DarkGreen -text TUR + $z itemconfigure $item 1 -text >>> - set item [$z add tabular $currentGroup 7 -labelformat $labelformat] - $z itemconfigure $item 0 -filled 1 -border contour \ - -bordercolor black -backcolor gray60 - $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; + } - return $item; -} + proc newTabular {z} { + variable currentGroup -proc addAxes {z item length command inFront} { - global currentGroup - - 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} { - $z raise $item $axesGroup - } - $z bind axis:$item <B1-Motion> {dragItem %W %x %y} - $z bind axis:$item <ButtonRelease-1> "$command %W; set drag 0" -} + set labelformat {f700f600+0+0 f700a0^0^0 f700a0^0>1 \ + f700a0^0>2 f700a0^0>3 f700a0^0>4 f700a0^0>5} -proc addItem {z} { - global itemType + set item [$z add tabular $currentGroup 7 -labelformat $labelformat] + $z itemconfigure $item 0 -filled 1 -border contour \ + -bordercolor black -backcolor gray60 + $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 - set length 25 - set itemOnTop 0 + return $item; + } - set item [eval "new$itemType $z"] - if {($itemType == "Track") || ($itemType == "WayPoint")} { - set itemOnTop 1 + proc addAxes {z item length command inFront} { + variable currentGroup + + 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} { + $z raise $item $axesGroup + } + $z bind axis:$item <B1-Motion> {::transforms::dragItem %W %x %y} + $z bind axis:$item <ButtonRelease-1> "::transforms::$command %W; set drag 0" } - addAxes $z $item 25 select $itemOnTop - changeItem $z $item -} + proc addItem {z} { + variable itemType + + set length 25 + set itemOnTop 0 -proc addGroup {z} { - global currentGroup + set item [eval "new$itemType $z"] + if {($itemType == "Track") || ($itemType == "WayPoint")} { + set itemOnTop 1 + } - set item [$z add group $currentGroup] + addAxes $z $item 25 select $itemOnTop + changeItem $z $item + } - addAxes $z $item 80 selectGroup 1 - changeGroup $z $item -} + proc addGroup {z} { + variable currentGroup -proc mouseAdd {z itemOrGroup x y} { - global currentGroup currentItem + set item [$z add group $currentGroup] - if {[llength [$z find withtag current]] != 0} { - return + addAxes $z $item 80 selectGroup 1 + changeGroup $z $item } - foreach {x y} [$z transform $currentGroup [list $x $y]] break + proc mouseAdd {z itemOrGroup x y} { + variable currentGroup + variable currentItem - eval "add$itemOrGroup $z" + if {[llength [$z find withtag current]] != 0} { + return + } + + foreach {x y} [$z transform $currentGroup [list $x $y]] break - $z translate $currentItem $x $y - $z translate axisgrp:$currentItem $x $y + eval "add$itemOrGroup $z" + + $z translate $currentItem $x $y + $z translate axisgrp:$currentItem $x $y + } } |