Import initial

1 files changed, 203 insertions, 0 deletions

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;
+