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'."$name".', $y1'."$name".', $x2'."$name".', $y2'."$name".') = $_zinc -> bbox ($previous);'; # push (@lignes, 'my ($parent) = $_zinc -> find(\'ancestors\', $previous);'); push (@lignes, '($x1'."$name".', $y1'."$name".', $x2'."$name".', $y2'."$name".') = $_zinc -> transform(\'device\', $parent, [$x1'."$name".'+1, $y1'."$name".'+1, $x2'."$name".'-2, $y2'."$name".'-2]);'); push (@lignes, "my \$grad"."$name"." = 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"."$name".", \$y1"."$name".", \$x2"."$name".", \$y2"."$name"); push (@lignes, ");"); push (@lignes, "mconfigure (\$previous, $prop => \$grad"."$name".");"); $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; $l =~ s/HASHKEY{\'(.*?)\'}/\$self -> {children} -> {$1} = /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; $l =~ s/HASHKEY{\'(.*?)\'}/\$self -> {children} -> {\'$1\'} = /g; } if (@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::GUI::MGroup; use vars qw /@ISA @EXPORT @EXPORT_OK/; use Tk::PNG; use Tk::JPEG; BEGIN { @ISA = qw /MTools::GUI::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}}, 'my $ascent = undef;'."\n".'$self -> {instance} = $previous = '); $self -> printLines(@{$self -> {delayed_lines}}); $self -> printLines( <<'TAIL' return $self; } 1; TAIL ); $self->close; } 1;