Perl Advent Calendar 2006-12-11

Putting Tinsel on the Tree

by Bill Ricker

Lincoln Stein's GD provides everything you need to draw simple geometric shapes for web graphics. The GD API is very verbose though, so he created a simplified version: GD::Simple. A key feature of GD::Simple is the ability to specify colors by name as well as by RGB triple-ints. However, if you want to attempt pseudo-metallic tones in the flat colors available, the default 'gold' and 'silver' aren't enough. But of course CPAN comes to the rescue with Graphics::ColorNames, which provides names to tuple mapping for use with GD or any other packages. It provides Netscape/Mozilla, X-windows, and several other RGB name tables.

In addition to demonstrating use of ColorNames, our sammple includes an example of how to make your own color namespace. I created Graphics::ColorNames::Metallic.pm to provide a range of golden hues, plus copper and a "cooler" (bluer) silver than the gray 'silver' offered by existing tables.

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

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