aboutsummaryrefslogtreecommitdiff
path: root/src/SVG/SVG2zinc/Backend/PerlScript.pm.k
diff options
context:
space:
mode:
Diffstat (limited to 'src/SVG/SVG2zinc/Backend/PerlScript.pm.k')
-rw-r--r--src/SVG/SVG2zinc/Backend/PerlScript.pm.k275
1 files changed, 275 insertions, 0 deletions
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
+
generated by cgit v1.1 at 2024-11-10 22:57:39 +0000