diff options
Diffstat (limited to 'sandbox/zinc.tcl')
| -rw-r--r-- | sandbox/zinc.tcl | 284 |
1 files changed, 0 insertions, 284 deletions
diff --git a/sandbox/zinc.tcl b/sandbox/zinc.tcl deleted file mode 100644 index a798e3b..0000000 --- a/sandbox/zinc.tcl +++ /dev/null @@ -1,284 +0,0 @@ -lappend auto_path . - -package require Tkzinc -package require Img - -set top 1 - -#memory info -#memory trace on -#memory validate on - -image create photo logo -file logo.gif -image create photo logosmall -file logo.gif -#image create photo bois -file texture-bois1.xpm - -#set r [zinc .r -backcolor gray -relief sunken -tile bois] -set r [zinc .r -backcolor gray -relief sunken] -pack .r -expand t -fill both -set scale 1.0 -set centerX 0.0 -set centerY 0.0 -set zincWidth 800 -set zincHeight 500 -#.r configure -width $zincWidth -height $zincHeight -#.r configure -drawbboxes t -set view [.r add group $top -tags "controls"] - -frame .rc -button .rc.up -text "Up" \ - -command {set centerY [expr $centerY+30.0]; updateTransform .r} -button .rc.down -text "Down" \ - -command {set centerY [expr $centerY-30.0]; updateTransform .r} -button .rc.left -text "Left" \ - -command {set centerX [expr $centerX+30.0]; updateTransform .r} -button .rc.right -text "Right" \ - -command {set centerX [expr $centerX-30.0]; updateTransform .r} -button .rc.expand -text "Expand" \ - -command {set scale [expr $scale*1.1]; updateTransform .r} -button .rc.shrink -text "Shrink" \ - -command {set scale [expr $scale*0.9]; updateTransform .r} -button .rc.reset -text "Reset" \ - -command {set scale 1.0; set centerX 0.0; set centerY 0.0; \ - updateTransform .r} -button .rc.quit -text "Quit" -command "exit" -grid .rc.up -row 0 -column 2 -sticky ew -grid .rc.down -row 2 -column 2 -sticky ew -grid .rc.left -row 1 -column 1 -grid .rc.right -row 1 -column 3 -grid .rc.expand -row 1 -column 4 -grid .rc.shrink -row 1 -column 0 -grid .rc.reset -row 1 -column 2 -sticky ew -grid .rc.quit -row 3 -column 2 -pack .rc - -bind .r <Configure> "ZincStyleConfig %W %w %h" - -proc ZincStyleConfig {zinc w h} { - global zincWidth zincHeight - - set bw [$zinc cget -borderwidth] - set zincWidth [expr $w - 2*$bw] - set zincHeight [expr $h - 2*$bw] - updateTransform $zinc -} - -proc updateTransform {zinc} { - global zincWidth zincHeight - global scale centerX centerY - global top - - $zinc treset $top - $zinc translate $top [expr -$centerX] [expr -$centerY] - $zinc scale $top $scale $scale - $zinc scale $top 1 -1 - $zinc translate $top [expr $zincWidth/2] [expr $zincHeight/2] -} - -# -# TRACKS -# -set track [.r add track $view 6 -tags track -leaderanchors "|0|0"] -.r itemconfigure $track -position "1 1" -.r itemconfigure $track -position "10 10" -.r itemconfigure $track -position "20 20" -.r itemconfigure $track -position "30 30" -.r itemconfigure $track -position "40 40" -.r itemconfigure $track -position "50 50" -.r itemconfigure $track -position "55 60" -.r itemconfigure $track -position "60 70" -.r itemconfigure $track -speedvector "20 0" -.r itemconfigure $track -symbolcolor salmon -speedvectorcolor salmon -leadercolor salmon \ - -labeldistance 20 -.r itemconfigure $track -markersize 20 \ - -filledmarker 1 \ - -markerfillpattern AlphaStipple4 \ - -markercolor salmon -.r itemconfigure $track -labelformat "120x40 l0l0+0+0 x80x20+0+0 x40x20+80+0 x40x20+0+20 x20x20>3>2 x60x20>1>1" -.r itemconfigure $track 0 -filled 1 -backcolor gray -bordercolor gray -relief groove -.r itemconfigure $track 1 -filled 1 -backcolor tan -bordercolor tan -relief groove \ - -font "cenapii-etiquette-m17" -text "AFR451" -.r itemconfigure $track 2 -text "WPY" \ - -font "cenapii-etiquette-m17" -.r itemconfigure $track 3 -text "400" -filled 1 -backcolor wheat \ - -font "cenapii-etiquette-m17" -.r itemconfigure $track 4 -text "-" -filled 1 -backcolor wheat \ - -font "cenapii-etiquette-m17" -.r itemconfigure $track 5 -text "450" -font "cenapii-etiquette-m17" - -.r bind $track:speedvector <Enter> ".r itemconfigure $track -speedvectorcolor red" -.r bind $track:speedvector <Leave> ".r itemconfigure $track -speedvectorcolor salmon" - -set track2 [.r add track $view 4 -speedvector "-20 0" \ - -symbolcolor salmon -speedvectorcolor salmon -leadercolor salmon \ - -labeldx -20 -labeldy 20 -leaderanchors "%30x30" \ - -historycolor MistyRose -lastasfirst t ] -.r itemconfigure $track2 -labelformat "a3f110+0+0 a3f110>0^0 a3f110^0>0 a3f110>2>0" -.r itemconfigure $track2 0 -filled 1 -backcolor tan -text "BAW452" -.r itemconfigure $track2 1 -filled 1 -backcolor wheat -text "450" -.r itemconfigure $track2 2 -filled 1 -backcolor wheat -text "KMC" -#.r itemconfigure $track2 3 -filled 1 -backcolor wheat -text "" -.r itemconfigure $track2 -connecteditem $track -connectioncolor green -.r itemconfigure $track2 -position "10 0" -.r itemconfigure $track2 -position "-20 10" -.r itemconfigure $track2 -position "-30 20" -.r itemconfigure $track2 -position "-40 30" -.r itemconfigure $track2 -position "-50 40" -.r itemconfigure $track2 -position "-60 50" -.r itemconfigure $track2 -position "-70 50" -.r itemconfigure $track2 -position "-80 50" -.r itemconfigure $track2 -position "-90 50" - -# -# WAY POINTS -# -puts "creating way points" -set wp [.r add waypoint $view 1 -tags borders] -.r itemconfigure $wp -symbolcolor bisque -leadercolor bisque -position "-100 120" \ - -labelformat "40x20" -.r itemconfigure $wp 0 -bordercolor bisque -text "NCY" -tile logo -filled t -set wp2 [.r add waypoint $view 1 -tags borders] -.r itemconfigure $wp2 -symbolcolor bisque \ - -leadercolor bisque \ - -position "50 160" \ - -labelformat "40x20" \ - -connectioncolor bisque \ - -connecteditem $wp -.r itemconfigure $wp2 0 -bordercolor bisque -text "MPW" -set wp3 [.r add waypoint $view 1 -tags borders] -.r itemconfigure $wp3 -symbolcolor bisque \ - -leadercolor bisque \ - -position "200 140" \ - -labelformat "40x20" \ - -connectioncolor bisque \ - -connecteditem $wp2 -.r itemconfigure $wp3 0 -bordercolor bisque -text "ART" - -# -# MACROS -# -puts "creating macros" -set macro [.r add tabular $view 10 -labelformat "x40x20+0+0 x40x20+40+0" \ - -tags f0borders -connecteditem $track] -.r itemconfigure $macro 0 -text une -.r itemconfigure $macro 1 -text macro - -# -# MINISTRIPS -# -puts "creating ministrips" -set ministrip [.r add tabular $view 1 \ - -labelformat "60x20" -position "10 10"] -.r itemconfigure $ministrip 0 -text "ministrip" -sensitive f -set ministrip2 [.r add tabular $view 1 \ - -labelformat "60x20" -connecteditem $ministrip] -.r itemconfigure $ministrip2 0 -text "ministrip2" -sensitive f -set ministrip3 [.r add tabular $view 1 \ - -labelformat "60x20" -connecteditem $ministrip2] -.r itemconfigure $ministrip3 0 -text "ministrip3" -sensitive f - -# -# MAPS -# -puts "creating maps" -videomap load "/usr/share/toccata/maps/videomap_paris-w_90_2" 0 paris-w -videomap load "/usr/share/toccata/maps/videomap_orly" 17 orly -videomap load "/usr/share/toccata/maps/hegias_parouest_TE.vid" 0 paris-ouest - -set map [.r add map $view -color darkblue] -.r itemconfigure $map -mapinfo orly - -set map2 [.r add map $view -color darkblue -filled 1 -priority 0 -fillpattern AlphaStipple1] -.r itemconfigure $map2 -mapinfo paris-ouest - -set map3 [.r add map $view -color orange] - -mapinfo mpessai create -mapinfo mpessai add text normal simple 0 200 "Et voilà" -mapinfo mpessai add line simple 5 0 0 100 100 -mapinfo mpessai add line simple 0 100 100 0 200 -mapinfo mpessai add line simple 2 -100 100 0 0 -.r itemconfigure $map3 -mapinfo mpessai - -# -# Clip -# -puts "crée les clips" -set clip [.r add rectangle $view "-100 -100 300 200" -filled t \ - -linewidth 0 -fillcolor darkgray -visible f] -#.r rotate $clip [expr 3.14159 / 4] -.r lower $clip -#.r itemconfigure $view -clip $clip - -.r add rectangle $top "-5 -5 5 5" -filled t -fillcolor red -set topclip [.r add rectangle $top "-400 -400 400 400" \ - -filled t -fillcolor lightgray -linewidth 0 -visible t] -.r lower $topclip -#.r rotate $topclip [expr 3.14159 / 4] -#.r itemconfigure $top -clip $topclip - -# -# CONTROLS -# -proc borders {onoff} { - set part [.r currentpart] - puts "part $part $onoff" - set contour noborder - if { $onoff == "on" } { - set contour "contour oblique" - } - if { [regexp {^[0-9]+$} $part] } { - .r itemconfigure current $part -border $contour - } -} - -.r bind borders <Enter> "borders on" -.r bind borders <Leave> "borders off" -.r bind f0borders:0 <Enter> "borders on" -.r bind f0borders:0 <Leave> "borders off" -.r bind track <Enter> {puts "Entre dans item"} -.r bind track <Leave> {puts "Sort d'item"} -.r bind track:0 <Enter> {puts "Entre dans champ 0"} -.r bind track:0 <Leave> {puts "Sort de champ 0"} -.r bind track:1 <Enter> {puts "Entre dans champ 1"} -.r bind track:1 <Leave> {puts "Sort de champ 1"} -.r bind track:2 <Enter> {puts "Entre dans champ 2"} -.r bind track:2 <Leave> {puts "Sort de champ 2"} -.r bind track:3 <Enter> {puts "Entre dans champ 3"} -.r bind track:3 <Leave> {puts "Sort de champ 3"} - -bind .r <2> {puts "%x@%y, item: [.r find atpoint %x %y]"} - -proc finditems {cornerx cornery} { - global origx origy - - puts "--- enclosed ---" - puts "++ [.r find enclosed $origx $origy $cornerx $cornery] ++" - puts "--- overlapping ---" - puts "++ [.r find overlapping $origx $origy $cornerx $cornery] ++" - puts "" -} - -bind .r <ButtonPress-1> "set origx %x; set origy %y" -bind .r <ButtonRelease-1> "finditems %x %y" - -.r bind all <1> { if {! [catch {.r find withtag current} item] } { \ - puts "<1> in $item" } else { puts "None" } } - -# -#for {set j 0} {$j < 20} {incr j} { -# memory info -# for {set i 0} {$i < 10} {incr i} { -# set a($i) [.r add icon 1 -image logo] -# set b($i) [.r add rectangle 1 "10 10 1000 1000" -filled t -tile logosmall] -# set c($i) [.r add curve 1 "10 10 10 100 100 100" -filled t -tile logosmall] -# } -# for {set i 0} {$i < 10} {incr i} { -# .r remove $a($i) -# .r remove $b($i) -# .r remove $c($i) -# } -#} - -source "controls.tcl" - |