[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Pastel / Graphics.pm

# $Id: Graphics.pm,v 1.13 2003/04/29 18:18:05 malay Exp $\r
# Perl module for Pastel::Graphics\r
# Author: Malay < curiouser@ccmb.res.in >\r
# Copyright (c) 2003 by Malay. All rights reserved.\r
# You may distribute this module under the same terms as perl itself\r
\r
=head1 NAME\r
\r
Pastel::Graphics - Graphics context.\r
\r
=head1 SYNOPSIS\r
\r
  use Pastel;\r
\r
  my $graphics = Pastel::Graphics->new(...);\r
  $graphics->foo();\r
  $graphics->bar();\r
\r
  $graphics->show(); #dump the graphics on STDOUT\r
\r
     -or-\r
\r
  my $string = $graphics->get_svg(); # get the graphic as string\r
  print $string;\r
\r
=head1 DESCRIPTION\r
\r
C<Pastel::Graphics> is the main workhorse of Pastel. It is equivalent to\r
Java Graphics2D class. Each program first has to create once instance\r
of this class, then call methods on this and lastly dump the whole\r
instance onto STDOUT or get it as string.\r
\r
The class provides the graphics context in that it hold all the\r
necessary informations for drawing any graphics object correctly.\r
\r
All styles like fonts, color and strokes are set into this class by\r
calling appropriate methods. Shapes and Strings are drawn by calling\r
C<draw()> and C<draw_string()> methods. For a tutorial introduction see\r
Pastel programming manual.\r
\r
There are certain shortcut methods that are inbuilt into this\r
module. You can draw shapes without creating additional\r
objects. Notable among these classes of methods are C<draw_3D_rect()>\r
and C<draw_round_rect()> which are not availble from the\r
L<Pastel::Geometry::Rectangle> class.\r
\r
=cut\r
\r
package Pastel::Graphics;\r
@ISA = qw( Pastel::Mixin::Mixin);    # requires _rearrange() function\r
use strict;\r
use Carp;\r
\r
my $_width  = "800";                 #Width of the SVG document\r
my $_height = "600";                 #Height of the SVG document\r
\r
my $_dtd =\r
'<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20001102//EN" "http://www.w3.org/TR/2000/CR-SVG-20001102/DTD/svg-20001102.dtd">';\r
\r
sub new {\r
    my $arg   = shift;\r
    my $class = ref($arg) || $arg;\r
    my $self  = {};\r
    bless $self, $class;\r
\r
    $self->_init(@_);\r
\r
    return $self;\r
\r
}\r
\r
=head1 CONSTRUCTOR\r
\r
=head2 new()\r
\r
Creates and returns a new C<Pastel::Graphics> object.\r
\r
  Usage : $graphics = Pastel::Graphics->new(-width=>$w,\r
					       -height=>$h,\r
					       -DTD   =>$dtd );\r
\r
   Args : $w  - Optional. Width of the SVG document in pixels. If not\r
                provided default is 800.\r
          $h  - Optional. Height of the SVG document in pixels. If not\r
                provided the default is 600.\r
         $dtd - Optional. DTD used for SVG document. You can pass your\r
                own DTD.\r
\r
 Returns: Pastel::Graphics object\r
\r
=cut\r
\r
sub _init {\r
\r
    my ( $self, @args ) = @_;\r
\r
    my ( $w, $h, $dtd, $cgi ) =\r
      $self->_rearrange( [ "WIDTH", "HEIGHT", "DTD", "CGI" ], @args );\r
\r
    $self->{width}  = defined($w)   ? $w   : $_width;\r
    $self->{height} = defined($h)   ? $h   : $_height;\r
    $self->{dtd}    = defined($dtd) ? $dtd : $_dtd;\r
    $self->{CGI}    = defined($cgi) ? $cgi : "true";\r
    $self->{_temp}   = "";                            # To store SVG elements\r
    $self->{_defs}   = "";                            # To store DEFS\r
    $self->{_writer} = $self->_initialize_writer();\r
    $self->{paint}   = undef;\r
    $self->{stroke}  = undef;\r
    $self->{defs}    = {};\r
}\r
\r
=head1 METHODS\r
\r
\r
=head2 set_font()\r
\r
Set the font for all the graphics object. Any string drawn using\r
C<draw_string()> after calling this method will be drawn using the\r
font presently set using this method. Note that\r
C<Pastel::Text::AttributedString> objects are immune to font\r
context. To set the font of C<Pastel::Text::AttributedString> you need\r
to set the font by setting it as attribute of the C<AttributedString>\r
object.\r
\r
  Usage   : set_font($font)\r
\r
  Args    : $font is a  Pastel::Font object. \r
\r
  Returns : Nothing. \r
\r
=cut\r
\r
sub set_font {\r
    my ( $self, $arg ) = @_;\r
    $self->{"font"} = $arg;\r
    return $self;\r
\r
    #   my ($self,%arg) = @_;\r
    #    if(defined ($arg{FAMILY})){$self->{FONT_FAMILY} = $arg{FAMILY};}\r
    #    if(defined ($arg{SIZE})){$self->{FONT_SIZE} = $arg{SIZE};}\r
    #    if(defined($arg{COLOR})){$self->{FONT_COLOR} = $arg{COLOR};}\r
    #    if(defined($arg{WEIGHT})){$self->{FONT_WEIGHT} = $arg{WEIGHT};}\r
    #    return $self;\r
}\r
\r
sub set_fill_color {\r
    my $self = shift;\r
    $self->{COLOR} = shift;\r
    return $self;\r
}\r
\r
=head2 set_paint()\r
\r
Sets the color of the graphics context. Any drawing of shapes or text\r
will be carried out using the color presently set in the graphics\r
context. The color can be solid color of Pastel::Color object or a\r
gradient implementing Pastel::GradientI interface.\r
\r
 Usage   : set_paint($color)\r
  \r
 Args    : $color is a Pastel::Color or Pastel::GradientI object.\r
  \r
 Returns : Nothing. \r
\r
=cut\r
\r
sub set_paint {\r
    my $self = shift;\r
    $self->{paint} = $_[0];\r
}\r
\r
=head2 set_stroke()\r
\r
If the current graphics context has the stroke object set then all\r
further drawings will be stroked. The stroke color will be the current\r
color set using C<set_paint()> method. The swith off the stroking you\r
need to unset the stroke by calling this method without any argument.\r
\r
Because stroking is done using the current color set in the graphics\r
context, to draw an object with both stroke and fill where the\r
stroke-color and the fill-color are different, you need to fill the\r
object first and set a different color before you draw the object. To\r
draw a rectangle with blue border and red fill you might do this:\r
\r
             $g = Pastel::Graphics->new();\r
             $g->set_paint(Pastel::Color->red());\r
             $g->set_stroke( Pastel::BasicStroke->new(-width=>5) );\r
             my $rect = Pastel::Geometry::Rectangle(\r
						 -x=>20,-y=>30,\r
              					 -width=>100,-height=>150\r
						   );\r
             $g->fill($rect); # filled with red color\r
             $g->set_paint(Pastel::Color->blue());\r
             $g->draw($rect);\r
\r
  Usage   : set_stroke($stroke) # set the stroke object\r
            set_stroke()        # unset stroking\r
\r
  Args    : $stroke is a Pastel::BasicStroke object.\r
  \r
  Returns : Nothing. \r
\r
=cut\r
\r
sub set_stroke {\r
    my $self = shift;\r
    my $arg  = shift;\r
\r
    #print STDERR "******STROKE called\n";\r
    if ( defined($arg) ) {\r
\r
        #print "Inside CLEAR\n";\r
        $self->{stroke} = $arg;\r
    }\r
    else {\r
        if ( defined( $self->{stroke} ) ) {\r
            $self->{stroke} = undef;\r
            return;\r
        }\r
    }\r
\r
}\r
\r
\r
=head2 get_font()\r
\r
Returns the current font object in the graphics context.\r
\r
 Usage   : get_font();\r
\r
 Args    : Nothing.\r
\r
 Returns : Pastel::Font object. \r
\r
=cut\r
\r
\r
sub get_font {\r
    my $self = shift;\r
    if ( defined( $self->{font} ) ) {\r
        return $self->{font};\r
    }\r
    else {\r
        return undef;\r
    }\r
}\r
\r
\r
=head2 get_paint()\r
\r
Returns the current paint object in the graphics context.\r
\r
 Usage   : $g->get_paint()\r
  \r
 Args    : Nothing.\r
  \r
 Returns : Pastel::Color or object implementing Pastel::GradientI interface. \r
\r
=cut\r
\r
sub get_paint {\r
    my $self = shift;\r
    if ( !defined( $self->{paint} ) ) {\r
        $self->{paint} = Pastel::Color->black();\r
    }\r
    return $self->{paint};\r
}\r
\r
=head2 get_stroke()\r
\r
Return the current stroke object in the graphics context. \r
\r
  Usage   :  get_stroke()\r
\r
  Args    :  Nothing.\r
\r
  Returns :  Pastel::BasicStroke object if stroke is set or undef if not set.\r
\r
=cut\r
\r
sub get_stroke {\r
    my $self = shift;\r
    if ( !defined( $self->{stroke} ) ) {\r
\r
        #    $self->{stroke} = Pastel::BasicStroke->new(-width=>1);\r
        #    return $self->{stroke};\r
        return "";\r
    }\r
    else {\r
        return $self->{stroke};\r
    }\r
}\r
\r
=head2 draw_rect()\r
\r
Shortcut function to draw a rectangle without creating additional\r
object. The rectangle is stroked with the current C<BasicStroke>\r
object. If the C<BasicStroke> is not set then the rectangle is created\r
using an 1 pixel width line. The color of the line is determined by\r
the current paint.\r
\r
  Usage   : draw_rect($x, $y, $width, $height)\r
\r
  Args    : $x     - X coordinate of the top left corner vertice of rectangle.\r
            $y     - Y coordinate of the top left corner vertice of rectangle.\r
            $width - Width of the rectangle.\r
            $height- Height of the rectangle.\r
\r
  Returns : Nothing. \r
\r
=cut\r
\r
sub draw_rect {\r
\r
    my $self = shift;\r
    my ( $x, $y, $width, $height ) =\r
      $self->_rearrange( [ "X", "Y", "WIDTH", "HEIGHT" ], @_ );\r
    my $color;\r
    if ( $self->get_paint()->isa("Pastel::Color") ) {\r
        $color = $self->get_paint()->to_svg_stroke();\r
    }\r
    else {\r
        $color = "stroke:url(" . $self->get_paint()->get_ref() . ');';\r
        $self->add_to_defs( $self->get_paint() );\r
    }\r
    my $stroke =\r
      $self->get_stroke()\r
      ? $self->get_stroke()\r
      : Pastel::BasicStroke->new();\r
\r
    my $stroke_style = $stroke->to_svg();\r
\r
    my $half_width = $stroke->get_line_width() / 2;\r
    $x      = $x + $half_width;\r
    $y      = $y + $half_width;\r
    $width  = $width - ( 2 * $half_width );\r
    $height = $height - ( 2 * $half_width );\r
\r
    $self->{_temp} .= (\r
qq(<rect x="$x" y="$y" width="$width" height="$height" style="fill:none; $color$stroke_style" />)\r
    );\r
\r
}\r
\r
=head2 fill_rect()\r
\r
Shortcut function to draw a filled rectangle without creating\r
additional objects. The rectangle is filled with the current paint in\r
the graphics context.\r
\r
  Usage  : fill_rect($x, $y, $width, $height);\r
\r
  Args   : $x     - X coordinate of the top left corner of the rectangle.\r
           $y     - Y coordinate of the top left corner of the rectangle.\r
           $width - Width of the rectangle in pixels.\r
           $height- Height of the rectangle in pixels.\r
    \r
 Returns  : Nothing\r
\r
=cut\r
\r
sub fill_rect {\r
    my $self = shift;\r
\r
    # my $color = $self->get_paint()->to_svg_fill();\r
    my $color;\r
    if ( $self->get_paint()->isa("Pastel::Color") ) {\r
        $color = $self->get_paint()->to_svg_fill();\r
    }\r
    else {\r
        $color = "fill:url(" . $self->get_paint()->get_ref() . ')';\r
        $self->add_to_defs( $self->get_paint() );\r
    }\r
\r
    my ( $x, $y, $width, $height ) =\r
      $self->_rearrange( [ "X", "Y", "WIDTH", "HEIGHT" ], @_ );\r
    $self->{_temp} .= (\r
qq(<rect x="$x" y="$y" width="$width" height="$height" style="$color;stroke:none"/>)\r
    );\r
\r
}\r
\r
=head2 draw_round_rect()\r
\r
Shortcut fuction to draw open rectangle with rounded corners. The\r
rectangle is stroked with the current stroke if it is set. Otherwise\r
it is drawn with 1 pixel width line. The color is determined by the\r
current paint object.\r
\r
  Usage : draw_round_rect($x, $y, $width, $height,\r
			 $arc_width, $arc_height);\r
\r
   Args : $x          - X coordinate of the top left hand corner.\r
          $y          - Y coordinate of the top left hand corner.\r
          $width      - Width of the rectangle.\r
          $height     - Height of the rectangle.\r
          $arc_width  - Horizontal diameter of the arc at the four corners.\r
          $arc_height - vertical diameter of the arc at the four corners.\r
\r
 Returns : Nothing\r
\r
=cut\r
\r
sub draw_round_rect {\r
    my ( $self, @args ) = @_;\r
\r
    if ( @args < 6 ) {\r
        croak 'Missing parameter in Pastel::Graphics::draw_round_rect()!\n';\r
    }\r
\r
    #my $paint  = $self->get_paint()->to_svg_stroke();\r
    my $paint;\r
    if ( $self->get_paint()->isa("Pastel::Color") ) {\r
        $paint = $self->get_paint()->to_svg_stroke();\r
    }\r
    else {\r
        $paint = "stroke:url(" . $self->get_paint()->get_ref() . ');';\r
        $self->add_to_defs( $self->get_paint() );\r
    }\r
\r
    my $stroke =\r
      $self->get_stroke()\r
      ? $self->get_stroke()\r
      : Pastel::BasicStroke->new();\r
\r
    my $half_width = $stroke->get_line_width() / 2;\r
\r
    my $stroke_style = $stroke->to_svg();\r
    my $x            = $args[0] + $half_width;\r
    my $y            = $args[1] + $half_width;\r
    my $width        = $args[2] - ( 2 * $half_width );\r
    my $height       = $args[3] - ( 2 * $half_width );\r
\r
    $self->{_temp} .=\r
qq(<rect x="$x" y="$y" width="$width" height="$height" rx="$args[4]" ry="$args[4]" style="fill:none;$paint$stroke_style" />);\r
\r
}\r
\r
=head2 draw_fill_round_rect()\r
\r
Draws a filled rectangle with rounded corners. The rectangle is filled\r
with the current paint object in the graphics context.\r
\r
  Usage : $g->draw_fill_round_rect($x, $y, $width, $height,\r
			      $arc_width, $arc_height);\r
\r
   Args : $x          - X coordinate of the top left hand corner.\r
          $y          - Y coordinate of the top left hand corner.\r
          $width      - Width of the rectangle.\r
          $height     - Height of the rectangle.\r
          $arc_width  - Horizontal diameter of the arc at the four corners.\r
          $arc_height - vertical diameter of the arc at the four corners.\r
\r
\r
  Returns : Nothing\r
\r
=cut\r
\r
sub draw_fill_round_rect {\r
    my ( $self, @args ) = @_;\r
\r
    if ( @args < 6 ) {\r
        croak 'Missing parameter in Pastel::Graphics::draw_fillround_rect()!\n';\r
    }\r
\r
    # my $paint = $self->get_paint()->to_svg_fill();\r
    my $paint;\r
    if ( $self->get_paint()->isa("Pastel::Color") ) {\r
        $paint = $self->get_paint()->to_svg_fill();\r
    }\r
    else {\r
        $paint = "fill:url(" . $self->get_paint()->get_ref() . ')';\r
        $self->add_to_defs( $self->get_paint() );\r
    }\r
\r
    # my $stroke = $self->get_stroke()->to_svg();\r
\r
    $self->{_temp} .=\r
qq(<rect x="$args[0]" y="$args[1]" width="$args[2]" height="$args[3]" rx="$args[4]" ry="$args[4]" style="$paint" />);\r
\r
}\r
\r
=head2 draw_3D_rect()\r
\r
Draws a highlighted 3D effect rectangle. \r
\r
  Usage   : $g->draw_3D_rect($x, $y, $width, $height, $raised, $bevel);\r
\r
  Args    : $x - Top left corner X coordinate  of the rectangle.\r
            $y - Top left corner Y coordinate  of the rectangle.\r
            $width - Width of the rectangle.\r
            $height - Height of the rectangle.\r
            $raised - Optional. Takes value "true" or "false". Default "true". \r
            $bevel  - Optional. Width of the bevel. Default 1.\r
\r
  Returns : Nothing\r
\r
=cut\r
\r
sub draw_3D_rect {\r
    my ( $self, @args ) = @_;\r
    if ( @args < 4 ) {\r
        croak 'Missing parameter in Pastel::Graphics::draw_3D_rect()!\n';\r
    }\r
    my $raised;\r
\r
    if ( $args[4] && ( $args[4] =~ /true/i ) ) {\r
        $raised = 1;\r
    }\r
    else {\r
        $raised = 0;\r
    }\r
\r
    my $bevel = 1;\r
    if ( $args[5] ) {\r
        $bevel = $args[5];\r
    }\r
    my ( $x, $y, $width, $height ) = (@args);\r
\r
    # print "***@args\n";\r
    my $before_color  = $self->get_paint();\r
    my $current_color = $before_color;\r
\r
    if ( !$before_color->isa("Pastel::Color") ) {\r
        $current_color = Pastel::Color->black();\r
    }\r
\r
    my $brighter = $current_color->brighter();\r
    my $darker   = $current_color->darker();\r
\r
    my $s = "<path d=\"";\r
    $self->set_paint( $raised ? $brighter : $darker );\r
\r
    $s .= "M" . $x . " " . $y;\r
    $s .= "L" . eval( $x + $width ) . " " . $y;\r
    $s .= "L" . eval( $x + $width - $bevel ) . " " . eval( $y + $bevel );\r
    $s .= "H" . eval( $x + $bevel );\r
    $s .= "V" . eval( $y + $height - $bevel );\r
    $s .= "L" . $x . " " . eval( $y + $height );\r
    $s .= "z" . "\" ";\r
\r
    $s .= "style=\"" . $self->get_paint()->to_svg_fill() . "\" />";\r
\r
    $self->set_paint( $raised ? $darker : $brighter );\r
    $s .= "<path d=\"";\r
    $s .= "M" . $x . " " . eval( $y + $height );\r
    $s .= "L" . eval( $x + $bevel ) . " " . eval( $y + $height - $bevel );\r
    $s .= "H" . eval( $x + $width - $bevel );\r
    $s .= "V" . eval( $y + $bevel );\r
    $s .= "L" . eval( $x + $width ) . " " . $y;\r
    $s .= "V" . eval( $y + $height );\r
    $s .= "z" . "\" style=\"" . $self->get_paint()->to_svg_fill() . "\" />";\r
\r
    $self->_buffer_add($s);\r
\r
    #    $self->fill_rect($x + $stroke_width, $y + $height - $stroke_width,\r
    #    $width -$stroke_width, $stroke_width); $self->fill_rect($x +\r
    #    $width - $stroke_width, $y , $stroke_width, $height);\r
\r
    $self->set_paint($before_color);\r
\r
    #    my $color  = $self->get_paint()->to_svg_stroke();\r
    #    my $width  = $self->get_stroke()->get_line_width();\r
    #    my $stroke = $self->get_stroke();\r
    #   $self->set_stroke( Pastel::BasicStroke->new( -width => 1 ) );\r
    #    if ($raised) {\r
    #        $self->set_paint( $self->get_paint()->brighter() );\r
    #        $self->draw_line( $args[0], $args[1], $args[0], $args[1] + $args[3] );\r
    #        $self->draw_line(\r
    #            $args[0] + 1,\r
    #            $args[1], $args[0] + $args[2] - 1,\r
    #            $args[1]\r
    #        );\r
    #        $self->set_paint( $self->get_paint()->darker() );\r
    #        $self->draw_line(\r
    #            $args[0] + 1,\r
    #            $args[1] + $args[3],\r
    #            $args[0] + $args[2],\r
    #            $args[1] + $args[3]\r
    #        );\r
    #        $self->draw_line(\r
    #            $args[0] + $args[2],\r
    #            $args[1],\r
    #            $args[0] + $args[2],\r
    #            $args[1] + $args[3] - 1\r
    #        );\r
    #    }\r
    #    else {\r
\r
    #        # = $color->darker();\r
    #    }\r
    #    $self->set_paint($color);\r
    #    $self->set_stroke($stroke);\r
\r
}\r
\r
=head2 draw()\r
\r
Draws a C<Pastel::Shape> object. The object is stroked using the current\r
stroke object in the graphics context using the current paint object\r
in the graphics context. The method works for any object which is a\r
subclass of C<Pastel::Shape>.\r
\r
If you subclass Pastel::Shape. The child class must implement\r
C<get_shape()> method, which should return an instance of the graphics\r
primitive (classes in C<Pastel::Geometry>).\r
\r
 Usage   : draw($shape)\r
\r
 Args    : $shape - an object subclassed from Pastel::Shape. All the\r
                    classes in Pastel::Geometry are subclass of Pastel::Shape.\r
\r
 Returns : Nothing\r
\r
=cut\r
\r
sub draw {\r
    my $self = shift;\r
    my $ob   = shift;\r
    my $data;\r
    my $shape = $ob;\r
\r
    #if (defined ($self->{stroke}) ){\r
    #print "***********Stroke defined********\n";\r
    #my $stroke =  $self->{stroke};\r
    #my $stroked_ob = $stroke->create_stroked_shape($ob);\r
    #$data = $stroked_$ob->_draw($self);\r
    #}\r
    #else{\r
    if ( $ob->can("get_shape") ) {\r
        $shape = $ob->get_shape();\r
    }\r
    $data = $shape->_draw($self);\r
\r
    #}\r
\r
    $self->_buffer_add($data);\r
}\r
\r
=head2 draw_string();\r
\r
Draws the string supplied in the co-ordinates specified. Three types\r
of strings can be drawn using this method. Native perl strings can be\r
supplied which will be internally converted into suitable format. The\r
entities are automatically escaped. You can even pass perl unicode\r
strings directly into the method.\r
\r
The methods also accepts C<Pastel::String> objects which are nothing\r
but an XML formatted container for the perl string.\r
\r
In both these above cases the font in which the string will drawn is\r
the current font object in the graphics context. The strings will also\r
be stroked with the current stroke in the graphics context and it will\r
drawn in the current paint color. \r
\r
The method also accepts C<Pastel::Text::AttributedString> object. In\r
Java you pass an C<AttributedCharacterIterator> into this method. In\r
Pastel you pass the C<AttributedString> object\r
itself. C<AttributedString> object are immune to current graphics\r
context. If you want to change the stroke or color of the\r
C<AttributedString> do so in the directly in the object.\r
\r
A major way in which C<Pastel> differs from C<Java2D> is that the\r
coordinates can be arrays of numbers each determining the coordinated\r
of each character in the string. See SVG specification for more\r
details.\r
\r
  Usage : draw_string("perl string", $x, $y);\r
          draw_string("perl string", \@x, \@y);\r
          draw_string( $string,$x, $y);\r
          draw_string( $string, \@x, \@y);\r
\r
\r
  Args : The method takes 3 arguments. The first argument can be an\r
         object of type Pastel::String or a pure perl string or\r
         Pastel::Text::AttributedString. The string supplied is converted to\r
         XML form automatically. All character code above 126 is converted to\r
         "&xff;" form. "<", ">", "&" and other XML entities are automatically\r
         created.\r
\r
         The second argument can be a single numerical value\r
         indicating the X cordinate of the first character of the\r
         string or the middle of the total length of the string or the\r
         last character depending on text anchoring. This argument\r
         also be a reference to an array indicating the X coordinates\r
         of successive characters in the string.\r
\r
         The third argument can be a single numerical or a reference\r
         to an array of numericals indicating the Y coordinate of the\r
         baseline of the glyph used for drawing the font.\r
\r
=cut\r
\r
sub draw_string {\r
    my ( $self, @args ) = @_;\r
    my ( $string, $x, $y ) = $self->_rearrange( [ "TEXT", "X", "Y" ], @args );\r
\r
    my $data = "";    #Holds the SVG string;\r
\r
    unless ( ( defined($string) ) && ( defined($x) ) && ( defined($y) ) ) {\r
        print 'Error: Graphics::drawstring(): Argument missing', "\n";\r
        return;\r
    }\r
\r
    if ( $string->isa("Pastel::Text::AttributedString") ) {\r
\r
        #print STDERR "AttributedString supplied\n";\r
        $string->set_x($x);\r
        $string->set_y($y);\r
        $data = $string->to_svg();\r
    }\r
\r
    # If $string is a string object calls its draw method\r
    elsif ( ref($string) =~ m/String/ ) {\r
\r
        $string->set_x($x);\r
        $string->set_y($y);\r
\r
        if ( defined( $self->{font} ) ) {    # If the graphics object has a font\r
                                             # First fontify it\r
            $string->set_font( $self->get_font() );\r
            $data = $string->draw($self);\r
\r
        }\r
        else {\r
            $data = $string->draw($self);\r
        }\r
    }\r
\r
    # If $string is a perl string, create a string object, fontify it\r
    # by passing it to the font object and then call its draw method\r
    else {\r
        my $string = Pastel::String->new($string);\r
        $string->set_x($x);\r
        $string->set_y($y);\r
\r
        if ( defined( $self->{font} ) ) {    # If the graphics object has font\r
\r
            # Set the font object of the String\r
            my $fontified = $string->set_font( $self->{font} );\r
            $data = $fontified->draw($self);\r
        }\r
        else {    # If the graphics object doesn't have font object set\r
            $data = $string->draw($self);    # Just call the draw method\r
        }\r
    }\r
\r
    $self->_buffer_add($data);               # Add the data to the print buffer\r
\r
}\r
\r
=head2 show()\r
\r
Dumps the graphics object as SVG on STDOUT.\r
\r
 Usage   : show()\r
  \r
 Args    : Nothing.\r
  \r
 Returns : Nothing.\r
\r
=cut\r
\r
sub show {\r
    my $self   = shift;\r
    my $writer = $self->{_writer};\r
    $self->_print_header();\r
    $self->_print_svg_start();\r
\r
    if ( %{ $self->{defs} } ) {\r
        $writer->print_svg('<defs>');\r
\r
        #  for ( my $i = 0 ; $i < @{ $self->{defs} } ; $i++ ) {\r
        #            $writer->print_svg( ${ $self->{defs} }[$i]->to_svg() );\r
        #        }\r
        $writer->print_svg( $self->_get_defs() );\r
        $writer->print_svg('</defs>');\r
    }\r
\r
    $writer->print_svg( $self->{_temp} );\r
    $self->_print_footer();\r
}\r
\r
\r
sub fill {\r
    my $self = shift;\r
\r
    my $shape = shift;\r
\r
    if ( !$shape->isa("Pastel::Shape") ) {\r
        croak 'Error: Only a shape can be filled by Pastel::Graphics->fill()';\r
    }\r
\r
    $shape->set_fill( $self->get_paint() );\r
}\r
\r
sub add_to_defs {\r
    my $self   = shift;\r
    my $object = shift;\r
\r
    # ${ $self->{defs} }[ @{ $self->{defs} } ] = $object;\r
    # to keep only the unique element we just add the object with an id\r
    my $id = $object->get_id();\r
    $self->{defs}->{id} = $object;\r
}\r
\r
sub _get_defs {\r
    my $self = shift;\r
    my $s    = "";\r
    if ( %{ $self->{defs} } ) {\r
        foreach my $key ( keys %{ $self->{defs} } ) {\r
            $s .= $self->{defs}->{$key}->to_svg();\r
        }\r
    }\r
    return $s;\r
}\r
\r
sub get_svg {\r
    my $self = shift;\r
    my $s    = '<?xml version="1.0" encoding="iso-8859-1"?>';\r
    $s .= "\n" . $self->{dtd} . "\n";\r
    $s .= "<svg width=\""\r
      . $self->{width}\r
      . "\" height=\""\r
      . $self->{height} . "\">";\r
    if ( %{ $self->{defs} } ) {\r
        $s .= "\n" . '<defs>' . "\n";\r
\r
        #  for ( my $i = 0 ; $i < @{ $self->{defs} } ; $i++ ) {\r
        #            $s .= ${ $self->{defs} }[$i]->to_svg();\r
        #        }\r
        $s .= $self->_get_defs();\r
        $s .= "\n" . '</defs>' . "\n";\r
    }\r
    $s .= $self->{_temp};\r
    $s .= "\n" . '</svg>';\r
    return $s;\r
}\r
\r
sub draw_polyline {\r
    my @args = @_;\r
    my $self = $args[0];\r
    my @x    = @{ $args[1] };\r
    my @y    = @{ $args[2] };\r
\r
    my $s = '<polyline style="fill:none; ';\r
    $s .= $self->get_paint()->to_svg() . " ";\r
    if ( $self->get_stroke() ) {\r
        $s .= $self->get_stroke()->to_svg() . "\" ";\r
    }\r
    else {\r
        $s .= Pastel::BasicStroke()->to_svg() . "\" ";\r
    }\r
    $s .= 'points="';\r
\r
    for ( my $i = 0 ; $i < @x ; $i++ ) {\r
        $s .= $x[$i] . "," . $y[$i];\r
        if ( $i != ( scalar(@x) - 1 ) ) {\r
            $s .= " ";\r
        }\r
    }\r
\r
    #  my $s .= '<path style="fill:none; ';\r
    #  $s .= $self->get_paint()->to_svg();\r
    #  $s .= " ".$self->get_stroke()->to_svg()."\" ";\r
    #  $s .= 'd="M'.$x[0].",".$y[0]." ";\r
    #  for ( my $i=0; $i < @x; $i++){\r
    #    $s .= "L".$x[$i].",".$y[$i];\r
    #    if( $i != (scalar(@x) - 1)){\r
    #      $s .=" ";\r
    #    }\r
    #  }\r
\r
    $s .= '" />';\r
    $self->{_temp} .= $s . "\n";\r
}\r
\r
sub draw_line {\r
    my ( $self, @args ) = @_;\r
    if ( @args < 4 ) {\r
        croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r
    }\r
    my $color  = $self->get_paint()->to_svg_stroke();\r
    my $stroke = $self->get_stroke()->to_svg();\r
    $self->{_temp} .=\r
qq(<line x1="$args[0]" y1="$args[1]" x2="$args[2]" y2="$args[3]" style="fill:none; $color $stroke" />);\r
}\r
\r
sub draw_oval {\r
    my ( $self, @args ) = @_;\r
    if ( @args < 4 ) {\r
        croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r
    }\r
    my $color  = $self->get_paint()->to_svg_stroke();\r
    my $stroke = $self->get_stroke()->to_svg();\r
\r
    my $cx = $args[0] + ( $args[2] / 2 );\r
    my $cy = $args[1] + ( $args[3] / 2 );\r
    my $rx = $args[2] / 2;\r
    my $ry = $args[3] / 2;\r
    $self->{_temp} .=\r
qq(<ellipse cx="$cx" cy="$cy" rx="$rx" ry="$ry" style="fill:none; $color $stroke" />);\r
}\r
\r
sub fill_oval {\r
    my ( $self, @args ) = @_;\r
    if ( @args < 4 ) {\r
        croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r
    }\r
    my $color  = $self->get_paint()->to_svg_fill();\r
    my $stroke = $self->get_stroke()->to_svg();\r
\r
    my $cx = $args[0] + ( $args[2] / 2 );\r
    my $cy = $args[1] + ( $args[3] / 2 );\r
    my $rx = $args[2] / 2;\r
    my $ry = $args[3] / 2;\r
    $self->{_temp} .=\r
qq(<ellipse cx="$cx" cy="$cy" rx="$rx" ry="$ry" style="$color $stroke" />);\r
}\r
\r
sub get_height {\r
    return $_[0]->{height};\r
}\r
\r
sub set_height {\r
    if ( $_[1] ) { $_[0]->{height} = $_[1]; }\r
}\r
\r
sub get_width {\r
    return $_[0]->{width};\r
}\r
\r
sub set_width {\r
    if ( $_[1] ) { $_[0]->{width} = $_[1]; }\r
}\r
\r
sub _buffer_add {\r
    my $self = shift;\r
    my $s    = shift;\r
    $self->{_temp} .= $s;\r
}\r
\r
sub _initialize_writer {\r
    my $self   = shift;\r
    my $writer = Pastel::Tools::Writer->new();\r
    return $writer;\r
}\r
\r
sub _print_header {\r
    my $self = shift;\r
    $self->{_writer}->print_svg('<?xml version="1.0" encoding="iso-8859-1"?>');\r
    $self->{_writer}->print_svg( $self->{dtd} );\r
}\r
\r
sub _print_footer {\r
    my $self = shift;\r
    $self->{_writer}->print_svg("</svg>");\r
}\r
\r
sub _print_svg_start {\r
    my $self = shift;\r
    $self->{_writer}->print_svg( "<svg width=\""\r
          . $self->{width}\r
          . "\" height=\""\r
          . $self->{height}\r
          . "\">" );\r
}\r
\r
sub message_err {\r
    my $self    = shift;\r
    my $message = shift;\r
    if ( ( $self->{DEBUG} =~ /^true$/i ) && ( $self->{CGI} ne "true" ) ) {\r
        my $fh = $self->{ERROR_HANDLE};\r
        print $fh "ERROR: $message\n";\r
    }\r
}\r
\r
=head1 SEE ALSO\r
\r
\r
=head1 COPYRIGHTS\r
\r
Copyright (c) 2003 by Malay <curiouser@ccmb.res.in>. All rights reserved.\r
\r
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.\r
\r
=cut\r
\r
1;\r
\r