path: root/demos/groupsInAtcStrips.tcl

#-----------------------------------------------------------------------------------
#
#      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: 
#-----------------------------------------------------------------------------------
#      This small application illustrates both the use of groups in combination
#         of -composescale attributes and an implementation of kind of air traffic
#         control electronic strips.
#      However it is only a simplified example given as is, without any immediate usage!
#
#      3 strips formats are accessible through "+" / "-" buttons on the right side
#
#      1.   small-format: with 2 lines of info, and reduced length
#
#      2.   normal-format: with 3 lines of info, full length
#
#      3.  extended-format: with 3 lines of infos, full length
#                           the 3 lines are zoomed
#                           an additionnel 4th lone is displayed
#
#      An additionnal 4th format (micro-format) is available when double-clicking somewhere...
#
#      Strips can be moved around by drag&drop from the callsign
#
#      When changing size, strips are animated. The animation is a very simple one,
#        which should be enhanced.... You can change the animation parameters, by modifyng
#        $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

    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 [demosPath] 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



    ###########################################
    # Text zone
    #######################
    ####################

    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
	the use of groups for an advanced graphic design.
	The following interactions are possible:
	"drag&drop button1" on the callsign.
	"button 1" triangle buttons on the right side of the strips
	to modify strips size
	"double click 1" on the blueish zone to fully reduce size}


    ###########################################
    # Zinc
    ##########################################
    image create photo texture -file \
	[file join [demosPath] 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"
		}	    
	    }
	}
    }
    
    # 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
    }


    # 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
	}
    }

    
    # 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
    }

    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]
    }

    proc getFKey {ratio} {
	variable ratio2FontSet

	foreach param $ratio2FontSet {
	    foreach {maxRatio fKey} $param {}
	    set newfKey $fKey
	    if { $ratio < $maxRatio } {
		return $newfKey;
	    }
	}

	return $newfKey;
    }


    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
	}
    }


    # 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
    }

    initBindings move scale
}