PDL-IO-GD
view release on metacpan or search on metacpan
#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',
$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);
%}
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 )
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,
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 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' );
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);
#
# 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 )
{
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";
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";
} # 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 )
GENERATED/PDL/IO/GD.pm view on Meta::CPAN
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,
GENERATED/PDL/IO/GD.pm view on Meta::CPAN
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' );
GENERATED/PDL/IO/GD.pm view on Meta::CPAN
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' );
GENERATED/PDL/IO/GD.pm view on Meta::CPAN
=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
#line 1397 "GD.pd"
=head2 write_Png
$image->write_Png( $filename )
=cut
sub write_Png
{
my $self = shift;
return _gdImagePng ( $self->{IMG_PTR}, @_ );
} # End of write_Png()...
#line 1397 "GD.pd"
=head2 write_PngEx
$image->write_PngEx( $filename, $level )
=cut
sub write_PngEx
{
my $self = shift;
return _gdImagePngEx ( $self->{IMG_PTR}, @_ );
} # End of write_PngEx()...
#line 1397 "GD.pd"
=head2 write_WBMP
$image->write_WBMP( $fg, $filename )
=cut
sub write_WBMP
GENERATED/PDL/IO/GD.pm view on Meta::CPAN
=cut
sub write_Gif
{
my $self = shift;
return _gdImageGif ( $self->{IMG_PTR}, @_ );
} # End of write_Gif()...
#line 1509 "GD.pd"
=head2 get_Png_data
$image->get_Png_data( )
=cut
sub get_Png_data
{
my $self = shift;
return _gdImagePngPtr ( $self->{IMG_PTR}, @_ );
} # End of get_Png_data()...
#line 1509 "GD.pd"
=head2 get_PngEx_data
$image->get_PngEx_data( $level )
=cut
sub get_PngEx_data
{
my $self = shift;
return _gdImagePngPtrEx ( $self->{IMG_PTR}, @_ );
} # End of get_PngEx_data()...
#line 1509 "GD.pd"
=head2 get_WBMP_data
$image->get_WBMP_data( $fg )
=cut
sub get_WBMP_data
t/gd_oo_tests.t view on Meta::CPAN
ok( 1, 'add some text' );
# Generate a color bar:
my $x1 = zeroes( long, 256 ) + 50;
my $y1 = sequence( long, 256 ) + 30;
my $color = sequence(long, 256);
$im->Lines( $x1, $y1, $x1 + 100, $y1, $color );
ok( 1, 'generate a color bar' );
# Write the output file:
$im->write_Png( $testfile2 );
ok( 1, 'write the output file' );
undef $im;
my $pic = sequence(100, 100);
$im = PDL::IO::GD->new({ pdl => $pic });
ok( defined( $im ), 'create from 2d PDL without a LUT' );
undef $im;
$im = PDL::IO::GD->new({ pdl => $pic, lut => $lut });
ok( defined( $im ), 'create from 2d PDL and a LUT' );
t/gd_oo_tests.t view on Meta::CPAN
$im = PDL::IO::GD->new({ data => $blob, type => 'png' });
ok( defined( $im ), 'create from glob with type given' );
undef $im;
# Create from a 3d PNG data glob:
my $blob3d = do { open my $fh, $testfile_true or die "$testfile_true: $!"; binmode $fh; local $/; <$fh> };
ok defined $blob, "read test file $testfile_true";
$im = PDL::IO::GD->new({ data => $blob3d });
ok( defined( $im ), 'create from a 3d PNG data glob' );
# Get a PNG data glob from a created
my $png_blob = $im->get_Png_data();
ok( $blob3d eq $png_blob, 'get a PNG data glob' );
undef $im;
# Try a nicer way to make an object. Just pass in a filename:
my $gd_new_just_filename = PDL::IO::GD->new( $testfile_lut );
ok( defined( $gd_new_just_filename ), 'initialize an object from JUST the filename' );
# Try another nicer way to make an object: Pass in an inline hash:
my $gd_new_inline_hash = PDL::IO::GD->new( filename => $testfile_lut );
ok( defined( $gd_new_inline_hash ), 'initialize an object from an inline hash' );
( run in 0.785 second using v1.01-cache-2.11-cpan-0a6323c29d9 )