for my ActiveState Perl 5.8.3 on Windows XP. The reason why I chose this ppm is that it is not dependent on the complete ImageMagick installation and can be packaged with PAR to be distributed on other machines.
On Windows XP machines, everything runs fine: both on my development machine, and even PAR packaged executables on other XP machines that don't have Perl installed. However, when I run my script (packaged or not) on Windows 98SE, it runs fine, until the script is done. Just before the end it gives me a page fault in Magick.dll. There is either a problem with ImageMagick on Windows 98, or I am doing something wrong.
The code that uses Image::Magick is below (it is supposed to be a drop-in replacement for the ReadImage subroutine of
). It tries to read the images from a cache first (using File::Cache). If all processed images are loaded from the cache, the problem does not occur. If one or more images are not in the cache, and it does the Image::Magick processing, the error does occur.
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) = @_;
$caption ||='';
$blowup ||=0;
# if the file is not readable, return a bitmap with just a questio
+nmark
return DrawCaption($x, $y, '?', $bgcolor, $parent_background) unle
+ss -r $file;
# The previous version needed colors to be defined as Wx::Colour-s
+, now
# we need the html-color code
$bgcolor = $parent_background unless defined $bgcolor;
my $ibg = wxColor2hex($bgcolor) if (ref($bgcolor) eq 'Wx::Colour')
+;
my $pbg = wxColor2hex($parent_background) if (ref($parent_backgrou
+nd) eq 'Wx::Colour');
# $cache is a global, first we check if the file is in cache alrea
+dy
my $image = $cache->get("$file-$x-$y-$caption-$ibg-$blowup-$pbg");
if (!$image)
{
# We're using a roundcornered background, created by this litt
+le piece of SVG
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);
# Now we determine the fontsize we're going to use for the cap
+tion under the image
my ($textheight, $textwidth) = (0,0);
if ($caption)
{
my $pt = 20;
do {
(undef, undef, undef, undef, $textwidth, $textheight, unde
+f) =
$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-San
+s-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;
# We'll fake transparency by using white as the transparent co
+lor...crappy, but it looks
# rather good most of the time
$img->Transparent(color => 'white') if (!$img->Get('matte') ||
+ $file =~ /wmf$/i);
# Now we'll make the image fit within the part that is not use
+d by the caption
my $w = $img->Get('width');
my $h = $img->Get('height');
my $ch = $textheight;
# if the image is too large, resize it to make it fit
if (($w > $x) || ($h > ($y-$ch)))
{
my ($newx, $newy) = ($w, $h);
if ($w > $x)
{
my $factor = $w/$x;
# return a null-bitmap if factor is 0
return wxNullBitmap if not $factor;
$newy = int($h/$factor);
($w,$h) = ($x, $newy);
}
if ($h > ($y-$ch))
{
my $factor = $h/($y-$ch);
# return a null-bitmap if factor is 0
return wxNullBitmap if not $factor;
($w, $h) = (int($w/$factor),$y-$ch);
}
$img->Thumbnail(height => $h, width =>$w );
}
# If the image is too small, and we specified that we want to
+blowup the image..
elsif ($blowup)
{
my $factor = $w/$x;
# return a null-bitmap if factor is 0
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 );
}
# we center the image by adding equal borders around it
$img->Border( width => int(($x - $img->Get('width'))/2) - $
+radius/2,
height => int((($y-$textheight) - $img->Get('h
+eight'))/2) - $radius/2,
fill => $ibg);
# Call the Composite method of the background image, with the
+image as an argument.
$background->Composite(image=>$img,compose=>'over', gravity =>
+ 'North');
$background->Set(quality=>100);
# We return the image as a PNG
$background->Set(magick => 'png');
$image = $background->imagetoblob();
# Now we can put it in the cache
$cache->set("$file-$x-$y-$caption-$ibg-$blowup-$pbg", $image);
+
# I added this hoping that the pagefault on W98 would disappea
+r, but it didn't work... :(
undef $background;
undef $img;
}
my $fh = IO::Scalar->new(\$image);
my $contenttype = 'image/png';
return Wx::Bitmap->new(Wx::Image->newStreamMIME($fh, $contenttype
+))
}
Any ideas?
Jouke Visser
Using Perl to enable the disabled: pVoice