package Url2Image;
use GD;
use strict;
sub new
{
chdir "/virtual/twoshortplanks.com/www/html/f/" or die "Can't change to working DIR";
my $class = shift;
my $style = shift;
my $text = shift;
# create the object with default values
my $this = [$style,$text,{
# text apreance
FACE => "cinema",
SIZE => 12.0,
FG_R => 255,
FG_G => 255,
FG_B => 255,
# text postion
WIDTH => "TEXT",
HEIGHT => "TEXT",
ALIGNMENT => "LEFT",
V_ALIGNMENT => "BELOW",
AT_X => 0,
AT_Y => 0,
# the border
BD_WIDTH => 0,
BD_R => 255,
BD_G => 255,
BD_B => 255,
# the background
BG_R => 0,
BG_G => 0,
BG_B => 0,
BG_IMAGE => undef,
BG_AT_X => 0,
BG_AT_Y => 0,
BG_ALIGNMENT => "LEFT",
BG_V_ALIGNMENT => "BELOW",
# the output format
OUTPUT => "PNG"
},];
# our father, who art in heaven...
bless $this, $class;
# read in the config options from the file, possibly
# overwriting the default values
$this->read_config_file;
# cache the image to memory
$this->create_image;
# return the object.
$this
}
# reads the config file from the correct place
# given what the style is
sub read_config_file
{
my $this = shift;
# get the style
my ($style) = $this->[0] =~ /^([A-Za-z0-9_]*)$/;
open (CONFIG, "$style/.fontrc") or return;
while (<CONFIG>)
{
chomp; # no newlines
s/#.*//; # no comments
s/^\s+//; # no start whitespace
s/\s+$//; # no end whitespace
next unless length; # anything left?
my ($var, $value) = split (/\s*=\s*/,$_,2);
$this->[2]->{$var} = $value;
}
close CONFIG;
}
sub print
{
my $this = shift;
binmode STDOUT;
if ($this->[2]{OUTPUT} eq 'PNG')
{
print "Content-type: image/png\n\n";
print $this->[3]->png;
}
else
{
print "Content-type: image/jpeg\n\n";
print $this->[3]->jpeg;
}
}
sub get_string
{
my $this = shift;
$_ = $this->[1];
s/_/ /g;
s/&([0-9]+);/chr($1)/ge;
s/&slash;/\//g;
s/ / /g;
s/</</g;
s/>/>/g;
s/"e;/"/g; #"
s/&/&/g;
# certain ends overide the default...
if (s/.png$//) { $this->[2]{OUTPUT} = "PNG" ; return $_}
if (s/.jpg$//) { $this->[2]{OUTPUT} = "JPG" ; return $_}
return $_;
}
sub create_image
{
my $this = shift;
my $text = $this->get_string;
my $font = "fonts/$this->[2]{FACE}.ttf";
# work out the size of the font
my @bounds = GD::Image->stringTTF(0,$font,$this->[2]{SIZE},0,0,0,$text);
die "couldn't find font!" unless (defined(@bounds));
my $text_width = $bounds[2]+1;
my $text_height = $bounds[3]-$bounds[7]+2;
# load the background image if there is one
my $bg_image;
my $bg_width;
my $bg_height;
if ($this->[2]{BG_IMAGE})
{
$bg_image = GD::Image->new("images/" . $this->[2]{BG_IMAGE}) or die "Can't load image $this->[2]{BG_IMAGE}";
($bg_width,$bg_height) = $bg_image->getBounds();
}
# define the width
my $width;
if ($this->[2]->{WIDTH} =~ /^IMAGE/)
{
$width = $bg_width;
$' =~ m#(\+|-)(.*)$#;
if ($1)
{
if ($1 eq '+')
{$width += $2}
else
{$width -= $2}
}
}
elsif ($this->[2]->{WIDTH} =~ /^TEXT/)
{
$width = $text_width;
$' =~ m#(\+|-)(.*)$#;
if ($1)
{
if ($1 eq '+')
{$width += $2}
else
{$width -= $2}
}
}
else
{
$width = $this->[2]{WIDTH} +0;
}
# define the height
my $height;
if ($this->[2]->{HEIGHT} =~ /^IMAGE/)
{
$height = $bg_height;
$' =~ m#(\+|-)(.*)$#;
if ($1)
{
if ($1 eq '+')
{$height += $2}
else
{$height -= $2}
}
}
elsif ($this->[2]->{HEIGHT} =~ /^TEXT/)
{
$height = $text_height;
$' =~ m#(\+|-)(.*)$#;
if ($1)
{
if ($1 eq '+')
{$height += $2}
else
{$height -= $2}
}
}
else
{
$height = $this->[2]{HEIGHT} +0;
}
# create the image
my $image = new GD::Image($width, $height);
# make the colours
my $background = $image->colorAllocate($this->[2]{BG_R},$this->[2]{BG_G},$this->[2]{BG_B});
my $foreground = $image->colorAllocate($this->[2]{FG_R},$this->[2]{FG_G},$this->[2]{FG_B});
my $border = $image->colorAllocate($this->[2]{BD_R},$this->[2]{BD_G},$this->[2]{BD_B});
# paste the background image if there is one
if ($bg_image)
{
my $bgx;
my $bgy;
# we have control of the horizontal
if ($this->[2]{BG_ALIGNMENT} =~ /^RIGHT$/)
{
$bgx = $this->[2]{BG_AT_X} - $bg_width;
}
elsif ($this->[2]{BG_ALIGNMENT} =~ /^CENT(ER|RE)$/)
{
$bgx = $this->[2]{BG_AT_X} - int($bg_width/2);
}
elsif ($this->[2]{BG_ALIGNMENT} =~ /^IMAGE_CENT(ER|RE)$/)
{
$bgx = int($width/2 - $bg_width/2) + $this->[2]{BG_AT_X};
}
elsif ($this->[2]{BG_ALIGNMENT} =~ /^FLUSH_RIGHT$/)
{
$bgx = $width - $bg_width + $this->[2]{BG_AT_X};
}
else
{
$bgx = $this->[2]{BG_AT_X};
}
# and the vertical - do not adjust your set
if ($this->[2]{BG_V_ALIGNMENT} =~ /^ABOVE$/)
{
$bgy = $this->[2]{BG_AT_Y} - $bg_height;
}
elsif ($this->[2]{BG_V_ALIGNMENT} =~ /^CENT(ER|RE)$/)
{
$bgy = $this->[2]{BG_AT_Y} - int($bg_height/2);
}
elsif ($this->[2]{BG_V_ALIGNMENT} =~ /^IMAGE_CENT(ER|RE)$/)
{
$bgy = int($height/2 - $bg_height/2) + $this->[2]{BG_AT_Y} ;
}
elsif ($this->[2]{BG_V_ALIGNMENT} =~ /^FLUSH_BOTTOM$/)
{
$bgy = $height - $bg_height + $this->[2]{BG_AT_Y};
}
else
{
$bgy = $this->[2]{BG_AT_Y};
}
# actually copy across the image (cross fingers)
$image->copy($bg_image,$bgx,$bgy,0,0,$bg_width,$bg_height);
}
# work out where the text is going to go
my $x;
my $y;
# we have control of the horizontal
if ($this->[2]{ALIGNMENT} =~ /^RIGHT$/)
{
$x = $this->[2]{AT_X} - $text_width;
}
elsif ($this->[2]{ALIGNMENT} =~ /^CENT(ER|RE)$/)
{
$x = $this->[2]{AT_X} - int($width/2);
}
elsif ($this->[2]{ALIGNMENT} =~ /^IMAGE_CENT(ER|RE)$/)
{
$x = int($width/2 - $text_width/2) + $this->[2]{AT_X};
}
elsif ($this->[2]{ALIGNMENT} =~ /^FLUSH_RIGHT$/)
{
$x = $width - $text_width + $this->[2]{AT_X};
}
else
{
$x = $this->[2]{AT_X};
}
# and the vertical - do not adjust your set
if ($this->[2]{V_ALIGNMENT} =~ /^ABOVE$/)
{
$y = $this->[2]{AT_Y} - $text_height;
}
elsif ($this->[2]{V_ALIGNMENT} =~ /^CENT(ER|RE)$/)
{
$y = $this->[2]{AT_Y} - int($text_height/2);
}
elsif ($this->[2]{V_ALIGNMENT} =~ /^IMAGE_CENT(ER|RE)$/)
{
$y = int($height/2 - $text_height/2) + $this->[2]{AT_Y} ;
}
elsif ($this->[2]{V_ALIGNMENT} =~ /^FLUSH_BOTTOM$/)
{
$y = $height - $text_height + $this->[2]{AT_Y};
}
else
{
$y = $this->[2]{BG_AT_Y};
}
# finally draw the text
my @bounds = $image->stringTTF($foreground,$font,$this->[2]{SIZE},0,$x,$y-$bounds[7],$text)
or die "Coundn't write text $text";
# do the border
if ($this->[2]{BD_WIDTH})
{
foreach (0..$this->[2]{BD_WIDTH}-1)
{
$image->rectangle($_,$_,$width-$_-1,$height-$_-1,$border);
}
}
# extract the name of the file
my ($style) = $this->[0] =~ /^([A-Za-z0-9_]*)$/;
my ($txt) = $this->[1] =~ /^([+-=A-Za-z0-9_&;\[\]:"'()]*)$/; # ";
# check we got a legal filename out
die unless (length($style) && length($txt));
# check we're not overwriting a dot file (v. bad)
die if ($txt =~ /^\./);
# save to the correct file. This probably shouldn't be hardcoded.
unless ($this->[2]{NO_WRITE})
{
open OUTPUT,">$style/$txt" or die "$!";
binmode OUTPUT;
if ($this->[2]{OUTPUT} eq 'JPG')
{
print OUTPUT $image->jpeg;
}
else
{
print OUTPUT $image->png;
}
close OUTPUT;
}
# return the image
$this->[3] = $image;
}
1
syntax highlighted by Code2HTML, v. 0.8.12