projects / imager.git / blame
| Commit | Line | Data |
|---|---|---|
| f1ac5027 TC |
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; |