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/TclScript.pm.k | 275 ++++++++++++++++++++++++++++++++ 1 file changed, 275 insertions(+) create mode 100644 src/SVG/SVG2zinc/Backend/TclScript.pm.k (limited to 'src/SVG/SVG2zinc/Backend/TclScript.pm.k') 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 +# +# 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( +<
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 "press motion %x %y" +bind $w.zinc release +bind $w.zinc "press zoom %x %y" +bind $w.zinc release +bind $w.zinc "press mouseRotate %x %y" +bind $w.zinc 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 "$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 {} +} +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 + +=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 + -- cgit v1.1