#!/usr/bin/perl
# $Id: svg2swf,v 1.6 2001/07/11 06:48:27 robla Exp $
# Derived from simple_appl.py 0.3 1999/01/19 20:42:17 simon
#
# Copyright (C) 2001 Mark A. Hershberger (mah@everybody.org)
#                    http://mah.everybody.org/
#
#    This library is free software; you can redistribute it and/or
#    modify it under the terms of the GNU Lesser General Public
#    License as published by the Free Software Foundation; either
#    version 2.1 of the License, or (at your option) any later version.
#
#    This library 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
#    Lesser General Public License for more details.
#
#    You should have received a copy of the GNU Lesser General Public
#    License along with this library; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#

our $DEBUG = 0;
$| = 1;

use strict;

package XML::SVG;

use XML::SAX2Perl;

use constant csscolors => 
  ( "black" => 0x000000,
    "silver" => 0xc0c0c0,
    "gray" => 0x808080,
    "white" => 0xFFFFFF,
    "maroon" => 0x800000,
    "red" => 0xFF0000,
    "purple" => 0x800080,
    "fuchsia" => 0xFF00FF,
    "green" => 0x008000,
    "lime" => 0x00FF00,
    "olive" => 0x808000,
    "yellow" => 0xFFFF00,
    "navy" => 0x000080,
    "blue" => 0x0000FF,
    "teal" => 0x008080,
    "aqua" => 0x00FFFF);

sub new  { print "new ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = {};

  $self->{data} = "";
  bless $self, $class;
}

sub handle  { print "handle ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my $self = shift;
  my $data = shift;

  $self->{data} .= $data;
}

sub parsepaint  { print "parsepaint ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my $paint = shift;
  my $colornum;

  if (exists csscolors->{$paint}) {;
    $colornum = csscolors->{$paint};
  } elsif ($paint =~ /;#([\dA-Fa-f][\dA-Fa-f][\dA-Fa-f][\dA-Fa-f][\dA-Fa-f][\dA-Fa-f])/) {
    $colornum = $1;
  } else {
    $colornum = $paint;
  }
  return [$colornum / 0x10000, ($colornum / 0x100), 0x100, $colornum, 0x100];
}

package XML::SVG::Null;

use base qw(XML::SVG);

sub handle  { print "handle ", join(", ", @_) ,"\n" if $DEBUG & 1;};

package XML::SVG::Text;

use base qw(XML::SVG);

package XML::SVG::G;

use base qw(XML::SVG);

package XML::SVG::toSWF;

use SWF;
use constant pi => 4 * atan2 1, 1;

our $AUTOLOAD;

sub AUTOLOAD {
  my $self = shift;
  my $method;

  return if $AUTOLOAD =~ /DESTROY/;
  for ($AUTOLOAD) { s/XML::SVG::toSWF/SWF::Shape/; }
print "$AUTOLOAD\n" if $DEBUG & 2;
print STDERR ref($self->{this}), " $AUTOLOAD(", join(", ", @_), ");\n" if $DEBUG & 4;
  return $self->{this}->$AUTOLOAD(@_);
}

sub new  { print "new ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = {};

  $self->{this} = SWF::Shape->new;
  $self->{cpx}  = 0;
  $self->{cpy}  = 0;
  $self->{origx} = 0;
  $self->{origy} = 0;

  bless $self, $class;
};

sub movePenTo  { print "movePenTo ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $x, $y) = @_;

  $self->{this}->movePenTo($x,$y);
print STDERR ref($self->{this}), " movePenTo($x, $y);\n" if $DEBUG & 4;
  $self->{cpx} = $x;
  $self->{cpy} = $y;

  $self;
};

sub movePen  { print "movePen ", join(", ", @_) ,"\n" if $DEBUG & 1;;
  my ($self,$x,$y) = @_;

  $self->{this}->movePen($x,$y);
print STDERR ref($self->{this}), " movePen($x, $y);\n" if $DEBUG & 4;
  $self->{cpx} += $x;
  $self->{cpy} += $y;

  $self;
};

sub drawLineTo  { print "drawLineTo ", join(", ", @_) ,"\n" if $DEBUG & 1;;
  my ($self,$x,$y) = @_;

  $self->{this}->drawLineTo($x,$y);
print STDERR ref($self->{this}), " drawLineTo($x, $y);\n" if $DEBUG & 4;
  $self->{cpx} = $x;
  $self->{cpy} = $y;

  $self;
};

sub drawLine  { print "drawLine ", join(", ", @_) ,"\n" if $DEBUG & 1;;
  my ($self,$x,$y) = @_;

  $self->{this}->drawLine($x,$y);
print STDERR ref($self->{this}), " drawLine($x, $y);\n" if $DEBUG & 4;
  $self->{cpx} += $x;
  $self->{cpy} += $y;

  $self;
};

sub drawCurveTo  { print "drawCurveTo ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $bx, $by, $cx, $cy, $dx, $dy) = @_;

  #self.this.drawLineTo(cx,cy)
  my $cpx = $self->{cpx};
  my $cpy = $self->{cpy};

        #XXX: Possible bug in ming: should I need to check
        #whether cpx==bx and cpy==by, or whether cx==dx and
        #cy==dy?  It won't work without these checks

  if($cpx == $bx and $cpy == $by){
    $self->{this}->drawCurveTo($cx,$cy,$dx,$dy);
    $self->{cpx} = $dx;
    $self->{cpy} = $dy;
  } elsif (($cx == $dx and $cy == $dy) or (!defined $dx and !defined $dy)) {
    $self->{this}->drawCurveTo($bx,$by,$cx,$cy);
    $self->{cpx} = $cx;
    $self->{cpy} = $cy;
  } elsif($by == $dy and $cy == $dy and $cpy == $dy) {
    $self->{this}->drawLineTo($dx, $dy);
    $self->{cpx} = $dx;
    $self->{cpy} = $dy;
  } else {;
    $self->{this}->drawCubicTo($bx,$by,$cx,$cy, $dx,$dy);
    $self->{cpx} = $dx;
    $self->{cpy} = $dy;
  };

  $self;
};


sub drawCurve  { print "drawCurve ", join(", ", @_) ,"\n" if $DEBUG & 1;;
  my ($self, $bx, $by, $cx, $cy, $dx, $dy) = @_;
  my $cpx = $self->{cpx};
  my $cpy = $self->{cpy};

  if(!defined $dx and !defined $dy){;
    $self->drawCurveTo($cpx+$bx,$cpy+$by,$cpx+$cx,$cpy+$cy);
  } else {;
    $self->drawCurveTo($cpx+$bx,$cpy+$by,$cpx+$cx,$cpy+$cy,$cpx+$dx,$cpy+$dy);
  };

  $self;
};


sub drawCircle  { print "drawCircle ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $r) = @_;

  use constant sqrt2 => sqrt(2);

  #  This needs to be replaced by a fixed version of drawCircle in ming

  my $x = $self->{cpx};
  my $y = $self->{cpy};
  my $x1 = $x - $r/sqrt2;
  my $x2 = $x + $r/sqrt2;
  my $y1 = $y - $r/sqrt2;
  my $y2 = $y + $r/sqrt2;

  $self->movePenTo($x-$r,$y);
  $self->path_arc($r,$r,0,0,1,$x1,$y1);
  $self->path_arc($r,$r,0,0,1,$x,$y-$r);
  $self->path_arc($r,$r,0,0,1,$x2,$y1);
  $self->path_arc($r,$r,0,0,1,$x+$r,$y);
  $self->path_arc($r,$r,0,0,1,$x2,$y2);
  $self->path_arc($r,$r,0,0,1,$x,$y+$r);
  $self->path_arc($r,$r,0,0,1,$x1,$y2);
  $self->path_arc($r,$r,0,0,1,$x-$r,$y);
  $self->{this}->movePenTo($x,$y);
print STDERR "notyet\n";
  $self->{cpx} = $x;
  $self->{cpy} = $y;

    #  pulled from librsvg/rsvg-path.c (Raph Levien <raph@acm.org>)
};

sub path_arc_segment  { print "path_arc_segment ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $xc, $yc, $th0, $th1, $rx, $ry, $x_axis_rotation) = @_;
        # local variables
        # sin_th, cos_th
        # a00, a01, a10, a11
        # x1, y1, x2, y2, x3, y3
        # t
        # th_half

  my $sin_th = sin ($x_axis_rotation * (pi / 180.0));
  my $cos_th = cos ($x_axis_rotation * (pi / 180.0)) ;
  # inverse transform compared with rsvg_path_arc
  my $a00 = $cos_th * $rx;
  my $a01 = -$sin_th * $ry;
  my $a10 = $sin_th * $rx;
  my $a11 = $cos_th * $ry;

  my $th_half = 0.5 * ($th1 - $th0);
  my $t = (8.0 / 3.0) * sin ($th_half * 0.5) 
    * sin ($th_half * 0.5) / sin ($th_half);
  my $x1 = $xc + cos ($th0) - $t * sin ($th0);
  my $y1 = $yc + sin ($th0) + $t * cos ($th0);
  my $x3 = $xc + cos ($th1);
  my $y3 = $yc + sin ($th1);
  my $x2 = $x3 + $t * sin ($th1);
  my $y2 = $y3 - $t * cos ($th1);
  $self->drawCurveTo ($a00 * $x1 + $a01 * $y1, $a10 * $x1 + $a11 * $y1,
		      $a00 * $x2 + $a01 * $y2, $a10 * $x2 + $a11 * $y2,
		      $a00 * $x3 + $a01 * $y3, $a10 * $x3 + $a11 * $y3);


    #  pulled from librsvg/rsvg-path.c (Raph Levien <raph@acm.org>)

    # path_arc: Add an elliptical arc to the swfshape
    # @ctx: Path context.
    # @rx: Radius in x direction (before rotation).
    # @ry: Radius in y direction (before rotation).
    # @x_axis_rotation: Rotation angle for axes.
    # @large_arc_flag: 0 for arc length <= 180, 1 for arc >= 180.
    # @sweep: 0 for "negative angle", 1 for "positive angle".
    # @x: New x coordinate.
    # @y: New y coordinate.


}

sub path_arc   { print "path_arc  ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $rx, $ry, $x_axis_rotation, $large_arc_flag, $sweep_flag, $x, $y) = @_;

  # local variables
  # sin_th, cos_th
  # a00, a01, a10, a11
  # x0, y0, x1, y1, xc, yc
  # d, sfactor, sfactor_sq
  # th0, th1, th_arc
  #  int i, n_segs

  my $distance = sqrt(($x-$self->{cpx})**2 + ($y-$self->{cpy})**2);

  if (($rx==0 or $ry==0)) {
    return;
    # ensure arc as defined can reach destination
    # FIXME: this method only really works when rx==ry
    if(max($rx,$ry)*2<$distance){
      $rx=$distance/2;
      $ry=$rx;
    }
    my $sin_th = sin ($x_axis_rotation * (pi / 180.0));
    my $cos_th = cos ($x_axis_rotation * (pi / 180.0));
    my $a00 = $cos_th / $rx;
    my $a01 = $sin_th / $rx;
    my $a10 = -$sin_th / $ry;
    my $a11 = $cos_th / $ry;
    my $x0 = $a00 * $self->{cpx} + $a01 * $self->{cpy};
    my $y0 = $a10 * $self->{cpx} + $a11 * $self->{cpy};
    my $x1 = $a00 * $x + $a01 * $y;
    my $y1 = $a10 * $x + $a11 * $y;
    # (x0, y0) is current point in transformed coordinate space.
    # (x1, y1) is new point in transformed coordinate space.
    #
    # The arc fits a unit-radius circle in this space.
    my $d = ($x1 - $x0) * ($x1 - $x0) + ($y1 - $y0) * ($y1 - $y0);
    my $sfactor_sq = 1.0 / $d - 0.25;
    if ( ($sfactor_sq < 0)) {
      $sfactor_sq = 0;
      my $sfactor = sqrt ($sfactor_sq);
      if ( ($sweep_flag == $large_arc_flag)) {
	$sfactor = -$sfactor;
        my $xc = 0.5 * ($x0 + $x1) - $sfactor * ($y1 - $y0);
        my $yc = 0.5 * ($y0 + $y1) + $sfactor * ($x1 - $x0);
        # (xc, yc) is center of the circle.

        my $th0 = atan2 ($y0 - $yc, $x0 - $xc);
        my $th1 = atan2 ($y1 - $yc, $x1 - $xc);

        my $th_arc = $th1 - $th0;
        if ( ($th_arc < 0 and $sweep_flag)) {
	  $th_arc = $th_arc + 2 * pi;
	} elsif ( ($th_arc > 0 and not $sweep_flag)) {
	  $th_arc = $th_arc - 2 * pi;
	}
        my $n_segs = ceil (fabs ($th_arc / (pi * 0.5 + 0.001)));

        for my $i (1..$n_segs) {
	  $self->path_arc_segment($xc, $yc,
                                  $th0 + $i * $th_arc / $n_segs,
                                  $th0 + ($i + 1) * $th_arc / $n_segs,
                                  $rx, $ry, $x_axis_rotation);

	  $self->{cpx} = $x;
	  $self->{cpy} = $y;

	}
      }
    }
  }
}

sub setfillandstroke  { print "setfillandstroke ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $stylemap) = @_;

  if (exists $stylemap->{'fill'}) {
    my $fill_color = parsepaint($stylemap->{'fill'});

    if ( ($fill_color != 'none')) {
      $self->setRightFill($self->addFill(@$fill_color));
    }
  }
  if ((exists $stylemap->{'stroke'})) {
    my $stroke_color = parsepaint($stylemap->{'stroke'});
    if ( ($stroke_color == 'none')) {
      $self->setLine(0, 0, 0, 0, 0);
    } elsif ((exists $stylemap->{'stroke-width'})) {
      $self->setLine(($stylemap->{'stroke-width'}), @$stroke_color);
    } else {
      $self->setLine(1, @$stroke_color);
    }
  }
  return;
}

sub resetorig  { print "resetorig ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = @_;

  $self->{origx} = $self->{cpx};
  $self->{origy} = $self->{cpy};
}

sub closepath  { print "closepath ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $stylemap, $returntosender) = @_;

  my $cpx=$self->{cpx};
  my $cpy=$self->{cpy};

  $self->setLine(0,0,0,0,0)
    if($returntosender);
  $self->drawLineTo($self->{origx}, $self->{origy});
  $self->setfillandstroke($stylemap);
  $self->movePenTo($cpx,$cpy)
    if($returntosender);

  return;
}

package SVG2SWF;

use SWF;
use File::Basename;

our $AUTOLOAD;

sub AUTOLOAD {
  my $self = shift;
  my $method;

  return if $AUTOLOAD =~ /DESTROY/;
  for ($AUTOLOAD) { s/SVG2SWF/SWF::MovieClip/; }
print "$AUTOLOAD\n" if $DEBUG & 2;
print STDERR ref($self->{this}), " $AUTOLOAD(", join(", ", @_), ");\n" if $DEBUG & 4;
  return $self->{this}->$AUTOLOAD(@_);
}

sub new  { print "new ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($this, $filename) = @_;
  my $class = ref $this || $this;
  my $self = {};

  SWF::Ming::setScale(1.0);
  SWF::Ming::setCubicThreshold(100);

  $self->{this} = SWF::MovieClip->new;
  $self->{movie} = SWF::Movie->new;
  $self->{blocks} = [];
  for($filename) {s/\.?[^.]*$//; $self->{filename} = $_}
  $self->{contenthandler} = XML::SVG::Null->new;
  $self->{chstack} = [];
  $self->{stylestack} = [];
  $self->{hasstyle} = 0;
  $self->{swftext} = undef;

  bless $self, $class;
}

sub add { print "add ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $item) = @_;
#use Data::Dumper; print Dumper($self, $item);

print STDERR ref($self->{this})," add " . ref($item->{this}) . ";\n";
  $self->{this}->add($item->{this});
}

sub setDimension {
  my $self = shift;

print STDERR "setDimension ", join(", ", @_), "\n";
  $self->{movie}->setDimension(@_);
}

sub setRate {
  my $self = shift;

print STDERR "setRate ", join(", ", @_), "\n";
  $self->{movie}->setRate(@_);
}

# parse the CSS style string
sub parsestyle  { print "parsestyle ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my $style = shift;
  my %stylemap;
  my @cssprops = split($style, ';');

  for (@cssprops) {
    if(m,\s*(\S+)\s*:\s*(\S+)\s*,) {
      $stylemap{$1} = $2;
    }
  }
  return \%stylemap;
}

sub handle_svg_start  { print "handle_svg_start ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

  if((exists $attrs->{'height'} and exists $attrs->{'width'})) {
    $self->setDimension($attrs->{'height'}, $attrs->{'width'});
    $self->{explicitheight} = ($attrs->{'height'});
  } elsif((exists $attrs->{'height'})) {
    $self->{explicitheight} = ($attrs->{'height'});
    $self->{explicitwidth}  = undef;
  } elsif((exists $attrs->{'width'})) {
    $self->{explicitwidth} = ($attrs->{'width'});
    $self->{explicitheight}=undef;
  } else {
    $self->{explicitheight}=undef;
    $self->{explicitwidth}=undef;
    #XXX: need to actually compute bounding box rather than just
    #     setting to arbitrary value here
    $self->setDimension(524, 517);
  }
  $self->setRate(12.0);
}

sub handle_g_start  { print "handle_g_start ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

  # push $self->{contenthandler} onto chstack
  push @{$self->{chstack}}, $self->{contenthandler};
  $self->{contenthandler} = XML::SVG::G->new;
  my $g=$self->{contenthandler};
  $g->{hasstyle} = 0;
  my $stylemap = {};

  if((@{$self->{stylestack}} == 0)) {
    $stylemap = {};
  } else {
    $stylemap = $self->{stylestack}->[0];
  }
  if((exists $attrs->{'style'})) {
    $g->{hasstyle} = 1;
    $stylemap = parsestyle($attrs->{'style'});
  }
  push @{$self->{stylestack}}, $stylemap;

}

sub handle_g_end  { print "handle_g_end ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = @_;

  my $g=$self->{contenthandler};
  if (($g->{hasstyle})) {
    pop @{$self->{stylestack}};
  }
  # pop the last content handler off the stack
  $self->{contenthandler} = pop @{$self->{chstack}};

}

sub handle_text_start  { print "handle_text_start ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

  # set up the data gathering process for handle_text_end to use
  # push $self->{contenthandler} onto chstack
  push @{$self->{chstack}}, $self->{contenthandler};
  $self->{contenthandler} = XML::SVG::Text->new;
  my $txt = $self->{contenthandler};
  $txt->{stylemap} = {};
  $txt->{x} = ($attrs->{'x'});
  $txt->{'y'} = ($attrs->{'y'});

  if((exists $attrs->{'style'})) {
    $txt->{stylemap} = parsestyle($attrs->{'style'});
  }
  $txt->{swftext} = SWF::Text->new;

  # set text color
  if ((exists $txt->{stylemap}->{'fill'})) {
    my $color = parsepaint($txt->{stylemap}->{'fill'});

    if ( ($color != 'none')) {
      $txt->{swftext}->setColor(@$color);
    }
  }
  # set font family
  my $f;
  if (exists $txt->{stylemap}->{'font-family'}) {
    #fixme: figure out legal values
    $f = SWF::Font->new("ming-examples/common/test.fdb");
  } else {
    $f = SWF::Font->new("ming-examples/common/test.fdb");
  }
  $txt->{swftext}->setFont($f);

  # set font size
  if ((exists $txt->{stylemap}->{'font-size'})) {
    $txt->{swftext}->setHeight($txt->{stylemap}->{'font-size'}-1);
  } else {
    $txt->{swftext}->setHeight(10);
  }
#  $txt->{swftext}->setBounds(450,450);

  if ((exists $txt->{stylemap}->{'align'})) {
    #fixme
#    $txt->{swftext}->align(0);
  } else {
#    $txt->{swftext}->align(0);
  }
}


sub handle_text_end  { print "handle_text_end ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = @_;

#  printout ("text", $self->{contenthandler}->data);
  my $txt=$self->{contenthandler};

  $txt->{swftext}->addString($self->{contenthandler}->{data});

  my $i = $self->{this}->add($txt->{swftext});
  $i->moveTo($txt->{x},$txt->{'y'}-10);

  # pop the last content handler off the stack
  $self->{contenthandler} = pop @{$self->{chstack}};

}

sub handle_circle  { print "handle_circle ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

        # Handle the <circle> tag

  printout("circle", "handle_circle");
  # parse the easy attributes
  my $cx = ($attrs->{cx});
  my $cy = ($attrs->{cy});
  my $r = ($attrs->{r});

  my $stylemap = {};

  if ((exists $attrs->{'style'})) {
    $stylemap = parsestyle($attrs->{'style'});

    # initialize the swf object
    my $s = XML::SVG::toSWF->new;
    $s->movePenTo(0,0);

    printout("circle", sprintf "setfillandstroke(%$s)", ($stylemap));
    $s->setfillandstroke($stylemap);

    $s->drawCircle($r);

#    printout("circle", sprintf "moveTo(%d,%d)", ($cx, $cy));
    my $i = $self->add($s);
    $i->moveTo($cx,$cy);
  }
}

sub handle_rect  { print "handle_rect ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

  # Handle the <rect> tag
#  printout("rect", "Starting handle_rect");

  # parse the easy attributes
  my $x = ($attrs->{'x'});
  my $y = ($attrs->{'y'});
  my $height = ($attrs->{'height'});
  my $width = ($attrs->{'width'});

  my $stylemap = {};

  my ($rx, $ry);
  if ((exists $attrs->{'style'})) {
    my $stylemap = parsestyle($attrs->{'style'});

    printout("rect", $stylemap);

    # initial math for rx and ry
    if ((exists $attrs->{'rx'})) {
      $rx = ($attrs->{'rx'});
      if ( not exists $attrs->{'ry'}) {
	$ry = $rx;
      }
    }
    if ((exists $attrs->{'ry'})) {
      $ry = ($attrs->{'ry'});
      if ( not exists $attrs->{'rx'}) {
	$rx = $ry;
      }
    }
    if ( not exists $attrs->{'rx'} and not exists $attrs->{'ry'}) {
      $rx = 0;
      $ry = 0;
    }
    my $x0=0;
    my $x1=$rx;
    my $x2=$width-$rx;
    my $x3=$width;
    my $fudgex=0;

    my $y0=0;
    my $y1=$ry;
    my $y2=$height-$ry;
    my $y3=$height;
    my $fudgey=0;

    if (($x1>$x2)) {
      $fudgex = $rx - ($x1+$x2)/2;
      $x1=$width-$rx;
      $x2=$rx;
      $y0=max(($ry-sqrt($ry**2 - $fudgex**2)), 2);
      $y3=$height-$y0;
    }
    if (($y1>$y2)) {
      $fudgey = $ry - ($y1+$y2)/2;
      $y1=$height-$ry;
      $y2=$ry;
      $x0=max(($rx-sqrt($rx**2 - $fudgey**2)), 2);
      $x3=$height-$x0;
    }
    # initialize the swf object
    my $s = XML::SVG::toSWF->new;

    $s->setfillandstroke($stylemap);

    $s->movePenTo($x2,$y0);
    # path_arc (self, rx, ry, x_axis_rotation, large_arc_flag, sweep_flag, x, y):
    $s->path_arc ($rx, $ry, 0, 0, 1, $x3, $y1);
    #s.drawCurveTo(x3,y0,x3,y1)
    $s->drawLineTo($x3,$y2);
    $s->path_arc ($rx, $ry, 0, 0, 1, $x2, $y3);
    #s.drawCurveTo(x3, y3, x2, y3)
    if ( $fudgex == 0) {
      $s->drawLineTo($x1,$y3);
    } else {
      $s->drawCurveTo(($x1+$x2)/2,$height,$x1,$y3);
    }
    $s->path_arc ($rx, $ry, 0, 0, 1, $x0, $y2);
    #s.drawCurveTo(0,y3,0,y2)
    $s->drawLineTo($x0,$y1);
    $s->path_arc ($rx, $ry, 0, 0, 1, $x1, $y0);
    #s.drawCurveTo(0,0,x1,0)
    if ( $fudgex == 0) {
      $s->drawLineTo($x2,$y0);
    } else {
      $s->drawCurveTo(($x1+$x2)/2,0,$x2,$y0);
    }       
    my $i = $self->add($s);
    $i->moveTo($x,$y);
    printout("rect", "Finishing handle_rect");

  }
}

sub handle_path  { print "handle_path ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $attrs) = @_;

  # Handle the <path> tag
  my $stylemap;
  if (@{$self->{stylestack}} == 0) {
    $stylemap = {};
  } else {
    $stylemap = $self->{stylestack}->[0];
  }
  if ((exists $attrs->{'style'})) {
    $stylemap = parsestyle($attrs->{'style'});
  }
  # initialize the swf object
  my $s = XML::SVG::toSWF->new;
#  my $s = SWF::Shape->new;
  $s->movePenTo(0,0);

  $self->{origx} = $s->{cpx};
  $self->{origy} = $s->{cpy};

  $s->setfillandstroke($stylemap);

  # Handle the dreaded "d" attribute
  # It'll look something like this
  # M10 405 h275 M205 405 v35 M10 426 h195 M205 422 h80
  # M=absolute moveto
  # m=relative moveto
  # H=absolute hortizontal (cpx, cpy) to (x, cpy)
  # h=relative horizontal 
  # V=absolute vertical (cpx, cpy) to (cpx, y)
  # v=relative vertical
  my ($bx, $by, $cx, $cy, $dx, $dy, $acx, $acy, $adx, $ady);

  if ((exists $attrs->{'d'})) {
    my $path = $attrs->{'d'};
    my $Mre = '\s*M\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $mre = '\s*m\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Lre = '\s*L\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $lre = '\s*l\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Vre = '\s*V\s*(-?\d+(\.\d+)?)\s*';
    my $vre = '\s*v\s*(-?\d+(\.\d+)?)\s*';
    my $Hre = '\s*H\s*(-?\d+(\.\d+)?)\s*';
    my $hre = '\s*h\s*(-?\d+(\.\d+)?)\s*';
    my $Tre = '\s*T\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $tre = '\s*t\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Qre = '\s*Q\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $qre = '\s*q\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Cre = '\s*C\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $cre = '\s*c\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Sre = '\s*S\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $sre = '\s*s\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $Are = '\s*A\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $are = '\s*a\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*(-?\d+(\.\d+)?)\s*';
    my $zre = '\s*[Zz]\s*';

    my @m;
    my ($qcx, $qcy, $qbx, $qby, $rx, $ry, $x_axis_rotation, $large_arc_flag);
    my ($sweep_flag, $x, $y);
  PATH:
    while (1) {

#use Data::Dumper; print Dumper($s);
      for($path) {@m = /$Mre/; s/$Mre//}
      if (@m) {
	$s->closepath($stylemap);
	$s->movePenTo($m[0], $m[2]);
	$s->resetorig();
	next PATH;
      }
      for($path) {@m = /$mre/; s/$mre//}
      if (@m) {
	$s->closepath($stylemap);
	$s->movePen($m[0], $m[2]);
	$s->resetorig();
	next PATH;
      }
      for($path) {@m = /$Lre/; s/$Lre//}
      if (@m) {
	$s->drawLineTo($m[0], $m[2]);
	next PATH;
      }
      for($path) {@m = /$lre/;s/$lre//};
      if (@m) {
	$s->drawLine($m[0], $m[2]);
	next PATH;
      }
      for($path) {@m = /$Vre/; s/$Vre//}
      if (@m) {
	$s->drawLineTo($s->{cpx},$m[0]);
	next PATH;
      }
      for($path) {@m = /$vre/;s/$vre//}
      if (@m) {
	$s->drawLine(0,$m[0]);
	next PATH;
      }
      for($path) {@m = /$Hre/; s/$Hre//}
      if (@m) {
	$s->drawLineTo($m[0],$s->{cpy});
	next PATH;
      }
      for($path) {@m = /$hre/; s/$hre//}
      if (@m) {
	$s->drawLine($m[0],0);
	next PATH;
      }
      for($path) {@m = /$Tre/; s/$Tre//}
      if (@m) {
	$bx=$qcx+($qcx-$qbx);
	$by=$qcy+($qcy-$qby);
	$cx=$m[0];
	$cy=$m[2];
	$qbx=$bx;
	$qby=$by;
	$qcx=$cx;
	$qcy=$cy;
	$s->drawCurveTo($bx,$by,$cx,$cy);

	next PATH;
      }
      for($path) {@m = /$tre/; s/$tre//}
      if(@m) {
	$bx=$qcx+($qcx-$qbx)-$s->{cpx};
	$by=$qcy+($qcy-$qby)-$s->{cpy};
	$cx=$m[0];
	$cy=$m[3];
	$qbx=$bx+$s->{cpx};
	$qby=$by+$s->{cpy};
	$qcx=$cx+$s->{cpx};
	$qcy=$cy+$s->{cpy};
	$s->drawCurve($bx,$by,$cx,$cy);

	next PATH;
      }
      for($path) {@m = /$Qre/; s/$Qre//}
      if(@m) {
	$bx=$m[0];
	$by=$m[2];
	$cx=$m[4];
	$cy=$m[6];
	$qbx=$bx;
	$qby=$by;
	$qcx=$cx;
	$qcy=$cy;
	$s->drawCurveTo($bx,$by,$cx,$cy);

	next PATH;
      }
      for($path) {@m = /$qre/; s/$qre//}
      if(@m) {
	$bx=$m[0];
	$by=$m[2];
	$cx=$m[4];
	$cy=$m[6];
	$qbx=$bx+$s->{cpx};
	$qby=$by+$s->{cpy};
	$qcx=$cx+$s->{cpx};
	$qcy=$cy+$s->{cpy};
	$s->drawCurve($bx,$by,$cx,$cy);

	next PATH;
      }
      for($path) {@m = /$Cre/;s/$Cre//}
      if (@m) {
	$bx=($m[0]);
	$by=($m[2]);
	$cx=($m[4]);
	$cy=($m[6]);
	$dx=($m[8]);
	$dy=($m[10]);
	$acx=$cx;
	$acy=$cy;
	$adx=$dx;
	$ady=$dy;
	$s->drawCurveTo($bx,$by,$cx,$cy,$dx,$dy);
	next PATH;
      }
      for($path) {@m = /$cre/; s/$cre//};
      if (@m) {
	$bx=($m[0]);
	$by=($m[2]);
	$cx=($m[4]);
	$cy=($m[6]);
	$dx=($m[8]);
	$dy=($m[10]);
	$acx=$cx+$s->{cpx};
	$acy=$cy+$s->{cpy};
	$adx=$dx+$s->{cpx};
	$ady=$dy+$s->{cpy};
	$s->drawCurve($bx,$by,$cx,$cy,$dx,$dy);

	next PATH;
      }
      for($path) {@m = /$Sre/; s/$Sre//}
      if (@m) {
	$bx=$adx+($adx-$acx);
	$by=$ady+($ady-$acy);
	$cx=($m[0]);
	$cy=($m[2]);
	$dx=($m[4]);
	$dy=($m[6]);
	$acx=$cx;
	$acy=$cy;
	$adx=$dx;
	$ady=$dy;
	$s->drawCurveTo($bx,$by,$cx,$cy,$dx,$dy);
	next PATH;
      }
      for($path) {@m = /$sre/; s/$sre//};
      if (@m) {
	$bx=$adx+($adx-$acx)-$s->{cpx};
	$by=$ady+($ady-$acy)-$s->{cpy};
	$cx=($m[0]);
	$cy=($m[2]);
	$dx=($m[4]);
	$dy=($m[6]);
	$acx=$cx+$s->{cpx};
	$acy=$cy+$s->{cpy};
	$adx=$dx+$s->{cpx};
	$ady=$dy+$s->{cpy};
	$s->drawCurve($bx,$by,$cx,$cy,$dx,$dy);
	next PATH;
      }
      for($path) {@m = /$Are/; s/$Are//}
      if(@m) {
	$rx=$m[0];
	$ry=$m[2];
	$x_axis_rotation=$m[4];
	$large_arc_flag=$m[6];
	$sweep_flag=$m[8];
	$x=$m[10];
	$y=$m[12];
	$s->path_arc($rx, $ry, $x_axis_rotation, 
		     $large_arc_flag, $sweep_flag, $x, $y);

	next PATH;
      }
      for($path) {@m = /$are/; s/$are//}
      if(@m) {
	$rx=$m[0];
	$ry=$m[2];
	$x_axis_rotation=$m[4];
	$large_arc_flag=$m[6];
	$sweep_flag=$m[8];
	$x=$m[10] + $s->{cpx};
	$y=$m[12] + $s->{cpy};
	$s->path_arc($rx, $ry, $x_axis_rotation, 
		     $large_arc_flag, $sweep_flag, $x, $y);

	next PATH;
      }
      for($path) {@m = /$zre/; s/$zre//};
      if (@m) {
	$s->closepath($stylemap);
	next PATH;
      }
      if (($path eq "")) {
	last PATH;
	warn "Unrecogized gunk in $path attribute: ", $path;
      }
    }
  }
  $s->closepath($stylemap, 1);

  my $i = $self->add($s);
  $i->moveTo(200,150);
  return;

}

sub finish  { print "finish ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = @_;

  $self->{this}->nextFrame();
print STDERR ref($self->{this}), " nextFrame;\n" if $DEBUG & 4;
  $self->{movie}->add($self->{this});
  $self->{movie}->save(sprintf "%s.swf", $self->{filename});

}

package DocumentHandler;
#     """Handle general document events. This is the main client;
#     interface for SAX: it contains callbacks for the most important;
#     document events, such as the start and end of elements. """;

use base qw(XML::Handler::BuildDOM);

sub new  { print "new ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($this, $filename) = @_;
  my $class = ref $this || $this;
  my $self = {};

  $self->{filename} = $filename;
  $self->{start_tag} = {'name' => [], 'indent' => '', 'line' => ''};

  bless $self, $class;
}

sub start_document  { print "start_document ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = shift;

#  "Handle an event for the beginning of a document.";
  $self->{level} = -1; # we are still below the root element
  #initialize the SWF object
  $self->{swfdoc} = SVG2SWF->new($self->{filename});
  $self->SUPER::start_document(@_);

#  print sprintf "Document: %s", ($self->location->{SystemId});
}

sub start_element  { print "start_element ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $arg) = (shift, @_);
  my ($name, $attrs) = ($arg->{Name}, $arg->{Attributes});

#  "Handle an event for the beginning of an element.";
#  printout("parser", "startElement: starting ", $name);
#  $self->output_start_tag('start'); # output start element of parent
  $self->{level}++;
  $self->{start_tag}->{'indent'} = " " x $self->{level};
  $self->{start_tag}->{'name'} = $name;
  if ( $name eq 'svg') {
    $self->{swfdoc}->handle_svg_start($attrs);
  }
  if ( $name eq 'text') {
    $self->{swfdoc}->handle_text_start($attrs);
  }
  if ( $name eq 'rect') {
    $self->{swfdoc}->handle_rect($attrs);
  }
  if ( $name eq 'path') {
    $self->{swfdoc}->handle_path($attrs);
  }
  if ( $name eq 'circle') {
    $self->{swfdoc}->handle_circle($attrs);
    #$self->{swfdoc}.simplecircle(attrs)
  }
  if ( $name eq 'g') {
    $self->{swfdoc}->handle_g_start($attrs);
  }
  # attrs is an AttributeMap object
  # that implements the AttributeList methods.
  for my $i (keys %$attrs) {
    $self->{start_tag}->{'name'} .= $i .q{="}.
      $attrs->{$i} . q{"};
  }
  eval {
    $self->{start_tag}->{'line'} = $self->{parser}->location->{LineNumber};
  };
  if ($@) {
    $self->{start_tag}->{'line'} = undef;
  }

#  printout("parser", "startElement: finishing ", $name);
  $self->SUPER::start_element(@_);

}

sub end_element  { print "end_element ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $arg) = (shift, @_);
  my $name = $arg->{Name};

#  printout("parser", "endElement: starting ", $name);
#  "Handle an event for the end of an element.";
  if ( $name eq 'text') {
    $self->{swfdoc}->handle_text_end();
  }
  if ( $name eq 'g') {
    $self->{swfdoc}->handle_g_end();
  }
  # output start tag (empty element) or print end tag
#  if ( not $self->output_start_tag('end')) {
#    printout ($name, sprintf "%s</%s>", (" " x $self->level, $name));
#  }
  $self->{level}--;
#  printout("parser", "endElement: finishing ", $name);
  $self->SUPER::end_element(@_);

}

sub characters  { print "characters ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $arg) = (shift, @_);
  my $data = $arg->{Data};

#  "Handle a character data event.";
  # all_data contains the whole file;
  # start:start+length is this part's slice

  if ( $data) {
    $self->{swfdoc}->{contenthandler}->handle($data);
#    $self->output_start_tag('data'); # output start element of parent
#    printout ("", sprintf "%s%s", (" " * ($self->level + 1), $data));
  }
  $self->SUPER::characters(@_);
}

sub output_start_tag   { print "output_start_tag  ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $where) = @_;
return;
  #         """startElement puts its data in $self->start_tag;
  #         startElement, characters, and endElement call output_start_tag;

  #         when called by startElement or characters;
  #         and the start tag (of the parent) is still unprinted:;
  #         print start tag, return 1;
  #         else return undef;

  #         when called by endElement;
  #         and the start tag is still unprinted:;
  #         print empty element tag, return 1;
  #         else return undef""";
  my $STAGC;
  if ( $self->{start_tag}->{'name'}) { # if still unprinted
    if ( $where eq "start" or $where eq "data") {
      $STAGC = ">";
    } elsif ( $where eq "end") {
      $STAGC = "/>";
    } else {
      warn 'output_start_tag("start"|"data"|"end")';
    }
    my $output = sprintf "%s<%s%s",
      ($self->{start_tag}->{'indent'},
       $self->{start_tag}->{'name'}, $STAGC);
    if ( $self->{start_tag}->{'line'}) {
      $output = sprintf "%s (line %s)", ($output, $self->{start_tag}->{'line'});
    }
#    print ($self->{start_tag}->{'name'}, $output), "\n";
    $self->{start_tag} = {'name' => "", 'indent' => '', 'line' => ''};
    return 1;
  } else {
    return undef;
  }
}

sub end_document   { print "end_document  ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self) = shift;

  #write the SWF file to disk
  print "Writing to disk...";
  $self->{swfdoc}->finish();
  print "done.\n";
  $self->SUPER::end_document(@_);
}

package ErrorHandler;
#     """Basic interface for SAX error handlers. If you create an object;
#     that implements this interface, then register the object with your;
#     Parser, the parser will call the methods in your object to report;
#     all warnings and errors. There are three levels of errors;
#     available: warnings, (possibly) recoverable errors, and;
#     unrecoverable errors. All methods take a SAXParseException as the;
#     only parameter.""";

my $SGMLSyntaxError = "SGML syntax error";

sub new { print "new { bless ", join(", ", @_) ,"\n" if $DEBUG & 1;
  bless  { }, __PACKAGE__ }

sub error  { print "error ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $exception) = @_;

#  "Handle a recoverable error.";
  warn("Error: %s\n", $exception);
}

sub fatalError  { print "fatalError ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $exception) = @_;

#        "Handle a non-recoverable error.";
  warn("Fatal error: %s\n", $exception);
  raise SGMLSyntaxError;
}

sub warning  { print "warning ", join(", ", @_) ,"\n" if $DEBUG & 1;
  my ($self, $exception) = @_;

#  "Handle a warning.";
  warn("Warning: %s\n", $exception);
}

package main;


# pick a specific parser
use XML::Parser::PerlSAX;

# ask a specific parser from the parser factory
# SAXparser=saxexts.make_parser("xml.sax.drivers.drv_xmlproc")
# in some versions of the saxexts module this is the correct form:
# SAXparser=saxexts.make_parser("xmlproc")

# ask any parser from the parser factory
# SAXparser=saxexts.make_parser()

# ask any validating parser from the XML validating parser factory
# SAXparser=saxexts.XMLValParserFactory.make_parser()

$SIG{__WARN__} = sub { use Carp; Carp::cluck @_ };

my $filename = shift;
open (SVG, $filename) or die "$!";
my $handler = DocumentHandler->new($filename);
my $parser = XML::Parser::PerlSAX->new(Handler => $handler,
				       Source => {ByteStream => *SVG});
$parser->parse;
close SVG;

# three options for error handling:
# 1. use our own ErrorHandler
#SAXparser->setErrorHandler(ErrorHandler());
# 2. use the ErrorRaiser from saxutils
# SAXparser.setErrorHandler(saxutils.ErrorRaiser())
# 3. use the ErrorPrinter from saxutils
# SAXparser.setErrorHandler(saxutils.ErrorPrinter())

# if __name__ == '__main__':;
#     try:;
#         SAXparser->parse(sys->argv[1]);
#     # catch the 'SGMLSyntaxError's raised by our own ErrorHandler
#     except SGMLSyntaxError:;
#         print STDERR("%s; processing aborted\n", (SGMLSyntaxError));
#         exit(1);
#     # catch the SAXParseException errors raised by the SAX parser
#     # and passed on by ErrorRaiser
#     except saxlib->SAXParseException:;
#         print STDERR("%s; processing aborted\n";
#                         , (saxlib->SAXParseException));
#         exit(1);