samples/logo

   1 #!/usr/bin/perl -wT
   2 use Imager;
   3 use CGI qw(:standard);
   4 use strict;
   5
   6 # set this the directory you're keeping the font files in
   7 my $fontdir = '../fonts/';
   8
   9 # make sure we get a good font name
  10 my $fontname = param('font');
  11 if (!defined $fontname || $fontname =~ /\W/) {
  12   $fontname = 'arial';
  13 }
  14
  15 my $text = param('text');
  16 my $anim = param('anim');
  17 my $size = param('size') + 0;
  18 $size > 3 or $size=3;
  19 my $bgname = param('bg') || '000000';
  20 my $fgname = param('fg') || 'FFFFFF';
  21 my $border = param('border') || 2;
  22 my $trans = param('trans');
  23
  24 chdir '/tmp'; # bah!
  25
  26 my $font = Imager::Font->new(file=>$fontdir.$fontname.".ttf")
  27   or print STDERR "Cannot open font\n";
  28 print STDERR "Font $fontname\n";
  29 if (!-e $fontdir.$fontname.".ttf") {
  30   print STDERR "Cannot find font\n";
  31 }
  32
  33 my $fg = Imager::Color->new("#$fgname");
  34 my $bg = Imager::Color->new("#$bgname");
  35 if ($trans) {
  36   $bg = Imager::Color->new(($bg->rgba)[0,1,2], 0);
  37 }
  38
  39 my @box = $font->bounding_box(string=>$text, size=>$size, canon=>1);
  40
  41 my $xsize = $box[2]+$border*2;
  42 my $ysize = $box[3]+$border*2;
  43 $|=1;
  44
  45 # we get faster quantization if we build our own palette
  46 # we want 20 steps between fg and bg
  47 my @cols;
  48 my @fg = $fg->rgba;
  49 my @bg = $bg->rgba;
  50 my @steps = map { $bg[$_]-$fg[$_] } 0..2;
  51 push (@cols, $fg, $bg);
  52 for my $grad (1..19) {
  53   push(@cols, Imager::Color->new(map { $fg[$_]+$steps[$_]*$grad/20 } 0..2));
  54 }
  55 if ($anim) {
  56   my @im;
  57
  58   my $steps = int($size / 3) - 2;
  59   my $sz = $size - $steps * 3;
  60   while ($sz <= $size) {
  61     my $im = Imager->new(xsize=>$xsize, ysize=>$ysize, channels=>$trans?4:3);
  62
  63     $im->box(filled=>1, color=>$bg);
  64     my @sbox = $font->bounding_box(string=>$text, size=>$sz, canon=>1);
  65     my $x = ($xsize-$sbox[2])/2 - $sbox[0];
  66     my $y = ($ysize+$sbox[3])/2 + $sbox[1];
  67     $im->string(font=>$font, text=>$text, x=>$x,
  68                 y=>$y, size=>$sz, color=>$fg, aa=>1);
  69     push @im, $im;
  70     $sz += 3;
  71   }
  72   print "Content-Type: image/gif\n\n";
  73   Imager->write_multi({type=>'gif',
  74                        transp=>$trans?'threshold':'none',
  75                        make_colors=>'none',
  76                        colors=>\@cols,
  77                        fd=>fileno(STDOUT),
  78                        gif_disposal=>[(2) x @im],
  79                        gif_delays=>[(10) x @im ]}, @im);
  80 }
  81 else {
  82   my $im = Imager->new(xsize=>$xsize, ysize=>$ysize,
  83                       channels => $trans?4:3);
  84
  85   $im->box(filled=>1, color=>$bg);
  86
  87   $im->string(font=>$font, text=>$text, x=>-$box[0]+$border,
  88               y=>$box[3]+$box[1]+$border, size=>$size, color=>$fg, aa=>1);
  89   print "Content-Type: image/gif\n\n";
  90   $im->write(fd=>fileno(STDOUT), type=>'gif',
  91              transp=>$trans?'threshold':'none', gifquant=>'gen');
  92 }
  93
  94 __END__
  95
  96 =head1 NAME
  97
  98 logo - generates a simple logo using Imager
  99
 100 =head1 SYNOPSIS
 101
 102   (run as a CGI script)
 103
 104 =head1 DESCRIPTION
 105
 106 Given a font and number of parameters, described below, I<logo> draws
 107 text to an image and writes that result as a GIF to STDOUT, with the
 108 required CGI headers.
 109
 110 The parameters that logo takes are:
 111
 112 =over
 113
 114 =item font
 115
 116 the basename of the font file to be used in drawing the text
 117
 118 =item text
 119
 120 the text to draw
 121
 122 =item size
 123
 124 the height in pixels to draw the text
 125
 126 =item anim
 127
 128 if this is non-zero the text is animated, from a very small size to
 129 the size specified by I<size>
 130
 131 =item bg
 132
 133 the background color of the image.  Used as the combining color if
 134 transparent.
 135
 136 =back
 137
 138 =cut
 139