Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

file 86 lines (67 sloc) 2.034 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
#!perl -w
use strict;
use Imager ':handy'; # handy functions like NC
use Imager::Fill;
use HTML::Entities;

if (!-d 'hatches') {
  mkdir 'hatches'
    or die "hatches directory does not exist and could not be created: $!";
}

open HTML, "> hatches.html"
  or die "Cannot create hatches.html: $!";
print HTML <<EOS;
<HTML><HEAD><TITLE>Imager - Hatched Fills</TITLE></HEAD><BODY BGCOLOR="FFFFFF">

<CENTER><FONT FACE="Helvetica, Arial" SIZE="6" COLOR="CC0000"><B>
Hatched Fills
</FONT></B></CENTER>
<HR WIDTH="65%" NOSHADE>
<TABLE><TR><TD WIDTH="70%">

<TABLE>
<TR><TH>Filled area</TH><TH>Close-up</TH><TH>Name</TH></TR>
EOS

my $red = NC(255, 0, 0);
my $yellow = NC(255, 255, 0);

# sort of a spiral
my $custom = [ 0xFF, 0x01, 0x7D, 0x45, 0x5D, 0x41, 0x7F, 0x00 ];

for my $hatch (Imager::Fill->hatches, $custom) {
  my $area = Imager->new(xsize=>100, ysize=>100);
  $area->box(xmax=>50, fill => { hatch => $hatch });
  $area->box(xmin=>50,
             fill => { hatch => $hatch,
                       fg=>$red,
                       bg=>$yellow });
  my $name = ref($hatch) ? "custom" : $hatch;

  $area->write(file=>"hatches/area_$name.png")
    or die "Cannot save hatches/area_$name.png: ",$area->errstr;

  my $subset = $area->crop(width=>20, height=>20);
  # we use the HTML to zoom up
  $subset->write(file=>"hatches/zoom_$name.png")
    or die "Cannot save hatches/zoom_$name.png: ",$subset->errstr;

  print HTML <<EOS;
<TR>
<TD><IMG SRC="hatches/area_$name.png" WIDTH="100" HEIGHT="100" BORDER=1></TD>
<TD><IMG SRC="hatches/zoom_$name.png" WIDTH="100" HEIGHT="100" BORDER=1></TD>
<TD>$name</TD>
</TR>
EOS
}

print HTML <<EOS;
</TABLE>

<P>The following code was used to generate this page:</p>

<PRE>
EOS

open SELF, "< $0"
  or die "Can't open myself: $!";
while (<SELF>) {
  print HTML encode_entities($_);
}
close SELF;

print HTML <<EOS;
</PRE>

<HR WIDTH="75%" NOSHADE ALIGN="LEFT">

Send errors/fixes/suggestions to: <B>tony</B>_at_<B>develop-help.com</B>

</TD></TR></TABLE>
</BODY>
</HTML>
EOS

close HTML;
Something went wrong with that request. Please try again.