aboutsummaryrefslogtreecommitdiff
path: root/sandbox/zinc.tcl
diff options
context:
space:
mode:
authorlecoanet2000-01-12 13:56:36 +0000
committerlecoanet2000-01-12 13:56:36 +0000
commit24df859cbc6bb1661abfa7bbe52cfc3dd1b14120 (patch)
tree36cbb4333c66bc50a7c8ef4919e5b7638a4cc02a /sandbox/zinc.tcl
parentdec60589aef2842b89e968759f702744bbefe06a (diff)
downloadtkzinc-24df859cbc6bb1661abfa7bbe52cfc3dd1b14120.zip
tkzinc-24df859cbc6bb1661abfa7bbe52cfc3dd1b14120.tar.gz
tkzinc-24df859cbc6bb1661abfa7bbe52cfc3dd1b14120.tar.bz2
tkzinc-24df859cbc6bb1661abfa7bbe52cfc3dd1b14120.tar.xz
*** empty log message ***
Diffstat (limited to 'sandbox/zinc.tcl')
-rw-r--r--sandbox/zinc.tcl258
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"
+