Updated to a more simple and hopefully tclish script.

Images are inlined.

2 files changed, 560 insertions, 1131 deletions

diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl
index 808b625..7634661 100644
--- a/demos/groupsInAtcStrips.tcl
+++ b/demos/groupsInAtcStrips.tcl
@@ -3,14 +3,8 @@
 #      Copyright (C) 2002
 #      Centre d'Études de la Navigation Aérienne
 #
-#      Authors: Jean-Luc Vinot <vinot@cena.fr> for whole graphic design and coding
-#               Christophe Mertz <mertz@cena.fr> for adding simple animations
-#                                                and integration in zinc-demos
-#                 This integration is still not perfect and requires an extension in zinc
-#                 We must know if a named gradient already exists, when launching
-#                 many time the same demo in the same process!
-#
-# $Id: 
+#      Authors: Jean-Luc Vinot <vinot@cena.fr> for the graphic design
+#               Patrick Lecoanet for the tcl code.
 #-----------------------------------------------------------------------------------
 #      This small application illustrates both the use of groups in combination
 #         of -composescale attributes and an implementation of kind of air traffic
@@ -36,41 +30,33 @@
 #        $delay and $steps.
 #
 #-----------------------------------------------------------------------------------
-#
-# Ported to Tcl by P.Lecoanet
-
 
 if {![info exists zincDemo]} {
     error "This script should be run from the zinc-widget demo."
 }
 
-#package require profiler
-#::profiler::init
 namespace eval groupsInAtcStrips {
-    variable w .groupsInAtcStrips
+  variable w .groupsInAtcStrips
 
-    catch {destroy $w}
-    toplevel $w
-    wm title $w "Atc electronic strips using groups"
-    wm iconname $w groupsInAtcStrips
+  catch {destroy $w}
+  toplevel $w
+  wm title $w "Atc electronic strips using groups"
+  wm iconname $w groupsInAtcStrips
 
-    variable defaultfont [font create -family Helvetica -size 10 -weight bold]
-    variable imagePath [file join $::zinc_demos images]
+  grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 2 -column 0 -pady 10
+  grid [button $w.code -text "See Code" -command "showCode $w"] -row 2 -column 1 -pady 10
 
-    grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 2 -column 0 -pady 10
-    grid [button $w.code -text "See Code" -command "showCode $w"] -row 2 -column 1 -pady 10
 
 
+  ###########################################
+  # Text zone
+  #######################
+  ####################
 
-    ###########################################
-    # Text zone
-    #######################
-    ####################
+  grid [text $w.text -relief sunken -borderwidth 2 -height 5] \
+    -row 0 -column 0 -columnspan 2 -sticky ew
 
-    grid [text $w.text -relief sunken -borderwidth 2 -height 5] \
-	-row 0 -column 0 -columnspan 2 -sticky ew
-
-    $w.text insert end {These fake air Traffic Control electronic strips illustrates
+  $w.text insert end {These fake air Traffic Control electronic strips illustrates
 	the use of groups for an advanced graphic design.
 	The following interactions are possible:
 	"drag&drop button1" on the callsign.
@@ -79,824 +65,388 @@ namespace eval groupsInAtcStrips {
 	"double click 1" on the blueish zone to fully reduce size}
 
 
-    ###########################################
-    # Zinc
-    ##########################################
-    image create photo texture -file \
-	[file join $::zinc_demos images background_texture.gif]
-
-    grid [zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 \
-	      -lightangle 130 -tile texture] -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 stripGradients {}
-    variable stripFontSet {}
-
-
-    variable delay 50;	# ms between each animation steps
-    variable steps 6;	# number of steps for the animation
-    # scales()      # this hash just memorizes the current x and y scaling ratio
-    # In a real appli, this should be memorized in strip objects
-
-    #----------------------
-    # configuration data
-    #----------------------
-
-    variable ratio2FontSet {{1.2 normal} {10 large}}
-
-    set loadedFonts [font names]
-    foreach f $loadedFonts {
-	if { [regexp {^radar-} $f] } {
-	    font delete $f
-	}
-    }
-
-    # cenapii-radar-b15
-    font create radar-b15 -family helvetica -size 16 -slant roman -weight bold
-    # cenapii-digistrips-b12
-    font create radar-b12 -family helvetica -size 12 -slant roman -weight bold
-    # cenapii-digistrips-b10 and cenapii-digistrips-b10c
-    font create radar-b10 -family helvetica -size 10 -slant roman -weight bold
-    # cenapii-radar-m18
-    font create radar-m18 -family helvetica -size 18 -slant roman -weight normal
-    # cenapii-radar-m20
-    font create radar-m20 -family helvetica -size 20 -slant roman -weight normal
-
-    variable stripStyle {
-	gradSet {
-	    idnt {=axial 90|#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a}
-	    back {#c1daff|#8aaaff}
-	    shad {=path -40 -40|#000000;50 0|#000000;50 92|#000000;0 100}
-	    btnOutside #ffeedd|#8a9acc
-	    btnInside {=axial 180|#ffeedd|#8a9acc}
-	    ch1 {#8aaaff|#5b76ed}
-	}
-	fontSet {
-	    normal {
-		callsign radar-b15
-		type1 radar-b12
-		type2 radar-b10
-		type3 radar-b10
-	    }
-	    large {
-		callsign radar-m20
-		type1 radar-m18
-		type2 radar-b15
-		type3 radar-b12
-	    }
-	}
-	width 340
-	height 86
-	shadowcoords {8 8 374 94}
-	shadowcolor shad
-	strip {
-	    linewidth 3
-	    linecolor \#aaccff
-	    fillcolor back
-	    relief roundraised
-	}
-	buttons {
-	    coords {340 0}
-	    clipcoords {0 0 90 83}
-	    zone {
-		coords {0 0 26 85}
-		fillcolor btnOutside
-		linewidth 0
-	    }			    
-	    btns {
-		btnup {
-		    coords {0 0 26 43}
-		    arrow {14 2 24 40 1 40 14 2}
-		    linewidth 1
-		    linecolor \#aabadd
-		    fillcolor btnInside
-		    label {
-			coords {13 27}
-			text +
-			font radar-m20
-			color \#ffffff
-			anchor center
-		    }
-		}
-		btndn {
-		    coords {0 43 26 86}
-		    arrow {14 83 24 43 1 43 14 83}
-		    linewidth 1
-		    linecolor \#aabadd
-		    fillcolor btnInside
-		    label {
-			coords {13 56}
-			text -
-			font radar-m20
-			color \#ffffff
-			anchor center
-		    }
-		}
-	    }
-	}
-	clipcoords {3 3 332 80}
-	zones {
-	    ident {
-		coords {3 3 90 50}
-		atomic 1
-		priority 200
-		sensitive 1
-		tags move
-		linewidth 1
-		filled 1
-		relief sunken
-		linecolor \#ffeedd
-		fillcolor idnt
-		fields {
-		    callsign {
-			coords {10 18}
-			font callsign
-			text EWG361
-			anchor w
-			color \#000000
-		    }
-		    company {
-			coords {10 34}
-			font type2
-			text Eurowing
-			anchor w
-			color \#444444
-		    }
-		}
-	    }
-	    input {
-		coords {3 3 334 82}
-		atomic 1
-		priority 100
-		sensitive 1
-		tags scale
-		linewidth 0
-		filled 1
-		relief flat
-		linecolor white
-		fillcolor back # \#afb2cc
-		fields {
-		    type {
-			coords {100 18}
-			font type1
-			text TYPA
-			anchor w
-			color \#444444
-		    }
-		    cfmu {
-			coords {200 18}
-			font type1
-			text 08:26
-			anchor e
-			color \#444444
-		    }
-		    ptsid {
-			coords {100 40}
-			font type2
-			text NIPOR
-			anchor w
-			color \#444444
-		    }
-		    confsid {
-			coords {158 40}
-			font type2
-			text 8G
-			anchor center
-			color \#444444
-		    }
-		    park {
-			coords {200 40}
-			font type2
-			text G23
-			anchor e
-			color \#444444
-		    }
-		    dest {
-			coords {10 66}
-			font type2
-			text DEST
-			anchor w
-			color \#555555
-		    }
-		    champ1 {
-			type rect
-			coords {45 56 135 76}
-			filled 1
-			fillcolor ch1
-			linecolor white
-			linewidth 0
-		    }
-		    bret {
-			coords {200 66}
-			font type2
-			text Bret.
-			anchor e
-			color \#444444
-		    }
-		}
-	    }
-	    zreco {
-		coords {210 3 346 82}
-		atomic 1
-		priority 200
-		texture stripped_texture.gif
-		sensitive 1
-		tags edit
-		linewidth 2
-		filled 1
-		relief sunken
-		linecolor \#deecff
-		fillcolor \#d3e5ff
-	    }
-	}
-	zinfo {
-	    coords {0 86}
-	    rectcoords {0 0 340 20}
-	    shadowcoords {8 8 348 28}
-	    shadowcolor shad
-	    atomic 1
-	    priority 200
-	    sensitive 1
-	    tags edit2
-	    linewidth 2
-	    linecolor \#aaccff
-	    fillcolor back
-	    relief roundraised
-	    fields {
-		ssr {
-		    coords {4 10}
-		    font type3
-		    text 7656
-		    anchor w
-		    color \#444444
-		}
-		pdep {
-		    coords {47 10}
-		    font type3
-		    text G23
-		    anchor center
-		    color \#444444
-		}
-		qfu {
-		    coords {73 10}
-		    font type3
-		    text 09R
-		    anchor center
-		    color \#444444
-		}
-		slabel {
-		    coords {105 10}
-		    font type3
-		    text vit:
-		    anchor e
-		    color \#444444
-		}
-		speed {
-		    coords {106 10}
-		    font type3
-		    text 260
-		    anchor w
-		    color \#444444
-		}
-		pper {
-		    coords {142 10}
-		    font type3
-		    text EPL
-		    anchor center
-		    color \#444444
-		}
-		rfl {
-		    coords {166 10}
-		    font type3
-		    text 210
-		    anchor center
-		    color \#444444
-		}
-		cautra {
-		    coords {183 10}
-		    font type3
-		    text 8350
-		    anchor w
-		    color \#444444
-		}
-		nsect {
-		    coords {219 10}
-		    font type3
-		    text MOD
-		    anchor w
-		    color \#444444
-		}
-		day {
-		    coords {297 10}
-		    font type3
-		    text 21/05/02
-		    anchor e
-		    color \#444444
-		}
-		hour {
-		    coords {332 10}
-		    font type3
-		    text 13:50
-		    anchor e
-		    color \#444444
-		}
-	    }
-	    
-	}
-    }
-
-
-
-    proc TLGetHash {list tag} {
-	array set temp $list
-	if { [info exists temp($tag)] } {
-	    return $temp($tag)
-	}
-	return ""
-    }
-    
-    proc TLGet {list tag} {
-	foreach {key val} $list {
-	    if { [string compare $key $tag] == 0 } {
-		#	    puts "TLGet found \"$val\" for \"$key\""
-		return $val
-	    }
-	}
-	#    puts "Unknown tag $tag in $list"
-	return ""
-    }
-    
-    
-    # Création du Strip
-    proc createStrip {index x y style} {
-	variable w
-	variable stripGradients
-	variable stripFontSet
-	variable textures 
-	variable imagePath
-	
-	# initialise les gradients
-	if { [llength $stripGradients] == 0 } {
-	    foreach {name gradient} [TLGet $style gradSet] {
-		# création des gradiants nommés
-		if {! [$w.zinc gname $name]} {
-		    $w.zinc gname $gradient $name
-		}
-		# the previous test is usefull only
-		# when this script is executed many time in the same process
-		# (it is typically the case in zinc-demos)
-		lappend stripGradients $name
-	    }  
-	}
-	
-	# initialise les jeux de fontes 
-	if { ![llength $stripFontSet] } {
-	    set stripFontSet [TLGet $style fontSet]
-	}
-	
-	# création du groupe de base : coords
-	set g1 [$w.zinc add group 1 -priority 100 -tags "base$index"]
-	$w.zinc coords $g1 [list $x $y]
-	
-	# group de transfo 1 : scaling (à partir du coin haut droit)
-			    set g2 [$w.zinc add group $g1 -tags "scaling$index"]    
-	
-	#-------------------------------------------------------------
-	# réalisation du strip lui même (papier support + ombre portée
-	#-------------------------------------------------------------
-	
-	# params strip
-	set stripw [TLGet $style width]
-	set striph [TLGet $style height]
-	
-	# ombre portée
-	$w.zinc add rectangle $g2 [TLGet $style shadowcoords] \
-	    -filled 1 -linewidth 0 -fillcolor [TLGet $style shadowcolor] \
-	    -priority 10 -tags "shadow$index"
-	
-	# strip
-	set sstyle [TLGet $style strip]
-	set strip [$w.zinc add rectangle $g2 [list 0 0 $stripw $striph] -filled 1 \
-		       -linewidth [TLGet $sstyle linewidth] \
-		       -linecolor [TLGet $sstyle linecolor] \
-		       -fillcolor [TLGet $sstyle fillcolor] \
-		       -relief [TLGet $sstyle relief] \
-		       -priority 20 -tags "strip$index"]
-	
-	set texName [TLGet $sstyle texture]
-	if { [llength $texName] != 0 } {
-	    if { ! [info exists textures(strip)] } {
-		set textures(strip) [image create photo -file [file join $imagePath $texName]]
-	    }
-	    $w.zinc itemconfigure $strip -tile $textures(strip)
-	}
-	
-	
-	#-------------------------------------------------
-	# ajout de la zone des boutons (à droite du strip)
-	#-------------------------------------------------
-	set bStyle [TLGet $style buttons]
-	if { [llength $bStyle] != 0 } {
-	    # le groupe de la zone bouton
-	    set btnGroup [$w.zinc add group $g2 -priority 40]
-	    $w.zinc coords $btnGroup [TLGet $bStyle coords]
-	    
-	    # sa zone de clipping
-	    set btnClip [$w.zinc add rectangle $btnGroup [TLGet $bStyle clipcoords] \
-			     -filled 0 -visible 0]
-	    
-	    # le clipping du groupe bouton
-	    $w.zinc itemconfigure $btnGroup -clip $btnClip
-	    
-	    # zone bouton
-	    set bZone [TLGet $bStyle zone]
-	    $w.zinc add rectangle $btnGroup [TLGet $bZone coords] \
-		-filled 1 -linewidth [TLGet $bZone linewidth] \
-		-fillcolor [TLGet $bZone fillcolor] -composescale 0 \
-		-tags "content$index"
-	    
-	    set btns [TLGet $bStyle btns]
-	    foreach {name btnStyle} $btns {
-		#	    puts "bouton $name $btnStyle"
-		
-		set sGroup [$w.zinc add group $btnGroup -atomic 1 -sensitive 1 \
-				-composescale 0 -tags [list "$name$index" "content$index"]]
-		
-		$w.zinc add rectangle $sGroup [TLGet $btnStyle coords] \
-		    -filled 1 -visible 0 -priority 100	
-		$w.zinc add curve $sGroup [TLGet $btnStyle arrow] \
-		    -closed 1 -filled 1 -priority 50 \
-		    -linewidth [TLGet $btnStyle linewidth] \
-		    -linecolor [TLGet $btnStyle linecolor] \
-		    -fillcolor [TLGet $btnStyle fillcolor]
-		set lab [TLGet $btnStyle label]
-		$w.zinc add text $sGroup -priority 60 \
-		    -position [TLGet $lab coords] -text [TLGet $lab text] \
-		    -font [TLGet $lab font] -color [TLGet $lab color] \
-		    -anchor [TLGet $lab anchor]
-	    }
-	    
-	    # bindings boutons Up et Down du Strip
-	    $w.zinc bind "btnup$index" <1> ::groupsInAtcStrips::extendedStrip
-	    $w.zinc bind "btndn$index" <1> ::groupsInAtcStrips::smallStrip    
-	}
-	
-	# construction du contenu du strip
-	buildContent $index $g2 100 $style
-	
-	# et de la barre d'extension info (extended format)
-	buildExtent $index $g2 [TLGet $style zinfo]
-    }
-    
-    # Construction des zones internes du Strips
-    proc buildContent {index parent priority style} {
-	variable w
-	variable textures
-	variable stripFontSet
-	variable imagePath
-	
-	# group content
-	set g3 [$w.zinc add group $parent -priority $priority]
-	
-	# zone de clipping
-	set clip [$w.zinc add rectangle $g3 [TLGet $style clipcoords] \
-		      -filled 0 -visible 0]
-	
-	# clipping du groupe content
-	$w.zinc itemconfigure $g3 -clip $clip
-	
-	# création d'un group intermédiaire pour bloquer le scaling
-	set g4 [$w.zinc add group $g3 -composescale 0 -tags "content$index"]
-	
-	# création des zones
-	set zones [TLGet $style zones]
-	foreach {name zoneStyle} $zones {
-	    # group de zone
-	    set gz [$w.zinc add group $g4]
-	    
-	    if { [TLGet $zoneStyle atomic] } {
-		$w.zinc itemconfigure $gz -atomic 1 \
-		    -sensitive [TLGet $zoneStyle sensitive] \
-		    -priority [TLGet $zoneStyle priority] \
-		    -tags [concat "$name$index" [TLGet $zoneStyle tags]]
-	    }
-	    
-	    set rectZone [$w.zinc add rectangle $gz [TLGet $zoneStyle coords] \
-			      -filled [TLGet $zoneStyle filled] \
-			      -linewidth [TLGet $zoneStyle linewidth] \
-			      -linecolor [TLGet $zoneStyle linecolor] \
-			      -fillcolor [TLGet $zoneStyle fillcolor] \
-			      -relief [TLGet $zoneStyle relief] \
-			      -priority 10 -tags "$name$index"]
-	    
-	    set texName [TLGet $zoneStyle texture]
-	    if { [llength $texName] != 0 } {
-		if { ! [info exists textures($name)] } {
-		    set textures($name) [image create photo \
-					     -file [file join $imagePath $texName]]
-		}
-		$w.zinc itemconfigure $rectZone -tile $textures($name)
-	    }
-	    
-	    set fields [TLGet $zoneStyle fields]
-	    set fontStyle [TLGet $stripFontSet normal]
-	    foreach {field fieldStyle} $fields {
-		set fsType [TLGet $fieldStyle type]
-		if { $fsType == "rect" } {
-		    $w.zinc add rectangle $gz [TLGet $fieldStyle coords] \
-			-filled [TLGet $fieldStyle filled] \
-			-fillcolor [TLGet $fieldStyle fillcolor] \
-			-linewidth [TLGet $fieldStyle linewidth] \
-			-linecolor [TLGet $fieldStyle linecolor] \
-			-priority 20
-		} else {
-		    set font [TLGet $fieldStyle font]
-		    # puts "buildContent field:$field font:$font"
-		    $w.zinc add text $gz -position [TLGet $fieldStyle coords] \
-			-text [TLGet $fieldStyle text] \
-			-font [TLGet $fontStyle $font] \
-			-color [TLGet $fieldStyle color] \
-			-anchor [TLGet $fieldStyle anchor] \
-			-priority 30 -tags "$font$index"
-		}	    
-	    }
-	}
-    }
+  font create dfont -family Helvetica -size 10 -weight bold
+  font create radar-b15 -family helvetica -size 16 -slant roman -weight bold
+  font create radar-b12 -family helvetica -size 12 -slant roman -weight bold
+  font create radar-b10 -family helvetica -size 10 -slant roman -weight bold
+  font create radar-m18 -family helvetica -size 18 -slant roman -weight normal
+  font create radar-m20 -family helvetica -size 20 -slant roman -weight normal
+
+  set fontsets(scales) {1.2 normal 10 large}
+  set fontsets(normal,callsign) radar-b15
+  set fontsets(normal,type1) radar-b12
+  set fontsets(normal,type2) radar-b10
+  set fontsets(normal,type3) radar-b10
+  set fontsets(large,callsign) radar-m20
+  set fontsets(large,type1) radar-m18
+  set fontsets(large,type2) radar-b15
+  set fontsets(large,type3) radar-b12
+
+  image create photo backtex -data {
+    R0lGODlhIAAgAPcAALi4uLe3t7a2trS0tLOzs7KysrGxsbCwsK+vr66urq2traysrKurq6qq
+    qqmpqaioqKenp6ampqWlpaSkpKOjo6KioqGhoaCgoJ+fn56enp2dnZycnJubm5qampmZmZiY
+    mJeXl5aWlpWVlZSUlJOTk5KSkpGRkZCQkI+Pj46Ojo2NjYyMjIuLi4qKiomJiYiIiIeHh4aG
+    hoWFhYSEhIODg4KCgoGBgYCAgH9/f35+fn19fXx8fHt7e3p6enl5eXh4eHR0dAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAAAAAAALAAAAAAgACAABwj/ADto4ABCAwgS
+    Ijps4NAhA4cJE0SIcJjhggUKDxxcGBEixAiGAz04oEDwQ4cQJjiU+MBhxAcNIzZMkGDBQgQI
+    FDyEwGCBw4YNHShQMFhQQwcLIj5sAMEhAwkOEiSczFABQ0uaHjowLLhBxM4IEi54wFCBZQUO
+    HixgGCECw9oPKSRw+OChroYJFECY+JAhQwkTGjCUGHEBgwi0JTo8qHCCA4oHHT6w1GBwRIcJ
+    DyxIrvAgwswKGz5SnLD2RImHHRRqWNjUQoULGfZ2ABGi6VIMeCVAEEwhAwYKEkMUvPD652+X
+    IVCkCBGYpwXfFTKEgKCho3AQIDAU3lB3A2wLGkSQ/zhawUJX00o1ZBCRIsXF1+A/gMjqwaTb
+    urgnfCCB4sQIEArNRsIIE0RQgXonhZDVByKogFx2Qik3wm8ZyKdgZEKpBOBCHmDnAQl0SbRB
+    TSKYIMIFE2hAFwoeZOBBZx2ckBIFmrmEgQQPUHASB27lZSIIInhQAQp3XbDdWB+gwIKD3vGF
+    F3caULBAByqY4AGPETAwAVomWQABCHT5NJtlGag1l0AcmLCcehdI4IAFIJRwAgkXMJBUYBl0
+    MMIJUeGlVl8ooECCdxlocEEEPYVQAgkeXAAUCCMM5oEGDDwwQQXlZbBBCSF4Z5VWq6n30wcj
+    DBSnCSFckKNVdXUYZGCrbf/gG1sbVDBTeEwV6hNnhUbmoUKazmeBBBNEpgFNE4BXwlisanCW
+    enONRdMFHYBoa19eWbUBT/95IEKgIPgF4EGl6rYlpxdoYCIMMgSqkAgSJLDABTx6oAIEB26b
+    7pUkgBCVVhC0KFAGGVFgAoACVUABBpbCtlpkHiw6V5UYrHCCg3xVyGC4GPxkJGwdiFDCoubJ
+    GoIKJICWZgiupesABhl49kEImvrWkgkuUVBBVBuAOEEDEoAZ3U9yQRWBehB4VxVDVDF1UXiH
+    HehfV0HS25BDI2bFAUMcGApimfQCaWAIH4QlJXEZAClZTBB3HapvxIEWQgQRbE1qBxF8ABsJ
+    JFRaBAIDiFYQwQPIWl1mzymUkMKgW28QQa1vahduX5T3hUEDcFIWQgeAURAa2R8kXSZ2HNBp
+    kWuYnnX0eBzUNkIGQ3WgHQaPu3XYUOq5BXOhG0iwaUO1pvBfCAEBADs=
+  }
+
+  image create photo striptex -data {
+    R0lGODlhCgBQAID/ALbd9tnn6ywAAAAACgBQAAACNYyPmcDtCqN0FMiL68Nc6daFx8eIImmZ
+    HaquZMux8CXPUW17bw7h/Lj7IXxC4s/IQ+aUNmYBADuioNSSFFMFXrHZ7mMr8YpZ4LE5AX6d
+    m+X1Oe1+t+NiOJ1UAAA7
+  }
+
+  ##########################################
+  # Zinc
+  ##########################################
+  grid [zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 \
+      -lightangle 130 -tile backtex] -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
+
+  $w.zinc gname {=axial 90|#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a} idnt 
+  $w.zinc gname {#c1daff|#8aaaff} back 
+  $w.zinc gname {=path -40 -40|#000000;50 0|#000000;50 92|#000000;0 100} shad
+  $w.zinc gname {#ffeedd|#8a9acc} btnOutside
+  $w.zinc gname {=axial 180|#ffeedd|#8a9acc} btnInside
+  $w.zinc gname {#8aaaff|#5b76ed} ch1
+
+  set anim(delay) 50;	# ms between each animation steps
+  set anim(steps) 6;	# number of steps for the animation
+
+  #
+  # The strip building routine
+  proc Strip { } {
+    variable scale
+    variable w
+    #
+    # Creating the object group
+    set stripG [$w.zinc add group 1]
+    #
+    # Add a group for all items that will need scaling
+    set scaleG [$w.zinc add group $stripG -tags scaling]    
+    #
+    # Add add background shadow
+    $w.zinc add rectangle $scaleG {8 8 374 94} -filled 1 -linewidth 0 \
+        -fillcolor shad -tags shadow
+    # 
+    # This is the strip background
+    $w.zinc add rectangle $scaleG {0 0 340 86} -filled 1 \
+        -linewidth 3 -linecolor {#aaccff} -fillcolor back -relief roundraised
+    #
+    # Add a group for the two size change buttons.
+    set btnGroup [$w.zinc add group $scaleG]
+    $w.zinc translate $btnGroup 340 0 true
+    #
+    # Clip the button group to a rectangular shape that will
+    # be scaled with the rest of the strip.
+    $w.zinc itemconfigure $btnGroup -clip [$w.zinc add rectangle $btnGroup {0 0 90 83} -visible no]
+    # 
+    # Here the cylindrical background of the button area.
+    # The scale is not inherited to preserve the cylindrical
+    # relief of the area, this is explain the need for a
+    # clipping on btnGroup.
+    $w.zinc add rectangle $btnGroup {0 0 26 85} -filled 1 -linewidth 0 \
+        -fillcolor btnOutside -composescale 0 -tags content
     
-    # Construction de la barre d'extension info du Strip
-    proc buildExtent {index parent infoStyle} {
-	variable w
-	variable textures
-	variable stripFontSet 
-	variable imagePath
-	
-	# group content
-	set extGroup [$w.zinc add group $parent]
-	$w.zinc coords $extGroup [TLGet $infoStyle coords]
-	$w.zinc itemconfigure $extGroup -visible 0 \
-	    -atomic [TLGet $infoStyle atomic] \
-	    -sensitive [TLGet $infoStyle sensitive] \
-	    -priority [TLGet $infoStyle priority] \
-	    -tags [concat "zinfo$index" [TLGet $infoStyle tags]]
-	
-	# ombre portée
-	$w.zinc add rectangle $extGroup [TLGet $infoStyle shadowcoords] \
-	    -filled 1 -linewidth 0 -priority 10 -tags "shadow$index" \
-	    -fillcolor [TLGet $infoStyle shadowcolor]
-	
-	set rectZone [$w.zinc add rectangle $extGroup [TLGet $infoStyle rectcoords] \
-			  -filled 1 -priority 20 \
-			  -linewidth [TLGet $infoStyle linewidth] \
-			  -linecolor [TLGet $infoStyle linecolor] \
-			  -fillcolor [TLGet $infoStyle fillcolor] \
-			  -relief [TLGet $infoStyle relief]]
-	
-	set texName [TLGet $infoStyle texture]
-	if { [llength $texName] != 0 } {
-	    if { ! [info exists textures(zinfo)] } {
-		set textures(zinfo) [image create photo \
-					 -file [file join $imagePath $texName]]
-	    }
-	    $w.zinc itemconfigure $rectZone -tile $textures(zinfo)
-	}
-	
-	set fields [TLGet $infoStyle fields]
-	set fontStyle [TLGet $stripFontSet normal]
-	foreach {field fieldStyle} $fields {
-	    set fsType [TLGet $fieldStyle type]
-	    if { $fsType == "rect" } {
-		$w.zinc add rectangle $extGroup [TLGet $fieldStyle coords] \
-		    -filled [TLGet $fieldStyle filled] \
-		    -fillcolor [TLGet $fieldStyle fillcolor] \
-		    -linewidth [TLGet $fieldStyle linewidth] \
-		    -linecolor [TLGet $fieldStyle linecolor] \
-		    -priority 40
-	    } else {
-		set font [TLGet $fieldStyle font]
-		# puts "buildContent field:$field font:$font"
-		$w.zinc add text $extGroup -position [TLGet $fieldStyle coords] \
-		    -text [TLGet $fieldStyle text] \
-		    -font [TLGet $fontStyle $font] \
-		    -color [TLGet $fieldStyle color] \
-		    -anchor [TLGet $fieldStyle anchor] \
-		    -priority 50 -tags "$font$index"
-	    }	
-	}
-    }
-    
-    # initialisation des bindings généraux dy Strip
-    proc initBindings {moveTag scaleTag} {
-	variable w
-	
-	$w.zinc bind $moveTag <1> "::groupsInAtcStrips::catchStrip %x %y"
-	$w.zinc bind $moveTag <ButtonRelease> ::groupsInAtcStrips::releaseStrip
-	$w.zinc bind $moveTag <B1-Motion> "::groupsInAtcStrips::motionStrip %x %y"
-	
-	$w.zinc bind $scaleTag <Double-Button-1> ::groupsInAtcStrips::microStrip
-    }
-    
-    # Callback CATCH de début de déplacement du Strip
-    proc catchStrip {x y} {
-	variable w
-	variable dx
-	variable dy
-	
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-	foreach {lx ly} [$w.zinc coords "base$index"] break
-	set dx [expr $lx - $x]
-	set dy [expr $ly - $y]
-	
-	$w.zinc itemconfigure "base$index" -priority 200
-    }
-
-    # Callback MOVE de fin de déplacement du Strip
-    proc motionStrip {x y} {
-	variable w
-	variable dx
-	variable dy
-
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-	$w.zinc coords "base$index" [list [expr $x + $dx] [expr $y + $dy]]
-    }
-
-    # Callback RELEASE de fin de déplacement du Strip
-    proc releaseStrip {} {
-	variable w
-
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-	$w.zinc itemconfigure "base$index" -priority 100
-    }
-
-    # Zoom Strip : normal format
-    proc normalStrip {} {
-	variable w
-
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-	$w.zinc itemconfigure "input$index" -sensitive 1
-
-	displayRecoZone $index 1
-	displayExtentZone $index 0
-	configButtons $index extendedStrip smallStrip
-	changeStripFormat $index 1 1 0 1
-    }
-
-    # Zoom Strip : small format (lignes 1 et 2)
-    proc smallStrip {} {
-	variable w
-
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-
-	displayRecoZone $index 0
-	configButtons $index normalStrip 0
-	changeStripFormat $index 1 0.63 0 1
-    }
-
-    # Zoom Strip : micro format (zone ident)
-    proc microStrip {} {
-	variable w
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-	
-	configButtons $index normalStrip 0
-	changeStripFormat $index 0.28 0.63 0 1
-	
-    }
-
-    # Zoom Strip : extendedFormat
-    proc extendedStrip {} {
-	variable w
-
-	set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
-
-	$w.zinc itemconfigure "input$index" -sensitive 0
-	$w.zinc itemconfigure "base$index" -priority 150
-	displayRecoZone $index 0
-	displayExtentZone $index 1
-	configButtons $index 0 normalStrip
-	changeStripFormat $index 1.3 1.3 1 1.3
-    }
-
-
-    # affiche/masque la zone Reco
-    proc displayRecoZone {index state} {
-	variable w
-
-	set priority [expr $state ? 200 : 0]
-	$w.zinc itemconfigure "zreco$index" -priority $priority
+    ArrowButton $btnGroup + {0 0 26 43} {14 2 24 40 1 40 14 2} {13 27} [list $stripG more content]
+    ArrowButton $btnGroup - {0 43 26 86} {14 83 24 43 1 43 14 83} {13 56} [list $stripG less content]
+   
+    #
+    # This group will get the strip useful content. Its area is clipped.
+    set clippedContent [$w.zinc add group $scaleG]
+    $w.zinc itemconfigure $clippedContent \
+        -clip [$w.zinc add rectangle $clippedContent {3 3 332 80} -visible 0]
+    # 
+    # One more group to control whether the scale is inherited or not.
+    set content [$w.zinc add group $clippedContent -composescale 0 -tags content]
+    # 
+    # The strip is divided into functional textual zones.
+    # They are created here.
+    set input [Zone $content {3 3 334 82} 0 white back {} flat [list $stripG scale input]]
+    TextField $input TYPA type1 {100 18} {#444444} w
+    TextField $input 08:26 type1 {200 18} {#444444} e
+    TextField $input NIPOR type2 {100 40} {#444444} w
+    TextField $input 8G type2 {158 40} {#444444} center
+    TextField $input G23 type2 {200 40} {#444444} e
+    TextField $input DEST type2 {10 66} {#555555} w
+    TextField $input Bret. type2 {200 66} {#444444} e
+    RectField $input {45 56 135 76} ch1
+
+    Zone $content {210 3 346 82} 2 {#deecff} {#d3e5ff} striptex sunken {zreco edit}
+
+    set ident [Zone $content {3 3 90 50} 1 {#ffeedd}  idnt {} sunken [list $stripG move]]
+    $w.zinc raise $ident
+    TextField $ident EWG361 callsign {10 18} {#000000} w
+    TextField $ident Eurowing type2 {10 34} {#444444} w
+    #
+    # Add and extension area beneath the main strip
+    # This extension is shown when the strip is shown in its
+    # extended form.
+    set extent [$w.zinc add group $scaleG -atomic yes -tags {zinfo edit2}]
+    $w.zinc translate $extent 0 86 true
+    # 
+    # Add a background shadow.
+    $w.zinc add rectangle $extent {8 8 348 28} \
+        -filled 1 -linewidth 0 -tags shadow -fillcolor shad
+    #
+    # This is the extention background
+    $w.zinc add rectangle $extent {0 0 340 20} -filled 1 \
+        -linewidth 2 -linecolor {#aaccff} -fillcolor back -relief roundraised
+    TextField $extent 7656 type3 {4 10} {#444444} w
+    TextField $extent G23 type3 {47 10} {#444444} center
+    TextField $extent 09R type3 {73 10} {#444444} center
+    TextField $extent vit: type3 {105 10} {#444444} e
+    TextField $extent 260 type3 {106 10} {#444444} w
+    TextField $extent EPL type3 {142 10} {#444444} center
+    TextField $extent 210 type3 {166 10} {#444444} center
+    TextField $extent 8350 type3 {183 10} {#444444} w
+    TextField $extent MOD type3 {219 10} {#444444} w
+    TextField $extent 21/05/02 type3 {297 10} {#444444} e
+    TextField $extent 13:50 type3 {332 10} {#444444} e
+    DisplayExtentZone $stripG no
+
+  #
+  # Preset the scale and font size of the layout
+    set scale($stripG,x) 1.0
+    set scale($stripG,y) 1.0
+    set scale($stripG,fontset) normal
+
+    return $stripG
+  }
+      
+  proc ArrowButton {top text coords arrow labelpos tags} {
+    variable w
+    set sGroup [$w.zinc add group $top -atomic 1 -composescale 0 -tags $tags]
+    $w.zinc add rectangle $sGroup $coords -filled 1 -visible 0
+    $w.zinc add curve $sGroup $arrow -closed 1 -filled 1 \
+        -linewidth 1  -linecolor {#aabadd} -fillcolor btnInside
+    $w.zinc add text $sGroup -position $labelpos -text $text \
+        -font radar-m20 -color {#ffffff} -anchor center
+  }
+
+  proc RectField {top coords fillcolor} {
+    variable w
+    $w.zinc add rectangle $top $coords -linewidth 0 -filled yes \
+        -fillcolor $fillcolor
+  }
+
+  proc TextField {top text fonttype coords color anchor} {
+    variable w
+    variable fontsets
+    $w.zinc add text $top -position $coords -text $text -font $fontsets(normal,$fonttype) \
+        -color $color -anchor $anchor -tags $fonttype
+  }
+
+  proc Zone {top coords linewidth linecolor fillcolor texture relief tags} {
+    variable w
+  #
+  # Zone group
+    set gz [$w.zinc add group $top -atomic 1 -tags $tags]
+  #
+  # Zone background
+    set rectZone [$w.zinc add rectangle $gz $coords \
+                      -filled yes -linewidth $linewidth -linecolor $linecolor \
+                      -fillcolor $fillcolor -relief $relief]
+    if { $texture ne "" } { 
+      $w.zinc itemconfigure $rectZone -tile $texture
     }
 
+    return $gz
+  }
 
-    # affiche/masque la zone Extent
-    proc displayExtentZone {index state} {
-	variable w
-
-	$w.zinc itemconfigure "zinfo$index" -visible $state -sensitive $state
-    }
-
-    # Configure affichage et callbacks des boutons du Strip
-    proc configButtons {index funcUp funcDown} {
-	variable w
-
-	# button Up
-	if { $funcUp != 0 } {
-	    $w.zinc itemconfigure "btnup$index" -visible 1
-	    $w.zinc bind "btnup$index" <1> ::groupsInAtcStrips::$funcUp
-	} {
-	    $w.zinc itemconfigure "btnup$index" -visible 0
-	}
-
-	# button Down
-	if { $funcDown != 0 } {
-	    $w.zinc itemconfigure "btndn$index" -visible 1
-	    $w.zinc bind "btndn$index" <1> ::groupsInAtcStrips::$funcDown
-	} {
-	    $w.zinc itemconfigure "btndn$index" -visible 0
-	}
-    }
-
+  #
+  # Called when the user click on the strip's identification area.
+  proc CatchStrip {x y} {
+    variable w
+    variable dx
+    variable dy
     
-    # this function has been hacked to provide the user with an animation
-    # The animation is (too) simple but provide a better feedback than without
-    proc changeStripFormat {index xratio yratio composeflag fontratio} {
-	variable w
-	variable dx
-	variable dy
-	variable scales
-	variable steps
-	variable delay
-
-	# réinitialisation du groupe scaling
-	$w.zinc treset "scaling$index"
-
-	# configure le blocage de transformation du format des champs
-	$w.zinc itemconfigure "content$index" -composescale $composeflag
-
-	# applique le nouveau scaling
-	if { ![info exists scales($index)] } {
-	    set scales($index) {1 1}
-	}
-	foreach {oldXratio oldYratio} $scales($index) {}
-	set scales($index) [list $xratio $yratio]
-	set dx [expr ($xratio - $oldXratio) / $steps]
-	set dy [expr ($yratio - $oldYratio) / $steps]
-	_resize $index $delay [expr $oldXratio+$dx] [expr $oldYratio+$dy] $dx $dy $steps
-	setFontes $index $yratio
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    foreach {lx ly} [$w.zinc coords $strip] break
+    set dx [expr {$lx - $x}]
+    set dy [expr {$ly - $y}]
+    $w.zinc raise $strip
+  }
+
+  #
+  # Called when the mouse drag the strip
+  proc MotionStrip {x y} {
+    variable w
+    variable dx
+    variable dy
+
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    $w.zinc translate $strip [expr $x + $dx] [expr $y + $dy] true
+  }
+
+  #
+  # ExtendedStrip, NormalStrip, SmallStrip, MicroStrip
+  # Those functions controls the transition from the current
+  # strip layout to the named layout.
+  # They are bonud to the resize buttons to the right of
+  # the strip.
+  proc NormalStrip {} {
+    variable w
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    $w.zinc itemconfigure $strip*input -sensitive 1
+
+    DisplayRecoZone $strip yes
+    DisplayExtentZone $strip no
+    ConfigButtons $strip ExtendedStrip SmallStrip
+    ChangeStripFormat $strip 1 1 no
+  }
+
+  proc SmallStrip {} {
+    variable w
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    DisplayRecoZone $strip no
+    ConfigButtons $strip NormalStrip {}
+    ChangeStripFormat $strip 1 0.63 no
+  }
+
+  proc MicroStrip {} {
+    variable w
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    ConfigButtons $strip NormalStrip {}
+    ChangeStripFormat $strip 0.28 0.63 no
+  }
+
+  proc ExtendedStrip {} {
+    variable w
+    set strip [lindex [$w.zinc itemcget current -tags] 0]
+    $w.zinc itemconfigure $strip*input -sensitive 0
+    $w.zinc raise $strip
+    DisplayRecoZone $strip no
+    DisplayExtentZone $strip yes
+    ConfigButtons $strip {} NormalStrip
+    ChangeStripFormat $strip 1.3 1.3 yes
+  }
+
+  #
+  # Controls the display of the gesture recognition area.
+  proc DisplayRecoZone {strip bool} {
+    variable w
+    $w.zinc itemconfigure $strip*zreco -visible $bool
+  }
+
+  #
+  # Controls the display of the extended information area.
+  proc DisplayExtentZone {strip bool} {
+    variable w
+    $w.zinc itemconfigure $strip*zinfo -visible $bool -sensitive $bool
+  }
+
+  #
+  # Update the scaling buttons to reflect the current
+  # layout of the strip.
+  proc ConfigButtons {strip funcUp funcDown} {
+    variable w
+    if { $funcUp ne "" } {
+      $w.zinc itemconfigure $strip*more -visible 1
+      $w.zinc bind more <1> ::groupsInAtcStrips::$funcUp
+    } {
+      $w.zinc itemconfigure $strip*more -visible 0
     }
-
-    proc _resize {index delay newXratio newYratio dx dy steps} {
-	variable w
-
-	$w.zinc treset "scaling$index"
-	$w.zinc scale "scaling$index" $newXratio $newYratio
-	# jeu de fontes
-	incr steps -1
-	if { $steps > 0 } {
-	    after $delay [list ::groupsInAtcStrips::_resize $index $delay [expr $newXratio+$dx] \
-			      [expr $newYratio+$dy] $dx $dy $steps]
-	}
-	#puts [::profiler::print]
+    if { $funcDown ne "" } {
+      $w.zinc itemconfigure $strip*less -visible 1
+      $w.zinc bind less <1> ::groupsInAtcStrips::$funcDown
+    } {
+      $w.zinc itemconfigure $strip*less -visible 0
     }
-
-    proc getFKey {ratio} {
-	variable ratio2FontSet
-
-	foreach param $ratio2FontSet {
-	    foreach {maxRatio fKey} $param {}
-	    set newfKey $fKey
-	    if { $ratio < $maxRatio } {
-		return $newfKey;
-	    }
-	}
-
-	return $newfKey;
+  }
+
+  #
+  # Change the strip size hiding information has needed.
+  # Uses an animation to highlight the state change to te user.
+  proc ChangeStripFormat {strip xscale yscale composeflag} {
+    variable w
+    variable scale
+    variable anim
+    #
+    # Adjust the scale inheritance of the content area 
+    $w.zinc itemconfigure $strip*content -composescale $composeflag
+    #
+    # Compute the scaling animation and start it.
+    # At the same time if needed switch to bigger/smaller fonts.
+    set dx [expr {($xscale - $scale($strip,x)) / $anim(steps)}]
+    set dy [expr {($yscale - $scale($strip,y)) / $anim(steps)}]
+    set newXScale [expr {$scale($strip,x) + $dx}]
+    set newYScale [expr {$scale($strip,y) + $dy}]
+    set scale($strip,x) $xscale
+    set scale($strip,y) $yscale
+    SetFontes $strip
+    ::groupsInAtcStrips::ResizeAnim $strip $newXScale $newYScale $dx $dy $anim(steps)
+  }
+
+  #
+  # This is the animation stepping function
+  proc ResizeAnim {strip xscale yscale dx dy steps} {
+    variable w
+    variable anim
+    $w.zinc treset $strip*scaling
+    $w.zinc scale $strip*scaling $xscale $yscale
+    incr steps -1
+    if { $steps > 0 } {
+      after $anim(delay) [list ::groupsInAtcStrips::ResizeAnim $strip [expr {$xscale+$dx}] \
+                        [expr {$yscale+$dy}] $dx $dy $steps]
     }
-
-
-    proc setFontes {index ratio} {
-	variable w
-	variable stripFontSet
-	variable oldFKey
-
-	set newFKey [getFKey $ratio]    
-	if {![info exists oldFKey] || ([string compare $oldFKey $newFKey] != 0) } {
-	    set fontStyle [TLGet $stripFontSet $newFKey]
-	    #puts "setFontes $oldFKey -> $newFKey"
-	    if { [llength $fontStyle] != 0 } {
-		foreach type {callsign type1 type2 type3} {
-		    $w.zinc itemconfigure "$type$index" -font [TLGet $fontStyle $type]
-		}
-	    }
-	    set oldFKey $newFKey
-	}
+  }
+
+  proc SetFontes {strip} {
+    variable w
+    variable scale
+    variable fontsets
+    #
+    # Find a fontset matching the current y scale
+    foreach {maxScale fs} $fontsets(scales) {
+      if { $scale($strip,y) < $maxScale } break
     }
-
-
-    # test Strips
-    for {set xn 10; set yn 30; set index 0} {$index < 4} {incr index; incr xn 50; incr yn 120} {
-	createStrip $index $xn $yn $stripStyle
+    if { $scale($strip,fontset) ne $fs } {
+      foreach type {callsign type1 type2 type3} {
+        $w.zinc itemconfigure $strip*$type -font $fontsets($fs,$type)
+      }
     }
-
-    initBindings move scale
+    set scale($strip,fontset) $fs
+  }
+  #
+  # Initialization of user input bindings..
+  $w.zinc bind more <1> ::groupsInAtcStrips::ExtendedStrip
+  $w.zinc bind less <1> ::groupsInAtcStrips::SmallStrip
+  $w.zinc bind move <1> {::groupsInAtcStrips::CatchStrip %x %y}
+  $w.zinc bind move <B1-Motion> {::groupsInAtcStrips::MotionStrip %x %y}
+  $w.zinc bind scale <Double-Button-1> ::groupsInAtcStrips::MicroStrip
+
+  #
+  # Generate a handful of strips
+  for {set xn 10; set yn 30; set i 0} {$i < 4} {incr i; incr xn 50; incr yn 120} {
+    $w.zinc translate [Strip] $xn $yn true
+  }
 }
diff --git a/demos/magicLens.tcl b/demos/magicLens.tcl
index 3a50e72..f9b8d00 100644
--- a/demos/magicLens.tcl
+++ b/demos/magicLens.tcl
@@ -1,306 +1,185 @@
 #-----------------------------------------------------------------------------------
+# MagicLens.tcl
 #
-#      MagicLens.pl
-#
-#      This small demo is based on Zinc::Graphics.pm for creating
-#      the graphic items.
-#      The magnifyer effect is obtained with the help of clipping,
-#      and some glass effect is based on color transparency through
-#      a triangles item bordering the magnifier
+#  This small demo shows the use of groups, transformations, clipping
+#  gradients and multi-contour curves to produce a structured and non
+#  trivial small application
 #
 #      Authors: Jean-Luc Vinot <vinot@cena.fr>
-#		Patrick Lecoanet (Translation to Tcl).
+#		            Patrick Lecoanet (Translation to Tcl).
 #
-# $Id: 
 #-----------------------------------------------------------------------------------
 
 if {![info exists zincDemo]} {
-    error "This script should be run from the zinc-widget demo."
+  error "This script should be run from the zinc-widget demo."
 }
 
-package require zincGraphics
-
 namespace eval magicLens {
-    variable font9b 7x13bold
-    variable font8 7x13
-
-    variable basicColors {
-	{Jaune \#fff52a \#f1f1f1 \#6a6611}
-	{"Jaune\nOrangé" \#ffc017 \#cfcfcf \#6b510a}
-	{Orangé \#ff7500 \#a5a5a5 \#622d00}
-	{Rouge \#ff2501 \#8b8b8b \#620e00}
-	{Magenta \#ec145d \#828282 \#600826}
-	{"Violet\nRouge" \#a41496 \#636363 \#020940}
-	{"Violet\nBleu" \#6a25b6 \#555555 \#2a0f48}
-	{Bleu \#324bde \#646464 \#101846}
-	{Cyan \#0a74f0 \#818181 \#064a9a}
-	{"Bleu\nVert" \#009bb4 \#969696 \#006474}
-	{Vert \#0fa706 \#979797 \#096604}
-	{"Jaune\nVert" \#9dd625 \#c9c9c9 \#496311}
-    }
-
-    variable circleCoords {
-	{0 -30} {-16.569 -30 c} {-30 -16.569 c} {-30 0}
-	{-30 16.569 c} {-16.569 30 c} {0 30}
-	{16.569 30 c} {30 16.569 c} {30 0}
-	{30 -16.569 c} {16.569 -30 c} {0 -30}
-    }
-
-
-    # MagicLens
-    variable lensItems {
-	back {
-	    -itemtype arc
-	    -coords {{-100 -100} {100 100}}
-	    -params {
-		-priority 10
-		-closed 1
-		-filled 1
-		-visible 0
-		-tags lensback
-	    }
-	}
-	light {
-	    -itemtype pathline
-	    -metacoords {
-		-type polygone
-		-coords {0 0}
-		-numsides 36
-		-radius 100
-		-startangle 240
-	    }
-	    -linewidth 10
-	    -shifting right
-	    -closed 1
-	    -graduate {
-		-type double
-		-colors {
-		    { \#ffffff;0 \#6666cc;0 \#ffffff;0 }
-		    { \#ffffff;100 \#333399;50 \#ffffff;100 }
-		}
-	    }
-	    -params {
-		-priority 50
-	    }
-	}
-	bord {
-	    -itemtype hippodrome
-	    -coords {{-100 -100} {100 100}}
-	    -params {
-		-priority 100
-		-closed 1
-		-filled 0
-		-linewidth 2
-		-linecolor \#222266;80
-	    }
-	}
-    }
-    
-
-    proc SetBindings {} {
-	variable zinc
-	variable w
-
-	$zinc bind lens <1> {::magicLens::LensStart %x %y}
-	$zinc bind lens <B1-Motion> {::magicLens::LensMove %x %y}
-	$zinc bind lens <ButtonRelease> {::magicLens::LensStop %x %y}
-
-	focus $w
-
-	# Up, Down, Right, Left : Translate
-	bind $w <Up> {::magicLens::LensTranslate up}
-	bind $w <Down> {::magicLens::LensTranslate down}
-	bind $w <Left> {::magicLens::LensTranslate left}
-	bind $w <Right> {::magicLens::LensTranslate right}
-    }
-
-
-    #-----------------------------------------------------------------------------------
-    # Lens Start Move Callback
-    #-----------------------------------------------------------------------------------
-    proc LensStart {x y} {
-	variable dx 
-	variable dy
-
-	set dx [expr 0 - $x]
-	set dy [expr 0 - $y]
-
-    }
-
-
-    #-----------------------------------------------------------------------------------
-    # Lens Move Callback.
-    #-----------------------------------------------------------------------------------
-    proc LensMove {x y} {
-	variable dx
-	variable dy
-	variable zoom
-	variable zinc
-	variable infoView
-	
-	$zinc translate current [expr $x + $dx] [expr $y + $dy]
-	$zinc translate lenszone [expr $x + $dx] [expr $y + $dy]
-	set dx [expr 0 - $x]
-	set dy [expr 0 - $y]
-
-	foreach {lx ly} [$zinc coords lens 0 0] break
-	$zinc coords $infoView [list [expr $lx * (1 - $zoom)] \
-				    [expr $ly * (1 - $zoom)]]
-    }
-
-
-    #-----------------------------------------------------------------------------------
-    # Lens Release Callback (End of a Move)
-    #-----------------------------------------------------------------------------------
-    proc LensStop {x y} {
-	LensMove $x $y
-    }
 
-    proc LensTranslate {way} {
-	variable zoom
-	variable zinc
-	variable infoView
-	
-	set dx 0
-	set dy 0
-	switch -- $way {
-	    left {set dx -10}
-	    up {set dy -10}
-	    right {set dx 10}
-	    down {set dy 10}
-	}
-	
-	$zinc translate lens $dx $dy
-	$zinc translate lenszone $dx $dy
-	foreach {lx ly} [$zinc coords lens 0 0] break
-	$zinc coords $infoView [list [expr $lx * (1 - $zoom)] \
-				    [expr $ly * (1 - $zoom)]]
+  image create photo paper -data {
+    R0lGODlhIAAgALMAAAAAAP///6ysrKKiogAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+    AAAAAAAAACH5BAAAAAAALAAAAAAgACAAAwSzUIgxpKzzTmqprximgRxpdaQ3ot0YZm8Gfyp8
+    fhuYc9stXzxVqCTT2Wy6F1HZGyaPJRGwuIvOejfpMrgSxbBHDTXFihp/LW2V7EUxrVLkzLyU
+    s4CpWJKHNffbaXI4LU1VhUJoRV5vTVtXOWVQgSaIXHF1hJWQlHF3aXo+NV1zLos/W08moaWP
+    lp6Eo0Z8kGKpdrNZSLaruHV8e4e/RIYuV2eGT4Ktbr9/kpc7p6Wud4iNAhEAOw==
+  }
+
+  font create magfont -family Helvetica -size 13 -weight bold
+  font create nfont -family Helvetica -size 11 -weight normal
+
+  #
+  # The basics colors, one per column.
+  set basicColors {
+    {Yellow {#fff52A} {#f1f1f1} {#6a6611}}
+    {"Yellow\nOrange" {#ffc017} {#cfcfcf} {#6b510a}}
+    {Orange {#ff7500} {#a5a5a5} {#622d00}}
+    {Red {#ff2501} {#8b8b8b} {#620e00}}
+    {Magenta {#ec145d} {#828282} {#600826}}
+    {"Red\nViolet" {#a41496} {#636363} {#020940}}
+    {"Violet\nBlue" {#6a25b6} {#555555} {#2a0f48}}
+    {Blue {#324bde} {#646464} {#101846}}
+    {Cyan {#0a74f0} {#818181} {#064a9a}}
+    {"Green\nBlue" {#009bb4} {#969696} {#006474}}
+    {Green {#0fa706} {#979797} {#096604}}
+    {"Yellow\nGreen" {#9dd625} {#c9c9c9} {#496311}}
+  }
+
+  #
+  # Compute a set of interpolated colors
+  #
+  proc CreateGraduate {steps color1 color2} {
+    scan $color1 {#%2x%2x%2x} r1 g1 b1
+    scan $color2 {#%2x%2x%2x} r2 g2 b2
+    set colors [list]
+    for {set i 0} {$i < $steps} {incr i} {
+      set ratio [expr {$i/($steps-1.0)}]
+      lappend colors [format {#%02x%02x%02x} \
+                          [expr {$r1 + int(($r2 - $r1) * $ratio)}] \
+                          [expr {$g1 + int(($g2 - $g1) * $ratio)}] \
+                          [expr {$b1 + int(($b2 - $b1) * $ratio)}]]
     }
-
-
-    variable w .magicLens
-    catch {destroy $w}
-    toplevel $w
-    wm title $w "Color Magic Lens Demonstration"
-    wm geometry $w "1000x900+0+0"
-    wm iconname $w magicLens
-
-    grid [button $w.dismiss -text Dismiss -command "destroy $w"]  -row 2 -column 0 -pady 10    
-    grid [button $w.code -text "See Code" -command "showCode $w"]  -row 2 -column 1 -pady 10 
-
-    # Create a Zinc instance
-    variable zinc [zinc $w.z -render 1 -width 1000 -height 900 -borderwidth 0 \
-		       -lightangle 140 -backcolor \#cccccc]
-    grid $zinc  -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 imagePath [file join $::zinc_demos images]
-    variable texture [image create photo -file [file join $imagePath paper-grey1.gif]]
-    variable lensTexture [image create photo -file [file join $imagePath paper-grey.gif]]
-    $zinc configure -tile $texture
-
-    # Create the views
-    variable normView [$zinc add group 1 -priority 100]
-    variable lensView [$zinc add group 1 -priority 200]
-    variable infoView [$zinc add group $lensView]
-
-    variable zoom 1.20
-    $zinc scale $infoView $zoom $zoom
-
-    $zinc add rectangle $infoView {{0 0} {1000 900}} \
-	-filled 1 -fillcolor \#000000 -tile $lensTexture -linewidth 0
-
-    variable x 60
-    for {set i 0} {$i < 12} {incr i} {
-
-	# Add a group in each view
-	set cGroup [$zinc add group $normView]
-	$zinc coords $cGroup [list $x 60]
-	set lGroup [$zinc add group $infoView]
-	$zinc coords $lGroup [list $x 60]
-
-	# Color Description : name, Saturated saturée, Unsaturated ZnColor, Shadow ZnColor
-	foreach {colorName saturColor greyColor shadColor} [lindex $basicColors $i] break
-
-	# Sample of saturated color + relief
-	set refGrad "=radial -12 -20|#ffffff 0|$saturColor 40|$shadColor 100"
-	set refItem [$zinc add curve $cGroup $circleCoords \
-			 -filled 1 -fillcolor $refGrad -linewidth 2 -priority 100]
-
-	# Clone into infoView group
-	set clone [$zinc clone $refItem]
-	$zinc chggroup $clone $lGroup
-
-	# Color label in infoView
-	$zinc add text $lGroup -priority 200 -position {0 0} \
-	    -text $colorName -anchor center -alignment center -font $font9b -spacing 2
-
-	# Color gradient toward a gray with same light
-	set barGrad "=axial 270|$saturColor|$greyColor"
-
-	# Create the color samples (Multi contours curve)
-	set gradBar [$zinc add curve $cGroup {} -closed 1 -filled 1 -fillcolor $barGrad \
-			 -linewidth 2 -priority 20 -fillrule nonzero]
-
-	# Create main gradient colors (saturation 100% -> 0%) and trim alpha
-	# channel off.
-	set znColors [list]
-	foreach color [zincGraphics::CreateGraduate 11 [list $saturColor $greyColor]] {
-	    lappend znColors [lindex [split $color ";"] 0]
-	}
-
-	# Create intermediate steps between colors (saturation -> desaturation)
-	for {set c 0} {$c < 11} {incr c} {
-	    # Color of the current step
-	    set color [lindex $znColors $c]
-	    
-	    # Create a zinc item for the color
-	    set sample [$zinc clone $refItem -fillcolor $color]
-	    $zinc translate $sample 0 [expr 65*($c+1)]
-	    
-	    # Add its shape to the multi-contours curve
-	    $zinc contour $gradBar add 1 $sample
-	    
-	    # Move the item to the info group
-	    $zinc chggroup $sample $lGroup
-	    
-	    # Text of label (% saturation + ZnColor)
-	    set txtColor "[expr ((10 - $c)*10)]%\n$color"
-	    $zinc add text $lGroup -priority 200 -position [list 0 [expr ($c + 1)* 65]] \
-		-text $txtColor -anchor center -alignment center -font $font8 -spacing 2 \
-		-composescale 0
-	}
-
-	incr x 80
+    return $colors
+  }
+
+  set dx 0
+  set dy 0
+  set zoom 1.20
+  set width 1000
+  set height 900
+  set simpleLens 1
+
+  variable w .magicLens
+  catch {destroy $w}
+  toplevel $w
+  wm title $w "Color Magic Lens Demonstration"
+  wm geometry $w "1000x900+0+0"
+  wm iconname $w magicLens
+  #
+  # Create a Zinc instance
+  pack [zinc $w.zinc -render 1 -width $width -height $height -borderwidth 0 \
+         -tile paper -backcolor {#cccccc}] -expand yes -fill both
+  #
+  # The main view. The unzoomed world is here.
+  $w.zinc add group 1 -tags normview
+  #
+  # The hidden view. It holds the hidden world.
+  # It is clipped by the lens shape.
+  $w.zinc add group 1 -tags hiddenview
+  #
+  # Create the lens itself. It is made of an atomic
+  # group, a back to catch the mouse events and a
+  # border. The back is not visible but remain sensitive.
+  if { $simpleLens } {
+    $w.zinc add arc 1 {{-100 -100} {100 100}} -tags {lens lensback} \
+          -linewidth 2 -linecolor {#222266;80} -filled 1 -fillcolor {#ffffff;0}
+  } {
+    $w.zinc add group 1 -atomic yes -tags lens
+    $w.zinc add arc lens {{-100 -100} {100 100}} -tags lensborder -linewidth 2 \
+        -linecolor {#222266;80}
+    $w.zinc clone lensborder -filled yes -visible no -tags lensback
+  }
+  #
+  # Add the clipping shape to the hidden view so that we can view
+  # the magnified view only within the lens.
+  $w.zinc clone lensback -visible yes -filled yes -tile paper \
+       -fillcolor {#ffffff;100} -tags {lens lenszone}
+  $w.zinc chggroup lenszone hiddenview true
+  $w.zinc itemconfigure hiddenview -clip lenszone
+  #
+  # The zoomed view is inside the hidden view.
+  $w.zinc add group hiddenview -tags magview
+  $w.zinc scale magview $zoom $zoom
+  #
+  # Create the vertical color stripes in both normal and magnified views.
+  # In the normal view multi-contours curves are used, they are filled
+  # with vertical axial gradients. In the magnified view arc items are
+  # used filled with solid colors.
+  set x 60
+  foreach colorDesc $basicColors {
+    #
+    # Color Description : name, Saturated, Unsaturated, Shadow
+    foreach {colorName satColor greyColor shadColor} $colorDesc break
+    #
+    # Add a group in each view
+    set normGroup [$w.zinc add group normview]
+    $w.zinc translate $normGroup $x 60 yes
+    set magGroup [$w.zinc add group magview]
+    $w.zinc translate $magGroup $x 60 yes
+    #
+    # Reference color on a ball shaped item.
+    set refBall [$w.zinc add arc $normGroup {{-30 -30} {30 30}} \
+          -fillcolor "=radial -12 -20|white 0|$satColor 40|$shadColor 100" \
+          -linewidth 2 -filled 1]
+    #
+    # Clone the reference ball and move it into the magview group
+    $w.zinc chggroup [$w.zinc clone $refBall] $magGroup
+    #
+    # Add the color name in magview
+    $w.zinc add text $magGroup -text $colorName -anchor center \
+         -alignment center -font magfont -spacing 2
+    #
+    # Create the color samples (Multi contours curve)
+    set gradientBar [$w.zinc add curve $normGroup {} -linewidth 2 \
+         -filled 1 -fillcolor "=axial 270|$satColor|$greyColor"]
+    #
+    # Create intermediate steps between colors (saturated -> unsaturated)
+    set c 0
+    foreach color [CreateGraduate 11 $satColor $greyColor] {
+      # Create a zinc item for the color
+      set sample [$w.zinc clone $refBall -fillcolor $color]
+      $w.zinc translate $sample 0 [expr {65*($c+1)}]
+      # 
+      # Add its shape to the multi-contours gradient bar
+      $w.zinc contour $gradientBar add 1 $sample
+      #
+      # Move the item to the maggroup
+      $w.zinc chggroup $sample $magGroup
+      # 
+      # Text of label Saturation % + Color.
+      set sampleText [$w.zinc add text $magGroup -text "[expr {((10 - $c)*10)}]%\n$color" \
+          -anchor center -alignment center -font nfont -composescale no]
+      $w.zinc translate $sampleText 0 [expr {65*($c+1)}]
+      incr c
     }
-
-    # Create the lens itself
-    variable lensGroup [$zinc add group 1 -priority 300 -atomic 1 -tags lens]
-    $zinc coords $lensGroup {300 110}
-    variable dx 0
-    variable dy 0
-    LensMove 0 0
-
-    # Graphical items defining the lens
-    foreach {name style} $lensItems {
-	zincGraphics::BuildZincItem $zinc $lensGroup $style {} $name
-    }
-
-    # Add a clipping shape to lensView
-    set lensZone [$zinc clone lensback -tags lenszone]
-    $zinc chggroup $lensZone $lensView true
-    $zinc itemconfigure $lensView -clip $lensZone
-
-    variable consigne [$zinc add text 1 -position {30 840} -font $font8 -alignment left \
-			   -color \#ffffff -spacing 2 \
-			   -text "<Up>, <Down>, <Left> and <Right> keys or <Mouse Drag>
-Move the Magic Color Lens behind the color gradiants
-to see the ZnColor value of Hue/saturation"]
-
-    variable cClone [$zinc clone $consigne -font $font9b]
-    $zinc chggroup $cClone $infoView
-
-    SetBindings
+    incr x 80
+  }
+  #
+  # Add the caption text.
+  $w.zinc add text normview -position {30 840} -font nfont -tags blurb -color white \
+      -text "Move the Magic Lens on a color to see the color value and saturation"
+  $w.zinc chggroup [$w.zinc clone blurb -font magfont] magview
+  #
+  # Lens motion callback proc.
+  proc LensMove {x y} {
+    variable w
+    variable zoom
+    $w.zinc translate lens $x $y yes
+    $w.zinc translate magview [expr {$x * (1-$zoom)}]  [expr {$y * (1-$zoom)}] yes
+  }
+  #
+  # The bindings needed to drag the lens.
+  $w.zinc bind lens <B1-Motion> {::magicLens::LensMove %x %y}
+  #
+  # Lets put the lens somewhere within the window area.
+  LensMove 300 110
 }