Many updates for the 3.2.90 release and new demos

1 files changed, 336 insertions, 0 deletions

diff --git a/demos/simpleRadar.tcl b/demos/simpleRadar.tcl
new file mode 100644
index 0000000..9179d4b
--- /dev/null
+++ b/demos/simpleRadar.tcl
@@ -0,0 +1,336 @@
+# $Id$
+# This simple radar has been initially developped by P. Lecoanet <lecoanet@cena.fr>
+# It has been adapted by C. Mertz <mertz@cena.fr> for demo purpose.
+
+if {![info exists zincDemo]} {
+    error "This script should be run from the zinc-widget demo."
+}
+
+set w .simpleRadar
+catch {destroy $w}
+toplevel $w
+wm title $w "Simple radar display"
+wm iconname $w SimpleRadar
+
+text $w.text -relief sunken -borderwidth 2 -height 11
+pack $w.text -expand yes -fill both
+
+$w.text insert end {This a very simple radar display, where you can see flight tracks,
+a so-called ministrip (green) and and extend flight label (tan background).
+   The following operations are possible:
+     Shift-Button 1 for using a square lasso (result in the terminal).
+     Click Button 2 for identifiying the closest item (result in the terminal).
+     Button 3 for dragging most items, but not the ministrip (not in the same group).
+     Shift-Button 3 for zooming independently on X and Y axis.
+     Ctrl-Button 3 for rotationg graphic objects.
+     Enter/Leave in flight label fields, speed vector, position and leader,
+       and in the ministrip fields.
+     Click Button 1 on flight track to display a route.}
+
+
+
+#-------------------------------------------------
+# Create zinc
+#-------------------------------------------------
+set top 1
+set scale 1.0
+set centerX 0.0
+set centerY 0.0
+set zincWidth 800
+set zincHeight 500
+set delay 2000
+set rate 0.3
+array unset tracks
+# if true the flights are no more moving
+set pause 0
+
+zinc $w.zinc -backcolor gray65 -relief sunken -font 10x20 \
+    -width $zincWidth -height $zincHeight
+pack $w.zinc -expand 1 -fill both
+
+$w.zinc add group $top -tags {controls radar}
+$w.zinc configure -overlapmanager [$w.zinc find withtag radar]
+
+
+#-------------------------------------------------
+# Create control panel
+#-------------------------------------------------
+frame $w.f
+pack $w.f
+button $w.f.up -text Up -command "set centerY [expr $centerY-30.0]; updateTransform $w.zinc"
+grid $w.f.up -row 0 -column 2 -sticky ew
+button $w.f.down -text Down -command "set centerY [expr $centerY+30.0]; updateTransform $w.zinc"
+grid $w.f.down -row 2 -column 2 -sticky ew
+button $w.f.left -text Left -command "set centerY [expr $centerX+30.0]; updateTransform $w.zinc"
+grid $w.f.left -row 1 -column 1
+button $w.f.right -text Right -command "set centerY [expr $centerX-30.0]; updateTransform $w.zinc"
+grid $w.f.right -row 1 -column 3
+button $w.f.expand -text Expand -command "set scale \[expr $scale*1.1\]; updateTransform $w.zinc"
+grid $w.f.expand -row 1 -column 4
+button $w.f.shrink -text Shrink -command "set scale \[expr $scale*0.9\]; updateTransform $w.zinc"
+grid $w.f.shrink -row 1 -column 0
+button $w.f.reset -text Reset -command "set scale 1.0; set centerX 0.0; set centerY 0.0; updateTransform $w.zinc"
+grid $w.f.reset -row 1 -column 2 -sticky ew
+button $w.f.pause -text Pause -command "set pause \[expr ! $pause\]"
+grid $w.f.pause -row 0 -column 6
+
+#--------------------------------------------------
+# Resize handling code
+#--------------------------------------------------
+bind $w.zinc <Configure> "resize $w.zinc %w %h"
+
+proc resize {z w h} {
+    global zincWidth zincHeight
+
+    set bw [$z cget -borderwidth]
+    set zincWidth [expr $w - 2 * $bw]
+    set zincHeight [expr $h - 2 * $bw]
+    updateTransform $z
+}
+
+proc updateTransform {z} {
+    global centerX centerY zincWidth zincHeight scale
+
+    $z treset 1
+    $z translate 1 [expr -$centerX] [expr -$centerY]
+    $z scale 1 $scale $scale
+    $z scale 1 1 -1
+    $z translate 1 [expr $zincWidth/2] [expr $zincHeight/2]
+}
+
+#------------------------------------------------
+# Create the tracks
+#------------------------------------------------
+proc createTracks {z} {
+    global oneTrack zincWidth zincHeight scale
+    global centerX centerY tracks
+
+    set w [expr $zincWidth / $scale]
+    set h [expr $zincHeight / $scale]
+    
+    set allTracks {}
+
+    set bOn "$z itemconfigure current \[$z currentpart\] -border contour"
+    set bOff "$z itemconfigure current \[$z currentpart\] -border noborder"
+
+    for {set i 20} {$i > 0} {incr i -1} {
+	set item [$z add track radar 6]
+	lappend allTracks $item
+	set oneTrack $item
+
+	set tracks($item,x) [expr rand()*$w - $w/2 + $centerX]
+	set tracks($item,y) [expr rand()*$h - $h/2 + $centerY]
+	set d [expr (rand() > 0.5) ? 1 : -1]
+	set tracks($item,vx) [expr (8.0 + rand()*10.0) * $d]
+	set d [expr (rand() > 0.5) ? 1 : -1]
+	set tracks($item,vy) [expr (8.0 + rand()*10.0) * $d]
+	$z itemconfigure $item -position "$tracks($item,x) $tracks($item,y)" -circlehistory 1 \
+	    -speedvector "$tracks($item,vx) $tracks($item,vy)" -speedvectorsensitive 1 \
+	    -labeldistance 30 -markersize 20 -historycolor gray30 -filledhistory 0 \
+	    -labelformat {x80x60+0+0 x63a0^0^0 x33a0^0>1 a0a0>2>1 x33a0>3>1 a0a0^0>2}
+	$z itemconfigure $item 0 -filled 0 -backcolor gray60 -sensitive 1
+	$z itemconfigure $item 1 -filled 1 -backcolor gray55 -text [format {AFR%03i} $i]
+	$z itemconfigure $item 2 -filled 0 -backcolor gray65 -text 360
+	$z itemconfigure $item 3 -filled 0 -backcolor gray65 -text /
+	$z itemconfigure $item 4 -filled 0 -backcolor gray65 -text 410
+	$z itemconfigure $item 5 -filled 0 -backcolor gray65 -text Balise
+
+	for {set j 0} {$j < 6} {incr j} {
+	    $z bind $item:$j <Enter> $bOn
+            $z bind $item:$j <Leave> $bOff
+            $z bind $item <1> "fieldSensitivity $z"
+            $z bind $item <Shift-1> {}
+        }
+	$z bind $item <Enter> [list $z itemconfigure current -historycolor red3 \
+				   -symbolcolor red3 -markercolor red3 -leaderwidth 2 \
+				   -leadercolor red3 -speedvectorwidth 2 -speedvectorcolor red3]
+        $z bind $item <Leave> [list $z itemconfigure current -historycolor black \
+				   -symbolcolor black -markercolor black -leaderwidth 1 \
+				   -leadercolor black -speedvectorwidth 1 -speedvectorcolor black]
+        $z bind $item:position <1> "createRoute $z"
+        $z bind $item:position <Shift-1> {}
+        set tracks($item,route) 0
+    }
+
+    set tracks(all) $allTracks
+}
+
+createTracks $w.zinc
+
+#---------------------------------------------------
+# Create route way points
+#---------------------------------------------------
+proc createRoute {z} {
+    global tracks
+
+    set track [$z find withtag current]
+
+    if { $tracks($track,route) == 0 } {
+	set x [expr $tracks($track,x) + 8.0 * $tracks($track,vx)]
+	set y [expr $tracks($track,y) + 8.0 * $tracks($track,vy)]
+	set connected $track
+	for {set i 4} {$i > 0} {incr i -1} {
+	    set wp [$z add waypoint radar 2 -position "$x $y" -labelformat x20x18+0+0 \
+			-connecteditem $connected -connectioncolor green -symbolcolor green]
+	    $z lower $wp $connected
+	    $z bind $wp:0 <Enter> "$z itemconfigure current 0 -border contour"
+	    $z bind $wp:position <Enter> "$z itemconfigure current -symbolcolor red"
+	    $z bind $wp:leader <Enter> "$z itemconfigure current -leadercolor red"
+	    $z bind $wp:connection <Enter> "$z itemconfigure current -connectioncolor red"
+	    $z bind $wp:0 <Leave> "$z itemconfigure current 0 -border noborder"
+	    $z bind $wp:position <Leave> "$z itemconfigure current -symbolcolor green"
+	    $z bind $wp:leader <Leave> "$z itemconfigure current -leadercolor black"
+	    $z bind $wp:connection <Leave> "$z itemconfigure current -connectioncolor green"
+	    $z itemconfigure $wp 0 -text $i -filled 1 -backcolor gray55
+	    $z bind $wp:position <1> "delWaypoint $z"
+	    set x [expr $x + (2.0 + rand()*8.0) * $tracks($track,vx)]
+	    set y [expr $y + (2.0 + rand()*8.0) * $tracks($track,vy)]
+	    set connected $wp
+	}
+	set tracks($track,route) $wp
+    } else {
+	set wp $tracks($track,route)
+	while { $wp != $track } {
+	    set tracks($track,route) [$z itemcget $wp -connecteditem]
+	    $z bind $wp:position <1> {}
+	    $z bind $wp:position <Enter> {}
+	    $z bind $wp:position <Leave> {}
+	    $z bind $wp:leader <Enter> {}
+            $z bind $wp:leader <Leave> {}
+            $z bind $wp:connection <Enter> {}
+            $z bind $wp:connection <Leave> {}
+	    $z bind $wp:0 <Enter> {}
+            $z bind $wp:0 <Leave> {}
+            $z remove $wp
+	    set wp $tracks($track,route)
+	}
+	set tracks($track,route) 0
+    }
+}
+
+#-----------------------------------------------------
+# Toggle current field sensitivity
+#-----------------------------------------------------
+proc fieldSensitivity {z} {
+    set curPart [$z currentpart]
+    if { [regexp {[0-9]+} $curPart] } {
+	set onOff [$z itemcget current $curPart -sensitive]
+	$z itemconfigure current $curPart -sensitive [expr !$onOff]
+    }
+}
+
+#-----------------------------------------------------
+# Removal of a route Waypoint
+#-----------------------------------------------------
+proc findTrack {z wp} {
+    set connected $wp
+    
+    while { [$z type $connected] != "track" } {
+	set connected [$z itemcget $connected -connecteditem]
+    }
+    return $connected
+}
+
+proc delWaypoint {z} {
+    global tracks
+
+    set wp [$z find withtag current]
+    set track [findTrack $z $wp]
+    set next [$z itemcget $wp -connecteditem]
+
+    set prev $tracks($track,route)
+    if { $prev != $wp } {
+	set prevnext [$z itemcget $prev -connecteditem]
+	while { $prevnext != $wp } {
+	    set prev $prevnext
+	    set prevnext [$z itemcget $prev -connecteditem]
+	}
+    }
+    $z itemconfigure $prev -connecteditem $next
+    $z bind $wp:position <1> {}
+    $z remove $wp
+    if { $wp == $tracks($track,route) } {
+	if { $next == $track } {
+	    set tracks($track,route) 0
+	} else {
+	    set tracks($track,route) $next
+	}
+    }
+}
+
+
+#---------------------------------------------
+# Create a macro
+#---------------------------------------------
+set macro [$w.zinc add tabular radar 10 -labelformat {x73x20+0+0 x20x20+0+0 x53x20+20+0}]
+$w.zinc itemconfigure $macro 0 -backcolor tan1 -filled 1 -fillpattern AlphaStipple7 \
+    -bordercolor red3
+$w.zinc itemconfigure $macro 1 -text a
+$w.zinc itemconfigure $macro 2 -text macro
+$w.zinc itemconfigure $macro -connecteditem $oneTrack
+foreach part {0 1 2} {
+    $w.zinc bind $macro:$part <Enter> "borders $w.zinc 1"
+    $w.zinc bind $macro:$part <Leave> "borders $w.zinc 0"
+}
+
+proc borders {z on} {
+    if { $on } {
+	set contour contour
+    } else {
+	set contour noborder
+    }
+    $z itemconfigure current 0 -border $contour
+}
+
+#---------------------------------------------
+# Create a ministrip
+#---------------------------------------------
+set ministrip [$w.zinc add tabular 1 10 -position {100 10} \
+		   -labelformat {x153x80^0^0 x93x20^0^0 x63a0^0>1 a0a0>2>1 x33a0>3>1 a0a0^0>2}]
+$w.zinc itemconfigure $ministrip 0 -filled 1 -backcolor grey70 -border contour -bordercolor green
+$w.zinc itemconfigure $ministrip 1 -text ministrip -color darkgreen -backcolor grey40
+$w.zinc itemconfigure $ministrip 2 -text field1 -color darkgreen -backcolor grey40
+$w.zinc itemconfigure $ministrip 3 -text field2 -color darkgreen -backcolor grey40
+$w.zinc itemconfigure $ministrip 4 -text f3 -color darkgreen -backcolor grey40
+$w.zinc itemconfigure $ministrip 5 -text field4 -color darkgreen -backcolor grey40
+
+foreach field {1 2 3 4 5} {
+    $w.zinc bind $ministrip:$field <Enter> \
+	"$w.zinc itemconfigure current $field -border contour -filled 1 -color white"
+    $w.zinc bind $ministrip:$field <Leave> \
+	"$w.zinc itemconfigure current $field -border noborder -filled 0 -color darkgreen"
+}
+
+#-------------------------------------------
+# Create some maps
+#-------------------------------------------
+set dataDir [file join [file dirname [info script]] data]
+videomap load [file join $dataDir videomap_paris-w_90_2] 0 paris-w
+videomap load [file join $dataDir videomap_orly] 17 orly
+videomap load [file join $dataDir hegias_parouest_TE.vid] 0 paris-ouest
+
+$w.zinc add map radar -color gray80 -mapinfo orly
+$w.zinc add map radar -color gray60 -filled 1 -priority 0 \
+    -fillpattern AlphaStipple6 -mapinfo paris-ouest
+$w.zinc add map radar -color gray50 -mapinfo paris-w
+
+
+#--------------------------------------------
+# Animate tracks along their trajectories
+#--------------------------------------------
+set timer [after $delay "refresh $w.zinc"]
+bind $w.zinc <Destroy> "puts {canceling timer}; after cancel $timer"
+
+proc refresh {z} {
+    global pause timer delay tracks rate
+
+    set timer [after $delay "refresh $z"]
+
+    if { ! $pause } {
+	foreach t $tracks(all) {
+	    set tracks($t,x) [expr $tracks($t,x) + $tracks($t,vx) * $rate]
+	    set tracks($t,y) [expr $tracks($t,y) + $tracks($t,vy) * $rate]
+	    $z itemconfigure $t -position "$tracks($t,x) $tracks($t,y)"
+	}
+    }
+}