$ perl mod11.pl > tree.png
Center @ 240 400 at tree.pl line 29, <DATA> line 191.

Well, the balls look a little too random compared to a real tree — randomness clusters more than is acceptable in a nice arrangement. At least there's something I do better in real-life than on-line! The tinsel doesn't look half shabby, though.

An interesting interface to Graphics::ColorNames is provided by Acme::AutoColor. In spite of its home in the Acme::* namespace, it could prove useful. Through the magic of AUTOLOAD, the module allows one access to colornamed subroutines like RED(), GREEN() and GOLD() or any others offered in a Graphics::ColorNames table. (It's actually case-insensitive, but since you'd be using them as constants you'd make them UPPERCASE, right?)

mod11.pl - Painting a Happy Tree^*

   1 #!perl -w
   2 use strict;
   3 use warnings;
   4 
   5 # Xmas tree PNG on stdout
   6 use GD::Simple;
   7 
   8 # create a new image
   9 my ($imgWide, $imgTall) = (480, 480);
  10 my $img = GD::Simple->new($imgWide, $imgTall);
  11 
  12 # my Custom metallics
  13 use Graphics::ColorNames qw(hex2tuple);
  14 tie our %colors, 'Graphics::ColorNames', 'Metallic';
  15 my $gold   = $img->colorAllocate(hex2tuple $colors{gold3});
  16 my $silver = $img->colorAllocate(hex2tuple $colors{silver});
  17 
  18 # Draw Border and background
  19 $img->bgcolor('lightblue');
  20 my $border = 50;
  21 $img->fgcolor($gold);
  22 $img->penSize($border, $border);
  23 $img->rectangle($border/2, $border/2, $imgWide-$border/2, $imgTall-$border/2);
  24 
  25 
  26 # Tree is a triangle based at @Center
  27 my @Center=(240, 400);
  28 warn "Center @ @Center";
  29 # but Draw trunk first, so it's under foliage
  30 $img->fgcolor(undef);
  31 $img->bgcolor('brown');
  32 $img->rectangle(
  33 		add2(@Center,(-20, -30)), 
  34 		add2(@Center,(+20, +30)),
  35 	       );
  36 # Foliage
  37 my ($wt, $ht)=(150, 300);                     # $wt = half width
  38 my @Top;
  39 my $poly = new GD::Polygon;
  40 $poly->addPt(     add2(@Center,(-$wt,   0)));
  41 $poly->addPt(     add2(@Center,(+$wt,   0)));
  42 $poly->addPt(@Top=add2(@Center,(   0,-$ht))); # y goes Down page :-(
  43 $img->bgcolor('green');                       # trees are green
  44 $img->fgcolor('green');
  45 $img->penSize(1, 1);
  46 $img->polygon($poly);                         # draw tree
  47 
  48 my @Balls=(
  49 	   'mediumblue', 'purple', 'crimson', 'darkorange',
  50 	   $img->colorAllocate(hex2tuple $colors{gold1}),
  51 	  );
  52 
  53 # Always hang tinsel last on a real tree, 
  54 # but to make it fall "behind" balls, we draw it first.
  55 HangTinsel(  add2(@Center, randPoint($wt, -$ht))) for (1..900);
  56 
  57 # Hang a ball on the highest bough2
  58 HangBall( 4, @Top);
  59 # Random balls
  60 HangBall($_, add2(@Center, randPoint($wt, -$ht)))
  61   for( 1 .. (9 * scalar @balls) );
  62 
  63 # convert into png data
  64 print $img->png;

Subroutines

  70 #center a ball on X, Y
  71 sub HangBall{                                 # number, X, Y
  72         my $n=shift;                          # leave point in @_
  73         my $m = scalar(@Balls);
  74         my ($c1,$c2)=(
  75 		      $n % $m,                # sequential through colors
  76 		      rand($m),               # random border/shine
  77 		     );
  78         $img->bgcolor($Balls[$c1]);
  79         $img->fgcolor($Balls[$c2]);
  80         $img->penSize(1, 1);
  81         $img->moveTo(@_);
  82         $img->ellipse(15, 15);                # circle is ellipse where a=b=r
  83 }
  84 
  85 #tinsel hangs from: X, Y
  86 sub HangTinsel{
  87         $img->fgcolor($silver);
  88         $img->bgcolor(undef);
  89         $img->penSize(2, 2);
  90         $img->angle(90);
  91         $img->moveTo(@_);
  92         $img->line(10);
  93 }
  94 
  95 
  96 # add points: (X,Y),(a,b)-> (X+a, Y+b). 
  97 # Points can be passed as arrays, lists, or coordinates; Perl flattens free
  98 sub add2 {
  99         warn "Useless use of add2() for points in scalar context" unless wantarray; 
 100         my ($x1, $y1, $x2, $y2)=@_;
 101         my $sum=[($x1+$x2), ($y1+$y2)];
 102         return @{$sum};
 103 }
 104 
 105 #rnadom point within bounds: half-width, height
 106 sub randPoint{
 107         # Pick a point in a rectangle
 108         # with two random reals 0..1
 109         # but transform into 
 110         # triangle, as they have the same
 111         # area -
 112         #    /\     ^   | |
 113         #   /__\    h   |_|
 114         #    ww  = 2*w   w 
 115         # before or after usual scaling 1*1 to w*h 
 116 
 117         my ($wt, $ht)=@_;
 118         my ($x, $y)=(rand(), rand());
 119         if( ($x+$y) > 1 ){ 
 120                 # fold upper right half rectangle
 121                 # to   lower right half triangle
 122                 $x = -1*(1 - $x);
 123                 $y = 1 - $y; 
 124         }
 125         return @{[ $wt*$x, $ht*$y ]};
 126 }

Metallic.pm

   1 package Graphics::ColorNames::Metallic;
   2 # Custom Metallic table for Graphics::ColorName,
   3 # from Graphics::ColorNames doc, with additions from X table.
   4 
   5 sub NamesRgbTable() {
   6 use integer;
   7         return {
   8         copper => 0xb87333,
   9         silver => 0xe6e8fa, # others use C0C0C0 which is just light-grey :-(
  10 
  11         gold   => 0xcd7f32,
  12         gold1  => 0xffd700, # X
  13         gold2  => 0xeec900, # X
  14         gold3  => 0xcdad00, # X
  15         gold4  => 0x8b7500, # X
  16         };
  17 }
  18 
  19  1;

My apologies to James Taylor and Judy Garland for alluding to Sinatra's bowdlerization of everyone's favorite tune from Xmas 1944 and 2001 in the code comments -- Bill