Import initial

10 files changed, 4815 insertions, 0 deletions

diff --git a/src/SVG/SVG2zinc.pm b/src/SVG/SVG2zinc.pm
new file mode 100644
index 0000000..f344b96
--- /dev/null
+++ b/src/SVG/SVG2zinc.pm
@@ -0,0 +1,2245 @@
+package SVG::SVG2zinc;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#
+#	convertisseur SVG->TkZinc
+# 
+#	Copyright 2002-2003
+#	Centre d'?tudes de la Navigation A?rienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com> 
+#								previously <mertz at cena dot fr>
+#		  with many helps from
+#		  Alexandre Lemort <lemort at intuilab dot com>
+#		  Celine Schlienger <celine at intuilab dot com>
+#		  St?phane Chatty <chatty at intuilab dot com>
+#
+# $Id: SVG2zinc.pm,v 1.6 2007-03-06 07:53:22 merlin Exp $
+#############################################################################
+#
+# this is the main module of the a converter from SVG file
+# to either perl script/module (an eventually other scripting language)
+# It is also usable to display SVG graphic file in Tk::Zinc
+
+#############################################################################
+# limitations are now listed in the POD at the end of this file
+#############################################################################
+
+use strict;
+use XML::Parser;
+use Carp;
+use Math::Trig;
+use English;
+use File::Basename;
+
+use SVG::SVG2zinc::Conversions;
+
+use vars qw($VERSION $REVISION @ISA @EXPORT);
+@EXPORT = qw( parsefile findINC );
+
+$REVISION = q$Revision: 1.6 $ ;
+$VERSION = "0.10";
+
+# to suppress some stupid warning usefull for debugging only
+my $warn=0;
+
+my $verbose;
+
+my $current_group;
+my @prev_groups = ();
+my %current_context;
+my @prev_contexts = ();
+
+my $itemCount = 0;
+my $effectiveItemCount = 0;  # to know if some groups are empty (cf &defs et &defs_)
+my $prefix;				  # prefix used in tags associated to generated items
+my $colorSep = ";";
+
+my $includeFollowingItems = 0;
+my $targetName = '';
+my @nameStack = ();
+
+sub InitVars {
+	@prev_groups = ();
+	%current_context = ();
+	@prev_contexts = ();
+	$itemCount = 0;
+	$effectiveItemCount = 0;
+	$colorSep = ";";
+	$includeFollowingItems = 0;
+	$targetName = '';
+	@nameStack = ();
+}
+
+# This hash table indicates all non-implemented extensions
+# Normaly, the href extension is the only implemented extension listed in the SVG entity
+# The hash-value associated to a not implemented etension is 0
+# The hash-value is then set to 1 when an warning message has been printed once
+my %notImplementedExtensionPrefix; 
+
+
+# events on "graphics and container elements"
+my @EVENT_ON_GRAPHICS = qw/
+	onfocusin onfocusout onactivate onclick
+	onmousedown onmouseup onmouseover onmousemove onmouseout onload
+/;
+# events on "Document-level event attributes"
+my @EVENT_ON_DOC = qw /onunload onabort onerror onresize onscroll onzoom/;
+# events "Animation event attributes"
+my @EVENT_ON_ANIM = qw /onbegin onend onrepeat/ ;
+
+my %EVENT_ON_GRAPHICS = map { $_ => 1 } @EVENT_ON_GRAPHICS;
+my %EVENT_ON_DOC	  = map { $_ => 1 } @EVENT_ON_DOC;
+my %EVENT_ON_ANIM	 = map { $_ => 1 } @EVENT_ON_ANIM;
+
+
+### @STYLE_ATTRS and %STYLE_ATTRS are "constant" array and hash used in
+#### &analyze_style , &analyze_text_style , &groupContext , &attrs_implemented
+my @STYLE_ATTRS = qw(
+	class style display ddisplay fill fill-opacity fill-rule stroke
+	stroke-width stroke-opacity opacity font-size font-family
+	font-weight stroke-linejoin stroke-linecap stroke-dasharray text-anchor
+) ;
+my %STYLE_ATTRS = map { $_ => 1 } @STYLE_ATTRS;
+
+#### not implemented / not implementable attributes
+#### these attributes will generate only limited warning
+#### used in &attrs_implemented
+my @STYLE_ATTRS_NYI = qw (
+	stroke-miterlimit
+	gradientUnits gradientTransform spreadMethod
+	clip-rule clip-path
+	name
+) ;   # what is the foolish name?
+my %STYLE_ATTRS_NYI = map { $_ => 1 } @STYLE_ATTRS_NYI;
+
+#### not yet implemented tags (to avoid many many error messages)
+#### this list could be used to clearly distinguishe TAGS
+#### not yet implemented or not implementable.
+#### This list is curently not used! consider it as a piece of comment!
+my @NO_YET_IMPLEMENTED_TAGS = qw ( midPointStop filter feColorMatrix feComponentTransfer feFuncA);
+
+my $fileDir; ## in fact this could be a part of an url
+			 ## but we currently only get files in the some directories
+my $backend; ## the backend used to produce/interpret  perl or tcl or whatever...
+
+my $expat;
+sub parsefile {
+	my ($svgfile, $backendName, %args) = @_;
+	&InitVars;
+	$fileDir = dirname($svgfile)."/";
+	$targetName = defined $args{-target} ? $args{-target}: '';
+	delete ($args{"-target"});
+	$includeFollowingItems = $targetName ne '' ? 0 : 1;
+	$verbose = defined $args{-verbose} ? $args{-verbose}: 0;
+	$prefix =  defined $args{-prefix} ? $args{-prefix} : "";
+	delete $args{-prefix};
+	my $namespace = defined $args{-namespace} ? $args{-namespace} : 0;
+	delete $args{-namespace};
+	&SVG::SVG2zinc::Conversions::InitConv(\&myWarn, \&current_line);
+	require SVG::SVG2zinc::Backend::PerlClass;
+	$backend = SVG::SVG2zinc::Backend::PerlClass -> new (-in => $svgfile, %args);
+	$current_group = $backend -> _topgroup;
+	$backend -> fileHeader;
+	my $parser = new XML::Parser(
+		Style => 'SVG2zinc',
+		Namespaces => $namespace,  # well this works for dia shape dtd!
+		Pkg => 'SVG::SVG2zinc',
+		ErrorContext => 3,
+	);
+	$parser -> setHandlers(
+		Char	=> \&Char,
+		Init	=> \&Init,
+		Final   => \&Final,
+		XMLDecl => \&XMLDecl,
+	);
+	my $svg = $parser->parsefile($svgfile);
+	$backend -> fileTail;
+	&print_warning_for_not_implemented_attr;
+}
+
+## as it seems that some svg files are using differencies between dtd 1.0 and 1.1
+## we need to know which version of the dtd we are using (defaulted to 1.0)
+my $dtdVersion;
+sub XMLDecl {
+	my ($parser, $Version, $Encoding, $Standalone) = @_;
+	if (defined $Version) 
+	{
+		$dtdVersion = $Version;
+	}
+	else
+	{
+		$dtdVersion = 1.0;
+	}
+}
+
+
+
+# the svg tags are translated in group items.
+# If the SVG tag contains both width and height properties
+# they will be reported in the generated group as tags :
+# 'height=xxx' 'width=xxx'
+
+sub svg {
+}
+
+sub svgold {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	delete $attrs{xmlns}; # this attribute is mandatory, but useless for SVG2zinc
+
+	my ($width,$height)=&sizesConvert( \%attrs , qw (width height)); #! this defines the Zinc size!
+	# case when the width or height is defined in %
+	# the % refers to the size of an including document
+	undef $width if defined $attrs{width} and $attrs{width} =~ /%/ ;
+	undef $height if defined $attrs{height} and $attrs{height}=~ /%/ ;
+	my $widthHeightTags="";
+	if (defined $width and defined $height) 
+	{
+		$widthHeightTags = ", 'width=" . &float2int($width) . 
+		"', 'height=" . &float2int($height) . "'";
+	}
+	if (!@prev_contexts) 
+	{ # we are in the very top svg group!
+		$widthHeightTags .= ", 'svg_top'";
+	}
+	my $res = "->add('group',$current_group, -tags => [$name$widthHeightTags], -priority => 10";
+	unshift @prev_contexts, \%current_context;
+	my $prop;
+	($prop, %current_context) = &groupContext ($name, %attrs);
+	$res .= $prop . ");";
+	
+	unshift @prev_groups, $current_group;
+	foreach my $attr (keys %attrs) 
+	{
+		if ($attr =~ /^xmlns:(.+)/ ) 
+		{
+			my $extensionPrefix = $1;
+			# this xlink extension is only partly implemented
+			# (ie. when the url refers an image file in the same directory than the SVG file)
+			next if ($extensionPrefix eq 'xlink');  
+			print "$extensionPrefix is not implemented\n";
+			$notImplementedExtensionPrefix{$extensionPrefix} = 0;
+		}
+	}
+	&attrs_implemented ( 'svg', $name, 
+		[qw ( id width height viewBox preserveAspectRatio xmlns),
+		# the following attributes are not currently implementable
+		qw ( enable-background overflow )], %attrs 
+	);
+	&stackPort($name, $width,$height, $attrs{viewBox}, $attrs{preserveAspectRatio});
+	&display ($res);
+}
+
+my @portStack;
+sub stackPort {
+#	my ($name, $width,$height,$viewbox,$aspectRatio)=@_;
+	unshift @portStack, [ @_ ];
+}
+
+## to treat the viewbox, preserveAspectRatio attributes
+## of the svg, symbol, image, foreignObject... entities
+sub viewPortTransforms {
+	my $portRef = shift @portStack;
+	my ($name, $width,$height,$viewbox,$aspectRatio)=@{$portRef};
+	$viewbox = "" unless defined $viewbox;
+	$aspectRatio = "" unless defined $aspectRatio;
+	$width = "" unless defined $width;
+	$height = "" unless defined $height;
+#	print "In $name: width=$width height=$height viewbox=$viewbox aspectRatio=$aspectRatio\n";
+	if ($viewbox and $width and $height ) {
+	my $expr = "->adaptViewport($name, $width,$height, '$viewbox', '$aspectRatio');";
+#	print "Expr = $expr\n";
+	&display($expr);
+#	if (!$aspectRatio or $aspectRatio eq "none") {
+#		my $translateX = $minx;
+#		my $translateY = $miny;
+#		my $scaleX= $width /  ($portWidth - $minx);
+#		my $scaleY= $height / ($portHeight - $miny);
+#		@transfs = ("->translate($name, $translateX, $translateY);",
+#			"->scale($name, $scaleX, $scaleY);");
+#		   &display(@transfs);
+	}
+}
+
+
+sub svgold_ {
+	my ($parser, $elementname) = @_;
+	print "############ End of $elementname:\n" if $verbose;
+	&viewPortTransforms;
+	$current_group = shift @prev_groups;
+	%current_context = %{shift @prev_contexts};
+}
+
+# just to avoid useless warning messages
+sub desc {}
+sub desc_ { }
+
+# just to avoid useless warning messages
+sub title {}
+sub title_ { }
+
+# just to avoid useless warning messages in svg tests suites
+sub Paragraph {}
+sub Paragraph_ { }
+
+## return either the id of the object or a name of the form '__<elementtype>__<$counter>'
+## the returned named includes single quotes!
+## it also increments two counters:
+##  - the itemCount used for naming any item
+##  - the effectiveItemCount for counting graphic items only
+##	This counter is used at the end of a defs to see if a group
+##	must be saved, or if the group is just empty
+sub name {
+	my ($type, $id) = @_;
+	print "############ In $type:\n" if $verbose;
+	$itemCount++;
+	$effectiveItemCount++ if (defined $id and
+				  $type ne 'defs' and
+				  $type ne 'switch' and
+				  $type ne 'g' and
+				  $type ne 'svg' and
+				  $type !~ /Gradient/
+				  );
+	if (defined $id) {
+	$id = &cleanName ($id);
+	return ("'$id'", 1);
+	} else {
+	return ("'" . $prefix . "__$type"."__$itemCount'",0);
+	}
+}
+
+sub g {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+		$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+		return;
+	}
+	%attrs = &expandAttributes ($elementname, %attrs);
+	my ($name,$natural) = &name ($elementname, $attrs {id});
+	my $res = '$parent = $previous = '." -> add ('group', $current_group, -tags => [$name], -priority => 10";
+	unshift @prev_groups, $current_group;
+	$current_group = '$parent';
+   	unshift @prev_contexts, \%current_context;
+   	my $prop;
+	($prop, %current_context) = &groupContext ($name, %attrs);
+   	$res .= $prop . ");\n";
+	$res .= 'push (@parents, $parent);';
+	&attrs_implemented ( 'g', $name, [qw ( id transform ) , @EVENT_ON_GRAPHICS ], %attrs ); ### les styles attrs sont ? traiter ? part!
+	&ddisplay ($res, &transform('$previous', $attrs{transform}));
+	&treatGroupEvent ($name, %attrs);
+}
+
+## returns true if the parameter is an EVENT_ON_GRAPHICS (ie. applies only to group-like tags)
+sub isGroupEvent {
+	my ($attr) = @_;
+	return $EVENT_ON_GRAPHICS{$attr} or 0;
+}
+
+## should bing callbacks to group, depending on events and scripts...
+## not yet implemented
+sub treatGroupEvent {
+	my ($objname, %attr) = (@_);
+	foreach my $event (@EVENT_ON_GRAPHICS) 
+	{
+		my $value = $attr{$event};
+		next unless defined $value;
+	#	print "## $objname HAS EVENT $event = $value\n";
+		# XXX what should I do here?
+	}
+}
+
+sub groupContext {
+	my ($name, %attrs) = @_;
+	my %childrenContext;
+	my $prop = "";
+	foreach my $attr (keys %attrs) 
+	{
+		my $value = $attrs{$attr};
+		if (!defined $value) 
+		{
+			&myWarn ("!! Undefined value for attribute $attr in group $name !?");
+			next;
+		}
+		elsif (&isGroupEvent ($attr)) 
+		{
+			next;
+		}
+		$value = &removeComment($value);
+		if ($attr eq 'opacity') 
+		{
+			$value = &convertOpacity ($value);
+			$prop = sprintf ", -alpha => %i", &float2int($value * 100); 
+		}
+		elsif ($attr eq 'id' or $attr eq 'transform') 
+		{
+			next;
+		}
+		elsif ($attr eq 'display' and $value eq 'none') 
+		{
+			$prop .= ", -visible => 0, -sensitive => 0";
+			&myWarn ("!! The following group is not visible: $name  !?\n");
+		}
+		elsif (&isAnExtensionAttr($attr))
+		{
+			next;
+		}
+		elsif ($attr eq 'viewBox' or $attr eq 'preserveAspectRatio'  or $attr eq 'height' or $attr eq 'width') 
+		{
+		
+		}
+		elsif (!defined $STYLE_ATTRS{$attr}) 
+		{
+			if (defined $STYLE_ATTRS_NYI{$attr}) 
+			{
+				&not_implemented_attr($attr);
+			}
+			else
+			{
+				&myWarn ("!!! Unimplemented attribute '$attr' (='$value') in group $name\n");
+			}
+			next;
+		}
+		else
+		{
+			$childrenContext{$attr} = $value;
+		}
+	}
+	print "children context: ", join (", ", (%childrenContext)) , "\n" if $verbose;
+	return ($prop, %childrenContext);
+}
+		
+
+sub g_ {
+	my ($parser, $elementname, %attrs) = @_;
+	if( !$includeFollowingItems )
+	{
+		return;
+	}
+#	 $current_group = shift @prev_groups;
+	if (!defined $attrs{opacity_group})
+	{
+		%current_context = %{shift @prev_contexts};
+	}
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+		$includeFollowingItems = 0;
+	}
+	my $res = 'pop (@parents);'."\n";
+	$res .= '$parent = $parents [$#parents];'."\n";
+	&ddisplay ($res);
+}
+
+## A switch is implemented as a group.
+## BUG: In fact, we should select either the first if the tag is implemented
+## or the secund sub-tag if not.
+## In practice, the first sub-tag is not implemented in standard SVG, so we
+## we forget it and take the second one.
+## A problem will appear if the first tag is implemented, because, in this case
+## we will instanciantes both the first and second
+sub switch {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name) = &name ($elementname, $attrs{id});
+	$name =~ s/\'//g;
+	$attrs{id} = $name;
+	&g($parser, $elementname, %attrs);
+}
+
+sub switch_ {
+	&g_;
+}
+
+# a clipath is a not-visible groupe whose items define a clipping area
+# usable with the clip-path attribute
+# BUG: currently, the clipping is not implemented, but at least clipping
+## items are put in a invisible sub-group and are not displayed
+sub clipPath {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	print "In clippath $name NYI\n";
+	my $res = "->add('group',$current_group, -tags => [$name, '__clipPath'], -priority => 10, -atomic => 1, -visible => 0";
+	unshift @prev_groups, $current_group;
+	unshift @prev_contexts, \%current_context;
+	my $prop;
+	($prop, %current_context) = &groupContext ($name, %attrs);
+	$res .= $prop . ");";
+	&display ($res, &transform('$previous', $attrs{transform}));
+}
+
+sub clipPath_ {
+	my ($parser, $elementname) = @_;
+	print "############ End of $elementname:\n" if $verbose;
+	%current_context = %{shift @prev_contexts};
+}
+
+# a symbol is a non-visible group which will be instancianted (cloned) 
+# latter in a <use> tag
+sub symbol {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	## should we verify that the clippath has an Id?
+	## should we verify that <symbols> is defined inside a <defs> tag?
+	my $res = "-> add('group', $current_group, -tags => [$name], -priority => 10, -atomic => 1, -visible => 0";
+	unshift @prev_groups, $current_group;
+	unshift @prev_contexts, \%current_context;
+	my $prop;
+	($prop, %current_context) = &groupContext ($name, %attrs);
+	$res .= $prop . ");";
+#	&attrs_implemented ( 'g', $name, [qw ( id transform ) , @EVENT_ON_GRAPHICS ], %attrs ); ### les styles attrs sont ? traiter ? part!
+	&display ($res, &transform('$previous', $attrs{transform}));
+#	&treatGroupEvent ($name, %attrs);
+}
+
+sub symbol_ {
+	my ($parser, $elementname) = @_;
+	print "############ End of $elementname:\n" if $verbose;
+#	 $current_group = shift @prev_groups;
+	%current_context = %{shift @prev_contexts};
+}
+
+# this will clone and make visible either symbols or other items based on the Id refered by the xlink:href attribute
+sub use {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my $ref = $attrs{'xlink:href'};
+	if (!defined $ref) {
+	&myWarn ("!! $elementname must have a xlink:href attribute\n");
+	return;
+	}
+	$ref =~ s/\#//;
+	my $cleanedId = &cleanName($ref); # to make the name zinc compliant
+	my $res = "-> clone ('$cleanedId', -visible => 1, -tags => [$name, 'cloned_$cleanedId']";
+	$res .= &analyze_style (\%attrs);
+	$res .=");";
+	my ($x,$y,$width,$height) = ($attrs{x},$attrs{y},$attrs{width},$attrs{height});
+	my @transforms = "-> chggroup ($name, $current_group);";
+	if (defined $x) 
+	{
+		push @transforms, "-> translate ($name, $x,$y);";
+	}
+	&display ($res,@transforms);
+}
+
+{   ## start of defs block to share $res and other variables between many functions
+
+	## XXX: BUG this code DOES NOT allow recursive defs! (this is also probably a bug in the SVG file)
+	my $defsCounter = 0;
+	my $insideGradient = 0;  ## should never exceed 1!
+	my $res; # the current gradient/object being defined
+	my $defsId; # the group id containing items to be cloned
+	# this group will be deleted later if it is empty
+	
+	my $effectiveItem;
+	## a <defs> will generate the creation of an invisible group in Tk::Zinc
+	## to be cloned latter in a <use> tag
+	## This group can be potentialy empty and in this cas it would be better
+	## not to create it, or at least delete it latter if it is empty
+	
+	sub defs {
+	}
+	
+	sub defsold {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	($defsId) = &name ($elementname, $attrs{id});
+	$defsId =~ s/\'//g;
+	$attrs{id} = $defsId;
+	&g($parser, $elementname, %attrs);
+	&display("-> itemconfigure ('$defsId', -visible => 0);");
+	$defsCounter++;
+	$effectiveItem = $effectiveItemCount;
+	print "############ $elementname: $defsId\n" if $verbose;
+	}
+
+sub defsold_ {
+	my ($parser, $elementname) = @_;
+	$defsCounter++;
+#	print "end of defs $defsId:", $effectiveItemCount , $effectiveItem, "\n";
+	&g_;
+	if ($effectiveItemCount == $effectiveItem) {
+	&display ("-> remove ('$defsId');");
+	}
+}
+
+
+######################################################################
+### CSS : Cascading Style Sheet
+######################################################################
+{ ### css
+	my @styles;
+	my %classes;
+	my %elementClasses;
+	my %idClasses;
+	my $in_css=0;
+sub nextStyle {
+	my $text = shift;
+	push @styles,$text;
+#	print "Style: $text\n";
+}
+
+## returns a reference to a hash-table defining pair of (attribut value) describing
+## a CSS style associated to a Class
+## returns undef if such class is not defined
+sub getClass {
+	my $class = shift;
+	my $ref_styles = $classes{$class};
+#	print "in getClass: $class  ",%classes, "\n";
+#	my %styles = %{$ref_styles}; print "in getClass: $class ", (%styles), "\n";
+	return ($ref_styles);
+}
+
+## returns a reference to a hash-table defining pair of (attribut value) describing
+## a CSS style associated to an element type
+## returns undef if such element type is not defined
+sub getElementClass {
+	my $element = shift;
+	my $ref_styles = $elementClasses{$element};
+#	my %styles = %{$ref_styles};
+#	print "in getElementClass: $element ", (%styles), "\n";
+	return ($ref_styles);
+}
+
+## returns a reference to a hash-table defining pair of (attribut value) describing
+## a CSS style associated to an Id
+## returns undef if such class is not defined
+sub getIdClass {
+	my $id = shift;
+	my $ref_styles = $idClasses{$id};
+#	my %styles = %{$ref_styles};
+#	print "in getIdClass: $id ", (%styles), "\n";
+	return ($ref_styles);
+}
+
+sub style {
+	my ($parser, $elementname, %attrs) = @_;
+	if ($attrs{type} eq "text/css") {
+	$in_css=1;
+	}
+} # end of style
+
+sub style_ {
+	my ($parser, $elementname) = @_;
+	my $str = "";
+	foreach my $s (@styles) {
+	$s = &removeComment($s);
+	$s =~ s/\s(\s+)//g ; # removing blocks of blanks
+	$str .= " " . $s;
+	}
+#	print "in style_: $str\n";
+	while ($str) {
+#	print "remaning str in style_: $str\n";
+	if ($str =~ /^\s*\.(\S+)\s*\{\s*([^\}]*)\}\s*(.*)/ ) {
+		# class styling
+		my ($name,$value) = ($1,$2);
+		$str = $3;
+#		$value =~ s/\s+$//;
+		print "STYLE of class: '$name' => '$value'\n";
+		## and now do something!
+		my %style = &expandStyle($value);
+		$classes{$1} = \%style;
+	} elsif ( $str =~ /^\s*\#([^\{]+)\s*\{\s*([^\}]*)\}\s*(.*)/ ) {
+		my ($ids,$value) = ($1,$2);
+		$str = $3;
+		print "STYLE of ids: '$ids' => '$value'\n";
+		## and now do something!
+	} elsif ( $str =~ /^\s*\[([^\{]+)\]\s*\{\s*([^\}]*)\}\s*(.*)/ ) {
+		my ($attr_val,$value) = ($1,$2);
+		$str = $3;
+		print "STYLE of attr_values: '$attr_val' => '$value'\n";
+		## and now do something!
+	} elsif  ( $str =~ /^\s*\@font-face\s*\{\s*[^\}]*\}\s*(.*)/ ) {
+		print "STYLE of font-face", substr($str, 0, 100),"....\n";
+		$str = $1;
+	} elsif  ( $str =~ /^\s*([^\s\{]+)\s*\{\s*([^\}]*)\}\s*(.*)/ ) {
+		my ($name,$value) = ($1,$2);
+		$str = $3;
+		print "STYLE of tags: '$name' => '$value'\n";
+		## and now do something... NYI
+	} else {
+		&myWarn ("unknown style : $str\nskipping this style");
+		return;
+	}
+	}
+	$in_css=0;
+	@styles=();
+} # end of style_
+
+} ### end of css
+
+######################################################################
+### gradients
+######################################################################
+
+my $gname;
+my @stops;
+my @inheritedStops;
+my $angle;
+my $center;
+my $gradientUnits;
+my @linearCoords;
+my @transformsGrad;
+
+sub radialGradient {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	&myWarn ("!! $elementname must have an id\n") unless $natural;
+	$gname = substr ($name,1,-1); # remove quote (') at the very beginning and end of $name
+	$insideGradient ++;
+	&myWarn ("Gradient '$gname' definition inside a previous gradient definition. This is bug in svg source\n")
+		unless $insideGradient == 1;
+	@stops = ();
+	@inheritedStops = ();
+	if (defined $attrs{'xlink:href'}) 
+	{
+		my $unused;
+		my $link = delete $attrs{'xlink:href'};
+		if ($link =~ /^\#(.+)$/) 
+		{
+			$link = $1;
+			@inheritedStops = @{getGradient ($link)};
+		} 
+		else 
+		{
+			# BUG??: we only treat internal links like #gradientName
+			carp "bad link towards a gradient: $link";
+		}
+	}
+	my ($fx,$fy,$cx,$cy, $r) = &sizesConvert( \%attrs , qw (fx fy cx cy r));
+	# BUG: a serious limitation is that TkZinc (3.2.6i) does not support
+	#	  the cx, cy and r parameters
+	$gradientUnits = $attrs{gradientUnits} ? $attrs{gradientUnits} : 'objectBoundingBox';
+	if (defined $cx and $cx == $fx) { delete $attrs{cx}; }  # to avoid needless warning of &attrs_implemented
+	if (defined $cy and $cy == $fy) { delete $attrs{cy}; }  # to avoid needless warning of &attrs_implemented
+	&attrs_implemented ( 'radialGradient', $name, [qw ( id fx fy r gradientUnits)], %attrs );
+
+	$fx = &float2int(($fx -0.5) * 100);
+	$fy = &float2int(($fy -0.5) * 100);
+	@linearCoords = ($fx, $fy);
+#	 $center = "$fx $fy";
+}
+
+sub radialGradient_ {
+	$insideGradient --;
+	if (!@stops) {
+	if (@inheritedStops) {
+		@stops = @inheritedStops;
+	} else {
+		carp ("Bad gradient def: nor stops, neither xlink;href");
+	}
+	}
+	my @stps = @stops;
+	my @co = @linearCoords;
+	my $gradientDefs = {type => 'radial', coords => \@co, stops => \@stps, gradientUnits => $gradientUnits, transform => []};
+	recordGradient ($gname, $gradientDefs);
+	@stops = ();
+}
+
+sub linearGradient {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	&myWarn ("!! $elementname must have an id\n") unless $natural;
+	$gname = substr ($name,1,-1); # remove quote (') at the very beginning and end of $name
+	$insideGradient ++;
+	&myWarn ("Gradient '$gname' definition inside a previous gradient Definition. This will bug\n")
+		unless $insideGradient == 1;
+	@stops = ();
+	@inheritedStops = ();
+	if (defined $attrs{'xlink:href'}) 
+	{
+		my $unused;
+		my $link = delete $attrs{'xlink:href'};
+		if ($link =~ /^\#(.+)$/) 
+		{
+			$link = $1;
+			@inheritedStops = @{getGradient ($link)};
+		} 
+		else 
+		{
+			# BUG??: we only treat internal links like #gradientName
+			carp "bad link towards a gradient: $link";
+		}
+	}
+	&attrs_implemented ( 'linearGradient', $name, [qw (gradientTransform x1 x2 y1 y2 id gradientUnits)], %attrs );
+	@linearCoords = &sizesConvert( \%attrs , qw (x1 y1 x2 y2));
+	@transformsGrad = parseGradientTransforms ($attrs{'gradientTransform'});
+	$gradientUnits = $attrs{gradientUnits} ? $attrs{gradientUnits} : 'objectBoundingBox';
+}
+
+sub linearGradient_ {
+	$insideGradient --;
+	if (!@stops) 
+	{
+		if (@inheritedStops) 
+		{
+			@stops = @inheritedStops;
+		}
+		else 
+		{
+			carp ("Bad gradient def: nor stops, neither xlink;href");
+		}
+	}
+	my @stps = @stops;
+	my @co = @linearCoords;
+	
+	my @transform = @transformsGrad;
+	my $gradientDefs = {type => 'axial', coords => \@co, stops => \@stps, gradientUnits => $gradientUnits, transform => \@transform};
+	recordGradient ($gname, $gradientDefs);
+}
+
+sub parseGradientTransforms {
+	my ($str) = @_;
+	return (1,0,0,1,0,0) if !defined $str;
+	my @fullTrans;
+
+	while ($str) {
+	my ($trans, $params, $rest) = $str =~ /\s*(\w+)\s*\(([^\)]*)\)\s*(.*)/ ;
+
+	my @params = (defined $params) ? split (/[\s,]+/, $params) : ();
+
+	if (!(defined $trans)) {
+	} elsif ($trans eq 'translate') {
+		$params[1] = 0 if scalar @params == 1;
+		push @fullTrans, [1,0,0,1,@params];
+
+	} elsif ($trans eq 'rotate') {
+		my $angle = $params[0] = &deg2rad($params[0]);
+		push @fullTrans, [cos($angle),sin($angle),-sin($angle),cos($angle),0,0];
+
+	} elsif ($trans eq 'scale') {
+		$params[1] = $params[0] if scalar @params == 1;
+		push @fullTrans, [$params[0],0,0,$params[1],0,0];
+
+	} elsif ($trans eq 'matrix') {
+		push @fullTrans, [@params];
+		
+	} elsif ($trans eq 'skewX') {
+		$params[0] = &deg2rad($params[0]);
+		push @fullTrans, [1,0,tan($params[0]),1,0,0];
+		
+	} elsif ($trans eq 'skewY') {
+		$params[0] = &deg2rad($params[0]);
+		push @fullTrans, [1,tan($params[0]),0,1,0,0];
+	   
+	} elsif ($trans eq 'skew'){
+		myWarn ("!!! Transformation $trans NOT implemented\n");
+
+	} else {
+		myWarn ("!!! Unkown transformation '$trans'\n");
+	}
+	$str = $rest;
+	}
+
+	my @transList = reverse @fullTrans;
+	my @matrix = (1,0,0,1,0,0);
+
+	foreach my $trans (@transList) {
+	my @t = @{$trans};
+	
+	my $a00 = $t[0] * $matrix[0] + $t[2] * $matrix[1];
+	my $a01 = $t[1] * $matrix[0] + $t[3] * $matrix[1];
+	my $a10 = $t[0] * $matrix[2] + $t[2] * $matrix[3];
+	my $a11 = $t[1] * $matrix[2] + $t[3] * $matrix[3];
+	my $a20 = $t[0] * $matrix[4] + $t[2] * $matrix[5] + $t[4];
+	my $a21 = $t[1] * $matrix[4] + $t[3] * $matrix[5] + $t[5];
+	
+	@matrix = ($a00,$a01,$a10,$a11,$a20,$a21);
+	}
+	return (@matrix);
+}
+
+sub stop {
+	my ($parser, $elementname, %attrs) = @_;
+	%attrs = &expandAttributes ($elementname,%attrs);
+	&myWarn ("$elementname should be defined inside <linearGradient> or <radialGradiant>\n") unless $insideGradient;
+
+	my $style = delete $attrs{'style'};
+	if (defined $style) {
+	my %keyvalues = &expandStyle($style);
+	%attrs = (%attrs , %keyvalues);
+	}
+	my $offset = $attrs{'offset'};
+	my $color = $attrs{'stop-color'};
+	if (!defined $color) {
+	&myWarn ("!! Undefined  stop-color in a <stop>\n");
+	} elsif (!defined $offset) {
+	&myWarn ("!! Undefined offset in a <stop>\n");
+	} else {
+	if ($offset =~ /([\.\d]+)%/){  
+		$offset = &float2int($1);
+#	} elsif ($offset =~ /^([.\d]+)$/) {
+#		$offset = &float2int($1*100);
+	} else {
+		$offset = &float2int($offset*100);
+	}
+ 	my ($newcol, $gd) = &colorConvert($color);
+ 	if ($newcol ne '')
+ 	{
+	 	$color = $newcol;
+ 	}
+	if (defined (my $stopOpacity = $attrs{'stop-opacity'})) {
+		$stopOpacity = &float2int($stopOpacity*100);
+		push @stops, "$color$colorSep$stopOpacity $offset";
+	} else {
+		push @stops, "$color $offset";
+	}
+	}
+} # end of stop
+
+} # end of gradient closure
+
+
+my $opacity_group = 100;
+my $start_opacity_group = 0;
+
+sub start_opacity_gp {
+	my ($parser, $elementname, $alpha) = @_;
+	if ($start_opacity_group)
+	{
+		my $res = '$parent ='." -> add ('group', $current_group, -priority => 10, -alpha => $opacity_group);";
+		unshift @prev_groups, $current_group;
+		$current_group = '$parent';
+		$res .= 'push (@parents, $parent);';
+		return $res;
+	}
+	return '';
+}
+
+sub close_opacity_gp {
+	my ($parser, $elementname, $alpha) = @_;
+	if ($start_opacity_group)
+	{
+		my $res = 'pop (@parents);'."\n";
+		$res .= '$parent = $parents [$#parents];'."\n";
+		$start_opacity_group = 0;
+		return $res;
+	}
+	return '';
+}
+
+my %convertFormat = (
+	'jpg' => 'jpeg',
+	'jpeg' => 'jpeg',
+	'png' => 'png',
+);
+
+sub image {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+		$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+		return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+
+	my $group = $current_group;
+	my @RES;
+	if (my $opacity = $attrs{'opacity'}) 
+	{
+		# creating an intermediate group for managing the transparency
+		# BUG: we could used the attribute -color := white:$opacity
+		$opacity = &convertOpacity ($opacity);
+		if ($opacity != 1) 
+		{
+			## on cr?e un groupe pour g?rer la transparence
+			my $opacity = &float2int(100 * $opacity);
+			my $newgroup = substr ($name, 0, -1) . "transparency'";
+			push @RES , '$previous = '." -> add('group', $current_group, -alpha => $opacity, -tags => [ $newgroup ], -priority => 10);\n";
+			$group = $newgroup;
+		}
+	}
+	my $res = "";
+	my $ref = "";
+	if ($ref = $attrs {'xlink:href'}) 
+	{
+		if ($ref =~ /^data:image\/(\w+);base64,(.+)/) 
+		{
+			my $format = $1;
+			my $data = $2;
+			$ref = "data:image/$format;base64"; # $ref is used later in a tag of the icon
+			$format = $convertFormat {lc($format)};
+			$res .= '$previous = '." -> add ('icon', $group, -image => -> Photo (-data => '$data', -format => '$format')";
+		}
+		elsif ($ref =~ /^data:;base64,(.+)/) 
+		{
+			## the following piece of code works more or less ?!
+	 		## BUG: there is a pb with scaling (ex: data-svg/vero_data/propal_crea_boutons.svg) 
+			my $data = $1;
+			$ref = "data:;base64";
+			$res .= '$previous = '." -> add ('icon',$group, -image => -> Photo (-data => '$data')";
+		} 
+		else 
+		{
+			if (open REF, "$fileDir$ref") 
+			{
+				close REF;
+				$res .= '$previous = '." -> add ('icon',$group, -image => -> Photo ('$ref', -file => '$fileDir$ref')";
+			}
+			else
+			{
+				&myWarn ("When parsing the image '$name': no such file: '" . substr ("$fileDir$ref", 0,50) . "'\n") ;
+				return;
+			}
+		}
+	}
+	else 
+	{
+		&myWarn ("Unable to parse the image '$name'") ;
+		return;
+	}
+
+	$res .= ", -tags => [$name, '$ref'], -composescale => 1, -composerotation => 1, -priority => 10);";
+	push @RES, $res ;
+
+	my ($x, $y, $width, $height) = &sizesConvert ( \%attrs , qw (x y width height));
+	if ($width == 0 or $height == 0) 
+	{
+		&myWarn ("Skipping a 0 sized image: '$name' size is $width x $height\n");
+	}
+	elsif ($width < 0 or $height < 0)
+	{
+		&myWarn ("Error in the size of the image '$name' : $width x $height\n");
+	}
+	else
+	{
+		#push @RES, " -> adaptViewport ($name, $width,$height);";
+	}
+	if ($x or $y) 
+	{
+		push @RES, " -> translate (\$previous, $x,$y);";
+	}
+	
+	&attrs_implemented ( 'image', $name, [qw (transform x y width height id )], %attrs );
+	&ddisplay (@RES, &transform('$previous', $attrs{transform}));
+} # end of image
+
+sub image_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub line {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my $res = "->add ('curve', $current_group, [$attrs{x1}, $attrs{y1}, $attrs{x2}, $attrs{y2}], -priority => 10";
+	$res .= ", -tags => ['line'";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "]";
+	$res .= &analyze_style (\%attrs);
+	$res .=");";
+	&attrs_implemented ( 'line', $name, [qw (x1 y1 x2 y2 style id transform )], %attrs );
+	&ddisplay ($res,
+	&transform('$previous', $attrs{transform}) );
+} # end of line
+
+sub line_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub Char {
+	my ($expat, $text) = @_;
+	return if !defined $text;
+	my $type = ($expat->context)[-1];
+	return if !defined $type;
+	chomp $text;
+	return if (!$text && ($text ne "0")); # empty text!
+	if ($type eq 'tspan') 
+	{
+		&nextText ($text);
+	}
+	elsif ($type eq 'style') 
+	{
+		&nextStyle ($text);
+	}
+} # end of char
+
+my $current_font_key = '';
+my %save_current_context = ();
+
+## this lexical block allows &text, &nextTetx, &tspan, and &text_ to share common variables
+{
+	my $res;
+	my @transforms;
+	my @texts;
+	my $text_x;
+	my $text_y;
+	sub text 
+	{
+		my ($parser, $elementname, %attrs) = @_;
+		push (@nameStack, $attrs{id});
+		if($attrs{id} eq $targetName)
+		{
+			$includeFollowingItems = 1;
+		}
+		if( !$includeFollowingItems )
+		{
+			return;
+		}
+		
+		my $prop;
+		%save_current_context = %current_context;
+		($prop, %current_context) = &groupContext ("", %attrs);
+		
+		%attrs = &expandAttributes ($elementname,%attrs);
+		my ($name,$natural) = &name ($elementname, $attrs{id});
+		($text_x, $text_y) = &sizesConvert( \%attrs , qw (x y));
+		$res = "->add('text',$current_group, -composescale => 1, -composerotation => 1, -position => [0, 0], -tags => ['text'";
+		$res .= ", $name" if ($natural or $attrs{transform});
+		$res .= "], -anchor => 'nw'"; 
+		$res .= &analyze_text_style (\%attrs);
+		@texts = ();
+		@transforms = &transform('$previous', $attrs{transform});
+		&attrs_implemented ( 'text', $name, [qw (stroke-miterlimit x y id transform text-anchor font-family font-size)], %attrs );
+	}
+
+	sub nextText {
+		my $txt = shift;
+		push @texts,$txt;
+	}
+	
+	## BUG: <tspan> tags can be used to modiofy many graphics attributs of the part of the text
+	## such as colors, fonte, size and position...
+	## this is currently hard to implement as in Tk::Zinc a text item can only have one color, one size...
+	sub tspan {
+		my ($expat, $elementname, %attrs) = @_;
+		$res .= &analyze_text_style (\%attrs);
+	}
+	
+	sub text_ {
+		my ($parser, $elementname, %attrs) = @_;
+		if( !$includeFollowingItems )
+		{
+			return;
+		}
+		for (my $i=0 ; $i <= $#texts ; $i++) 
+		{
+			$texts[$i] =~ s/\'/\\'/g ;  #'
+		}
+		my $theText = join ('', @texts);
+		$res .= ", -text => '$theText', -priority => 10);";
+		my @ascent;
+		if ($text_x != 0 || $text_y != 0)
+		{
+			push (@ascent, "->  translate(\$previous, $text_x, $text_y);");
+		}
+		push (@ascent, "my \$ascent = -> fontMetrics (\$fonts{\"$current_font_key\"}, -ascent);");
+		push (@ascent, "-> translate(\$previous,0, -\$ascent);");
+	
+		&ddisplay ($res, @ascent, @transforms);
+		
+		$attrs{id} = pop (@nameStack);
+		if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+		{
+			$includeFollowingItems = 0;
+		}
+		%current_context = %save_current_context;
+	
+	}
+
+} ## end of text lexical block
+
+sub polyline {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my $res = "->add('curve',$current_group,[" . &points(\%attrs);
+	$res .= "], -tags => ['polyline'";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "], -priority => 10";
+	$res .= &analyze_style (\%attrs);
+	$res .=");";
+	&attrs_implemented ( 'polyline', $name, [qw (points style transform id )], %attrs );
+	&ddisplay ($res,
+		  &transform('$previous', $attrs{transform}) );
+}
+
+sub polyline_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+my $add_stroke = 0;
+
+sub rect {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my ($x,$y,$width,$height)=&sizesConvert( \%attrs , qw (x y width height));
+	
+	my ($type, $path) = getRectData ($x, $y, $width, $height, $attrs {rx}, $attrs {ry});
+
+	$add_stroke = 0;
+	
+	my $res = "\$previous = -> add('$type',$current_group, [$path], -tags => ['rect'";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "], -priority => 10";
+
+	$res .= ", -filled => 1" unless defined $attrs{fill} and $attrs{fill} eq 'none';
+	$add_stroke = 1 if defined $attrs{stroke};
+	delete $attrs{'stroke-linejoin'}; ## BUG: due to TkZinc limitation: no -joinstyle for rectangle 
+	$res .= &analyze_style (\%attrs);
+	$res .= ", -linewidth => 0" if !$add_stroke;
+	$res .=");";
+	&attrs_implemented ( 'rect', $name, [qw (id x y width height style transform rx ry )], %attrs );
+	&ddisplay ($res,
+		  &transform('$previous', $attrs{transform}) );
+}
+
+sub getRectData {
+	my ($x, $y, $width, $height, $rx, $ry) = @_;
+	my $xf = $x + $width;
+	my $yf = $y + $height;
+	if (( !defined $rx ) && ( !defined $ry ))
+	{
+		return ('rectangle', "$x,$y, ".($x+$width).','.($y+$height));
+	}
+
+	$rx = (defined $rx) ? $rx : $ry;
+	$ry = (defined $ry) ? $ry : $rx;
+	$rx = 0 if ($rx < 0);
+	$ry = 0 if ($ry < 0);
+	$rx = ($rx > $width / 2) ? $width / 2 : $rx;
+	$ry = ($ry > $width / 2) ? $width / 2 : $ry;
+	
+	my $c = (sqrt (2) - 1) * 4/3;	
+	my $retour = "[$x + $rx, $y], [$x + (1 - $c) * $rx, $y, 'c'],";
+	$retour .= "[$x, $y + (1 - $c) * $ry, 'c'], [$x, $y + $ry],";
+	$retour .= "[$x, $yf - $ry], [$x, $yf - (1 - $c) * $ry, 'c'],";
+	$retour .= "[$x + (1 - $c) * $rx, $yf, 'c'], [$x + $rx, $yf],";
+	$retour .= "[$xf - $rx, $yf], [$xf - (1 - $c) * $rx, $yf, 'c'],";
+	$retour .= "[$xf, $yf - (1 - $c) * $ry, 'c'], [$xf, $yf - $ry],";
+	$retour .= "[$xf, $y + $ry], [$xf, $y + (1 - $c) * $ry, 'c'],";
+	$retour .= "[$xf - (1 - $c) * $rx, $y, 'c'], [$xf - $rx, $y],";
+	$retour .= "[$x + $rx, $y]";
+	
+	return ('curve', $retour);
+}
+
+sub rect_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub ellipse {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my ($cx,$cy,$rx,$ry)=&sizesConvert( \%attrs , qw (cx cy rx ry));
+	my $res = "\$previous = ->add('arc', $current_group, [". ($cx-$rx) . ", ". ($cy-$ry) .
+	", " . ($cx+$rx) . ", ". ($cy+$ry) . "], -tags => ['ellipse',";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "], -priority => 10";
+	# by default, ellipses are filled
+	# from svg specifs). The value is set here, and can be overidden later
+	# in the  &analyze_style
+	$res .= ", -filled => 1" unless defined $attrs{fill} and $attrs{fill} eq 'none';
+	delete $attrs{'stroke-linejoin'}; ## BUG: due to TkZinc limitation: no -joinstyle for arc 
+	$res .= &analyze_style (\%attrs);
+	$res .=");";
+	&attrs_implemented ( 'ellipse', $name, [qw (cx cy rx ry style transform id )], %attrs );
+	&ddisplay ($res,
+		  &transform('$previous', $attrs{transform}) );
+}
+
+sub ellipse_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub circle {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my ($cx,$cy,$r)=&sizesConvert( \%attrs , qw (cx cy r));
+	my $res = "\$previous = -> add('arc',$current_group,[". ($cx-$r) . ", ". ($cy-$r) .
+	", " . ($cx+$r) . ", ". ($cy+$r) . "], -tags => ['circle'";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "], -priority => 10";
+	# by default, circles are filled
+	# from svg specifs). The value is set here, and can be overidden later
+	# in the  &analyze_style
+	$res .= ", -filled => 1" unless defined $attrs{fill} and $attrs{fill} eq 'none';
+	$res .= &analyze_style (\%attrs);
+	$res .=");";
+	delete $attrs{'stroke-linejoin'}; ## BUG: due to TkZinc limitation: no -joinstyle for arc 
+	&attrs_implemented ( 'circle', $name, [qw ( cx cy r transform id )], %attrs );
+	&ddisplay ($res,
+		  &transform('$previous', $attrs{transform}) );
+}
+
+sub circle_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub polygon {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+	$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+	return;
+	}
+	%attrs = &expandAttributes ($elementname,%attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my $res = "\$previous = -> add('curve',$current_group,[" . &points(\%attrs);
+	$res .= "], -closed => 1, -tags => ['polygon'";
+	$res .= ", $name" if ($natural or $attrs{transform});
+	$res .= "], -priority => 10";
+	# by default, polygones are filled
+	# from svg specifs). The value is set here, and can be overidden later
+	# in the  &analyze_style
+	$res .= ", -filled => 1" unless defined $attrs{fill} and $attrs{fill} eq 'none';
+	$res .= &analyze_style (\%attrs);
+	$res .= ");";
+	&attrs_implemented ( 'polygone', $name, [qw ( points style transform id )], %attrs );
+	&ddisplay ($res,
+		  &transform('$previous', $attrs{transform}) );
+}
+
+sub polygon_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+
+sub path {
+	my ($parser, $elementname, %attrs) = @_;
+	push (@nameStack, $attrs{id});
+	if($attrs{id} eq $targetName)
+	{
+		$includeFollowingItems = 1;
+	}
+	if( !$includeFollowingItems )
+	{
+		return;
+	}
+	$add_stroke = 0;
+	%attrs = &expandAttributes ($elementname, %attrs);
+	my ($name,$natural) = &name ($elementname, $attrs{id});
+	my $res = "";
+	my ($closed, @listOfListpoints) = &pathPoints (\%attrs);
+	my $refPoints = shift @listOfListpoints;
+	$res .= join (", ", @{$refPoints});
+	$res .= "], -tags => [$name], -priority => 10";
+	$res .= ", -filled => 1" unless defined $attrs {fill} and $attrs {fill} eq 'none';
+	$add_stroke = 1 if defined $attrs {stroke};
+	if ( defined $attrs{'fill-rule'} ) 
+	{
+		$res .= ", -fillrule => 'nonzero'" unless $attrs{'fill-rule'} eq 'evenodd';
+		delete $attrs{'fill-rule'};
+	}
+	$res .= ", -closed => $closed";
+	$res .= &analyze_style (\%attrs);
+	$res .= ", -linewidth => 0" if !$add_stroke;
+	$res .= ");";
+	# and process other contours
+	my @contours = ();
+	foreach my $refPoints (@listOfListpoints) 
+	{
+		my @points = @{$refPoints};
+		my $contour = "-> contour($name, 'add', 0, [";
+		$contour .= join (", ", @points);
+		$contour .= "]);";
+		push @contours, $contour;
+	}
+	&attrs_implemented ( 'path', $name, [qw ( d style stroke-linejoin stroke-linecap transform id stroke-dasharray )], %attrs );
+	$res = start_opacity_gp ($parser, $elementname)."\$previous = -> add('curve', $current_group, [".$res;
+	
+	&ddisplay ($res, @contours, &transform('$previous', $attrs{transform}));
+   	$res = close_opacity_gp ($parser, $elementname);
+   	&ddisplay ($res);
+
+} # end of path
+
+
+sub path_ {
+	my ($parser, $elementname, %attrs) = @_;
+	$attrs{id} = pop (@nameStack);
+	if ((defined $attrs{id}) && ($attrs{id} eq $targetName))
+	{
+	$includeFollowingItems = 0;
+	}
+}
+
+sub expandAttributes {
+	my ($elementName, %rawAttrs) = @_;
+	my (%styleKeyValues, %classKeyValues, %elementKeyValues, %idKeyValues);
+	my $style = delete $rawAttrs{'style'};
+	if (defined $style) {
+	%styleKeyValues = &expandStyle($style);
+	}
+	my $class = delete $rawAttrs{'class'};
+	if (defined $class) {  ## for the css
+	my $ref_styles = &getClass($class);
+	if (defined $ref_styles) {
+		%classKeyValues = %{$ref_styles};
+	} else {
+		&myWarn ("class attribute refers an illegal style: '$class'\n");
+	}
+	}
+	my $ref_styles = &getElementClass($elementName);
+	if (defined $ref_styles) {
+	%elementKeyValues = %{$ref_styles};
+	}
+	my $id = $rawAttrs{id};
+	if (defined $id) {
+	my $ref_style = &getIdClass($id);
+	if (defined $ref_style) {
+		%idKeyValues = %{$ref_styles};
+	}
+	} 
+   return (%rawAttrs, %elementKeyValues, %classKeyValues, %styleKeyValues, %idKeyValues); ## the order is important!
+}
+
+### CM 19/1/03: This function could be really simplified (CM 09/09/3 why??? I do not remember!)
+## analyze styles attached to an item (non text item) and on any of its groups
+sub analyze_style {
+	my ($ref_attr) = @_;
+	my %ref_attr = %{$ref_attr};
+	my %attrs = (%current_context , %ref_attr );
+	my %directkeyvalues;
+	foreach my $attr (@STYLE_ATTRS) 
+	{
+		my $value = $attrs {$attr};
+		if (defined $value) 
+		{  
+			$directkeyvalues {$attr} = &removeComment ($value);
+		}
+	}
+	return &analyze_style_hash (\%directkeyvalues);
+}
+
+
+## analyze styles attached to a text item and on any of its groups
+sub analyze_text_style {
+	my ($ref_attr) = @_;
+	my %attrs = ( %current_context , %{$ref_attr} );
+	my $res = "";
+	my $style = delete $attrs{'style'};
+	if (defined $style) 
+	{
+		my %keyvalues = &expandStyle($style);
+		$res = &analyze_text_style_hash (\%keyvalues);
+	}
+	my %directkeyvalues;
+	foreach my $attr (@STYLE_ATTRS) 
+	{
+		my $value = $attrs{$attr};
+		if (defined $value) 
+		{
+			$directkeyvalues{$attr} = &removeComment($value);
+		}
+	}
+	$res .= &analyze_text_style_hash (\%directkeyvalues);
+	return $res;
+}
+
+
+## expanses the attribute = "prop:val;prop2:val2" in a hashtable like {prop => val, prop2 => val2, ...}
+## and return this hash (BUG: may be it should return a reference!)
+sub expandStyle {
+	my ($style) = @_;
+	return () unless defined $style;
+	my %keyvalues;
+	$style = &removeComment ($style);
+	foreach my $keyvalue ( split ( /\s*;\s*/ , $style) ) 
+	{
+		my ($key, $value) = $keyvalue =~ /(.*)\s*:\s*(.*)/ ;
+		$keyvalues{$key} = $value;
+	}
+	return %keyvalues;
+}
+
+
+## Analyze attributes contained in the hashtable given as ref
+## This hashtable {attribut =>value...} must contain all
+## attributes to analyze
+## returns a string containing the TkZinc attributes
+sub analyze_style_hash {
+	my ($ref_keyvalues) = @_;
+	my %keyvalues = %{$ref_keyvalues};
+	my $res = "";
+	my $opacity = &convertOpacity (delete $keyvalues {'opacity'});
+	my $stroke = delete $keyvalues {'stroke'};
+	my $strokeOpacity = delete $keyvalues {'stroke-opacity'};
+	$strokeOpacity = 1 if !defined $strokeOpacity;
+	$strokeOpacity = &float2int (&convertOpacity ($strokeOpacity) * $opacity * 100);
+	if (defined $stroke) 
+	{
+ 		my ($color, $gd) = &colorConvert ($stroke);
+ 		if ($gd)
+ 		{
+	 		&applyGradient ($color, '-linecolor');
+ 		}
+		elsif ($color eq "none") 
+		{
+			$res .= ", -linewidth => 0";
+			delete $keyvalues {'stroke-width'};
+		} 
+		elsif ($strokeOpacity != 100)
+		{
+			if (&existsGradient ($color)) 
+			{
+				my $newColor = &addTransparencyToGradient ($color, $strokeOpacity);
+				$res .= ", -linecolor => \"$newColor\", -filled => 1";
+			} 
+			else 
+			{
+				$res .= ", -linecolor => \"$color$colorSep$strokeOpacity\"";
+			}
+		} 
+		else 
+		{
+			$res .= ", -linecolor => \"$color\"";
+		}
+		$add_stroke = 1;
+	} 
+	elsif ( $strokeOpacity != 1 ) 
+	{ 
+		# no stroke color, but opacity
+		## what should I do?!
+	}
+   	
+
+	my $fill = delete $keyvalues{'fill'};
+	my $fillOpacity = delete $keyvalues{'fill-opacity'};
+	$fillOpacity = 1 if !defined $fillOpacity;
+	$fillOpacity = &float2int(&convertOpacity($fillOpacity) * $opacity * 100);
+	delete $keyvalues{'fill-opacity'};
+	if (defined $fill) 
+	{  
+ 		my ($color, $gd) = &colorConvert ($fill);
+ 		if ($gd)
+ 		{
+ 			if ($fillOpacity != 100)
+ 			{
+ 			 	print STDERR "Attention, gros hack\n";
+ 				$start_opacity_group = 1;
+	 			$opacity_group = $fillOpacity;
+ 			}
+	 		&applyGradient ($color, '-fillcolor');
+ 		}
+		elsif ($color eq "none") 
+		{
+	   		$res .= ", -filled => 0";
+			delete $keyvalues {'fill-opacity'};
+		} 
+		elsif ( $fillOpacity != 100 ) 
+		{
+			if (&existsGradient ($color)) 
+			{
+				my $newColor = &addTransparencyToGradient ($color, $fillOpacity);
+				$res .= ", -fillcolor => \"$newColor\", -filled => 1";
+				$res .= ", -linecolor => \"$newColor\"," unless defined $stroke;
+			} 
+			else 
+			{
+				$res .= ", -fillcolor => \"$color$colorSep$fillOpacity\", -filled => 1";
+				$res .= ", -linecolor => \"$color$colorSep$fillOpacity\"," unless defined $stroke;
+			}
+		} 
+		else 
+		{
+			$res .= ", -fillcolor => \"$color\", -filled =>1";
+			$res .= ", -linecolor => \"$color\"" unless defined $stroke;
+		}
+	}
+
+	foreach my $key (sort keys %keyvalues) 
+	{
+		my $value = $keyvalues{$key};
+		next if (!defined $value);
+		if ($key eq 'stroke-width') 
+		{
+			if ( defined $keyvalues{stroke} and $keyvalues{stroke} eq 'none' ) 
+			{
+				delete $keyvalues{stroke};
+				next;
+			}
+			$value = &sizeConvert($value);
+			if ($value == 0 and $dtdVersion eq "1.0") 
+			{
+				$value = 0.1;	  # BUG? a widht of 0 is the smallest possible width in SVG 1.0 [true or false?]
+			}
+			$res .= ", -linewidth => $value";
+		} 
+		elsif ($key eq 'stroke-dasharray') 
+		{
+			$res .= ", -linestyle => \"dashed\"";
+		} 
+		elsif ($key eq 'display') 
+		{
+			if ($value eq 'none') 
+			{
+				$res .= ", -visible => 0, -sensitive => 0";
+			}
+		} 
+		elsif ($key eq 'visibility') 
+		{
+			## BUG? if a "not-visible" <g> group contains a visible graphic element
+			## this element WILL NOT be visible in TkZinc , but should be visible in SVG!!
+			## Cf specif svg p. 284
+			if ($value eq 'hidden' or $value eq 'collapse') 
+			{
+				$res .= ", -visible => 0";
+			}
+		} 
+		elsif ($key eq 'stroke-linecap') 
+		{
+			if ($value eq 'butt' or $value eq 'round') 
+			{
+				$res .= ", -capstyle => \"$value\"";
+			} 
+			elsif ($value eq 'square') 
+			{
+				$res .= ", -capstyle => \"projecting\"";
+			} 
+			else 
+			{
+				&myWarn ("!! bad value for $key style : $value\n");
+			}
+		} 
+		elsif ($key eq 'stroke-linejoin') 
+		{
+			($value) = $value =~ /(\w+)/ ;
+			$res .= ", -joinstyle => \"$value\"";
+		} 
+		elsif ($key eq 'fill-rule') 
+		{
+			### this attributes is for shape only and is analyzed in &path
+		} 
+		elsif ($key eq 'font-size') 
+		{
+			### this attributes is for text only and is analyzed in &analyze_text_style_hash
+		}
+		else 
+		{
+			&myWarn ("Unknown Style (in analyze_style_hash): $key (value is $value)\n") if $warn;
+		}
+	}
+	return $res;
+}
+
+
+sub analyze_text_style_hash 
+{
+	my ($ref_keyvalues) = @_;
+	my %keyvalues = %{$ref_keyvalues};
+
+	my $res = "";
+	my $opacity = &convertOpacity($keyvalues{opacity});
+	delete $keyvalues{'opacity'};
+
+	my $fontFamily="";
+	my $fontSize ="";
+	my $fontWeight ="";
+
+	foreach my $key (keys %keyvalues) 
+	{
+		my $value = $keyvalues{$key};
+		next if (!defined $value);  # in this case, the SVG code is invalide (TBC)
+		if ($key eq 'text-anchor') 
+		{
+			if ($value eq 'start') 
+			{
+				$res .= ", -anchor => 'nw'";
+			} 
+			elsif ($value eq 'end') 
+			{
+				$res .= ", -anchor => 'ne'";
+			} 
+			elsif ($value eq 'middle') 
+			{
+				$res .= ", -anchor => 'n'"
+			}
+		} 
+		elsif ($key eq 'display') 
+		{
+			if ($value eq 'none') 
+			{
+				$res .= ", -visible => 0, -sensitive => 0";
+			}
+		} 
+		elsif ($key eq 'visibility') 
+		{
+			## BUG? if a "not-visible" <g> group contains a visible graphic element
+			## this element WILL NOT be visible in TkZinc , but should be visible in SVG!!
+			## Cf specif svg p. 284
+			if ($value eq 'hidden' or $value eq 'collapse') 
+			{
+				$res .= ", -visible => 0";
+			}
+			## We do not treat the other possible values for display as defined in CSS2?!
+		} 
+		elsif ($key eq 'font-family') 
+		{
+			$value =~ s/\'//g;  # on removing quotes around the fonte name
+			$fontFamily = $value;
+		} 
+		elsif ($key eq 'font-size') 
+		{
+			$fontSize = $value;
+		} 
+		elsif ($key eq 'font-weight') 
+		{
+			$fontWeight = $value;
+		} 
+		elsif ($key eq 'fill') 
+		{
+			my $fillOpacity;
+ 			my ($color, $gd) = &colorConvert($value);
+ 			if ( $gd )
+ 			{
+	 			&applyGradient ($color, '-color');
+ 			}
+			elsif ($color eq 'none') 
+			{
+				# $res .= ", -filled => 0"; # this is the default value in Tk::Zinc
+			} 
+			elsif ( ($fillOpacity = $keyvalues{'fill-opacity'} or $opacity != 1) ) 
+			{
+				$fillOpacity = &convertOpacity($fillOpacity) * $opacity;
+				delete $keyvalues{'fill-opacity'};
+				if ( &existsGradient($color) )
+				{
+					#  so, apply a transparency to a Tk::Zinc named gradient
+					my $newColor = &addTransparencyToGradient($color,$fillOpacity);
+					$res .= ", -color => \"$newColor\"";
+				} 
+				else 
+				{
+					$fillOpacity = int ($fillOpacity * 100);
+					$res .= ", -color => \"$color$colorSep$fillOpacity\"";
+				}
+			} 
+			else 
+			{
+				$res .= ", -color => \"$color\"";
+			}
+		} 
+		else 
+		{
+			&myWarn ("Unknown Style of text: $key (value is $value)\n") if $warn;
+		}
+	}
+	if ($fontFamily or $fontSize or $fontWeight) 
+	{
+		## to be extended to all other fonts definition parameters
+		## NB: fontWeight is not used yet!
+		my ($fontKey,$code) = &createNamedFont ($fontFamily, $fontSize, "");
+		&display("\$fonts{\"$fontKey\"} = ") if $code;
+		&display($code) if $code;
+		$res .= ", -font => \"$fontKey\"";
+		$current_font_key = $fontKey;
+	}
+	return $res;
+}
+
+
+
+
+## print warnings for all used attributes unkonwn or not implemented
+sub attrs_implemented {
+	my ($type, $name, $ref_attrs_implemented, %attrs) = @_;
+	my %attrs_implemented;
+	foreach my $attr (@{$ref_attrs_implemented}) {
+	$attrs_implemented{$attr}=1;
+	}
+	my %expandStyle = &expandStyle ($attrs{style});
+	my %attributes = ( %expandStyle, %attrs);
+	foreach my $attr ( keys %attributes ) {
+#	print "attr: $attr  $attributes{$attr}\n";
+	if (!&isAnExtensionAttr($attr) and
+		!defined $STYLE_ATTRS{$attr} and
+		!defined $attrs_implemented{$attr}) {
+		if (defined $STYLE_ATTRS_NYI{$attr}) {
+		&not_implemented_attr($attr);
+		} else {
+		&myWarn ("!!! Unimplemented attribute '$attr' (='$attributes{$attr}') in '$type' $name\n");
+		}
+	}
+	}
+} # end of attrs_implemented
+
+# These hashes contain the number of usage of not implemented attributes and
+# the lines on svg source files where a not implemented attributes is used
+# so that they can be displayed by the sub &print_warning_for_not_implemented_attr
+my %not_implemented_attr;
+my %not_implemented_attr_lines;
+sub not_implemented_attr {
+	my ($attr) = @_;
+	$not_implemented_attr{$attr}++;
+	if (defined $not_implemented_attr_lines{$attr}) {
+	push @{$not_implemented_attr_lines{$attr}},&current_line;
+	} else {
+	$not_implemented_attr_lines{$attr} = [&current_line];
+	}
+}
+
+sub print_warning_for_not_implemented_attr {
+	foreach my $k (sort keys %not_implemented_attr) {
+	print "not implemented/implementable attribute '$k' was used $not_implemented_attr{$k} times in lines ";
+	my @lines;
+	if ($not_implemented_attr{$k} > 20) {
+		@lines = @{$not_implemented_attr_lines{$k}}[0..19];
+		print join (", ",@lines) ,"...\n";
+	} else {
+		@lines = @{$not_implemented_attr_lines{$k}};
+		print join (", ",@lines) ,"...\n";
+	}
+	}
+}
+
+
+# print a warning for the first use of an attribute of a non-implemented extension to SVG
+# return  :
+# - true if the attribute belong to an extension of SVG
+# - false if its supposed to be a standard SVG attribute (or a non-existing attribute)
+sub isAnExtensionAttr {
+	my ($attr) = @_;
+	if ( $attr =~ /^(.+):.+/ ) {
+	my $prefix = $1;
+	if (defined $notImplementedExtensionPrefix{$prefix} and
+		$notImplementedExtensionPrefix{$prefix} == 0) {
+		&myWarn ("!! XML EXTENSION '$prefix' IS NOT IMPLEMENTED\n");
+		# we set the value to 1 so that the next time we will not prnt another message
+		$notImplementedExtensionPrefix{$prefix} = 1;
+	}
+	return 1;
+	} else {
+	return 0;
+	}
+} # end of isAnExtensionAttr
+
+{
+	my $inMetadata=0;
+	sub metadata {
+	$inMetadata++;
+	}
+sub _metadata {
+	$inMetadata--;
+}
+
+sub inMetadata {
+	return $inMetadata;
+}
+}
+
+sub notYetImplemented {
+	my ($elementname) = @_;
+	&myWarn ("####### $elementname: Not Yet Implemented\n");
+}
+
+{
+	my $expat;
+sub Init {
+	$expat = shift;
+}
+sub Final {
+	undef $expat;
+}
+
+## takes 1 arg : 'message'
+sub myWarn {
+	my ($mess) = @_;
+	if (defined $expat) {
+	print STDOUT ("at ", $expat->current_line, ": $mess");
+	} else {
+	print STDOUT $mess;
+	}
+}
+
+sub current_line {
+	if (defined $expat) 
+	{
+		return $expat->current_line; 
+	} 
+	else 
+	{
+		return "_undef_";
+	}
+}
+}
+
+sub applyGradient {
+	my (@res) = @_;
+	$backend -> applyGradient(@res);
+}
+
+sub recordGradient {
+	my (@res) = @_;
+	$backend -> recordGradient(@res);
+}
+
+sub getGradient {
+	my (@res) = @_;
+	return $backend -> getGradient(@res);
+}
+
+sub display {
+	my (@res) = @_;
+	$backend -> treatLines(@res);
+}
+
+sub ddisplay {
+	my (@res) = @_;
+	$backend -> dtreatLines(@res);
+}
+
+sub findINC
+{
+ my $file = join('/',@_);
+ my $dir;
+ $file  =~ s,::,/,g;
+ foreach $dir (@INC)
+  {
+   my $path;
+   return $path if (-e ($path = "$dir/$file"));
+  }
+ return undef;
+}
+
+
+###################################################################
+### this a slightly different implementation of the subs style as defined in XML::Parser
+### Differences are :
+# - when an error occure in a callback, the error is handled and a warning is
+#	 printed with the line number of the SVG source file
+# - namespace can be used (this is usefull for example to treat the SVG included in dia data files)
+#
+
+package XML::Parser::SVG2zinc;
+$XML::Parser::Built_In_Styles{'SVG2zinc'} = 1;
+
+
+sub Start {
+	no strict 'refs';
+	my $expat = shift;
+	my $tag = shift;
+	my $ns = $expat->namespace($tag);
+	if (!defined $ns || $ns =~ /\/svg$/) 
+	{
+		## the tag is a SVG tag
+		## BUG: we should also get some tags of XML standard used by
+		## the SVG standard. Exemple: xlink:href
+		my $sub = $expat->{Pkg} . "::$tag";
+		if (defined &$sub) 
+		{
+	  		eval { &$sub($expat, $tag, @_) };
+			if ($@) 
+			{
+				$expat->xpcarp("An Error occured while evaluationg $tag {...} :\n$@");
+			}
+		} 
+		elsif (&SVG::SVG2zinc::inMetadata) 
+		{
+	  		# we do othing, unless tags were treated before!
+		}
+	  	else 
+		{
+			if ($tag eq 'a:midPointStop') {return;}
+			## skipping the tag if it is part of not implemented extension
+			my ($extension) = $tag =~ /(\w+):.*/;
+			return if defined $extension &&  defined $notImplementedExtensionPrefix{$extension};
+		 warn "## Unimplemented SVG tag: $tag\n";
+		}
+	}
+}
+
+sub End {
+  no strict 'refs';
+  my $expat = shift;
+  my $tag = shift;
+  my $ns = $expat->namespace($tag);
+  if (!defined $ns || $ns =~ /\/svg$/) {
+	  my $sub = $expat->{Pkg} . "::${tag}_";
+	  ## the tag is a SVG tag
+	  if (defined &$sub) {
+	  eval { &$sub($expat, $tag) };
+	  if ($@) {
+		  $expat->xpcarp("An Error occured while evaluationg ${tag}_ {...}) :\n$@");
+	  }
+	  } else {
+	  # the following error message is not usefull, as there were already
+	  # an error message at the opening tag
+	  # warn "## Unimplemented SVG tag: ${tag}_\n";
+	  }
+  }
+}
+
+
+
+###################################################################
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+SVG::SVG2zinc - a module to display or convert svg files in scripts, classes, images...
+
+=head1 SYNOPSIS
+
+ use SVG::SVG2zinc;
+
+ &SVG::SVG2zinc::parsefile('file.svg', 'Backend','file.svg',
+			   -out => 'outfile',
+			   -verbose => $verbose,
+			   -namespace => 0|1,
+			   -prefix => 'string', 
+			   );
+
+ # to generate a Perl script: 
+ &SVG::SVG2zinc::parsefile('file.svg','PerlScript', 
+			   -out => 'file.pl');
+
+ # to generate a Perl Class:
+ &SVG::SVG2zinc::parsefile('file.svg','PerlClass', 
+			   -out => 'Class.pm');
+
+ # to display a svgfile:
+ &SVG::SVG2zinc::parsefile('file.svg', 'Display'); 
+
+ #To convert a svgfile in png/jpeg file:
+ &SVG::SVG2zinc::parsefile('file.svg', 'Image', 
+				   -out => 'file.jpg');
+
+ # to generate a Tcl script: 
+ &SVG::SVG2zinc::parsefile('file.svg','TclScript', 
+			   -out => 'file.tcl');
+
+
+=head1 DESCRIPTION
+
+Depending on the used Backend, &SVG::SVG2zinc::parsefile either generates a Perl Class,
+Perl script, Tcl Script, bitmap images or displays SVG files inside a Tk::Zinc widget.
+
+SVG::SVG2zinc could be extended to generate Python scripts and/or
+classes, or other files, just by sub-classing SVG::SVG2zinc::Backend(3pm)
+
+==head1 HOW IT WORKS
+
+This converter creates some TkZinc items associated to most SVG tags.
+For example, <SVG> or <G> tags are transformed in TkZinc groups. <PATH>
+are converted in TkZinc curves.... many more to come...
+
+==head2 TkZinc items tags
+
+Every TkZinc item created by the parser get one or more tags. If the
+corresponding svg tag has an Id, this Id will be used as a tag, after
+some cleaning due to TkZinc limitation on tag values (no dot, star, etc...).
+If the corresponding svg tag has no Id, the parser add a tag of the
+following form : __<itemtype>__<integer>. If the parser is provided
+a B<-prefix> option, the prefix is prepended to the tag:
+<prefix>__<itemtype>__<integer>
+
+The TkZinc group associated to the top <SVG> tag has the following tag 'svg_top', as well as 'width=integer' 'heigth=integer' tags if width and height are defined in the top <SVG> tag. These tags can be used to find the group and to get its desired width and height.
+
+==head2 RunTime code
+
+There is currently on new Tk::Zinc method needed when executing perl code generated.
+This perl Tk::Zinc::adaptViewport function should be translated and included or
+imported in any script generated in an other scripting language (eg. Tcl or Python).
+
+=head1 BUGS and LIMITATIONS
+
+Some limitations are due to differences between Tk::Zinc and SVG graphic models :
+
+=over 2
+
+=item B<Drawing width>
+
+Drawing width are zoomed in SVG but are not in Tk::Zinc where it is constant whatever the zoom factor is.
+
+=item B<Gradient Transformation>
+
+Gradient Transformation is not possible in Tk::Zinc. May be it could be implemented by the converter?
+
+=item B<Rounded Rectangles>
+
+Rectangles cannot have rounded corners in Tk::Zinc. Could be implemented, by producing curve item rather than rectangles in Tk::zinc. Should be implemented in a future release of Tk::Zinc  
+
+=item B<Text and tspan tags>
+
+Text and tspan tags are very complex items in SVG, for example placement can be very precise and complex. Many such features are difficult
+to implement in Tk::Zinc and are not currently implemented
+
+=item B<Font>
+
+Font management is still limited. It will be rotatable and zoomable in future release of Tk::Zinc. SVG fonts included in a document are not readed, currently.
+
+=item B<SVG image filtering>
+
+No image filtering functions are (and will be) available with Tk::Zinc, except if YOU want to contribute?
+
+=item B<ClipPath tag>
+
+The SVG ClipPath tag is a bit more powerfull than Tk::Zinc clipping (clipper is limited to one item). So currently this is not implemented at all in SVG::SVG2zinc 
+
+=back
+
+
+There are also some limitations due to the early stage of the converter:
+
+=over 2
+
+=item B<CSS>
+
+CSS in external url is not yet implemented
+
+=item B<SVG animation and scripting>
+
+No animation is currently available, neither scripting in the SVG file. But Perl or Tcl are scripting languages, are not they?
+
+=item B<switch tag>
+
+The SVG switch tag is only partly implemented, but should work in most situations
+
+=item B<href for images>
+
+href for images can only reference a file in the same directory than the SVG source file.
+
+=back
+
+It was said there is still one hidden bug... but please patch and/or report it to the author! Any (simple ?)
+
+SVG file not correctly rendered by this module (except for limitations
+listed previously) could be send to the author with little comments
+about the expected rendering and observed differences.
+
+=head1 SEE ALSO
+
+svg2zinc.pl(1) a sample script using and demonstrating SVG::SVG2zinc
+
+SVG::SVG2zinc::Backend(3pm) to defined new backends.
+
+Tk::Zinc(3) TkZinc is available at www.openatc.org/zinc/
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com>
+
+many patches and extensions from Alexandre Lemort <lemort at intuilab dot com>
+
+helps from Celine Schlienger <celine at intuilab dot com> and St?phane Chatty <chatty at intuilab dot com>
+
+=head1 COPYRIGHT
+
+CENA (C) 2002-2004, IntuiLab (C) 2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
diff --git a/src/SVG/SVG2zinc/Backend.pm b/src/SVG/SVG2zinc/Backend.pm
new file mode 100644
index 0000000..badee67
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend.pm
@@ -0,0 +1,293 @@
+package SVG::SVG2zinc::Backend;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend for SVG2zinc
+#
+#	Copyright 2003-2004
+#	Centre d'?tudes de la Navigation A?rienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       An abstract class for code generation
+#       Concrete sub-classes can generate code for perl (script / module), tcl,
+#       printing, or direct execution
+#
+# $Id: Backend.pm,v 1.1.1.2 2006-11-16 14:51:45 merlin Exp $
+#############################################################################
+
+use strict;
+use Carp;
+use FileHandle;
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.2 $ =~ /(\d+)\.(\d+)/);
+
+sub new {
+    my ($class, %passed_options) = @_;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(%passed_options);
+    return $self;
+}
+
+my %new_options = (
+		   -render => 1,
+		   -out => 1,
+		   -in => 1,
+		   -verbose => 1,
+);
+
+sub _initialize {
+    my ($self, %passed_options) = @_;
+    foreach my $opt (keys (%passed_options)) 
+    {
+		if (defined ($new_options{$opt})) 
+		{
+	    	$self->{$opt} = $passed_options{$opt};
+		} 
+		else 
+		{
+	    	carp ("Warning: option $opt unknown for a ".ref($self)."\n");
+		}
+    }
+    $self -> {-render} = 1 unless defined $self -> {-render};
+    croak("undefined mandatory -in options") unless defined $self -> {-in};
+    if (defined $self -> {-out} and $self -> {-out}) 
+    {
+		my $out = $self->{-out};
+		if (ref($out) eq 'GLOB') 
+		{
+	    	## nothing to do, the $out is supposed to be open!?
+		} 
+		else 
+		{
+		    my @reps = split ('::', $out);
+			my $file = $reps [0];
+			for (my $i = 0; $i < @reps - 1; $i++)
+			{
+				if(not -d $file)
+				{
+					if(!mkdir ($file))
+					{
+						print STDERR "##### Error creating directory: $file\n";
+					}
+				}
+				$file .= '/'.$reps [$i + 1];
+			}
+			print STDERR "writing $file...\n";
+			my $fh = FileHandle -> new("> " . $file);
+		    if ($fh) 
+		    {
+				$self->{-filehandle} = $fh;
+		    } 
+		    else 
+		    {
+				carp ("unable to open " . $out);
+		    }
+		}
+    }
+    return $self;
+}
+
+# used by SVG2zinc to know the zinc group in which the svg topgroup  
+# by default: 1
+# currently default need be overriden by PerlClass only, as far as I now!?
+sub _topgroup {
+    my ($self) = @_;
+    if ($self->{-topgroup}) {
+	return $self->{-topgroup};
+    } else {
+	return 1;
+    }
+}
+
+# returns true if code is put in a file
+sub inFile {
+    my ($self) = @_;
+    return (defined $self->{-filehandle});
+}
+
+sub printLines {
+    my ($self, @lines) = @_;
+    if ($self->inFile) {
+	my $fh = $self->{-filehandle};
+	foreach my $l (@lines) {
+	    print $fh "$l\n";
+	}
+    } else {
+	carp "printLines cannot print if no outfile has been given\n";
+    }
+}
+
+sub treatLines {
+    my ($self, @lines) = @_;
+    if ($self->inFile) {
+	$self->printLines(@lines);
+    }
+}
+
+
+## in case of file generation, should print a comment
+## the default is to print comment starting with #
+sub comment {
+    my ($self, @lines) = @_;
+    if ($self->inFile) {
+	foreach my $l (@lines) {
+	    $self->printLines("##  $l");
+	}
+    }
+}
+
+sub close {
+    my ($self) = @_;
+    if ($self->inFile) {
+	$self->{-filehandle}->close;
+    }
+}
+
+sub fileHeader {
+    my ($self) = @_;
+    $self->comment ("", "default Header of SVG::SVG2zinc::Backend", "");
+}
+
+
+sub fileTail {
+    my ($self) = @_;
+    $self->comment ("", "default Tail of SVG::SVG2zinc::Backend", "");
+    $self->close;
+}
+
+
+	
+1;
+
+
+__END__
+
+=head1 NAME
+
+SVG::SVG2zinc::Backend - a virtual class SVG::SVG2zinc svg reader. Sub-class are specialized for different type of generation
+
+=head1 SYNOPSIS
+
+package SVG::SVG2zinc::Backend::SubClass
+
+use SVG::SVG2zinc::Backend;
+
+## some methods definition
+
+....
+
+ ## when using a specialized backend:
+
+ use SVG::SVG2zinc::Backend::SubClass;
+
+ $backend = SVG::SVG2zinc::Backend::SubClass->new(
+	       -out => filename_or_handle,
+               -in => svgfilename,
+	       -verbose => 0|1,
+	       [otheroptions],
+	       );
+
+ $backend->fileHeader();
+
+ $backend->treatLines("lineOfCode1", "lineOfCode2",...);
+
+ $backend->comment("comment1", "comment2", ...);
+
+ $backend->printLines("comment1", "comment2", ...);
+
+ $backend->fileTail();
+
+=head1 DESCRIPTION
+
+SVG::SVG2zinc::Backend is a perl virtual class which should be specialized in sub-classes. It defines
+a common interface ot classes which can for example generate perl code with Tk::Zinc, display
+SVG file in a Tk::Zinc widget, convert svg file in image files (e.g. png) or generate tcl code
+to be used with TkZinc etc...
+
+A backend should provide the following methods:
+
+=over
+
+=item B<new>
+
+This creation class method should accept pairs of (-option => value) as well as the following arguments:
+
+=over
+
+=item B<-out>
+
+A filename or a filehandle ready for writing the output. In same rare cases
+(e.g. the Display backend which only displays the SVG file on the screen,
+this option will not be used)
+
+=item B<-in>
+
+The svg filename. It should be used in comments only in the generated file
+
+=item B<-verbose>
+
+It will be used for letting the backend being verbose
+
+=back
+
+=item B<fileHeader>
+
+Generates the header in the out file, if needed. This method should be called just after creating a backend and prior any treatLines or comment method call.
+
+=item B<treatLines>
+
+Processes the given arguments as lines of code. The arguments are very close to Tk::Zinc perl code. When creating a new backend, using the B<Print> backend can help understanding what are exactly these arguments.
+
+=item B<comment>
+
+Processes the given arguments as comments. Depending on the backend, this method must be redefined so that arguments are treated as comments, or just skipped.
+
+=item B<printLines>
+
+Print in an outfile the given arguments as lines of text. This method should not be re-defined, but used by any Backend which generates code.
+
+=item B<fileTail>
+
+Generate the tail in the out file if needed and closes the out file. This must be the last call.
+
+=back
+
+A backend can use the printLines method to print lines in the generated file.
+
+=head1 SEE ALSO
+
+SVG::SVG2zinc::Backend::Display(3pm), SVG::SVG2zinc::Backend::PerlScript(3pm),
+SVG::SVG2zinc::Backend::TclScript(3pm), SVG::SVG2zinc::Backend::PerlClass(3pm) code
+as examples of SVG::SVG2zinc::Backend subclasses.
+
+SVG::SVG2zinc(3pm)
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com> with some help from Daniel Etienne <etienne at cena dot fr>
+
+=head1 COPYRIGHT
+    
+CENA (C) 2003-2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
+
diff --git a/src/SVG/SVG2zinc/Backend/Display.pm.k b/src/SVG/SVG2zinc/Backend/Display.pm.k
new file mode 100644
index 0000000..8da4b9b
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/Display.pm.k
@@ -0,0 +1,257 @@
+package SVG::SVG2zinc::Backend::Display;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc to display a svg file in a Tk::Zinc canvas
+# 
+#	Copyright 2003
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+# $Id: Display.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+use SVG::SVG2zinc::Backend;
+
+@ISA = qw( SVG::SVG2zinc::Backend );
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+use strict;
+use Carp;
+use Tk::Zinc::SVGExtension;
+
+eval (require Tk::Zinc);
+if ($@) {
+    die "$@\nSVG::SVG2zinc::Backend requires Tk::Zinc to be installed\n";
+} elsif (eval ('$Tk::Zinc::VERSION !~ /^\d\.\d+$/ or $Tk::Zinc::VERSION < 3.295') ) {
+    die "Tk::Zinc must be at least 3.295";
+}
+
+
+sub new {
+    my ($class, %passed_options) = @_;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(%passed_options);
+    return $self;
+}
+
+my $zinc;
+my ($WIDTH, $HEIGHT);
+my $top_group;
+sub _initialize {
+    my ($self, %passed_options) = @_;
+    $WIDTH = delete $passed_options{-width};
+    $WIDTH = 600 unless defined $WIDTH;
+    $HEIGHT = delete $passed_options{-height};
+    $HEIGHT = 600 unless defined $HEIGHT;
+    
+    $self->SUPER::_initialize(%passed_options);
+
+    require Tk::Zinc::Debug; # usefull for browsing items herarchy
+    my $mw = MainWindow->new();
+    my $svgfile = $self->{-in};
+    $mw->title($svgfile);
+    $zinc = $mw->Zinc(-width => $WIDTH, -height => $HEIGHT,
+		      -borderwidth => 0,
+		      -render => $self->{-render},
+		      -backcolor => "white", ## why white?
+		      )->pack(qw/-expand yes -fill both/);
+
+    if (Tk::Zinc::Debug->can('init')) {
+	# for TkZinc >= 3.2.96
+	&Tk::Zinc::Debug::init($zinc, -optionsToDisplay => "-tags", -optionsFormat => "row");
+    } else {
+	# for TkZinc <= 3.2.95
+	&Tk::Zinc::Debug::finditems($zinc);
+	&Tk::Zinc::Debug::tree($zinc, -optionsToDisplay => "-tags", -optionsFormat => "row");
+    }
+}
+
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    my $verbose = $self->{-verbose};
+    foreach my $l (@lines) {
+	my $expr = $l;
+	$expr =~ s/->/\$zinc->/g;
+	my $unused = $zinc; ## due to a perl bug, this is needed so that $zinc will be known in $expr
+	my $r = eval ($expr);
+	if ($@) {
+#	    &myWarn ("While evaluationg:\n$expr\nAn Error occured: $@\n");
+	    print ("While evaluationg:\n$expr\nAn Error occured: $@\n");
+	} elsif ($verbose) {
+	    if ($l =~ /^->add/) {
+		print "$r == $expr\n" if $verbose;
+	    } else {
+		print "$expr\n" if $verbose;
+	    }
+	}
+    }
+}
+
+
+sub fileHeader {
+#    my ($self) = @_;
+}
+
+
+my $zoom;
+sub fileTail {
+    # resizing to make them all visible
+    $top_group = $zinc->find ('withtag', ".1");
+    my @bbox = $zinc->bbox($top_group);
+    $zinc->translate($top_group, -$bbox[0], -$bbox[1]) if defined $bbox[0] and $bbox[1];
+    @bbox = $zinc->bbox($top_group);
+    my $ratio = 1;
+    $ratio = $WIDTH / $bbox[2] if ($bbox[2] and $bbox[2] > $WIDTH);
+    $ratio = $HEIGHT/ $bbox[3] if ($bbox[3] and $HEIGHT/$bbox[3] lt $ratio);
+
+    $zoom=1;
+    $zinc->scale($top_group, $ratio, $ratio);
+
+    # adding some usefull callbacks
+    $zinc->Tk::bind('<ButtonPress-1>', [\&press, \&motion]);
+    $zinc->Tk::bind('<ButtonRelease-1>', [\&release]);
+    
+    $zinc->Tk::bind('<ButtonPress-2>', [\&press, \&zoom]);
+    $zinc->Tk::bind('<ButtonRelease-2>', [\&release]);
+
+    $zinc->Tk::bind('<Control-ButtonPress-1>', [\&press, \&mouseRotate]);
+    $zinc->Tk::bind('<Control-ButtonRelease-1>', [\&release]);
+    $zinc->bind('all', '<Enter>',
+                [ sub { my ($z)=@_; my $i=$z->find('withtag', 'current');
+                        my @tags = $z->gettags($i);
+                        pop @tags; # to remove the tag 'current'
+                        print "$i (", $z->type($i), ") [@tags]\n";}] );
+
+  Tk::MainLoop;
+}
+
+##### bindings for moving, rotating, scaling the displayed items
+my ($cur_x, $cur_y, $cur_angle);
+sub press {
+    my ($zinc, $action) = @_;
+    my $ev = $zinc->XEvent();
+    $cur_x = $ev->x;
+    $cur_y = $ev->y;
+    $cur_angle = atan2($cur_y, $cur_x);
+    $zinc->Tk::bind('<Motion>', [$action]);
+}
+
+sub motion {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+    
+    my @res = $zinc->transform($top_group, [$lx, $ly, $cur_x, $cur_y]);
+    $zinc->translate($top_group, ($res[0] - $res[2])*$zoom, ($res[1] - $res[3])*$zoom);
+    $cur_x = $lx;
+    $cur_y = $ly;
+}
+
+sub zoom {
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+    my ($maxx, $maxy);
+    
+    if ($lx > $cur_x) {
+        $maxx = $lx;
+    } else {
+        $maxx = $cur_x;
+    }
+    if ($ly > $cur_y) {
+        $maxy = $ly
+    } else {
+        $maxy = $cur_y;
+    }
+    return if ($maxx == 0 || $maxy == 0);
+    my $sx = 1.0 + ($lx - $cur_x)/$maxx;
+    my $sy = 1.0 + ($ly - $cur_y)/$maxy;
+    $cur_x = $lx;
+    $cur_y = $ly;
+    $zoom = $zoom * $sx;
+    $zinc->scale($top_group, $sx, $sx); #$sy);
+}
+
+sub mouseRotate {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+    my $langle = atan2($ev->y, $ev->x);
+    $zinc->rotate($top_group, -($langle - $cur_angle), $cur_x, $cur_y);
+    $cur_angle = $langle;
+}
+
+sub release {
+    my ($zinc) = @_;
+    $zinc->Tk::bind('<Motion>', '');
+}
+
+
+sub displayVersion {
+    print $0, " : Version $VERSION\n\tSVG::SVG2zinc.pm Version : $SVG::SVG2zinc::VERSION\n";
+    exit;
+}
+
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+SVG:SVG2zinc::Backend::Display - a backend class for displaying SVG file
+
+=head1 DESCRIPTION
+
+SVG:SVG2zinc::Backend::Display is a class for displaying SVG files.
+
+For more information, you should look at SVG:SVG2zinc::Backend(3pm).
+
+The new method accepts parameters described in the SVG:SVG2zinc::Backend class and the following additionnal parameters:
+
+=over
+
+=item B<-render>
+
+The render value of the Tk::Zinc widget. 0 means no openGL, 1 or 2 for openGL. Defaults to 1.
+
+=back
+
+=head1 SEE ALSO
+
+SVG::SVG2zinc::Backend(3pm) and SVG::SVG2zinc(3pm)
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com>
+
+=head1 COPYRIGHT
+    
+CENA (C) 2003-2004 IntuiLab 2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
+
diff --git a/src/SVG/SVG2zinc/Backend/Image.pm.k b/src/SVG/SVG2zinc/Backend/Image.pm.k
new file mode 100644
index 0000000..bfd7851
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/Image.pm.k
@@ -0,0 +1,201 @@
+package SVG::SVG2zinc::Backend::Image;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc to generate image files
+# 
+#	Copyright 2003
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+# $Id: Image.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+use SVG::SVG2zinc::Backend;
+
+@ISA = qw( SVG::SVG2zinc::Backend );
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+use strict;
+use Carp;
+use Tk::Zinc::SVGExtension;
+
+eval (require Tk::Zinc);
+if ($@) {
+    print "$@\nSVG::SVG2zinc::Backend requires Tk::Zinc to be installed\n";
+}
+
+sub new {
+    # testing that 'import' is available
+    # is this test portable?
+    my $ret = `which import`;
+    croak ("## You need the 'import' command from 'imagemagic' package to use the Image backend.\n")
+	if !$ret;
+    
+    my ($class, %passed_options) = @_;
+    my $self = {};
+    bless $self, $class;
+    $self->_initialize(%passed_options);
+    return $self;
+}
+
+my $zinc;
+sub _initialize {
+    my ($self, %passed_options) = @_;
+    if (defined $passed_options{-ratio}) {
+	if ($passed_options{-ratio} !~ /^\d+%$/) {
+	    croak ("## -ratio should look like nn%");
+	} else {
+	    $self->{-ratio} = delete $passed_options{-ratio};
+	}
+    }
+    if (defined $passed_options{-width}) {
+	$self->{-width} = delete $passed_options{-width};
+    }
+    if (defined $passed_options{-height}) {
+	$self->{-height} = delete $passed_options{-height};
+    }
+
+    $self->SUPER::_initialize(%passed_options);
+
+    my $mw = MainWindow->new();
+    my $svgfile = $self->{-in};
+    $mw->title($svgfile);
+    my $render = (defined $self->{-render}) ? $self->{-render} : 1;
+    $zinc = $mw->Zinc(-borderwidth => 0,
+		      -render => $render,
+		      -backcolor => "white", ## why white?
+		      )->pack(qw/-expand yes -fill both/);
+}
+
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    my $verbose = $self->{-verbose};
+    foreach my $l (@lines) {
+	my $expr = $l;
+	$expr =~ s/->/\$zinc->/g;
+	my $unused = $zinc; ## due to a perl bug, this is needed so that $zinc will be known in $expr
+	my $r = eval ($expr);
+	if ($@) {
+#	    &myWarn ("While evaluationg:\n$expr\nAn Error occured: $@\n");
+	    print ("While evaluationg:\n$expr\nAn Error occured: $@\n");
+	} elsif ($verbose) {
+	    if ($l =~ /^->add/) {
+		print "$r == $expr\n" if $verbose;
+	    } else {
+		print "$expr\n" if $verbose;
+	    }
+	}
+    }
+}
+
+
+sub fileHeader {
+#    my ($self) = @_;
+}
+
+
+sub fileTail {
+    my ($self) = @_;
+    my $outfile = $self->{-out};
+
+    # to find the top group containing width and height
+    my $svgGroup = $zinc->find('withtag', 'svg_top') ; 
+
+    my $tags = join " ", $zinc->gettags($svgGroup);
+#    print "svgGroup=$svgGroup  => $tags\n";
+    my ($width) = $tags =~ /width=(\d+)/ ;
+    my ($height) = $tags =~ /height=(\d+)/ ;
+#    print "height => $height width => $width\n";
+    
+    $zinc->configure (-width => $width, -height => $height);
+    $zinc->update;
+
+    my $requiredWidth = $self->{-width};
+    my $requiredHeigth = $self->{-height};
+    my $importParams="";
+    if (defined $requiredWidth and defined $requiredHeigth) {
+	$importParams=" -resize $requiredWidth"."x$requiredHeigth";
+    } elsif (defined $self->{-ratio}) {
+	$importParams=" -resize ".$self->{-ratio};
+    }
+#    print "importParams=$importParams\n";
+
+    ## following are for comments:
+    my ($svg2zincPackage) = caller;
+    my $VERSION = eval ( "\$".$svg2zincPackage."::VERSION" );
+    my $svgfile = $self->{-in};
+
+    my $command = "import -window " . $zinc->id . $importParams ." -comment 'created with SVG::SVG2zinc from $svgfile v$VERSION (c) CENA 2003 C.Mertz.' $outfile";
+#    print "command=$command\n";
+    my $return = system ($command);
+
+    if ($return) {
+	## -1 when import is not available
+	print "## To use the Image Backend you need the 'import' command\n";
+	print "## from the 'imagemagick' package on your system\n";
+    }
+}
+
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+SVG:SVG2zinc::Backend::Image - a backend class for generating image file from SVG file
+
+=head1 DESCRIPTION
+
+SVG:SVG2zinc::Backend::Image is a backend class for generating image file from SVG files. It uses the 'import' command included in the ImageMagick package.
+
+For more information, you should look at SVG:SVG2zinc::Backend(3pm).
+
+The new method accepts parameters described in the SVG:SVG2zinc::Backend class and the following additionnal parameters:
+
+=over
+
+=item B<none>
+
+=back
+
+=head1 SEE ALSO
+
+SVG::SVG2zinc::Backend(3pm) and SVG::SVG2zinc(3pm)
+
+=head1 BUGS and LIMITATIONS
+
+This backend generates images files from the content of a displayed Tk::Zinc window. The size (in pixels) of the generated image is thus limited to the maximal size of a window on your system. 
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com>
+
+=head1 COPYRIGHT
+    
+CENA (C) 2003-2004 IntuiLab 2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
+
diff --git a/src/SVG/SVG2zinc/Backend/PerlClass.pm b/src/SVG/SVG2zinc/Backend/PerlClass.pm
new file mode 100644
index 0000000..9b47ee7
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/PerlClass.pm
@@ -0,0 +1,203 @@
+package SVG::SVG2zinc::Backend::PerlClass;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc
+# 
+#	Copyright 2003-2004
+#	Centre d'?tudes de la Navigation A?rienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       An concrete class for code generation for Perl Class
+#
+# $Id: PerlClass.pm,v 1.4 2007-03-12 10:25:18 merlin Exp $
+#############################################################################
+
+use SVG::SVG2zinc::Backend;
+use File::Basename;
+
+use Tk::Zinc;
+
+@ISA = qw( SVG::SVG2zinc::Backend );
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
+
+use strict;
+use Carp;
+
+our $current_package_name = '';
+
+sub _initialize {
+    my ($self, %passed_options) = @_;
+    $self->{-topgroup} = '$self->{-topgroup}'; # this code is used by SVG2zinc
+    $self->SUPER::_initialize(%passed_options);
+    $self -> {delayed_lines} = ();
+    $self -> {gradient} = {};
+    $self -> {gradient_id} = 0;
+    return $self;
+}
+
+sub recordGradient {
+	my ($self, $name, $def) = @_;
+	$self -> {gradient} -> {$name} = $def;
+}
+
+sub getGradient {
+	my ($self, $name) = @_;
+	return $self -> {gradient} -> {$name} -> {stops};
+}
+
+sub applyGradient {
+	my ($self, $name, $prop) = @_;
+	my $grad = $self -> {gradient} -> {$name};
+	my $id = $self -> {gradient_id} ++;
+	my %hash = %{$grad};
+	my @lignes = 'my ($x1, $y1, $x2, $y2) = $_zinc -> bbox ($previous);';
+#	push (@lignes, 'my ($parent) = $_zinc -> find(\'ancestors\', $previous);');
+	push (@lignes, '($x1, $y1, $x2, $y2) = $_zinc -> transform(\'device\', $parent, [$x1+1, $y1+1, $x2-2, $y2-2]);');
+	push (@lignes, "my \$grad = getGradient (");
+	push (@lignes, "\t'$current_package_name',");
+	push (@lignes, "\t'$id',");
+	push (@lignes, "\t'".$hash {type}."',");
+	push (@lignes, "\t'".$hash {gradientUnits}."',");
+	push (@lignes, "\t".join (',' , @{$hash{coords}}).",");
+	push (@lignes, "\t'".join ('|' , @{$hash{stops}})."',");
+	push (@lignes, "\t".join (',' , @{$hash{transform}}).",");
+	push (@lignes, "\t\$x1, \$y1, \$x2, \$y2");
+	push (@lignes, ");");
+	push (@lignes, "mconfigure (\$previous, $prop => \$grad);");
+	
+	$self -> {current_gradient} = \@lignes;
+}
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    foreach my $l (@lines) 
+    {
+		$l =~ s/^(\s*)->/$1\$_zinc->/g;
+		$l =~ s/(\W)->/$1\$_zinc->/g;
+		$self -> printLines($l);
+    }
+}
+
+sub dtreatLines {
+    my ($self, @lines) = @_;
+    foreach my $l (@lines) 
+    {
+		$l =~ s/^(\s*)->add/$1\$previous = \$_zinc-> add/g;
+		$l =~ s/(\W)->add/$1\$previous = \$_zinc-> add/g;
+		
+		$l =~ s/^(\s*)->/$1\$_zinc-> /g;
+		$l =~ s/(\W)->/$1\$_zinc-> /g;
+		
+    }
+    if (defined @lines)
+    {
+		my $rule = shift (@lines);
+		push (@{$self -> {delayed_lines}}, $rule);
+    }
+    if (defined $self -> {current_gradient})
+    {
+	    my @grad = @{$self -> {current_gradient}};
+	    foreach my $l (@grad) 
+    	{
+	    	push (@{$self -> {delayed_lines}}, $l);
+    	}
+    	$self -> {current_gradient} = undef;
+    }
+    foreach my $l (@lines) 
+    {
+    	push (@{$self -> {delayed_lines}}, $l);
+    }
+}
+
+sub fileHeader {
+    my ($self) = @_;
+    my $file = $self -> {-in}; # print "file=$file\n";
+    my ($svg2zincPackage) = caller;
+    my $VERSION = eval ( "\$".$svg2zincPackage."::VERSION" );
+    my ($package_name) = $self -> {-out} =~ /(.*)\.pm$/ ;
+	$current_package_name = $package_name;
+	$self -> printLines("package $package_name;
+
+####### This file has been generated from $file by SVG::SVG2zinc.pm Version: $VERSION
+
+");
+    $self->printLines(
+<<'HEADER'
+
+use strict;
+use MTools;
+use MTools::MGroup;
+use vars qw /@ISA @EXPORT @EXPORT_OK/;
+use Tk::PNG;
+
+BEGIN 
+{
+	@ISA = qw /MTools::MGroup/;
+}
+	      
+
+sub new {
+    my ($class, %passed_options) = @_;
+    my $self = {};
+    bless $self, $class;
+
+    my $_zinc = $passed_options {-zinc};
+    croak ("-zinc option is mandatory at instanciation") unless defined $_zinc;
+
+    if (defined $passed_options {-topgroup}) 
+    {
+		$self -> {-topgroup} = $passed_options {-topgroup};
+    }
+    else 
+    {
+		$self -> {-topgroup} = 1;
+    }
+    
+    my $parent = $self -> {-topgroup};
+    my @parents = ();
+    my $previous = ();
+    push (@parents, $parent);
+
+# on now items creation!
+HEADER
+);
+}
+
+
+sub fileTail {
+    my ($self) = @_;
+    $self->comment ("", "Tail of SVG2zinc::Backend::PerlScript", "");
+    unshift (@{$self -> {delayed_lines}}, '$self -> {instance} = $previous = ');
+    $self -> printLines(@{$self -> {delayed_lines}});
+    $self -> printLines(
+<<'TAIL'
+return $self;
+}
+
+1;
+TAIL
+);
+    $self->close;
+}
+
+
+1;
+
diff --git a/src/SVG/SVG2zinc/Backend/PerlScript.pm.k b/src/SVG/SVG2zinc/Backend/PerlScript.pm.k
new file mode 100644
index 0000000..b3b453c
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/PerlScript.pm.k
@@ -0,0 +1,275 @@
+package SVG::SVG2zinc::Backend::PerlScript;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc
+# 
+#	Copyright 2003-2004
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       A concrete class for code generation for Perl Scripts
+#
+# $Id: PerlScript.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+use strict;
+use Carp;
+
+use SVG::SVG2zinc::Backend;
+use File::Basename;
+
+use vars qw( $VERSION @ISA  );
+@ISA = qw( SVG::SVG2zinc::Backend );
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    foreach my $l (@lines) {
+	$l =~ s/->/\$_zinc->/g;
+	$self->printLines($l);
+    }
+}
+
+sub fileHeader {
+    my ($self) = @_;
+    my $svgfile = $self->{-in};
+    my ($svg2zincPackage) = caller;
+    my $VERSION = eval ( "\$".$svg2zincPackage."::VERSION" );
+    $self->printLines("#!/usr/bin/perl -w
+
+####### This file has been generated from $svgfile by SVG::SVG2zinc.pm Version: $VERSION
+");
+
+
+    $self->printLines(
+<<'HEADER'
+use Tk::Zinc 3.295;
+use Tk::Zinc::Debug;
+use Tk::PNG;  # only usefull if loading png file
+use Tk::JPEG; # only usefull if loading png file
+
+use Tk::Zinc::SVGExtension;
+
+my $mw = MainWindow->new();
+HEADER
+		      );
+    my $svgfilename = basename($svgfile);
+    $self->printLines("
+\$mw->title('$svgfile');
+my (\$WIDTH, \$HEIGHT) = (800, 600);
+" );
+    my $render = $self->{-render};
+    $self->printLines("
+my \$zinc = \$mw->Zinc(-width => \$WIDTH, -height => \$HEIGHT,
+		     -borderwidth => 0,
+                     -backcolor => 'white', # why white?
+		     -render => $render,
+		      )->pack(qw/-expand yes -fill both/);;
+");
+
+    $self->printLines(
+<<'HEADER'
+if (Tk::Zinc::Debug->can('init')) {
+    # for TkZinc >= 3.2.96
+    &Tk::Zinc::Debug::init($zinc, -optionsToDisplay => "-tags", -optionsFormat => "row");
+} else {
+    # for TkZinc <= 3.2.95
+    &Tk::Zinc::Debug::finditems($zinc);
+    &Tk::Zinc::Debug::tree($zinc, -optionsToDisplay => "-tags", -optionsFormat => "row");
+}
+
+my $top_group = 1; ###$zinc->add('group', 1);
+
+my $_zinc=$zinc;
+
+{ ###
+
+HEADER
+    );
+}
+
+
+sub fileTail {
+    my ($self) = @_;
+    $self->printLines(
+<<'TAIL'
+	   }
+
+### on va retailler et translater les objets créés!
+
+my @bbox = $_zinc->bbox($top_group);
+$_zinc->translate($top_group, -$bbox[0], -$bbox[1]);
+@bbox = $_zinc->bbox($top_group);
+my $ratio = 1;
+$ratio = $WIDTH / $bbox[2] if ($bbox[2] > $WIDTH);
+$ratio = $HEIGHT/$bbox[3] if ($HEIGHT/$bbox[3] lt $ratio);
+$zinc->scale($top_group, $ratio, $ratio);
+
+### on ajoute quelques binding bien pratiques pour la mise au point
+
+$_zinc->Tk::bind('<ButtonPress-1>', [\&press, \&motion]);
+$_zinc->Tk::bind('<ButtonRelease-1>', [\&release]);
+$_zinc->Tk::bind('<ButtonPress-2>', [\&press, \&zoom]);
+$_zinc->Tk::bind('<ButtonRelease-2>', [\&release]);
+
+# $_zinc->Tk::bind('<ButtonPress-3>', [\&press, \&mouseRotate]);
+# $_zinc->Tk::bind('<ButtonRelease-3>', [\&release]);
+$_zinc->bind('all', '<Enter>',
+	[ sub { my ($z)=@_; my $i=$z->find('withtag', 'current');
+			my @tags = $z->gettags($i);
+			pop @tags; # pour enlever 'current'
+			print "$i (", $z->type($i), ") [@tags]\n";}] );
+
+&Tk::MainLoop;
+
+
+##### bindings for moving, rotating, scaling the items
+my ($cur_x, $cur_y, $cur_angle);
+sub press {
+    my ($zinc, $action) = @_;
+    my $ev = $zinc->XEvent();
+    $cur_x = $ev->x;
+    $cur_y = $ev->y;
+    $cur_angle = atan2($cur_y, $cur_x);
+    $zinc->Tk::bind('<Motion>', [$action]);
+}
+
+sub motion {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+    my @res = $zinc->transform($top_group, [$lx, $ly, $cur_x, $cur_y]);
+    $zinc->translate($top_group, $res[0] - $res[2], $res[1] - $res[3]);
+    $cur_x = $lx;
+    $cur_y = $ly;
+}
+
+sub zoom {
+    my ($zinc, $self) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+    my $maxx;
+    my $maxy;
+    my $sx;
+    my $sy;
+    
+    if ($lx > $cur_x) {
+	$maxx = $lx;
+    } else {
+	$maxx = $cur_x;
+    }
+    if ($ly > $cur_y) {
+	$maxy = $ly
+    } else {
+	$maxy = $cur_y;
+    }
+    return if ($maxx == 0 || $maxy == 0);
+    $sx = 1.0 + ($lx - $cur_x)/$maxx;
+    $sy = 1.0 + ($ly - $cur_y)/$maxy;
+    $cur_x = $lx;
+    $cur_y = $ly;
+    $zinc->scale($top_group, $sx, $sx); #$sy);
+}
+
+sub mouseRotate {
+    my ($zinc) = @_;
+    my $ev = $zinc->XEvent();
+    my $lx = $ev->x;
+    my $ly = $ev->y;
+    my $langle = atan2($ly, $lx);
+    $zinc->rotate($top_group, -($langle - $cur_angle));
+    $cur_angle = $langle;
+}
+
+sub release {
+    my ($zinc) = @_;
+    $zinc->Tk::bind('<Motion>', '');
+}
+TAIL
+);
+    $self->close;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+SVG:SVG2zinc::Backend::PerlScript - a backend class generating Perl script displaying the content of a SVG file
+
+=head1 SYNOPSIS
+
+ use SVG:SVG2zinc::Backend::PerlScript;
+
+ $backend = SVG:SVG2zinc::Backend::PerlScript->new(
+	       -out => filename_or_handle,
+               -in => svgfilename,
+	       -verbose => 0|1,
+	       -render => 0|1|2,
+	       );
+
+ $backend->fileHeader();
+
+ $backend->treatLines("lineOfCode1", "lineOfCode2",...);
+
+ $backend->comment("comment1", "comment2", ...);
+
+ $backend->printLines("comment1", "comment2", ...);
+
+ $backend->fileTail();
+
+=head1 DESCRIPTION
+
+SVG:SVG2zinc::Backend::PerlScript is a class for generating perl script which displays the content of a SVG file. The generated script requires Tk::Zinc.
+
+For more information, you should look at SVG::SVG2zinc::Backend(3pm).
+
+The generated perl script uses the Tk::Zinc::Debug tool, so it is easy to inspect items created in Tk::Zinc. Use the <ESC> key to get some help when the cursor is in the Tk::Zinc window. 
+
+The B<new> method accepts parameters described in the SVG:SVG2zinc::Backend class and the following additionnal parameter:
+
+=over
+
+=item B<-render>
+
+The render option of the Tk::Zinc widget. A value of 0 means no openGL, 1 or 2 for openGL. Defaults to 1.
+
+=back
+
+=head1 SEE ALSO
+
+SVG::SVG2zinc::Backend(3pm) and SVG::SVG2zinc(3pm)
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com>
+
+=head1 COPYRIGHT
+    
+CENA (C) 2003-2004 IntuiLab (C) 2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
+
diff --git a/src/SVG/SVG2zinc/Backend/Print.pm.k b/src/SVG/SVG2zinc/Backend/Print.pm.k
new file mode 100644
index 0000000..8e533ac
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/Print.pm.k
@@ -0,0 +1,61 @@
+package SVG::SVG2zinc::Backend::Print;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc
+# 
+#	Copyright 2003
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       An concrete class for code printing for Perl Scripts/Modules
+#       This Backend is for svg2zinc debug purpose mainly
+#
+# $Id: Print.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+use SVG::SVG2zinc::Backend;
+
+@ISA = qw( SVG::SVG2zinc::Backend );
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+use strict;
+use Carp;
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    foreach my $l (@lines) {
+	print "$l\n";
+    }
+}
+
+
+sub fileHeader {
+#    my ($self) = @_;
+}
+
+
+sub fileTail {
+#    my ($self) = @_;
+}
+
+
+1;
+
diff --git a/src/SVG/SVG2zinc/Backend/Tcl.pm.k b/src/SVG/SVG2zinc/Backend/Tcl.pm.k
new file mode 100644
index 0000000..3149ef6
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/Tcl.pm.k
@@ -0,0 +1,96 @@
+package SVG::SVG2zinc::Backend::Tcl;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc
+# 
+#	Copyright 2003-2004
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       A module for code translation from perl to tcl generation
+#
+# $Id: Tcl.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+
+use vars qw( $VERSION);
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+@ISA = qw( Exporter );
+@EXPORT = qw( perl2tcl );
+
+use strict;
+use Carp;
+
+
+sub perl2tcl {
+    my (@lines) = @_;
+    my @res;
+    foreach my $l (@lines) {
+
+	$l =~ s/->(\w*)\((.*)\)/\$w\.zinc $1 $2/g;  # ->add(....) => $w.zinc add ...
+
+	$l =~ s/\s*,\s*/ /g;  # replacing commas by spaces
+	$l =~ s/\s*=>\s*/ /g;  # replacing => by spaces
+
+ 	$l =~ s/\s*\'([^\s;]+)\'\s*/ $1 /g ;  # removing single-quotes around string without spaces
+	$l =~ s/\s*\"([^\s;]+)\"\s*/ $1 /g ;  # removing double-quotes around string without spaces
+	$l =~ s/([\"\s])\#/$1\\\#/g ;  # prefixing # by a slash
+
+	$l =~ s/\[/\{/g;  # replacing [ by }
+	$l =~ s/\]/\}/g;  # replacing ] by }
+	$l =~ s/\{\s+/\{/g;  # removing spaces after {
+	$l =~ s/\s+\}/\}/g;  # removing spaces before }
+
+	$l =~ s/-tags \{(\S+)\}/-tags $1/g;  # -tags {toto}  ==>> -tags toto
+	$l =~ s/\'/\"/g;  # replacing all single quotes by double quotes
+
+	$l = &hack($l);
+    
+	$l =~ s/\s+/ /g;  # dangerous: removing multiple occurences of blanks
+
+	$l =~ s/^\s+//;   # removing blanks at the beginning
+	$l =~ s/\s+$//;   # removing trailing blanks
+	$l =~ s/\s*;$//;  # removing trailing ;
+	push @res, $l;
+    }
+    return (@res);
+}
+
+
+# this routine is used to do some special code transformation,
+# due to soem discrepancies between tcl/tk and perl/tk
+# the following code is more or less dependant from the generated
+# code by SVG2zinc.pm
+#
+# We assume is code has already been tcl-ised
+sub hack {
+    my ($l) = @_;
+
+    if ($l =~ /^\$w\.zinc fontCreate/) {
+	# this works because I know how fontCreate is used in SVG2zinc
+	$l =~ s/\$w\.zinc fontCreate/font create/;
+	$l =~ s/-weight medium/-weight normal/;
+    }
+
+    return $l;
+}
+
+1;
+
diff --git a/src/SVG/SVG2zinc/Backend/TclScript.pm.k b/src/SVG/SVG2zinc/Backend/TclScript.pm.k
new file mode 100644
index 0000000..90ecf4b
--- /dev/null
+++ b/src/SVG/SVG2zinc/Backend/TclScript.pm.k
@@ -0,0 +1,275 @@
+package SVG::SVG2zinc::Backend::TclScript;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+#	Backend Class for SVG2zinc
+# 
+#	Copyright 2003
+#	Centre d'Études de la Navigation Aérienne
+#
+#	Author: Christophe Mertz <mertz at intuilab dot com>
+#
+#       A concrete class for code generation for Tcl Scripts
+#
+# $Id: TclScript.pm.k,v 1.1.1.1 2006-10-20 13:34:31 merlin Exp $
+#############################################################################
+
+use strict;
+use Carp;
+
+use SVG::SVG2zinc::Backend;
+use SVG::SVG2zinc::Backend::Tcl;
+use File::Basename;
+
+use vars qw( $VERSION @ISA  );
+@ISA = qw( SVG::SVG2zinc::Backend );
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
+
+sub new {
+    my ($class, %passed_options) = @_;
+    my $self = {};
+    bless $self, $class;
+    $self->{-render} = defined $passed_options{-render} ? delete $passed_options{-render} : 1;
+    $self->_initialize(%passed_options);
+    return $self;
+}
+
+
+sub treatLines {
+    my ($self,@lines) = @_;
+    foreach my $l (@lines) {
+	$self->printLines( &perl2tcl($l) );
+    }
+}
+
+sub fileHeader {
+    my ($self) = @_;
+    my $svgfile = $self->{-in};
+    my $svgfilename = basename($svgfile);
+    $svgfilename =~ s/\./_/g;
+    my ($svg2zincPackage) = caller;
+    my $VERSION = eval ( "\$".$svg2zincPackage."::VERSION" );
+    $self->printLines('#!/bin/sh
+# the next line restarts using wish \
+    exec wish "$0" "$@"
+');
+
+    $self->printLines("
+
+####### This Tcl script file has been generated
+####### from $svgfile
+####### by SVG::SVG2zinc.pm Version: $VERSION
+
+");
+
+    $self->printLines('
+#
+# Locate the zinc top level directory.
+#
+set zincRoot [file join [file dirname [info script]] ..]
+
+#
+# And adjust the paths accordingly.
+#
+lappend auto_path $zincRoot
+set zinc_library $zincRoot
+
+package require Tkzinc 3.2
+
+## here we should import img for reading jpeg, png, gif files
+
+');
+
+    my $render = $self->{-render};
+    $self->printLines(
+<<HEADER
+set w .$svgfilename
+## catch {destroy \$w}
+toplevel \$w
+wm title \$w $svgfilename
+wm iconname \$w $svgfilename
+
+###########################################
+# Zinc
+##########################################
+zinc \$w.zinc -width 600 -height 600 -font 9x15 -borderwidth 0 -backcolor grey90 -render $render
+
+pack \$w.zinc
+
+set topGroup [\$w.zinc add group 1]
+
+
+HEADER
+    );
+}
+
+
+sub fileTail {
+    my ($self) = @_;
+    $self->printLines(
+<<'TAIL'
+### translating ojects for making them all visibles
+
+#set bbox [$w.zinc bbox $topGroup]
+
+$w.zinc translate $topGroup 200 150
+
+
+##### bindings for moving rotating scaling the items
+
+bind $w.zinc <ButtonPress-1>  "press motion %x %y"
+bind $w.zinc <ButtonRelease-1>  release
+bind $w.zinc <ButtonPress-2>  "press zoom %x %y"
+bind $w.zinc <ButtonRelease-2>  release
+bind $w.zinc <ButtonPress-3>  "press mouseRotate %x %y"
+bind $w.zinc <ButtonRelease-3>  release
+
+
+set curX 0
+set curY 0
+set curAngle 0
+
+proc press {action x y} {
+    global w curAngle curX curY
+
+    set curX $x
+    set curY $y
+    set curAngle [expr atan2($y, $x)]
+    bind $w.zinc <Motion> "$action %x %y"
+}
+
+proc motion {x y} {
+    global w topGroup curX curY
+
+    foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \
+			       [list $x $y $curX $curY]] break
+    $w.zinc translate $topGroup [expr $x1 - $x2] [expr $y1 - $y2]
+    set curX $x
+    set curY $y
+}
+
+proc zoom {x y} {
+    global w curX curY
+
+    if {$x > $curX} {
+	set maxX $x
+    } else {
+	set maxX $curX
+    }
+    if {$y > $curY} {
+	set maxY $y
+    } else {
+	set maxY $curY
+    }
+    if {($maxX == 0) || ($maxY == 0)} {
+	return;
+    }
+    set sx [expr 1.0 + (double($x - $curX) / $maxX)]
+    set sy [expr 1.0 + (double($y - $curY) / $maxY)]
+    $w.zinc scale __svg__1 $sx $sx
+    set curX $x
+    set curY $y
+}
+
+proc mouseRotate {x y} {
+    global w curAngle
+
+    set lAngle [expr atan2($y, $x)]
+    $w.zinc rotate __svg__1 [expr $lAngle - $curAngle]
+    set curAngle  $lAngle
+}
+
+proc release {} {
+    global w
+
+    bind $w.zinc <Motion> {}
+}
+TAIL
+);
+
+    $self->close;
+}
+
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+SVG:SVG2zinc::Backend::TclScript - a backend class for generating Tcl script
+
+=head1 SYNOPSIS
+
+ use SVG:SVG2zinc::Backend::TclScript;
+
+ $backend = SVG:SVG2zinc::Backend::TclScript->new(
+	       -out => filename_or_handle,
+               -in => svgfilename,
+	       -verbose => 0|1,
+	       -render => 0|1|2,
+	       );
+
+ $backend->fileHeader();
+
+ $backend->treatLines("lineOfCode1", "lineOfCode2",...);
+
+ $backend->comment("comment1", "comment2", ...);
+
+ $backend->printLines("comment1", "comment2", ...);
+
+ $backend->fileTail();
+
+=head1 DESCRIPTION
+
+SVG:SVG2zinc::Backend::TclScript is a class for generating Tcl script to display SVG files. The generated script is based on TkZinc.
+
+For more information, you should look at SVG:SVG2zinc::Backend(3pm).
+
+The new method accepts parameters described in the SVG:SVG2zinc::Backend class and the following additionnal parameters:
+
+=over
+
+=item B<-render>
+
+The render value of the TkZinc widget. 0 means no openGL, 1 or 2 for openGL. Defaults to 1.
+
+=back
+
+=head1 SEE ALSO
+
+SVG::SVG2zinc::Backend and SVG::SVG2zinc(3pm)
+
+=head1 BUGS and LIMITATIONS
+
+This is higly experimental. Only few tests... The author is not a Tcl coder!
+
+The Tk::Zinc::SVGExtension perl module provided with SVG::SVG2zinc should be converted in Tcl and imported by (or included in) the generated Tcl script.
+
+=head1 AUTHORS
+
+Christophe Mertz <mertz at intuilab dot com>
+
+=head1 COPYRIGHT
+    
+CENA (C) 2003-2004
+
+This program is free software; you can redistribute it and/or modify it under the term of the LGPL licence.
+
+=cut
+
diff --git a/src/SVG/SVG2zinc/Conversions.pm b/src/SVG/SVG2zinc/Conversions.pm
new file mode 100644
index 0000000..9a8ccb9
--- /dev/null
+++ b/src/SVG/SVG2zinc/Conversions.pm
@@ -0,0 +1,909 @@
+package SVG::SVG2zinc::Conversions;
+#	This program is free software; you can redistribute it and/or
+#	modify it under the terms of the GNU LGPL Libray General Public License
+#	as published by the Free Software Foundation; either version 2
+#	of the License, or (at your option) any later version.
+#
+#	This program is distributed in the hope that it will be useful,
+#	but WITHOUT ANY WARRANTY; without even the implied warranty of
+#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#	GNU Library General Public License for more details.
+#
+#	You should have received a copy of the GNU Library General Public License
+#	along with this program; if not, write to the Free Software
+#	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA,
+#	or refer to http://www.gnu.org/copyleft/lgpl.html
+#
+##################################################################
+
+use Math::Trig;
+use Math::Bezier::Convert;
+use strict;
+use Carp;
+
+use vars qw( $VERSION @ISA @EXPORT );
+
+($VERSION) = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/);
+
+@ISA = qw( Exporter );
+
+@EXPORT = qw( InitConv
+	      removeComment convertOpacity
+	      createNamedFont
+	      defineNamedGradient namedGradient namedGradientDef existsGradient
+	      extractGradientTypeAndStops addTransparencyToGradient 
+	      colorConvert
+	      pathPoints points
+	      cleanName
+	      float2int sizesConvert sizeConvert
+	      transform
+	      );
+
+# some variables to be initialized at the beginning
+
+my ($warnProc, $lineNumProc); # two proc
+my %fonts; # a hashtable to identify all used fonts 
+my %gradients;
+
+sub InitConv {
+    ($warnProc, $lineNumProc) = @_;
+    %fonts = ();
+    %gradients = ();
+    return 1;
+}
+
+sub myWarn{
+    &{$warnProc}(@_);
+}
+
+### remove SVG comments in the form  /* */  in $str
+### returns the string without these comments
+sub removeComment {
+    my ($str) = @_;
+#    my $strOrig = $str;
+    return "" unless defined $str;
+
+    while ($str =~ s|(.*)(/\*.*\*/){1}?|$1|) {
+#	print "begin='$str'\n";
+    }
+#    print "'$strOrig' => '$str'\n";
+    $str =~ s/^\s*// ;
+    return $str;
+}
+
+## returns an opacity value between 0 and 1
+## returns 1 if the argument is undefined
+sub convertOpacity {
+    my ($opacity) = @_;
+    $opacity = 1 unless defined $opacity;
+    $opacity = 0 if $opacity<0;
+    $opacity = 1 if $opacity>1;
+    return $opacity;
+}
+
+
+######################################################################################
+#   fontes management
+######################################################################################
+
+# the following hashtable is used to maps SVG font names to X font names
+# BUG: obvioulsy this hashtable should be defined in the system or at
+# least as a configuration file or in the SVG2zinc parser parameters
+
+my %fontsMapping = (
+	'comicsansms' => "comic sans ms",
+	'arialmt' => "arial",
+	'arial black' => "arial-bold",
+	'bleriottextmono-roman' => 'bleriot-radar',
+	'bleriottext-roman' => 'bleriot',
+	'cityd' => 'city d',
+	'cityd-medi' => 'city d',
+);
+
+my $last_key = "verdana";
+
+sub createNamedFont {
+    my ($fullFamily, $size, $weight) = @_;
+    if ($fullFamily eq "")
+    {
+    	$fullFamily = $last_key if $fullFamily eq "";
+    }
+    else
+    {
+    	$last_key = $fullFamily;
+    }
+    my $family = lc($fullFamily);
+
+    $weight = "normal" unless $weight;
+    if ( $size =~ /(.*)pt/ ) 
+    {
+		$size = -$1;
+    } 
+    elsif ( $size =~ /(.*)px/ ) 
+    {
+		$size = -$1;
+    }
+    elsif ( $size =~ /(\d*(.\d*)?)\s*$/ ) 
+    {
+		$size = -$1;
+    }
+#     $size = &float2int($size); # I round the font size, at least until we have vectorial font in Tk::Zinc
+
+	$family = $fontsMapping{$family} if defined $fontsMapping{$family};    
+    if ( $family =~ /(\w*)-bold/ ) 
+    {
+		$family = $1;
+		$weight = "bold";
+    }
+    else
+    {
+		$weight = "medium";
+    }
+
+    my $fontKey = join "_", ($family, $size, $weight);
+    if (!defined $fonts{$fontKey}) 
+    {
+		$fonts{$fontKey} = $fontKey;
+		return ($fontKey, "->fontCreate('$fontKey', -family => \"$family\", -size => $size, -weight => \"$weight\") if ! \$fonts {\"$fontKey\"};");
+    } 
+    else 
+    {
+		return ($fontKey,"");
+    }
+    
+} # end of createNamedFont
+
+######################################################################################
+#   gradients management
+######################################################################################
+# my %gradients;
+
+## Check if the new gradient does not already exists (with another name)
+## In this case, the hash is extended with an "auto-reference"
+##   $gradients{newName} = "oldName"
+## and the function returns 0
+## Otherwise, add an entry in the hastable
+##   $gradients{newName} = "newDefinition"
+## and returns 1
+sub defineNamedGradient {
+    my ($newGname, $newGradDef) = @_;
+    my $prevEqGrad;
+    $newGradDef =~ s/^\s*(.*\S)\s*$/$1/ ; # removing trailing/leading blank
+    $newGradDef =~ s/\s*\|\s*/ \| /g ;    # inserting blanks around the |
+    $newGradDef =~ s/\s\s+/ /g;  # removing multiple occurence of blanks
+#    print "CLEANED grad='$newGradDef'\n";
+    foreach my $gname (keys %gradients) {
+	if ($gradients{$gname} eq $newGradDef) {
+	    ## such a gradient already exist with another name
+	    $gradients{$newGname} = $gname;
+#	    print "GRADIENT: $newGname == $gname\n";
+
+#	    $res .= "\n###### $newGname => $gname"; ### 
+
+	    return 0;
+	}
+    }
+    ## there is no identical gradient with another name
+    ## we add the definition in the hashtable
+    $gradients{$newGname} = $newGradDef;
+    return $newGradDef;
+}
+
+## returns the name of a gradient, by following if necessary
+## "auto-references" in the hashtable
+sub namedGradient {
+    my ($gname) = @_;
+    my $def = $gradients{$gname};
+    return $gname unless defined $def; 
+    ## to avoid looping if the hashtable is buggy:
+    return $gname if !defined $gradients{$def} or $def eq $gradients{$def}; 
+    return &namedGradient($gradients{$gname});
+}
+
+## returns the definition associated to a named gradient, following if necessary
+## "auto-references" in the hashtable
+sub namedGradientDef {
+    my ($gname) = @_;
+    my $def = $gradients{$gname};
+    return "" unless defined $def; 
+    ## to avoid looping if the hashtable is buggy:
+    return $def if !defined $gradients{$def} or $def eq $gradients{$def}; 
+    return $gradients{&namedGradient($gradients{$gname})};
+}
+
+# returns 1 if the named has an associated gradient
+sub existsGradient {
+    my ($gname) = @_;
+    if (defined $gradients{$gname}) {return 1} else {return 0}; 
+}
+
+## this function returns both the radial type with its parameters AND
+## a list of stops characteristics as defined in TkZinc
+## usage: ($radialType, @stops) = &extractGradientTypeAndStops(<namedGradient>);
+## this func assumes that <namedGradient> DOES exist
+sub extractGradientTypeAndStops {
+    my ($namedGradient) = @_;
+    my $gradDef = &namedGradientDef($namedGradient);
+    my @defElements = split (/\s*\|\s*/ , $gradDef);
+    my $gradientType;
+    $gradientType = shift @defElements;
+    return ($gradientType, @defElements); 
+}
+
+## combines the opacity to every parts of a named gradient
+## if some parts of the gradients are themselves partly transparent, they are combined
+## if $opacity is 1, returns directly $gname
+## else returns a new definition of a gradient
+sub addTransparencyToGradient {
+    my ($gname,$opacity) = @_;
+    return $gname if $opacity == 100;
+    &myWarn ("ATTG: ERROR $gname\n"), return $gname if !&namedGradientDef($gname); ## this cas is certainly an error in the SVG source file!
+    my ($gradientType, @stops) = &extractGradientTypeAndStops($gname);
+
+    my @newStops;
+    foreach my $stop (@stops) {
+	my $newStop="";
+	if ($stop =~ /^([^\s;]+)\s*;\s*(\d+)\s*(\d*)\s*$/   #   red;45 50   or red;45
+	    ) {
+	    my ($color,$trans,$pos) = ($1,$2,$3);
+#	    print "$stop => '$color','$trans','$pos'\n";
+	    my $newtransp = &float2int($trans*$opacity/100);
+	    if ($pos) {
+		$newStop="$color;$newtransp $pos";
+	    } else {
+		$newStop="$color;$newtransp";
+	    }
+	} elsif ($stop =~ /^(\S+)\s+(\d+)$/) {             # red 50
+	    my ($color,$pos) = ($1,$2);
+#	    print "$stop => '$color','$pos'\n";
+	    my $newtransp = &float2int($opacity);
+	    $newStop="$color;$newtransp $pos";
+	} elsif ($stop =~ /^(\S+)$/) {
+	    my ($color) = ($1);
+#	        print "$stop => '$color'\n";
+	    my $newtransp = &float2int($opacity);
+	    $newStop="$color;$newtransp";
+	} else {
+	    &myWarn ("In addTransparencyToGradient: bad gradient Elements: '$stop'\n");
+	}
+	push @newStops, $newStop;
+    }
+    return ( $gradientType . " | " . join (" | ", @newStops));
+} # end of addTransparencyToGradient
+
+
+######################################################################################
+# color conversion
+######################################################################################
+# a hash table to define non-X SVG colors
+# THX to Lemort for bug report and correction!
+my %color2color = ('lime'    => 'green',
+		   'Lime'    => 'green',
+		   'crimson' => '#DC143C',
+		   'Crimson' => '#DC143C',
+		   'aqua'    => '#00ffff',
+		   'Aqua'    => '#00ffff',
+		   'fuschia' => '#ff00ff',
+		   'Fuschia' => '#ff00ff',
+		   'fuchsia' => '#ff00ff',
+		   'Fuchsia' => '#ff00ff',
+		   'indigo'  => '#4b0082',
+		   'Indigo'  => '#4b0082',
+		   'olive'   => '#808000',
+		   'Olive'   => '#808000',
+		   'silver'  => '#c0c0c0',
+		   'Silver'  => '#c0c0c0',
+		   'teal'    => '#008080',
+		   'Teal'    => '#008080',
+		   'green'   => '#008000',
+		   'Green'   => '#008000',
+		   'grey'    => '#808080',
+		   'Grey'    => '#808080',
+		   'gray'    => '#808080',
+		   'Gray'    => '#808080',
+		   'maroon'  => '#800000',
+		   'Maroon'  => '#800000',
+		   'purple'  => '#800080',
+		   'Purple'  => '#800080',
+		   );
+
+#### BUG: this is certainly only a partial implementation!!
+sub colorConvert {
+    my ($color) = @_;
+  
+    if ($color =~ /^\s*none/m) 
+    {
+		return ('none', 0);
+    } 
+    elsif ($color =~ /rgb\(\s*(.+)\s*\)/ ) 
+    {
+		## color like "rgb(...)"
+		my $rgbs = $1;
+		if ($rgbs =~ /([\d.]*)%\s*,\s*([\d.]*)%\s*,\s*([\d.]*)%/ ) 
+		{
+  	    	## color like "rgb(1.2% , 45%,67.%)"
+		    my ($r,$g,$b) = ($1,$2,$3);
+		    $color = sprintf ("#%02x%02x%02x",
+			      sprintf ("%.0f",2.55*$r),
+			      sprintf ("%.0f",2.55*$g),
+			      sprintf ("%.0f",2.55*$b));
+	    	return ($color, 0);
+		} 
+		elsif ($rgbs =~ /(\d*)\s*,\s*(\d*)\s*,\s*(\d*)/ ) 
+		{
+	    	## color like "rgb(255, 45,67)"
+	    	my ($r,$g,$b) = ($1,$2,$3);
+	    	$color = sprintf "#%02x%02x%02x", $r,$g,$b;
+	    	return ($color, 0);
+	    } 
+	    else 
+	    {
+	    	&myWarn ("Unknown rgb color coding: $color\n");
+		}
+    } 
+    elsif ($color =~ /^url\(\#(.+)\)/ ) 
+    {
+		## color like "url(#monGradient)"
+# 		$color = $1;
+#		my $res = &namedGradient($color);
+		return ($1, 1); #&namedGradient($1);
+    } 
+    elsif ( $color =~ /\#([0-9a-fA-F]{3}?)$/ ) 
+    {
+		## color like #fc1 => #ffcc11
+		$color =~ s/([0-9a-fA-F])/$1$1/g ;
+        # on doubling the digiys, because Tk does not do it properly
+		return ($color, 0);
+    } 
+    elsif ( $color =~ /\#([0-9a-fA-F]{6}?)$/ ) 
+    {
+	    return ($color, 0);
+    }
+    else 
+    {
+	## named colors!
+	## except those in the %color2color, all other should be defined in the
+	## standard rgb.txt file
+# 	my $converted = $color2color{lc($color)}; # THX to Lemort for bug report!
+# 	if (defined $converted) {
+# 	    return $converted;
+# 	} else {
+	    return ($color, 0);
+# 	}
+    }
+} # end of colorConvert
+
+######################################################################################
+# path points commands conversion
+######################################################################################
+
+
+# &pathPoints (\%attrs)
+# returns a boolean and a list of table references
+# - the boolean is true is the path has more than one contour or if it must be closed
+# - every table referecne pints to a table of strings, each string describing coordinates
+# possible BUG: in Tk::Zinc when a curve has more than one contour, they are all closed
+#  how is it in SVG?
+sub pathPoints {
+    my ($ref_attrs) = @_;
+    my $str = $ref_attrs->{d};
+#    print "#### In PathPoints : $str\n";
+    my ($x,$y) = (0,0); # current values
+    my $closed = 1;
+    my $atLeastOneZ=0; # true if at least one z/Z command. The curve must then be closed
+    my @fullRes;
+    my @res ;
+    my ($firstX, $firstY); # for memorizing the first point for a 'm' command after a 'z'!
+    my ($prevContrlx,$prevContrly); # useful for the s/S commande
+
+    # I use now a repetitive search on the same string, without allocating
+    # a $last string for the string end; with very long list of points, such
+    # as iceland.svg, we can gain 30% in this function and about 3s over 30s
+    while ( $str =~ m/\s*([aAmMzZvVhHlLcCsSqQtT])\s*([^aAmMzZvVhHlLcCsSqQtT]*)\s*/g ) {
+	my ($command, $args)=($1,$2);
+	&myWarn ("!!!! Ill-formed path command: '", substr($str,pos($str), 40), "...'\n") unless defined $command ;
+#	print "Command=$command args=$args x=$x y=$y\n";
+	if ($command eq "M") {   ## moveto absolute
+	    if (!$closed) {
+		## creating a new contour
+		push @fullRes, [ @res ];
+		$atLeastOneZ = 1;
+		@res = ();
+	    }
+	    my @points = &splitPoints($args);
+	    ($prevContrlx,$prevContrly) = (undef,undef);
+	    $firstX = $points[0];
+	    $firstY = $points[1];
+	    while (@points) {
+		$x = shift @points;
+		$y = shift @points;
+		push @res , "[$x, $y]";
+	    }
+	    next;
+	} elsif ($command eq "m") {  ## moveto relative
+	    if (!$closed) {
+		## creating a new contour
+		push @fullRes, [ @res ];
+		$atLeastOneZ = 1;
+		@res = ();
+	    }
+	    my @dxy = &splitPoints($args);
+	    $firstX = $x+$dxy[0];
+	    $firstY = $y+$dxy[1];
+# 	    print "m command: $args  => @dxy ,$x,$y\n";
+	    while (@dxy) {
+		## trying to minimize the number of operation
+		## to speed a bit this loop
+		$x += shift @dxy;
+		$y += shift @dxy;
+		push @res, "[$x, $y]";
+	    }
+	    next;
+	} elsif ($command eq 'z' or $command eq 'Z') {
+	    push @fullRes, [ @res ];
+	    $closed = 1;
+	    $atLeastOneZ = 1;
+	    @res = ();
+	    $x=$firstX;
+	    $y=$firstY;
+	    next;
+	}
+	# as a command will/should follow, the curve is no more closed
+	$closed = 0;
+	if ($command eq "V") {  ## vertival lineto absolute
+	    ($y) = $args =~ /(\S+)/m ;  ## XXXX what about multiple y !?
+	    push @res , "[$x, $y]";
+	} elsif ($command eq "v") {  ## vertical lineto relative
+	    my ($dy) = $args =~ /(\S+)/m ;  ## XXXX what about multiple dy !?
+	    $y += $dy;
+	    push @res , "[$x, $y]";
+	} elsif ($command eq "H") {  ## horizontal lineto absolute
+	    ($x) = $args =~ /(\S+)/m ;  ## XXXX what about multiple x !?
+	    push @res , "[$x, $y]";
+	} elsif ($command eq "h") {  ## horizontal lineto relative
+	    my ($dx) = $args =~ /(\S+)/m ;  ## XXXX what about multiple dx !?
+	    $x += $dx;
+	    push @res , "[$x, $y]";
+	} elsif ($command eq "L") {  ## lineto absolute
+	    my @points = &splitPoints($args);
+	    while (@points) {
+		$x = shift @points;
+		$y = shift @points;
+		push @res , "[$x, $y]";
+	    }
+	} elsif ($command eq "l") {  ## lineto relative
+	    ### thioscommand can have more than one point as arguments
+	    my @points = &splitPoints($args);
+	    # for (my $i = 0; $i < $#points; $i+=2)
+	    # is not quicker than the following while
+  	    while (@points) {
+		## trying to minimize the number of operation
+		## to speed a bit this loop
+  		$x += shift @points;
+  		$y += shift @points;
+  		push @res , "[$x, $y]";
+  	    }
+	} elsif ($command eq "C" or $command eq "c") {  ## cubic bezier
+	    &myWarn ("$command command in a path must not be the first one") ,last
+		if (scalar @res < 1);
+	    my @points = &splitPoints($args);
+	    while (@points) {
+		&myWarn ("$command command must have 6 coordinates x N times") ,last
+		    if (scalar @points < 6);
+		my $x1 = shift @points;
+		my $y1 = shift @points;
+		$prevContrlx = shift @points;
+		$prevContrly = shift @points;
+		my $xf = shift @points;
+		my $yf = shift @points;
+		if ($command eq "c") { $x1+=$x; $y1+=$y; $prevContrlx+=$x; $prevContrly+=$y; $xf+=$x; $yf+=$y}
+		push @res, ( "[$x1, $y1, 'c'], [$prevContrlx, $prevContrly, 'c'], [$xf, $yf]");
+		$x=$xf;
+		$y=$yf;
+	    }
+	} elsif ($command eq "S" or $command eq "s") {  ## cubic bezier with opposite last control point
+	    &myWarn ("$command command in a path must not be the first one") ,last
+		if (scalar @res < 1);
+#	    print "$command command : $args\n";
+	    my @points = &splitPoints($args);
+	    if ($command eq "s") {
+		for (my $i=0; $i <= $#points; $i += 2) {
+		    $points[$i] += $x;
+		}
+		for (my $i=1; $i <= $#points; $i += 2) {
+		    $points[$i] += $y;
+		}
+	    }
+	    while (@points) {
+		&myWarn ("$command command must have 4 coordinates x N times; skipping @points") ,last
+		    if (scalar @points < 4);
+		my $x1 = (defined $prevContrlx) ? $prevContrlx : $x;
+		$x1 = 2*$x-$x1;
+		my $y1 = (defined $prevContrly) ? $prevContrly : $y;
+		$y1 = 2*$y-$y1;
+		$prevContrlx = shift @points;
+		$prevContrly = shift @points;
+		$x = shift @points;
+		$y = shift @points;
+		push @res, ( "[$x1, $y1, 'c'], [$prevContrlx, $prevContrly, 'c'], [$x, $y]");
+	    }
+
+
+	} elsif ($command eq "Q" or $command eq "q") {  ## quadratic bezier
+	    &myWarn ("$command command in a path must not be the first one") ,last
+		if (scalar @res < 1);
+	    my @points = &splitPoints($args);
+	    if ($command eq "q") {
+		for (my $i=0; $i <= $#points; $i += 2) {
+		    $points[$i] += $x;
+		}
+		for (my $i=1; $i <= $#points; $i += 2) {
+		    $points[$i] += $y;
+		}
+	    }
+	    while (@points) {
+		&myWarn ("$command command must have 4 coordinates x N times") ,last
+		    if (scalar @points < 4);
+		$prevContrlx = shift @points;
+		$prevContrly = shift @points;
+		
+		my $last_x = $x;
+		my $last_y = $y;
+
+		$x = shift @points;
+		$y = shift @points;
+
+		# the following code has been provided by Lemort@intuilab.com
+		my @coordsToConvert = ($last_x,$last_y, $prevContrlx, $prevContrly,$x,$y);
+		my @convertCoords = Math::Bezier::Convert::quadratic_to_cubic(@coordsToConvert);
+		# removing the first point, already present
+		splice(@convertCoords, 0, 2);
+		
+		while (@convertCoords) {
+		    my ($ctrl1_x, $ctrl1_y) = splice(@convertCoords, 0, 2);
+		    my ($ctrl2_x, $ctrl2_y) = splice(@convertCoords, 0, 2);
+		    my ($pt_x, $pt_y) = splice(@convertCoords, 0, 2);
+
+		    push @res, ("[$ctrl1_x, $ctrl1_y, 'c'], [$ctrl2_x, $ctrl2_y, 'c'], [$pt_x, $pt_y]");
+		}
+
+	    }
+
+	} elsif ($command eq "T" or $command eq "t") {  ## quadratic bezier with opposite last control point?!
+	    &myWarn ("$command command in a path must not be the first one") ,last
+		if (scalar @res < 1);
+	    my @points = &splitPoints($args);
+
+	    if ($command eq "t") {
+		for (my $i=0; $i <= $#points; $i += 2) {
+		    $points[$i] += $x;
+		}
+		for (my $i=1; $i <= $#points; $i += 2) {
+		    $points[$i] += $y;
+		}
+	    }
+	    while (@points) {
+		&myWarn ("$command command must have 2 coordinates x N times") ,last
+		    if (scalar @points < 2);
+		my $x1 = (defined $prevContrlx) ? $prevContrlx : $x;
+		$prevContrlx = 2*$x-$x1;
+		my $y1 = (defined $prevContrly) ? $prevContrly : $y;
+		$prevContrly = 2*$y-$y1;
+		
+		my $last_x = $x;
+		my $last_y = $y;
+
+		$x = shift @points;
+		$y = shift @points;
+
+		# the following code has been provided by Lemort@intuilab.com
+		my @coordsToConvert = ($last_x,$last_y, $prevContrlx, $prevContrly,$x,$y);
+		my @convertCoords = Math::Bezier::Convert::quadratic_to_cubic(@coordsToConvert);
+		# removing the first point, already present
+		splice(@convertCoords, 0, 2);
+		
+		while (@convertCoords) {
+		    my ($ctrl1_x, $ctrl1_y) = splice(@convertCoords, 0, 2);
+		    my ($ctrl2_x, $ctrl2_y) = splice(@convertCoords, 0, 2);
+		    my ($pt_x, $pt_y) = splice(@convertCoords, 0, 2);
+
+		    push @res, ("[$ctrl1_x, $ctrl1_y, 'c'], [$ctrl2_x, $ctrl2_y, 'c'], [$pt_x, $pt_y]");
+		}
+
+	    }
+	} elsif ($command eq 'a' or $command eq 'A') {
+	    my @points = &splitPoints($args);
+	    while (@points) {
+		&myWarn ("bad $command command parameters: @points\n") if (scalar @points < 7);
+#	    print "($x,$y) $command command: @points\n";
+		if ($command eq 'a') {
+		    $points[5] += $x;
+		    $points[6] += $y;
+		}
+#	    print "($x,$y) $command command: @points\n";
+		my @coords = &arcPathCommand ( $x,$y, @points[0..6] );
+		push @res, @coords;
+		$x = $points[5];
+		$y = $points[6];
+		last if (scalar @points == 7);
+		@points = @points[7..$#points]; ### XXX ? tester!
+	    }
+	} else {
+	    &myWarn ("!!! bad path command: $command\n");
+	}
+    }
+    if (@res) {
+	return ( $atLeastOneZ, [@res], @fullRes);
+    } else { return ( $atLeastOneZ, @fullRes) }
+} # end of pathPoints
+
+
+
+
+# this function can be called many many times; so it has been "optimized"
+# even if a bit less readable
+sub splitPoints {
+    $_ = shift;
+    ### adding a space before every dash (-) when the dash preceeds by a digit
+    s/(\d)-/$1 -/g;
+    ### adding a space before ? dot (.) when more than one real are not separated;
+    ### e.g.:  '2.3.45.6.' becomes '2.3 .45 .5'
+    while ( scalar s/\.(\d+)\.(\d+)/\.$1 \.$2/) {
+    }
+    return  split ( /[\s,]+/ );
+}
+
+
+
+sub arcPathCommand {
+    my ($x1,$y1, $rx,$ry, $x_rot, $large_arc_flag,$sweep_flag, $x2,$y2) = @_;
+    return ($x2,$y2) if ($rx == 0 and $ry == 0);
+    $rx = -$rx if $rx < 0;
+    $ry = -$ry if $ry < 0;
+
+    # computing the center
+    my $phi = deg2rad($x_rot);
+
+    # compute x1' and y1' (formula F.6.5.1)
+    my $deltaX = ($x1-$x2)/2;
+    my $deltaY = ($y1-$y2)/2;
+    my $xp1 =  cos($phi)*$deltaX + sin($phi)*$deltaY;
+    my $yp1 = -sin($phi)*$deltaX + cos($phi)*$deltaY;
+#    print "xp1,yp1= $xp1 , $yp1\n";
+
+    # the radius_check has been suggested by lemort@intuilab.com
+    # checking that radius are correct
+    my $radius_check = ($xp1/$rx)**2 + ($yp1/$ry)**2;
+    
+    if ($radius_check > 1) {
+        $rx *= sqrt($radius_check);
+        $ry *= sqrt($radius_check);
+    }
+
+    # compute the sign:  (formula F.6.5.2)
+    my $sign = 1;
+    $sign = -1 if $large_arc_flag eq $sweep_flag;
+    # compute the big square root  (formula F.6.5.2)
+#    print "denominator: ", ( ($rx*$ry)**2 - ($rx*$yp1)**2 - ($ry*$xp1)**2 ),"\n";
+    my $bigsqroot = (
+		     abs( ($rx*$ry)**2 - ($rx*$yp1)**2 - ($ry*$xp1)**2 ) ### ABS ?!?!
+		     /
+		     ( ($rx*$yp1)**2 + ($ry*$xp1)**2 )
+		     );
+    # computing c'x and c'y  (formula F.6.5.2) 
+    $bigsqroot = $sign * sqrt ($bigsqroot);
+    my $cpx = $bigsqroot * ($rx*$yp1/$ry);
+    my $cpy = $bigsqroot * (- $ry*$xp1/$rx);
+
+    # compute cx and cy  (formula F.6.5.3)
+    my $middleX = ($x1+$x2)/2;
+    my $middleY = ($y1+$y2)/2;
+    my $cx = cos($phi)*$cpx - sin($phi)*$cpy + $middleX;
+    my $cy = sin($phi)*$cpx + cos($phi)*$cpy + $middleY;
+
+    # computing theta1   (formula F.6.5.5)
+    my $XX = ($xp1-$cpx)/$rx;
+    my $YY = ($yp1-$cpy)/$ry;
+    my $theta1 = rad2deg (&vectorProduct ( 1,0, $XX,$YY));
+    # computing dTheta (formula F.6.5.6)
+    my $dTheta = rad2deg (&vectorProduct ( $XX,$YY, (-$xp1-$cpx)/$rx,(-$yp1-$cpy)/$ry ));
+
+        if (!$sweep_flag and $dTheta>0) {
+	$dTheta-=360;
+    }
+    if ($sweep_flag and $dTheta<0) {
+	$dTheta+=360;
+    }
+    return  join (",", &computeArcPoints($cx,$cy,$rx,$ry,
+				       $phi,deg2rad($theta1),deg2rad($dTheta))), "\n";
+}
+
+sub computeArcPoints {
+	my ($cx,$cy,$rx,$ry,$phi,$theta1,$dTheta) = @_;
+	my $Nrad = 3.14/18;
+	my $N = &float2int(abs($dTheta/$Nrad));
+	my $cosPhi = cos($phi);
+	my $sinPhi = sin($phi);
+	my $dd = $dTheta/$N;
+	my @res;
+	for (my $i=0; $i<=$N; $i++) 
+	{
+		my $a = $theta1 + $dd*$i;
+		my $xp = $rx*cos($a);
+		my $yp = $ry*sin($a);
+		my $x1 = $cosPhi*$xp - $sinPhi*$yp + $cx;
+		my $y1 = $sinPhi*$xp + $cosPhi*$yp + $cy;
+		push @res, "[$x1, $y1]";
+	}
+	return @res;
+}
+
+## vectorial product
+sub vectorProduct {
+    my ($x1,$y1, $x2,$y2) = @_;
+    my $sign = 1;
+    $sign = -1 if ($x1*$y2 - $y1*$x2) < 0;
+
+    return $sign * acos ( ($x1*$x2 + $y1*$y2)
+			  /
+			  sqrt ( ($x1**2 + $y1**2) * ($x2**2 + $y2**2) )
+			  );
+}
+
+######################################################################################
+# points conversions for polygone / polyline
+######################################################################################
+
+# &points (\%attrs)
+# converts the string, value of an attribute points
+# to a string of coordinate list for Tk::Zinc
+sub points {
+    my ($ref_attrs) = @_;
+    my $str = $ref_attrs->{points};
+    # suppressing leading and trailing blanks:
+    ($str) = $str =~ /^\s*   # leading blanks
+                      (.*\S) # 
+		      \s*$   # trailing blanks
+		     /x;
+
+    $str =~ s/([^,])[\s]+([^,])/$1,$2/g ;  # replacing blanks separators by a comma
+    return $str;
+}
+
+######################################################################################
+# cleaning an id to make it usable as a TkZinc Tag
+######################################################################################
+
+## the following function cleans an id, ie modifies it so that it
+## follows the TkZinc tag conventions.
+## BUG: the cleanning is far from being complete
+sub cleanName {
+    my $id = shift;
+     # to avoid numeric ids
+    if ($id =~ /^\d+$/) {
+#	&myWarn ("id: $id start with digits\n");
+	$id = "id_".$id;
+    }
+    # to avoid any dots in a tag
+    if ($id =~ /\./) {
+#	&myWarn ("id: $id contains dots\n");
+	$id =~ s/\./_/g ;
+    }
+    return $id;
+}
+
+################################################################################
+# size conversions
+################################################################################
+
+## get a list of "size" attributes as listed in @attrs (e.g.: x y width height...)
+## - convert all in pixel
+## - return 0 for attributes listed in @attrs and not available in %{$ref_attrs}
+sub sizesConvert {
+    my ($ref_attrs,@attrs) = @_;
+    my %attrs = %{$ref_attrs};
+    my @res;
+    foreach my $attr (@attrs) 
+    {
+		my $value;
+		if (!defined ($value = $attrs{$attr}) ) 
+		{
+			if ($attr eq 'x2')
+			{
+				push (@res, 1);
+			}
+			else
+			{
+		    		push (@res, 0);
+			}
+		} 
+		else 
+		{
+		    push @res,&sizeConvert ($value);
+		}
+    }
+    return @res;
+} # end of sizesConvert
+
+# currently, to simplify this code, I suppose the screen is 100dpi!
+# at least the generated code is currently independant from the host
+# where is is supposed to run
+# maybe this should be enhanced
+sub sizeConvert {
+    my ($value) = @_;
+    if ($value =~ /(.*)cm/) {
+	return $1 * 40;   ## approximative pixel / cm
+    } elsif ($value =~ /(.*)mm/) {
+	return $1 * 4;   ## approximative pixel / mm
+    } elsif ($value =~ /(.*)px/) {
+	return $1;   ## exact! pixel / pixel
+    } elsif ($value =~ /(.*)in/) {
+	return &float2int($1 * 100);   ## approximative pixel / inch
+    } elsif ($value =~ /(.*)pt/) {
+	return &float2int($1 * 100 / 72);   ## approximative pixel / pt  (a pt = 1in/72)
+    } elsif ($value =~ /(.*)pc/) {
+	return &float2int($1 * 100 / 6);   ##   (a pica = 1in/6)
+    } elsif ($value =~ /(.*)%/) {
+	return $1/100;   ## useful for coordinates using % 
+	                 ## in lienar gradient (x1,x2,y2,y2)
+    } elsif ($value =~ /(.*)em/) { # not yet implemented
+	&myWarn ("em unit not yet implemented in sizes");
+	return $value;
+    } elsif ($value =~ /(.*)ex/) { # not yet implemented
+	&myWarn ("ex unit not yet implemented in sizes");
+	return $value;
+    } else {
+	return $value;
+    }
+} # end of sizeConvert
+
+
+sub float2int {
+    return sprintf ("%.0f",$_[0]);
+}
+
+
+# process a string describing transformations
+# returns a list of string describing transformations
+# to be applied to Tk::Zinc item Id
+sub transform {
+    my ($id, $str) = @_;
+    return () if !defined $str;
+    &myWarn ("!!! Need an Id for applying a transformation\n"), return () if !defined $id;
+    my @fullTrans;
+    while ($str  =~ m/\s*(\w+)\s*\(([^\)]*)\)\s*/g) {
+	my ($trans, $params) = ($1,$2);
+	my @params = split (/[\s,]+/, $params);
+	if ($trans eq 'translate') {
+	    $params[1] = 0 if scalar @params == 1; ## the 2nd paramter defaults to 0
+	    my $translation = "-> translate ($id," . join (",",@params) . ");"  ;
+	    push @fullTrans, $translation;
+	} elsif ($trans eq 'rotate') {
+	    $params[0] = deg2rad($params[0]);
+	    my $rotation = "-> rotate ($id," . join (",",@params) . ");";
+	    push @fullTrans, $rotation;
+	} elsif ($trans eq 'scale') {
+	    $params[1] = $params[0] if scalar @params == 1; ## the 2nd scale parameter defaults to the 1st
+	    my $scale = "-> scale ($id," . join (",",@params) . ");";
+	    push @fullTrans,$scale;
+	} elsif ($trans eq 'matrix') {
+	    my $matrixParams = join ',',@params;
+	    my $matrix = "-> tset ($id, $matrixParams);";
+	    push @fullTrans, $matrix;
+	} elsif ($trans eq 'skewX'){
+	    my $skewX = "-> skew ($id, " . deg2rad($params[0]) . ",0);";
+#	    print "skewX=$skewX\n";
+	    push @fullTrans, $skewX;
+	} elsif ($trans eq 'skewY'){
+	    my $skewY = "-> skew ($id, 0," . deg2rad($params[0]) . ");";
+#	    print "skewY=$skewY\n";
+	    push @fullTrans, $skewY;
+	} else {
+	    &myWarn ("!!! Unknown transformation '$trans'\n");
+	}
+#	$str = $rest;
+    }
+    return reverse @fullTrans;
+} # end of transform
+
+1;