samples/hatches.pl

   1 #!perl -w
   2 use strict;
   3 use Imager ':handy'; # handy functions like NC
   4 use Imager::Fill;
   5 use HTML::Entities;
   6
   7 if (!-d 'hatches') {
   8   mkdir 'hatches'
   9     or die "hatches directory does not exist and could not be created: $!";
  10 }
  11
  12 open HTML, "> hatches.html"
  13   or die "Cannot create hatches.html: $!";
  14 print HTML <<EOS;
  15 <HTML><HEAD><TITLE>Imager - Hatched Fills</TITLE></HEAD><BODY BGCOLOR="FFFFFF">
  16
  17 <CENTER><FONT FACE="Helvetica, Arial" SIZE="6" COLOR="CC0000"><B>
  18 Hatched Fills
  19 </FONT></B></CENTER>
  20 <HR WIDTH="65%" NOSHADE>
  21 <TABLE><TR><TD WIDTH="70%">
  22
  23 <TABLE>
  24 <TR><TH>Filled area</TH><TH>Close-up</TH><TH>Name</TH></TR>
  25 EOS
  26
  27 my $red = NC(255, 0, 0);
  28 my $yellow = NC(255, 255, 0);
  29
  30 # sort of a spiral
  31 my $custom = [ 0xFF, 0x01, 0x7D, 0x45, 0x5D, 0x41, 0x7F, 0x00 ];
  32
  33 for my $hatch (Imager::Fill->hatches, $custom) {
  34   my $area = Imager->new(xsize=>100, ysize=>100);
  35   $area->box(xmax=>50, fill => { hatch => $hatch });
  36   $area->box(xmin=>50,
  37              fill => { hatch => $hatch,
  38                        fg=>$red,
  39                        bg=>$yellow });
  40   my $name = ref($hatch) ? "custom" : $hatch;
  41
  42   $area->write(file=>"hatches/area_$name.png")
  43     or die "Cannot save hatches/area_$name.png: ",$area->errstr;
  44
  45   my $subset = $area->crop(width=>20, height=>20);
  46   # we use the HTML to zoom up
  47   $subset->write(file=>"hatches/zoom_$name.png")
  48     or die "Cannot save hatches/zoom_$name.png: ",$subset->errstr;
  49
  50   print HTML <<EOS;
  51 <TR>
  52   <TD><IMG SRC="hatches/area_$name.png" WIDTH="100" HEIGHT="100" BORDER=1></TD>
  53   <TD><IMG SRC="hatches/zoom_$name.png" WIDTH="100" HEIGHT="100" BORDER=1></TD>
  54   <TD>$name</TD>
  55 </TR>
  56 EOS
  57 }
  58
  59 print HTML <<EOS;
  60 </TABLE>
  61
  62 <P>The following code was used to generate this page:</p>
  63
  64 <PRE>
  65 EOS
  66
  67 open SELF, "< $0"
  68   or die "Can't open myself: $!";
  69 while (<SELF>) {
  70   print HTML encode_entities($_);
  71 }
  72 close SELF;
  73
  74 print HTML <<EOS;
  75 </PRE>
  76
  77 <HR WIDTH="75%" NOSHADE ALIGN="LEFT">
  78
  79 Send errors/fixes/suggestions to: <B>tony</B>_at_<B>develop-help.com</B>
  80
  81 </TD></TR></TABLE>
  82 </BODY>
  83 </HTML>
  84 EOS
  85
  86 close HTML;