package AAC::Pvoice::Bitmap;
use strict;
use warnings;
use Wx qw(:everything);
use Wx::Perl::Carp;
use Image::Magick;
use IO::Scalar;
use File::Cache;
use File::stat;
use File::Temp qw( :POSIX );
our $VERSION = sprintf("%d.%02d", q$Revision: 1.12 $=~/(\d+)\.(\d+)/);
use base qw(Wx::Bitmap);
our $cache;
BEGIN
{
Wx::InitAllImageHandlers;
$cache = File::Cache->new({namespace => 'images'});
}
#----------------------------------------------------------------------
sub new
{
my $class = shift;
my ($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) = @_;
$caption||='';
$parent_background=Wx::Colour->new(220,220,220) if not defined $parent_background;
my $config = Wx::ConfigBase::Get;
$caption = $config->ReadInt('Caption')?$caption:'';
# return ReadImage($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) if $file;
return ReadImageMagick($file, $MAX_X, $MAX_Y, $caption, $background, $blowup, $parent_background) if $file;
return DrawCaption($MAX_X, $MAX_Y, $caption, $background, $parent_background);
}
sub ReadImage
{
my $file = shift;
my ($x, $y, $caption, $background, $blowup, $parent_background) = @_;
return DrawCaption($x, $y, '?', $background, $parent_background) unless -r $file;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
my $newbmp;
$caption ||='';
$blowup ||=0;
$background = $parent_background unless defined $background;
my $ibg = wxColor2hex($background) if (ref($background) eq 'Wx::Colour');
my $pbg = wxColor2hex($parent_background) if (ref($parent_background) eq 'Wx::Colour');
my $stat = stat($file);
my $mtime = $stat->mtime();
my $image = $cache->get("$file-$x-$y-$caption-$ibg-$blowup-$pbg-$mtime");
if (!$image)
{
my $capdc = Wx::MemoryDC->new();
my $cpt = 10;
my ($cfont, $cw, $ch) = (wxNullFont, 0, 0);
if ($caption)
{
do
{
$cfont = Wx::Font->new( $cpt, # font size
wxSWISS, # font family
wxNORMAL, # style
wxNORMAL, # weight
0,
'Comic Sans MS', # face name
wxFONTENCODING_SYSTEM);
($cw, $ch, undef, undef) = $capdc->GetTextExtent($caption, $cfont);
$cpt--;
} until ($cw<$x);
}
my $img = Wx::Image->new($x, $y-$ch);
$img->SetOption('quality', 100);
my $rc = $img->LoadFile($file, wxBITMAP_TYPE_ANY);
return wxNullBitmap if not $rc;
my ($w,$h) = ($img->GetWidth, $img->GetHeight);
if (($w > $x) || ($h > ($y-$ch)))
{
my ($newx, $newy) = ($w, $h);
if ($w > $x)
{
my $factor = $w/$x;
return wxNullBitmap if not $factor;
$newy = int($h/$factor);
($w,$h) = ($x, $newy);
}
if ($h > ($y-$ch))
{
my $factor = $h/($y-$ch);
return wxNullBitmap if not $factor;
($w, $h) = (int($w/$factor),$y-$ch);
}
$img = $img->Scale($w, $h);
}
elsif ($blowup)
{
# Do we really want to blow up images that are too small??
my $factor = $w/$x;
return wxNullBitmap if not $factor;
my $newy = int($h/$factor);
($w,$h) = ($x, $newy);
if ($h > ($y-$ch))
{
my $factor = $h/($y-$ch);
return wxNullBitmap if not $factor;
($w, $h) = (int($w/$factor),$y-$ch);
}
$img = $img->Scale($w, $h);
}
my $bmp = Wx::Bitmap->new($img);
my $newbmp = Wx::Bitmap->new($x, $y);
my $tmpdc = Wx::MemoryDC->new();
$tmpdc->SelectObject($newbmp);
my $bgbr = Wx::Brush->new($parent_background, wxSOLID);
$tmpdc->SetBrush($bgbr);
$tmpdc->SetBackground($bgbr);
$tmpdc->Clear();
my $bg = $parent_background;
if (defined $background)
{
if (ref($background)=~/ARRAY/)
{
$bg = Wx::Colour->new(@$background);
}
else
{
$bg = $background;
}
my $br = Wx::Brush->new($bg, wxSOLID);
my $pen = Wx::Pen->new($bg, 1, wxSOLID);
$tmpdc->SetBrush($br);
$tmpdc->SetPen($pen);
$tmpdc->DrawRoundedRectangle(1,1,$x-1,$y-1, 10);
}
my $msk = Wx::Mask->new($bmp, Wx::Colour->new(255,255,255));
$bmp->SetMask($msk);
$tmpdc->DrawBitmap($bmp, int(($x - $bmp->GetWidth())/2), int(($y-$ch-$bmp->GetHeight())/2), 1);
if ($caption)
{
$tmpdc->SetTextBackground($bg);
$tmpdc->SetTextForeground(wxBLACK);
$tmpdc->SetFont($cfont);
$tmpdc->DrawText($caption, int(($x-$cw)/2),$y-$ch);
}
my $tmpfile = File::Temp::tmpnam();
$newbmp->SaveFile($tmpfile, wxBITMAP_TYPE_PNG);
local $/ = undef;
open(my $fh, "<$tmpfile");
binmode($fh);
my $image = <$fh>;
close($fh);
$cache->set("$file-$x-$y-$caption-$ibg-$blowup-$pbg-$mtime", $image);
}
my $fh = IO::Scalar->new(\$image);
my $contenttype = 'image/png';
return Wx::Bitmap->new(Wx::Image->newStreamMIME($fh, $contenttype))
}
sub wxColor2hex
{
my $color = shift;
my $red = $color->Red();
my $green = $color->Green();
my $blue = $color->Blue();
return sprintf("#%0x%0x%0x", $red,$green,$blue);
}
sub ReadImageMagick
{
my $file = shift;
my ($x, $y, $caption, $bgcolor, $blowup, $parent_background) = @_;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
return DrawCaption($x, $y, '?', $bgcolor, $parent_background) unless -r $file;
$caption ||='';
$blowup ||=0;
$bgcolor = $parent_background unless defined $bgcolor;
my $ibg = wxColor2hex($bgcolor) if (ref($bgcolor) eq 'Wx::Colour');
my $pbg = wxColor2hex($parent_background) if (ref($parent_background) eq 'Wx::Colour');
my $stat = stat($file);
my $mtime = $stat->mtime();
my $image = $cache->get("$file-$x-$y-$caption-$ibg-$blowup-$pbg-$mtime");
if (!$image)
{
my $radius = 10;
my $svg = <<SVG;
<svg width="$x" height="$y" viewBox="0 0 $x $y">
<rect x="0" y="0" width="$x" height="$y" ry="$radius"
style="stroke: none; fill: $ibg;"/>
</svg>
SVG
my $background=Image::Magick->new(magick => 'svg');
$background->Set('background' => $pbg);
$background->blobtoimage($svg);
my ($textheight, $textwidth) = (0,0);
if ($caption)
{
my $pt = 20;
do {
(undef, undef, undef, undef, $textwidth, $textheight, undef) =
$background->QueryFontMetrics(text => $caption, font => 'Comic-Sans-MS', pointsize => $pt, gravity => 'South');
$pt--;
} until ($textwidth < $x) && ($textheight < $y/5);
$background->Annotate(text => $caption, font => 'Comic-Sans-MS', pointsize => $pt, gravity => 'South');
}
# Read the actual image
my $img = Image::Magick->new;
my $rc = $img->Read($file);
carp "Can't read $file: $rc" if $rc;
# wmf files have a white background color by default
# if we can't get the matte color for the image, we assume
# that white can be used as the transparent color...
$img->Transparent(color => 'white') if (!$img->Get('matte') || $file =~ /wmf$/i);
my $w = $img->Get('width');
my $h = $img->Get('height');
my $ch = $textheight;
if (($w > $x) || ($h > ($y-$ch)))
{
my ($newx, $newy) = ($w, $h);
if ($w > $x)
{
my $factor = $w/$x;
return wxNullBitmap if not $factor;
$newy = int($h/$factor);
($w,$h) = ($x, $newy);
}
if ($h > ($y-$ch))
{
my $factor = $h/($y-$ch);
return wxNullBitmap if not $factor;
($w, $h) = (int($w/$factor),$y-$ch);
}
$img->Thumbnail(height => $h, width =>$w );
}
elsif ($blowup)
{
# Do we really want to blow up images that are too small??
my $factor = $w/$x;
return wxNullBitmap if not $factor;
my $newy = int($h/$factor);
($w,$h) = ($x, $newy);
if ($h > ($y-$ch))
{
my $factor = $h/($y-$ch);
return wxNullBitmap if not $factor;
($w, $h) = (int($w/$factor),$y-$ch);
}
$img->Resize(height => $h, width =>$w );
}
$img->Border(width => int(($x - $img->Get('width'))/2) - $radius/2,
height => int((($y-$textheight) - $img->Get('height'))/2) - $radius/2,
fill => $ibg);
# Call the Composite method of the background image, with the logo image as an argument.
$background->Composite(image=>$img,compose=>'over', gravity => 'North');
$background->Set(quality=>100);
$background->Set(magick => 'png');
$image = $background->imagetoblob();
$cache->set("$file-$x-$y-$caption-$ibg-$blowup-$pbg-$mtime", $image);
undef $background;
undef $img;
}
my $fh = IO::Scalar->new(\$image);
my $contenttype = 'image/png';
return Wx::Bitmap->new(Wx::Image->newStreamMIME($fh, $contenttype))
}
END
{
undef $cache;
}
sub DrawCaption
{
my ($x, $y, $caption, $background, $parent_background) = @_;
confess "MaxX and MaxY should be positive" if $x < 1 || $y < 1;
my $newbmp = Wx::Bitmap->new($x, $y);
my $tmpdc = Wx::MemoryDC->new();
$tmpdc->SelectObject($newbmp);
my $bgbr = Wx::Brush->new($parent_background, wxSOLID);
$tmpdc->SetBrush($bgbr);
$tmpdc->SetBackground($bgbr);
$tmpdc->Clear();
my $bg = $parent_background;
if (defined $background)
{
if (ref($background)=~/ARRAY/)
{
$bg = Wx::Colour->new(@$background);
}
else
{
$bg = $background;
}
my $br = Wx::Brush->new($bg, wxSOLID);
my $pen = Wx::Pen->new($bg, 1, wxSOLID);
$tmpdc->SetBrush($br);
$tmpdc->SetPen($pen);
$tmpdc->DrawRoundedRectangle(1,1,$x-1,$y-1, 10);
}
my $pt = 72;
my ($font, $w, $h);
do
{
$font = Wx::Font->new( $pt, # font size
wxSWISS, # font family
wxNORMAL, # style
wxNORMAL, # weight
0,
'Comic Sans MS'); # face name
($w, $h, undef, undef) = $tmpdc->GetTextExtent($caption, $font);
$pt= $pt > 24 ? $pt - 4 : $pt-1;
} until (($w<$x) && ($h<$y) || $pt < 5);
$tmpdc->SetTextForeground(wxBLACK);
$tmpdc->SetTextBackground($bg);
$tmpdc->SetFont($font);
$tmpdc->DrawText($caption, int(($x-$w)/2), int(($y-$h)/2));
return $newbmp;
}
1;
__END__
=pod
=head1 NAME
AAC::Pvoice::Bitmap - Easily create resized bitmaps with options
=head1 SYNOPSIS
use AAC::Pvoice::Bitmap;
my $bitmap = AAC::Pvoice::Bitmap->new('image.jpg', #image
100, #maxX
100, #maxY
'This is my image', #caption
wxWHITE, #background
1); #blowup?
=head1 DESCRIPTION
This module is a simpler interface to the Wx::Bitmap to do things with
images that I tend to do with almost every image I use in pVoice applications.
It's a subclass of Wx::Bitmap, so you can call any method that a Wx::Bitmap
can handle on the resulting AAC::Pvoice::Bitmap.
=head1 USAGE
=head2 new(image, maxX, maxY, caption, background, blowup, parentbackground)
This constructor returns a bitmap (useable as a normal Wx::Bitmap), that
has a size of maxX x maxY, the image drawn into it as large as possible.
If blowup has a true value, it will enlarge the image to try and match
the maxX and maxY. Any space not filled by the image will be the
specified background colour. A caption can be specified to draw under the
image.
If the image doesn't exist, it will draw a large questionmark and warn
the user.
=over 4
=item image
This is the path to the image you want to have.
=item maxX, maxY
These are the maximum X and Y size of the resulting image. If the original
image is larger, it will be resized (maintaining the aspect ratio) to
match these values as closely as possible. If the 'blowup' parameter is
set to a true value, it will also enlarge images that are smaller than
maxX and maxY to get the largest possible image within these maximum values.
=item caption
This is an optional caption below the image. The caption's font is Comic Sans MS
and will have a pointsize that will make the caption fit within the maxX
of the image. The resulting height of the caption is subtracted from the
maxY
=item background
This is the background of the image, specified as either a constant
(i.e. wxWHITE) or as an arrayref of RGB colours (like [128,150,201] ).
=item blowup
This boolean parameter determines whether or not images that are smaller
than maxX and maxY should be blown up to be as large as possible within
the given maxX and maxY.
=item parentbackground
This is the background of the parent of this bitmap, which is the colour to
be used outside of the round cornered background.
=back
=head1 BUGS
probably a lot, patches welcome!
=head1 AUTHOR
Jouke Visser
jouke@pvoice.org
http://jouke.pvoice.org
=head1 COPYRIGHT
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
The full text of the license can be found in the
LICENSE file included with this module.
=head1 SEE ALSO
perl(1), Wx
=cut