From c5866f304210618979d03c561b1e3f6f83200bce Mon Sep 17 00:00:00 2001 From: ribet Date: Wed, 21 Mar 2007 10:19:39 +0000 Subject: Import initial --- src/SVG/SVG2zinc/Backend/PerlClass.pm | 203 ++++++++++++++++++++++++++++++++++ 1 file changed, 203 insertions(+) create mode 100644 src/SVG/SVG2zinc/Backend/PerlClass.pm (limited to 'src/SVG/SVG2zinc/Backend/PerlClass.pm') 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 +# +# 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; + -- cgit v1.1