Ported from Perl code.

1 files changed, 610 insertions, 655 deletions

diff --git a/demos/groupsInAtcStrips.tcl b/demos/groupsInAtcStrips.tcl
index c5739f1..b373b26 100644
--- a/demos/groupsInAtcStrips.tcl
+++ b/demos/groupsInAtcStrips.tcl
@@ -1,4 +1,3 @@
-#!/usr/bin/perl -w
 #-----------------------------------------------------------------------------------
 #
 #      Copyright (C) 2002
@@ -45,6 +44,8 @@ if {![info exists zincDemo]} {
     error "This script should be run from the zinc-widget demo."
 }
 
+#package require profiler
+#::profiler::init
 
 set w .groupsInAtcStrips
 catch {destroy $w}
@@ -53,6 +54,7 @@ wm title $w "Atc electronic strips using groups"
 wm iconname $w groupsInAtcStrips
 
 set defaultfont [font create -family Helvetica -size 10 -weight bold]
+set imagePath [file join $zinc_library demos images]
 
 frame $w.buttons
 pack $w.buttons -side bottom -fill x -pady 2m
@@ -89,823 +91,776 @@ zinc $w.zinc -render 1 -width 700 -height 500 -borderwidth 0 -lightangle 130 -ti
 pack $w.zinc -fill both -expand 1
 
 
+set stripGradients {}
+set stripFontSet {}
 
-my @stripGradiants;
-my %stripFontset;
-my %textures;
 
-my $oldfkey;
-my ($dx, $dy);
-
-my $delay = 50; # ms between each animation steps
-my $steps = 6;  # number of steps for the animation
-my %scales;     # this hash just memorizes the current x and y scaling ratio
+set delay 50;	# ms between each animation steps
+set 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
 #----------------------
-my $fnb10 = 'cenapii-digistrips-b10';
-my $fnb10c = 'cenapii-digistrips-b10c';
-my $fnb11 = 'cenapii-digistrips-b11';
-my $fnb12 = 'cenapii-digistrips-b12';
-my $fnb15 = 'cenapii-radar-b15';
-my $fnm20 = 'cenapii-radar-m20';
-my $fne18 = 'cenapii-radar-m18';
-
-my @ratio2fontset = ([1.2, 'normal'],
-		     [10, 'large']);
-
-my %stripstyle = (-gradset => {'idnt' => '#ffffff 0|#ffeedd 30|#e9d1ca 90|#e9a89a/90',
-			       'back' => '#c1daff|#8aaaff/0',
-			       'shad' => '#000000:50 0|#000000:50 92|#000000:0 100[200 -100',
-			       'btn_outside' => '#ffeedd|#8a9acc/0', 
-			       'btn_inside' => '#ffeedd|#8a9acc/180',
-			       'ch1' => '#8aaaff|#5B76ED/0',
-			   },
-		  
-		  -fontset => {'normal' => {'callsign' => $fnb15,
-					    'type1' => $fnb12,
-					    'type2' => $fnb10,
-					    'type3' => $fnb10c,
-					},
-			       
-			       'large' => {'callsign' => $fnm20,
-					   'type1' => $fne18,
-					   'type2' => $fnb15,
-					   'type3' => $fnb12,
-				       },
-			   },
-		  
-		  -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 => 'btn_outside',
-					 -linewidth => 0,
-				     },
-			    
-			       -btns => {'btnup' => {-coords => [0, 0, 26, 43],
-						     -arrow => [14, 2, 24, 40,
-								1, 40, 14, 2],
-						     -linewidth => 1,
-						     -linecolor => '#aabadd',
-						     -fillcolor => 'btn_inside',
-						     -label => {-coords => [13, 27],
-								-text => "+",
-								-font => $fnm20,
-								-color => '#ffffff',
-								-anchor => 'center',
-							    },
-						 },
-					 
-					 'btndn' => {-coords => [0, 43, 26, 86],
-						     -arrow => [14, 83, 24, 43,
-								1, 43, 14, 83],
-						     -linewidth => 1,
-						     -linecolor => '#aabadd',
-						     -fillcolor => 'btn_inside',
-						     -label => {-coords => [13, 56],
-								-text => "-",
-								-font => $fnm20,
-								-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',
-					      },
-			     },
-					 
-			  },
-		  );
-
-
-
-#------------------------
-# creation du widget Zinc
-
-
-my ($xn, $yn) = (10, 30);
-
-# test Strips
-for (my $index = 0; $index < 4 ; $index++) {
-    
-    &createStrip($index, $xn, $yn, \%stripstyle);
 
-    $xn += 50;
-    $yn += 120;
+set ratio2FontSet {{1.2 normal} {10 large}}
 
+set 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 cenapii-radar-b15
+	    type1 cenapii-digistrips-b12
+	    type2 cenapii-digistrips-b10
+	    type3 cenapii-digistrips-b10c
+	}
+	large {
+	    callsign cenapii-radar-m20
+	    type1 cenapii-radar-m18
+	    type2 cenapii-radar-b15
+	    type3 cenapii-digistrips-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 cenapii-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 cenapii-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
+	    }
+	}
+	
+    }
 }
 
 
-&initBindings('move', 'scale');
-
-
-	 
-
-Tk::MainLoop;
+proc TLGetHash {list tag} {
+    array set temp $list
+    if { [info exists temp($tag)] } {
+	return $temp($tag)
+    }
+    return ""
+}
 
-#----------------------------------------------------------------------- fin de MAIN
+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
-sub createStrip {
-    my ($index, $x, $y, $style) = @_;
-
-    # initialise les gradiants
-    unless (@stripGradiants) {
-	my %gradiants = %{$style->{'-gradset'}};
-	my ($name, $gradiant);
-	while (($name, $gradiant) = each(%gradiants)) {
+proc createStrip {index x y style} {
+    global w stripGradients stripFontSet textures imagePath
+
+    # initialise les gradients
+    if { [llength $stripGradients] == 0 } {
+	foreach {name gradient} [TLGet $style gradSet] {
 	    # création des gradiants nommés
-	    $zinc->gname($gradiant, $name) unless $zinc->gname($gradiant);
+	    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)
-
-	    push(@stripGradiants, $name);
+	    lappend stripGradients $name
 	}  
     }
-  
+    
     # initialise les jeux de fontes 
-    unless (%stripFontset) {
-	%stripFontset = %{$style->{'-fontset'}};
+    if { ![llength $stripFontSet] } {
+	set stripFontSet [TLGet $style fontSet]
     }
-
+    
     # création du groupe de base : coords
-    my $g1 = $zinc->add('group', 1, -priority => 100, -tags => ["base".$index]);
-    $zinc->coords($g1, [$x, $y]);
-
+    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)
-    my $g2 = $zinc->add('group', $g1, -tags => ["scaling".$index]);
-
-
+    set g2 [$w.zinc add group $g1 -tags "scaling$index"]    
+    
     #-------------------------------------------------------------
     # réalisation du strip lui même (papier support + ombre portée
     #-------------------------------------------------------------
     
     # params strip
-    my $stripw = $style->{'-width'};
-    my $striph = $style->{'-height'};
+    set stripw [TLGet $style width]
+    set striph [TLGet $style height]
     
     # ombre portée
-    $zinc->add('rectangle', $g2,
-	       $style->{'-shadowcoords'},
-	       -filled => 1,
-	       -linewidth => 0,
-	       -fillcolor => $style->{'-shadowcolor'},
-	       -priority => 10,
-	       -tags => ["shadow".$index],
-	       );
-
+    $w.zinc add rectangle $g2 [TLGet $style shadowcoords] \
+	-filled 1 -linewidth 0 -fillcolor [TLGet $style shadowcolor] \
+	-priority 10 -tags "shadow$index"
 
     # strip
-    my $sstyle = $style->{'-strip'};    
-    my $strip = $zinc->add('rectangle', $g2,
-			   [0, 0, $stripw, $striph],
-			   -filled => 1,
-			   -linewidth => $sstyle->{'-linewidth'},
-			   -linecolor => $sstyle->{'-linecolor'},
-			   -fillcolor => $sstyle->{'-fillcolor'},
-			   -relief => $sstyle->{'-relief'},
-			   -priority => 20,
-			   -tags => ["strip".$index],
-			   );
-
-    if ($sstyle->{'-texture'}) {
-	if (!exists($textures{'-strip'})) {
-	    my $texture = $zinc->Photo($sstyle->{'-texture'}, -file => "$image_path/$sstyle->{'-texture'}");
-	    $textures{'-strip'} = $texture;
+    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]]
 	}
-	    
-	$zinc->itemconfigure($strip, -tile => $textures{'-strip'});
+	$w.zinc itemconfigure $strip -tile $textures(strip)
     }
     
 
     #-------------------------------------------------
     # ajout de la zone des boutons (à droite du strip)
     #-------------------------------------------------
-    if ($style->{'-buttons'}) {
-	my $bstyle = $style->{'-buttons'};
-
+    set bStyle [TLGet $style buttons]
+    if { [llength $bStyle] != 0 } {
 	# le groupe de la zone bouton
-	my $btngroup = $zinc->add('group', $g2, -priority => 40);
-	$zinc->coords($btngroup, $bstyle->{'-coords'});
+	set btnGroup [$w.zinc add group $g2 -priority 40]
+	$w.zinc coords $btnGroup [TLGet $bStyle coords]
 
 	# sa zone de clipping
-	my $btnclip = $zinc->add('rectangle', $btngroup,
-				 $bstyle->{'-clipcoords'},
-				 -filled => 0,
-				 -visible => 0,
-				 );
+	set btnClip [$w.zinc add rectangle $btnGroup [TLGet $bStyle clipcoords] \
+			 -filled 0 -visible 0]
 	
 	# le clipping du groupe bouton
-	$zinc->itemconfigure($btngroup, -clip => $btnclip);
+	$w.zinc itemconfigure $btnGroup -clip $btnClip
 	
 	# zone bouton
-	$zinc->add('rectangle', $btngroup,
-		   $bstyle->{'-zone'}->{'-coords'},
-		   -filled => 1,
-		   -linewidth => $bstyle->{'-zone'}->{'-linewidth'},
-		   -fillcolor => $bstyle->{'-zone'}->{'-fillcolor'},
-		   -composescale => 0,
-		   -tags => ["content".$index],
-		   );
-	
-
-	my %btns = %{$bstyle->{'-btns'}};
-	my ($name, $btnstyle);
-	while (($name, $btnstyle) = each(%btns)) {
-#	    print "bouton $name $btnstyle\n";
-
-	    my $sgroup = $zinc->add('group', $btngroup,
-				    -atomic => 1,
-				    -sensitive => 1,
-				    -composescale => 0,
-				    -tags => [$name.$index, "content".$index],
-				    );
-
-	    $zinc->add('rectangle', $sgroup,
-		       $btnstyle->{'-coords'},
-		       -filled => 1,
-		       -visible => 0,
-		       -priority => 100,
-		       );
-	
-	    $zinc->add('curve', $sgroup,
-		       $btnstyle->{'-arrow'},
-		       -closed => 1,
-		       -filled => 1,
-		       -linewidth => $btnstyle->{'-linewidth'},
-		       -linecolor => $btnstyle->{'-linecolor'},
-		       -fillcolor => $btnstyle->{'-fillcolor'},
-		       -priority => 50,
-		       );
-
-	    $zinc->add('text', $sgroup,
-		       -position => $btnstyle->{'-label'}->{'-coords'},
-		       -text => $btnstyle->{'-label'}->{'-text'},
-		       -font => $btnstyle->{'-label'}->{'-font'},
-		       -color => $btnstyle->{'-label'}->{'-color'},
-		       -anchor => $btnstyle->{'-label'}->{'-anchor'},
-		       -priority => 60,
-		       );
+	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
-	$zinc->bind('btnup'.$index, '<1>', \&extendedStrip);
-	$zinc->bind('btndn'.$index, '<1>', \&smallStrip);
+	$w.zinc bind "btnup$index" <1> extendedStrip
+	$w.zinc bind "btndn$index" <1> smallStrip
 	
     }
 
     # construction du contenu du strip
-    &buildContent($index, $g2, 100, $style);
+    buildContent $index $g2 100 $style
 
     # et de la barre d'extension info (extended format)
-    &buildExtent($index, $g2, $style->{'-zinfo'});
+    buildExtent $index $g2 [TLGet $style zinfo]
 
 }
 
 
 # Construction des zones internes du Strips
-sub buildContent {
-    my ($index, $parent, $priority, $style) = @_;
-    
+proc buildContent {index parent priority style} {
+    global w textures stripFontSet imagePath
+
     # group content
-    my $g3 = $zinc->add('group', $parent, -priority => $priority);
+    set g3 [$w.zinc add group $parent -priority $priority]
 
     # zone de clipping
-    my $clip = $zinc->add('rectangle', $g3,
-			  $style->{'-clipcoords'},
-			  -filled => 0,
-			  -visible => 0,
-			  );
+    set clip [$w.zinc add rectangle $g3 [TLGet $style clipcoords] \
+		  -filled 0 -visible 0]
     
     # clipping du groupe content
-    $zinc->itemconfigure($g3, -clip => $clip);
+    $w.zinc itemconfigure $g3 -clip $clip
 
     # création d'un group intermédiaire pour bloquer le scaling
-    my $g4 = $zinc->add('group', $g3,
-			-composescale => 0,
-			-tags => ["content".$index],
-			);
+    set g4 [$w.zinc add group $g3 -composescale 0 -tags "content$index"]
     
     # création des zones
-    my %zones = %{$style->{'-zones'}};
-    my ($name, $zonestyle);
-    while (($name, $zonestyle) = each(%zones)) {
+    set zones [TLGet $style zones]
+    foreach {name zoneStyle} $zones {
 	# group de zone
-	my $gz = $zinc->add('group', $g4);
-
-	if ($zonestyle->{'-atomic'}) {
-	    $zinc->itemconfigure($gz, -atomic => 1,
-				 -sensitive => $zonestyle->{'-sensitive'},
-				 -priority => $zonestyle->{'-priority'},
-				 -tags => [$name.$index, $zonestyle->{'-tags'}],
-				 );
+	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]]
 	}
 	
-	my $rectzone = $zinc->add('rectangle', $gz,
-				  $zonestyle->{'-coords'},
-				  -filled => $zonestyle->{'-filled'},
-				  -linewidth => $zonestyle->{'-linewidth'},
-				  -linecolor => $zonestyle->{'-linecolor'},
-				  -fillcolor => $zonestyle->{'-fillcolor'},
-				  -relief => $zonestyle->{'-relief'},
-				  -priority => 10,
-				  -tags => [$name.$index],
-				  );
-
-	if ($zonestyle->{'-texture'}) {
-	    if (!exists($textures{$name})) {
-		my $texture = $zinc->Photo($zonestyle->{'-texture'}, -file => "$image_path/$zonestyle->{'-texture'}");
-		$textures{$name} = $texture;
+	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]]
 	    }
-
-	    $zinc->itemconfigure($rectzone, -tile => $textures{$name});
+	    $w.zinc itemconfigure $rectZone -tile $textures($name)
 	}
 
-
-	my %fields;
-	%fields = %{$zonestyle->{'-fields'}} if (defined $zonestyle->{'-fields'}) ;
-	my ($field, $fieldstyle);
-	my $fontsty = $stripFontset{'normal'};
-	while ( ($field, $fieldstyle) = each(%fields) ) {
-	    if ($fieldstyle->{'-type'} and $fieldstyle->{'-type'} eq 'rect') {
-		$zinc->add('rectangle', $gz,
-			   $fieldstyle->{'-coords'},
-			   -filled => $fieldstyle->{'-filled'},
-			   -fillcolor => $fieldstyle->{'-fillcolor'},
-			   -linewidth => $fieldstyle->{'-linewidth'},
-			   -linecolor => $fieldstyle->{'-linecolor'},
-			   -priority => 20,
-			   );
-		} else {
-		
-		    my $font = $fieldstyle->{'-font'};
-#		    print "buildContent field:$field font:$font\n";
-		    $zinc->add('text', $gz,
-			       -position => $fieldstyle->{'-coords'},
-			       -text => $fieldstyle->{'-text'},
-			       -font => $fontsty->{$font},
-			       -color => $fieldstyle->{'-color'},
-			       -anchor => $fieldstyle->{'-anchor'},
-			       -priority => 30,
-			       -tags => [$font.$index],
-			       );
-		}
-		
+	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
-sub buildExtent {
-    my ($index, $parent, $infostyle) = @_;
-    
-    # group content
-    my $extgroup = $zinc->add('group', $parent);
-    $zinc->coords($extgroup, $infostyle->{'-coords'});
+proc buildExtent {index parent infoStyle} {
+    global w textures stripFontSet imagePath
 
-    $zinc->itemconfigure($extgroup,
-			 -atomic => $infostyle->{'-atomic'},
-			 -sensitive => $infostyle->{'-sensitive'},
-			 -priority => $infostyle->{'-priority'},
-			 -visible => 0,
-			 -tags => ["zinfo".$index, $infostyle->{'-tags'}],
-			 );
+    # 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
-    $zinc->add('rectangle', $extgroup,
-	       $infostyle->{'-shadowcoords'},
-	       -filled => 1,
-	       -linewidth => 0,
-	       -fillcolor => $infostyle->{'-shadowcolor'},
-	       -priority => 10,
-	       -tags => ["shadow".$index],
-	       );
+    $w.zinc add rectangle $extGroup [TLGet $infoStyle shadowcoords] \
+	-filled 1 -linewidth 0 -priority 10 -tags "shadow$index" \
+	-fillcolor [TLGet $infoStyle shadowcolor]
     
-    my $rectzone = $zinc->add('rectangle', $extgroup,
-  			      $infostyle->{'-rectcoords'},
-  			      -filled => 1,
-  			      -linewidth => $infostyle->{'-linewidth'},
-  			      -linecolor => $infostyle->{'-linecolor'},
-  			      -fillcolor => $infostyle->{'-fillcolor'},
-  			      -relief => $infostyle->{'-relief'},
-  			      -priority => 20,
-  			      );
-
-    if ($infostyle->{'-texture'}) {
-  	if (!exists($textures{'-zinfo'})) {
-  	    my $texture = $zinc->Photo($infostyle->{'-texture'}, -file => "$image_path/$infostyle->{'-texture'}");
-  	    $textures{'-zinfo'} = $texture;
+    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]]
   	}
-  	$zinc->itemconfigure($rectzone, -tile => $textures{'-zinfo'});
-	
+  	$w.zinc itemconfigure $rectZone -tile $textures(zinfo)
     }
 
-    my %fields = %{$infostyle->{'-fields'}};
-    my ($field, $fieldstyle);
-    my $fontsty = $stripFontset{'normal'};
-    while (($field, $fieldstyle) = each(%fields)) {
-	if ($fieldstyle->{'-type'} and $fieldstyle->{'-type'} eq 'rect') {
-	    $zinc->add('rectangle', $extgroup,
-		       $fieldstyle->{'-coords'},
-		       -filled => $fieldstyle->{'-filled'},
-		       -fillcolor => $fieldstyle->{'-fillcolor'},
-		       -linewidth => $fieldstyle->{'-linewidth'},
-		       -linecolor => $fieldstyle->{'-linecolor'},
-		       -priority => 40,
-		       );
+    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 {
-	    
-	    my $font = $fieldstyle->{'-font'};
-#	    print "buildContent field:$field font:$font\n";
-	    $zinc->add('text', $extgroup,
-		       -position => $fieldstyle->{'-coords'},
-		       -text => $fieldstyle->{'-text'},
-		       -font => $fontsty->{$font},
-		       -color => $fieldstyle->{'-color'},
-		       -anchor => $fieldstyle->{'-anchor'},
-		       -priority => 50,
-		       -tags => [$font.$index],
-		       );
-	}
-	
+	    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
-sub initBindings {
-    my ($movetag, $scaletag) = @_;
-
-    $zinc->bind($movetag, '<1>', \&catchStrip);
-    $zinc->bind($movetag, '<ButtonRelease>', \&releaseStrip);
-    $zinc->bind($movetag, '<B1-Motion>', \&motionStrip);
+proc initBindings {moveTag scaleTag} {
+    global w
 
-    $zinc->bind($scaletag, '<Double-Button-1>', \&microStrip);
+    $w.zinc bind $moveTag <1> "catchStrip %x %y"
+    $w.zinc bind $moveTag <ButtonRelease> releaseStrip
+    $w.zinc bind $moveTag <B1-Motion> "motionStrip %x %y"
 
+    $w.zinc bind $scaleTag <Double-Button-1> microStrip
 }
     
 # Callback CATCH de début de déplacement du Strip
-sub catchStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
-
-    my ($x, $y) = $zinc->coords("base".$index);
-    my $ev = $zinc->XEvent;
-    ($dx, $dy) = ($x - $ev->x, $y - $ev->y);
-
-    $zinc->itemconfigure("base".$index, -priority => 200);
-
+proc catchStrip {x y} {
+    global w dx dy
+
+    set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
+    set p [$w.zinc coords "base$index"]
+    set lx [lindex [lindex $p 0] 0]
+    set ly [lindex [lindex $p 0] 1]
+#    foreach {lx ly} $p {}
+    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
-sub motionStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
-    my $ev = $zinc->XEvent;
-    $zinc->coords("base".$index, [$ev->x + $dx, $ev->y + $dy]);
-    
+proc motionStrip {x y} {
+    global w dx 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
-sub releaseStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
-    $zinc->itemconfigure("base".$index, -priority => 100);
+proc releaseStrip {} {
+    global 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
-sub normalStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+proc normalStrip {} {
+    global w
 
-    $zinc->itemconfigure("input".$index, -sensitive => 1);
+    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);
+    displayRecoZone $index 1
+    displayExtentZone $index 0
+    configButtons $index extendedStrip smallStrip
+    changeStripFormat $index 1 1 0 1
 }
 
 # Zoom Strip : small format (lignes 1 et 2)
-sub smallStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+proc smallStrip {} {
+    global w
+
+    set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
 
-    &displayRecoZone($index, 0);
-    &configButtons($index, \&normalStrip, 0);
-    &changeStripFormat($index, 1, .63, 0, 1);
+    displayRecoZone $index 0
+    configButtons $index normalStrip 0
+    changeStripFormat $index 1 0.63 0 1
 }
 
 # Zoom Strip : micro format (zone ident)
-sub microStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0], 5);
+proc microStrip {} {
+    global w
+    set index [string range [lindex [$w.zinc itemcget current -tags] 0] 5 end]
     
-    &configButtons($index, \&normalStrip, 0);
-    &changeStripFormat($index, .28, .63, 0, 1);
+    configButtons $index normalStrip 0
+    changeStripFormat $index 0.28 0.63 0 1
     
 }
 
 # Zoom Strip : extendedFormat
-sub extendedStrip {
-    my $index = substr(($zinc->itemcget('current', -tags))[0],5);
-
-    $zinc->itemconfigure("input".$index, -sensitive => 0);
-    $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);
+proc extendedStrip {} {
+    global 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
-sub displayRecoZone {
-    my ($index, $state) = @_;
-    my $priority = ($state) ? 200 : 0;
-    $zinc->itemconfigure("zreco".$index, -priority => $priority);
+proc displayRecoZone {index state} {
+    global w
+
+    set priority [expr $state ? 200 : 0]
+    $w.zinc itemconfigure "zreco$index" -priority $priority
 }
 
 
 # affiche/masque la zone Extent
-sub displayExtentZone {
-    my ($index, $state) = @_;
+proc displayExtentZone {index state} {
+    global w
 
-    $zinc->itemconfigure("zinfo".$index,
-			 -visible => $state,
-			 -sensitive => $state);
+    $w.zinc itemconfigure "zinfo$index" -visible $state -sensitive $state
 }
 
 # Configure affichage et callbacks des boutons du Strip
-sub configButtons {
-    my ($index, $funcUp, $funcDown) = @_;
+proc configButtons {index funcUp funcDown} {
+    global w
 
     # button Up
-    $zinc->itemconfigure("btnup".$index, -visible => $funcUp);
-    $zinc->bind('btnup'.$index, '<1>', $funcUp) if $funcUp;
+    if { $funcUp != 0 } {
+	$w.zinc itemconfigure "btnup$index" -visible 1
+	$w.zinc bind "btnup$index" <1> $funcUp
+    } {
+	$w.zinc itemconfigure "btnup$index" -visible 0
+    }
 
     # button Down
-    $zinc->itemconfigure("btndn".$index, -visible => $funcDown);
-    $zinc->bind('btndn'.$index, '<1>', $funcDown) if $funcDown;
-
+    if { $funcDown != 0 } {
+	$w.zinc itemconfigure "btndn$index" -visible 1
+	$w.zinc bind "btndn$index" <1> $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
-sub changeStripFormat {
-    my ($index, $xratio, $yratio, $composeflag, $fontratio) = @_;
+proc changeStripFormat {index xratio yratio composeflag fontratio} {
+    global w dx dy scales steps delay
 
     # réinitialisation du groupe scaling
-    $zinc->treset("scaling".$index);
+    $w.zinc treset "scaling$index"
 
     # configure le blocage de transformation du format des champs
-    $zinc->itemconfigure("content".$index, -composescale => $composeflag);
+    $w.zinc itemconfigure "content$index" -composescale $composeflag
 
     # applique le nouveau scaling
-    $scales{$index} = [1,1] unless defined $scales{$index};
-    my ($oldXratio,$oldYratio) = @{$scales{$index}};
-    $scales{$index}=[$xratio, $yratio];
-    my $dx = ($xratio - $oldXratio) / $steps;
-    my $dy = ($yratio - $oldYratio) / $steps;
-    &_resize($index, $delay, $oldXratio+$dx, $oldYratio+$dy, $dx, $dy, $steps);
+    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
 }
 
-sub _resize {
-    my ($index, $delay, $newXratio, $newYratio, $dx, $dy, $steps) = @_;
-    $zinc->treset("scaling".$index);
-    $zinc->scale("scaling".$index, $newXratio, $newYratio);
+proc _resize {index delay newXratio newYratio dx dy steps} {
+    global w
+
+    $w.zinc treset "scaling$index"
+    $w.zinc scale "scaling$index" $newXratio $newYratio
     # jeu de fontes
-    &setFontes($index, $newYratio);
-    $steps--;
-    $zinc->after($delay, sub {&_resize ($index, $delay, $newXratio+$dx, $newYratio+$dy, $dx, $dy, $steps)})
-	if $steps > 0;
+    incr steps -1
+    if { $steps > 0 } {
+	after $delay [list _resize $index $delay [expr $newXratio+$dx] [expr $newYratio+$dy] $dx $dy $steps]
+    }
+#puts [::profiler::print]
 }
 
-sub getFKey {
-    my ($ratio) = @_;
-    my $newfkey;
-   
-    foreach my $param (@ratio2fontset) {
-	my ($maxratio, $fkey) = @{$param};
-	$newfkey = $fkey;
-	if ($ratio < $maxratio) {
-	    return $newfkey;
+proc getFKey {ratio} {
+    global ratio2FontSet
+
+    foreach param $ratio2FontSet {
+	foreach {maxRatio fKey} $param {}
+	set newfKey $fKey
+	if { $ratio < $maxRatio } {
+	    return $newfKey;
 	}
     }
-	
-    return $newfkey;
+
+    return $newfKey;
 }
 
 
-sub setFontes {
-    my ($index, $ratio) = @_;
-    my $newfkey = &getFKey($ratio);
-    
-    if (!$oldfkey or $oldfkey ne $newfkey) {
-	my $fontsty = $stripFontset{$newfkey};
-#	print "setFontes $oldfkey -> $newfkey\n";
-	if ($fontsty) {
-	    foreach my $type ('callsign', 'type1', 'type2', 'type3') {
-		$zinc->itemconfigure($type.$index, -font => $fontsty->{$type});
+proc setFontes {index ratio} {
+    global w stripFontSet 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]
 	    }
 	}
-	
-	$oldfkey = $newfkey;
+	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