view release on metacpan or  search on metacpan

lib/AAC/Pvoice/Bitmap.pm  view on Meta::CPAN

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);
        }