diff options
Diffstat (limited to 'demos/transforms.tcl')
| -rw-r--r-- | demos/transforms.tcl | 506 |
1 files changed, 0 insertions, 506 deletions
diff --git a/demos/transforms.tcl b/demos/transforms.tcl deleted file mode 100644 index 679d583..0000000 --- a/demos/transforms.tcl +++ /dev/null @@ -1,506 +0,0 @@ -# $Id$ -# This simple demo has been developped by P. Lecoanet <lecoanet@cena.fr> - -# -# TODO: -# -# Add the building of missing items -# - -if {![info exists zincDemo]} { - error "This script should be run from the zinc-widget demo." -} - -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 14 -weight normal] - - 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 $defaultfont -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 [demosPath] 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} { - 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 - } - } - - proc toggleComposeRot {z} { - variable currentItem - variable composeRot - - if {$currentItem != 0} { - $z itemconfigure $currentItem -composerotation $composeRot - $z itemconfigure axisgrp:$currentItem -composerotation $composeRot - } - } - - proc toggleComposeScale {z} { - variable currentItem - variable composeScale - - if {$currentItem != 0} { - $z itemconfigure $currentItem -composescale $composeScale - $z itemconfigure axisgrp:$currentItem -composescale $composeScale - } - } - - 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 - } - } - - proc dragItem {z x y} { - variable drag - variable 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 select {z} { - foreach t [$z gettags current] { - if {[regexp {^axis:(\d+)} $t m item]} { - changeItem $z $item - } - } - } - - 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 selectGroup {z} { - foreach t [$z gettags current] { - if {[regexp {^axis:(\d+)} $t m item]} { - changeGroup $z $item - return - } - } - } - - proc changeGroup {z grp} { - variable currentItem - variable currentGroup - variable world - - changeItem $z $grp - if {$currentItem != 0} { - set currentGroup $currentItem - } else { - set currentGroup $world - } - } - - proc reset {z } { - variable currentItem - - if {$currentItem != 0} { - $z treset $currentItem - $z treset axisgrp:$currentItem - } - } - - proc resetChildren {z} { - variable currentItem - - if {($currentItem != 0) && ([$z type $currentItem] == "group")} { - $z addtag rt withtag .$currentItem. - $z treset rt - $z dtag rt rt - } - } - - proc moveUp {z} { - move $z 0 20 - } - - proc moveDown {z} { - move $z 0 -20 - } - - proc moveRight {z} { - move $z 20 0 - } - - proc moveLeft {z} { - move $z -20 0 - } - - proc move {z dx dy} { - variable currentItem - - if {$currentItem != 0} { - $z translate $currentItem $dx $dy - $z translate axisgrp:$currentItem $dx $dy - } - } - - proc scaleUp {z} { - scale $z 1.1 1.1 - } - - proc scaleDown {z} { - scale $z 0.9 0.9 - } - - proc scale {z dx dy} { - variable currentItem - - if {$currentItem != 0} { - $z scale $currentItem $dx $dy - $z scale axisgrp:$currentItem $dx $dy - } - } - - proc rotateLeft {z} { - rotate $z [expr -3.14159/18] - } - - proc rotateRight {z} { - rotate $z [expr 3.14159/18] - } - - proc rotate {z angle} { - variable currentItem - - if {$currentItem != 0} { - $z rotate $currentItem $angle - $z rotate axisgrp:$currentItem $angle - } - } - - proc newRectangle {z} { - variable currentGroup - - return [$z add rectangle $currentGroup {-15 -15 15 15} \ - -filled 1 -linewidth 0 -fillcolor tan] - } - - proc newArc {z} { - variable currentGroup - - return [$z add arc $currentGroup {-25 -15 25 15} \ - -filled 1 -linewidth 0 -fillcolor tan] - } - - proc newCurve {z} { - variable currentGroup - - return [$z add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \ - -filled 1 -linewidth 0 -fillcolor tan] - } - - proc newText {z} { - variable currentGroup - - set item [$z add text $currentGroup -anchor s] - $z itemconfigure $item -text "Item id: $item" - return $item; - } - - proc newIcon {z} { - variable currentGroup - - return [$z add icon $currentGroup -image logo -anchor center] - } - - proc newTriangles {z} { - variable 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 {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; - } - - proc newWayPoint {z} { - variable currentGroup - - set labelformat {a0a0+0+0 a0a0>0^1} - - 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 {z} { - variable 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 [$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; - } - - 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" - } - - proc addItem {z} { - variable itemType - - set length 25 - set itemOnTop 0 - - set item [eval "new$itemType $z"] - if {($itemType == "Track") || ($itemType == "WayPoint")} { - set itemOnTop 1 - } - - addAxes $z $item 25 select $itemOnTop - changeItem $z $item - } - - proc addGroup {z} { - variable currentGroup - - set item [$z add group $currentGroup] - - addAxes $z $item 80 selectGroup 1 - changeGroup $z $item - } - - proc mouseAdd {z itemOrGroup x y} { - variable currentGroup - variable currentItem - - if {[llength [$z find withtag current]] != 0} { - return - } - - foreach {x y} [$z transform $currentGroup [list $x $y]] break - - eval "add$itemOrGroup $z" - - $z translate $currentItem $x $y - $z translate axisgrp:$currentItem $x $y - } -} - |