samples/combines.pl

   1 #!perl -w
   2 use strict;
   3 use Imager ':handy';
   4 use Imager::Fill;
   5 use Imager::Fountain;
   6 use HTML::Entities;
   7
   8 my $fountain = Imager::Fountain->new();
   9 $fountain->add(end=>0.8,
  10                c0=>NC(hsv=>[90, 0.5, 0.5], alpha=>64),
  11                c1=>NC(hsv=>[90, 1, 0.8], alpha=>192),
  12                color=>'hueup');
  13 $fountain->add(start=>0.8,
  14                c0=>NC(hsv=>[90, 1, 0.8], alpha=>192),
  15                c1=>NC(255, 255, 255, 128));
  16
  17 unless (-d 'combines') {
  18   mkdir 'combines'
  19     or die "combines directory does not exist and could not be created: $!";
  20 }
  21
  22 open HTML, "> combines.html"
  23   or die "Cannot create combines.html: $!";
  24
  25 print HTML <<EOS;
  26 <HTML><HEAD><TITLE>Imager - Combining Modes</TITLE></HEAD><BODY BGCOLOR="FFFFFF">
  27
  28 <CENTER><FONT FACE="Helvetica, Arial" SIZE="6" COLOR="CC0000"><B>
  29 Combining Modes
  30 </FONT></B></CENTER>
  31 <HR WIDTH="65%" NOSHADE>
  32 <TABLE><TR><TD WIDTH="70%">
  33
  34 <TABLE>
  35 <TR><TH>Name</TH><TH>Result</TH><TH>Base</TH></TR>
  36 EOS
  37
  38 # build our base image
  39 # this is similar to the test image used for some of Imager's tests
  40 my $green = NC(0, 255, 0);
  41 my $lblue = NC(128, 128, 255);
  42 my $dred = NC(128, 64, 64);
  43 my $base = Imager->new(xsize=>150, ysize=>150);
  44 $base->box(xmin=>70, ymin=>25, xmax=>130, ymax=>125, color=>$green, filled=>1);
  45 $base->box(xmin=>20, ymin=>25, xmax=>80, ymax=>125, color=>$lblue, filled=>1);
  46 $base->arc(r=>30, color=>$dred);
  47 $base->filter(type=>'conv', coef=>[0.1, 0.2, 0.4, 0.2, 0.1]);
  48
  49 $base->write(file=>"combines/base.jpg", jpegquality=>100)
  50   or die "Cannot save combines/base.jpg: ",$base->errstr;
  51
  52 # we fill the top with a fountain fill, and the bottom with a solid color
  53 my $solid_left = NC(128, 32, 32, 128);
  54 my $solid_right = NC(128, 32, 32, 255);
  55
  56 for my $combine (Imager::Fill->combines) {
  57   my $work = $base->copy();
  58   $work->box(ymax=>74,
  59              fill=>{ fountain=>'radial',
  60                      combine=>$combine,
  61                      segments=>$fountain,
  62                      xa=>75, ya=>50, xb=>15, yb=>50,
  63                      repeat=>'sawtooth'
  64                    })
  65     or die $work->errstr;
  66   $work->box(ymin=>75, xmax=>74,
  67              fill=>{ solid=>$solid_left, combine=>$combine })
  68     or die $work->errstr;
  69   $work->box(ymin=>75, xmin=>75,
  70              fill=>{ solid=>$solid_right, combine=>$combine })
  71     or die $work->errstr;
  72
  73   $work->write(file=>"combines/$combine.jpg", jpegquality=>100)
  74     or die "Cannot save combines/$combine.jpg: ",$work->errstr;
  75
  76   print HTML <<HTML
  77 <TR>
  78   <TD>$combine</TD>
  79   <TD><IMG SRC="combines/$combine.jpg" WIDTH="150" HEIGHT="150"></TD>
  80   <TD><IMG SRC="combines/base.jpg" WIDTH="150" HEIGHT="150"></TD>
  81 </TR>
  82 HTML
  83 }
  84
  85 print HTML <<EOS;
  86 </TABLE>
  87
  88 <P>The following code was used to generate this page:</p>
  89
  90 <PRE>
  91 EOS
  92
  93 open SELF, "< $0"
  94   or die "Can't open myself: $!";
  95 while (<SELF>) {
  96   print HTML encode_entities($_);
  97 }
  98 close SELF;
  99
 100 print HTML <<EOS;
 101 </PRE>
 102
 103 <HR WIDTH="75%" NOSHADE ALIGN="LEFT">
 104
 105 Send errors/fixes/suggestions to: <B>tony</B>_at_<B>develop-help.com</B>
 106
 107 </TD></TR></TABLE>
 108 </BODY>
 109 </HTML>
 110 EOS
 111
 112 close HTML;