Mercurial > repos > dereeper > sniploid

comparison GD/Simple.pm @ 0:58111b3965b2 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author dereeper
date Thu, 01 Nov 2012 09:35:05 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:58111b3965b2
1 package GD::Simple;
2
3 =head1 NAME
4
5 GD::Simple - Simplified interface to GD library
6
7 =head1 SYNOPSIS
8
9 use GD::Simple;
10
11 # create a new image
12 $img = GD::Simple->new(400,250);
13
14 # draw a red rectangle with blue borders
15 $img->bgcolor('red');
16 $img->fgcolor('blue');
17 $img->rectangle(10,10,50,50);
18
19 # draw an empty rectangle with green borders
20 $img->bgcolor(undef);
21 $img->fgcolor('green');
22 $img->rectangle(30,30,100,100);
23
24 # move to (80,80) and draw a green line to (100,190)
25 $img->moveTo(80,80);
26 $img->lineTo(100,190);
27
28 # draw a solid orange ellipse
29 $img->moveTo(110,100);
30 $img->bgcolor('orange');
31 $img->fgcolor('orange');
32 $img->ellipse(40,40);
33
34 # draw a black filled arc
35 $img->moveTo(150,150);
36 $img->fgcolor('black');
37 $img->arc(50,50,0,100,gdNoFill|gdEdged);
38
39 # draw a string at (10,180) using the default
40 # built-in font
41 $img->moveTo(10,180);
42 $img->string('This is very simple');
43
44 # draw a string at (280,210) using 20 point
45 # times italic, angled upward 90 degrees
46 $img->moveTo(280,210);
47 $img->font('Times:italic');
48 $img->fontsize(20);
49 $img->angle(-90);
50 $img->string('This is very fancy');
51
52 # some turtle graphics
53 $img->moveTo(300,100);
54 $img->penSize(3,3);
55 $img->angle(0);
56 $img->line(20); # 20 pixels going to the right
57 $img->turn(30); # set turning angle to 30 degrees
58 $img->line(20); # 20 pixel line
59 $img->line(20);
60 $img->line(20);
61 $img->turn(-90); # set turning angle to -90 degrees
62 $img->line(50); # 50 pixel line
63
64 # draw a cyan polygon edged in blue
65 my $poly = new GD::Polygon;
66 $poly->addPt(150,100);
67 $poly->addPt(199,199);
68 $poly->addPt(100,199);
69 $img->bgcolor('cyan');
70 $img->fgcolor('blue');
71 $img->penSize(1,1);
72 $img->polygon($poly);
73
74 # convert into png data
75 print $img->png;
76
77 =head1 DESCRIPTION
78
79 GD::Simple is a subclass of the GD library that shortens many of the
80 long GD method calls by storing information about the pen color, size
81 and position in the GD object itself. It also adds a small number of
82 "turtle graphics" style calls for those who prefer to work in polar
83 coordinates. In addition, the library allows you to use symbolic
84 names for colors, such as "chartreuse", and will manage the colors for
85 you.
86
87 =head2 The Pen
88
89 GD::Simple maintains a "pen" whose settings are used for line- and
90 shape-drawing operations. The pen has the following properties:
91
92 =over 4
93
94 =item fgcolor
95
96 The pen foreground color is the color of lines and the borders of
97 filled and unfilled shapes.
98
99 =item bgcolor
100
101 The pen background color is the color of the contents of filled
102 shapes.
103
104 =item pensize
105
106 The pen size is the width of the pen. Larger sizes draw thicker
107 lines.
108
109 =item position
110
111 The pen position is its current position on the canvas in (X,Y)
112 coordinates.
113
114 =item angle
115
116 When drawing in turtle mode, the pen angle determines the current
117 direction of lines of relative length.
118
119 =item turn
120
121 When drawing in turtle mode, the turn determines the clockwise or
122 counterclockwise angle that the pen will turn before drawing the next
123 line.
124
125 =item font
126
127 The font to use when drawing text. Both built-in bitmapped fonts and
128 TrueType fonts are supported.
129
130 =item fontsize
131
132 The size of the font to use when drawing with TrueType fonts.
133
134 =back
135
136 One sets the position and properties of the pen and then draws. As
137 the drawing progresses, the position of the pen is updated.
138
139 =head2 Methods
140
141 GD::Simple introduces a number of new methods, a few of which have the
142 same name as GD::Image methods, and hence change their behavior. In
143 addition to these new methods, GD::Simple objects support all of the
144 GD::Image methods. If you make a method call that isn't directly
145 supported by GD::Simple, it refers the request to the underlying
146 GD::Image object. Hence one can load a JPEG image into GD::Simple and
147 declare it to be TrueColor by using this call, which is effectively
148 inherited from GD::Image:
149
150 my $img = GD::Simple->newFromJpeg('./myimage.jpg',1);
151
152 The rest of this section describes GD::Simple-specific methods.
153
154 =cut
155
156 use strict;
157 use GD;
158 use GD::Group;
159 use Math::Trig;
160 use Carp 'croak';
161
162 our @ISA = 'Exporter';
163 our @EXPORT = @GD::EXPORT;
164 our @EXPORT_OK = @GD::EXPORT_OK;
165 our $AUTOLOAD;
166
167 my %COLORS;
168 my $IMAGECLASS = 'GD::Image';
169 my $TRANSPARENT;
170
171 sub AUTOLOAD {
172 my $self = shift;
173 my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
174 return if $func_name eq 'DESTROY';
175
176 if (ref $self && exists $self->{gd}) {
177 $self->{gd}->$func_name(@_);
178 } else {
179 my @result = $IMAGECLASS->$func_name(@_);
180 if (UNIVERSAL::isa($result[0],'GD::Image')) {
181 return $self->new($result[0]);
182 } else {
183 return @result;
184 }
185 }
186 }
187
188 =over 4
189
190 =item $img = GD::Simple->new($x,$y [,$truecolor])
191
192 =item $img = GD::Simple->new($gd)
193
194 Create a new GD::Simple object. There are two forms of new(). In the
195 first form, pass the width and height of the desired canvas, and
196 optionally a boolean flag to request a truecolor image. In the second
197 form, pass a previously-created GD::Image object.
198
199 =cut
200
201 # dual-purpose code - beware
202 sub new {
203 my $pack = shift;
204
205 unshift @_,(100,100) if @_ == 0;
206
207 if (@_ >= 2) { # traditional GD::Image->new() call
208 my $gd = $IMAGECLASS->new(@_);
209 my $self = $pack->new($gd);
210 $self->clear;
211 return $self;
212 }
213
214 if (@_ == 1) { # initialize from existing image
215 my $gd = shift;
216 my $self = bless {
217 gd => $gd,
218 xy => [0,0],
219 font => gdSmallFont,
220 fontsize => 9,
221 turningangle => 0,
222 angle => 0,
223 pensize => 1,
224 },$pack;
225 $self->{bgcolor} = $self->translate_color(255,255,255);
226 $self->{fgcolor} = $self->translate_color(0,0,0);
227 return $self;
228 }
229 }
230
231 =item GD::Simple->class('GD');
232
233 =item GD::Simple->class('GD::SVG');
234
235 Select whether new() should use GD or GD::SVG internally. Call
236 GD::Simple->class('GD::SVG') before calling new() if you wish to
237 generate SVG images.
238
239 If future GD subclasses are created, this method will subport them.
240
241 =cut
242
243 sub class {
244 my $pack = shift;
245 if (@_) {
246 $IMAGECLASS = shift;
247 eval "require $IMAGECLASS; 1" or die $@;
248 $IMAGECLASS = "$IMAGECLASS\:\:Image"
249 if $IMAGECLASS eq 'GD::SVG';
250 }
251 $IMAGECLASS;
252 }
253
254 =item $img->moveTo($x,$y)
255
256 This call changes the position of the pen without drawing. It moves
257 the pen to position ($x,$y) on the drawing canvas.
258
259 =cut
260
261 sub moveTo {
262 my $self = shift;
263 croak 'Usage GD::Simple->moveTo($x,$y)' unless @_ == 2;
264 my ($x,$y) = @_;
265 $self->{xy} = [$x,$y];
266 }
267
268 =item $img->move($dx,$dy)
269
270 =item $img->move($dr)
271
272 This call changes the position of the pen without drawing. When called
273 with two arguments it moves the pen $dx pixels to the right and $dy
274 pixels downward. When called with one argument it moves the pen $dr
275 pixels along the vector described by the current pen angle.
276
277 =cut
278
279 sub move {
280 my $self = shift;
281 if (@_ == 1) { # polar coordinates -- this is r
282 $self->{angle} += $self->{turningangle};
283 my $angle = deg2rad($self->{angle});
284 $self->{xy}[0] += $_[0] * cos($angle);
285 $self->{xy}[1] += $_[0] * sin($angle);
286 }
287 elsif (@_ == 2) { # cartesian coordinates
288 $self->{xy}[0] += $_[0];
289 $self->{xy}[1] += $_[1];
290 } else {
291 croak 'Usage GD::Simple->move($dx,$dy) or move($r)';
292 }
293 }
294
295 =item $img->lineTo($x,$y)
296
297 The lineTo() call simultaneously draws and moves the pen. It draws a
298 line from the current pen position to the position defined by ($x,$y)
299 using the current pen size and color. After drawing, the position of
300 the pen is updated to the new position.
301
302 =cut
303
304 sub lineTo {
305 my $self = shift;
306 croak 'Usage GD::Simple->lineTo($x,$y)' unless @_ == 2;
307 $self->gd->line($self->curPos,@_,$self->fgcolor);
308 $self->moveTo(@_);
309 }
310
311 =item $img->line($dx,$dy)
312
313 =item $img->line($dr)
314
315 The line() call simultaneously draws and moves the pen. When called
316 with two arguments it draws a line from the current position of the
317 pen to the position $dx pixels to the right and $dy pixels down. When
318 called with one argument, it draws a line $dr pixels long along the
319 angle defined by the current pen angle.
320
321 =cut
322
323 sub line {
324 my $self = shift;
325 croak 'Usage GD::Simple->line($dx,$dy) or line($r)' unless @_ >= 1;
326 my @curPos = $self->curPos;
327 $self->move(@_);
328 my @newPos = $self->curPos;
329 $self->gd->line(@curPos,@newPos,$self->fgcolor);
330 }
331
332 =item $img->clear
333
334 This method clears the canvas by painting over it with the current
335 background color.
336
337 =cut
338
339 sub clear {
340 my $self = shift;
341 $self->gd->filledRectangle(0,0,$self->getBounds,$self->bgcolor);
342 }
343
344 =item $img->rectangle($x1,$y1,$x2,$y2)
345
346 This method draws the rectangle defined by corners ($x1,$y1),
347 ($x2,$y2). The rectangle's edges are drawn in the foreground color and
348 its contents are filled with the background color. To draw a solid
349 rectangle set bgcolor equal to fgcolor. To draw an unfilled rectangle
350 (transparent inside), set bgcolor to undef.
351
352 =cut
353
354 sub rectangle {
355 my $self = shift;
356 croak 'Usage GD::Simple->rectangle($x1,$y1,$x2,$y2)' unless @_ == 4;
357 my $gd = $self->gd;
358 my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
359 $gd->filledRectangle(@_,$bg) if defined $bg;
360 $gd->rectangle(@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
361 }
362
363 =item $img->ellipse($width,$height)
364
365 This method draws the ellipse centered at the current location with
366 width $width and height $height. The ellipse's border is drawn in the
367 foreground color and its contents are filled with the background
368 color. To draw a solid ellipse set bgcolor equal to fgcolor. To draw
369 an unfilled ellipse (transparent inside), set bgcolor to undef.
370
371 =cut
372
373 sub ellipse {
374 my $self = shift;
375 croak 'Usage GD::Simple->ellipse($width,$height)' unless @_ == 2;
376 my $gd = $self->gd;
377 my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
378 $gd->filledEllipse($self->curPos,@_,$bg) if defined $bg;
379 $gd->ellipse($self->curPos,@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
380 }
381
382 =item $img->arc($cx,$cy,$width,$height,$start,$end [,$style])
383
384 This method draws filled and unfilled arcs. See L<GD> for a
385 description of the arguments. To draw a solid arc (such as a pie
386 wedge) set bgcolor equal to fgcolor. To draw an unfilled arc, set
387 bgcolor to undef.
388
389 =cut
390
391 sub arc {
392 my $self = shift;
393 croak 'Usage GD::Simple->arc($width,$height,$start,$end,$style)' unless @_ >= 4;
394 my ($width,$height,$start,$end,$style) = @_;
395 my $gd = $self->gd;
396 my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
397 my ($cx,$cy) = $self->curPos;
398
399 if ($bg) {
400 my @args = ($cx,$cy,$width,$height,$start,$end,$bg);
401 push @args,$style if defined $style;
402 $gd->filledArc(@args);
403 } else {
404 my @args = ($cx,$cy,$width,$height,$start,$end,$fg);
405 $gd->arc(@args);
406 }
407 }
408
409 =item $img->polygon($poly)
410
411 This method draws filled and unfilled polygon using the current
412 settings of fgcolor for the polygon border and bgcolor for the polygon
413 fill color. See L<GD> for a description of creating polygons. To draw
414 a solid polygon set bgcolor equal to fgcolor. To draw an unfilled
415 polygon, set bgcolor to undef.
416
417 =cut
418
419 sub polygon {
420 my $self = shift;
421 croak 'Usage GD::Simple->polygon($poly)' unless @_ == 1;
422 my $gd = $self->gd;
423 my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
424 $gd->filledPolygon(@_,$bg) if defined $bg;
425 $gd->openPolygon(@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
426 }
427
428 =item $img->polyline($poly)
429
430 This method draws polygons without closing the first and last vertices
431 (similar to GD::Image->unclosedPolygon()). It uses the fgcolor to draw
432 the line.
433
434 =cut
435
436 sub polyline {
437 my $self = shift;
438 croak 'Usage GD::Simple->polyline($poly)' unless @_ == 1;
439 my $gd = $self->gd;
440 my $fg = $self->fgcolor;
441 $gd->unclosedPolygon(@_,$fg);
442 }
443
444 =item $img->string($string)
445
446 This method draws the indicated string starting at the current
447 position of the pen. The pen is moved to the end of the drawn string.
448 Depending on the font selected with the font() method, this will use
449 either a bitmapped GD font or a TrueType font. The angle of the pen
450 will be consulted when drawing the text. For TrueType fonts, any angle
451 is accepted. For GD bitmapped fonts, the angle can be either 0 (draw
452 horizontal) or -90 (draw upwards).
453
454 For consistency between the TrueType and GD font behavior, the string
455 is always drawn so that the current position of the pen corresponds to
456 the bottom left of the first character of the text. This is different
457 from the GD behavior, in which the first character of bitmapped fonts
458 hangs down from the pen point.
459
460 This method returns a polygon indicating the bounding box of the
461 rendered text. If an error occurred (such as invalid font
462 specification) it returns undef and an error message in $@.
463
464 =cut
465
466 sub string {
467 my $self = shift;
468 my $string = shift;
469 my $font = $self->font;
470 my @bounds;
471 if (ref $font && $font->isa('GD::Font')) {
472 my ($x,$y) = $self->curPos;
473 if ($self->angle == -90) {
474 $x -= $font->height;
475 $y -= $font->width;
476 $self->gd->stringUp($font,$x,$y,$string,$self->fgcolor);
477 $self->{xy}[1] -= length($string) * $font->width;
478 @bounds = ( ($self->{xy}[0],$y), ($x,$y), ($x,$self->{xy}[1]-$font->width), ($self->{xy}[0],$self->{xy}[1]-$font->width) );
479 } else {
480 $y -= $font->height;
481 $self->gd->string($font,$x,$y,$string,$self->fgcolor);
482 $self->{xy}[0] += length($string) * $font->width;
483 @bounds = ( ($x,$self->{xy}[1]), ($self->{xy}[0],$self->{xy}[1]), ($self->{xy}[0],$y), ($x,$y) );
484 }
485 }
486 else {
487 $self->useFontConfig(1);
488 @bounds = $self->stringFT($self->fgcolor,$font,
489 $self->fontsize,-deg2rad($self->angle), # -pi * $self->angle/180,
490 $self->curPos,$string);
491 return unless @bounds;
492 my ($delta_x,$delta_y) = $self->_string_width(@bounds);
493 $self->{xy}[0] += $delta_x;
494 $self->{xy}[1] += $delta_y;
495 }
496 my $poly = GD::Polygon->new;
497 while (@bounds) {
498 $poly->addPt(splice(@bounds,0,2));
499 }
500 return $poly;
501 }
502
503 =item $metrics = $img->fontMetrics
504
505 =item ($metrics,$width,$height) = GD::Simple->fontMetrics($font,$fontsize,$string)
506
507 This method returns information about the current font, most commonly
508 a TrueType font. It can be invoked as an instance method (on a
509 previously-created GD::Simple object) or as a class method (on the
510 'GD::Simple' class).
511
512 When called as an instance method, fontMetrics() takes no arguments
513 and returns a single hash reference containing the metrics that
514 describe the currently selected font and size. The hash reference
515 contains the following information:
516
517 xheight the base height of the font from the bottom to the top of
518 a lowercase 'm'
519
520 ascent the length of the upper stem of the lowercase 'd'
521
522 descent the length of the lower step of the lowercase 'j'
523
524 lineheight the distance from the bottom of the 'j' to the top of
525 the 'd'
526
527 leading the distance between two adjacent lines
528
529 =cut
530
531 # return %$fontmetrics
532 # keys: 'ascent', 'descent', 'lineheight', 'xheight', 'leading'
533 sub fontMetrics {
534 my $self = shift;
535
536 unless (ref $self) { #class invocation -- create a scratch
537 $self = $self->new;
538 $self->font(shift) if defined $_[0];
539 $self->fontsize(shift) if defined $_[0];
540 }
541
542 my $font = $self->font;
543 my $metrics;
544
545 if (ref $font && $font->isa('GD::Font')) {
546 my $height = $font->height;
547 $metrics = {ascent => 0,
548 descent => 0,
549 lineheight => $height,
550 xheight => $height,
551 leading => 0};
552 }
553 else {
554 $self->useFontConfig(1);
555 my @mbounds = GD::Image->stringFT($self->fgcolor,$font,
556 $self->fontsize,0,
557 0,0,'m');
558 my $xheight = $mbounds[3]-$mbounds[5];
559 my @jbounds = GD::Image->stringFT($self->fgcolor,$font,
560 $self->fontsize,0,
561 0,0,'j');
562 my $ascent = $mbounds[7]-$jbounds[7];
563 my $descent = $jbounds[3]-$mbounds[3];
564
565 my @mmbounds = GD::Image->stringFT($self->fgcolor,$font,
566 $self->fontsize,0,
567 0,0,"m\nm");
568 my $twolines = $mmbounds[3]-$mmbounds[5];
569 my $lineheight = $twolines - 2*$xheight;
570 my $leading = $lineheight - $ascent - $descent;
571 $metrics = {ascent => $ascent,
572 descent => $descent,
573 lineheight => $lineheight,
574 xheight => $xheight,
575 leading => $leading};
576 }
577
578 if ((my $string = shift) && wantarray) {
579 my ($width,$height) = $self->stringBounds($string);
580 return ($metrics,abs($width),abs($height));
581 }
582 return $metrics;
583 }
584
585 =item ($delta_x,$delta_y)= $img->stringBounds($string)
586
587 This method indicates the X and Y offsets (which may be negative) that
588 will occur when the given string is drawn using the current font,
589 fontsize and angle. When the string is drawn horizontally, it gives
590 the width and height of the string's bounding box.
591
592 =cut
593
594 sub stringBounds {
595 my $self = shift;
596 my $string = shift;
597 my $font = $self->font;
598 if (ref $font && $font->isa('GD::Font')) {
599 if ($self->angle == -90) {
600 return ($font->height,-length($string) * $font->width);
601 } else {
602 return (length($string) * $font->width,$font->height);
603 }
604 }
605 else {
606 $self->useFontConfig(1);
607 my @bounds = GD::Image->stringFT($self->fgcolor,$font,
608 $self->fontsize,-deg2rad($self->angle),
609 $self->curPos,$string);
610 return $self->_string_width(@bounds);
611 }
612 }
613
614 =item $delta_x = $img->stringWidth($string)
615
616 This method indicates the width of the string given the current font,
617 fontsize and angle. It is the same as ($img->stringBounds($string))[0]
618
619 =cut
620
621 sub stringWidth {
622 return ((shift->stringBounds(@_))[0]);
623 }
624
625
626 sub _string_width {
627 my $self = shift;
628 my @bounds = @_;
629 my $delta_x = abs($bounds[2]-$bounds[0]);
630 my $delta_y = abs($bounds[5]-$bounds[3]);
631 my $angle = $self->angle % 360;
632 if ($angle >= 0 && $angle < 90) {
633 return ($delta_x,$delta_y);
634
635 } elsif ($angle >= 90 && $angle < 180) {
636 return (-$delta_x,$delta_y);
637
638 } elsif ($angle >= 180 && $angle < 270) {
639 return (-$delta_x,-$delta_y);
640
641 } elsif ($angle >= 270 && $angle < 360) {
642 return ($delta_x,-$delta_y);
643 }
644 }
645
646 =item ($x,$y) = $img->curPos
647
648 Return the current position of the pen. Set the current position
649 using moveTo().
650
651 =cut
652
653 sub curPos { @{shift->{xy}}; }
654
655 =item $font = $img->font([$newfont] [,$newsize])
656
657 Get or set the current font. Fonts can be GD::Font objects, TrueType
658 font file paths, or fontconfig font patterns like "Times:italic" (see
659 L<fontconfig>). The latter feature requires that you have the
660 fontconfig library installed and are using libgd version 2.0.33 or
661 higher.
662
663 As a shortcut, you may pass two arguments to set the font and the
664 fontsize simultaneously. The fontsize is only valid when drawing with
665 TrueType fonts.
666
667 =cut
668
669 sub font {
670 my $self = shift;
671 $self->{font} = shift if @_;
672 $self->{fontsize} = shift if @_;
673 $self->{font};
674 }
675
676 =item $size = $img->fontsize([$newfontsize])
677
678 Get or set the current font size. This is only valid for TrueType
679 fonts.
680
681 =cut
682
683 sub fontsize {
684 my $self = shift;
685 $self->{fontsize} = shift if @_;
686 $self->{fontsize};
687 }
688
689 =item $size = $img->penSize([$newpensize])
690
691 Get or set the current pen width for use during line drawing
692 operations.
693
694 =cut
695
696 sub penSize {
697 my $self = shift;
698 if (@_) {
699 $self->{pensize} = shift;
700 $self->gd->setThickness($self->{pensize});
701 }
702 $self->{pensize};
703 }
704
705 =item $angle = $img->angle([$newangle])
706
707 Set the current angle for use when calling line() or move() with a
708 single argument.
709
710 Here is an example of using turn() and angle() together to draw an
711 octagon. The first line drawn is the downward-slanting top right
712 edge. The last line drawn is the horizontal top of the octagon.
713
714 $img->moveTo(200,50);
715 $img->angle(0);
716 $img->turn(360/8);
717 for (1..8) { $img->line(50) }
718
719 =cut
720
721 sub angle {
722 my $self = shift;
723 $self->{angle} = shift if @_;
724 $self->{angle};
725 }
726
727 =item $angle = $img->turn([$newangle])
728
729 Get or set the current angle to turn prior to drawing lines. This
730 value is only used when calling line() or move() with a single
731 argument. The turning angle will be applied to each call to line() or
732 move() just before the actual drawing occurs.
733
734 Angles are in degrees. Positive values turn the angle clockwise.
735
736 =cut
737
738 # degrees, not radians
739 sub turn {
740 my $self = shift;
741 $self->{turningangle} = shift if @_;
742 $self->{turningangle};
743 }
744
745 =item $color = $img->fgcolor([$newcolor])
746
747 Get or set the pen's foreground color. The current pen color can be
748 set by (1) using an (r,g,b) triple; (2) using a previously-allocated
749 color from the GD palette; or (3) by using a symbolic color name such
750 as "chartreuse." The list of color names can be obtained using
751 color_names(). The special color name 'transparent' will create a
752 completely transparent color.
753
754 =cut
755
756 sub fgcolor {
757 my $self = shift;
758 $self->{fgcolor} = $self->translate_color(@_) if @_;
759 $self->{fgcolor};
760 }
761
762 =item $color = $img->bgcolor([$newcolor])
763
764 Get or set the pen's background color. The current pen color can be
765 set by (1) using an (r,g,b) triple; (2) using a previously-allocated
766 color from the GD palette; or (3) by using a symbolic color name such
767 as "chartreuse." The list of color names can be obtained using
768 color_names(). The special color name 'transparent' will create a
769 completely transparent color.
770
771 =cut
772
773 sub bgcolor {
774 my $self = shift;
775 $self->{bgcolor} = $self->translate_color(@_) if @_;
776 $self->{bgcolor};
777 }
778
779 =item $index = $img->translate_color(@args)
780
781 Translates a color into a GD palette or TrueColor index. You may pass
782 either an (r,g,b) triple or a symbolic color name. If you pass a
783 previously-allocated index, the method will return it unchanged.
784
785 =cut
786
787 sub translate_color {
788 my $self = shift;
789 return unless defined $_[0];
790 my ($r,$g,$b);
791 if (@_ == 1 && $_[0] =~ /^-?\d+/) { # previously allocated index
792 return $_[0];
793 }
794 elsif (@_ == 3) { # (rgb triplet)
795 ($r,$g,$b) = @_;
796 }
797 elsif (lc $_[0] eq 'transparent') {
798 return $TRANSPARENT ||= $self->alphaColor('white',127);
799 }
800 else {
801 $self->read_color_table unless %COLORS;
802 die "unknown color" unless exists $COLORS{lc $_[0]};
803 ($r,$g,$b) = @{$COLORS{lc $_[0]}};
804 }
805 return $self->colorResolve($r,$g,$b);
806 }
807
808 sub transparent {
809 my $self = shift;
810 my $index = $self->translate_color(@_);
811 $self->gd->transparent($index);
812 }
813
814 =item $index = $img->alphaColor(@args,$alpha)
815
816 Creates an alpha color. You may pass either an (r,g,b) triple or a
817 symbolic color name, followed by an integer indicating its
818 opacity. The opacity value ranges from 0 (fully opaque) to 127 (fully
819 transparent).
820
821 =cut
822
823 sub alphaColor {
824 my $self = shift;
825 return unless defined $_[0];
826 my ($r,$g,$b,$a);
827 if (@_ == 4) { # (rgb triplet)
828 ($r,$g,$b,$a) = @_;
829 } else {
830 $self->read_color_table unless %COLORS;
831 die "unknown color" unless exists $COLORS{lc $_[0]};
832 ($r,$g,$b) = @{$COLORS{lc $_[0]}};
833 $a = $_[1];
834 }
835 return $self->colorAllocateAlpha($r,$g,$b,$a);
836 }
837
838 =item @names = GD::Simple->color_names
839
840 =item $translate_table = GD::Simple->color_names
841
842 Called in a list context, color_names() returns the list of symbolic
843 color names recognized by this module. Called in a scalar context,
844 the method returns a hash reference in which the keys are the color
845 names and the values are array references containing [r,g,b] triples.
846
847 =cut
848
849 sub color_names {
850 my $self = shift;
851 $self->read_color_table unless %COLORS;
852 return wantarray ? sort keys %COLORS : \%COLORS;
853 }
854
855 =item $gd = $img->gd
856
857 Return the internal GD::Image object. Usually you will not need to
858 call this since all GD methods are automatically referred to this object.
859
860 =cut
861
862 sub gd { shift->{gd} }
863
864 sub read_color_table {
865 my $class = shift;
866 while (<DATA>) {
867 chomp;
868 last if /^__END__/;
869 my ($name,$r,$g,$b) = split /\s+/;
870 $COLORS{$name} = [hex $r,hex $g,hex $b];
871 }
872 }
873
874 sub setBrush {
875 my $self = shift;
876 my $brush = shift;
877 if ($brush->isa('GD::Simple')) {
878 $self->gd->setBrush($brush->gd);
879 } else {
880 $self->gd->setBrush($brush);
881 }
882 }
883
884 =item ($red,$green,$blue) = GD::Simple->HSVtoRGB($hue,$saturation,$value)
885
886 Convert a Hue/Saturation/Value (HSV) color into an RGB triple. The
887 hue, saturation and value are integers from 0 to 255.
888
889 =cut
890
891 sub HSVtoRGB {
892 my $self = shift;
893 @_ == 3 or croak "Usage: GD::Simple->HSVtoRGB(\$hue,\$saturation,\$value)";
894
895 my ($h,$s,$v)=@_;
896 my ($r,$g,$b,$i,$f,$p,$q,$t);
897
898 if( $s == 0 ) {
899 ## achromatic (grey)
900 return ($v,$v,$v);
901 }
902 $h %= 255;
903 $s /= 255; ## scale saturation from 0.0-1.0
904 $h /= 255; ## scale hue from 0 to 1.0
905 $h *= 360; ## and now scale it to 0 to 360
906
907 $h /= 60; ## sector 0 to 5
908 $i = $h % 6;
909 $f = $h - $i; ## factorial part of h
910 $p = $v * ( 1 - $s );
911 $q = $v * ( 1 - $s * $f );
912 $t = $v * ( 1 - $s * ( 1 - $f ) );
913
914 if($i<1) {
915 $r = $v;
916 $g = $t;
917 $b = $p;
918 } elsif($i<2){
919 $r = $q;
920 $g = $v;
921 $b = $p;
922 } elsif($i<3){
923 $r = $p;
924 $g = $v;
925 $b = $t;
926 } elsif($i<4){
927 $r = $p;
928 $g = $q;
929 $b = $v;
930 } elsif($i<5){
931 $r = $t;
932 $g = $p;
933 $b = $v;
934 } else {
935 $r = $v;
936 $g = $p;
937 $b = $q;
938 }
939 return (int($r+0.5),int($g+0.5),int($b+0.5));
940 }
941
942 =item ($hue,$saturation,$value) = GD::Simple->RGBtoHSV($hue,$saturation,$value)
943
944 Convert a Red/Green/Blue (RGB) value into a Hue/Saturation/Value (HSV)
945 triple. The hue, saturation and value are integers from 0 to 255.
946
947 =back
948
949 =cut
950
951 sub RGBtoHSV {
952 my $self = shift;
953 my ($r, $g ,$bl) = @_;
954 my ($min,undef,$max) = sort {$a<=>$b} ($r,$g,$bl);
955 return (0,0,0) unless $max > 0;
956
957 my $v = $max;
958 my $s = 255 * ($max - $min)/$max;
959 my $h;
960 my $range = $max - $min;
961
962 if ($range == 0) { # all colors are equal, so monochrome
963 return (0,0,$max);
964 }
965
966 if ($max == $r) {
967 $h = 60 * ($g-$bl)/$range;
968 }
969 elsif ($max == $g) {
970 $h = 60 * ($bl-$r)/$range + 120;
971 }
972 else {
973 $h = 60 * ($r-$g)/$range + 240;
974 }
975
976 $h = int($h*255/360 + 0.5);
977
978 return ($h, $s, $v);
979 }
980
981 sub newGroup {
982 my $self = shift;
983 return $self->GD::newGroup(@_);
984 }
985
986 1;
987
988 __DATA__
989 white FF FF FF
990 black 00 00 00
991 aliceblue F0 F8 FF
992 antiquewhite FA EB D7
993 aqua 00 FF FF
994 aquamarine 7F FF D4
995 azure F0 FF FF
996 beige F5 F5 DC
997 bisque FF E4 C4
998 blanchedalmond FF EB CD
999 blue 00 00 FF
1000 blueviolet 8A 2B E2
1001 brown A5 2A 2A
1002 burlywood DE B8 87
1003 cadetblue 5F 9E A0
1004 chartreuse 7F FF 00
1005 chocolate D2 69 1E
1006 coral FF 7F 50
1007 cornflowerblue 64 95 ED
1008 cornsilk FF F8 DC
1009 crimson DC 14 3C
1010 cyan 00 FF FF
1011 darkblue 00 00 8B
1012 darkcyan 00 8B 8B
1013 darkgoldenrod B8 86 0B
1014 darkgray A9 A9 A9
1015 darkgreen 00 64 00
1016 darkkhaki BD B7 6B
1017 darkmagenta 8B 00 8B
1018 darkolivegreen 55 6B 2F
1019 darkorange FF 8C 00
1020 darkorchid 99 32 CC
1021 darkred 8B 00 00
1022 darksalmon E9 96 7A
1023 darkseagreen 8F BC 8F
1024 darkslateblue 48 3D 8B
1025 darkslategray 2F 4F 4F
1026 darkturquoise 00 CE D1
1027 darkviolet 94 00 D3
1028 deeppink FF 14 100
1029 deepskyblue 00 BF FF
1030 dimgray 69 69 69
1031 dodgerblue 1E 90 FF
1032 firebrick B2 22 22
1033 floralwhite FF FA F0
1034 forestgreen 22 8B 22
1035 fuchsia FF 00 FF
1036 gainsboro DC DC DC
1037 ghostwhite F8 F8 FF
1038 gold FF D7 00
1039 goldenrod DA A5 20
1040 gray 80 80 80
1041 green 00 80 00
1042 greenyellow AD FF 2F
1043 honeydew F0 FF F0
1044 hotpink FF 69 B4
1045 indianred CD 5C 5C
1046 indigo 4B 00 82
1047 ivory FF FF F0
1048 khaki F0 E6 8C
1049 lavender E6 E6 FA
1050 lavenderblush FF F0 F5
1051 lawngreen 7C FC 00
1052 lemonchiffon FF FA CD
1053 lightblue AD D8 E6
1054 lightcoral F0 80 80
1055 lightcyan E0 FF FF
1056 lightgoldenrodyellow FA FA D2
1057 lightgreen 90 EE 90
1058 lightgrey D3 D3 D3
1059 lightpink FF B6 C1
1060 lightsalmon FF A0 7A
1061 lightseagreen 20 B2 AA
1062 lightskyblue 87 CE FA
1063 lightslategray 77 88 99
1064 lightsteelblue B0 C4 DE
1065 lightyellow FF FF E0
1066 lime 00 FF 00
1067 limegreen 32 CD 32
1068 linen FA F0 E6
1069 magenta FF 00 FF
1070 maroon 80 00 00
1071 mediumaquamarine 66 CD AA
1072 mediumblue 00 00 CD
1073 mediumorchid BA 55 D3
1074 mediumpurple 100 70 DB
1075 mediumseagreen 3C B3 71
1076 mediumslateblue 7B 68 EE
1077 mediumspringgreen 00 FA 9A
1078 mediumturquoise 48 D1 CC
1079 mediumvioletred C7 15 85
1080 midnightblue 19 19 70
1081 mintcream F5 FF FA
1082 mistyrose FF E4 E1
1083 moccasin FF E4 B5
1084 navajowhite FF DE AD
1085 navy 00 00 80
1086 oldlace FD F5 E6
1087 olive 80 80 00
1088 olivedrab 6B 8E 23
1089 orange FF A5 00
1090 orangered FF 45 00
1091 orchid DA 70 D6
1092 palegoldenrod EE E8 AA
1093 palegreen 98 FB 98
1094 paleturquoise AF EE EE
1095 palevioletred DB 70 100
1096 papayawhip FF EF D5
1097 peachpuff FF DA B9
1098 peru CD 85 3F
1099 pink FF C0 CB
1100 plum DD A0 DD
1101 powderblue B0 E0 E6
1102 purple 80 00 80
1103 red FF 00 00
1104 rosybrown BC 8F 8F
1105 royalblue 41 69 E1
1106 saddlebrown 8B 45 13
1107 salmon FA 80 72
1108 sandybrown F4 A4 60
1109 seagreen 2E 8B 57
1110 seashell FF F5 EE
1111 sienna A0 52 2D
1112 silver C0 C0 C0
1113 skyblue 87 CE EB
1114 slateblue 6A 5A CD
1115 slategray 70 80 90
1116 snow FF FA FA
1117 springgreen 00 FF 7F
1118 steelblue 46 82 B4
1119 tan D2 B4 8C
1120 teal 00 80 80
1121 thistle D8 BF D8
1122 tomato FF 63 47
1123 turquoise 40 E0 D0
1124 violet EE 82 EE
1125 wheat F5 DE B3
1126 whitesmoke F5 F5 F5
1127 yellow FF FF 00
1128 yellowgreen 9A CD 32
1129 gradient1 00 ff 00
1130 gradient2 0a ff 00
1131 gradient3 14 ff 00
1132 gradient4 1e ff 00
1133 gradient5 28 ff 00
1134 gradient6 32 ff 00
1135 gradient7 3d ff 00
1136 gradient8 47 ff 00
1137 gradient9 51 ff 00
1138 gradient10 5b ff 00
1139 gradient11 65 ff 00
1140 gradient12 70 ff 00
1141 gradient13 7a ff 00
1142 gradient14 84 ff 00
1143 gradient15 8e ff 00
1144 gradient16 99 ff 00
1145 gradient17 a3 ff 00
1146 gradient18 ad ff 00
1147 gradient19 b7 ff 00
1148 gradient20 c1 ff 00
1149 gradient21 cc ff 00
1150 gradient22 d6 ff 00
1151 gradient23 e0 ff 00
1152 gradient24 ea ff 00
1153 gradient25 f4 ff 00
1154 gradient26 ff ff 00
1155 gradient27 ff f4 00
1156 gradient28 ff ea 00
1157 gradient29 ff e0 00
1158 gradient30 ff d6 00
1159 gradient31 ff cc 00
1160 gradient32 ff c1 00
1161 gradient33 ff b7 00
1162 gradient34 ff ad 00
1163 gradient35 ff a3 00
1164 gradient36 ff 99 00
1165 gradient37 ff 8e 00
1166 gradient38 ff 84 00
1167 gradient39 ff 7a 00
1168 gradient40 ff 70 00
1169 gradient41 ff 65 00
1170 gradient42 ff 5b 00
1171 gradient43 ff 51 00
1172 gradient44 ff 47 00
1173 gradient45 ff 3d 00
1174 gradient46 ff 32 00
1175 gradient47 ff 28 00
1176 gradient48 ff 1e 00
1177 gradient49 ff 14 00
1178 gradient50 ff 0a 00
1179 __END__
1180
1181 =head1 COLORS
1182
1183 This script will create an image showing all the symbolic colors.
1184
1185 #!/usr/bin/perl
1186
1187 use strict;
1188 use GD::Simple;
1189
1190 my @color_names = GD::Simple->color_names;
1191 my $cols = int(sqrt(@color_names));
1192 my $rows = int(@color_names/$cols)+1;
1193
1194 my $cell_width = 100;
1195 my $cell_height = 50;
1196 my $legend_height = 16;
1197 my $width = $cols * $cell_width;
1198 my $height = $rows * $cell_height;
1199
1200 my $img = GD::Simple->new($width,$height);
1201 $img->font(gdSmallFont);
1202
1203 for (my $c=0; $c<$cols; $c++) {
1204 for (my $r=0; $r<$rows; $r++) {
1205 my $color = $color_names[$c*$rows + $r] or next;
1206 my @topleft = ($c*$cell_width,$r*$cell_height);
1207 my @botright = ($topleft[0]+$cell_width,$topleft[1]+$cell_height-$legend_height);
1208 $img->bgcolor($color);
1209 $img->fgcolor($color);
1210 $img->rectangle(@topleft,@botright);
1211 $img->moveTo($topleft[0]+2,$botright[1]+$legend_height-2);
1212 $img->fgcolor('black');
1213 $img->string($color);
1214 }
1215 }
1216
1217 print $img->png;
1218
1219 =head1 AUTHOR
1220
1221 The GD::Simple module is copyright 2004, Lincoln D. Stein. It is
1222 distributed under the same terms as Perl itself. See the "Artistic
1223 License" in the Perl source code distribution for licensing terms.
1224
1225 The latest versions of GD.pm are available at
1226
1227 http://stein.cshl.org/WWW/software/GD
1228
1229 =head1 SEE ALSO
1230
1231 L<GD>,
1232 L<GD::Polyline>,
1233 L<GD::SVG>,
1234 L<Image::Magick>
1235
1236 =cut