| 1 | # $Id: Graphics.pm,v 1.13 2003/04/29 18:18:05 malay Exp $\r |
| 2 | # Perl module for Pastel::Graphics\r |
| 3 | # Author: Malay < curiouser@ccmb.res.in >\r |
| 4 | # Copyright (c) 2003 by Malay. All rights reserved.\r |
| 5 | # You may distribute this module under the same terms as perl itself\r |
| 6 | \r |
| 7 | =head1 NAME\r |
| 8 | \r |
| 9 | Pastel::Graphics - Graphics context.\r |
| 10 | \r |
| 11 | =head1 SYNOPSIS\r |
| 12 | \r |
| 13 | use Pastel;\r |
| 14 | \r |
| 15 | my $graphics = Pastel::Graphics->new(...);\r |
| 16 | $graphics->foo();\r |
| 17 | $graphics->bar();\r |
| 18 | \r |
| 19 | $graphics->show(); #dump the graphics on STDOUT\r |
| 20 | \r |
| 21 | -or-\r |
| 22 | \r |
| 23 | my $string = $graphics->get_svg(); # get the graphic as string\r |
| 24 | print $string;\r |
| 25 | \r |
| 26 | =head1 DESCRIPTION\r |
| 27 | \r |
| 28 | C<Pastel::Graphics> is the main workhorse of Pastel. It is equivalent to\r |
| 29 | Java Graphics2D class. Each program first has to create once instance\r |
| 30 | of this class, then call methods on this and lastly dump the whole\r |
| 31 | instance onto STDOUT or get it as string.\r |
| 32 | \r |
| 33 | The class provides the graphics context in that it hold all the\r |
| 34 | necessary informations for drawing any graphics object correctly.\r |
| 35 | \r |
| 36 | All styles like fonts, color and strokes are set into this class by\r |
| 37 | calling appropriate methods. Shapes and Strings are drawn by calling\r |
| 38 | C<draw()> and C<draw_string()> methods. For a tutorial introduction see\r |
| 39 | Pastel programming manual.\r |
| 40 | \r |
| 41 | There are certain shortcut methods that are inbuilt into this\r |
| 42 | module. You can draw shapes without creating additional\r |
| 43 | objects. Notable among these classes of methods are C<draw_3D_rect()>\r |
| 44 | and C<draw_round_rect()> which are not availble from the\r |
| 45 | L<Pastel::Geometry::Rectangle> class.\r |
| 46 | \r |
| 47 | =cut\r |
| 48 | \r |
| 49 | package Pastel::Graphics;\r |
| 50 | @ISA = qw( Pastel::Mixin::Mixin); # requires _rearrange() function\r |
| 51 | use strict;\r |
| 52 | use Carp;\r |
| 53 | \r |
| 54 | my $_width = "800"; #Width of the SVG document\r |
| 55 | my $_height = "600"; #Height of the SVG document\r |
| 56 | \r |
| 57 | my $_dtd =\r |
| 58 | '<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20001102//EN" "http://www.w3.org/TR/2000/CR-SVG-20001102/DTD/svg-20001102.dtd">';\r |
| 59 | \r |
| 60 | sub new {\r |
| 61 | my $arg = shift;\r |
| 62 | my $class = ref($arg) || $arg;\r |
| 63 | my $self = {};\r |
| 64 | bless $self, $class;\r |
| 65 | \r |
| 66 | $self->_init(@_);\r |
| 67 | \r |
| 68 | return $self;\r |
| 69 | \r |
| 70 | }\r |
| 71 | \r |
| 72 | =head1 CONSTRUCTOR\r |
| 73 | \r |
| 74 | =head2 new()\r |
| 75 | \r |
| 76 | Creates and returns a new C<Pastel::Graphics> object.\r |
| 77 | \r |
| 78 | Usage : $graphics = Pastel::Graphics->new(-width=>$w,\r |
| 79 | -height=>$h,\r |
| 80 | -DTD =>$dtd );\r |
| 81 | \r |
| 82 | Args : $w - Optional. Width of the SVG document in pixels. If not\r |
| 83 | provided default is 800.\r |
| 84 | $h - Optional. Height of the SVG document in pixels. If not\r |
| 85 | provided the default is 600.\r |
| 86 | $dtd - Optional. DTD used for SVG document. You can pass your\r |
| 87 | own DTD.\r |
| 88 | \r |
| 89 | Returns: Pastel::Graphics object\r |
| 90 | \r |
| 91 | =cut\r |
| 92 | \r |
| 93 | sub _init {\r |
| 94 | \r |
| 95 | my ( $self, @args ) = @_;\r |
| 96 | \r |
| 97 | my ( $w, $h, $dtd, $cgi ) =\r |
| 98 | $self->_rearrange( [ "WIDTH", "HEIGHT", "DTD", "CGI" ], @args );\r |
| 99 | \r |
| 100 | $self->{width} = defined($w) ? $w : $_width;\r |
| 101 | $self->{height} = defined($h) ? $h : $_height;\r |
| 102 | $self->{dtd} = defined($dtd) ? $dtd : $_dtd;\r |
| 103 | $self->{CGI} = defined($cgi) ? $cgi : "true";\r |
| 104 | $self->{_temp} = ""; # To store SVG elements\r |
| 105 | $self->{_defs} = ""; # To store DEFS\r |
| 106 | $self->{_writer} = $self->_initialize_writer();\r |
| 107 | $self->{paint} = undef;\r |
| 108 | $self->{stroke} = undef;\r |
| 109 | $self->{defs} = {};\r |
| 110 | }\r |
| 111 | \r |
| 112 | =head1 METHODS\r |
| 113 | \r |
| 114 | \r |
| 115 | =head2 set_font()\r |
| 116 | \r |
| 117 | Set the font for all the graphics object. Any string drawn using\r |
| 118 | C<draw_string()> after calling this method will be drawn using the\r |
| 119 | font presently set using this method. Note that\r |
| 120 | C<Pastel::Text::AttributedString> objects are immune to font\r |
| 121 | context. To set the font of C<Pastel::Text::AttributedString> you need\r |
| 122 | to set the font by setting it as attribute of the C<AttributedString>\r |
| 123 | object.\r |
| 124 | \r |
| 125 | Usage : set_font($font)\r |
| 126 | \r |
| 127 | Args : $font is a Pastel::Font object. \r |
| 128 | \r |
| 129 | Returns : Nothing. \r |
| 130 | \r |
| 131 | =cut\r |
| 132 | \r |
| 133 | sub set_font {\r |
| 134 | my ( $self, $arg ) = @_;\r |
| 135 | $self->{"font"} = $arg;\r |
| 136 | return $self;\r |
| 137 | \r |
| 138 | # my ($self,%arg) = @_;\r |
| 139 | # if(defined ($arg{FAMILY})){$self->{FONT_FAMILY} = $arg{FAMILY};}\r |
| 140 | # if(defined ($arg{SIZE})){$self->{FONT_SIZE} = $arg{SIZE};}\r |
| 141 | # if(defined($arg{COLOR})){$self->{FONT_COLOR} = $arg{COLOR};}\r |
| 142 | # if(defined($arg{WEIGHT})){$self->{FONT_WEIGHT} = $arg{WEIGHT};}\r |
| 143 | # return $self;\r |
| 144 | }\r |
| 145 | \r |
| 146 | sub set_fill_color {\r |
| 147 | my $self = shift;\r |
| 148 | $self->{COLOR} = shift;\r |
| 149 | return $self;\r |
| 150 | }\r |
| 151 | \r |
| 152 | =head2 set_paint()\r |
| 153 | \r |
| 154 | Sets the color of the graphics context. Any drawing of shapes or text\r |
| 155 | will be carried out using the color presently set in the graphics\r |
| 156 | context. The color can be solid color of Pastel::Color object or a\r |
| 157 | gradient implementing Pastel::GradientI interface.\r |
| 158 | \r |
| 159 | Usage : set_paint($color)\r |
| 160 | \r |
| 161 | Args : $color is a Pastel::Color or Pastel::GradientI object.\r |
| 162 | \r |
| 163 | Returns : Nothing. \r |
| 164 | \r |
| 165 | =cut\r |
| 166 | \r |
| 167 | sub set_paint {\r |
| 168 | my $self = shift;\r |
| 169 | $self->{paint} = $_[0];\r |
| 170 | }\r |
| 171 | \r |
| 172 | =head2 set_stroke()\r |
| 173 | \r |
| 174 | If the current graphics context has the stroke object set then all\r |
| 175 | further drawings will be stroked. The stroke color will be the current\r |
| 176 | color set using C<set_paint()> method. The swith off the stroking you\r |
| 177 | need to unset the stroke by calling this method without any argument.\r |
| 178 | \r |
| 179 | Because stroking is done using the current color set in the graphics\r |
| 180 | context, to draw an object with both stroke and fill where the\r |
| 181 | stroke-color and the fill-color are different, you need to fill the\r |
| 182 | object first and set a different color before you draw the object. To\r |
| 183 | draw a rectangle with blue border and red fill you might do this:\r |
| 184 | \r |
| 185 | $g = Pastel::Graphics->new();\r |
| 186 | $g->set_paint(Pastel::Color->red());\r |
| 187 | $g->set_stroke( Pastel::BasicStroke->new(-width=>5) );\r |
| 188 | my $rect = Pastel::Geometry::Rectangle(\r |
| 189 | -x=>20,-y=>30,\r |
| 190 | -width=>100,-height=>150\r |
| 191 | );\r |
| 192 | $g->fill($rect); # filled with red color\r |
| 193 | $g->set_paint(Pastel::Color->blue());\r |
| 194 | $g->draw($rect);\r |
| 195 | \r |
| 196 | Usage : set_stroke($stroke) # set the stroke object\r |
| 197 | set_stroke() # unset stroking\r |
| 198 | \r |
| 199 | Args : $stroke is a Pastel::BasicStroke object.\r |
| 200 | \r |
| 201 | Returns : Nothing. \r |
| 202 | \r |
| 203 | =cut\r |
| 204 | \r |
| 205 | sub set_stroke {\r |
| 206 | my $self = shift;\r |
| 207 | my $arg = shift;\r |
| 208 | \r |
| 209 | #print STDERR "******STROKE called\n";\r |
| 210 | if ( defined($arg) ) {\r |
| 211 | \r |
| 212 | #print "Inside CLEAR\n";\r |
| 213 | $self->{stroke} = $arg;\r |
| 214 | }\r |
| 215 | else {\r |
| 216 | if ( defined( $self->{stroke} ) ) {\r |
| 217 | $self->{stroke} = undef;\r |
| 218 | return;\r |
| 219 | }\r |
| 220 | }\r |
| 221 | \r |
| 222 | }\r |
| 223 | \r |
| 224 | \r |
| 225 | =head2 get_font()\r |
| 226 | \r |
| 227 | Returns the current font object in the graphics context.\r |
| 228 | \r |
| 229 | Usage : get_font();\r |
| 230 | \r |
| 231 | Args : Nothing.\r |
| 232 | \r |
| 233 | Returns : Pastel::Font object. \r |
| 234 | \r |
| 235 | =cut\r |
| 236 | \r |
| 237 | \r |
| 238 | sub get_font {\r |
| 239 | my $self = shift;\r |
| 240 | if ( defined( $self->{font} ) ) {\r |
| 241 | return $self->{font};\r |
| 242 | }\r |
| 243 | else {\r |
| 244 | return undef;\r |
| 245 | }\r |
| 246 | }\r |
| 247 | \r |
| 248 | \r |
| 249 | =head2 get_paint()\r |
| 250 | \r |
| 251 | Returns the current paint object in the graphics context.\r |
| 252 | \r |
| 253 | Usage : $g->get_paint()\r |
| 254 | \r |
| 255 | Args : Nothing.\r |
| 256 | \r |
| 257 | Returns : Pastel::Color or object implementing Pastel::GradientI interface. \r |
| 258 | \r |
| 259 | =cut\r |
| 260 | \r |
| 261 | sub get_paint {\r |
| 262 | my $self = shift;\r |
| 263 | if ( !defined( $self->{paint} ) ) {\r |
| 264 | $self->{paint} = Pastel::Color->black();\r |
| 265 | }\r |
| 266 | return $self->{paint};\r |
| 267 | }\r |
| 268 | \r |
| 269 | =head2 get_stroke()\r |
| 270 | \r |
| 271 | Return the current stroke object in the graphics context. \r |
| 272 | \r |
| 273 | Usage : get_stroke()\r |
| 274 | \r |
| 275 | Args : Nothing.\r |
| 276 | \r |
| 277 | Returns : Pastel::BasicStroke object if stroke is set or undef if not set.\r |
| 278 | \r |
| 279 | =cut\r |
| 280 | \r |
| 281 | sub get_stroke {\r |
| 282 | my $self = shift;\r |
| 283 | if ( !defined( $self->{stroke} ) ) {\r |
| 284 | \r |
| 285 | # $self->{stroke} = Pastel::BasicStroke->new(-width=>1);\r |
| 286 | # return $self->{stroke};\r |
| 287 | return "";\r |
| 288 | }\r |
| 289 | else {\r |
| 290 | return $self->{stroke};\r |
| 291 | }\r |
| 292 | }\r |
| 293 | \r |
| 294 | =head2 draw_rect()\r |
| 295 | \r |
| 296 | Shortcut function to draw a rectangle without creating additional\r |
| 297 | object. The rectangle is stroked with the current C<BasicStroke>\r |
| 298 | object. If the C<BasicStroke> is not set then the rectangle is created\r |
| 299 | using an 1 pixel width line. The color of the line is determined by\r |
| 300 | the current paint.\r |
| 301 | \r |
| 302 | Usage : draw_rect($x, $y, $width, $height)\r |
| 303 | \r |
| 304 | Args : $x - X coordinate of the top left corner vertice of rectangle.\r |
| 305 | $y - Y coordinate of the top left corner vertice of rectangle.\r |
| 306 | $width - Width of the rectangle.\r |
| 307 | $height- Height of the rectangle.\r |
| 308 | \r |
| 309 | Returns : Nothing. \r |
| 310 | \r |
| 311 | =cut\r |
| 312 | \r |
| 313 | sub draw_rect {\r |
| 314 | \r |
| 315 | my $self = shift;\r |
| 316 | my ( $x, $y, $width, $height ) =\r |
| 317 | $self->_rearrange( [ "X", "Y", "WIDTH", "HEIGHT" ], @_ );\r |
| 318 | my $color;\r |
| 319 | if ( $self->get_paint()->isa("Pastel::Color") ) {\r |
| 320 | $color = $self->get_paint()->to_svg_stroke();\r |
| 321 | }\r |
| 322 | else {\r |
| 323 | $color = "stroke:url(" . $self->get_paint()->get_ref() . ');';\r |
| 324 | $self->add_to_defs( $self->get_paint() );\r |
| 325 | }\r |
| 326 | my $stroke =\r |
| 327 | $self->get_stroke()\r |
| 328 | ? $self->get_stroke()\r |
| 329 | : Pastel::BasicStroke->new();\r |
| 330 | \r |
| 331 | my $stroke_style = $stroke->to_svg();\r |
| 332 | \r |
| 333 | my $half_width = $stroke->get_line_width() / 2;\r |
| 334 | $x = $x + $half_width;\r |
| 335 | $y = $y + $half_width;\r |
| 336 | $width = $width - ( 2 * $half_width );\r |
| 337 | $height = $height - ( 2 * $half_width );\r |
| 338 | \r |
| 339 | $self->{_temp} .= (\r |
| 340 | qq(<rect x="$x" y="$y" width="$width" height="$height" style="fill:none; $color$stroke_style" />)\r |
| 341 | );\r |
| 342 | \r |
| 343 | }\r |
| 344 | \r |
| 345 | =head2 fill_rect()\r |
| 346 | \r |
| 347 | Shortcut function to draw a filled rectangle without creating\r |
| 348 | additional objects. The rectangle is filled with the current paint in\r |
| 349 | the graphics context.\r |
| 350 | \r |
| 351 | Usage : fill_rect($x, $y, $width, $height);\r |
| 352 | \r |
| 353 | Args : $x - X coordinate of the top left corner of the rectangle.\r |
| 354 | $y - Y coordinate of the top left corner of the rectangle.\r |
| 355 | $width - Width of the rectangle in pixels.\r |
| 356 | $height- Height of the rectangle in pixels.\r |
| 357 | \r |
| 358 | Returns : Nothing\r |
| 359 | \r |
| 360 | =cut\r |
| 361 | \r |
| 362 | sub fill_rect {\r |
| 363 | my $self = shift;\r |
| 364 | \r |
| 365 | # my $color = $self->get_paint()->to_svg_fill();\r |
| 366 | my $color;\r |
| 367 | if ( $self->get_paint()->isa("Pastel::Color") ) {\r |
| 368 | $color = $self->get_paint()->to_svg_fill();\r |
| 369 | }\r |
| 370 | else {\r |
| 371 | $color = "fill:url(" . $self->get_paint()->get_ref() . ')';\r |
| 372 | $self->add_to_defs( $self->get_paint() );\r |
| 373 | }\r |
| 374 | \r |
| 375 | my ( $x, $y, $width, $height ) =\r |
| 376 | $self->_rearrange( [ "X", "Y", "WIDTH", "HEIGHT" ], @_ );\r |
| 377 | $self->{_temp} .= (\r |
| 378 | qq(<rect x="$x" y="$y" width="$width" height="$height" style="$color;stroke:none"/>)\r |
| 379 | );\r |
| 380 | \r |
| 381 | }\r |
| 382 | \r |
| 383 | =head2 draw_round_rect()\r |
| 384 | \r |
| 385 | Shortcut fuction to draw open rectangle with rounded corners. The\r |
| 386 | rectangle is stroked with the current stroke if it is set. Otherwise\r |
| 387 | it is drawn with 1 pixel width line. The color is determined by the\r |
| 388 | current paint object.\r |
| 389 | \r |
| 390 | Usage : draw_round_rect($x, $y, $width, $height,\r |
| 391 | $arc_width, $arc_height);\r |
| 392 | \r |
| 393 | Args : $x - X coordinate of the top left hand corner.\r |
| 394 | $y - Y coordinate of the top left hand corner.\r |
| 395 | $width - Width of the rectangle.\r |
| 396 | $height - Height of the rectangle.\r |
| 397 | $arc_width - Horizontal diameter of the arc at the four corners.\r |
| 398 | $arc_height - vertical diameter of the arc at the four corners.\r |
| 399 | \r |
| 400 | Returns : Nothing\r |
| 401 | \r |
| 402 | =cut\r |
| 403 | \r |
| 404 | sub draw_round_rect {\r |
| 405 | my ( $self, @args ) = @_;\r |
| 406 | \r |
| 407 | if ( @args < 6 ) {\r |
| 408 | croak 'Missing parameter in Pastel::Graphics::draw_round_rect()!\n';\r |
| 409 | }\r |
| 410 | \r |
| 411 | #my $paint = $self->get_paint()->to_svg_stroke();\r |
| 412 | my $paint;\r |
| 413 | if ( $self->get_paint()->isa("Pastel::Color") ) {\r |
| 414 | $paint = $self->get_paint()->to_svg_stroke();\r |
| 415 | }\r |
| 416 | else {\r |
| 417 | $paint = "stroke:url(" . $self->get_paint()->get_ref() . ');';\r |
| 418 | $self->add_to_defs( $self->get_paint() );\r |
| 419 | }\r |
| 420 | \r |
| 421 | my $stroke =\r |
| 422 | $self->get_stroke()\r |
| 423 | ? $self->get_stroke()\r |
| 424 | : Pastel::BasicStroke->new();\r |
| 425 | \r |
| 426 | my $half_width = $stroke->get_line_width() / 2;\r |
| 427 | \r |
| 428 | my $stroke_style = $stroke->to_svg();\r |
| 429 | my $x = $args[0] + $half_width;\r |
| 430 | my $y = $args[1] + $half_width;\r |
| 431 | my $width = $args[2] - ( 2 * $half_width );\r |
| 432 | my $height = $args[3] - ( 2 * $half_width );\r |
| 433 | \r |
| 434 | $self->{_temp} .=\r |
| 435 | qq(<rect x="$x" y="$y" width="$width" height="$height" rx="$args[4]" ry="$args[4]" style="fill:none;$paint$stroke_style" />);\r |
| 436 | \r |
| 437 | }\r |
| 438 | \r |
| 439 | =head2 draw_fill_round_rect()\r |
| 440 | \r |
| 441 | Draws a filled rectangle with rounded corners. The rectangle is filled\r |
| 442 | with the current paint object in the graphics context.\r |
| 443 | \r |
| 444 | Usage : $g->draw_fill_round_rect($x, $y, $width, $height,\r |
| 445 | $arc_width, $arc_height);\r |
| 446 | \r |
| 447 | Args : $x - X coordinate of the top left hand corner.\r |
| 448 | $y - Y coordinate of the top left hand corner.\r |
| 449 | $width - Width of the rectangle.\r |
| 450 | $height - Height of the rectangle.\r |
| 451 | $arc_width - Horizontal diameter of the arc at the four corners.\r |
| 452 | $arc_height - vertical diameter of the arc at the four corners.\r |
| 453 | \r |
| 454 | \r |
| 455 | Returns : Nothing\r |
| 456 | \r |
| 457 | =cut\r |
| 458 | \r |
| 459 | sub draw_fill_round_rect {\r |
| 460 | my ( $self, @args ) = @_;\r |
| 461 | \r |
| 462 | if ( @args < 6 ) {\r |
| 463 | croak 'Missing parameter in Pastel::Graphics::draw_fillround_rect()!\n';\r |
| 464 | }\r |
| 465 | \r |
| 466 | # my $paint = $self->get_paint()->to_svg_fill();\r |
| 467 | my $paint;\r |
| 468 | if ( $self->get_paint()->isa("Pastel::Color") ) {\r |
| 469 | $paint = $self->get_paint()->to_svg_fill();\r |
| 470 | }\r |
| 471 | else {\r |
| 472 | $paint = "fill:url(" . $self->get_paint()->get_ref() . ')';\r |
| 473 | $self->add_to_defs( $self->get_paint() );\r |
| 474 | }\r |
| 475 | \r |
| 476 | # my $stroke = $self->get_stroke()->to_svg();\r |
| 477 | \r |
| 478 | $self->{_temp} .=\r |
| 479 | qq(<rect x="$args[0]" y="$args[1]" width="$args[2]" height="$args[3]" rx="$args[4]" ry="$args[4]" style="$paint" />);\r |
| 480 | \r |
| 481 | }\r |
| 482 | \r |
| 483 | =head2 draw_3D_rect()\r |
| 484 | \r |
| 485 | Draws a highlighted 3D effect rectangle. \r |
| 486 | \r |
| 487 | Usage : $g->draw_3D_rect($x, $y, $width, $height, $raised, $bevel);\r |
| 488 | \r |
| 489 | Args : $x - Top left corner X coordinate of the rectangle.\r |
| 490 | $y - Top left corner Y coordinate of the rectangle.\r |
| 491 | $width - Width of the rectangle.\r |
| 492 | $height - Height of the rectangle.\r |
| 493 | $raised - Optional. Takes value "true" or "false". Default "true". \r |
| 494 | $bevel - Optional. Width of the bevel. Default 1.\r |
| 495 | \r |
| 496 | Returns : Nothing\r |
| 497 | \r |
| 498 | =cut\r |
| 499 | \r |
| 500 | sub draw_3D_rect {\r |
| 501 | my ( $self, @args ) = @_;\r |
| 502 | if ( @args < 4 ) {\r |
| 503 | croak 'Missing parameter in Pastel::Graphics::draw_3D_rect()!\n';\r |
| 504 | }\r |
| 505 | my $raised;\r |
| 506 | \r |
| 507 | if ( $args[4] && ( $args[4] =~ /true/i ) ) {\r |
| 508 | $raised = 1;\r |
| 509 | }\r |
| 510 | else {\r |
| 511 | $raised = 0;\r |
| 512 | }\r |
| 513 | \r |
| 514 | my $bevel = 1;\r |
| 515 | if ( $args[5] ) {\r |
| 516 | $bevel = $args[5];\r |
| 517 | }\r |
| 518 | my ( $x, $y, $width, $height ) = (@args);\r |
| 519 | \r |
| 520 | # print "***@args\n";\r |
| 521 | my $before_color = $self->get_paint();\r |
| 522 | my $current_color = $before_color;\r |
| 523 | \r |
| 524 | if ( !$before_color->isa("Pastel::Color") ) {\r |
| 525 | $current_color = Pastel::Color->black();\r |
| 526 | }\r |
| 527 | \r |
| 528 | my $brighter = $current_color->brighter();\r |
| 529 | my $darker = $current_color->darker();\r |
| 530 | \r |
| 531 | my $s = "<path d=\"";\r |
| 532 | $self->set_paint( $raised ? $brighter : $darker );\r |
| 533 | \r |
| 534 | $s .= "M" . $x . " " . $y;\r |
| 535 | $s .= "L" . eval( $x + $width ) . " " . $y;\r |
| 536 | $s .= "L" . eval( $x + $width - $bevel ) . " " . eval( $y + $bevel );\r |
| 537 | $s .= "H" . eval( $x + $bevel );\r |
| 538 | $s .= "V" . eval( $y + $height - $bevel );\r |
| 539 | $s .= "L" . $x . " " . eval( $y + $height );\r |
| 540 | $s .= "z" . "\" ";\r |
| 541 | \r |
| 542 | $s .= "style=\"" . $self->get_paint()->to_svg_fill() . "\" />";\r |
| 543 | \r |
| 544 | $self->set_paint( $raised ? $darker : $brighter );\r |
| 545 | $s .= "<path d=\"";\r |
| 546 | $s .= "M" . $x . " " . eval( $y + $height );\r |
| 547 | $s .= "L" . eval( $x + $bevel ) . " " . eval( $y + $height - $bevel );\r |
| 548 | $s .= "H" . eval( $x + $width - $bevel );\r |
| 549 | $s .= "V" . eval( $y + $bevel );\r |
| 550 | $s .= "L" . eval( $x + $width ) . " " . $y;\r |
| 551 | $s .= "V" . eval( $y + $height );\r |
| 552 | $s .= "z" . "\" style=\"" . $self->get_paint()->to_svg_fill() . "\" />";\r |
| 553 | \r |
| 554 | $self->_buffer_add($s);\r |
| 555 | \r |
| 556 | # $self->fill_rect($x + $stroke_width, $y + $height - $stroke_width,\r |
| 557 | # $width -$stroke_width, $stroke_width); $self->fill_rect($x +\r |
| 558 | # $width - $stroke_width, $y , $stroke_width, $height);\r |
| 559 | \r |
| 560 | $self->set_paint($before_color);\r |
| 561 | \r |
| 562 | # my $color = $self->get_paint()->to_svg_stroke();\r |
| 563 | # my $width = $self->get_stroke()->get_line_width();\r |
| 564 | # my $stroke = $self->get_stroke();\r |
| 565 | # $self->set_stroke( Pastel::BasicStroke->new( -width => 1 ) );\r |
| 566 | # if ($raised) {\r |
| 567 | # $self->set_paint( $self->get_paint()->brighter() );\r |
| 568 | # $self->draw_line( $args[0], $args[1], $args[0], $args[1] + $args[3] );\r |
| 569 | # $self->draw_line(\r |
| 570 | # $args[0] + 1,\r |
| 571 | # $args[1], $args[0] + $args[2] - 1,\r |
| 572 | # $args[1]\r |
| 573 | # );\r |
| 574 | # $self->set_paint( $self->get_paint()->darker() );\r |
| 575 | # $self->draw_line(\r |
| 576 | # $args[0] + 1,\r |
| 577 | # $args[1] + $args[3],\r |
| 578 | # $args[0] + $args[2],\r |
| 579 | # $args[1] + $args[3]\r |
| 580 | # );\r |
| 581 | # $self->draw_line(\r |
| 582 | # $args[0] + $args[2],\r |
| 583 | # $args[1],\r |
| 584 | # $args[0] + $args[2],\r |
| 585 | # $args[1] + $args[3] - 1\r |
| 586 | # );\r |
| 587 | # }\r |
| 588 | # else {\r |
| 589 | \r |
| 590 | # # = $color->darker();\r |
| 591 | # }\r |
| 592 | # $self->set_paint($color);\r |
| 593 | # $self->set_stroke($stroke);\r |
| 594 | \r |
| 595 | }\r |
| 596 | \r |
| 597 | =head2 draw()\r |
| 598 | \r |
| 599 | Draws a C<Pastel::Shape> object. The object is stroked using the current\r |
| 600 | stroke object in the graphics context using the current paint object\r |
| 601 | in the graphics context. The method works for any object which is a\r |
| 602 | subclass of C<Pastel::Shape>.\r |
| 603 | \r |
| 604 | If you subclass Pastel::Shape. The child class must implement\r |
| 605 | C<get_shape()> method, which should return an instance of the graphics\r |
| 606 | primitive (classes in C<Pastel::Geometry>).\r |
| 607 | \r |
| 608 | Usage : draw($shape)\r |
| 609 | \r |
| 610 | Args : $shape - an object subclassed from Pastel::Shape. All the\r |
| 611 | classes in Pastel::Geometry are subclass of Pastel::Shape.\r |
| 612 | \r |
| 613 | Returns : Nothing\r |
| 614 | \r |
| 615 | =cut\r |
| 616 | \r |
| 617 | sub draw {\r |
| 618 | my $self = shift;\r |
| 619 | my $ob = shift;\r |
| 620 | my $data;\r |
| 621 | my $shape = $ob;\r |
| 622 | \r |
| 623 | #if (defined ($self->{stroke}) ){\r |
| 624 | #print "***********Stroke defined********\n";\r |
| 625 | #my $stroke = $self->{stroke};\r |
| 626 | #my $stroked_ob = $stroke->create_stroked_shape($ob);\r |
| 627 | #$data = $stroked_$ob->_draw($self);\r |
| 628 | #}\r |
| 629 | #else{\r |
| 630 | if ( $ob->can("get_shape") ) {\r |
| 631 | $shape = $ob->get_shape();\r |
| 632 | }\r |
| 633 | $data = $shape->_draw($self);\r |
| 634 | \r |
| 635 | #}\r |
| 636 | \r |
| 637 | $self->_buffer_add($data);\r |
| 638 | }\r |
| 639 | \r |
| 640 | =head2 draw_string();\r |
| 641 | \r |
| 642 | Draws the string supplied in the co-ordinates specified. Three types\r |
| 643 | of strings can be drawn using this method. Native perl strings can be\r |
| 644 | supplied which will be internally converted into suitable format. The\r |
| 645 | entities are automatically escaped. You can even pass perl unicode\r |
| 646 | strings directly into the method.\r |
| 647 | \r |
| 648 | The methods also accepts C<Pastel::String> objects which are nothing\r |
| 649 | but an XML formatted container for the perl string.\r |
| 650 | \r |
| 651 | In both these above cases the font in which the string will drawn is\r |
| 652 | the current font object in the graphics context. The strings will also\r |
| 653 | be stroked with the current stroke in the graphics context and it will\r |
| 654 | drawn in the current paint color. \r |
| 655 | \r |
| 656 | The method also accepts C<Pastel::Text::AttributedString> object. In\r |
| 657 | Java you pass an C<AttributedCharacterIterator> into this method. In\r |
| 658 | Pastel you pass the C<AttributedString> object\r |
| 659 | itself. C<AttributedString> object are immune to current graphics\r |
| 660 | context. If you want to change the stroke or color of the\r |
| 661 | C<AttributedString> do so in the directly in the object.\r |
| 662 | \r |
| 663 | A major way in which C<Pastel> differs from C<Java2D> is that the\r |
| 664 | coordinates can be arrays of numbers each determining the coordinated\r |
| 665 | of each character in the string. See SVG specification for more\r |
| 666 | details.\r |
| 667 | \r |
| 668 | Usage : draw_string("perl string", $x, $y);\r |
| 669 | draw_string("perl string", \@x, \@y);\r |
| 670 | draw_string( $string,$x, $y);\r |
| 671 | draw_string( $string, \@x, \@y);\r |
| 672 | \r |
| 673 | \r |
| 674 | Args : The method takes 3 arguments. The first argument can be an\r |
| 675 | object of type Pastel::String or a pure perl string or\r |
| 676 | Pastel::Text::AttributedString. The string supplied is converted to\r |
| 677 | XML form automatically. All character code above 126 is converted to\r |
| 678 | "&xff;" form. "<", ">", "&" and other XML entities are automatically\r |
| 679 | created.\r |
| 680 | \r |
| 681 | The second argument can be a single numerical value\r |
| 682 | indicating the X cordinate of the first character of the\r |
| 683 | string or the middle of the total length of the string or the\r |
| 684 | last character depending on text anchoring. This argument\r |
| 685 | also be a reference to an array indicating the X coordinates\r |
| 686 | of successive characters in the string.\r |
| 687 | \r |
| 688 | The third argument can be a single numerical or a reference\r |
| 689 | to an array of numericals indicating the Y coordinate of the\r |
| 690 | baseline of the glyph used for drawing the font.\r |
| 691 | \r |
| 692 | =cut\r |
| 693 | \r |
| 694 | sub draw_string {\r |
| 695 | my ( $self, @args ) = @_;\r |
| 696 | my ( $string, $x, $y ) = $self->_rearrange( [ "TEXT", "X", "Y" ], @args );\r |
| 697 | \r |
| 698 | my $data = ""; #Holds the SVG string;\r |
| 699 | \r |
| 700 | unless ( ( defined($string) ) && ( defined($x) ) && ( defined($y) ) ) {\r |
| 701 | print 'Error: Graphics::drawstring(): Argument missing', "\n";\r |
| 702 | return;\r |
| 703 | }\r |
| 704 | \r |
| 705 | if ( $string->isa("Pastel::Text::AttributedString") ) {\r |
| 706 | \r |
| 707 | #print STDERR "AttributedString supplied\n";\r |
| 708 | $string->set_x($x);\r |
| 709 | $string->set_y($y);\r |
| 710 | $data = $string->to_svg();\r |
| 711 | }\r |
| 712 | \r |
| 713 | # If $string is a string object calls its draw method\r |
| 714 | elsif ( ref($string) =~ m/String/ ) {\r |
| 715 | \r |
| 716 | $string->set_x($x);\r |
| 717 | $string->set_y($y);\r |
| 718 | \r |
| 719 | if ( defined( $self->{font} ) ) { # If the graphics object has a font\r |
| 720 | # First fontify it\r |
| 721 | $string->set_font( $self->get_font() );\r |
| 722 | $data = $string->draw($self);\r |
| 723 | \r |
| 724 | }\r |
| 725 | else {\r |
| 726 | $data = $string->draw($self);\r |
| 727 | }\r |
| 728 | }\r |
| 729 | \r |
| 730 | # If $string is a perl string, create a string object, fontify it\r |
| 731 | # by passing it to the font object and then call its draw method\r |
| 732 | else {\r |
| 733 | my $string = Pastel::String->new($string);\r |
| 734 | $string->set_x($x);\r |
| 735 | $string->set_y($y);\r |
| 736 | \r |
| 737 | if ( defined( $self->{font} ) ) { # If the graphics object has font\r |
| 738 | \r |
| 739 | # Set the font object of the String\r |
| 740 | my $fontified = $string->set_font( $self->{font} );\r |
| 741 | $data = $fontified->draw($self);\r |
| 742 | }\r |
| 743 | else { # If the graphics object doesn't have font object set\r |
| 744 | $data = $string->draw($self); # Just call the draw method\r |
| 745 | }\r |
| 746 | }\r |
| 747 | \r |
| 748 | $self->_buffer_add($data); # Add the data to the print buffer\r |
| 749 | \r |
| 750 | }\r |
| 751 | \r |
| 752 | =head2 show()\r |
| 753 | \r |
| 754 | Dumps the graphics object as SVG on STDOUT.\r |
| 755 | \r |
| 756 | Usage : show()\r |
| 757 | \r |
| 758 | Args : Nothing.\r |
| 759 | \r |
| 760 | Returns : Nothing.\r |
| 761 | \r |
| 762 | =cut\r |
| 763 | \r |
| 764 | sub show {\r |
| 765 | my $self = shift;\r |
| 766 | my $writer = $self->{_writer};\r |
| 767 | $self->_print_header();\r |
| 768 | $self->_print_svg_start();\r |
| 769 | \r |
| 770 | if ( %{ $self->{defs} } ) {\r |
| 771 | $writer->print_svg('<defs>');\r |
| 772 | \r |
| 773 | # for ( my $i = 0 ; $i < @{ $self->{defs} } ; $i++ ) {\r |
| 774 | # $writer->print_svg( ${ $self->{defs} }[$i]->to_svg() );\r |
| 775 | # }\r |
| 776 | $writer->print_svg( $self->_get_defs() );\r |
| 777 | $writer->print_svg('</defs>');\r |
| 778 | }\r |
| 779 | \r |
| 780 | $writer->print_svg( $self->{_temp} );\r |
| 781 | $self->_print_footer();\r |
| 782 | }\r |
| 783 | \r |
| 784 | \r |
| 785 | sub fill {\r |
| 786 | my $self = shift;\r |
| 787 | \r |
| 788 | my $shape = shift;\r |
| 789 | \r |
| 790 | if ( !$shape->isa("Pastel::Shape") ) {\r |
| 791 | croak 'Error: Only a shape can be filled by Pastel::Graphics->fill()';\r |
| 792 | }\r |
| 793 | \r |
| 794 | $shape->set_fill( $self->get_paint() );\r |
| 795 | }\r |
| 796 | \r |
| 797 | sub add_to_defs {\r |
| 798 | my $self = shift;\r |
| 799 | my $object = shift;\r |
| 800 | \r |
| 801 | # ${ $self->{defs} }[ @{ $self->{defs} } ] = $object;\r |
| 802 | # to keep only the unique element we just add the object with an id\r |
| 803 | my $id = $object->get_id();\r |
| 804 | $self->{defs}->{id} = $object;\r |
| 805 | }\r |
| 806 | \r |
| 807 | sub _get_defs {\r |
| 808 | my $self = shift;\r |
| 809 | my $s = "";\r |
| 810 | if ( %{ $self->{defs} } ) {\r |
| 811 | foreach my $key ( keys %{ $self->{defs} } ) {\r |
| 812 | $s .= $self->{defs}->{$key}->to_svg();\r |
| 813 | }\r |
| 814 | }\r |
| 815 | return $s;\r |
| 816 | }\r |
| 817 | \r |
| 818 | sub get_svg {\r |
| 819 | my $self = shift;\r |
| 820 | my $s = '<?xml version="1.0" encoding="iso-8859-1"?>';\r |
| 821 | $s .= "\n" . $self->{dtd} . "\n";\r |
| 822 | $s .= "<svg width=\""\r |
| 823 | . $self->{width}\r |
| 824 | . "\" height=\""\r |
| 825 | . $self->{height} . "\">";\r |
| 826 | if ( %{ $self->{defs} } ) {\r |
| 827 | $s .= "\n" . '<defs>' . "\n";\r |
| 828 | \r |
| 829 | # for ( my $i = 0 ; $i < @{ $self->{defs} } ; $i++ ) {\r |
| 830 | # $s .= ${ $self->{defs} }[$i]->to_svg();\r |
| 831 | # }\r |
| 832 | $s .= $self->_get_defs();\r |
| 833 | $s .= "\n" . '</defs>' . "\n";\r |
| 834 | }\r |
| 835 | $s .= $self->{_temp};\r |
| 836 | $s .= "\n" . '</svg>';\r |
| 837 | return $s;\r |
| 838 | }\r |
| 839 | \r |
| 840 | sub draw_polyline {\r |
| 841 | my @args = @_;\r |
| 842 | my $self = $args[0];\r |
| 843 | my @x = @{ $args[1] };\r |
| 844 | my @y = @{ $args[2] };\r |
| 845 | \r |
| 846 | my $s = '<polyline style="fill:none; ';\r |
| 847 | $s .= $self->get_paint()->to_svg() . " ";\r |
| 848 | if ( $self->get_stroke() ) {\r |
| 849 | $s .= $self->get_stroke()->to_svg() . "\" ";\r |
| 850 | }\r |
| 851 | else {\r |
| 852 | $s .= Pastel::BasicStroke()->to_svg() . "\" ";\r |
| 853 | }\r |
| 854 | $s .= 'points="';\r |
| 855 | \r |
| 856 | for ( my $i = 0 ; $i < @x ; $i++ ) {\r |
| 857 | $s .= $x[$i] . "," . $y[$i];\r |
| 858 | if ( $i != ( scalar(@x) - 1 ) ) {\r |
| 859 | $s .= " ";\r |
| 860 | }\r |
| 861 | }\r |
| 862 | \r |
| 863 | # my $s .= '<path style="fill:none; ';\r |
| 864 | # $s .= $self->get_paint()->to_svg();\r |
| 865 | # $s .= " ".$self->get_stroke()->to_svg()."\" ";\r |
| 866 | # $s .= 'd="M'.$x[0].",".$y[0]." ";\r |
| 867 | # for ( my $i=0; $i < @x; $i++){\r |
| 868 | # $s .= "L".$x[$i].",".$y[$i];\r |
| 869 | # if( $i != (scalar(@x) - 1)){\r |
| 870 | # $s .=" ";\r |
| 871 | # }\r |
| 872 | # }\r |
| 873 | \r |
| 874 | $s .= '" />';\r |
| 875 | $self->{_temp} .= $s . "\n";\r |
| 876 | }\r |
| 877 | \r |
| 878 | sub draw_line {\r |
| 879 | my ( $self, @args ) = @_;\r |
| 880 | if ( @args < 4 ) {\r |
| 881 | croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r |
| 882 | }\r |
| 883 | my $color = $self->get_paint()->to_svg_stroke();\r |
| 884 | my $stroke = $self->get_stroke()->to_svg();\r |
| 885 | $self->{_temp} .=\r |
| 886 | qq(<line x1="$args[0]" y1="$args[1]" x2="$args[2]" y2="$args[3]" style="fill:none; $color $stroke" />);\r |
| 887 | }\r |
| 888 | \r |
| 889 | sub draw_oval {\r |
| 890 | my ( $self, @args ) = @_;\r |
| 891 | if ( @args < 4 ) {\r |
| 892 | croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r |
| 893 | }\r |
| 894 | my $color = $self->get_paint()->to_svg_stroke();\r |
| 895 | my $stroke = $self->get_stroke()->to_svg();\r |
| 896 | \r |
| 897 | my $cx = $args[0] + ( $args[2] / 2 );\r |
| 898 | my $cy = $args[1] + ( $args[3] / 2 );\r |
| 899 | my $rx = $args[2] / 2;\r |
| 900 | my $ry = $args[3] / 2;\r |
| 901 | $self->{_temp} .=\r |
| 902 | qq(<ellipse cx="$cx" cy="$cy" rx="$rx" ry="$ry" style="fill:none; $color $stroke" />);\r |
| 903 | }\r |
| 904 | \r |
| 905 | sub fill_oval {\r |
| 906 | my ( $self, @args ) = @_;\r |
| 907 | if ( @args < 4 ) {\r |
| 908 | croak "Missing parameters in Pastel::Graphics::draw_line()!\n";\r |
| 909 | }\r |
| 910 | my $color = $self->get_paint()->to_svg_fill();\r |
| 911 | my $stroke = $self->get_stroke()->to_svg();\r |
| 912 | \r |
| 913 | my $cx = $args[0] + ( $args[2] / 2 );\r |
| 914 | my $cy = $args[1] + ( $args[3] / 2 );\r |
| 915 | my $rx = $args[2] / 2;\r |
| 916 | my $ry = $args[3] / 2;\r |
| 917 | $self->{_temp} .=\r |
| 918 | qq(<ellipse cx="$cx" cy="$cy" rx="$rx" ry="$ry" style="$color $stroke" />);\r |
| 919 | }\r |
| 920 | \r |
| 921 | sub get_height {\r |
| 922 | return $_[0]->{height};\r |
| 923 | }\r |
| 924 | \r |
| 925 | sub set_height {\r |
| 926 | if ( $_[1] ) { $_[0]->{height} = $_[1]; }\r |
| 927 | }\r |
| 928 | \r |
| 929 | sub get_width {\r |
| 930 | return $_[0]->{width};\r |
| 931 | }\r |
| 932 | \r |
| 933 | sub set_width {\r |
| 934 | if ( $_[1] ) { $_[0]->{width} = $_[1]; }\r |
| 935 | }\r |
| 936 | \r |
| 937 | sub _buffer_add {\r |
| 938 | my $self = shift;\r |
| 939 | my $s = shift;\r |
| 940 | $self->{_temp} .= $s;\r |
| 941 | }\r |
| 942 | \r |
| 943 | sub _initialize_writer {\r |
| 944 | my $self = shift;\r |
| 945 | my $writer = Pastel::Tools::Writer->new();\r |
| 946 | return $writer;\r |
| 947 | }\r |
| 948 | \r |
| 949 | sub _print_header {\r |
| 950 | my $self = shift;\r |
| 951 | $self->{_writer}->print_svg('<?xml version="1.0" encoding="iso-8859-1"?>');\r |
| 952 | $self->{_writer}->print_svg( $self->{dtd} );\r |
| 953 | }\r |
| 954 | \r |
| 955 | sub _print_footer {\r |
| 956 | my $self = shift;\r |
| 957 | $self->{_writer}->print_svg("</svg>");\r |
| 958 | }\r |
| 959 | \r |
| 960 | sub _print_svg_start {\r |
| 961 | my $self = shift;\r |
| 962 | $self->{_writer}->print_svg( "<svg width=\""\r |
| 963 | . $self->{width}\r |
| 964 | . "\" height=\""\r |
| 965 | . $self->{height}\r |
| 966 | . "\">" );\r |
| 967 | }\r |
| 968 | \r |
| 969 | sub message_err {\r |
| 970 | my $self = shift;\r |
| 971 | my $message = shift;\r |
| 972 | if ( ( $self->{DEBUG} =~ /^true$/i ) && ( $self->{CGI} ne "true" ) ) {\r |
| 973 | my $fh = $self->{ERROR_HANDLE};\r |
| 974 | print $fh "ERROR: $message\n";\r |
| 975 | }\r |
| 976 | }\r |
| 977 | \r |
| 978 | =head1 SEE ALSO\r |
| 979 | \r |
| 980 | \r |
| 981 | =head1 COPYRIGHTS\r |
| 982 | \r |
| 983 | Copyright (c) 2003 by Malay <curiouser@ccmb.res.in>. All rights reserved.\r |
| 984 | \r |
| 985 | This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.\r |
| 986 | \r |
| 987 | =cut\r |
| 988 | \r |
| 989 | 1;\r |
| 990 | \r |