#!/usr/bin/perl
#---------------------------------------------------------------
#  Module          : FontDisplay
#  File            : FontDisplay
#
#  Copyright (C) 2002
#  Centre d'tudes de la Navigation Arienne
#  Authors: Vinot Jean-Luc <vinot@cena.fr>
#
#---------------------------------------------------------------

use Tk;
use Tk::Zinc;
use Getopt::Long;
use strict 'vars';

$| = 1;

my %opt;
my @fonts;
my $title;
my $cp;
my $oldindex;
my ($dx, $dy);  # delta interaction dplacement

my $fnb15 = 'cenapii-radar-b15';
my @balcolor = ('#000000', '#4068e0');

my $numeric = '0123456789';
my $capital = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
my $lowercase = 'abcdefghijklmnopqrstuvwxyz';
my $capaccent = "\xC0\xC2\xC7\xC8\xC9\xCA\xCB\xCE\xCF\xD4\xD9\xDB";
my $accent = '';
my $tendancy = "\x14\x15\x16";  #caractres hexa 14, 15 et 16
my $div = '!"#$%&'."'".'()*+,-./:;<=>?@[\]^_{|}'."\xB0"; #\xA4

my %glyphsets = (alphanum => [$capital.'  '.$tendancy,
			      $numeric.'  '.$lowercase,
			     ],

		 extent => [$numeric.'  '.$capital,
			    $lowercase.' '.$capaccent.' '.$accent,
			    $tendancy, #.' '.$div,
			    ],
		 extent => [$numeric,
			    $capital.' '.$capaccent,
			    $lowercase.' '.$accent,
			    $tendancy.' '.$div,
			    ],
		);

my $glyphset = $glyphsets{'extent'};

my @digits = ('0123456789:');

my @letterprobs = (['III111','IIIJJJ','IIILLL','IIIlll','IIITTT'],
		   ['777III','777111','777YYY','777ZZZ','ZZZ222'],
		   ['BBB333','BBB888','BBBRRR','BBBSSS','BBB555'],
		   ['PPPRRR','I3I3BBB','SSS555','SSS333','SSS888'],
		   ['333888','888999','666888','666999','666000'],
		   ['CCCGGG','GGGQQQ','GGG666','GGG000','GGG555'],
		   ['OOOQQQ','OOO000','EEEFFF','EEEBBB','HHHNNN'],
		   ['HHHMMM','KKKXXX','444AAA','',''],
		   );

my @callsigns = (['AF729PX', 'UKA276', 'BZ722TA', 'AF627GY', 'AFR439'],
		 ['AFR061', 'WW1', 'BRT246', 'BAW160', 'AFR1571'],
		 ['IAG024', 'FGRBW', 'EIN822', 'GIL893', 'RYR26F'],
		 ['RNO805', 'CTM0035', 'FGROI', 'SAY405', 'VPBLK'],
		 ['VRG726', 'JEA8933', 'BMA177', 'BCY334','ANS8700'],
		 ['BRT523', 'BAW334', 'DAH1060', 'FGPAK', 'SAB98M'],
		 ['SAS156', 'RR5207', 'KT749','BY250G', 'GATZN'],
		 ['MWEXHX', 'NA002', 'KK445','GBFFM','GBARE']
		);

my @numvalues = (['010','100','190','280','370','460','550','+20','.65','.74'],
		 ['020','110','200','290','380','470','560','+15','.66','.75'],
		 ['030','120','210','300','390','480','570','+10','.67','.76'],
		 ['040','130','220','310','400','490','580','+05','.68','.77'],
		 ['050','140','230','320','410','500','590','Cap','.69','.78'],
		 ['060','150','240','330','420','510','600','-05','.70','.79'],
		 ['070','160','250','340','430','520','610','-10','.71','.80'],
		 ['080','170','260','350','440','530','620','-15','.72','.81'],
		 ['090','180','270','360','450','540','630','-20','.73','.82']
		);

my @balvalues = (['AFRIC','BANGI','CUERS','DEKIS','ELBOX','FAWBO','GIPEX'],
		 ['HORRO','IDOKO','JURON','KOVAR','LASRA','MERUE','NIBAR'],
		 ['OLMES','POLLY','QUANA','RECIF','SOLBA','TORTU','USIMI'],
		 ['VATRI','WAPIT','XERAM','YAOUR','ZORRO','',''],
		 ['Afric','Bangi','Cuers','Dekis','Elbox','Fawbo','Gipex'],
		 ['Horro','Idoko','Juron','Kovar','Lasra','Merue','Nibar'],
		 ['Olmes','Polly','Quana','Recif','Solba','Tortu','Usimi'],
		 ['Vatri','Wapit','Xeram','Yaour','Zorro','','']
		);

# creation des lignes test d'espacement caractre
# combinaison de tous les couples de caractres
my $maxlines = 9;
my @charspacing = &createCharSpacing($capital, $maxlines);
push @charspacing, &createCharSpacing($lowercase, $maxlines);

my $refspacing = ['AWBWCWDWEWFWGWHWIWJWKWLWMWNWOWPWQWRWSWTWUWVWWWXWYWZW',
		  'AMBMCMDMEMFMGMHMIMJMKMLMMMNMOMPMQMRMSMTMUMVMWMXMYMZM',
		  'awbwcwdwewfwgwhwiwjwkwlwmwnwowpwqwrwswtwuwvwwwxwywzw',
		  'ambmcmdmemfmgmhmimjmkmlmmmnmompmqmrmsmtmumvmwmxmymzm'];


my %letterSample = (-priority => 200,
		    -form => {-thick => 23,
			      -biso => 10,
			      -overlap => 2,
			      -way => 'horizontal',
			      -width => 4,
			      -height => 6,
			      -len => '128',
			     },
		    -graphics => {-texture => 'backtexture2',
				  -linecolor => '#cbcbcb',
				  -fillcolor => '#cbcbcb',
				  -relief => 'roundraised',
				  -linewidth => 3,
				 },
		    -title => {-color => '#000000:40',
			       -alignment => 'right',
			       -anchor => 'w',
			       -font => $fnb15,
			      },

		    -geom => {-minw => 300,
			      -minh => 200,
			      -top => 30,
			      -bottom => 6,
			      },
						
		    -numpages => 4,
		    -databases => [\@letterprobs,
				   \@callsigns,
				   \@numvalues,
				   \@balvalues,],

		    -titles => {-texts => ['Confusion',
					   'Callsigns',
					   'Numerics',
					   'Beacons',],
				-posi => [[ 10, 12],
					  [ 138, 12],
					  [ 266, 12],
					  [ 394, 12]],
			       },
		);

my %letterSpacing = (-priority => 200,
		     -form => {-thick => 26,
			       -biso => 10,
			       -overlap => 4,
			       -way => 'vertical',
			       -width => 30,
			       -height => 0,
			       -len => 34,
			      },
		    -graphics => {-texture => 'backtexture2',
				  -linecolor => '#cbcbcb',
				  -fillcolor => '#cbcbcb',
				  -relief => 'roundraised',
				  -linewidth => 3,
				 },
		    -title => {-color => '#000000:40',
			       -alignment => 'right',
			       -anchor => 'w',
			       -font => $fnb15,
			      },

		     -geom => {-minw => 300,
			       -minh => 200,
			       -top => 6,
			       -bottom => 8,
			      },
						
		    -numpages => 6,
		    -databases => \@charspacing,

		    -titles => {-texts => ['S1',
					   'S2',
					   'S3',
					   'S4',
					   'S5',
					   'S6'],
				-posi => [[4,  14],
					  [4,  44],
					  [4,  74],
					  [4, 104],
					  [4, 134],
					  [4, 164]],
			       },
		);

#-----------------------------------------------------------------------------------
# FontDisplay
# M A I N
#-----------------------------------------------------------------------------------

# gestion des options de la ligne de commande
my %OPTIONS = ("help" =>       "-help                      Affiche l'aide",
	       "geometry=s" => "-geometrie <[WxH]+X+Y>     Geometrie de la fenetre",
	       "image=s" =>    "-image <FILE>              nom du fichier image snapshot  crer",
	       "font=s" =>     "-font <font1[,font2,...]>  liste de fontes  afficher",
	       "gs=s" =>       "-gs <set> (alpha|extent)   jeu de caractres  afficher",
	       "samples" =>    "-samples                   affichages des fentres examples",
	       "norender" =>   "-norender                  affichage zinc render => 0",
	      );

if (not GetOptions (\%opt, keys (%OPTIONS)) or $opt{help}) {
    &usage;
}

# gestion du mode d'affichage
my $render = ($opt{norender}) ? $opt{norender} : 1;


# gestion des fontes
if ($opt{font}) {
    @fonts = (split(/,/, $opt{font}));
    my $mess = (scalar(@fonts) > 1) ? "Fontes " : "Fonte ";
    $mess = $mess." afficher :";
    foreach (@fonts) {
      $title = $title."$_ ";
    }
    print "$mess $title\n";

} else {
  &usage("vous devez spcifier au moins une fonte  afficher !");
}

# gestion de l'opion -gs : jeu de glyphes  afficher
if ($opt{gs}) {
  my $setname = $opt{gs};
  if (exists $glyphsets{$setname}) {
    $glyphset = $glyphsets{$setname};

  } else {
    print "option -gs $setname non valide... valeur par dfaut 'extent' !\n";
  }
}

# gestion de l'option -samples affiches les fentres examples
my $samples = $opt{samples};



# gestion de la geometrie fenetre
my ($size, $pos, $geometry);
if ($opt{geometry}) {
    if ($opt{geometry} =~ /^(\d+x\d+)?([+-]\d+[+-]\d+)?$/) {
	$size = ($1) ? $1 : '1000x800';
	$pos = ($2) ? $2 : '+0+0';
	$geometry = $size;
    } else {
	&usage("Le format de la geometrie est incorrect");
    }
} else {
  my $h = 300 + ($#fonts * 250);
  my $w = (defined $opt{cp}) ? 1200 : 500;
  $geometry = $w.'x'.$h.'+0+0';
}


$geometry =~ /^(\d+)x(\d+)/;
my $width = $1;
my $height = $2;

my $fontImage = $opt{image};

# creation de la fenetre principale
my $mw = MainWindow->new();

$mw->geometry($geometry);
$title = "Test fontes : $title";
$mw->title($title);


#------------------------
# creation du widget Zinc
my $zinc = $mw->Zinc(-render => $render,
		     -width => $width,
		     -height => $height,
		     -backcolor => '#6a6a6a',
		     -borderwidth => 0,
		     -lightangle => 130,
		     );

$zinc->pack(-fill => 'both', -expand => 1);

# test fichiers fontes
foreach my $fontname (@fonts) {
  my $error;
  eval {
    $error = system "xlsfonts |grep $fontname > /dev/null";
  };

  if ($error) {
    &usage("fonte $fontname inexistante!");
  }


}

# gestion de l'option cp
$cp = 1;


my ($x, $y) = (50, 40);
my $index = 0;
foreach my $font (@fonts) {
    my $height = &createFontTest($index, $font, $glyphset, [$x, $y]);
    $y += ($height + 30);
    $index++;

}

# initialisation Bindings dplacement fentres
&setMoveBindings;

# initialisation Bindings pages
&setPagesBindings;

# affichage page 0
&liftDivider('h0');



MainLoop;

#-----------------------------------------------------------------------------------
# main::quit
# fonction appele par bouton exit
#-----------------------------------------------------------------------------------
sub quit {
    print "Exit\n";
        exit;
}

sub createFontTest {
    my ($index, $font, $glyphset, $geom, $margin) = @_;
    $margin = 10 if !defined $margin;
    my @glyphs = @{$glyphset};
    my $cpfont = $cp;


    if ($font =~ /digit|symbol/) {
      @glyphs = @digits if $font =~ /digit/;
      $cpfont = 0;

    }

    my $numitems = scalar(@glyphs);

    # test bounding box fonte
    my ($tw0, $ystep) = &stringBBox($font, \@glyphs);
    my ($tw1) = &stringBBox($font, $refspacing);

    my $width = $tw0 + ($margin * 2);

    # test alphabets
    my $size = &createAlphaTest($index, $font, $glyphset, $geom, $width,
				$ystep, $margin, \%letterSample);

    my ($width, $height, $hbox) = @{$size};

    if ($samples) {

      my $width2 = $tw1 + ($margin * 2) + 30;
      my $globwidth = $width + $width2;

      &adjustWinSize($geom, $globwidth, $height);

      $geom = [$geom->[0]+$size->[0], $geom->[1]];

      # pages (onglet) test groupes de lettres
      my $tst_pages = &createLetterTest($font, 'h', $geom, $width2, $height,
					$hbox,$ystep, $margin, \%letterSample);
      $height -= 17;
      $geom->[1] +=23;

      # pages (onglet) test espacements des caractres
      my $spc_pages = &createLetterTest($font, 'v', $geom, $width2, $height,
					$hbox, $ystep, $margin, \%letterSpacing);

      # regroupement des pages
      my $pageref = $tst_pages->[0];
      my $pagegroup = $zinc->group($pageref);


      foreach my $page (@{$spc_pages}) {
	$zinc->chggroup($page, $pagegroup, 1);
      }

    } else {
      &adjustWinSize($geom, $width, $height);
    }

    return $size->[1];


}

sub createAlphaTest {
  my ($index, $font, $glyphset, $geom, $width, $ystep, $margin, $style) = @_;

  my @glyphs = @{$glyphset};
  my $numitems = scalar(@glyphs);

  my $boxgeom = $style->{'-geom'};
  my $top = $boxgeom->{'-top'};
  my $bottom = $boxgeom->{'-bottom'};

  my $height = int(9.5 * $ystep) + $top + $bottom;

  $height = $boxgeom->{'-minh'} if $height < $boxgeom->{'-minh'};
  $width = $boxgeom->{'-minw'} if $width < $boxgeom->{'-minw'};

  my $titlefont = $font;

  if ($font =~ /digit|symbol/) {
    @glyphs = @digits if $font =~ /digit/;
    $titlefont = $fnb15;

  }


  my $group = $zinc->add('group', 1, -tags => ["fontgroup".$index]);
  $zinc->coords($group, $geom);

  # titre fonte
  my ($tw, $th) = &stringBBox($titlefont, $font);
  if ($th > $top) {
    if (scalar(@fonts) > 1) {
      $titlefont = $fnb15 if $th > $top;
    } else {
      $height+= ($th - $top);
      $top = $th;
    }
  }

  $zinc->add('rectangle', $group,
	     [-6, -6, $width+6, $height+6],
	     -linewidth => .5,
	     -filled => 1,
	     -fillcolor => '#cbcbcb',
	     -visible => 1,
	     -linewidth => 3,
	     -linecolor => '#cbcbcb',
	     -relief => 'roundraised',
	     -sensitive => 1,
	     -tags => ["winfont".$index, 'moveable'],
	    );


  $zinc->add('text', $group,
	     -position => [$margin, ($top*.4)],
	     -text => $font,
	     -color => $balcolor[1],
	     -anchor => 'w',
	     -alignment => 'left',
	     -font => $titlefont,
	     -sensitive => 1,
	     -tags => ["winfont".$index, 'moveable'],
	    );

  my ($x, $y) = (0, $top);
  my $y2 = $y + ($ystep * .6);
  my $yb = $y2;

  my $hbox = ($height - ($top+$bottom));
  $zinc->add('rectangle', $group,
	     [$x-2, $y-2, $x+$width+2, $y+$hbox+2],
	     -filled => 1,
	     -fillcolor => '#cbcbcb',
	     -linecolor => '#cbcbcb',
	     -priority => 10,
	     -linewidth => 3,
	     -relief => 'sunken',
	    );

  my $index = 1;

  my @colors = (['#000000', '#ffffff'], ['#ffffff', '#000000']);
  foreach (@colors) {
    my ($back, $front) = @{$_};
    $zinc->add('rectangle', $group,
	       [0, $y, $width, $y+($hbox/2)],
	       -filled => 1,
	       -fillcolor => $back,
	       -linewidth => 0,
	       -priority => 10,
	       -linewidth => 0,
	      );

    my $y1 = $y + $ystep;

    foreach (@glyphs) {	
      $zinc->add('text', $group,
		 -position => [$margin, $y1],
		 -text => $_,
		 -color => $front,
		 -anchor => 'w',
		 -alignment => 'left',
		 -font => $font,
		 -priority => 20,
		);

      $index++;
      $y1 += $ystep;
    }

    $y += $hbox/2;
  }


  if ($fontImage) {
    FontImageSave($font, $group);
  }

  return [$width+12, $height+5, $hbox];

}


sub createLetterTest {
  my ($font, $set, $geom, $width, $height, $hbox, $ystep, $margin, $style) = @_;

  my @datas = @{$style->{'-databases'}};
  my $num = $style->{'-numpages'};
  $style->{'-form'}->{'-width'} += $width;
  $style->{'-form'}->{'-height'} += $height;

  my $shapes = &computeDividers($num, %{$style->{'-form'}});

  my $group = $zinc->add('group', 1);
  $zinc->coords($group, [$geom->[0] - 4, $geom->[1] - 6]);

  my @pages;

  if ($shapes and @datas) {
    my $index = 0;
    my $priority = $num * 20;
    my $titles = $style->{'-titles'};
    my $graphics = $style->{'-graphics'};

    # texture dividers
    my $texture;
    if ($style->{'-graphics'}->{'-texture'}) {
      my $imgfile = $style->{'-graphics'}->{'-texture'};
      $texture = $zinc->Photo(-file => Tk::findINC($imgfile));
    }

    foreach my $database (@datas) {
      if ($index < scalar(@{$shapes})) {
	my $title = "";
	if ($titles) {
	  my $posi = $titles->{'-posi'}->[$index];
	  $title = $titles->{'-texts'}->[$index];
	  $style->{'-title'}->{'-text'} = $title;
	  $style->{'-title'}->{'-posi'} = $posi;
	} else {
	  $style->{'-title'}->{'-text'} = undef;
	}

	my $divgroup = $zinc->add('group', $group, -tags => ["page".$set.$index]);

	# accumulation des intercalaires
	push (@pages, $divgroup);	
	
	# enveloppe de l'intercalaire
	my $divider = $zinc->add('curve', $divgroup,
				 $shapes->[$index],
				 -closed => 1,
				 -filled => 1,
				 -fillcolor => $graphics->{'-fillcolor'},
				 -linewidth => $graphics->{'-linewidth'},
				 -linecolor => $graphics->{'-linecolor'},
				 -relief => $graphics->{'-relief'},
				 -visible => 1,
				 -sensitive => 1,
				 -priority => 10,
				 -tags => ["divider",
					   $set.$index],
				);


	if ($texture) {
	  #$zinc->itemconfigure($divider, -tile => $texture);
	}

	# ajout du titre onglet
	if ($style->{'-title'}) {
	  my $titlesty = $style->{'-title'};
	  my ($tx, $ty) = @{$titlesty->{'-posi'}};
	  if ($style->{'-form'}->{'-way'} eq 'vertical') {
	    $tx += $width;
	  }

	  $zinc->add('text', $divgroup,
		     -position => [$tx, $ty],
		     -alignment => $titlesty->{'-alignment'},
		     -font => $titlesty->{'-font'},
		     -color => $titlesty->{'-color'},
		     -anchor => $titlesty->{'-anchor'},
		     -text => $titlesty->{'-text'},
		     -sensitive => 1,
		     -priority => 20,
		     -tags => ["divider",
			       $set.$index,
			       "title".$set.$index],
		    );
	}

	# Contenu
	my @values = @{$database};
	my $numitems = scalar(@values);

	my $boxgeom = $style->{'-geom'};
	my $top = $boxgeom->{'-top'};
	my $bottom = $boxgeom->{'-bottom'};


	my ($x, $y) = (6, $top);
	my $hbox = ($height - ($top + $bottom));

	$zinc->add('rectangle', $divgroup,
		   [$x-2, $y-2, $width, $y+$hbox+3],
		   -filled => 1,
		   -fillcolor => '#dbdbdb',
		   -linecolor => '#dbdbdb',
		   -priority => 10,
		   -linewidth => 4,
		   -relief => 'roundgroove',
		  );

	my $i = 1;
	my $align = 'left';
	my $x1 = $margin + 6;
	my $y1 = $y + $ystep ;
	my $anchor = 'w';

	if ($database eq \@numvalues) {
	  $align = 'right';
	  $x1 += 36;
	  $anchor = 'e';
	}

	foreach my $line (@values) {
	  my $xc = $x1;
	  my $numcol = scalar @{$line};

	  foreach my $word (@{$line}) {

	    $zinc->add('text', $divgroup,
		       -position => [$xc, $y1],
		       -text => $word,
		       -color => '#000000',
		       -anchor => $anchor,
		       -alignment => $align,
		       -font => $font,
		       -priority => 20,
		      );

	    $i++;
	    $xc += (($width / $numcol)-2);
	  }

	  $y1 += $ystep;
	}

	# initialisation Bindings pages
	#&setBindings;

	$index++;
	$priority -= 10;

      }
    }
  }

  $style->{'-form'}->{'-width'} -= $width;
  $style->{'-form'}->{'-height'} -= $height;

  return \@pages;

}


sub setPagesBindings {

    # bindings intercalaires
    $zinc->bind("divider", '<1>', sub {&liftDivider();});

}

sub liftDivider {
  my ($index) = @_;

  if (!defined $index) {
    $index = ($zinc->itemcget('current', -tags))[1];
  }

  my @pages = $zinc->find('withtag', "page".$index);

  # afficher les pages index
  foreach my $page (@pages) {
    $zinc->raise($page);
  }

  if (defined $oldindex) {
    $zinc->itemconfigure("title".$oldindex, -color => '#000000:40');
  }

  $oldindex = $index;
  $zinc->itemconfigure("title".$index, -color => $balcolor[1]);

}


#-----------------------------------------------------------------------------------
# main::usage
# retourne l'aide d'usage des paramtres de lancement de l'appli.
#-----------------------------------------------------------------------------------
sub usage {
    my $message = shift;
    print STDERR "*** Erreur : $message\n\n" if $message;
    print "Usage : FontDisplay -font <FONT> [options]\n";
    print "Options : \n";
    foreach my $val (sort values(%OPTIONS)) {
	print "     $val\n";
    }
    &quit;
}


sub stringBBox {
  my ($font, $str, $sw, $sh) = @_;
  $sw = 0 if !defined $sw;
  $sh = 0 if !defined $sh;


  if (ref($str) eq 'ARRAY') {
    my @strings = @{$str};
    $str = shift @strings;

    if (@strings) {
      my ($sw1, $sh1) = &stringBBox($font, \@strings, $sw, $sh);

      $sw = $sw1 if $sw1 > $sw;
      $sh = $sh1 if $sh1 > $sh;
    }

  }

  my $test = $zinc->add('text', 1,
			-position => [0, 0],
			-font => $font,
			-text => $str,
			-visible => 0,
		       );

  my ($x0, $y0, $x1, $y1) = $zinc->bbox($test);
  $zinc->remove($test);

  $sw = ($x1 - $x0) if ($x1 - $x0) > $sw;
  $sh = ($y1 - $y0) if ($y1 - $y0) > $sh;

  return ($sw, $sh);

}

sub createCharSpacing {
  my ($charstr, $lineperpage) = @_;
  my @chars = split //, $charstr;
  my @charstrings;
  my @pages;

  my $line = "";
  my $numline = 0;

  foreach my $cl (@chars) {
    $numline++;
    foreach my $cc (@chars) {
      $line = $line.$cc.$cl;
    }

    push (@charstrings, [$line]);
    $line = "";

    if ($numline >= $lineperpage) {
      my @bloc = @charstrings;
      push (@pages, \@bloc);
      @charstrings = ();
      $numline = 0;
    }

  }

  push (@pages, \@charstrings);

  return @pages;

}

sub computeDividers {
    my ($numpages, %options) = @_;
    my @shapes;
    my @pts = ();

    if (!$numpages or !%options) {
	return undef;
    }

    my @options = keys(%options);

    # gestion des valeurs par defaut
    my $rad = 0;
    my $thick = ($options{'-thick'}) ? $options{'-thick'} : 20;
    my $biso = ($options{'-biso'}) ? $options{'-biso'} : 0;
    my $way = ($options{'-way'}) ? $options{'-way'} : 'horizontal';
    my $fer = ($options{'-fer'}) ? $options{'-fer'} : 'normal';

    my $overlap = ($options{'-overlap'}) ? $options{'-overlap'} : undef;

    my $width = ($options{'-width'}) ? $options{'-width'} : 300;
    my $height = ($options{'-height'}) ? $options{'-height'} : 200;
    my $len = ($options{'-len'}) ? $options{'-len'} : 'auto';

    my ($x0, $y0) = (0, 0);
    my $pagew = ($way eq 'vertical') ? $width - (2 + $thick) : $width - 2;
    my $pageh = ($way eq 'vertical') ? $height - 2 : $height - (2+$thick);

    if ($len eq 'auto') {
	$len = ($way eq 'vertical') ? $height/$numpages : $width/$numpages;
    }

    if (!$overlap) {
	$overlap = 0;

    } else {
	if ($fer  eq 'invert') {
	    $overlap *= -1;
	}
    }

    my $astep = ($fer eq 'invert') ? -3 : 3;
    my ($ext1, $ext2) = ($fer eq 'invert') ? (-90, -60) : (90, 60);

    my $len2 = $len - $biso;

    # inversion du sens onglet
    $len *= -1 if $fer eq 'invert';

    for (my $i = 0; $i < $numpages; $i++) {
	my @pts = ();

	if ($way eq 'vertical') {
	    my $yref = ($fer eq 'invert') ? $y0+$height : $y0;
	    my $x3 = $x0 + $width;
	    my $x2 = $x3 - $rad;
	    my $x1 = $x3 - $thick;
	    my $yn = ($fer eq 'invert') ? $y0 : $y0+$height;
	    my $yi = $yref + (($len - $overlap) * $i);
	    my $y1 = $yi;

	    # cadre hors onglet
	    push (@pts, ($x1, $yn, $x0, $yn, $x0, $yref, $x1, $yref));

	    # dcrochage onglet
	    push (@pts, ($x1, $yi)) if $i > 0;

	    # points onglets
	    push (@pts, ($x3, $yi, $x3, $yi+$len-$biso));
	    push (@pts, ($x1, $yi+$len));


	} else {
	    my $xref = ($fer eq 'invert') ? $x0+$width : $x0;
	    my $y3 = $y0 + $height;
	    my $y2 = $y0 + $thick;
	    my $xn = ($fer eq 'invert') ? $x0 : $x0+$width;
	    my $xi = $xref + (($len - $overlap) * $i);
	    my $x1 = $xi;

	    # cadre hors onglet
	    push (@pts, ($xn, $y2, $xn, $y3, $xref, $y3, $xref, $y2));

	    # dcrochage onglet
	    push (@pts, ($xi, $y2)) if $i > 0;

	    # points onglets
	    push (@pts, ($xi, $y0, $xi+$len-$biso, $y0));
	    push (@pts, ($xi+$len, $y2));

	}

	push (@shapes, \@pts);

    }

    return \@shapes;
}


sub adjustWinSize {
  my ($coord, $width, $height) = @_;
  my ($x, $y) = @{$coord};
  my $oldw = $zinc->cget(-width);
  my $oldh = $zinc->cget(-height);
  my ($neww, $newh);

  if (($x + $width + $x) > $oldw) {
    $neww = $x + $width + $x;
    $neww = 1600 if $neww > 1600;
    $zinc->configure(-width => $neww);
  }

  if (($y + $height + 40) > $oldh) {
    $newh = $y + $height + 40;
    $newh = 1200 if $newh > 1200;
    $zinc->configure(-height => $newh);
  }

  if ($neww or $newh) {
    $neww = $oldw if !defined $neww;
    $newh = $oldh if !defined $newh;

    $mw->geometry($neww.'x'.$newh);
  }

}


sub FontImageSave {
  my ($filename, $fontgroup) = @_;

  return if ! $filename or !fontgroup;

  my $id=$zinc->id;
  my ($xo, $yo, $xc, $yc) = $zinc->bbox($fontgroup);
  my $width = $xc-$xo;
  my $height = $yc - $yo;

  printf "FontImageSave l'id=$id zinc->bbox retourne $xo, $yo, $xc, $yc\n";
  printf "FontImageSave l'id=$id width=$width height=$height xoffset=$xc yoffset=$yc\n";
  printf "FontImageSave system import -window $id -crop $width".'x'."$height+$xo+$yo page.jpeg\n";

  # imagemagick doit etre install sur le systeme
  system "import -window $id -crop $width".'x'."$height+$xo+$yo $filename.jpeg";

}


#------------------------------------------------------------
# test stabilit des chanes textes (OpenGL)
#------------------------------------------------------------
# initialisation des bindings dplacement des fentres fontes
sub setMoveBindings {

    $zinc->bind('moveable', '<1>', \&catchWinFont);
    $zinc->bind('moveable', '<ButtonRelease>', \&releaseWinFont);
    $zinc->bind('moveable', '<B1-Motion>', \&motionWinFont);

}

# Callback CATCH de dbut de dplacement de la fentre fonte
sub catchWinFont {
    my $index = substr(($zinc->itemcget('current', -tags))[0], 7);

    my ($x, $y) = $zinc->coords("fontgroup".$index);
    my $ev = $zinc->XEvent;
    ($dx, $dy) = ($x - $ev->x, $y - $ev->y);

    $zinc->itemconfigure("fontgroup".$index, -priority => 200);

}

# Callback MOVE de fin de dplacement de la fentre fonte
sub motionWinFont {
    my $index = substr(($zinc->itemcget('current', -tags))[0], 7);
    my $ev = $zinc->XEvent;
    $zinc->coords("fontgroup".$index, [$ev->x + $dx, $ev->y + $dy]);

}

# Callback RELEASE de fin de dplacement du Strip
sub releaseWinFont {
    my $index = substr(($zinc->itemcget('current', -tags))[0], 7);
    $zinc->itemconfigure("fontgroup".$index, -priority => 100);
}

