PDL-IO-GD
view release on metacpan or search on metacpan
my $image = read_true_png("test_true_read.png");
write_true_png($image, "test_true_read.out.png");
my $lut = read_png_lut("test.png");
$pdl = sequence(byte, 30, 30);
write_png_ex($pdl, load_lut($lutfile), "test_nocomp.png", 0);
write_png_ex($pdl, load_lut($lutfile), "test_bestcomp1.png", 9);
write_png_best($pdl, load_lut($lutfile), "test_bestcomp2.png");
$pdl = sequence(100, 100, 3);
write_true_png_ex($pdl, "test_true_nocomp.png", 0);
write_true_png_ex($pdl, "test_true_bestcomp1.png", 9);
write_true_png_best($pdl, "test_true_bestcomp2.png");
recompress_png_best("test_recomp_best.png");
=head1 DESCRIPTION
This is the "General Interface" for the PDL::IO::GD library, and is actually several
years old at this point (read: stable). If you're feeling frisky, try the new OO
interface described below.
The general version just provides several image IO utility functions you can use with
ndarray variables. It's deceptively useful, however.
=cut
ENDPM
###########################
# General Interface Code: #
###########################
# needed header files:
pp_addhdr(<<'EOH');
#include "gd.h"
#include "gdfontl.h"
#include "gdfonts.h"
#include "gdfontmb.h"
#include "gdfontg.h"
#include "gdfontt.h"
#include <stdio.h>
#define PKG "PDL::IO::GD"
EOH
my %gdi_from_pngfile = (
OtherPars => 'char* filename',
Comp => 'gdImagePtr im',
MakeComp => '
FILE *fh = fopen($COMP(filename), "rb");
if (!fh) $CROAK("Error opening %s\n", $COMP(filename));
$COMP(im) = gdImageCreateFromPng(fh);
fclose(fh);
if (!$COMP(im)) $CROAK("Error reading PNG data\n");
',
CompFreeCodeComp => 'gdImageDestroy($COMP(im));',
);
my %gdi_from_args = (
OtherPars => 'gdImagePtr im',
);
my %lu_dim_check = (
RedoDimsCode => <<'EOF',
if ($SIZE(j) > 256)
$CROAK("Wrong LUT dimensions (%"IND_FLAG", %"IND_FLAG")! (should be (3, X), where X <= 256)\n",
$SIZE(i), $SIZE(j) );
EOF
);
my %level_check = (
RedoDimsCode => <<'EOF',
if( $COMP(level) < -1 || $COMP(level) > 9 )
$CROAK("Invalid compression level %d, should be [-1,9]\n",
$COMP(level) );
EOF
);
my %lu_dim_level_check = (
RedoDimsCode => $lu_dim_check{RedoDimsCode}.$level_check{RedoDimsCode},
);
my $gdi_from_dims = "gdImagePtr im = gdImageCreate(\$SIZE(x), \$SIZE(y));\n";
my $gdi_to_file = <<'EOF';
FILE *out = fopen($COMP(filename), "wb");
if (!out) $CROAK("Error opening %s\n", $COMP(filename));
gdImagePng(im, out);
fclose(out);
gdImageDestroy(im);
EOF
my $gdi_to_fileEx = <<'EOF';
FILE *out = fopen($COMP(filename), "wb");
if (!out) $CROAK("Error opening %s\n", $COMP(filename));
gdImagePngEx(im, out, $COMP(level));
fclose(out);
gdImageDestroy(im);
EOF
my $gdiTrue_from_dims = "gdImagePtr im = gdImageCreateTrueColor(\$SIZE(x), \$SIZE(y));\n";
my $lut_allocate = <<'EOF';
loop(j) %{
int tmp = gdImageColorAllocate(im, $lut(i=>0), $lut(i=>1), $lut(i=>2));
if (tmp != j)
$CROAK("palette mismatch on index %"IND_FLAG" (mapped to %d)\n", j, tmp);
%}
EOF
my $img_to_gdi = 'loop(y,x) %{
if ($img() >= $SIZE(j))
$CROAK("Pixel value=%d exceeded LUT size", (int)$img());
gdImageSetPixel(im, x, y, $img());
%}';
my $img_to_gdiTrue = <<'EOF';
loop(y,x) %{
gdImageSetPixel(im, x, y,
gdImageColorResolve(im, $img(z=>0), $img(z=>1), $img(z=>2))
);
%}
EOF
my $gdi_to_img_tpl = 'loop(y,x) %%{ $img() = gdImageGetPixel($COMP(im), x, %sy); %%}';
my $gdi_to_img = sprintf $gdi_to_img_tpl, '';
my $gdi_to_img_inv = sprintf $gdi_to_img_tpl, '$SIZE(y)-1-';
my $gdiTrue_to_img_tpl = <<'EOF';
if (!$COMP(im)->trueColor) $CROAK("Tried to read a non-truecolour image as truecolour");
loop(y,x) %%{
int tpixel = gdImageTrueColorPixel($COMP(im), x, %sy);
$img(z=>0) = gdTrueColorGetRed(tpixel);
$img(z=>1) = gdTrueColorGetGreen(tpixel);
$img(z=>2) = gdTrueColorGetBlue(tpixel);
%%}
EOF
my $gdiTrue_to_img = sprintf $gdiTrue_to_img_tpl, '';
my $gdiTrue_to_img_inv = sprintf $gdiTrue_to_img_tpl, '$SIZE(y)-1-';
my $gdi_to_ptr = '$img_ptr() = PTR2IV(im);';
# Function to write a PNG image from an ndarray variable:
pp_def( 'write_png',
Pars => 'img(x,y); lut(i=3,j);',
GenericTypes => ['B'],
OtherPars => 'char* filename',
Doc => <<'ENDDOC',
Writes a 2-d PDL variable out to a PNG file, using the supplied color look-up-table ndarray
(hereafter referred to as a LUT).
The LUT contains a line for each value 0-255 with a corresponding R, G, and B value.
ENDDOC
%lu_dim_check,
Code => $gdi_from_dims . $lut_allocate . $img_to_gdi . $gdi_to_file,
);
# Function to write a PNG image from an ndarray variable, accepting a compression
# level argument:
pp_def( 'write_png_ex',
Pars => 'img(x,y); lut(i=3,j);',
GenericTypes => ['B'],
OtherPars => 'char* filename; int level',
Like write_png(), but it assumes the best PNG compression (9).
=for example
write_png_best( $img(ndarray), $lut(ndarray), $filename )
=cut
sub write_png_best
{
my $img = shift;
my $lut = shift;
my $filename = shift;
return write_png_ex( $img, $lut, $filename, 9 );
} # End of write_png_best()...
=head2 write_true_png_best
Like write_true_png(), but it assumes the best PNG compression (9).
=for example
write_true_png_best( $img(ndarray), $filename )
=cut
sub write_true_png_best
{
my $img = shift;
my $filename = shift;
return write_true_png_ex( $img, $filename, 9 );
} # End of write_true_png_best()...
ENDPM
# End of best copression aliases
pp_add_exported( '', 'write_png_best write_true_png_best' );
#
# Function to recompress PNG files with the best compression available:
# NOTE: libgd doesn't return anything, so there's nothing to check!
pp_addpm( '', <<'ENDPM' );
=head2 recompress_png_best( $filename )
Recompresses the given PNG file using the best compression (9).
=cut
ENDPM
pp_addxs( '', <<'ENDXS' );
void
recompress_png_best(char* filename)
CODE:
gdImagePtr im;
FILE* file = fopen(filename, "rb");
if (!file) croak("Error opening %s\n", filename);
im = gdImageCreateFromPng(file);
fclose(file);
file = fopen(filename, "wb");
if (!file) croak("Error opening %s\n", filename);
gdImagePngEx( im, file, 9 );
fclose(file);
gdImageDestroy(im);
ENDXS
pp_add_exported( '', 'recompress_png_best' );
# End of recompress_png_best() XS code...
pp_addpm(<<'EOPM');
=head2 load_lut( $filename )
Loads a color look up table from an ASCII file. returns an ndarray
=cut
sub load_lut {
xchg(byte(cat(rcols(shift))), 0, 1);
}
EOPM
pp_add_exported('', 'load_lut');
pp_def( 'read_true_png',
Pars => '[o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))),z=3);',
GenericTypes => ['B'],
%gdi_from_pngfile,
Doc => "=for ref\n\nReads a true colour PNG image into a (new) PDL variable.\n",
Code => $gdiTrue_to_img,
);
pp_def( 'read_png',
Pars => '[o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))));',
GenericTypes => ['L'],
%gdi_from_pngfile,
Doc => "=for ref\n\nReads a (palette) PNG image into a (new) PDL variable.\n",
Code => $gdi_to_img,
);
pp_def( '_gd_image_to_pdl_true',
Pars => '[o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))),z=3);',
GenericTypes => ['B'],
%gdi_from_args,
Doc => undef,
Code => $gdiTrue_to_img,
);
pp_def( '_gd_image_to_rpic_true',
Pars => '[o] img(z=3,x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))));',
GenericTypes => ['B'],
%gdi_from_args,
Doc => undef,
Code => $gdiTrue_to_img_inv,
);
pp_def( '_gd_image_to_pdl',
Pars => '[o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))));',
GenericTypes => ['L'],
%gdi_from_args,
Doc => undef,
Code => $gdi_to_img,
);
####################
# NEW OO Interface #
####################
##############################################
# Autogeneration of the low level interface: #
##############################################
##################################################
# Process functions to create images from files: #
##################################################
#########################################
# Start the PDL::IO::GD OO module code: #
#########################################
pp_addpm( { At => 'Bot' }, <<'ENDPM' );
=head1 OO INTERFACE
Object Oriented interface to the GD image library.
=head1 SYNOPSIS
# Open an existing file:
#
my $gd = PDL::IO::GD->new( { filename => "test.png" } );
# Query the x and y sizes:
my $x = $gd->SX();
my $y = $gd->SY();
# Grab the PDL of the data:
my $pdl = $gd->to_pdl; # (x,y,3) y=0 at top
# Grab the PDL of the data:
my $pdl = $gd->to_rpic; # (3,x,y) y=0 at bottom
# Kill this thing:
$gd->DESTROY();
# Create a new object:
#
my $im = PDL::IO::GD->new( { x => 300, y => 300 } );
# Allocate some colors:
#
my $black = $im->ColorAllocate( 0, 0, 0 );
my $red = $im->ColorAllocate( 255, 0, 0 );
my $green = $im->ColorAllocate( 0, 255, 0 );
my $blue = $im->ColorAllocate( 0, 0, 255 );
# Draw a rectangle:
$im->Rectangle( 10, 10, 290, 290, $red );
# Add some text:
$im->String( gdFontGetLarge(), 20, 20, "Test Large Font!", $green );
# Write the output file:
$im->write_Png( "test2.png" );
=head1 DESCRIPTION
This is the Object-Oriented interface from PDL to the GD image library.
See L<http://www.boutell.com/gd/> for more information on the GD library and how it works.
=head2 IMPLEMENTATION NOTES
Surprisingly enough, this interface has nothing to do with the other Perl->GD interface module,
aka 'GD' (as in 'use GD;'). This is done from scratch over the years.
Requires at least version 2.0.22 of the GD library, but it's only been thoroughly tested with
gd-2.0.33, so it would be best to use that. The 2.0.22 requirement has to do with a change in
GD's font handling functions, so if you don't use those, then don't worry about it.
I should also add, the statement about "thoroughly tested" above is mostly a joke. This OO
interface is very young, and it has I<barely> been tested at all, so if something
breaks, email me and I'll get it fixed ASAP (for me).
Functions that manipulate and query the image objects generally have a 'gdImage' prefix on the
function names (ex: gdImageString()). I've created aliases here for all of those member
functions so you don't have to keep typing 'gdImage' in your code, but the long version are in
there as well.
=head1 METHODS
=cut
use PDL;
use PDL::Slices;
use PDL::IO::Misc;
#
# Some helper functions:
#
sub _pkg_name
{ return "PDL::IO::GD::" . (shift) . "()"; }
# ID a file type from it's filename:
sub _id_image_file
{
my $filename = shift;
return 'png'
if( $filename =~ /\.png$/ );
return 'jpg'
if( $filename =~ /\.jpe?g$/ );
return 'wbmp'
if( $filename =~ /\.w?bmp$/ );
return 'gd'
if( $filename =~ /\.gd$/ );
return 'gd2'
if( $filename =~ /\.gd2$/ );
return 'gif'
if( $filename =~ /\.gif$/ );
return 'xbm'
if( $filename =~ /\.xbm$/ );
return undef;
} # End of _id_image_file()...
# Load a new file up (don't read it yet):
sub _img_ptr_from_file
{
my $filename = shift;
my $type = shift;
return _gdImageCreateFromPng( $filename )
if( $type eq 'png' );
return _gdImageCreateFromJpeg( $filename )
if( $type eq 'jpg' );
return _gdImageCreateFromWBMP( $filename )
if( $type eq 'wbmp' );
return _gdImageCreateFromGd( $filename )
if( $type eq 'gd' );
return _gdImageCreateFromGd2( $filename )
if( $type eq 'gd2' );
return _gdImageCreateFromGif( $filename )
if( $type eq 'gif' );
return _gdImageCreateFromXbm( $filename )
if( $type eq 'xbm' );
return undef;
} # End of _img_ptr_from_file()...
# ID a file type from it's "magic" header in the image data:
sub _id_image_data
{
my $data = shift;
my $magic = substr($data,0,4);
return 'png'
if( $magic eq "\x89PNG" );
return 'jpg'
if( $magic eq "\377\330\377\340" );
return 'jpg'
if( $magic eq "\377\330\377\341" );
return 'jpg'
if( $magic eq "\377\330\377\356" );
return 'gif'
if( $magic eq "GIF8" );
return 'gd2'
if( $magic eq "gd2\000" );
# Still need filters for WBMP and .gd!
return undef;
} # End of _id_image_data()...
# Load a new data scalar up:
sub _img_ptr_from_data
{
my $data = shift;
my $type = shift;
return _gdImageCreateFromPngPtr( $data )
if( $type eq 'png' );
return _gdImageCreateFromJpegPtr( $data )
if( $type eq 'jpg' );
return _gdImageCreateFromWBMPPtr( $data )
if( $type eq 'wbmp' );
return _gdImageCreateFromGdPtr( $data )
if( $type eq 'gd' );
return _gdImageCreateFromGd2Ptr( $data )
if( $type eq 'gd2' );
return _gdImageCreateFromGifPtr( $data )
if( $type eq 'gif' );
return undef;
} # End of _img_ptr_from_data()...
=head2 new
Creates a new PDL::IO::GD object.
Accepts a hash describing how to create the object. Accepts a single hash ( with
curly braces ), an inline hash (the same, but without the braces) or a single
string interpreted as a filename. Thus the following are all equivalent:
PDL::IO::GD->new( {filename => 'image.png'} );
PDL::IO::GD->new( filename => 'image.png' );
PDL::IO::GD->new( 'image.png' );
If the hash has:
pdl => $pdl_var (lut => $lut_ndarray)
Then a new GD is created from that PDL variable.
filename => $file
Then a new GD is created from the image file.
x => $num, y => $num
Then a new GD is created as a palette image, with size x, y
x => $num, y => $num, true_color => 1
Then a new GD is created as a true color image, with size x, y
data => $scalar (type => $typename)
Then a new GD is created from the file data stored in $scalar.
If no type is given, then it will try to guess the type of the data, but
this will not work for WBMP and gd image types. For those types, you
_must_ specify the type of the data, or the operation will fail.
Valid types are: 'jpg', 'png', 'gif', 'gd', 'gd2', 'wbmp'.
Example:
my $gd = PDL::IO::GD->new({ pdl => $pdl_var });
my $gd = PDL::IO::GD->new({ pdl => $pdl_var, lut => $lut_ndarray });
: _gd_image_to_pdl( $self->{IMG_PTR} );
}
=head2 to_rpic
When you're done playing with your GDImage and want an ndarray back, use this function to return one.
For true-colour, RGB dim is lowest (3,x,y).
To get it in the highest dim (and with y=0 is the top), use L</to_pdl>.
=cut
sub to_rpic {
my $self = shift;
$self->gdImageTrueColor() ? _gd_image_to_rpic_true( $self->{IMG_PTR} )
: _gd_image_to_rpic( $self->{IMG_PTR} );
}
=head2 apply_lut( $lut(ndarray) )
Does a $im->ColorAllocate() for an entire LUT ndarray at once.
The LUT ndarray format is the same as for the general interface above.
=cut
sub apply_lut
{
my $self = shift;
my $lut = shift;
# Let the PDL broadcasting engine sort this out:
$self->ColorAllocates( $lut->slice("(0),:"), $lut->slice("(1),:"), $lut->slice("(2),:") );
} # End of apply_lut()...
sub DESTROY
{
my $self = shift;
my $sub = _pkg_name( "DESTROY" );
#print STDERR sprintf("$sub: destroying gdImagePtr: 0x%p (%d) (%ld) (%lld)\n", $self->{IMG_PTR}, $self->{IMG_PTR},$self->{IMG_PTR},$self->{IMG_PTR});
if( defined( $self->{IMG_PTR} ) )
{
_gdImageDestroy( $self->{IMG_PTR} );
delete( $self->{IMG_PTR} );
}
} # End of DESTROY()...
=head2 WARNING:
All of the docs below this point are auto-generated (not to mention the actual code),
so read with a grain of salt, and B<always> check the main GD documentation about how
that function works and what it does.
=cut
ENDPM
generate_create_functions( <<'ENDCREATE' );
gdImagePtr gdImageCreateFromPng (FILE * fd);
gdImagePtr gdImageCreateFromWBMP (FILE * inFile);
gdImagePtr gdImageCreateFromJpeg (FILE * infile);
gdImagePtr gdImageCreateFromGd (FILE * in);
gdImagePtr gdImageCreateFromGd2 (FILE * in);
gdImagePtr gdImageCreateFromXbm (FILE * in);
gdImagePtr gdImageCreateFromGif (FILE * fd);
gdImagePtr gdImageCreate (int sx, int sy);
gdImagePtr gdImageCreatePalette (int sx, int sy);
gdImagePtr gdImageCreateTrueColor (int sx, int sy);
ENDCREATE
generate_create_from_data_functions( <<'ENDCDATA' );
gdImagePtr gdImageCreateFromPngPtr (int size, void * data);
gdImagePtr gdImageCreateFromWBMPPtr (int size, void * data);
gdImagePtr gdImageCreateFromJpegPtr (int size, void * data);
gdImagePtr gdImageCreateFromGdPtr (int size, void * data);
gdImagePtr gdImageCreateFromGd2Ptr (int size, void * data);
gdImagePtr gdImageCreateFromGifPtr (int size, void * data);
ENDCDATA
generate_write_functions( <<'ENDWRITE' );
void gdImagePng (gdImagePtr im, FILE * out);
void gdImagePngEx (gdImagePtr im, FILE * out, int level);
void gdImageWBMP (gdImagePtr image, int fg, FILE * out);
void gdImageJpeg (gdImagePtr im, FILE * out, int quality);
void gdImageGd (gdImagePtr im, FILE * out);
void gdImageGd2 (gdImagePtr im, FILE * out, int cs, int fmt);
void gdImageGif (gdImagePtr im, FILE * out);
ENDWRITE
generate_data_ptr_functions( <<'ENDDATAPTR' );
void *gdImagePngPtr (gdImagePtr im, int *size);
void *gdImagePngPtrEx (gdImagePtr im, int *size, int level);
void *gdImageWBMPPtr (gdImagePtr im, int *size, int fg);
void *gdImageJpegPtr (gdImagePtr im, int *size, int quality);
void *gdImageGdPtr (gdImagePtr im, int *size);
void *gdImageGd2Ptr (gdImagePtr im, int cs, int fmt, int *size);
ENDDATAPTR
#void gdImageDestroy (gdImagePtr im);
generate_member_functions( <<'ENDMEMBERS' );
void gdImageSetPixel (gdImagePtr im, int x, int y, int color);
int gdImageGetPixel (gdImagePtr im, int x, int y);
void gdImageAABlend (gdImagePtr im);
void gdImageLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageDashedLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageFilledRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageSetClip(gdImagePtr im, int x1, int y1, int x2, int y2);
void gdImageGetClip(gdImagePtr im, int *x1P, int *y1P, int *x2P, int *y2P);
int gdImageBoundsSafe (gdImagePtr im, int x, int y);
void gdImageChar (gdImagePtr im, gdFontPtr f, int x, int y, int c, int color);
void gdImageCharUp (gdImagePtr im, gdFontPtr f, int x, int y, int c, int color);
void gdImageString (gdImagePtr im, gdFontPtr f, int x, int y, unsigned char *s, int color);
void gdImageStringUp (gdImagePtr im, gdFontPtr f, int x, int y, unsigned char *s, int color);
void gdImageString16 (gdImagePtr im, gdFontPtr f, int x, int y, unsigned short *s, int color);
void gdImageStringUp16 (gdImagePtr im, gdFontPtr f, int x, int y, unsigned short *s, int color);
void gdImagePolygon (gdImagePtr im, gdPointPtr p, int n, int c);
void gdImageFilledPolygon (gdImagePtr im, gdPointPtr p, int n, int c);
int gdImageColorAllocate (gdImagePtr im, int r, int g, int b);
int gdImageColorAllocateAlpha (gdImagePtr im, int r, int g, int b, int a);
int gdImageColorClosest (gdImagePtr im, int r, int g, int b);
int gdImageColorClosestAlpha (gdImagePtr im, int r, int g, int b, int a);
int gdImageColorClosestHWB (gdImagePtr im, int r, int g, int b);
int gdImageColorExact (gdImagePtr im, int r, int g, int b);
int gdImageColorExactAlpha (gdImagePtr im, int r, int g, int b, int a);
int gdImageColorResolve (gdImagePtr im, int r, int g, int b);
int gdImageColorResolveAlpha (gdImagePtr im, int r, int g, int b, int a);
void gdImageColorDeallocate (gdImagePtr im, int color);
void gdImageTrueColorToPalette (gdImagePtr im, int ditherFlag, int colorsWanted);
void gdImageColorTransparent (gdImagePtr im, int color);
void gdImageFilledArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color, int style);
void gdImageArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color);
void gdImageFilledEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
void gdImageFillToBorder (gdImagePtr im, int x, int y, int border, int color);
void gdImageFill (gdImagePtr im, int x, int y, int color);
void gdImageCopyRotated (gdImagePtr dst, gdImagePtr src, double dstX, double dstY, int srcX, int srcY, int srcWidth, int srcHeight, int angle);
void gdImageSetBrush (gdImagePtr im, gdImagePtr brush);
void gdImageSetTile (gdImagePtr im, gdImagePtr tile);
void gdImageSetAntiAliased (gdImagePtr im, int c);
void gdImageSetAntiAliasedDontBlend (gdImagePtr im, int c, int dont_blend);
void gdImageSetStyle (gdImagePtr im, int *style, int noOfPixels);
void gdImageSetThickness (gdImagePtr im, int thickness);
void gdImageInterlace (gdImagePtr im, int interlaceArg);
void gdImageAlphaBlending (gdImagePtr im, int alphaBlendingArg);
void gdImageSaveAlpha (gdImagePtr im, int saveAlphaArg);
int gdImageTrueColor (gdImagePtr im);
int gdImageColorsTotal (gdImagePtr im);
int gdImageRed (gdImagePtr im, int c);
int gdImageGreen (gdImagePtr im, int c);
int gdImageBlue (gdImagePtr im, int c);
int gdImageAlpha (gdImagePtr im, int c);
int gdImageGetTransparent (gdImagePtr im);
int gdImageGetInterlaced (gdImagePtr im);
int gdImageSX (gdImagePtr im);
int gdImageSY (gdImagePtr im);
ENDMEMBERS
#char* gdImageStringTTF (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
#char* gdImageStringFT (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
#ENDMEMBERS
# Allow operation on these member function on ndarrays as well:
#int gdImageGetPixel (gdImagePtr im, int x, int y);
generate_pp_def_members( <<'ENDMEMBERS' );
int gdImageColorAllocate (gdImagePtr im, int r, int g, int b);
int gdImageColorAllocateAlpha (gdImagePtr im, int r, int g, int b, int a);
void gdImageSetPixel (gdImagePtr im, int x, int y, int color);
void gdImageLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageDashedLine (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageFilledRectangle (gdImagePtr im, int x1, int y1, int x2, int y2, int color);
void gdImageFilledArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color, int style);
void gdImageArc (gdImagePtr im, int cx, int cy, int w, int h, int s, int e, int color);
void gdImageFilledEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
ENDMEMBERS
generate_class_functions( <<'ENDCLASS' );
void gdImageCopy (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h);
void gdImageCopyMerge (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h, int pct);
void gdImageCopyMergeGray (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int w, int h, int pct);
void gdImageCopyResized (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int dstW, int dstH, int srcW, int srcH);
void gdImageCopyResampled (gdImagePtr dst, gdImagePtr src, int dstX, int dstY, int srcX, int srcY, int dstW, int dstH, int srcW, int srcH);
int gdImageCompare (gdImagePtr im1, gdImagePtr im2);
void gdImagePaletteCopy (gdImagePtr dst, gdImagePtr src);
ENDCLASS
generate_general_functions( <<'ENDGENERAL' );
int gdAlphaBlend (int dest, int src);
int gdTrueColor (int r, int g, int b);
int gdTrueColorAlpha (int r, int g, int b, int a);
void gdFree (void *m);
gdFontPtr gdFontGetLarge ( );
gdFontPtr gdFontGetSmall ( );
gdFontPtr gdFontGetMediumBold ( );
gdFontPtr gdFontGetGiant ( );
gdFontPtr gdFontGetTiny ( );
ENDGENERAL
#
# Keep these in here for later:
#
my $unused_funcs = <<'ENDUNUSED';
# These have disappeared in later versions of GD:
void gdFreeFontCache ();
void gdImageEllipse (gdImagePtr im, int cx, int cy, int w, int h, int color);
BGD_DECLARE(gdImagePtr) gdImageCreateFromGifPtr (int size, void *data);
BGD_DECLARE(gdImagePtr) gdImageCreateFromGifCtx (gdIOCtxPtr in);
void gdImagePngCtx (gdImagePtr im, gdIOCtx * out);
void gdImagePngCtxEx (gdImagePtr im, gdIOCtx * out, int level);
void gdImageWBMPCtx (gdImagePtr image, int fg, gdIOCtx * out);
void gdImageJpegCtx (gdImagePtr im, gdIOCtx * out, int quality);
void gdImagePngToSink (gdImagePtr im, gdSinkPtr out);
gdIOCtx *gdNewFileCtx (FILE *);
gdIOCtx *gdNewDynamicCtx (int, void *);
gdIOCtx *gdNewSSCtx (gdSourcePtr in, gdSinkPtr out);
void *gdDPExtractData (struct gdIOCtx *ctx, int *size);
gdImagePtr gdImageCreateFromPngSource (gdSourcePtr in);
gdImagePtr gdImageCreateFromGd2Part (FILE * in, int srcx, int srcy, int w, int h);
char* gdImageStringFTEx (gdImage * im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string, gdFTStringExtraPtr strex);
ENDUNUSED
# Add functions that the code gen doesn't handle properly:
#
#char* gdImageStringTTF (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);
pp_addxs( <<"ENDXS" );
char*
_gdImageStringTTF( im, brect, fg, fontlist, ptsize, angle, x, y, string )
gdImagePtr im
int * brect
int fg
char * fontlist
double ptsize
double angle
int x
int y
char * string
CODE:
int c_brect[8];
RETVAL = gdImageStringTTF ( im, c_brect, fg, fontlist, ptsize, angle, x, y, string );
brect = c_brect;
OUTPUT:
RETVAL
brect
ENDXS
pp_addpm( { At => 'Bot' }, <<'ENDPM' );
=head2 StringTTF
$image->StringTTF( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
Alias for gdImageStringTTF.
=cut
sub StringTTF
{
return gdImageStringTTF ( @_ );
} # End of StringTTF()...
=head2 gdImageStringTTF
$image->gdImageStringTTF( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string )
=cut
sub gdImageStringTTF
{
my $self = shift;
return _gdImageStringTTF ( $self->{IMG_PTR}, @_ );
} # End of gdImageStringTTF()...
ENDPM
#char* gdImageStringFT (gdImagePtr im, int *brect, int fg, char *fontlist, double ptsize, double angle, int x, int y, char *string);=
Judd Taylor, Orbital Systems, Ltd.
judd dot t at orbitalsystems dot com
=cut
ENDPM
pp_done();
#########
# SUBS: #
#########
use Data::Dumper;
#
# Member functions to create a new object (or populate it from data):
#
sub generate_create_functions
{
my @funcs = split( /\n/, shift );
my $sub = "generate_create_functions()";
foreach my $func ( @funcs )
{
#print "$sub: Generating read function for $func...\n";
my $info = parse_prototype( $func )
or die "$sub: Couldn't parse prototype\n";
# If it wants a FILE*, we need to do something different in the XS code:
if( $info->{ARGS}->{1}->{TYPE} =~ /FILE\s*\*/ )
{
my $function_name = $info->{NAME};
my $return_type = $info->{RETURN_TYPE};
pp_addxs(<<"ENDXS");
$return_type
_$function_name( char* filename )
CODE:
FILE *file = fopen( filename, "rb");
if (!file) croak("Error opening %s\\n", filename);
RETVAL = $function_name( file );
fclose(file);
OUTPUT:
RETVAL
ENDXS
}
# Otherwise, it should be pretty easy:
else
{
add_basic_xs( $info, '_' );
}
}
} # End of generate_create_functions()...
#
# Member functions to create a new object from a data scalar:
#
# gdImagePtr gdImageCreateFromPngPtr (int size, void * data);
#
sub generate_create_from_data_functions
{
my @funcs = split( /\n/, shift );
my $sub = "generate_create_from_data_functions()";
foreach my $func ( @funcs )
{
#print "$sub: Generating read function for $func...\n";
my $info = parse_prototype( $func )
or die "$sub: Couldn't parse prototype\n";
my $function_name = $info->{NAME};
my $return_type = $info->{RETURN_TYPE};
pp_addxs(<<"ENDXS");
$return_type
_$function_name( imageData )
SV * imageData
PREINIT:
char* data;
STRLEN len;
CODE:
data = SvPV( imageData, len );
RETVAL = $function_name( len, (void*)data );
OUTPUT:
RETVAL
ENDXS
}
} # End of generate_create_from_data_functions()...
#void gdImagePng (gdImagePtr im, FILE * out);
#void gdImageWBMP (gdImagePtr image, int fg, FILE * out);
sub generate_write_functions
{
my @funcs = split( /\n/, shift );
my $sub = "generate_write_functions()";
foreach my $func ( @funcs )
{
#print "$sub: Generating write function for $func...\n";
my $info = parse_prototype( $func )
or die "$sub: Couldn't parse prototype\n";
my $function_name = $info->{NAME};
my $return_type = $info->{RETURN_TYPE};
my @arg_names = ();
my @call_args = ();
my $arg_decl_string = "";
foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
{
my $type = $info->{ARGS}->{$num}->{TYPE};
my $name = $info->{ARGS}->{$num}->{NAME};
if( $type =~ /FILE/ )
{
push( @arg_names, "filename" );
push( @call_args, "file" );
$arg_decl_string.= "\t\tchar *\t\tfilename\n";
next;
}
push(@arg_names, $name );
push(@call_args, $name );
$arg_decl_string .= "\t\t$type\t\t$name\n";
}
my $arg_list = join(", ", @arg_names);
my $call_arg_list = join(", ", @call_args);
pp_addxs(<<"ENDXS");
$return_type
_$function_name ( $arg_list )
$arg_decl_string
CODE:
FILE *file = fopen( filename, "wb");
if (!file) croak("Error opening %s\\n", filename);
$function_name ( $call_arg_list );
fclose( file );
ENDXS
# Add the OO code:
#
# Use template method here to avoid escaping everything:
my $pmcode = <<'ENDPM';
=head2 INSERT_NAME_HERE
$image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE )
=cut
sub INSERT_NAME_HERE
{
my $self = shift;
return INSERT_XS_FUNC_HERE ( $self->{IMG_PTR}, @_ );
} # End of INSERT_NAME_HERE()...
ENDPM
my $name = "write_" . $function_name;
$name =~ s/gdimage//;
$name =~ s/gdImage//;
$pmcode =~ s/INSERT_NAME_HERE/$name/sg;
$pmcode =~ s/INSERT_XS_FUNC_HERE/_$function_name/sg;
my @arg_names2;
my @doc_args;
foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
{
next if ( $info->{ARGS}->{$num}->{TYPE} eq 'gdImagePtr' );
if( $info->{ARGS}->{$num}->{TYPE} =~ /FILE/ )
{
push( @arg_names2, "filename" );
push(@doc_args, "\$filename" );
next;
}
push(@arg_names2, $info->{ARGS}->{$num}->{NAME});
push(@doc_args, "\$" . $info->{ARGS}->{$num}->{NAME} );
}
my $arg_list2 = join( ", ", @arg_names2 );
$pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list2/sg;
my $doc_arg_list = join( ", ", @doc_args );
$pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg;
pp_addpm( { At => 'Bot' }, $pmcode );
}
} # End of generate_write_functions()...
#
# The functions allow you to get a pointer to a formatted region of memory
# that contains image data in the specified format. This is useful, among
# other things, because PerlQt has almost no other way to import any image
# data from PDL!
#
#void *gdImageWBMPPtr (gdImagePtr im, int *size, int fg);
#void *gdImageJpegPtr (gdImagePtr im, int *size, int quality);
#void *gdImagePngPtr (gdImagePtr im, int *size);
#void *gdImageGdPtr (gdImagePtr im, int *size);
#void *gdImageGd2Ptr (gdImagePtr im, int cs, int fmt, int *size);
#void *gdImagePngPtrEx (gdImagePtr im, int *size, int level);
#
sub generate_data_ptr_functions
{
my @funcs = split( /\n/, shift );
my $sub = "generate_data_ptr_functions()";
foreach my $func ( @funcs )
{
#print "$sub: Generating data_ptr function for $func...\n";
my $info = parse_prototype( $func )
or die "$sub: Couldn't parse prototype\n";
#use Data::Dumper;
#print Data::Dumper->Dump([$info], ['info']);
my $function_name = $info->{NAME};
my $return_type = $info->{RETURN_TYPE};
my @arg_names = ();
my @call_args = ();
my $arg_decl_string = "";
foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } )
{
my $type = $info->{ARGS}->{$num}->{TYPE};
my $name = $info->{ARGS}->{$num}->{NAME};
if( $name =~ /size/ )
{
push( @call_args, "\&$name" );
next;
}
push(@arg_names, $name );
push(@call_args, $name );
$arg_decl_string .= "\t\t$type\t\t$name\n";
}
my $arg_list = join(", ", @arg_names);
my $call_arg_list = join(", ", @call_args);
# Add the low level functions we'll need:
#
pp_addxs(<<"ENDXS");
SV *
_$function_name( $arg_list )
$arg_decl_string
CODE:
char* imdata;
int size;
imdata = (char *)$function_name( $call_arg_list );
RETVAL = newSVpv( imdata, size );
gdFree( imdata );
OUTPUT:
RETVAL
ENDXS
# Add the object code for this function:
#
# Use template method here to avoid escaping everything:
my $pmcode = <<'ENDPM';
=head2 INSERT_NAME_HERE
( run in 2.510 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )