# Copyright 2011 Kevin Ryde

# This file is part of Math-Image.
#
# Math-Image is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-Image 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 General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-Image.  If not, see <http://www.gnu.org/licenses/>.


package App::MathImage::Image::Base::SVGout;
use 5.004;
use strict;
use Carp;
use vars '$VERSION', '@ISA';

use Image::Base;
@ISA = ('Image::Base');

$VERSION = 59;

# uncomment this to run the ### lines
use Devel::Comments '###';

sub new {
  my $class = shift;
  my $self = bless { -width  => 100,
                     -height => 100,
                     @_ }, $class;
  if (defined $self->{'-file'}) {
    croak "Cannot load initial -file, Image::Base::SVGout is output-only";
  }
}

sub set {
  my $self = shift;
  %$self = (%$self, @_);
}

sub xy {
  my ($self, $x, $y, $colour) = @_;
  ### Image-Base-SVGout xy(): @_[1 .. $#_]

  if (@_ == 3) {
    return undef;  # no fetch
  } else {
    push @{$self->{'-elements'}},
      "<rect x=\"$x\" y=\"$y\" width=\"1\" height=\"1\" stroke="._attribute_quote($colour)."/>";
  }
}

sub rectangle {
  my ($self, $x1,$y1, $x2,$y2, $colour, $fill) = @_;
  ### Image-Base-SVGout rectangle(): @_[1 .. $#_]

  if ($x1 == $x2 || $y1 == $y2) {
    $self->line ($x1,$y1, $x2,$y2, $colour);
  } else {
    if (! $fill) {
      $x1 += .5;
      $y1 += .5;
      $x2 -= .5;
      $y2 -= .5;
    }
    push @{$self->{'-elements'}},
      ("<rect x=\"$x1\" y=\"$y1\" width=\"" . (abs($x2-$x1)+1)
       . "\" height=\"" . (abs($y2-$y1)+1)
       . "\" ".($fill?'fill':'stroke')."="._attribute_quote($colour)
       . "/>");
  }
}

sub ellipse {
  my ($self, $x1,$y1, $x2,$y2, $colour, $fill) = @_;
  ### Image-Base-SVGout rectangle(): @_[1 .. $#_]

  if ($x1 == $x2 || $y1 == $y2) {
    $self->line ($x1,$y1, $x2,$y2, $colour);
  } else {
    my $rx = (abs($x1-$x2) / 2);
    my $ry = (abs($y1-$y2) / 2);
    if ($fill) {
      $rx += .5;
      $ry += .5;
    }
    push @{$self->{'-elements'}},
      ("<ellipse cx=\"" .(($x1+$x2) / 2)
       . "\" cy=\"" . (($y1+$y2) / 2)
       . "\" rx=\"$rx\" ry=\"$ry\""
       . "\" ".($fill?'fill':'stroke')."="._attribute_quote($colour)
       . "/>");
  }
}

sub line {
  my ($self, $x1,$y1, $x2,$y2, $colour, $fill) = @_;
  ### Image-Base-SVGout rectangle(): @_[1 .. $#_]

  push @{$self->{'-elements'}},
    ('<line x1="'.($x1+.5)
     . '" y1="' . ($y1+.5)
     . '" x2="' . ($x2+.5)
     . '" y2="' . ($y2+.5)
     .'" stroke=' . _attribute_quote($colour)
     . ' stroke-linecap="square"/>');
}

sub load {
  my ($self, $filename) = @_;
  croak "Image::Base::SVGout is output-only";
}

sub save {
  my ($self, $filename) = @_;
  ### Image-Base-SVGout save(): @_
  if (@_ > 1) {
    $self->set('-file', $filename);
  } else {
    $filename = $self->get('-file');
  }
  ### $filename

  require Fcntl;
  sysopen FH, $filename, Fcntl::O_WRONLY() | Fcntl::O_TRUNC() | Fcntl::O_CREAT()
    or croak "Cannot create $filename: $!";

  if (! $self->save_fh (\*FH)) {
    my $err = "Error writing $filename: $!";
    { local $!; close FH; }
    croak $err;
  }
  close FH
    or croak "Error closing $filename: $!";
}

# not yet documented ...
sub save_fh {
  my ($self, $fh) = @_;
  ### save_fh() ...
  ### elements: $self->{'-elements'}
  ### height: $self->{'-height'}

  local $,="\n";
  return
    print($fh <<"HERE",
<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
<svg xmlns="http://www.w3.org/2000/svg"
     width="$self->{'-width'}" height="$self->{'-height'}">
<!-- Generated by Image::Base::SVGout version $VERSION -->
HERE
          (defined $self->{'-title'}
           ? ("<title>", _entitize($self->{'-title'}), "</title>") : ()),

          (defined $self->{'-description'}
           ? ("<description>", _entitize($self->{'-description'}), "</description>") : ()),

          @{$self->{'-elements'} || []},
          "</svg>\n");
}

my %entity = ('&' => '&amp;',
             '"' => '&quot;',
             '<' => '&lt;',
             '>' => '&gt;',
            );
sub _entitize {
  my ($value) = @_;
  $value =~ s/([&"<>])/$entity{$1}/eg;
  return $value;
}

sub _attribute_quote {
  my ($value) = @_;
  return '"'._entitize($value).'"';
}

1;
__END__

=for stopwords SVGout filename Ryde

=head1 NAME

App::MathImage::Image::Base::SVGout -- SVG image file output

=head1 SYNOPSIS

 use App::MathImage::Image::Base::SVGout;
 my $image = App::MathImage::Image::Base::SVGout->new (-width => 100,
                                                       -height => 100);
 $image->rectangle (0,0, 99,99, 'b');
 $image->xy (20,20, 'o');
 $image->line (50,50, 70,70, 'o');
 $image->line (50,50, 70,70, 'o');
 $image->save ('/some/filename.rle');

=head1 CLASS HIERARCHY

C<App::MathImage::Image::Base::SVGout> is a subclass of C<Image::Base>,

    Image::Base
      App::MathImage::Image::Base::SVGout

=head1 DESCRIPTION

C<App::MathImage::Image::Base::SVGout> extends C<Image::Base> to create SVG
format image files.

The colour names are ...

=head1 FUNCTIONS

=over 4

=item C<$image = App::MathImage::Image::Base::SVGout-E<gt>new (key=E<gt>value,...)>

Create and return a new image object.  A new image can be started with
C<-width> and C<-height>,

    $image = App::MathImage::Image::Base::SVGout->new (-width => 200, -height => 100);

=item C<$image-E<gt>save ()>

=item C<$image-E<gt>save ($filename)>

Save the image to an SVG file, either the current C<-file> option, or set
that option to C<$filename> and save to there.

=back

=head1 SEE ALSO

L<Image::Base>

=cut
