view release on metacpan or  search on metacpan

GENERATED/PDLA/IO/GD.pm  view on Meta::CPAN

*_gdImageFilledArcs = \&PDLA::_gdImageFilledArcs;





*_gdImageArcs = \&PDLA::_gdImageArcs;





*_gdImageFilledEllipses = \&PDLA::_gdImageFilledEllipses;



;


=head1 OO INTERFACE
 
Object Oriented interface to the GD image library.

=head1 SYNOPSIS

 # Open an existing file:
 # 
 my $gd = PDLA::IO::GD->new( { filename => "test.png" } );
 
 # Query the x and y sizes:
 my $x = $gd->SX();
 my $y = $gd->SY();

 # Grab the PDLA of the data:
 my $pdl = $gd->to_pdl();

 # Kill this thing:
 $gd->DESTROY();

 # Create a new object:
 # 
 my $im = PDLA::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 PDLA to the GD image library.

See L<http://www.boutell.com/gd/> for more information on the GD library and how it works.

=head2 IMPLEMENTATION NOTES

Surprisingly enough, this interface has nothing to do with the other Perl->GD interface module, 
aka 'GD' (as in 'use GD;'). This is done from scratch over the years.

Requires at least version 2.0.22 of the GD library, but it's only been thoroughly tested with
gd-2.0.33, so it would be best to use that. The 2.0.22 requirement has to do with a change in
GD's font handling functions, so if you don't use those, then don't worry about it.

I should also add, the statement about "thoroughly tested" above is mostly a joke. This OO 
interface is very young, and it has I<barely> been tested at all, so if something 
breaks, email me and I'll get it fixed ASAP (for me).

Functions that manipulate and query the image objects generally have a 'gdImage' prefix on the
function names (ex: gdImageString()). I've created aliases here for all of those member 
functions so you don't have to keep typing 'gdImage' in your code, but the long version are in 
there as well.

=head1 METHODS

=cut

use PDLA;
use PDLA::Slices;
use PDLA::IO::Misc;

#
# Some helper functions:
#
sub _pkg_name
    { return "PDLA::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 PDLA::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:

 PDLA::IO::GD->new( {filename => 'image.png'} );
 PDLA::IO::GD->new( filename => 'image.png' );
 PDLA::IO::GD->new( 'image.png' );

If the hash has:

 pdl => $pdl_var (lut => $lut_piddle)
    Then a new GD is created from that PDLA 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 = PDLA::IO::GD->new({ pdl => $pdl_var });
    
 my $gd = PDLA::IO::GD->new({ pdl => $pdl_var, lut => $lut_piddle });
 

GENERATED/PDLA/IO/GD.pm  view on Meta::CPAN

    my $sub = _pkg_name( "to_pdl" );
    
    my $x = $self->gdImageSX();
    my $y = $self->gdImageSY();
    
    if( $self->gdImageTrueColor() )
    {
        my $pdl = zeroes(byte, $x, $y, 3);
        _gd_image_to_pdl_true( $pdl, $self->{IMG_PTR} );
        return $pdl;
    }
    
    my $pdl = zeroes(byte, $x, $y);
    _gd_image_to_pdl( $pdl, $self->{IMG_PTR} );
    return $pdl;
} # End of to_pdl()...

=head2 apply_lut( $lut(piddle) )

Does a $im->ColorAllocate() for and entire LUT piddle at once.

The LUT piddle format is the same as for the general interface above.

=cut


sub apply_lut
{
    my $self = shift;
    my $lut = shift;
    
    # Let the PDLA threading engine sort this out:
    $self->ColorAllocates( $lut->slice("(0),:"), $lut->slice("(1),:"), $lut->slice("(2),:") );
} # End of apply_lut()...

sub DESTROY
{
    my $self = shift;
    my $sub = _pkg_name( "DESTROY" );
 
    #print STDERR sprintf("$sub: destroying gdImagePtr: 0x%p (%d) (%ld) (%lld)!\n", $self->{IMG_PTR}, $self->{IMG_PTR},$self->{IMG_PTR},$self->{IMG_PTR});
    
    if( defined( $self->{IMG_PTR} ) )
    {
        _gdImageDestroy( $self->{IMG_PTR} );
        delete( $self->{IMG_PTR} );
    }
} # End of DESTROY()...

=head2 WARNING:

All of the docs below this point are auto-generated (not to mention the actual code), 
so read with a grain of salt, and B<always> check the main GD documentation about how 
that function works and what it does.

=cut



=head2 write_Png

$image->write_Png( $filename )

=cut


sub write_Png
{
    my $self = shift;
    return _gdImagePng ( $self->{IMG_PTR}, @_ );
} # End of write_Png()...


=head2 write_PngEx

$image->write_PngEx( $filename, $level )

=cut


sub write_PngEx
{
    my $self = shift;
    return _gdImagePngEx ( $self->{IMG_PTR}, @_ );
} # End of write_PngEx()...


=head2 write_WBMP

$image->write_WBMP( $fg, $filename )

=cut


sub write_WBMP
{
    my $self = shift;
    return _gdImageWBMP ( $self->{IMG_PTR}, @_ );
} # End of write_WBMP()...


=head2 write_Jpeg

$image->write_Jpeg( $filename, $quality )

=cut


sub write_Jpeg
{
    my $self = shift;
    return _gdImageJpeg ( $self->{IMG_PTR}, @_ );
} # End of write_Jpeg()...


=head2 write_Gd

$image->write_Gd( $filename )

=cut


sub write_Gd
{
    my $self = shift;
    return _gdImageGd ( $self->{IMG_PTR}, @_ );
} # End of write_Gd()...


=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()...


=head2 write_Gif

$image->write_Gif( $filename )

=cut


sub write_Gif
{
    my $self = shift;
    return _gdImageGif ( $self->{IMG_PTR}, @_ );
} # End of write_Gif()...


=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()...


=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()...


=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()...


=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()...


=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()...


=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()...


=head2 SetPixel