summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/GD
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/GD')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/GD/Group.pm33
-rwxr-xr-xMaster/tlpkg/tlperl/lib/GD/Image.pm200
-rwxr-xr-xMaster/tlpkg/tlperl/lib/GD/Polygon.pm183
-rwxr-xr-xMaster/tlpkg/tlperl/lib/GD/Polyline.pm792
-rwxr-xr-xMaster/tlpkg/tlperl/lib/GD/Simple.pm1236
5 files changed, 2444 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/GD/Group.pm b/Master/tlpkg/tlperl/lib/GD/Group.pm
new file mode 100755
index 00000000000..93506bb3bc1
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/GD/Group.pm
@@ -0,0 +1,33 @@
+package GD::Group;
+
+# Simple object for recursive grouping. Does absolutely nothing with GD,
+# but works nicely with GD::SVG.
+
+use strict;
+
+our $AUTOLOAD;
+our $VERSION = 1.00;
+
+sub AUTOLOAD {
+ my ($pack,$func_name) = $AUTOLOAD =~ /(.+)::([^:]+)$/;
+ my $this = shift;
+ $this->{gd}->currentGroup($this->{group});
+ $this->{gd}->$func_name(@_);
+}
+
+sub new {
+ my $this = shift;
+ my ($gd,$group) = @_;
+ return bless {gd => $gd,
+ group => $group},ref $this || $this;
+}
+
+sub DESTROY {
+ my $this = shift;
+ my $gd = $this->{gd};
+ my $grp = $this->{group};
+ $gd->endGroup($grp);
+}
+
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/GD/Image.pm b/Master/tlpkg/tlperl/lib/GD/Image.pm
new file mode 100755
index 00000000000..bbeaadc6a87
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/GD/Image.pm
@@ -0,0 +1,200 @@
+# DO NOT EDIT! THIS FILE IS AUTOGENERATED BY GD/Image.pm.PLS
+package GD::Image;
+
+use strict;
+use GD;
+use Symbol 'gensym','qualify_to_ref';
+use vars '$VERSION';
+$VERSION = '2.38';
+
+=head1 NAME
+
+GD::Image - Image class for the GD image library
+
+=head1 SYNOPSIS
+
+See L<GD>
+
+=head1 DESCRIPTION
+
+See L<GD>
+
+=head1 AUTHOR
+
+The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is
+distributed under the same terms as Perl itself. See the "Artistic
+License" in the Perl source code distribution for licensing terms.
+
+The latest versions of GD.pm are available on CPAN:
+
+ http://www.cpan.org
+
+=head1 SEE ALSO
+
+L<GD>
+L<GD::Polyline>,
+L<GD::SVG>,
+L<GD::Simple>,
+L<Image::Magick>
+
+=cut
+
+# Copyright 1995 Lincoln D. Stein. See accompanying README file for
+# usage information
+
+*stringTTF = \&GD::Image::stringFT;
+
+sub _make_filehandle {
+ shift; # get rid of class
+ no strict 'refs';
+ my $thing = shift;
+ return $thing if defined(fileno $thing);
+
+ # otherwise try qualifying it into caller's package
+ my $fh;
+ {
+ local $^W = 0; # to avoid uninitialized variable warning from Symbol.pm
+ $fh = qualify_to_ref($thing,caller(2));
+ }
+ return $fh if defined(fileno $fh);
+
+ # otherwise treat it as a file to open
+ $fh = gensym;
+ open($fh,$thing) || return;
+ return $fh;
+}
+
+sub new {
+ my $pack = shift;
+ if (@_ == 1) {
+ if (my $type = _image_type($_[0])) {
+ my $method = "newFrom${type}Data";
+ return unless $pack->can($method);
+ return $pack->$method($_[0]);
+ }
+ return unless my $fh = $pack->_make_filehandle($_[0]);
+ my $magic;
+ return unless read($fh,$magic,4);
+ return unless my $type = _image_type($magic);
+ seek($fh,0,0);
+ my $method = "newFrom${type}";
+ return $pack->$method($fh);
+ }
+ return $pack->_new(@_);
+}
+
+sub newTrueColor {
+ my $pack = shift;
+ return $pack->_new(@_, 1);
+}
+
+sub newPalette {
+ my $pack = shift;
+ return $pack->_new(@_, 0);
+}
+
+sub newFromGd {
+ croak("Usage: newFromGd(class,filehandle)") unless @_==2;
+ my($class,$f) = @_;
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromGd($fh);
+}
+
+sub newFromGd2 {
+ croak("Usage: newFromGd2(class,filehandle)") unless @_==2;
+ my($class,$f) = @_;
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromGd2($fh);
+}
+
+sub newFromGd2Part {
+ croak("Usage: newFromGd2(class,filehandle,srcX,srcY,width,height)") unless @_==6;
+ my($class,$f) = splice(@_,0,2);
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromGd2Part($fh,@_);
+}
+
+sub ellipse ($$$$$) {
+ my ($self,$cx,$cy,$width,$height,$color) = @_;
+ $self->arc($cx,$cy,$width,$height,0,360,$color);
+}
+
+# draws closed polygon with the specified color
+sub polygon {
+ my $self = shift;
+ my($p,$c) = @_;
+ $self->openPolygon($p, $c);
+ $self->line( @{$p->{'points'}->[0]},
+ @{$p->{'points'}->[$p->{'length'}-1]}, $c);
+}
+
+sub width {
+ my $self = shift;
+ my @bounds = $self->getBounds;
+ $bounds[0];
+}
+
+sub height {
+ my $self = shift;
+ my @bounds = $self->getBounds;
+ $bounds[1];
+}
+
+sub _image_type {
+ my $data = shift;
+ my $magic = substr($data,0,4);
+ return 'Png' if $magic eq "\x89PNG";
+ return 'Jpeg' if $magic eq "\377\330\377\340";
+ return 'Jpeg' if $magic eq "\377\330\377\341";
+ return 'Jpeg' if $magic eq "\377\330\377\355";
+ return 'Jpeg' if $magic eq "\377\330\377\356";
+ return 'Gif' if $magic eq "GIF8";
+ return 'Gd2' if $magic eq "gd2\000";
+ return 'Xpm' if substr($data,0,9) eq "/* XPM */";
+ return;
+}
+
+
+sub clone {
+ croak("Usage: clone(\$image)") unless @_ == 1;
+ my $self = shift;
+ my ($x,$y) = $self->getBounds;
+ my $new = $self->new($x,$y);
+ return unless $new;
+ $new->copy($self,0,0,0,0,$x,$y);
+ return $new;
+}
+
+sub newFromPng {
+ croak("Usage: newFromPng(class,filehandle,[truecolor])") unless @_>=2;
+ my($class) = shift;
+ my($f) = shift;
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromPng($fh,@_);
+}
+
+sub newFromJpeg {
+ croak("Usage: newFromJpeg(class,filehandle,[truecolor])") unless @_>=2;
+ my($class) = shift;
+ my($f) = shift;
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromJpeg($fh,@_);
+}
+
+sub newFromGif {
+ croak("Usage: newFromGif(class,filehandle,[truecolor])") unless @_>=2;
+ my($class) = shift;
+ my($f) = shift;
+ my $fh = $class->_make_filehandle($f);
+ binmode($fh);
+ $class->_newFromGif($fh,@_);
+}
+
+# Autoload methods go after __END__, and are processed by the autosplit program.
+1;
+__END__
diff --git a/Master/tlpkg/tlperl/lib/GD/Polygon.pm b/Master/tlpkg/tlperl/lib/GD/Polygon.pm
new file mode 100755
index 00000000000..42319b266fe
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/GD/Polygon.pm
@@ -0,0 +1,183 @@
+package GD::Polygon;
+
+use strict;
+use Carp 'carp';
+use GD;
+
+# old documentation error
+*GD::Polygon::delete = \&deletePt;
+
+=head1 NAME
+
+GD::Polygon - Polygon class for the GD image library
+
+=head1 SYNOPSIS
+
+See L<GD>
+
+=head1 DESCRIPTION
+
+See L<GD>
+
+=head1 AUTHOR
+
+The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is
+distributed under the same terms as Perl itself. See the "Artistic
+License" in the Perl source code distribution for licensing terms.
+
+The latest versions of GD.pm are available on CPAN:
+
+ http://www.cpan.org
+
+=head1 SEE ALSO
+
+L<GD>
+L<GD::Polyline>,
+L<GD::SVG>,
+L<GD::Simple>,
+L<Image::Magick>
+
+=cut
+
+### The polygon object ###
+# create a new polygon
+sub new {
+ my $class = shift;
+ return bless { 'length'=>0,'points'=>[] },$class;
+}
+
+# automatic destruction of the polygon
+sub DESTROY {
+ my $self = shift;
+ undef $self->{'points'};
+}
+
+sub clear {
+ my $self = shift;
+ $self->{'points'} = [];
+}
+
+# add an x,y vertex to the polygon
+sub addPt {
+ my($self,$x,$y) = @_;
+ push(@{$self->{'points'}},[$x,$y]);
+ $self->{'length'}++;
+}
+
+# get a vertex
+sub getPt {
+ my($self,$index) = @_;
+ return () unless ($index>=0) && ($index<$self->{'length'});
+ return @{$self->{'points'}->[$index]};
+}
+
+# change the value of a vertex
+sub setPt {
+ my($self,$index,$x,$y) = @_;
+ unless (($index>=0) && ($index<$self->{'length'})) {
+ carp "Attempt to set an undefined polygon vertex";
+ return undef;
+ }
+ @{$self->{'points'}->[$index]} = ($x,$y);
+ 1;
+}
+
+# return the total number of vertices
+sub length {
+ my $self = shift;
+ return $self->{'length'};
+}
+
+# return the array of vertices.
+# each vertex is an two-member (x,y) array
+sub vertices {
+ my $self = shift;
+ return @{$self->{'points'}};
+}
+
+# return the bounding box of the polygon
+# (smallest rectangle that contains it)
+sub bounds {
+ my $self = shift;
+ my($top,$bottom,$left,$right) = @_;
+ $top = 99999999;
+ $bottom =-99999999;
+ $left = 99999999;
+ $right = -99999999;
+ my $v;
+ foreach $v ($self->vertices) {
+ $left = $v->[0] if $left > $v->[0];
+ $right = $v->[0] if $right < $v->[0];
+ $top = $v->[1] if $top > $v->[1];
+ $bottom = $v->[1] if $bottom < $v->[1];
+ }
+ return ($left,$top,$right,$bottom);
+}
+
+# delete a vertex, returning it, just for fun
+sub deletePt {
+ my($self,$index) = @_;
+ unless (($index>=0) && ($index<@{$self->{'points'}})) {
+ carp "Attempt to delete an undefined polygon vertex";
+ return undef;
+ }
+ my($vertex) = splice(@{$self->{'points'}},$index,1);
+ $self->{'length'}--;
+ return @$vertex;
+ }
+
+# translate the polygon in space by deltaX and deltaY
+sub offset {
+ my($self,$dh,$dv) = @_;
+ my $size = $self->length;
+ my($i);
+ for ($i=0;$i<$size;$i++) {
+ my($x,$y)=$self->getPt($i);
+ $self->setPt($i,$x+$dh,$y+$dv);
+ }
+}
+
+# map the polygon from sourceRect to destRect,
+# translating and resizing it if necessary
+sub map {
+ my($self,$srcL,$srcT,$srcR,$srcB,$destL,$destT,$destR,$destB) = @_;
+ my($factorV) = ($destB-$destT)/($srcB-$srcT);
+ my($factorH) = ($destR-$destL)/($srcR-$srcL);
+ my($vertices) = $self->length;
+ my($i);
+ for ($i=0;$i<$vertices;$i++) {
+ my($x,$y) = $self->getPt($i);
+ $x = int($destL + ($x - $srcL) * $factorH);
+ $y = int($destT + ($y - $srcT) * $factorV);
+ $self->setPt($i,$x,$y);
+ }
+}
+
+# These routines added by Winfriend Koenig.
+sub toPt {
+ my($self, $dx, $dy) = @_;
+ unless ($self->length > 0) {
+ $self->addPt($dx,$dy);
+ return;
+ }
+ my ($x, $y) = $self->getPt($self->length-1);
+ $self->addPt($x+$dx,$y+$dy);
+}
+
+sub transform($$$$$$$) {
+ # see PostScript Ref. page 154
+ my($self, $a, $b, $c, $d, $tx, $ty) = @_;
+ my $size = $self->length;
+ for (my $i=0;$i<$size;$i++) {
+ my($x,$y)=$self->getPt($i);
+ $self->setPt($i, $a*$x+$c*$y+$tx, $b*$x+$d*$y+$ty);
+ }
+}
+
+sub scale {
+ my($self, $sx, $sy, $cx, $cy) = @_;
+ $self->offset(-$cx,-$cy) if defined $cx or defined $cy;
+ $self->transform($sx,0,0,$sy,$cx,$cy);
+}
+
+1;
diff --git a/Master/tlpkg/tlperl/lib/GD/Polyline.pm b/Master/tlpkg/tlperl/lib/GD/Polyline.pm
new file mode 100755
index 00000000000..3b5dcb7ce71
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/GD/Polyline.pm
@@ -0,0 +1,792 @@
+############################################################################
+#
+# Polyline.pm
+#
+# Author: Dan Harasty
+# Email: harasty@cpan.org
+# Version: 0.2
+# Date: 2002/08/06
+#
+# For usage documentation: see POD at end of file
+#
+# For changes: see "Changes" file included with distribution
+#
+
+use strict;
+
+package GD::Polyline;
+
+############################################################################
+#
+# GD::Polyline
+#
+############################################################################
+#
+# What's this? A class with nothing but a $VERSION and and @ISA?
+# Below, this module overrides and adds several modules to
+# the parent class, GD::Polygon. Those updated/new methods
+# act on polygons and polylines, and sometimes those behaviours
+# vary slightly based on whether the object is a polygon or polyine.
+#
+
+use vars qw($VERSION @ISA);
+$VERSION = "0.2";
+@ISA = qw(GD::Polygon);
+
+
+package GD::Polygon;
+
+############################################################################
+#
+# new methods on GD::Polygon
+#
+############################################################################
+
+use GD;
+use Carp 'croak','carp';
+
+use vars qw($bezSegs $csr);
+$bezSegs = 20; # number of bezier segs -- number of segments in each portion of the spline produces by toSpline()
+$csr = 1/3; # control seg ratio -- the one possibly user-tunable parameter in the addControlPoints() algorithm
+
+
+sub rotate {
+ my ($self, $angle, $cx, $cy) = @_;
+ $self->offset(-$cx,-$cy) if $cx or $cy;
+ $self->transform(cos($angle),sin($angle),-sin($angle),cos($angle),$cx,$cy);
+}
+
+sub centroid {
+ my ($self, $scale) = @_;
+ my ($cx,$cy);
+ $scale = 1 unless defined $scale;
+
+ map {$cx += $_->[0]; $cy += $_->[1]} $self->vertices();
+
+ $cx *= $scale / $self->length();
+ $cy *= $scale / $self->length();
+
+ return ($cx, $cy);
+}
+
+
+sub segLength {
+ my $self = shift;
+ my @points = $self->vertices();
+
+ my ($p1, $p2, @segLengths);
+
+ $p1 = shift @points;
+
+ # put the first vertex on the end to "close" a polygon, but not a polyline
+ push @points, $p1 unless $self->isa('GD::Polyline');
+
+ while ($p2 = shift @points) {
+ push @segLengths, _len($p1, $p2);
+ $p1 = $p2;
+ }
+
+ return @segLengths if wantarray;
+
+ my $sum;
+ map {$sum += $_} @segLengths;
+ return $sum;
+}
+
+sub segAngle {
+ my $self = shift;
+ my @points = $self->vertices();
+
+ my ($p1, $p2, @segAngles);
+
+ $p1 = shift @points;
+
+ # put the first vertex on the end to "close" a polygon, but not a polyline
+ push @points, $p1 unless $self->isa('GD::Polyline');
+
+ while ($p2 = shift @points) {
+ push @segAngles, _angle_reduce2(_angle($p1, $p2));
+ $p1 = $p2;
+ }
+
+ return @segAngles;
+}
+
+sub vertexAngle {
+ my $self = shift;
+ my @points = $self->vertices();
+
+ my ($p1, $p2, $p3, @vertexAngle);
+
+ $p1 = $points[$#points]; # last vertex
+ $p2 = shift @points; # current point -- the first vertex
+
+ # put the first vertex on the end to "close" a polygon, but not a polyline
+ push @points, $p2 unless $self->isa('GD::Polyline');
+
+ while ($p3 = shift @points) {
+ push @vertexAngle, _angle_reduce2(_angle($p1, $p2, $p3));
+ ($p1, $p2) = ($p2, $p3);
+ }
+
+ $vertexAngle[0] = undef if defined $vertexAngle[0] and $self->isa("GD::Polyline");
+
+ return @vertexAngle if wantarray;
+
+}
+
+
+
+sub toSpline {
+ my $self = shift;
+ my @points = $self->vertices();
+
+ # put the first vertex on the end to "close" a polygon, but not a polyline
+ push @points, [$self->getPt(0)] unless $self->isa('GD::Polyline');
+
+ unless (@points > 1 and @points % 3 == 1) {
+ carp "Attempt to call toSpline() with invalid set of control points";
+ return undef;
+ }
+
+ my ($ap1, $dp1, $dp2, $ap2); # ap = anchor point, dp = director point
+ $ap1 = shift @points;
+
+ my $bez = new ref($self);
+
+ $bez->addPt(@$ap1);
+
+ while (@points) {
+ ($dp1, $dp2, $ap2) = splice(@points, 0, 3);
+
+ for (1..$bezSegs) {
+ my ($t0, $t1, $c1, $c2, $c3, $c4, $x, $y);
+
+ $t1 = $_/$bezSegs;
+ $t0 = (1 - $t1);
+
+ # possible optimization:
+ # these coefficient could be calculated just once and
+ # cached in an array for a given value of $bezSegs
+
+ $c1 = $t0 * $t0 * $t0;
+ $c2 = 3 * $t0 * $t0 * $t1;
+ $c3 = 3 * $t0 * $t1 * $t1;
+ $c4 = $t1 * $t1 * $t1;
+
+ $x = $c1 * $ap1->[0] + $c2 * $dp1->[0] + $c3 * $dp2->[0] + $c4 * $ap2->[0];
+ $y = $c1 * $ap1->[1] + $c2 * $dp1->[1] + $c3 * $dp2->[1] + $c4 * $ap2->[1];
+
+ $bez->addPt($x, $y);
+ }
+
+ $ap1 = $ap2;
+ }
+
+ # remove the last anchor point if this is a polygon -- since it will autoclose without it
+ $bez->deletePt($bez->length()-1) unless $self->isa('GD::Polyline');
+
+ return $bez;
+}
+
+sub addControlPoints {
+ my $self = shift;
+ my @points = $self->vertices();
+
+ unless (@points > 1) {
+ carp "Attempt to call addControlPoints() with too few vertices in polyline";
+ return undef;
+ }
+
+ my $points = scalar(@points);
+ my @segAngles = $self->segAngle();
+ my @segLengths = $self->segLength();
+
+ my ($prevLen, $nextLen, $prevAngle, $thisAngle, $nextAngle);
+ my ($controlSeg, $pt, $ptX, $ptY, @controlSegs);
+
+ # this loop goes about creating polylines -- here called control segments --
+ # that hold the control points for the final set of control points
+
+ # each control segment has three points, and these are colinear
+
+ # the first and last will ultimately be "director points", and
+ # the middle point will ultimately be an "anchor point"
+
+ for my $i (0..$#points) {
+
+ $controlSeg = new GD::Polyline;
+
+ $pt = $points[$i];
+ ($ptX, $ptY) = @$pt;
+
+ if ($self->isa('GD::Polyline') and ($i == 0 or $i == $#points)) {
+ $controlSeg->addPt($ptX, $ptY); # director point
+ $controlSeg->addPt($ptX, $ptY); # anchor point
+ $controlSeg->addPt($ptX, $ptY); # director point
+ next;
+ }
+
+ $prevLen = $segLengths[$i-1];
+ $nextLen = $segLengths[$i];
+ $prevAngle = $segAngles[$i-1];
+ $nextAngle = $segAngles[$i];
+
+ # make a control segment with control points (director points)
+ # before and after the point from the polyline (anchor point)
+
+ $controlSeg->addPt($ptX - $csr * $prevLen, $ptY); # director point
+ $controlSeg->addPt($ptX , $ptY); # anchor point
+ $controlSeg->addPt($ptX + $csr * $nextLen, $ptY); # director point
+
+ # note that:
+ # - the line is parallel to the x-axis, as the points have a common $ptY
+ # - the points are thus clearly colinear
+ # - the director point is a distance away from the anchor point in proportion to the length of the segment it faces
+
+ # now, we must come up with a reasonable angle for the control seg
+ # first, "unwrap" $nextAngle w.r.t. $prevAngle
+ $nextAngle -= 2*pi() until $nextAngle < $prevAngle + pi();
+ $nextAngle += 2*pi() until $nextAngle > $prevAngle - pi();
+ # next, use seg lengths as an inverse weighted average
+ # to "tip" the control segment toward the *shorter* segment
+ $thisAngle = ($nextAngle * $prevLen + $prevAngle * $nextLen) / ($prevLen + $nextLen);
+
+ # rotate the control segment to $thisAngle about it's anchor point
+ $controlSeg->rotate($thisAngle, $ptX, $ptY);
+
+ } continue {
+ # save the control segment for later
+ push @controlSegs, $controlSeg;
+
+ }
+
+ # post process
+
+ my $controlPoly = new ref($self);
+
+ # collect all the control segments' points in to a single control poly
+
+ foreach my $cs (@controlSegs) {
+ foreach my $pt ($cs->vertices()) {
+ $controlPoly->addPt(@$pt);
+ }
+ }
+
+ # final clean up based on poly type
+
+ if ($controlPoly->isa('GD::Polyline')) {
+ # remove the first and last control point
+ # since they are director points ...
+ $controlPoly->deletePt(0);
+ $controlPoly->deletePt($controlPoly->length()-1);
+ } else {
+ # move the first control point to the last control point
+ # since it is supposed to end with two director points ...
+ $controlPoly->addPt($controlPoly->getPt(0));
+ $controlPoly->deletePt(0);
+ }
+
+ return $controlPoly;
+}
+
+
+# The following helper functions are for internal
+# use of this module. Input arguments of "points"
+# refer to an array ref of two numbers, [$x, $y]
+# as is used internally in the GD::Polygon
+#
+# _len()
+# Find the length of a segment, passing in two points.
+# Internal function; NOT a class or object method.
+#
+sub _len {
+# my ($p1, $p2) = @_;
+# return sqrt(($p2->[0]-$p1->[0])**2 + ($p2->[1]-$p1->[1])**2);
+ my $pt = _subtract(@_);
+ return sqrt($pt->[0] ** 2 + $pt->[1] **2);
+}
+
+use Math::Trig;
+
+# _angle()
+# Find the angle of... well, depends on the number of arguments:
+# - one point: the angle from x-axis to the point (origin is the center)
+# - two points: the angle of the vector defined from point1 to point2
+# - three points:
+# Internal function; NOT a class or object method.
+#
+sub _angle {
+ my ($p1, $p2, $p3) = @_;
+ my $angle = undef;
+ if (@_ == 1) {
+ return atan2($p1->[1], $p1->[0]);
+ }
+ if (@_ == 2) {
+ return _angle(_subtract($p1, $p2));
+ }
+ if (@_ == 3) {
+ return _angle(_subtract($p2, $p3)) - _angle(_subtract($p2, $p1));
+ }
+}
+
+# _subtract()
+# Find the difference of two points; returns a point.
+# Internal function; NOT a class or object method.
+#
+sub _subtract {
+ my ($p1, $p2) = @_;
+# print(_print_point($p2), "-", _print_point($p1), "\n");
+ return [$p2->[0]-$p1->[0], $p2->[1]-$p1->[1]];
+}
+
+# _print_point()
+# Returns a string suitable for displaying the value of a point.
+# Internal function; NOT a class or object method.
+#
+sub _print_point {
+ my ($p1) = @_;
+ return "[" . join(", ", @$p1) . "]";
+}
+
+# _angle_reduce1()
+# "unwraps" angle to interval -pi < angle <= +pi
+# Internal function; NOT a class or object method.
+#
+sub _angle_reduce1 {
+ my ($angle) = @_;
+ $angle += 2 * pi() while $angle <= -pi();
+ $angle -= 2 * pi() while $angle > pi();
+ return $angle;
+}
+
+# _angle_reduce2()
+# "unwraps" angle to interval 0 <= angle < 2 * pi
+# Internal function; NOT a class or object method.
+#
+sub _angle_reduce2 {
+ my ($angle) = @_;
+ $angle += 2 * pi() while $angle < 0;
+ $angle -= 2 * pi() while $angle >= 2 * pi();
+ return $angle;
+}
+
+############################################################################
+#
+# new methods on GD::Image
+#
+############################################################################
+
+sub GD::Image::polyline {
+ my $self = shift; # the GD::Image
+ my $p = shift; # the GD::Polyline (or GD::Polygon)
+ my $c = shift; # the color
+
+ my @points = $p->vertices();
+ my $p1 = shift @points;
+ my $p2;
+ while ($p2 = shift @points) {
+ $self->line(@$p1, @$p2, $c);
+ $p1 = $p2;
+ }
+}
+
+sub GD::Image::polydraw {
+ my $self = shift; # the GD::Image
+ my $p = shift; # the GD::Polyline or GD::Polygon
+ my $c = shift; # the color
+
+ return $self->polyline($p, $c) if $p->isa('GD::Polyline');
+ return $self->polygon($p, $c);
+}
+
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+GD::Polyline - Polyline object and Polygon utilities (including splines) for use with GD
+
+=head1 SYNOPSIS
+
+ use GD;
+ use GD::Polyline;
+
+ # create an image
+ $image = new GD::Image (500,300);
+ $white = $image->colorAllocate(255,255,255);
+ $black = $image->colorAllocate( 0, 0, 0);
+ $red = $image->colorAllocate(255, 0, 0);
+
+ # create a new polyline
+ $polyline = new GD::Polyline;
+
+ # add some points
+ $polyline->addPt( 0, 0);
+ $polyline->addPt( 0,100);
+ $polyline->addPt( 50,125);
+ $polyline->addPt(100, 0);
+
+ # polylines can use polygon methods (and vice versa)
+ $polyline->offset(200,100);
+
+ # rotate 60 degrees, about the centroid
+ $polyline->rotate(3.14159/3, $polyline->centroid());
+
+ # scale about the centroid
+ $polyline->scale(1.5, 2, $polyline->centroid());
+
+ # draw the polyline
+ $image->polydraw($polyline,$black);
+
+ # create a spline, which is also a polyine
+ $spline = $polyline->addControlPoints->toSpline;
+ $image->polydraw($spline,$red);
+
+ # output the png
+ binmode STDOUT;
+ print $image->png;
+
+=head1 DESCRIPTION
+
+B<Polyline.pm> extends the GD module by allowing you to create polylines. Think
+of a polyline as "an open polygon", that is, the last vertex is not connected
+to the first vertex (unless you expressly add the same value as both points).
+
+For the remainder of this doc, "polyline" will refer to a GD::Polyline,
+"polygon" will refer to a GD::Polygon that is not a polyline, and
+"polything" and "$poly" may be either.
+
+The big feature added to GD by this module is the means
+to create splines, which are approximations to curves.
+
+=head1 The Polyline Object
+
+GD::Polyline defines the following class:
+
+=over 5
+
+=item C<GD::Polyline>
+
+A polyline object, used for storing lists of vertices prior to
+rendering a polyline into an image.
+
+=item C<new>
+
+C<GD::Polyline-E<gt>new> I<class method>
+
+Create an empty polyline with no vertices.
+
+ $polyline = new GD::Polyline;
+
+ $polyline->addPt( 0, 0);
+ $polyline->addPt( 0,100);
+ $polyline->addPt( 50,100);
+ $polyline->addPt(100, 0);
+
+ $image->polydraw($polyline,$black);
+
+In fact GD::Polyline is a subclass of GD::Polygon,
+so all polygon methods (such as B<offset> and B<transform>)
+may be used on polylines.
+Some new methods have thus been added to GD::Polygon (such as B<rotate>)
+and a few updated/modified/enhanced (such as B<scale>) I<in this module>.
+See section "New or Updated GD::Polygon Methods" for more info.
+
+=back
+
+Note that this module is very "young" and should be
+considered subject to change in future releases, and/or
+possibly folded in to the existing polygon object and/or GD module.
+
+=head1 Updated Polygon Methods
+
+The following methods (defined in GD.pm) are OVERRIDDEN if you use this module.
+
+All effort has been made to provide 100% backward compatibility, but if you
+can confirm that has not been achieved, please consider that a bug and let the
+the author of Polyline.pm know.
+
+=over 5
+
+=item C<scale>
+
+C<$poly-E<gt>scale($sx, $sy, $cx, $cy)> I<object method -- UPDATE to GD::Polygon::scale>
+
+Scale a polything in along x-axis by $sx and along the y-axis by $sy,
+about centery point ($cx, $cy).
+
+Center point ($cx, $cy) is optional -- if these are omitted, the function
+will scale about the origin.
+
+To flip a polything, use a scale factor of -1. For example, to
+flip the polything top to bottom about line y = 100, use:
+
+ $poly->scale(1, -1, 0, 100);
+
+=back
+
+=head1 New Polygon Methods
+
+The following methods are added to GD::Polygon, and thus can be used
+by polygons and polylines.
+
+Don't forget: a polyline is a GD::Polygon, so GD::Polygon methods
+like offset() can be used, and they can be used in
+GD::Image methods like filledPolygon().
+
+=over 5
+
+=item C<rotate>
+
+C<$poly-E<gt>rotate($angle, $cx, $cy)> I<object method>
+
+Rotate a polything through $angle (clockwise, in radians) about center point ($cx, $cy).
+
+Center point ($cx, $cy) is optional -- if these are omitted, the function
+will rotate about the origin
+
+In this function and other angle-oriented functions in GD::Polyline,
+positive $angle corrensponds to clockwise rotation. This is opposite
+of the usual Cartesian sense, but that is because the raster is opposite
+of the usual Cartesian sense in that the y-axis goes "down".
+
+=item C<centroid>
+
+C<($cx, $cy) = $poly-E<gt>centroid($scale)> I<object method>
+
+Calculate and return ($cx, $cy), the centroid of the vertices of the polything.
+For example, to rotate something 180 degrees about it's centroid:
+
+ $poly->rotate(3.14159, $poly->centroid());
+
+$scale is optional; if supplied, $cx and $cy are multiplied by $scale
+before returning. The main use of this is to shift an polything to the
+origin like this:
+
+ $poly->offset($poly->centroid(-1));
+
+=item C<segLength>
+
+C<@segLengths = $poly-E<gt>segLength()> I<object method>
+
+In array context, returns an array the lengths of the segments in the polything.
+Segment n is the segment from vertex n to vertex n+1.
+Polygons have as many segments as vertices; polylines have one fewer.
+
+In a scalar context, returns the sum of the array that would have been returned
+in the array context.
+
+=item C<segAngle>
+
+C<@segAngles = $poly-E<gt>segAngle()> I<object method>
+
+Returns an array the angles of each segment from the x-axis.
+Segment n is the segment from vertex n to vertex n+1.
+Polygons have as many segments as vertices; polylines have one fewer.
+
+Returned angles will be on the interval 0 <= $angle < 2 * pi and
+angles increase in a clockwise direction.
+
+=item C<vertexAngle>
+
+C<@vertexAngles = $poly-E<gt>vertexAngle()> I<object method>
+
+Returns an array of the angles between the segment into and out of each vertex.
+For polylines, the vertex angle at vertex 0 and the last vertex are not defined;
+however $vertexAngle[0] will be undef so that $vertexAngle[1] will correspond to
+vertex 1.
+
+Returned angles will be on the interval 0 <= $angle < 2 * pi and
+angles increase in a clockwise direction.
+
+Note that this calculation does not attempt to figure out the "interior" angle
+with respect to "inside" or "outside" the polygon, but rather,
+just the angle between the adjacent segments
+in a clockwise sense. Thus a polygon with all right angles will have vertex
+angles of either pi/2 or 3*pi/2, depending on the way the polygon was "wound".
+
+=item C<toSpline>
+
+C<$poly-E<gt>toSpline()> I<object method & factory method>
+
+Create a new polything which is a reasonably smooth curve
+using cubic spline algorithms, often referred to as Bezier
+curves. The "source" polything is called the "control polything".
+If it is a polyline, the control polyline must
+have 4, 7, 10, or some number of vertices of equal to 3n+1.
+If it is a polygon, the control polygon must
+have 3, 6, 9, or some number of vertices of equal to 3n.
+
+ $spline = $poly->toSpline();
+ $image->polydraw($spline,$red);
+
+In brief, groups of four points from the control polyline
+are considered "control
+points" for a given portion of the spline: the first and
+fourth are "anchor points", and the spline passes through
+them; the second and third are "director points". The
+spline does not pass through director points, however the
+spline is tangent to the line segment from anchor point to
+adjacent director point.
+
+The next portion of the spline reuses the previous portion's
+last anchor point. The spline will have a cusp
+(non-continuous slope) at an anchor point, unless the anchor
+points and its adjacent director point are colinear.
+
+In the current implementation, toSpline() return a fixed
+number of segments in the returned polyline per set-of-four
+control points. In the future, this and other parameters of
+the algorithm may be configurable.
+
+=item C<addControlPoints>
+
+C<$polyline-E<gt>addControlPoints()> I<object method & factory method>
+
+So you say: "OK. Splines sound cool. But how can I
+get my anchor points and its adjacent director point to be
+colinear so that I have a nice smooth curves from my
+polyline?" Relax! For The Lazy: addControlPoints() to the
+rescue.
+
+addControlPoints() returns a polyline that can serve
+as the control polyline for toSpline(), which returns
+another polyline which is the spline. Is your head spinning
+yet? Think of it this way:
+
+=over 5
+
+=item +
+
+If you have a polyline, and you have already put your
+control points where you want them, call toSpline() directly.
+Remember, only every third vertex will be "on" the spline.
+
+You get something that looks like the spline "inscribed"
+inside the control polyline.
+
+=item +
+
+If you have a polyline, and you want all of its vertices on
+the resulting spline, call addControlPoints() and then
+toSpline():
+
+ $control = $polyline->addControlPoints();
+ $spline = $control->toSpline();
+ $image->polyline($spline,$red);
+
+You get something that looks like the control polyline "inscribed"
+inside the spline.
+
+=back
+
+Adding "good" control points is subjective; this particular
+algorithm reveals its author's tastes.
+In the future, you may be able to alter the taste slightly
+via parameters to the algorithm. For The Hubristic: please
+build a better one!
+
+And for The Impatient: note that addControlPoints() returns a
+polyline, so you can pile up the the call like this,
+if you'd like:
+
+ $image->polyline($polyline->addControlPoints()->toSpline(),$mauve);
+
+=back
+
+=head1 New GD::Image Methods
+
+=over 5
+
+=item C<polyline>
+
+C<$image-E<gt>polyline(polyline,color)> I<object method>
+
+ $image->polyline($polyline,$black)
+
+This draws a polyline with the specified color.
+Both real color indexes and the special
+colors gdBrushed, gdStyled and gdStyledBrushed can be specified.
+
+Neither the polyline() method or the polygon() method are very
+picky: you can call either method with either a GD::Polygon or a GD::Polyline.
+The I<method> determines if the shape is "closed" or "open" as drawn, I<not>
+the object type.
+
+=item C<polydraw>
+
+C<$image-E<gt>polydraw(polything,color)> I<object method>
+
+ $image->polydraw($poly,$black)
+
+This method draws the polything as expected (polygons are closed,
+polylines are open) by simply checking the object type and calling
+either $image->polygon() or $image->polyline().
+
+=back
+
+=head1 Examples
+
+Please see file "polyline-examples.pl" that is included with the distribution.
+
+=head1 See Also
+
+For more info on Bezier splines, see http://www.webreference.com/dlab/9902/bezier.html.
+
+=head1 Future Features
+
+On the drawing board are additional features such as:
+
+ - polygon winding algorithms (to determine if a point is "inside" or "outside" the polygon)
+
+ - new polygon from bounding box
+
+ - find bounding polygon (tightest fitting simple convex polygon for a given set of vertices)
+
+ - addPts() method to add many points at once
+
+ - clone() method for polygon
+
+ - functions to interwork GD with SVG
+
+Please provide input on other possible features you'd like to see.
+
+=head1 Author
+
+This module has been written by Daniel J. Harasty.
+Please send questions, comments, complaints, and kudos to him
+at harasty@cpan.org.
+
+Thanks to Lincoln Stein for input and patience with me and this,
+my first CPAN contribution.
+
+=head1 Copyright Information
+
+The Polyline.pm module is copyright 2002, Daniel J. Harasty. It is
+distributed under the same terms as Perl itself. See the "Artistic
+License" in the Perl source code distribution for licensing terms.
+
+The latest version of Polyline.pm is available at
+your favorite CPAN repository and/or
+along with GD.pm by Lincoln D. Stein at http://stein.cshl.org/WWW/software/GD.
+
+=cut
+
+# future:
+# addPts
+# boundingPolygon
+# addControlPoints('method' => 'fitToSegments', 'numSegs' => 10)
+# toSpline('csr' => 1/4);
+
+# GD::Color
+# colorMap('x11' | 'svg' | <filename> )
+# colorByName($image, 'orange');
+# setImage($image);
+# cbn('orange');
+#
+#
+#
diff --git a/Master/tlpkg/tlperl/lib/GD/Simple.pm b/Master/tlpkg/tlperl/lib/GD/Simple.pm
new file mode 100755
index 00000000000..ed0c3e9aa11
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/GD/Simple.pm
@@ -0,0 +1,1236 @@
+package GD::Simple;
+
+=head1 NAME
+
+GD::Simple - Simplified interface to GD library
+
+=head1 SYNOPSIS
+
+ use GD::Simple;
+
+ # create a new image
+ $img = GD::Simple->new(400,250);
+
+ # draw a red rectangle with blue borders
+ $img->bgcolor('red');
+ $img->fgcolor('blue');
+ $img->rectangle(10,10,50,50);
+
+ # draw an empty rectangle with green borders
+ $img->bgcolor(undef);
+ $img->fgcolor('green');
+ $img->rectangle(30,30,100,100);
+
+ # move to (80,80) and draw a green line to (100,190)
+ $img->moveTo(80,80);
+ $img->lineTo(100,190);
+
+ # draw a solid orange ellipse
+ $img->moveTo(110,100);
+ $img->bgcolor('orange');
+ $img->fgcolor('orange');
+ $img->ellipse(40,40);
+
+ # draw a black filled arc
+ $img->moveTo(150,150);
+ $img->fgcolor('black');
+ $img->arc(50,50,0,100,gdNoFill|gdEdged);
+
+ # draw a string at (10,180) using the default
+ # built-in font
+ $img->moveTo(10,180);
+ $img->string('This is very simple');
+
+ # draw a string at (280,210) using 20 point
+ # times italic, angled upward 90 degrees
+ $img->moveTo(280,210);
+ $img->font('Times:italic');
+ $img->fontsize(20);
+ $img->angle(-90);
+ $img->string('This is very fancy');
+
+ # some turtle graphics
+ $img->moveTo(300,100);
+ $img->penSize(3,3);
+ $img->angle(0);
+ $img->line(20); # 20 pixels going to the right
+ $img->turn(30); # set turning angle to 30 degrees
+ $img->line(20); # 20 pixel line
+ $img->line(20);
+ $img->line(20);
+ $img->turn(-90); # set turning angle to -90 degrees
+ $img->line(50); # 50 pixel line
+
+ # draw a cyan polygon edged in blue
+ my $poly = new GD::Polygon;
+ $poly->addPt(150,100);
+ $poly->addPt(199,199);
+ $poly->addPt(100,199);
+ $img->bgcolor('cyan');
+ $img->fgcolor('blue');
+ $img->penSize(1,1);
+ $img->polygon($poly);
+
+ # convert into png data
+ print $img->png;
+
+=head1 DESCRIPTION
+
+GD::Simple is a subclass of the GD library that shortens many of the
+long GD method calls by storing information about the pen color, size
+and position in the GD object itself. It also adds a small number of
+"turtle graphics" style calls for those who prefer to work in polar
+coordinates. In addition, the library allows you to use symbolic
+names for colors, such as "chartreuse", and will manage the colors for
+you.
+
+=head2 The Pen
+
+GD::Simple maintains a "pen" whose settings are used for line- and
+shape-drawing operations. The pen has the following properties:
+
+=over 4
+
+=item fgcolor
+
+The pen foreground color is the color of lines and the borders of
+filled and unfilled shapes.
+
+=item bgcolor
+
+The pen background color is the color of the contents of filled
+shapes.
+
+=item pensize
+
+The pen size is the width of the pen. Larger sizes draw thicker
+lines.
+
+=item position
+
+The pen position is its current position on the canvas in (X,Y)
+coordinates.
+
+=item angle
+
+When drawing in turtle mode, the pen angle determines the current
+direction of lines of relative length.
+
+=item turn
+
+When drawing in turtle mode, the turn determines the clockwise or
+counterclockwise angle that the pen will turn before drawing the next
+line.
+
+=item font
+
+The font to use when drawing text. Both built-in bitmapped fonts and
+TrueType fonts are supported.
+
+=item fontsize
+
+The size of the font to use when drawing with TrueType fonts.
+
+=back
+
+One sets the position and properties of the pen and then draws. As
+the drawing progresses, the position of the pen is updated.
+
+=head2 Methods
+
+GD::Simple introduces a number of new methods, a few of which have the
+same name as GD::Image methods, and hence change their behavior. In
+addition to these new methods, GD::Simple objects support all of the
+GD::Image methods. If you make a method call that isn't directly
+supported by GD::Simple, it refers the request to the underlying
+GD::Image object. Hence one can load a JPEG image into GD::Simple and
+declare it to be TrueColor by using this call, which is effectively
+inherited from GD::Image:
+
+ my $img = GD::Simple->newFromJpeg('./myimage.jpg',1);
+
+The rest of this section describes GD::Simple-specific methods.
+
+=cut
+
+use strict;
+use GD;
+use GD::Group;
+use Math::Trig;
+use Carp 'croak';
+
+our @ISA = 'Exporter';
+our @EXPORT = @GD::EXPORT;
+our @EXPORT_OK = @GD::EXPORT_OK;
+our $AUTOLOAD;
+
+my %COLORS;
+my $IMAGECLASS = 'GD::Image';
+my $TRANSPARENT;
+
+sub AUTOLOAD {
+ my $self = shift;
+ my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
+ return if $func_name eq 'DESTROY';
+
+ if (ref $self && exists $self->{gd}) {
+ $self->{gd}->$func_name(@_);
+ } else {
+ my @result = $IMAGECLASS->$func_name(@_);
+ if (UNIVERSAL::isa($result[0],'GD::Image')) {
+ return $self->new($result[0]);
+ } else {
+ return @result;
+ }
+ }
+}
+
+=over 4
+
+=item $img = GD::Simple->new($x,$y [,$truecolor])
+
+=item $img = GD::Simple->new($gd)
+
+Create a new GD::Simple object. There are two forms of new(). In the
+first form, pass the width and height of the desired canvas, and
+optionally a boolean flag to request a truecolor image. In the second
+form, pass a previously-created GD::Image object.
+
+=cut
+
+# dual-purpose code - beware
+sub new {
+ my $pack = shift;
+
+ unshift @_,(100,100) if @_ == 0;
+
+ if (@_ >= 2) { # traditional GD::Image->new() call
+ my $gd = $IMAGECLASS->new(@_);
+ my $self = $pack->new($gd);
+ $self->clear;
+ return $self;
+ }
+
+ if (@_ == 1) { # initialize from existing image
+ my $gd = shift;
+ my $self = bless {
+ gd => $gd,
+ xy => [0,0],
+ font => gdSmallFont,
+ fontsize => 9,
+ turningangle => 0,
+ angle => 0,
+ pensize => 1,
+ },$pack;
+ $self->{bgcolor} = $self->translate_color(255,255,255);
+ $self->{fgcolor} = $self->translate_color(0,0,0);
+ return $self;
+ }
+}
+
+=item GD::Simple->class('GD');
+
+=item GD::Simple->class('GD::SVG');
+
+Select whether new() should use GD or GD::SVG internally. Call
+GD::Simple->class('GD::SVG') before calling new() if you wish to
+generate SVG images.
+
+If future GD subclasses are created, this method will subport them.
+
+=cut
+
+sub class {
+ my $pack = shift;
+ if (@_) {
+ $IMAGECLASS = shift;
+ eval "require $IMAGECLASS; 1" or die $@;
+ $IMAGECLASS = "$IMAGECLASS\:\:Image"
+ if $IMAGECLASS eq 'GD::SVG';
+ }
+ $IMAGECLASS;
+}
+
+=item $img->moveTo($x,$y)
+
+This call changes the position of the pen without drawing. It moves
+the pen to position ($x,$y) on the drawing canvas.
+
+=cut
+
+sub moveTo {
+ my $self = shift;
+ croak 'Usage GD::Simple->moveTo($x,$y)' unless @_ == 2;
+ my ($x,$y) = @_;
+ $self->{xy} = [$x,$y];
+}
+
+=item $img->move($dx,$dy)
+
+=item $img->move($dr)
+
+This call changes the position of the pen without drawing. When called
+with two arguments it moves the pen $dx pixels to the right and $dy
+pixels downward. When called with one argument it moves the pen $dr
+pixels along the vector described by the current pen angle.
+
+=cut
+
+sub move {
+ my $self = shift;
+ if (@_ == 1) { # polar coordinates -- this is r
+ $self->{angle} += $self->{turningangle};
+ my $angle = deg2rad($self->{angle});
+ $self->{xy}[0] += $_[0] * cos($angle);
+ $self->{xy}[1] += $_[0] * sin($angle);
+ }
+ elsif (@_ == 2) { # cartesian coordinates
+ $self->{xy}[0] += $_[0];
+ $self->{xy}[1] += $_[1];
+ } else {
+ croak 'Usage GD::Simple->move($dx,$dy) or move($r)';
+ }
+}
+
+=item $img->lineTo($x,$y)
+
+The lineTo() call simultaneously draws and moves the pen. It draws a
+line from the current pen position to the position defined by ($x,$y)
+using the current pen size and color. After drawing, the position of
+the pen is updated to the new position.
+
+=cut
+
+sub lineTo {
+ my $self = shift;
+ croak 'Usage GD::Simple->lineTo($x,$y)' unless @_ == 2;
+ $self->gd->line($self->curPos,@_,$self->fgcolor);
+ $self->moveTo(@_);
+}
+
+=item $img->line($dx,$dy)
+
+=item $img->line($dr)
+
+The line() call simultaneously draws and moves the pen. When called
+with two arguments it draws a line from the current position of the
+pen to the position $dx pixels to the right and $dy pixels down. When
+called with one argument, it draws a line $dr pixels long along the
+angle defined by the current pen angle.
+
+=cut
+
+sub line {
+ my $self = shift;
+ croak 'Usage GD::Simple->line($dx,$dy) or line($r)' unless @_ >= 1;
+ my @curPos = $self->curPos;
+ $self->move(@_);
+ my @newPos = $self->curPos;
+ $self->gd->line(@curPos,@newPos,$self->fgcolor);
+}
+
+=item $img->clear
+
+This method clears the canvas by painting over it with the current
+background color.
+
+=cut
+
+sub clear {
+ my $self = shift;
+ $self->gd->filledRectangle(0,0,$self->getBounds,$self->bgcolor);
+}
+
+=item $img->rectangle($x1,$y1,$x2,$y2)
+
+This method draws the rectangle defined by corners ($x1,$y1),
+($x2,$y2). The rectangle's edges are drawn in the foreground color and
+its contents are filled with the background color. To draw a solid
+rectangle set bgcolor equal to fgcolor. To draw an unfilled rectangle
+(transparent inside), set bgcolor to undef.
+
+=cut
+
+sub rectangle {
+ my $self = shift;
+ croak 'Usage GD::Simple->rectangle($x1,$y1,$x2,$y2)' unless @_ == 4;
+ my $gd = $self->gd;
+ my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
+ $gd->filledRectangle(@_,$bg) if defined $bg;
+ $gd->rectangle(@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
+}
+
+=item $img->ellipse($width,$height)
+
+This method draws the ellipse centered at the current location with
+width $width and height $height. The ellipse's border is drawn in the
+foreground color and its contents are filled with the background
+color. To draw a solid ellipse set bgcolor equal to fgcolor. To draw
+an unfilled ellipse (transparent inside), set bgcolor to undef.
+
+=cut
+
+sub ellipse {
+ my $self = shift;
+ croak 'Usage GD::Simple->ellipse($width,$height)' unless @_ == 2;
+ my $gd = $self->gd;
+ my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
+ $gd->filledEllipse($self->curPos,@_,$bg) if defined $bg;
+ $gd->ellipse($self->curPos,@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
+}
+
+=item $img->arc($cx,$cy,$width,$height,$start,$end [,$style])
+
+This method draws filled and unfilled arcs. See L<GD> for a
+description of the arguments. To draw a solid arc (such as a pie
+wedge) set bgcolor equal to fgcolor. To draw an unfilled arc, set
+bgcolor to undef.
+
+=cut
+
+sub arc {
+ my $self = shift;
+ croak 'Usage GD::Simple->arc($width,$height,$start,$end,$style)' unless @_ >= 4;
+ my ($width,$height,$start,$end,$style) = @_;
+ my $gd = $self->gd;
+ my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
+ my ($cx,$cy) = $self->curPos;
+
+ if ($bg) {
+ my @args = ($cx,$cy,$width,$height,$start,$end,$bg);
+ push @args,$style if defined $style;
+ $gd->filledArc(@args);
+ } else {
+ my @args = ($cx,$cy,$width,$height,$start,$end,$fg);
+ $gd->arc(@args);
+ }
+}
+
+=item $img->polygon($poly)
+
+This method draws filled and unfilled polygon using the current
+settings of fgcolor for the polygon border and bgcolor for the polygon
+fill color. See L<GD> for a description of creating polygons. To draw
+a solid polygon set bgcolor equal to fgcolor. To draw an unfilled
+polygon, set bgcolor to undef.
+
+=cut
+
+sub polygon {
+ my $self = shift;
+ croak 'Usage GD::Simple->polygon($poly)' unless @_ == 1;
+ my $gd = $self->gd;
+ my ($bg,$fg) = ($self->bgcolor,$self->fgcolor);
+ $gd->filledPolygon(@_,$bg) if defined $bg;
+ $gd->openPolygon(@_,$fg) if defined $fg && (!defined $bg || $bg != $fg);
+}
+
+=item $img->polyline($poly)
+
+This method draws polygons without closing the first and last vertices
+(similar to GD::Image->unclosedPolygon()). It uses the fgcolor to draw
+the line.
+
+=cut
+
+sub polyline {
+ my $self = shift;
+ croak 'Usage GD::Simple->polyline($poly)' unless @_ == 1;
+ my $gd = $self->gd;
+ my $fg = $self->fgcolor;
+ $gd->unclosedPolygon(@_,$fg);
+}
+
+=item $img->string($string)
+
+This method draws the indicated string starting at the current
+position of the pen. The pen is moved to the end of the drawn string.
+Depending on the font selected with the font() method, this will use
+either a bitmapped GD font or a TrueType font. The angle of the pen
+will be consulted when drawing the text. For TrueType fonts, any angle
+is accepted. For GD bitmapped fonts, the angle can be either 0 (draw
+horizontal) or -90 (draw upwards).
+
+For consistency between the TrueType and GD font behavior, the string
+is always drawn so that the current position of the pen corresponds to
+the bottom left of the first character of the text. This is different
+from the GD behavior, in which the first character of bitmapped fonts
+hangs down from the pen point.
+
+This method returns a polygon indicating the bounding box of the
+rendered text. If an error occurred (such as invalid font
+specification) it returns undef and an error message in $@.
+
+=cut
+
+sub string {
+ my $self = shift;
+ my $string = shift;
+ my $font = $self->font;
+ my @bounds;
+ if (ref $font && $font->isa('GD::Font')) {
+ my ($x,$y) = $self->curPos;
+ if ($self->angle == -90) {
+ $x -= $font->height;
+ $y -= $font->width;
+ $self->gd->stringUp($font,$x,$y,$string,$self->fgcolor);
+ $self->{xy}[1] -= length($string) * $font->width;
+ @bounds = ( ($self->{xy}[0],$y), ($x,$y), ($x,$self->{xy}[1]-$font->width), ($self->{xy}[0],$self->{xy}[1]-$font->width) );
+ } else {
+ $y -= $font->height;
+ $self->gd->string($font,$x,$y,$string,$self->fgcolor);
+ $self->{xy}[0] += length($string) * $font->width;
+ @bounds = ( ($x,$self->{xy}[1]), ($self->{xy}[0],$self->{xy}[1]), ($self->{xy}[0],$y), ($x,$y) );
+ }
+ }
+ else {
+ $self->useFontConfig(1);
+ @bounds = $self->stringFT($self->fgcolor,$font,
+ $self->fontsize,-deg2rad($self->angle), # -pi * $self->angle/180,
+ $self->curPos,$string);
+ return unless @bounds;
+ my ($delta_x,$delta_y) = $self->_string_width(@bounds);
+ $self->{xy}[0] += $delta_x;
+ $self->{xy}[1] += $delta_y;
+ }
+ my $poly = GD::Polygon->new;
+ while (@bounds) {
+ $poly->addPt(splice(@bounds,0,2));
+ }
+ return $poly;
+}
+
+=item $metrics = $img->fontMetrics
+
+=item ($metrics,$width,$height) = GD::Simple->fontMetrics($font,$fontsize,$string)
+
+This method returns information about the current font, most commonly
+a TrueType font. It can be invoked as an instance method (on a
+previously-created GD::Simple object) or as a class method (on the
+'GD::Simple' class).
+
+When called as an instance method, fontMetrics() takes no arguments
+and returns a single hash reference containing the metrics that
+describe the currently selected font and size. The hash reference
+contains the following information:
+
+ xheight the base height of the font from the bottom to the top of
+ a lowercase 'm'
+
+ ascent the length of the upper stem of the lowercase 'd'
+
+ descent the length of the lower step of the lowercase 'j'
+
+ lineheight the distance from the bottom of the 'j' to the top of
+ the 'd'
+
+ leading the distance between two adjacent lines
+
+=cut
+
+# return %$fontmetrics
+# keys: 'ascent', 'descent', 'lineheight', 'xheight', 'leading'
+sub fontMetrics {
+ my $self = shift;
+
+ unless (ref $self) { #class invocation -- create a scratch
+ $self = $self->new;
+ $self->font(shift) if defined $_[0];
+ $self->fontsize(shift) if defined $_[0];
+ }
+
+ my $font = $self->font;
+ my $metrics;
+
+ if (ref $font && $font->isa('GD::Font')) {
+ my $height = $font->height;
+ $metrics = {ascent => 0,
+ descent => 0,
+ lineheight => $height,
+ xheight => $height,
+ leading => 0};
+ }
+ else {
+ $self->useFontConfig(1);
+ my @mbounds = GD::Image->stringFT($self->fgcolor,$font,
+ $self->fontsize,0,
+ 0,0,'m');
+ my $xheight = $mbounds[3]-$mbounds[5];
+ my @jbounds = GD::Image->stringFT($self->fgcolor,$font,
+ $self->fontsize,0,
+ 0,0,'j');
+ my $ascent = $mbounds[7]-$jbounds[7];
+ my $descent = $jbounds[3]-$mbounds[3];
+
+ my @mmbounds = GD::Image->stringFT($self->fgcolor,$font,
+ $self->fontsize,0,
+ 0,0,"m\nm");
+ my $twolines = $mmbounds[3]-$mmbounds[5];
+ my $lineheight = $twolines - 2*$xheight;
+ my $leading = $lineheight - $ascent - $descent;
+ $metrics = {ascent => $ascent,
+ descent => $descent,
+ lineheight => $lineheight,
+ xheight => $xheight,
+ leading => $leading};
+ }
+
+ if ((my $string = shift) && wantarray) {
+ my ($width,$height) = $self->stringBounds($string);
+ return ($metrics,abs($width),abs($height));
+ }
+ return $metrics;
+}
+
+=item ($delta_x,$delta_y)= $img->stringBounds($string)
+
+This method indicates the X and Y offsets (which may be negative) that
+will occur when the given string is drawn using the current font,
+fontsize and angle. When the string is drawn horizontally, it gives
+the width and height of the string's bounding box.
+
+=cut
+
+sub stringBounds {
+ my $self = shift;
+ my $string = shift;
+ my $font = $self->font;
+ if (ref $font && $font->isa('GD::Font')) {
+ if ($self->angle == -90) {
+ return ($font->height,-length($string) * $font->width);
+ } else {
+ return (length($string) * $font->width,$font->height);
+ }
+ }
+ else {
+ $self->useFontConfig(1);
+ my @bounds = GD::Image->stringFT($self->fgcolor,$font,
+ $self->fontsize,-deg2rad($self->angle),
+ $self->curPos,$string);
+ return $self->_string_width(@bounds);
+ }
+}
+
+=item $delta_x = $img->stringWidth($string)
+
+This method indicates the width of the string given the current font,
+fontsize and angle. It is the same as ($img->stringBounds($string))[0]
+
+=cut
+
+sub stringWidth {
+ return ((shift->stringBounds(@_))[0]);
+}
+
+
+sub _string_width {
+ my $self = shift;
+ my @bounds = @_;
+ my $delta_x = abs($bounds[2]-$bounds[0]);
+ my $delta_y = abs($bounds[5]-$bounds[3]);
+ my $angle = $self->angle % 360;
+ if ($angle >= 0 && $angle < 90) {
+ return ($delta_x,$delta_y);
+
+ } elsif ($angle >= 90 && $angle < 180) {
+ return (-$delta_x,$delta_y);
+
+ } elsif ($angle >= 180 && $angle < 270) {
+ return (-$delta_x,-$delta_y);
+
+ } elsif ($angle >= 270 && $angle < 360) {
+ return ($delta_x,-$delta_y);
+ }
+}
+
+=item ($x,$y) = $img->curPos
+
+Return the current position of the pen. Set the current position
+using moveTo().
+
+=cut
+
+sub curPos { @{shift->{xy}}; }
+
+=item $font = $img->font([$newfont] [,$newsize])
+
+Get or set the current font. Fonts can be GD::Font objects, TrueType
+font file paths, or fontconfig font patterns like "Times:italic" (see
+L<fontconfig>). The latter feature requires that you have the
+fontconfig library installed and are using libgd version 2.0.33 or
+higher.
+
+As a shortcut, you may pass two arguments to set the font and the
+fontsize simultaneously. The fontsize is only valid when drawing with
+TrueType fonts.
+
+=cut
+
+sub font {
+ my $self = shift;
+ $self->{font} = shift if @_;
+ $self->{fontsize} = shift if @_;
+ $self->{font};
+}
+
+=item $size = $img->fontsize([$newfontsize])
+
+Get or set the current font size. This is only valid for TrueType
+fonts.
+
+=cut
+
+sub fontsize {
+ my $self = shift;
+ $self->{fontsize} = shift if @_;
+ $self->{fontsize};
+}
+
+=item $size = $img->penSize([$newpensize])
+
+Get or set the current pen width for use during line drawing
+operations.
+
+=cut
+
+sub penSize {
+ my $self = shift;
+ if (@_) {
+ $self->{pensize} = shift;
+ $self->gd->setThickness($self->{pensize});
+ }
+ $self->{pensize};
+}
+
+=item $angle = $img->angle([$newangle])
+
+Set the current angle for use when calling line() or move() with a
+single argument.
+
+Here is an example of using turn() and angle() together to draw an
+octagon. The first line drawn is the downward-slanting top right
+edge. The last line drawn is the horizontal top of the octagon.
+
+ $img->moveTo(200,50);
+ $img->angle(0);
+ $img->turn(360/8);
+ for (1..8) { $img->line(50) }
+
+=cut
+
+sub angle {
+ my $self = shift;
+ $self->{angle} = shift if @_;
+ $self->{angle};
+}
+
+=item $angle = $img->turn([$newangle])
+
+Get or set the current angle to turn prior to drawing lines. This
+value is only used when calling line() or move() with a single
+argument. The turning angle will be applied to each call to line() or
+move() just before the actual drawing occurs.
+
+Angles are in degrees. Positive values turn the angle clockwise.
+
+=cut
+
+# degrees, not radians
+sub turn {
+ my $self = shift;
+ $self->{turningangle} = shift if @_;
+ $self->{turningangle};
+}
+
+=item $color = $img->fgcolor([$newcolor])
+
+Get or set the pen's foreground color. The current pen color can be
+set by (1) using an (r,g,b) triple; (2) using a previously-allocated
+color from the GD palette; or (3) by using a symbolic color name such
+as "chartreuse." The list of color names can be obtained using
+color_names(). The special color name 'transparent' will create a
+completely transparent color.
+
+=cut
+
+sub fgcolor {
+ my $self = shift;
+ $self->{fgcolor} = $self->translate_color(@_) if @_;
+ $self->{fgcolor};
+}
+
+=item $color = $img->bgcolor([$newcolor])
+
+Get or set the pen's background color. The current pen color can be
+set by (1) using an (r,g,b) triple; (2) using a previously-allocated
+color from the GD palette; or (3) by using a symbolic color name such
+as "chartreuse." The list of color names can be obtained using
+color_names(). The special color name 'transparent' will create a
+completely transparent color.
+
+=cut
+
+sub bgcolor {
+ my $self = shift;
+ $self->{bgcolor} = $self->translate_color(@_) if @_;
+ $self->{bgcolor};
+}
+
+=item $index = $img->translate_color(@args)
+
+Translates a color into a GD palette or TrueColor index. You may pass
+either an (r,g,b) triple or a symbolic color name. If you pass a
+previously-allocated index, the method will return it unchanged.
+
+=cut
+
+sub translate_color {
+ my $self = shift;
+ return unless defined $_[0];
+ my ($r,$g,$b);
+ if (@_ == 1 && $_[0] =~ /^-?\d+/) { # previously allocated index
+ return $_[0];
+ }
+ elsif (@_ == 3) { # (rgb triplet)
+ ($r,$g,$b) = @_;
+ }
+ elsif (lc $_[0] eq 'transparent') {
+ return $TRANSPARENT ||= $self->alphaColor('white',127);
+ }
+ else {
+ $self->read_color_table unless %COLORS;
+ die "unknown color" unless exists $COLORS{lc $_[0]};
+ ($r,$g,$b) = @{$COLORS{lc $_[0]}};
+ }
+ return $self->colorResolve($r,$g,$b);
+}
+
+sub transparent {
+ my $self = shift;
+ my $index = $self->translate_color(@_);
+ $self->gd->transparent($index);
+}
+
+=item $index = $img->alphaColor(@args,$alpha)
+
+Creates an alpha color. You may pass either an (r,g,b) triple or a
+symbolic color name, followed by an integer indicating its
+opacity. The opacity value ranges from 0 (fully opaque) to 127 (fully
+transparent).
+
+=cut
+
+sub alphaColor {
+ my $self = shift;
+ return unless defined $_[0];
+ my ($r,$g,$b,$a);
+ if (@_ == 4) { # (rgb triplet)
+ ($r,$g,$b,$a) = @_;
+ } else {
+ $self->read_color_table unless %COLORS;
+ die "unknown color" unless exists $COLORS{lc $_[0]};
+ ($r,$g,$b) = @{$COLORS{lc $_[0]}};
+ $a = $_[1];
+ }
+ return $self->colorAllocateAlpha($r,$g,$b,$a);
+}
+
+=item @names = GD::Simple->color_names
+
+=item $translate_table = GD::Simple->color_names
+
+Called in a list context, color_names() returns the list of symbolic
+color names recognized by this module. Called in a scalar context,
+the method returns a hash reference in which the keys are the color
+names and the values are array references containing [r,g,b] triples.
+
+=cut
+
+sub color_names {
+ my $self = shift;
+ $self->read_color_table unless %COLORS;
+ return wantarray ? sort keys %COLORS : \%COLORS;
+}
+
+=item $gd = $img->gd
+
+Return the internal GD::Image object. Usually you will not need to
+call this since all GD methods are automatically referred to this object.
+
+=cut
+
+sub gd { shift->{gd} }
+
+sub read_color_table {
+ my $class = shift;
+ while (<DATA>) {
+ chomp;
+ last if /^__END__/;
+ my ($name,$r,$g,$b) = split /\s+/;
+ $COLORS{$name} = [hex $r,hex $g,hex $b];
+ }
+}
+
+sub setBrush {
+ my $self = shift;
+ my $brush = shift;
+ if ($brush->isa('GD::Simple')) {
+ $self->gd->setBrush($brush->gd);
+ } else {
+ $self->gd->setBrush($brush);
+ }
+}
+
+=item ($red,$green,$blue) = GD::Simple->HSVtoRGB($hue,$saturation,$value)
+
+Convert a Hue/Saturation/Value (HSV) color into an RGB triple. The
+hue, saturation and value are integers from 0 to 255.
+
+=cut
+
+sub HSVtoRGB {
+ my $self = shift;
+ @_ == 3 or croak "Usage: GD::Simple->HSVtoRGB(\$hue,\$saturation,\$value)";
+
+ my ($h,$s,$v)=@_;
+ my ($r,$g,$b,$i,$f,$p,$q,$t);
+
+ if( $s == 0 ) {
+ ## achromatic (grey)
+ return ($v,$v,$v);
+ }
+ $h %= 255;
+ $s /= 255; ## scale saturation from 0.0-1.0
+ $h /= 255; ## scale hue from 0 to 1.0
+ $h *= 360; ## and now scale it to 0 to 360
+
+ $h /= 60; ## sector 0 to 5
+ $i = $h % 6;
+ $f = $h - $i; ## factorial part of h
+ $p = $v * ( 1 - $s );
+ $q = $v * ( 1 - $s * $f );
+ $t = $v * ( 1 - $s * ( 1 - $f ) );
+
+ if($i<1) {
+ $r = $v;
+ $g = $t;
+ $b = $p;
+ } elsif($i<2){
+ $r = $q;
+ $g = $v;
+ $b = $p;
+ } elsif($i<3){
+ $r = $p;
+ $g = $v;
+ $b = $t;
+ } elsif($i<4){
+ $r = $p;
+ $g = $q;
+ $b = $v;
+ } elsif($i<5){
+ $r = $t;
+ $g = $p;
+ $b = $v;
+ } else {
+ $r = $v;
+ $g = $p;
+ $b = $q;
+ }
+ return (int($r+0.5),int($g+0.5),int($b+0.5));
+}
+
+=item ($hue,$saturation,$value) = GD::Simple->RGBtoHSV($hue,$saturation,$value)
+
+Convert a Red/Green/Blue (RGB) value into a Hue/Saturation/Value (HSV)
+triple. The hue, saturation and value are integers from 0 to 255.
+
+=back
+
+=cut
+
+sub RGBtoHSV {
+ my $self = shift;
+ my ($r, $g ,$bl) = @_;
+ my ($min,undef,$max) = sort {$a<=>$b} ($r,$g,$bl);
+ return (0,0,0) unless $max > 0;
+
+ my $v = $max;
+ my $s = 255 * ($max - $min)/$max;
+ my $h;
+ my $range = $max - $min;
+
+ if ($range == 0) { # all colors are equal, so monochrome
+ return (0,0,$max);
+ }
+
+ if ($max == $r) {
+ $h = 60 * ($g-$bl)/$range;
+ }
+ elsif ($max == $g) {
+ $h = 60 * ($bl-$r)/$range + 120;
+ }
+ else {
+ $h = 60 * ($r-$g)/$range + 240;
+ }
+
+ $h = int($h*255/360 + 0.5);
+
+ return ($h, $s, $v);
+}
+
+sub newGroup {
+ my $self = shift;
+ return $self->GD::newGroup(@_);
+}
+
+1;
+
+__DATA__
+white FF FF FF
+black 00 00 00
+aliceblue F0 F8 FF
+antiquewhite FA EB D7
+aqua 00 FF FF
+aquamarine 7F FF D4
+azure F0 FF FF
+beige F5 F5 DC
+bisque FF E4 C4
+blanchedalmond FF EB CD
+blue 00 00 FF
+blueviolet 8A 2B E2
+brown A5 2A 2A
+burlywood DE B8 87
+cadetblue 5F 9E A0
+chartreuse 7F FF 00
+chocolate D2 69 1E
+coral FF 7F 50
+cornflowerblue 64 95 ED
+cornsilk FF F8 DC
+crimson DC 14 3C
+cyan 00 FF FF
+darkblue 00 00 8B
+darkcyan 00 8B 8B
+darkgoldenrod B8 86 0B
+darkgray A9 A9 A9
+darkgreen 00 64 00
+darkkhaki BD B7 6B
+darkmagenta 8B 00 8B
+darkolivegreen 55 6B 2F
+darkorange FF 8C 00
+darkorchid 99 32 CC
+darkred 8B 00 00
+darksalmon E9 96 7A
+darkseagreen 8F BC 8F
+darkslateblue 48 3D 8B
+darkslategray 2F 4F 4F
+darkturquoise 00 CE D1
+darkviolet 94 00 D3
+deeppink FF 14 100
+deepskyblue 00 BF FF
+dimgray 69 69 69
+dodgerblue 1E 90 FF
+firebrick B2 22 22
+floralwhite FF FA F0
+forestgreen 22 8B 22
+fuchsia FF 00 FF
+gainsboro DC DC DC
+ghostwhite F8 F8 FF
+gold FF D7 00
+goldenrod DA A5 20
+gray 80 80 80
+green 00 80 00
+greenyellow AD FF 2F
+honeydew F0 FF F0
+hotpink FF 69 B4
+indianred CD 5C 5C
+indigo 4B 00 82
+ivory FF FF F0
+khaki F0 E6 8C
+lavender E6 E6 FA
+lavenderblush FF F0 F5
+lawngreen 7C FC 00
+lemonchiffon FF FA CD
+lightblue AD D8 E6
+lightcoral F0 80 80
+lightcyan E0 FF FF
+lightgoldenrodyellow FA FA D2
+lightgreen 90 EE 90
+lightgrey D3 D3 D3
+lightpink FF B6 C1
+lightsalmon FF A0 7A
+lightseagreen 20 B2 AA
+lightskyblue 87 CE FA
+lightslategray 77 88 99
+lightsteelblue B0 C4 DE
+lightyellow FF FF E0
+lime 00 FF 00
+limegreen 32 CD 32
+linen FA F0 E6
+magenta FF 00 FF
+maroon 80 00 00
+mediumaquamarine 66 CD AA
+mediumblue 00 00 CD
+mediumorchid BA 55 D3
+mediumpurple 100 70 DB
+mediumseagreen 3C B3 71
+mediumslateblue 7B 68 EE
+mediumspringgreen 00 FA 9A
+mediumturquoise 48 D1 CC
+mediumvioletred C7 15 85
+midnightblue 19 19 70
+mintcream F5 FF FA
+mistyrose FF E4 E1
+moccasin FF E4 B5
+navajowhite FF DE AD
+navy 00 00 80
+oldlace FD F5 E6
+olive 80 80 00
+olivedrab 6B 8E 23
+orange FF A5 00
+orangered FF 45 00
+orchid DA 70 D6
+palegoldenrod EE E8 AA
+palegreen 98 FB 98
+paleturquoise AF EE EE
+palevioletred DB 70 100
+papayawhip FF EF D5
+peachpuff FF DA B9
+peru CD 85 3F
+pink FF C0 CB
+plum DD A0 DD
+powderblue B0 E0 E6
+purple 80 00 80
+red FF 00 00
+rosybrown BC 8F 8F
+royalblue 41 69 E1
+saddlebrown 8B 45 13
+salmon FA 80 72
+sandybrown F4 A4 60
+seagreen 2E 8B 57
+seashell FF F5 EE
+sienna A0 52 2D
+silver C0 C0 C0
+skyblue 87 CE EB
+slateblue 6A 5A CD
+slategray 70 80 90
+snow FF FA FA
+springgreen 00 FF 7F
+steelblue 46 82 B4
+tan D2 B4 8C
+teal 00 80 80
+thistle D8 BF D8
+tomato FF 63 47
+turquoise 40 E0 D0
+violet EE 82 EE
+wheat F5 DE B3
+whitesmoke F5 F5 F5
+yellow FF FF 00
+yellowgreen 9A CD 32
+gradient1 00 ff 00
+gradient2 0a ff 00
+gradient3 14 ff 00
+gradient4 1e ff 00
+gradient5 28 ff 00
+gradient6 32 ff 00
+gradient7 3d ff 00
+gradient8 47 ff 00
+gradient9 51 ff 00
+gradient10 5b ff 00
+gradient11 65 ff 00
+gradient12 70 ff 00
+gradient13 7a ff 00
+gradient14 84 ff 00
+gradient15 8e ff 00
+gradient16 99 ff 00
+gradient17 a3 ff 00
+gradient18 ad ff 00
+gradient19 b7 ff 00
+gradient20 c1 ff 00
+gradient21 cc ff 00
+gradient22 d6 ff 00
+gradient23 e0 ff 00
+gradient24 ea ff 00
+gradient25 f4 ff 00
+gradient26 ff ff 00
+gradient27 ff f4 00
+gradient28 ff ea 00
+gradient29 ff e0 00
+gradient30 ff d6 00
+gradient31 ff cc 00
+gradient32 ff c1 00
+gradient33 ff b7 00
+gradient34 ff ad 00
+gradient35 ff a3 00
+gradient36 ff 99 00
+gradient37 ff 8e 00
+gradient38 ff 84 00
+gradient39 ff 7a 00
+gradient40 ff 70 00
+gradient41 ff 65 00
+gradient42 ff 5b 00
+gradient43 ff 51 00
+gradient44 ff 47 00
+gradient45 ff 3d 00
+gradient46 ff 32 00
+gradient47 ff 28 00
+gradient48 ff 1e 00
+gradient49 ff 14 00
+gradient50 ff 0a 00
+__END__
+
+=head1 COLORS
+
+This script will create an image showing all the symbolic colors.
+
+ #!/usr/bin/perl
+
+ use strict;
+ use GD::Simple;
+
+ my @color_names = GD::Simple->color_names;
+ my $cols = int(sqrt(@color_names));
+ my $rows = int(@color_names/$cols)+1;
+
+ my $cell_width = 100;
+ my $cell_height = 50;
+ my $legend_height = 16;
+ my $width = $cols * $cell_width;
+ my $height = $rows * $cell_height;
+
+ my $img = GD::Simple->new($width,$height);
+ $img->font(gdSmallFont);
+
+ for (my $c=0; $c<$cols; $c++) {
+ for (my $r=0; $r<$rows; $r++) {
+ my $color = $color_names[$c*$rows + $r] or next;
+ my @topleft = ($c*$cell_width,$r*$cell_height);
+ my @botright = ($topleft[0]+$cell_width,$topleft[1]+$cell_height-$legend_height);
+ $img->bgcolor($color);
+ $img->fgcolor($color);
+ $img->rectangle(@topleft,@botright);
+ $img->moveTo($topleft[0]+2,$botright[1]+$legend_height-2);
+ $img->fgcolor('black');
+ $img->string($color);
+ }
+ }
+
+ print $img->png;
+
+=head1 AUTHOR
+
+The GD::Simple module is copyright 2004, Lincoln D. Stein. It is
+distributed under the same terms as Perl itself. See the "Artistic
+License" in the Perl source code distribution for licensing terms.
+
+The latest versions of GD.pm are available at
+
+ http://stein.cshl.org/WWW/software/GD
+
+=head1 SEE ALSO
+
+L<GD>,
+L<GD::Polyline>,
+L<GD::SVG>,
+L<Image::Magick>
+
+=cut