package SVG::SVG2zinc::Backend::PerlScript;

#	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,v 1.16 2004/05/01 09:19:34 mertz 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.16 $ =~ /(\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