PDL-IO-GD-2.103/0000755000175000017500000000000014736677206012703 5ustar osboxesosboxesPDL-IO-GD-2.103/META.json0000644000175000017500000000263314736677206014330 0ustar osboxesosboxes{ "abstract" : "unknown", "author" : [ "PerlDL Developers " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PDL-IO-GD", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0", "PDL" : "2.094" } }, "runtime" : { "requires" : { "PDL" : "2.094" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/PDLPorters/PDL-IO-GD/issues" }, "homepage" : "http://pdl.perl.org/", "repository" : { "type" : "git", "url" : "git://github.com/PDLPorters/PDL-IO-GD.git", "web" : "https://github.com/PDLPorters/PDL-IO-GD" }, "x_IRC" : "irc://irc.perl.org/#pdl" }, "version" : "2.103", "x_serialization_backend" : "JSON::PP version 4.04" } PDL-IO-GD-2.103/typemap0000644000175000017500000000027514723505457014303 0ustar osboxesosboxes# # Extra type mappings for Judd::PDL::IO::GD # gdImagePtr T_PTR gdImage * T_PTR gdFontPtr T_PTR gdFont * T_PTR gdPointPtr T_PTR int * T_PTR unsigned short * T_PTR PDL-IO-GD-2.103/MANIFEST.SKIP0000644000175000017500000000075614723507100014566 0ustar osboxesosboxes\.DS_Store %$ -stamp$ .*/TAGS$ .*Version_check$ .*\#$ .*\.0$ .*\.orig$ .*\.rej$ \.swp$ .exe$ /\.\#.* /pm_to_blib$ /tmp.* MANIFEST\.bak$ MANIFEST\.old META\.json META\.yml Makefile$ Makefile\.aperl Makefile\.old \.(tmp|new|diff|ori)$ \.BAK$ \.bck$ \.bs \.bundle$ \.lck$ \.m$ \.o$ \.out$ \.patch$ \.so$ \.tar\.gz$ /core$ \b_eumm/ ^GD\.(pm|xs|c)$ ^\.\#.* ^\.exists ^\.git \.gitignore$ ^blib/ ^pm_to_blib$ ~$ ^xt/ ^\.github/ ^\.cirrus\.yml ^cover_db/ ^nytprof(/|\.out) \.gc(ov|no|da)$ pp-\w*\.c$ PDL-IO-GD-2.103/t/0000755000175000017500000000000014736677206013146 5ustar osboxesosboxesPDL-IO-GD-2.103/t/gd_tests.t0000644000175000017500000001235414723505457015146 0ustar osboxesosboxes# t/gd_tests.t - tests functions in the PDL::IO::GD module # Judd Taylor, USF IMaRS # 13 March 2003 use strict; use warnings; use PDL; use Test::More; use Test::PDL; use File::Temp qw(tempdir); use PDL::IO::GD; # Test Files: my $tempdir = tempdir( CLEANUP=>1 ); my $lutfile = "$tempdir/default.rcols"; my $testfile1 = "$tempdir/test.png"; my $testfile2 = "$tempdir/test_true.png"; my $testfile3 = "$tempdir/test_comp.png"; my $testfile4 = "$tempdir/test_nocomp.png"; # Write out the lutfile below, so we don't have to include it in the distro: write_lut($lutfile); my $lut = load_lut( $lutfile ); ok( ($lut->dim(0) == 3 && $lut->dim(1) == 256) ); eval {write_png( sequence(16,16), sequence(255)->dummy(0,3), $testfile1 )}; like $@, qr/exceeded LUT size/, 'too-short LUT throws exception'; my $pdl = sequence(byte, 30, 30); write_png( $pdl, $lut, $testfile1 ); is_pdl read_png($testfile1), $pdl->long; eval {read_true_png($testfile1)}; like $@, qr/Tried to read a non-truecolour/, 'right error instead of segfault'; is_pdl read_png_lut( $testfile1 ), $lut; my $tc_pdl = sequence(byte, 100, 100, 3); write_true_png( $tc_pdl, $testfile2 ); is_pdl read_true_png( $testfile2 ), $tc_pdl; $pdl = sequence(byte, 30, 30); write_png_ex($pdl, $lut, $testfile3, 0); write_png_ex($pdl, $lut, $testfile3, 9); write_png_best($pdl, $lut, $testfile3); $pdl = sequence(100, 100, 3); write_true_png_ex($pdl, $testfile4, 0); write_true_png_ex($pdl, $testfile3, 9); write_true_png_best($pdl, $testfile3 ); recompress_png_best( $testfile3 ); is_pdl read_png( $testfile4 ), read_png( $testfile3 ); done_testing; sub write_lut { my $filename = shift; open my $fh, ">", $filename or die "Can't write $filename: $!\n"; print $fh <<'ENDLUT'; 2 0 4 9 0 7 22 0 19 36 0 32 50 0 48 61 0 63 69 0 77 77 0 91 82 0 104 84 0 118 88 0 132 87 0 145 84 0 159 83 0 173 77 0 186 70 0 200 60 0 214 53 0 227 40 0 241 25 0 255 12 0 255 0 4 255 0 21 255 0 38 255 0 55 255 0 72 255 0 89 255 0 106 255 0 119 255 0 135 255 0 152 255 0 165 255 0 187 255 0 195 255 0 203 255 0 208 255 0 220 255 0 225 255 0 233 255 0 242 255 0 250 255 0 255 255 0 255 242 0 255 238 0 255 225 0 255 220 0 255 212 0 255 203 0 255 195 0 255 187 0 255 174 0 255 165 0 255 152 0 255 144 0 255 131 0 255 114 0 255 102 0 255 84 0 255 67 0 255 55 0 255 38 0 255 21 0 255 8 8 255 0 25 255 0 42 255 0 55 255 0 76 255 0 97 255 0 119 255 0 140 255 0 161 255 0 182 255 0 203 255 0 225 255 0 246 255 0 255 242 0 255 242 0 255 242 0 255 242 0 255 238 0 255 238 0 255 238 0 255 233 0 255 233 0 255 233 0 255 233 0 255 229 0 255 229 0 255 229 0 255 221 0 255 221 0 255 221 0 255 221 0 255 216 0 255 216 0 255 216 0 255 212 0 255 212 0 255 212 0 255 208 0 255 208 0 255 199 0 255 199 0 255 199 0 255 195 0 255 195 0 255 191 0 255 191 0 255 191 0 255 187 0 255 187 0 255 178 0 255 178 0 255 178 0 255 174 0 255 174 0 255 170 0 255 170 0 255 165 0 255 165 0 255 165 0 255 161 0 255 161 0 255 153 0 255 153 0 255 153 0 255 148 0 255 148 0 255 144 0 255 144 0 255 144 0 255 140 0 255 140 0 255 131 0 255 131 0 255 127 0 255 127 0 255 127 0 255 123 0 255 123 0 255 123 0 255 119 0 255 119 0 255 110 0 255 110 0 255 110 0 255 106 0 255 106 0 255 106 0 255 102 0 255 102 0 255 97 0 255 97 0 255 97 0 255 89 0 255 89 0 255 85 0 255 85 0 255 85 0 255 80 0 255 80 0 255 76 0 255 76 0 255 72 0 255 72 0 255 72 0 255 63 0 255 63 0 255 59 0 255 59 0 255 55 0 255 55 0 255 51 0 255 51 0 255 42 0 255 42 0 255 38 0 255 38 0 255 34 0 255 34 0 255 29 0 255 29 0 255 21 0 255 21 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 29 0 170 170 170 0 255 0 255 250 0 0 0 0 255 255 255 ENDLUT } # End of write_lut()... PDL-IO-GD-2.103/t/gd_oo_tests.t0000644000175000017500000002057114723505457015643 0ustar osboxesosboxes# Tests for the OO interface of PDL::IO::GD. # Judd Taylor, Orbital Sytstems, Ltd. # 07 Apr 2006 use strict; use warnings; use PDL; use Test::More; use Test::PDL; use File::Temp qw(tempdir); use PDL::IO::GD; my $tempdir = tempdir( CLEANUP => 1 ); my $lutfile = "$tempdir/default.rcols"; my $testfile_lut = "$tempdir/test.png"; my $testfile2 = "$tempdir/test2.png"; my $testfile_true = "$tempdir/test3.png"; # Write out the lutfile below, so we don't have to include it in the distro: write_lut($lutfile); my $pdl = sequence(byte, 30, 30); my $lut = load_lut( $lutfile ); ok( ($lut->dim(0) == 3 && $lut->dim(1) == 256), 'Load a lut from an ASCII file' ); write_png( $pdl, $lut, $testfile_lut ); write_true_png(sequence(100, 100, 3), $testfile_true); eval {PDL::IO::GD->new( { filename => "$tempdir/notthere.png" } )}; like $@, qr/Error/, 'exception not segfault on non-existent file'; my $gd = PDL::IO::GD->new( { filename => $testfile_lut } ); ok( defined( $gd ), 'Object created' ); is $gd->gdImageSX, 30, 'query X dim'; is $gd->gdImageSY, 30, 'query Y dim'; is_pdl $gd->to_pdl, $pdl->long, 'image matches original pdl'; is_pdl $gd->to_rpic->slice(',-1:0'), $pdl->long, 'rpic image matches original pdl'; undef $gd; my $im = PDL::IO::GD->new( { x => 300, y => 300 } ); ok( defined( $im ), 'create new image from scratch' ); $im->apply_lut( $lut ); # Resolve some colors: my $black = $im->ColorResolve( 0, 0, 0 ); ok( defined( $black ), 'resolve color black' ); my $red = $im->ColorResolve( 255, 0, 0 ); ok( defined( $red ), 'resolve color red' ); my $green = $im->ColorResolve( 0, 255, 0 ); ok( defined( $green ), 'resolve color green' ); my $blue = $im->ColorResolve( 0, 0, 255 ); ok( defined( $blue ), 'resolve color blue' ); # Draw a rectangle: $im->Rectangle( 5, 5, 295, 295, $red ); ok( 1, 'draw a rectangle' ); # Add some text: $im->String( gdFontGetLarge(), 10, 10, "Test Large Font!", $green ); 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' ); undef $im; my $pic3d = $pic->dummy(2,3); $im = PDL::IO::GD->new({ pdl => $pic3d }); ok( defined( $im ), 'create from a RGB PDL' ); undef $im; $im = PDL::IO::GD->new({ x => 100, y => 100, true_color => 1 }); ok( defined( $im ), 'create an RGB from scratch' ); undef $im; # Create from a 2d PNG data glob: my $blob = do { open my $fh, $testfile_lut or die "$testfile_lut: $!"; binmode $fh; local $/; <$fh> }; ok defined $blob, "read test file $testfile_lut"; $im = PDL::IO::GD->new({ data => $blob }); ok( defined( $im ), 'create from a 2d PNG data glob' ); undef $im; # Create from a 2d PNG data glob, with the type given: $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' ); # Make sure bogus inline hashes generate complaints. First, give an odd # number of args my $gd_new_inline_hash_broken1; eval { $gd_new_inline_hash_broken1 = PDL::IO::GD->new( filename => $testfile_lut, 34 ) }; ok( $@ && !defined( $gd_new_inline_hash_broken1 ), 'incorrectly initialize an object from an inline hash: odd Nargs' ); # TEST 32: # Make sure bogus inline hashes generate complaints. Give a non-string key my $gd_new_inline_hash_broken2; eval { $gd_new_inline_hash_broken2 = PDL::IO::GD->new( filename => $testfile_lut, [34] => 12 ) }; ok( $@ && !defined( $gd_new_inline_hash_broken2 ), 'incorrectly initialize an object from an inline hash: non-string key' ); done_testing; sub write_lut { my $filename = shift; open my $fh, ">", $filename or die "Can't write $filename: $!\n"; print $fh <<'ENDLUT'; 2 0 4 9 0 7 22 0 19 36 0 32 50 0 48 61 0 63 69 0 77 77 0 91 82 0 104 84 0 118 88 0 132 87 0 145 84 0 159 83 0 173 77 0 186 70 0 200 60 0 214 53 0 227 40 0 241 25 0 255 12 0 255 0 4 255 0 21 255 0 38 255 0 55 255 0 72 255 0 89 255 0 106 255 0 119 255 0 135 255 0 152 255 0 165 255 0 187 255 0 195 255 0 203 255 0 208 255 0 220 255 0 225 255 0 233 255 0 242 255 0 250 255 0 255 255 0 255 242 0 255 238 0 255 225 0 255 220 0 255 212 0 255 203 0 255 195 0 255 187 0 255 174 0 255 165 0 255 152 0 255 144 0 255 131 0 255 114 0 255 102 0 255 84 0 255 67 0 255 55 0 255 38 0 255 21 0 255 8 8 255 0 25 255 0 42 255 0 55 255 0 76 255 0 97 255 0 119 255 0 140 255 0 161 255 0 182 255 0 203 255 0 225 255 0 246 255 0 255 242 0 255 242 0 255 242 0 255 242 0 255 238 0 255 238 0 255 238 0 255 233 0 255 233 0 255 233 0 255 233 0 255 229 0 255 229 0 255 229 0 255 221 0 255 221 0 255 221 0 255 221 0 255 216 0 255 216 0 255 216 0 255 212 0 255 212 0 255 212 0 255 208 0 255 208 0 255 199 0 255 199 0 255 199 0 255 195 0 255 195 0 255 191 0 255 191 0 255 191 0 255 187 0 255 187 0 255 178 0 255 178 0 255 178 0 255 174 0 255 174 0 255 170 0 255 170 0 255 165 0 255 165 0 255 165 0 255 161 0 255 161 0 255 153 0 255 153 0 255 153 0 255 148 0 255 148 0 255 144 0 255 144 0 255 144 0 255 140 0 255 140 0 255 131 0 255 131 0 255 127 0 255 127 0 255 127 0 255 123 0 255 123 0 255 123 0 255 119 0 255 119 0 255 110 0 255 110 0 255 110 0 255 106 0 255 106 0 255 106 0 255 102 0 255 102 0 255 97 0 255 97 0 255 97 0 255 89 0 255 89 0 255 85 0 255 85 0 255 85 0 255 80 0 255 80 0 255 76 0 255 76 0 255 72 0 255 72 0 255 72 0 255 63 0 255 63 0 255 59 0 255 59 0 255 55 0 255 55 0 255 51 0 255 51 0 255 42 0 255 42 0 255 38 0 255 38 0 255 34 0 255 34 0 255 29 0 255 29 0 255 21 0 255 21 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 17 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 12 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 8 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 0 0 255 29 0 170 170 170 0 255 0 255 250 0 0 0 0 255 255 255 ENDLUT } # End of write_lut()... PDL-IO-GD-2.103/GENERATED/0000755000175000017500000000000014736677206014201 5ustar osboxesosboxesPDL-IO-GD-2.103/GENERATED/PDL/0000755000175000017500000000000014736677206014620 5ustar osboxesosboxesPDL-IO-GD-2.103/GENERATED/PDL/IO/0000755000175000017500000000000014736677207015130 5ustar osboxesosboxesPDL-IO-GD-2.103/GENERATED/PDL/IO/GD.pm0000644000175000017500000015256414736677207015775 0ustar osboxesosboxes# # GENERATED WITH PDL::PP from GD.pd! Don't modify! # package PDL::IO::GD; our @EXPORT_OK = qw(write_png write_png_ex write_true_png write_true_png_ex write_png_best write_true_png_best recompress_png_best load_lut read_true_png read_png _gd_image_to_pdl_true _gd_image_to_rpic_true _gd_image_to_pdl _gd_image_to_rpic _pdl_to_gd_image_true _pdl_to_gd_image_lut read_png_lut write_gif_anim _gdImageColorAllocates _gdImageColorAllocateAlphas _gdImageSetPixels _gdImageLines _gdImageDashedLines _gdImageRectangles _gdImageFilledRectangles _gdImageFilledArcs _gdImageArcs _gdImageFilledEllipses gdAlphaBlend gdTrueColor gdTrueColorAlpha gdFree gdFontGetLarge gdFontGetSmall gdFontGetMediumBold gdFontGetGiant gdFontGetTiny ); our %EXPORT_TAGS = (Func=>\@EXPORT_OK); use PDL::Core; use PDL::Exporter; use DynaLoader; our @ISA = ( 'PDL::Exporter','DynaLoader' ); push @PDL::Core::PP, __PACKAGE__; bootstrap PDL::IO::GD ; #line 22 "GD.pd" use strict; use warnings; =head1 NAME PDL::IO::GD - Interface to the GD image library. =head1 SYNOPSIS my $pdl = sequence(byte, 30, 30); write_png($pdl, load_lut($lutfile), "test.png"); write_true_png(sequence(100, 100, 3), "test_true.png"); my $image = read_png("test.png"); 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 #line 71 "GD.pm" =head1 FUNCTIONS =cut =head2 write_png =for sig Signature: (img(x,y); lut(i=3,j); char* filename) 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. =for bad write_png does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *write_png = \&PDL::write_png; =head2 write_png_ex =for sig Signature: (img(x,y); lut(i=3,j); char* filename; int level) Same as write_png(), except you can specify the compression level (0-9) as the last argument. =for bad write_png_ex does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *write_png_ex = \&PDL::write_png_ex; =head2 write_true_png =for sig Signature: (img(x,y,z=3); char* filename) Writes an (x, y, z(3)) PDL variable out to a PNG file, using a true color format. This means a larger file on disk, but can contain more than 256 colors. =for bad write_true_png does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *write_true_png = \&PDL::write_true_png; =head2 write_true_png_ex =for sig Signature: (img(x,y,z=3); char* filename; int level) Same as write_true_png(), except you can specify the compression level (0-9) as the last argument. =for bad write_true_png_ex does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *write_true_png_ex = \&PDL::write_true_png_ex; #line 233 "GD.pd" =head2 write_png_best 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()... #line 308 "GD.pd" =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); } #line 235 "GD.pm" =head2 read_true_png =for sig Signature: ([o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))),z=3); char* filename) =for ref Reads a true colour PNG image into a (new) PDL variable. =for bad read_true_png does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *read_true_png = \&PDL::read_true_png; =head2 read_png =for sig Signature: ([o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im)))); char* filename) =for ref Reads a (palette) PNG image into a (new) PDL variable. =for bad read_png does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *read_png = \&PDL::read_png; *_gd_image_to_pdl_true = \&PDL::_gd_image_to_pdl_true; *_gd_image_to_rpic_true = \&PDL::_gd_image_to_rpic_true; *_gd_image_to_pdl = \&PDL::_gd_image_to_pdl; *_gd_image_to_rpic = \&PDL::_gd_image_to_rpic; *_pdl_to_gd_image_true = \&PDL::_pdl_to_gd_image_true; *_pdl_to_gd_image_lut = \&PDL::_pdl_to_gd_image_lut; =head2 read_png_lut =for sig Signature: ([o] lut(c=3,i=256); char* filename) =for ref Reads a color LUT from an already-existing palette PNG file. =for bad read_png_lut does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *read_png_lut = \&PDL::read_png_lut; =head2 write_gif_anim =for sig Signature: (img(c=3,x,y,n); char* filename; int Loops; int Delay) =for ref Writes an image cube to a file as an animated GIF. RGB dimension is first. y=0 is at bottom. 0 loops = infinite (default). Delay in 100ths of a second, default 4. =for bad write_gif_anim does not process bad values. It will set the bad-value flag of all output ndarrays if the flag is set for any of the input ndarrays. =cut *write_gif_anim = \&PDL::write_gif_anim; *_gdImageColorAllocates = \&PDL::_gdImageColorAllocates; *_gdImageColorAllocateAlphas = \&PDL::_gdImageColorAllocateAlphas; *_gdImageSetPixels = \&PDL::_gdImageSetPixels; *_gdImageLines = \&PDL::_gdImageLines; *_gdImageDashedLines = \&PDL::_gdImageDashedLines; *_gdImageRectangles = \&PDL::_gdImageRectangles; *_gdImageFilledRectangles = \&PDL::_gdImageFilledRectangles; *_gdImageFilledArcs = \&PDL::_gdImageFilledArcs; *_gdImageArcs = \&PDL::_gdImageArcs; *_gdImageFilledEllipses = \&PDL::_gdImageFilledEllipses; #line 472 "GD.pd" =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 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 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 }); my $gd = PDL::IO::GD->new({ filename => "image.png" }); my $gd = PDL::IO::GD->new({ x => 100, y => 100 }); my $gd = PDL::IO::GD->new({ x => 100, y => 100, true_color => 1 }); my $gd = PDL::IO::GD->new({ data => $imageData }); my $gd = PDL::IO::GD->new({ data => $imageData, type => 'wbmp' }); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; #my $self = $class->SUPER::new( @_ ); my $self = {}; my $sub = _pkg_name( "new" ); # Figure out our options: # I want a single hash. I handle several cases here my $options; if( @_ == 1 && ref $_[0] eq 'HASH' ) { # single hash argument. Just take it $options = shift; } elsif( @_ == 1 && ! ref $_[0] ) { # single scalar argument. Treat it as a filename by default my $filename = shift; $options = { filename => $filename }; } else { # the only other acceptable option is an inline hash. This is valid if I # have an even number of arguments, and the even-indexed ones (the keys) # are scalars if( @_ % 2 == 0 ) { my @pairs = @_; my $Npairs = scalar(@pairs)/2; use List::Util 'none'; if( none { ref $pairs[2*$_] } 0..$Npairs-1 ) { # treat the arguments as a hash $options = { @pairs } } } } if( !defined $options ) { die <{pdl} ) ) { # Create it from a PDL variable: my $pdl = $options->{pdl}; $pdl->make_physical(); my $num_dims = scalar( $pdl->dims() ); if( $num_dims == 2 ) { if( defined( $options->{lut} ) ) { die "$sub: _pdl_to_gd_image_lut() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_lut( $pdl, $options->{lut} )->sclr; } else { my $lut = sequence(byte, 256)->slice("*3,:"); die "$sub: _pdl_to_gd_image_lut() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_lut( $pdl, $lut )->sclr; } } elsif( $num_dims == 3 ) { die "$sub: _pdl_to_gd_image_true() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_true( $pdl )->sclr; } else { die "Can't create a PDL::IO::GD from a PDL with bad dims\n"; } } elsif( exists( $options->{filename} ) ) { # Create it from a file: if( !defined $options->{filename} ) { die "PDL::IO::GD::new got an undefined filename. Giving up.\n"; } # Figure out what type of file it is: $self->{input_type} = _id_image_file( $options->{filename} ) or die "$sub: Can't determine image type of filename => \'$options->{filename}\'\n"; # Read in the file: $self->{IMG_PTR} = _img_ptr_from_file( $options->{filename}, $self->{input_type} ) or die "$sub: Can't read in the input file\n"; } elsif( defined( $options->{x} ) && defined( $options->{y} ) ) { # Create an empty image: my $done = 0; if( $options->{true_color} ) { # Create an empty true color image: die "$sub: _gdImageCreateTrueColor() failed\n" unless $self->{IMG_PTR} = _gdImageCreateTrueColor( $options->{x}, $options->{y} ); $done = 1; } unless( $done ) { # Create an empty palette image: die "$sub: _gdImageCreatePalette() failed\n" unless $self->{IMG_PTR} = _gdImageCreatePalette( $options->{x}, $options->{y} ); } } elsif( defined( $options->{data} ) ) { # Create an image from the given image data: # Figure out what type of file it is: if( defined( $options->{type} ) && ( $options->{type} eq 'jpg' || $options->{type} eq 'png' || $options->{type} eq 'gif' || $options->{type} eq 'wbmp' || $options->{type} eq 'gd' || $options->{type} eq 'gd2' ) ) { $self->{input_type} = $options->{type}; } else { $self->{input_type} = _id_image_data( $options->{data} ) or die "$sub: Can't determine image type given data\n"; } # Load the data: $self->{IMG_PTR} = _img_ptr_from_data( $options->{data}, $self->{input_type} ) or die "$sub: Can't load the input image data\n"; } # Bless and return: # bless ($self, $class); return $self; } # End of new()... =head2 to_pdl 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 highest (x,y,3). To get it in the lowest dim (and with y=0 is the bottom), use L. =cut sub to_pdl { my $self = shift; $self->gdImageTrueColor() ? _gd_image_to_pdl_true( $self->{IMG_PTR} ) : _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. =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 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 { my $self = shift; return _gdImageWBMP ( $self->{IMG_PTR}, @_ ); } # End of write_WBMP()... #line 1397 "GD.pd" =head2 write_Jpeg $image->write_Jpeg( $filename, $quality ) =cut sub write_Jpeg { my $self = shift; return _gdImageJpeg ( $self->{IMG_PTR}, @_ ); } # End of write_Jpeg()... #line 1397 "GD.pd" =head2 write_Gd $image->write_Gd( $filename ) =cut sub write_Gd { my $self = shift; return _gdImageGd ( $self->{IMG_PTR}, @_ ); } # End of write_Gd()... #line 1397 "GD.pd" =head2 write_Gd2 $image->write_Gd2( $filename, $cs, $fmt ) =cut sub write_Gd2 { my $self = shift; return _gdImageGd2 ( $self->{IMG_PTR}, @_ ); } # End of write_Gd2()... #line 1397 "GD.pd" =head2 write_Gif $image->write_Gif( $filename ) =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 { my $self = shift; return _gdImageWBMPPtr ( $self->{IMG_PTR}, @_ ); } # End of get_WBMP_data()... #line 1509 "GD.pd" =head2 get_Jpeg_data $image->get_Jpeg_data( $quality ) =cut sub get_Jpeg_data { my $self = shift; return _gdImageJpegPtr ( $self->{IMG_PTR}, @_ ); } # End of get_Jpeg_data()... #line 1509 "GD.pd" =head2 get_Gd_data $image->get_Gd_data( ) =cut sub get_Gd_data { my $self = shift; return _gdImageGdPtr ( $self->{IMG_PTR}, @_ ); } # End of get_Gd_data()... #line 1509 "GD.pd" =head2 get_Gd2_data $image->get_Gd2_data( $cs, $fmt ) =cut sub get_Gd2_data { my $self = shift; return _gdImageGd2Ptr ( $self->{IMG_PTR}, @_ ); } # End of get_Gd2_data()... #line 1609 "GD.pd" =head2 SetPixel $image->SetPixel( $x, $y, $color ) Alias for gdImageSetPixel. =cut sub SetPixel { return gdImageSetPixel ( @_ ); } # End of SetPixel()... =head2 gdImageSetPixel $image->gdImageSetPixel( $x, $y, $color ) =cut sub gdImageSetPixel { my $self = shift; return _gdImageSetPixel ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetPixel()... #line 1609 "GD.pd" =head2 GetPixel $image->GetPixel( $x, $y ) Alias for gdImageGetPixel. =cut sub GetPixel { return gdImageGetPixel ( @_ ); } # End of GetPixel()... =head2 gdImageGetPixel $image->gdImageGetPixel( $x, $y ) =cut sub gdImageGetPixel { my $self = shift; return _gdImageGetPixel ( $self->{IMG_PTR}, @_ ); } # End of gdImageGetPixel()... #line 1609 "GD.pd" =head2 AABlend $image->AABlend( ) Alias for gdImageAABlend. =cut sub AABlend { return gdImageAABlend ( @_ ); } # End of AABlend()... =head2 gdImageAABlend $image->gdImageAABlend( ) =cut sub gdImageAABlend { my $self = shift; return _gdImageAABlend ( $self->{IMG_PTR}, @_ ); } # End of gdImageAABlend()... #line 1609 "GD.pd" =head2 Line $image->Line( $x1, $y1, $x2, $y2, $color ) Alias for gdImageLine. =cut sub Line { return gdImageLine ( @_ ); } # End of Line()... =head2 gdImageLine $image->gdImageLine( $x1, $y1, $x2, $y2, $color ) =cut sub gdImageLine { my $self = shift; return _gdImageLine ( $self->{IMG_PTR}, @_ ); } # End of gdImageLine()... #line 1609 "GD.pd" =head2 DashedLine $image->DashedLine( $x1, $y1, $x2, $y2, $color ) Alias for gdImageDashedLine. =cut sub DashedLine { return gdImageDashedLine ( @_ ); } # End of DashedLine()... =head2 gdImageDashedLine $image->gdImageDashedLine( $x1, $y1, $x2, $y2, $color ) =cut sub gdImageDashedLine { my $self = shift; return _gdImageDashedLine ( $self->{IMG_PTR}, @_ ); } # End of gdImageDashedLine()... #line 1609 "GD.pd" =head2 Rectangle $image->Rectangle( $x1, $y1, $x2, $y2, $color ) Alias for gdImageRectangle. =cut sub Rectangle { return gdImageRectangle ( @_ ); } # End of Rectangle()... =head2 gdImageRectangle $image->gdImageRectangle( $x1, $y1, $x2, $y2, $color ) =cut sub gdImageRectangle { my $self = shift; return _gdImageRectangle ( $self->{IMG_PTR}, @_ ); } # End of gdImageRectangle()... #line 1609 "GD.pd" =head2 FilledRectangle $image->FilledRectangle( $x1, $y1, $x2, $y2, $color ) Alias for gdImageFilledRectangle. =cut sub FilledRectangle { return gdImageFilledRectangle ( @_ ); } # End of FilledRectangle()... =head2 gdImageFilledRectangle $image->gdImageFilledRectangle( $x1, $y1, $x2, $y2, $color ) =cut sub gdImageFilledRectangle { my $self = shift; return _gdImageFilledRectangle ( $self->{IMG_PTR}, @_ ); } # End of gdImageFilledRectangle()... #line 1609 "GD.pd" =head2 SetClip $image->SetClip( $x1, $y1, $x2, $y2 ) Alias for gdImageSetClip. =cut sub SetClip { return gdImageSetClip ( @_ ); } # End of SetClip()... =head2 gdImageSetClip $image->gdImageSetClip( $x1, $y1, $x2, $y2 ) =cut sub gdImageSetClip { my $self = shift; return _gdImageSetClip ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetClip()... #line 1609 "GD.pd" =head2 GetClip $image->GetClip( $x1P, $y1P, $x2P, $y2P ) Alias for gdImageGetClip. =cut sub GetClip { return gdImageGetClip ( @_ ); } # End of GetClip()... =head2 gdImageGetClip $image->gdImageGetClip( $x1P, $y1P, $x2P, $y2P ) =cut sub gdImageGetClip { my $self = shift; return _gdImageGetClip ( $self->{IMG_PTR}, @_ ); } # End of gdImageGetClip()... #line 1609 "GD.pd" =head2 BoundsSafe $image->BoundsSafe( $x, $y ) Alias for gdImageBoundsSafe. =cut sub BoundsSafe { return gdImageBoundsSafe ( @_ ); } # End of BoundsSafe()... =head2 gdImageBoundsSafe $image->gdImageBoundsSafe( $x, $y ) =cut sub gdImageBoundsSafe { my $self = shift; return _gdImageBoundsSafe ( $self->{IMG_PTR}, @_ ); } # End of gdImageBoundsSafe()... #line 1609 "GD.pd" =head2 Char $image->Char( $f, $x, $y, $c, $color ) Alias for gdImageChar. =cut sub Char { return gdImageChar ( @_ ); } # End of Char()... =head2 gdImageChar $image->gdImageChar( $f, $x, $y, $c, $color ) =cut sub gdImageChar { my $self = shift; return _gdImageChar ( $self->{IMG_PTR}, @_ ); } # End of gdImageChar()... #line 1609 "GD.pd" =head2 CharUp $image->CharUp( $f, $x, $y, $c, $color ) Alias for gdImageCharUp. =cut sub CharUp { return gdImageCharUp ( @_ ); } # End of CharUp()... =head2 gdImageCharUp $image->gdImageCharUp( $f, $x, $y, $c, $color ) =cut sub gdImageCharUp { my $self = shift; return _gdImageCharUp ( $self->{IMG_PTR}, @_ ); } # End of gdImageCharUp()... #line 1609 "GD.pd" =head2 String $image->String( $f, $x, $y, $s, $color ) Alias for gdImageString. =cut sub String { return gdImageString ( @_ ); } # End of String()... =head2 gdImageString $image->gdImageString( $f, $x, $y, $s, $color ) =cut sub gdImageString { my $self = shift; return _gdImageString ( $self->{IMG_PTR}, @_ ); } # End of gdImageString()... #line 1609 "GD.pd" =head2 StringUp $image->StringUp( $f, $x, $y, $s, $color ) Alias for gdImageStringUp. =cut sub StringUp { return gdImageStringUp ( @_ ); } # End of StringUp()... =head2 gdImageStringUp $image->gdImageStringUp( $f, $x, $y, $s, $color ) =cut sub gdImageStringUp { my $self = shift; return _gdImageStringUp ( $self->{IMG_PTR}, @_ ); } # End of gdImageStringUp()... #line 1609 "GD.pd" =head2 String16 $image->String16( $f, $x, $y, $s, $color ) Alias for gdImageString16. =cut sub String16 { return gdImageString16 ( @_ ); } # End of String16()... =head2 gdImageString16 $image->gdImageString16( $f, $x, $y, $s, $color ) =cut sub gdImageString16 { my $self = shift; return _gdImageString16 ( $self->{IMG_PTR}, @_ ); } # End of gdImageString16()... #line 1609 "GD.pd" =head2 StringUp16 $image->StringUp16( $f, $x, $y, $s, $color ) Alias for gdImageStringUp16. =cut sub StringUp16 { return gdImageStringUp16 ( @_ ); } # End of StringUp16()... =head2 gdImageStringUp16 $image->gdImageStringUp16( $f, $x, $y, $s, $color ) =cut sub gdImageStringUp16 { my $self = shift; return _gdImageStringUp16 ( $self->{IMG_PTR}, @_ ); } # End of gdImageStringUp16()... #line 1609 "GD.pd" =head2 Polygon $image->Polygon( $p, $n, $c ) Alias for gdImagePolygon. =cut sub Polygon { return gdImagePolygon ( @_ ); } # End of Polygon()... =head2 gdImagePolygon $image->gdImagePolygon( $p, $n, $c ) =cut sub gdImagePolygon { my $self = shift; return _gdImagePolygon ( $self->{IMG_PTR}, @_ ); } # End of gdImagePolygon()... #line 1609 "GD.pd" =head2 FilledPolygon $image->FilledPolygon( $p, $n, $c ) Alias for gdImageFilledPolygon. =cut sub FilledPolygon { return gdImageFilledPolygon ( @_ ); } # End of FilledPolygon()... =head2 gdImageFilledPolygon $image->gdImageFilledPolygon( $p, $n, $c ) =cut sub gdImageFilledPolygon { my $self = shift; return _gdImageFilledPolygon ( $self->{IMG_PTR}, @_ ); } # End of gdImageFilledPolygon()... #line 1609 "GD.pd" =head2 ColorAllocate $image->ColorAllocate( $r, $g, $b ) Alias for gdImageColorAllocate. =cut sub ColorAllocate { return gdImageColorAllocate ( @_ ); } # End of ColorAllocate()... =head2 gdImageColorAllocate $image->gdImageColorAllocate( $r, $g, $b ) =cut sub gdImageColorAllocate { my $self = shift; return _gdImageColorAllocate ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorAllocate()... #line 1609 "GD.pd" =head2 ColorAllocateAlpha $image->ColorAllocateAlpha( $r, $g, $b, $a ) Alias for gdImageColorAllocateAlpha. =cut sub ColorAllocateAlpha { return gdImageColorAllocateAlpha ( @_ ); } # End of ColorAllocateAlpha()... =head2 gdImageColorAllocateAlpha $image->gdImageColorAllocateAlpha( $r, $g, $b, $a ) =cut sub gdImageColorAllocateAlpha { my $self = shift; return _gdImageColorAllocateAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorAllocateAlpha()... #line 1609 "GD.pd" =head2 ColorClosest $image->ColorClosest( $r, $g, $b ) Alias for gdImageColorClosest. =cut sub ColorClosest { return gdImageColorClosest ( @_ ); } # End of ColorClosest()... =head2 gdImageColorClosest $image->gdImageColorClosest( $r, $g, $b ) =cut sub gdImageColorClosest { my $self = shift; return _gdImageColorClosest ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorClosest()... #line 1609 "GD.pd" =head2 ColorClosestAlpha $image->ColorClosestAlpha( $r, $g, $b, $a ) Alias for gdImageColorClosestAlpha. =cut sub ColorClosestAlpha { return gdImageColorClosestAlpha ( @_ ); } # End of ColorClosestAlpha()... =head2 gdImageColorClosestAlpha $image->gdImageColorClosestAlpha( $r, $g, $b, $a ) =cut sub gdImageColorClosestAlpha { my $self = shift; return _gdImageColorClosestAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorClosestAlpha()... #line 1609 "GD.pd" =head2 ColorClosestHWB $image->ColorClosestHWB( $r, $g, $b ) Alias for gdImageColorClosestHWB. =cut sub ColorClosestHWB { return gdImageColorClosestHWB ( @_ ); } # End of ColorClosestHWB()... =head2 gdImageColorClosestHWB $image->gdImageColorClosestHWB( $r, $g, $b ) =cut sub gdImageColorClosestHWB { my $self = shift; return _gdImageColorClosestHWB ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorClosestHWB()... #line 1609 "GD.pd" =head2 ColorExact $image->ColorExact( $r, $g, $b ) Alias for gdImageColorExact. =cut sub ColorExact { return gdImageColorExact ( @_ ); } # End of ColorExact()... =head2 gdImageColorExact $image->gdImageColorExact( $r, $g, $b ) =cut sub gdImageColorExact { my $self = shift; return _gdImageColorExact ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorExact()... #line 1609 "GD.pd" =head2 ColorExactAlpha $image->ColorExactAlpha( $r, $g, $b, $a ) Alias for gdImageColorExactAlpha. =cut sub ColorExactAlpha { return gdImageColorExactAlpha ( @_ ); } # End of ColorExactAlpha()... =head2 gdImageColorExactAlpha $image->gdImageColorExactAlpha( $r, $g, $b, $a ) =cut sub gdImageColorExactAlpha { my $self = shift; return _gdImageColorExactAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorExactAlpha()... #line 1609 "GD.pd" =head2 ColorResolve $image->ColorResolve( $r, $g, $b ) Alias for gdImageColorResolve. =cut sub ColorResolve { return gdImageColorResolve ( @_ ); } # End of ColorResolve()... =head2 gdImageColorResolve $image->gdImageColorResolve( $r, $g, $b ) =cut sub gdImageColorResolve { my $self = shift; return _gdImageColorResolve ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorResolve()... #line 1609 "GD.pd" =head2 ColorResolveAlpha $image->ColorResolveAlpha( $r, $g, $b, $a ) Alias for gdImageColorResolveAlpha. =cut sub ColorResolveAlpha { return gdImageColorResolveAlpha ( @_ ); } # End of ColorResolveAlpha()... =head2 gdImageColorResolveAlpha $image->gdImageColorResolveAlpha( $r, $g, $b, $a ) =cut sub gdImageColorResolveAlpha { my $self = shift; return _gdImageColorResolveAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorResolveAlpha()... #line 1609 "GD.pd" =head2 ColorDeallocate $image->ColorDeallocate( $color ) Alias for gdImageColorDeallocate. =cut sub ColorDeallocate { return gdImageColorDeallocate ( @_ ); } # End of ColorDeallocate()... =head2 gdImageColorDeallocate $image->gdImageColorDeallocate( $color ) =cut sub gdImageColorDeallocate { my $self = shift; return _gdImageColorDeallocate ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorDeallocate()... #line 1609 "GD.pd" =head2 TrueColorToPalette $image->TrueColorToPalette( $ditherFlag, $colorsWanted ) Alias for gdImageTrueColorToPalette. =cut sub TrueColorToPalette { return gdImageTrueColorToPalette ( @_ ); } # End of TrueColorToPalette()... =head2 gdImageTrueColorToPalette $image->gdImageTrueColorToPalette( $ditherFlag, $colorsWanted ) =cut sub gdImageTrueColorToPalette { my $self = shift; return _gdImageTrueColorToPalette ( $self->{IMG_PTR}, @_ ); } # End of gdImageTrueColorToPalette()... #line 1609 "GD.pd" =head2 ColorTransparent $image->ColorTransparent( $color ) Alias for gdImageColorTransparent. =cut sub ColorTransparent { return gdImageColorTransparent ( @_ ); } # End of ColorTransparent()... =head2 gdImageColorTransparent $image->gdImageColorTransparent( $color ) =cut sub gdImageColorTransparent { my $self = shift; return _gdImageColorTransparent ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorTransparent()... #line 1609 "GD.pd" =head2 FilledArc $image->FilledArc( $cx, $cy, $w, $h, $s, $e, $color, $style ) Alias for gdImageFilledArc. =cut sub FilledArc { return gdImageFilledArc ( @_ ); } # End of FilledArc()... =head2 gdImageFilledArc $image->gdImageFilledArc( $cx, $cy, $w, $h, $s, $e, $color, $style ) =cut sub gdImageFilledArc { my $self = shift; return _gdImageFilledArc ( $self->{IMG_PTR}, @_ ); } # End of gdImageFilledArc()... #line 1609 "GD.pd" =head2 Arc $image->Arc( $cx, $cy, $w, $h, $s, $e, $color ) Alias for gdImageArc. =cut sub Arc { return gdImageArc ( @_ ); } # End of Arc()... =head2 gdImageArc $image->gdImageArc( $cx, $cy, $w, $h, $s, $e, $color ) =cut sub gdImageArc { my $self = shift; return _gdImageArc ( $self->{IMG_PTR}, @_ ); } # End of gdImageArc()... #line 1609 "GD.pd" =head2 FilledEllipse $image->FilledEllipse( $cx, $cy, $w, $h, $color ) Alias for gdImageFilledEllipse. =cut sub FilledEllipse { return gdImageFilledEllipse ( @_ ); } # End of FilledEllipse()... =head2 gdImageFilledEllipse $image->gdImageFilledEllipse( $cx, $cy, $w, $h, $color ) =cut sub gdImageFilledEllipse { my $self = shift; return _gdImageFilledEllipse ( $self->{IMG_PTR}, @_ ); } # End of gdImageFilledEllipse()... #line 1609 "GD.pd" =head2 FillToBorder $image->FillToBorder( $x, $y, $border, $color ) Alias for gdImageFillToBorder. =cut sub FillToBorder { return gdImageFillToBorder ( @_ ); } # End of FillToBorder()... =head2 gdImageFillToBorder $image->gdImageFillToBorder( $x, $y, $border, $color ) =cut sub gdImageFillToBorder { my $self = shift; return _gdImageFillToBorder ( $self->{IMG_PTR}, @_ ); } # End of gdImageFillToBorder()... #line 1609 "GD.pd" =head2 Fill $image->Fill( $x, $y, $color ) Alias for gdImageFill. =cut sub Fill { return gdImageFill ( @_ ); } # End of Fill()... =head2 gdImageFill $image->gdImageFill( $x, $y, $color ) =cut sub gdImageFill { my $self = shift; return _gdImageFill ( $self->{IMG_PTR}, @_ ); } # End of gdImageFill()... #line 1609 "GD.pd" =head2 CopyRotated $image->CopyRotated( $dstX, $dstY, $srcX, $srcY, $srcWidth, $srcHeight, $angle ) Alias for gdImageCopyRotated. =cut sub CopyRotated { return gdImageCopyRotated ( @_ ); } # End of CopyRotated()... =head2 gdImageCopyRotated $image->gdImageCopyRotated( $dstX, $dstY, $srcX, $srcY, $srcWidth, $srcHeight, $angle ) =cut sub gdImageCopyRotated { my $self = shift; return _gdImageCopyRotated ( $self->{IMG_PTR}, @_ ); } # End of gdImageCopyRotated()... #line 1609 "GD.pd" =head2 SetBrush $image->SetBrush( ) Alias for gdImageSetBrush. =cut sub SetBrush { return gdImageSetBrush ( @_ ); } # End of SetBrush()... =head2 gdImageSetBrush $image->gdImageSetBrush( ) =cut sub gdImageSetBrush { my $self = shift; return _gdImageSetBrush ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetBrush()... #line 1609 "GD.pd" =head2 SetTile $image->SetTile( ) Alias for gdImageSetTile. =cut sub SetTile { return gdImageSetTile ( @_ ); } # End of SetTile()... =head2 gdImageSetTile $image->gdImageSetTile( ) =cut sub gdImageSetTile { my $self = shift; return _gdImageSetTile ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetTile()... #line 1609 "GD.pd" =head2 SetAntiAliased $image->SetAntiAliased( $c ) Alias for gdImageSetAntiAliased. =cut sub SetAntiAliased { return gdImageSetAntiAliased ( @_ ); } # End of SetAntiAliased()... =head2 gdImageSetAntiAliased $image->gdImageSetAntiAliased( $c ) =cut sub gdImageSetAntiAliased { my $self = shift; return _gdImageSetAntiAliased ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetAntiAliased()... #line 1609 "GD.pd" =head2 SetAntiAliasedDontBlend $image->SetAntiAliasedDontBlend( $c, $dont_blend ) Alias for gdImageSetAntiAliasedDontBlend. =cut sub SetAntiAliasedDontBlend { return gdImageSetAntiAliasedDontBlend ( @_ ); } # End of SetAntiAliasedDontBlend()... =head2 gdImageSetAntiAliasedDontBlend $image->gdImageSetAntiAliasedDontBlend( $c, $dont_blend ) =cut sub gdImageSetAntiAliasedDontBlend { my $self = shift; return _gdImageSetAntiAliasedDontBlend ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetAntiAliasedDontBlend()... #line 1609 "GD.pd" =head2 SetStyle $image->SetStyle( $style, $noOfPixels ) Alias for gdImageSetStyle. =cut sub SetStyle { return gdImageSetStyle ( @_ ); } # End of SetStyle()... =head2 gdImageSetStyle $image->gdImageSetStyle( $style, $noOfPixels ) =cut sub gdImageSetStyle { my $self = shift; return _gdImageSetStyle ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetStyle()... #line 1609 "GD.pd" =head2 SetThickness $image->SetThickness( $thickness ) Alias for gdImageSetThickness. =cut sub SetThickness { return gdImageSetThickness ( @_ ); } # End of SetThickness()... =head2 gdImageSetThickness $image->gdImageSetThickness( $thickness ) =cut sub gdImageSetThickness { my $self = shift; return _gdImageSetThickness ( $self->{IMG_PTR}, @_ ); } # End of gdImageSetThickness()... #line 1609 "GD.pd" =head2 Interlace $image->Interlace( $interlaceArg ) Alias for gdImageInterlace. =cut sub Interlace { return gdImageInterlace ( @_ ); } # End of Interlace()... =head2 gdImageInterlace $image->gdImageInterlace( $interlaceArg ) =cut sub gdImageInterlace { my $self = shift; return _gdImageInterlace ( $self->{IMG_PTR}, @_ ); } # End of gdImageInterlace()... #line 1609 "GD.pd" =head2 AlphaBlending $image->AlphaBlending( $alphaBlendingArg ) Alias for gdImageAlphaBlending. =cut sub AlphaBlending { return gdImageAlphaBlending ( @_ ); } # End of AlphaBlending()... =head2 gdImageAlphaBlending $image->gdImageAlphaBlending( $alphaBlendingArg ) =cut sub gdImageAlphaBlending { my $self = shift; return _gdImageAlphaBlending ( $self->{IMG_PTR}, @_ ); } # End of gdImageAlphaBlending()... #line 1609 "GD.pd" =head2 SaveAlpha $image->SaveAlpha( $saveAlphaArg ) Alias for gdImageSaveAlpha. =cut sub SaveAlpha { return gdImageSaveAlpha ( @_ ); } # End of SaveAlpha()... =head2 gdImageSaveAlpha $image->gdImageSaveAlpha( $saveAlphaArg ) =cut sub gdImageSaveAlpha { my $self = shift; return _gdImageSaveAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageSaveAlpha()... #line 1609 "GD.pd" =head2 TrueColor $image->TrueColor( ) Alias for gdImageTrueColor. =cut sub TrueColor { return gdImageTrueColor ( @_ ); } # End of TrueColor()... =head2 gdImageTrueColor $image->gdImageTrueColor( ) =cut sub gdImageTrueColor { my $self = shift; return _gdImageTrueColor ( $self->{IMG_PTR}, @_ ); } # End of gdImageTrueColor()... #line 1609 "GD.pd" =head2 ColorsTotal $image->ColorsTotal( ) Alias for gdImageColorsTotal. =cut sub ColorsTotal { return gdImageColorsTotal ( @_ ); } # End of ColorsTotal()... =head2 gdImageColorsTotal $image->gdImageColorsTotal( ) =cut sub gdImageColorsTotal { my $self = shift; return _gdImageColorsTotal ( $self->{IMG_PTR}, @_ ); } # End of gdImageColorsTotal()... #line 1609 "GD.pd" =head2 Red $image->Red( $c ) Alias for gdImageRed. =cut sub Red { return gdImageRed ( @_ ); } # End of Red()... =head2 gdImageRed $image->gdImageRed( $c ) =cut sub gdImageRed { my $self = shift; return _gdImageRed ( $self->{IMG_PTR}, @_ ); } # End of gdImageRed()... #line 1609 "GD.pd" =head2 Green $image->Green( $c ) Alias for gdImageGreen. =cut sub Green { return gdImageGreen ( @_ ); } # End of Green()... =head2 gdImageGreen $image->gdImageGreen( $c ) =cut sub gdImageGreen { my $self = shift; return _gdImageGreen ( $self->{IMG_PTR}, @_ ); } # End of gdImageGreen()... #line 1609 "GD.pd" =head2 Blue $image->Blue( $c ) Alias for gdImageBlue. =cut sub Blue { return gdImageBlue ( @_ ); } # End of Blue()... =head2 gdImageBlue $image->gdImageBlue( $c ) =cut sub gdImageBlue { my $self = shift; return _gdImageBlue ( $self->{IMG_PTR}, @_ ); } # End of gdImageBlue()... #line 1609 "GD.pd" =head2 Alpha $image->Alpha( $c ) Alias for gdImageAlpha. =cut sub Alpha { return gdImageAlpha ( @_ ); } # End of Alpha()... =head2 gdImageAlpha $image->gdImageAlpha( $c ) =cut sub gdImageAlpha { my $self = shift; return _gdImageAlpha ( $self->{IMG_PTR}, @_ ); } # End of gdImageAlpha()... #line 1609 "GD.pd" =head2 GetTransparent $image->GetTransparent( ) Alias for gdImageGetTransparent. =cut sub GetTransparent { return gdImageGetTransparent ( @_ ); } # End of GetTransparent()... =head2 gdImageGetTransparent $image->gdImageGetTransparent( ) =cut sub gdImageGetTransparent { my $self = shift; return _gdImageGetTransparent ( $self->{IMG_PTR}, @_ ); } # End of gdImageGetTransparent()... #line 1609 "GD.pd" =head2 GetInterlaced $image->GetInterlaced( ) Alias for gdImageGetInterlaced. =cut sub GetInterlaced { return gdImageGetInterlaced ( @_ ); } # End of GetInterlaced()... =head2 gdImageGetInterlaced $image->gdImageGetInterlaced( ) =cut sub gdImageGetInterlaced { my $self = shift; return _gdImageGetInterlaced ( $self->{IMG_PTR}, @_ ); } # End of gdImageGetInterlaced()... #line 1609 "GD.pd" =head2 SX $image->SX( ) Alias for gdImageSX. =cut sub SX { return gdImageSX ( @_ ); } # End of SX()... =head2 gdImageSX $image->gdImageSX( ) =cut sub gdImageSX { my $self = shift; return _gdImageSX ( $self->{IMG_PTR}, @_ ); } # End of gdImageSX()... #line 1609 "GD.pd" =head2 SY $image->SY( ) Alias for gdImageSY. =cut sub SY { return gdImageSY ( @_ ); } # End of SY()... =head2 gdImageSY $image->gdImageSY( ) =cut sub gdImageSY { my $self = shift; return _gdImageSY ( $self->{IMG_PTR}, @_ ); } # End of gdImageSY()... #line 1711 "GD.pd" =head2 ColorAllocates $image->ColorAllocates( $r(pdl), $g(pdl), $b(pdl) ) Alias for gdImageColorAllocates. =cut sub ColorAllocates { return gdImageColorAllocates ( @_ ); } # End of ColorAllocates()... =head2 gdImageColorAllocates $image->gdImageColorAllocates( $r(pdl), $g(pdl), $b(pdl) ) =cut sub gdImageColorAllocates { my $self = shift; return _gdImageColorAllocates ( @_, $self->{IMG_PTR} ); } # End of gdImageColorAllocates()... #line 1711 "GD.pd" =head2 ColorAllocateAlphas $image->ColorAllocateAlphas( $r(pdl), $g(pdl), $b(pdl), $a(pdl) ) Alias for gdImageColorAllocateAlphas. =cut sub ColorAllocateAlphas { return gdImageColorAllocateAlphas ( @_ ); } # End of ColorAllocateAlphas()... =head2 gdImageColorAllocateAlphas $image->gdImageColorAllocateAlphas( $r(pdl), $g(pdl), $b(pdl), $a(pdl) ) =cut sub gdImageColorAllocateAlphas { my $self = shift; return _gdImageColorAllocateAlphas ( @_, $self->{IMG_PTR} ); } # End of gdImageColorAllocateAlphas()... #line 1711 "GD.pd" =head2 SetPixels $image->SetPixels( $x(pdl), $y(pdl), $color(pdl) ) Alias for gdImageSetPixels. =cut sub SetPixels { return gdImageSetPixels ( @_ ); } # End of SetPixels()... =head2 gdImageSetPixels $image->gdImageSetPixels( $x(pdl), $y(pdl), $color(pdl) ) =cut sub gdImageSetPixels { my $self = shift; return _gdImageSetPixels ( @_, $self->{IMG_PTR} ); } # End of gdImageSetPixels()... #line 1711 "GD.pd" =head2 Lines $image->Lines( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) Alias for gdImageLines. =cut sub Lines { return gdImageLines ( @_ ); } # End of Lines()... =head2 gdImageLines $image->gdImageLines( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) =cut sub gdImageLines { my $self = shift; return _gdImageLines ( @_, $self->{IMG_PTR} ); } # End of gdImageLines()... #line 1711 "GD.pd" =head2 DashedLines $image->DashedLines( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) Alias for gdImageDashedLines. =cut sub DashedLines { return gdImageDashedLines ( @_ ); } # End of DashedLines()... =head2 gdImageDashedLines $image->gdImageDashedLines( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) =cut sub gdImageDashedLines { my $self = shift; return _gdImageDashedLines ( @_, $self->{IMG_PTR} ); } # End of gdImageDashedLines()... #line 1711 "GD.pd" =head2 Rectangles $image->Rectangles( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) Alias for gdImageRectangles. =cut sub Rectangles { return gdImageRectangles ( @_ ); } # End of Rectangles()... =head2 gdImageRectangles $image->gdImageRectangles( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) =cut sub gdImageRectangles { my $self = shift; return _gdImageRectangles ( @_, $self->{IMG_PTR} ); } # End of gdImageRectangles()... #line 1711 "GD.pd" =head2 FilledRectangles $image->FilledRectangles( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) Alias for gdImageFilledRectangles. =cut sub FilledRectangles { return gdImageFilledRectangles ( @_ ); } # End of FilledRectangles()... =head2 gdImageFilledRectangles $image->gdImageFilledRectangles( $x1(pdl), $y1(pdl), $x2(pdl), $y2(pdl), $color(pdl) ) =cut sub gdImageFilledRectangles { my $self = shift; return _gdImageFilledRectangles ( @_, $self->{IMG_PTR} ); } # End of gdImageFilledRectangles()... #line 1711 "GD.pd" =head2 FilledArcs $image->FilledArcs( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $s(pdl), $e(pdl), $color(pdl), $style(pdl) ) Alias for gdImageFilledArcs. =cut sub FilledArcs { return gdImageFilledArcs ( @_ ); } # End of FilledArcs()... =head2 gdImageFilledArcs $image->gdImageFilledArcs( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $s(pdl), $e(pdl), $color(pdl), $style(pdl) ) =cut sub gdImageFilledArcs { my $self = shift; return _gdImageFilledArcs ( @_, $self->{IMG_PTR} ); } # End of gdImageFilledArcs()... #line 1711 "GD.pd" =head2 Arcs $image->Arcs( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $s(pdl), $e(pdl), $color(pdl) ) Alias for gdImageArcs. =cut sub Arcs { return gdImageArcs ( @_ ); } # End of Arcs()... =head2 gdImageArcs $image->gdImageArcs( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $s(pdl), $e(pdl), $color(pdl) ) =cut sub gdImageArcs { my $self = shift; return _gdImageArcs ( @_, $self->{IMG_PTR} ); } # End of gdImageArcs()... #line 1711 "GD.pd" =head2 FilledEllipses $image->FilledEllipses( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $color(pdl) ) Alias for gdImageFilledEllipses. =cut sub FilledEllipses { return gdImageFilledEllipses ( @_ ); } # End of FilledEllipses()... =head2 gdImageFilledEllipses $image->gdImageFilledEllipses( $cx(pdl), $cy(pdl), $w(pdl), $h(pdl), $color(pdl) ) =cut sub gdImageFilledEllipses { my $self = shift; return _gdImageFilledEllipses ( @_, $self->{IMG_PTR} ); } # End of gdImageFilledEllipses()... #line 1723 "GD.pd" =head1 CLASS FUNCTIONS =cut #line 1793 "GD.pd" =head2 gdImageCopy gdImageCopy ( $dst(PDL::IO::GD), $src(PDL::IO::GD), $dstX, $dstY, $srcX, $srcY, $w, $h ) =cut sub gdImageCopy { my $dst = shift; my $src = shift; my $dstX = shift; my $dstY = shift; my $srcX = shift; my $srcY = shift; my $w = shift; my $h = shift; return _gdImageCopy ( $dst->{IMG_PTR}, $src->{IMG_PTR}, $dstX, $dstY, $srcX, $srcY, $w, $h ); } # End of gdImageCopy()... #line 1793 "GD.pd" =head2 gdImageCopyMerge gdImageCopyMerge ( $dst(PDL::IO::GD), $src(PDL::IO::GD), $dstX, $dstY, $srcX, $srcY, $w, $h, $pct ) =cut sub gdImageCopyMerge { my $dst = shift; my $src = shift; my $dstX = shift; my $dstY = shift; my $srcX = shift; my $srcY = shift; my $w = shift; my $h = shift; my $pct = shift; return _gdImageCopyMerge ( $dst->{IMG_PTR}, $src->{IMG_PTR}, $dstX, $dstY, $srcX, $srcY, $w, $h, $pct ); } # End of gdImageCopyMerge()... #line 1793 "GD.pd" =head2 gdImageCopyMergeGray gdImageCopyMergeGray ( $dst(PDL::IO::GD), $src(PDL::IO::GD), $dstX, $dstY, $srcX, $srcY, $w, $h, $pct ) =cut sub gdImageCopyMergeGray { my $dst = shift; my $src = shift; my $dstX = shift; my $dstY = shift; my $srcX = shift; my $srcY = shift; my $w = shift; my $h = shift; my $pct = shift; return _gdImageCopyMergeGray ( $dst->{IMG_PTR}, $src->{IMG_PTR}, $dstX, $dstY, $srcX, $srcY, $w, $h, $pct ); } # End of gdImageCopyMergeGray()... #line 1793 "GD.pd" =head2 gdImageCopyResized gdImageCopyResized ( $dst(PDL::IO::GD), $src(PDL::IO::GD), $dstX, $dstY, $srcX, $srcY, $dstW, $dstH, $srcW, $srcH ) =cut sub gdImageCopyResized { my $dst = shift; my $src = shift; my $dstX = shift; my $dstY = shift; my $srcX = shift; my $srcY = shift; my $dstW = shift; my $dstH = shift; my $srcW = shift; my $srcH = shift; return _gdImageCopyResized ( $dst->{IMG_PTR}, $src->{IMG_PTR}, $dstX, $dstY, $srcX, $srcY, $dstW, $dstH, $srcW, $srcH ); } # End of gdImageCopyResized()... #line 1793 "GD.pd" =head2 gdImageCopyResampled gdImageCopyResampled ( $dst(PDL::IO::GD), $src(PDL::IO::GD), $dstX, $dstY, $srcX, $srcY, $dstW, $dstH, $srcW, $srcH ) =cut sub gdImageCopyResampled { my $dst = shift; my $src = shift; my $dstX = shift; my $dstY = shift; my $srcX = shift; my $srcY = shift; my $dstW = shift; my $dstH = shift; my $srcW = shift; my $srcH = shift; return _gdImageCopyResampled ( $dst->{IMG_PTR}, $src->{IMG_PTR}, $dstX, $dstY, $srcX, $srcY, $dstW, $dstH, $srcW, $srcH ); } # End of gdImageCopyResampled()... #line 1793 "GD.pd" =head2 gdImageCompare gdImageCompare ( $im1(PDL::IO::GD), $im2(PDL::IO::GD) ) =cut sub gdImageCompare { my $im1 = shift; my $im2 = shift; return _gdImageCompare ( $im1->{IMG_PTR}, $im2->{IMG_PTR} ); } # End of gdImageCompare()... #line 1793 "GD.pd" =head2 gdImagePaletteCopy gdImagePaletteCopy ( $dst(PDL::IO::GD), $src(PDL::IO::GD) ) =cut sub gdImagePaletteCopy { my $dst = shift; my $src = shift; return _gdImagePaletteCopy ( $dst->{IMG_PTR}, $src->{IMG_PTR} ); } # End of gdImagePaletteCopy()... #line 1118 "GD.pd" =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()... #line 1171 "GD.pd" =head2 StringFT $image->StringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string ) Alias for gdImageStringFT. =cut sub StringFT { return gdImageStringFT ( @_ ); } # End of StringFT()... =head2 gdImageStringFT $image->gdImageStringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string ) =cut sub gdImageStringFT { my $self = shift; return _gdImageStringFT ( $self->{IMG_PTR}, @_ ); } # End of gdImageStringFT()... #line 1203 "GD.pd" =head1 AUTHOR Judd Taylor, Orbital Systems, Ltd. judd dot t at orbitalsystems dot com =cut #line 3033 "GD.pm" # Exit with OK status 1; PDL-IO-GD-2.103/GD.pd0000644000175000017500000016161414736673345013533 0ustar osboxesosboxes# # GD.pd # # PDL interface to the GD c library # ('cos looping over an ndarray in perl and using the perl GD lib is too slow...) # # Judd Taylor, USF IMaRS # 13 March 2003 # use strict; use warnings; #use PDL; use vars qw( $VERSION ); $VERSION = "2.103"; ##################################### # Start the General Interface Docs: # ##################################### pp_addpm({ At => 'Top' }, <<'ENDPM'); use strict; use warnings; =head1 NAME PDL::IO::GD - Interface to the GD image library. =head1 SYNOPSIS my $pdl = sequence(byte, 30, 30); write_png($pdl, load_lut($lutfile), "test.png"); write_true_png(sequence(100, 100, 3), "test_true.png"); my $image = read_png("test.png"); 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 #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', Doc => <<'ENDDOC', Same as write_png(), except you can specify the compression level (0-9) as the last argument. ENDDOC %lu_dim_level_check, Code => $gdi_from_dims . $lut_allocate . $img_to_gdi . $gdi_to_fileEx, ); # Function to write a TRUE COLOR PNG image from an ndarray variable: pp_def( 'write_true_png', Pars => 'img(x,y,z=3);', GenericTypes => ['B'], OtherPars => 'char* filename', Doc => <<'ENDDOC', Writes an (x, y, z(3)) PDL variable out to a PNG file, using a true color format. This means a larger file on disk, but can contain more than 256 colors. ENDDOC Code => $gdiTrue_from_dims . $img_to_gdiTrue . $gdi_to_file, ); # Function to write a TRUE COLOR PNG image from an ndarray variable, # with the specified compression level: pp_def( 'write_true_png_ex', Pars => 'img(x,y,z=3);', GenericTypes => ['B'], OtherPars => 'char* filename; int level', Doc => <<'ENDDOC', Same as write_true_png(), except you can specify the compression level (0-9) as the last argument. ENDDOC %level_check, Code => $gdiTrue_from_dims . $img_to_gdiTrue . $gdi_to_fileEx, ); # # Add some perl level alias functions to automatically use the best compression # pp_addpm(<<'ENDPM'); =head2 write_png_best 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, ); pp_def( '_gd_image_to_rpic', Pars => '[o] img(x=CALC(gdImageSX($COMP(im))),y=CALC(gdImageSY($COMP(im))));', GenericTypes => ['L'], %gdi_from_args, Doc => undef, Code => $gdi_to_img_inv, ); pp_def( '_pdl_to_gd_image_true', Pars => 'img(x,y,z=3); indx [o] img_ptr()', GenericTypes => ['B'], Doc => undef, Code => $gdiTrue_from_dims . $img_to_gdiTrue . $gdi_to_ptr, ); pp_def( '_pdl_to_gd_image_lut', Pars => 'img(x,y); lut(i=3,j); indx [o] img_ptr()', GenericTypes => ['B'], Doc => undef, %lu_dim_check, Code => $gdi_from_dims . $lut_allocate . $img_to_gdi . $gdi_to_ptr, ); pp_def( 'read_png_lut', Pars => '[o] lut(c=3,i=256);', GenericTypes => ['B'], %gdi_from_pngfile, Doc => "=for ref\n\nReads a color LUT from an already-existing palette PNG file.\n", Code => <<'EOC', loop(i) %{ $lut(c=>0) = gdImageRed($COMP(im), i); $lut(c=>1) = gdImageGreen($COMP(im), i); $lut(c=>2) = gdImageBlue($COMP(im), i); %} EOC ); pp_def( 'write_gif_anim', Pars => 'img(c=3,x,y,n)', GenericTypes => ['B'], OtherPars => 'char* filename; int Loops; int Delay', OtherParsDefaults => {Loops=>0, Delay=>4}, NoPthread => 1, Doc => <<'EOF', =for ref Writes an image cube to a file as an animated GIF. RGB dimension is first. y=0 is at bottom. 0 loops = infinite (default). Delay in 100ths of a second, default 4. EOF Code => <<'EOF', FILE *fh = fopen($COMP(filename), "wb"); if (!fh) $CROAK("Error opening %s\n", $COMP(filename)); gdImagePtr im = gdImageCreateTrueColor($SIZE(x), $SIZE(y)), im_prev = NULL; if (!im) $CROAK("Error creating gdImage\n"); loop (n=0:1) %{ loop (y,x) %{ gdImageSetPixel(im, x, $SIZE(y)-1-y, gdImageColorResolve(im, $img(c=>0), $img(c=>1), $img(c=>2)) ); %} %} gdImageGifAnimBegin(im, fh, 0, $COMP(Loops)); gdImageGifAnimAdd(im, fh, 1, 0, 0, $COMP(Delay), gdDisposalNone, im_prev); im_prev = im; loop (n=1) %{ im = gdImageCreateTrueColor($SIZE(x), $SIZE(y)); if (!im) $CROAK("Error creating gdImage\n"); loop (y,x) %{ gdImageSetPixel(im, x, $SIZE(y)-1-y, gdImageColorResolve(im, $img(c=>0), $img(c=>1), $img(c=>2)) ); %} gdImageGifAnimAdd(im, fh, 1, 0, 0, $COMP(Delay), gdDisposalNone, im_prev); gdImageDestroy(im_prev); im_prev = im; %} gdImageDestroy(im_prev); gdImageGifAnimEnd(fh); fclose(fh); EOF ); pp_addxs( <<'ENDXS' ); void _gdImageDestroy( im ) gdImagePtr im CODE: /* fprintf( stderr, "_gdImageDestroy(): gdImagePtr = %p (d=%d x=%x l=%ld ll=%lld)\n", im, im, im, im, im);*/ gdImageDestroy ( im ); OUTPUT: ENDXS #################### # 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 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 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 }); my $gd = PDL::IO::GD->new({ filename => "image.png" }); my $gd = PDL::IO::GD->new({ x => 100, y => 100 }); my $gd = PDL::IO::GD->new({ x => 100, y => 100, true_color => 1 }); my $gd = PDL::IO::GD->new({ data => $imageData }); my $gd = PDL::IO::GD->new({ data => $imageData, type => 'wbmp' }); =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; #my $self = $class->SUPER::new( @_ ); my $self = {}; my $sub = _pkg_name( "new" ); # Figure out our options: # I want a single hash. I handle several cases here my $options; if( @_ == 1 && ref $_[0] eq 'HASH' ) { # single hash argument. Just take it $options = shift; } elsif( @_ == 1 && ! ref $_[0] ) { # single scalar argument. Treat it as a filename by default my $filename = shift; $options = { filename => $filename }; } else { # the only other acceptable option is an inline hash. This is valid if I # have an even number of arguments, and the even-indexed ones (the keys) # are scalars if( @_ % 2 == 0 ) { my @pairs = @_; my $Npairs = scalar(@pairs)/2; use List::Util 'none'; if( none { ref $pairs[2*$_] } 0..$Npairs-1 ) { # treat the arguments as a hash $options = { @pairs } } } } if( !defined $options ) { die <{pdl} ) ) { # Create it from a PDL variable: my $pdl = $options->{pdl}; $pdl->make_physical(); my $num_dims = scalar( $pdl->dims() ); if( $num_dims == 2 ) { if( defined( $options->{lut} ) ) { die "$sub: _pdl_to_gd_image_lut() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_lut( $pdl, $options->{lut} )->sclr; } else { my $lut = sequence(byte, 256)->slice("*3,:"); die "$sub: _pdl_to_gd_image_lut() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_lut( $pdl, $lut )->sclr; } } elsif( $num_dims == 3 ) { die "$sub: _pdl_to_gd_image_true() failed\n" unless $self->{IMG_PTR} = _pdl_to_gd_image_true( $pdl )->sclr; } else { die "Can't create a PDL::IO::GD from a PDL with bad dims\n"; } } elsif( exists( $options->{filename} ) ) { # Create it from a file: if( !defined $options->{filename} ) { die "PDL::IO::GD::new got an undefined filename. Giving up.\n"; } # Figure out what type of file it is: $self->{input_type} = _id_image_file( $options->{filename} ) or die "$sub: Can't determine image type of filename => \'$options->{filename}\'\n"; # Read in the file: $self->{IMG_PTR} = _img_ptr_from_file( $options->{filename}, $self->{input_type} ) or die "$sub: Can't read in the input file\n"; } elsif( defined( $options->{x} ) && defined( $options->{y} ) ) { # Create an empty image: my $done = 0; if( $options->{true_color} ) { # Create an empty true color image: die "$sub: _gdImageCreateTrueColor() failed\n" unless $self->{IMG_PTR} = _gdImageCreateTrueColor( $options->{x}, $options->{y} ); $done = 1; } unless( $done ) { # Create an empty palette image: die "$sub: _gdImageCreatePalette() failed\n" unless $self->{IMG_PTR} = _gdImageCreatePalette( $options->{x}, $options->{y} ); } } elsif( defined( $options->{data} ) ) { # Create an image from the given image data: # Figure out what type of file it is: if( defined( $options->{type} ) && ( $options->{type} eq 'jpg' || $options->{type} eq 'png' || $options->{type} eq 'gif' || $options->{type} eq 'wbmp' || $options->{type} eq 'gd' || $options->{type} eq 'gd2' ) ) { $self->{input_type} = $options->{type}; } else { $self->{input_type} = _id_image_data( $options->{data} ) or die "$sub: Can't determine image type given data\n"; } # Load the data: $self->{IMG_PTR} = _img_ptr_from_data( $options->{data}, $self->{input_type} ) or die "$sub: Can't load the input image data\n"; } # Bless and return: # bless ($self, $class); return $self; } # End of new()... =head2 to_pdl 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 highest (x,y,3). To get it in the lowest dim (and with y=0 is the bottom), use L. =cut sub to_pdl { my $self = shift; $self->gdImageTrueColor() ? _gd_image_to_pdl_true( $self->{IMG_PTR} ) : _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. =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 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);= pp_addxs(<<"ENDXS"); char* _gdImageStringFT( 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 = gdImageStringFT ( im, c_brect, fg, fontlist, ptsize, angle, x, y, string ); brect = c_brect; OUTPUT: RETVAL brect ENDXS pp_addpm({At => 'Bot'}, <<'ENDPM' ); =head2 StringFT $image->StringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string ) Alias for gdImageStringFT. =cut sub StringFT { return gdImageStringFT ( @_ ); } # End of StringFT()... =head2 gdImageStringFT $image->gdImageStringFT( $brect, $fg, $fontlist, $ptsize, $angle, $x, $y, $string ) =cut sub gdImageStringFT { my $self = shift; return _gdImageStringFT ( $self->{IMG_PTR}, @_ ); } # End of gdImageStringFT()... ENDPM # Add the final docs: # pp_addpm({At => 'Bot'}, <<'ENDPM'); =head1 AUTHOR 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 $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 $format = $function_name; $format =~ s/gdImage//; $format =~ s/Ptr//; my $name = "get_$format" . "_data"; $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' ); next if ( $info->{ARGS}->{$num}->{NAME} eq 'size' ); 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 ); } # foreach func... } # End of generate_data_ptr_functions()... # # Here, we also need to add PM code for the OO side: # sub generate_member_functions { my @funcs = split( /\n/, shift ); my $sub = "generate_member_functions()"; foreach my $func ( @funcs ) { #print "$sub: Generating member function for $func...\n"; my $info = parse_prototype( $func ) or die "$sub: Couldn't parse prototype\n"; # Add the XS portion of the code: my @macro_list = qw( gdImageSX gdImageSY gdImageTrueColor ); if( scalar( grep( /$info->{NAME}/, @macro_list ) ) ) { # Special functions that are actually definitions: add_basic_def_xs( $info, '_' ); } else { # Normal function add_basic_xs( $info, '_' ); } # Add the OO code: # Use template method here to avoid escaping everything: my $pmcode = <<'ENDPM'; INSERT_SHORT_CODE_HERE =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 $short_code_template = <<'ENDSHORTCODE'; =head2 INSERT_SHORT_NAME_HERE $image->INSERT_SHORT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE ) Alias for INSERT_NAME_HERE. =cut sub INSERT_SHORT_NAME_HERE { return INSERT_NAME_HERE ( @_ ); } # End of INSERT_SHORT_NAME_HERE()... ENDSHORTCODE my $name = $info->{NAME}; my $short_name = $name; $short_name =~ s/gdImage//; my $short_code = ''; if( $short_name ne $name ) { $short_code = $short_code_template; $short_code =~ s/INSERT_SHORT_NAME_HERE/$short_name/sg; } $pmcode =~ s/INSERT_SHORT_CODE_HERE/$short_code/sg; $pmcode =~ s/INSERT_NAME_HERE/$name/sg; $pmcode =~ s/INSERT_XS_FUNC_HERE/_$name/sg; my @arg_names; my @doc_args; foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } ) { next if ( $info->{ARGS}->{$num}->{TYPE} eq 'gdImagePtr' ); push(@arg_names, $info->{ARGS}->{$num}->{NAME}); push( @doc_args, "\$" . $info->{ARGS}->{$num}->{NAME} ); } my $arg_list = join( ", ", @arg_names ); $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list/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_member_functions()... # # Add some member functions that can function on ndarrays: # sub generate_pp_def_members { my @funcs = split( /\n/, shift ); my $sub = "generate_pp_def_members()"; foreach my $func ( @funcs ) { #print "$sub: Generating member function for $func...\n"; my $info = parse_prototype( $func ) or die "$sub: Couldn't parse prototype\n"; my $orig_name = $info->{NAME}; my $name = $orig_name . "s"; my $short_name = $name; $short_name =~ s/gdImage//; my $pdlpp_name = "_$name"; my @arg_names; my @doc_args; my $pdlpp_arg_list = ""; foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } ) { my $type = $info->{ARGS}->{$num}->{TYPE}; my $arg_name = $info->{ARGS}->{$num}->{NAME}; next if ( $type eq 'gdImagePtr' ); push(@arg_names, $arg_name ); push( @doc_args, "\$" . $arg_name . "(pdl)" ); $pdlpp_arg_list .= "$type $arg_name(); "; } my $arg_list = join( ", ", @arg_names ); my $doc_arg_list = join( ", ", @doc_args ); my $pdlpp_call_arg_list = "\$" . join( "(), \$", @arg_names ) . "()"; # Add the PDL::PP code: # pp_def( $pdlpp_name, Pars => $pdlpp_arg_list, GenericTypes => ['B'], OtherPars => 'gdImagePtr img_ptr', Doc => undef, Code => "$orig_name( \$COMP(img_ptr), $pdlpp_call_arg_list );" ); # Add the OO code: # Use template method here to avoid escaping everything: my $pmcode = <<'ENDPM'; INSERT_SHORT_CODE_HERE =head2 INSERT_NAME_HERE $image->INSERT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE ) =cut sub INSERT_NAME_HERE { my $self = shift; return INSERT_PP_FUNC_HERE ( @_, $self->{IMG_PTR} ); } # End of INSERT_NAME_HERE()... ENDPM my $short_code_template = <<'ENDSHORTCODE'; =head2 INSERT_SHORT_NAME_HERE $image->INSERT_SHORT_NAME_HERE( INSERT_DOC_ARG_LIST_HERE ) Alias for INSERT_NAME_HERE. =cut sub INSERT_SHORT_NAME_HERE { return INSERT_NAME_HERE ( @_ ); } # End of INSERT_SHORT_NAME_HERE()... ENDSHORTCODE my $short_code = ''; if( $short_name ne $name ) { $short_code = $short_code_template; $short_code =~ s/INSERT_SHORT_NAME_HERE/$short_name/sg; } $pmcode =~ s/INSERT_SHORT_CODE_HERE/$short_code/sg; $pmcode =~ s/INSERT_NAME_HERE/$name/sg; $pmcode =~ s/INSERT_PP_FUNC_HERE/$pdlpp_name/sg; $pmcode =~ s/INSERT_ARG_LIST_HERE/$arg_list/sg; $pmcode =~ s/INSERT_DOC_ARG_LIST_HERE/$doc_arg_list/sg; pp_addpm( { At => 'Bot' }, $pmcode ); } } # End of generate_pp_def_members... # # Functions not specific to one object, but that need to take objects as arguments: # sub generate_class_functions { my @funcs = split( /\n/, shift ); my $sub = "generate_class_functions()"; pp_addpm( {At => 'Bot'}, <<'ENDPM' ); =head1 CLASS FUNCTIONS =cut ENDPM foreach my $func ( @funcs ) { #print "$sub: Generating class function for $func...\n"; my $info = parse_prototype( $func ) or die "$sub: Couldn't parse prototype\n"; # Add the XS portion of the code: add_basic_xs( $info, '_' ); # Add the Class functions code: # Figure out the perl arg list where it needs PDL::IO::GDImage objects: # my @perl_arg_names; my @arg_names; my @doc_args; my $arg_shift_string = ""; foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } ) { my $type = $info->{ARGS}->{$num}->{TYPE}; my $name = $info->{ARGS}->{$num}->{NAME}; push(@arg_names, $name); $arg_shift_string .= " my \$$name = shift;\n"; if ( $type eq 'gdImagePtr' ) { push(@perl_arg_names, "\$" . $name . "->{IMG_PTR}" ); push(@doc_args, "\$" . $name . "(PDL::IO::GD)" ); next; } push(@doc_args, "\$" . $name); push(@perl_arg_names, "\$" . $name); } # Use template method here to avoid escaping everything: my $pmcode = <<'ENDPM'; =head2 INSERT_NAME_HERE INSERT_NAME_HERE ( INSERT_DOC_ARG_LIST_HERE ) =cut sub INSERT_NAME_HERE { INSERT_ARG_SHIFT_HERE return INSERT_XS_FUNC_HERE ( INSERT_PERL_ARG_LIST_HERE ); } # End of INSERT_NAME_HERE()... ENDPM my $function_name = $info->{NAME}; $pmcode =~ s/INSERT_NAME_HERE/$function_name/sg; $pmcode =~ s/INSERT_XS_FUNC_HERE/_$function_name/sg; $pmcode =~ s/INSERT_ARG_SHIFT_HERE/$arg_shift_string/sg; my $perl_arg_list = join(", ", @perl_arg_names); $pmcode =~ s/INSERT_PERL_ARG_LIST_HERE/$perl_arg_list/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_class_functions()... # # These functions are not specific to and object instance: # sub generate_general_functions { my @funcs = split( /\n/, shift ); my $sub = "generate_general_functions()"; foreach my $func ( @funcs ) { #print "$sub: Generating general function for $func...\n"; my $info = parse_prototype( $func ) or die "$sub: Couldn't parse prototype\n"; # Add the XS portion of the code: my @macro_list = qw( gdTrueColor gdTrueColorAlpha ); if( scalar( grep( /$info->{NAME}/, @macro_list ) ) ) { # Special functions that are actually definitions: add_basic_def_xs( $info ); } else { # Normal function add_basic_xs( $info ); } pp_add_exported(" $info->{NAME} "); } } # End of generate_general_functions()... sub add_basic_xs { my $info = shift; my $prefix = shift || ''; my $return_type = $info->{RETURN_TYPE}; my $orig_name = $info->{NAME}; my $name = $prefix . $orig_name; my @arg_names; my @arg_call_names; my @out_arg_names; my $arg_decl_string = ""; foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } ) { my $name = $info->{ARGS}{$num}{NAME}; my $type = $info->{ARGS}{$num}{TYPE}; # Handle perl's handling of pointers: my $call_name = $name; if( $type =~ /((\S+\s*?)+)\s*\*/ && $type !~ /void/ && $type !~ /char/ ) { $type = $1; $call_name = "&$name"; push( @out_arg_names, $name ); } push(@arg_names, $name ); push(@arg_call_names, $call_name ); $arg_decl_string .= "\t\t$type\t\t$name\n"; } chomp( $arg_decl_string ); my $arg_string = join(", ", @arg_names ); my $arg_call_string = join(", ", @arg_call_names); my $retval_output = "\t\tRETVAL\n"; my $retval_input = "RETVAL ="; if( $return_type =~ /void/ ) { $retval_output = ''; $retval_input = ''; } my $arg_output_string = $retval_output . "\t\t" . join("\n\t\t", @out_arg_names); pp_addxs( <<"ENDXS" ); $return_type $name( $arg_string ) $arg_decl_string \tCODE: \t\t$retval_input $orig_name ( $arg_call_string ); \tOUTPUT: $arg_output_string ENDXS } # End of add_basic_xs()... sub add_basic_def_xs { my $info = shift; my $prefix = shift || ''; my $return_type = $info->{RETURN_TYPE}; my $orig_name = $info->{NAME}; my $name = $prefix . $orig_name; my @arg_names; my $arg_decl_string = ""; foreach my $num ( sort {$a <=> $b} keys %{ $info->{ARGS} } ) { my $name = $info->{ARGS}->{$num}->{NAME}; my $type = $info->{ARGS}->{$num}->{TYPE}; push(@arg_names, $name ); $arg_decl_string .= "\t\t$type\t\t$name\n"; } chomp( $arg_decl_string ); my $arg_string = join(", ", @arg_names ); pp_addxs( <<"ENDXS" ); $return_type $name( $arg_string ) $arg_decl_string \tCODE: \t\tRETVAL = $orig_name ( $arg_string ); \tOUTPUT: \t\tRETVAL ENDXS } # End of add_basic_def_xs()... sub parse_prototype { my $proto = shift; return undef unless( $proto =~ /(\w+\s*\*?)\s*(\w+)\s*\((.*)\)/ ); my $args = $3; my $hash = { RETURN_TYPE => $1, NAME => $2, }; # Figure out the args: my $arg_count = 1; foreach my $arg ( grep /\w/, split /,/, $args ) { my ($name) = ($arg =~ /(\w+)$/); $arg =~ s/$name$//; # arg now contains the full C type $arg =~ s/const //; # get rid of 'const' in C type $arg =~ s/^\s+//; $arg =~ s/\s+$//; # pare off the variable type from 'arg' $hash->{ARGS}->{$arg_count} = { NAME => $name, TYPE => $arg, }; $arg_count++; } #use Data::Dumper; #my $dd = Data::Dumper->new( [$hash], [ 'hash' ] ); #$dd->Indent(1); #print STDERR $dd->Dump(); return $hash; } # End of parse_prototype()... PDL-IO-GD-2.103/META.yml0000644000175000017500000000141114736677206014151 0ustar osboxesosboxes--- abstract: unknown author: - 'PerlDL Developers ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' PDL: '2.094' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.44, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PDL-IO-GD no_index: directory: - t - inc requires: PDL: '2.094' resources: IRC: irc://irc.perl.org/#pdl bugtracker: https://github.com/PDLPorters/PDL-IO-GD/issues homepage: http://pdl.perl.org/ repository: git://github.com/PDLPorters/PDL-IO-GD.git version: '2.103' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' PDL-IO-GD-2.103/Changes0000644000175000017500000000124314736675710014174 0ustar osboxesosboxes2.103 2025-01-06 - add licence information 2.102 2024-12-09 - add repo metadata 2.101 2024-12-03 - split out from PDL 2.095 2.0: 30 Mar 2006 (Judd Taylor) - Transferred to new name PDL::IO::GD, and modified for inclusion to the PDL CVS tree. 1.6: 12 Oct 2005 (Judd Taylor) - Added functions to set level of compression on PNG images (write_png_ex, write_true_png_ex, write_png_best, write_true_png_best) - Added function recompress_png_best, to open a PNG file, and write it out using the best PNG compression available. 1.3: 19 Feb 2004 (Judd Taylor) - Added support to write only chunks of PNG images. - Started changelog! PDL-IO-GD-2.103/MANIFEST0000644000175000017500000000055414736677207014041 0ustar osboxesosboxesChanges GD.pd Makefile.PL MANIFEST This list of files MANIFEST.SKIP t/gd_oo_tests.t t/gd_tests.t typemap META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) GENERATED/PDL/IO/GD.pm mod=PDL::IO::GD pd=GD.pd (added by pdlpp_mkgen) PDL-IO-GD-2.103/Makefile.PL0000644000175000017500000000653214736671632014660 0ustar osboxesosboxesuse strict; use warnings; use ExtUtils::MakeMaker; use Config; use Text::ParseWords qw(shellwords quotewords); use PDL::Core::Dev; my ($include_path, $lib_path, $linkname); my $ppfile = "GD.pd"; my $package_name = "PDL::IO::GD"; my $lib_name = "GD"; my @find_libs = ( "libgd.$Config{dlext}", 'libgd.a', 'libgd.dll.a', 'bgd.dll' ); my @find_incs = ( 'gd.h' ); my @lib_locations = grep defined, ( $ENV{GD_LIBS}, find_macos_path('lib'), '/usr/lib64', '/usr/local/lib64', '/lib64', '/usr/lib', '/usr/local/lib', '/lib', ($^O eq 'MSWin32' ? (split($Config{path_sep}, $ENV{PATH}), (map {s/^-L//;$_} grep /^-L/, map {s/"//g; $_} quotewords('\s+', 1, $Config{ldflags})) ) : shellwords($Config{libpth})), ); my @inc_locations = grep defined, ( $ENV{GD_INC}, find_macos_path('include'), '/usr/include', '/usr/local/include', $Config{usrinc}, (map {s/^-I//;$_} grep /^-I/, $^O eq 'MSWin32' ? (map {s/"//g; $_} quotewords('\s+', 1, $Config{cppflags})) : shellwords($Config{cppflags})), ); sub find_macos_path { return if $^O ne 'darwin'; my $pref = `brew --prefix gd`; return if !$pref; chomp $pref; qq{$pref/$_[0]}; } my $msg = ""; # Look for GD includes/libs # Look for the libs: foreach my $libdir ( @lib_locations ) { my $found = 0; foreach my $find_lib ( @find_libs ) { if ( -e "$libdir/$find_lib" ) { $lib_path = $libdir; $found = 1; # The lib name is different on windows, so we need to adjust the LIBS, below: $linkname = ( $find_lib =~ /bgd.dll$/ ) ? 'bgd' : 'gd'; } last if $found; } last if $found; } # foreach $libdir... unless( defined( $lib_path ) ) { $msg .= "Cannot find $lib_name library, (@find_libs).\n" . "Please add the correct library path to Makefile.PL or install $lib_name\n."; } # Look for the include files: foreach my $incdir ( @inc_locations ) { foreach my $find_inc ( @find_incs ) { if ( -e "$incdir/$find_inc" ) { $include_path = $incdir; last; } } } unless( defined( $include_path ) ) { $msg .= "Cannot find $lib_name header files, (@find_incs).\n" . "Please add the correct library path to Makefile.PL or install $lib_name.\n"; } die $msg if $msg; my $package = [$ppfile, $lib_name, $package_name]; my %hash = pdlpp_stdargs($package); $hash{VERSION_FROM} = $ppfile; $hash{DEFINE} = $ENV{GD_DEFINE}; $hash{LIBS} = [qq{-L"$lib_path" -l$linkname}]; $hash{INC} = PDL_INCLUDE() . qq{ -I"$include_path"}; $hash{CONFIGURE_REQUIRES} = { 'ExtUtils::MakeMaker' => 0, 'PDL' => '2.094', }; $hash{PREREQ_PM} = { 'PDL' => '2.094', }; $hash{TEST_REQUIRES} = { 'Test::More' => '0.88', }; $hash{AUTHOR} = 'PerlDL Developers '; $hash{LICENSE} = "perl"; sub MY::postamble { pdlpp_postamble( $package ); } (my $repo = $package_name) =~ s#::#-#g; $repo = "PDLPorters/$repo"; WriteMakefile( META_MERGE => { "meta-spec" => { version => 2 }, resources => { homepage => 'http://pdl.perl.org/', bugtracker => {web=>"https://github.com/$repo/issues"}, repository => { url => "git://github.com/$repo.git", type => 'git', web => "https://github.com/$repo", }, x_IRC => 'irc://irc.perl.org/#pdl', }, }, %hash, );