aboutsummaryrefslogtreecommitdiff
path: root/src/SVG/SVG2zinc/Backend
diff options
context:
space:
mode:
Diffstat (limited to 'src/SVG/SVG2zinc/Backend')
-rw-r--r--src/SVG/SVG2zinc/Backend/Display.pm.k257
-rw-r--r--src/SVG/SVG2zinc/Backend/Image.pm.k201
-rw-r--r--src/SVG/SVG2zinc/Backend/PerlClass.pm203
-rw-r--r--src/SVG/SVG2zinc/Backend/PerlScript.pm.k275
-rw-r--r--src/SVG/SVG2zinc/Backend/Print.pm.k61
-rw-r--r--src/SVG/SVG2zinc/Backend/Tcl.pm.k96
-rw-r--r--src/SVG/SVG2zinc/Backend/TclScript.pm.k275
7 files changed, 1368 insertions, 0 deletions
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
+
generated by cgit v1.1 at 2024-09-21 08:34:48 +0000