#!/usr/local/bin/perl
use strict;
$|++;

my $q = do {
  if ($ENV{MOD_PERL}) {
    require Apache::Request;
    Apache::Request->new(Apache->request);
  } else {
    require CGI;
    CGI->new;
  }
};

## inputs
my $text = $q->param('text') || "submit";
my $fgcolor = $q->param('color') || "blue";
my $bgcolor = $q->param('bg') || "lightblue";
my $size = $q->param('size') || 18;

## start the clock
my @times = (time, times);

tr/\020-\176//cd for $text, $fgcolor, $bgcolor, $size;
my $key = join "\n", $text, $fgcolor, $bgcolor, $size;

require Cache::FileCache;
my $cache = Cache::FileCache->new
  ({default_expires_in => 86400,
    auto_purge_interval => 86400,
    namespace => 'button'});

my $image;
if (my $obj = $cache->get_object($key)) {
  $obj->set_expires_at(time + 86400); # keep it fresh
  $image = $obj->get_data;      # still might fail, perhaps
}

if (not $image) {
  require Image::Magick;
  ## configuration constants
  my $border = $size / 2;
  my $font = 'helvetica';

  ## first, draw the text so that we know how big to make the button
  my $label = Image::Magick->new
    (size => sprintf("%dx%d",
                     $size * length($text) + $border * 2 + 2,
                     $size * 2 + $border * 2));
  $label->Read("xc:$bgcolor");
  $label->Annotate(gravity => 'West',
                   font => $font,
                   fill => $fgcolor,
                   pointsize => $size,
                   x => $border + 1,
                   text => $text);
  ## make background transparent:
  $label->Draw(primitive => 'matte', points => '0,0', meth => 'replace');
  ## change to "0 and" to see original canvas (for tweaking size above)
  1 and $label->Crop("0x0+$border+$border");
  ## debugging (change to "1 and") to see bounding box:
  0 and $label->Border(color => 'red', geom => '1x1');
  ## get size for the button
  my ($w, $h) = $label->Get(qw(width height));

  ## now, draw the button to be the size of the text
  my $background = Image::Magick->new(size => $w . 'x' . $h);
  $background->Read('xc:#fdfeff');  # unlikely color
  $background->Draw(prim => 'roundRectangle',
                    antialias => 0, # prevent partial background fluff
                    fill => $bgcolor,
                    points => sprintf("0,%d %d,0 %d,%d",
                                      $h - 1, $w - 1, $border * 2, $border));
  $background->Draw(primitive => 'matte', points => '0,0', meth => 'replace');

  ## and put the text on the button
  $background->Composite(image => $label);

  ## render it
  $background->Set(magick => 'gif');
  $image = $background->ImageToBlob;
  $cache->set($key, $image);
}

print "Content-type: image/gif\n\n$image";

@times = map { $_ - shift @times } time, times;
printf STDERR "buttonmaker: real=%d user=%.2f sys=%.2f\n", @times;