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'."$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;