diff options
Diffstat (limited to 'sandbox/zinc.tcl')
-rw-r--r-- | sandbox/zinc.tcl | 258 |
1 files changed, 258 insertions, 0 deletions
diff --git a/sandbox/zinc.tcl b/sandbox/zinc.tcl new file mode 100644 index 0000000..a828934 --- /dev/null +++ b/sandbox/zinc.tcl @@ -0,0 +1,258 @@ +#!/usr/bin/wish -f + +load tkradar3.1.so +package require Img + +set top 1 + +image create photo logo -file /usr/share/toccata/images/logo.gif +image create photo logosmall -file /usr/share/toccata/images/logo-small.gif +#image create photo papier -file /usr/share/toccata/images/dgtexture-dragstrip.xpm + +set r [radar .r -backcolor gray -relief sunken] +pack .r -expand t -fill both +set scale 1.0 +set centerX 0.0 +set centerY 0.0 +set radarWidth 800 +set radarHeight 500 +.r configure -width $radarWidth -height $radarHeight +#.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} +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 +pack .rc + +bind .r <Configure> "RadarStyleConfig %W %w %h" + +proc RadarStyleConfig {radar w h} { + global radarWidth radarHeight + + set bw [$radar cget -borderwidth] + set radarWidth [expr $w - 2*$bw] + set radarHeight [expr $h - 2*$bw] + updateTransform $radar +} + +proc updateTransform {radar} { + global radarWidth radarHeight + global scale centerX centerY + global top + + $radar treset $top + $radar scale $top 1 -1 + $radar translate $top [expr -$centerX] [expr -$centerY] + $radar scale $top $scale $scale + $radar translate $top [expr $radarWidth/2] [expr $radarHeight/2] +} + +# +# TRACKS +# +set track [.r add track $view 5 -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 x80x20+0+0 x40x20+80+0 x40x20+0+20 x20x20>2>1 x60x20>0>0" +.r itemconfigure $track 0 -filled 1 -backcolor tan -relief groove \ + -font "cenapii-etiquette-m17" -text "AFR451" +.r itemconfigure $track 1 -text "WPY" -filled 1 -backcolor wheat -relief ridge \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 2 -text "400" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 3 -text "-" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" +.r itemconfigure $track 4 -text "450" -filled 1 -backcolor wheat \ + -font "cenapii-etiquette-m17" + +.r bind $track:-3 <Enter> ".r itemconfigure $track -speedvectorcolor red" +.r bind $track:-3 <Leave> ".r itemconfigure $track -speedvectorcolor salmon" + +set track2 [.r add track $view 4 -speedvector "-20 0" \ + -symbolcolor salmon -speedvectorcolor salmon -leadercolor salmon \ + -labeldistance 20 -leaderanchors "%30x30"] +.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 "1 1" +.r itemconfigure $track2 -position "-10 10" +.r itemconfigure $track2 -position "-20 20" +.r itemconfigure $track2 -position "-30 30" +.r itemconfigure $track2 -position "-40 40" +.r itemconfigure $track2 -position "-50 50" +.r itemconfigure $track2 -position "-60 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] + set contour noborder + if { $onoff == "on" } { + set contour "contour" + } + if { $part >= 0 } { + .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" } } + +source "controls.tcl" + |