view release on metacpan or  search on metacpan

t/gd_oo_tests.t  view on Meta::CPAN

    ok( $y, 'query Y dim' );
    #diag "\$x = $x\t\$y = $y\n";

    # TEST 7:
    # Read it into a PDLA, and make sure it matches:
    my $pdl2 = $gd->to_pdl();
    ok( tapprox( $pdl, $pdl2 ), 'image matches original pdl' );

    # TEST 8:
    # Kill it:
    $gd->DESTROY();
    #diag "Object destroyed!\n";
    ok( 1, 'Object destroyed' );

    #
    # Create a new object:
    # 
    # TEST 9:
    # Create a new image from scratch:
    my $im = PDLA::IO::GD->new( { x => 300, y => 300 } );
    ok( defined( $im ), 'creat new image from scratch' );

    #
    # Allocate some colors:
    #
    # TEST 10:
    $im->apply_lut( $lut );
    ok( 1, 'allocate some colors' );

    # TESTS 11-14:
    # 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' );

    # TEST 15:
    # Draw a rectangle:
    $im->Rectangle( 5, 5, 295, 295, $red );
    ok( 1, 'draw a rectangle' );

    # TEST 16:
    # Add some text:
    $im->String( gdFontGetLarge(), 10, 10, "Test Large Font!", $green );
    ok( 1, 'add some text' );

    # TEST 17:
    # 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' );

    # TEST 18:
    # Write the output file:
    $im->write_Png( $testfile2 );
    ok( 1, 'write the output file' );
    $im->DESTROY(); $im = undef;

    #
    # New tests on object creation:
    #

    # TEST 19:
    # Create from a 2d PDLA without a LUT:
    my $pic = sequence(100, 100);
    $im = PDLA::IO::GD->new({ pdl => $pic });
    ok( defined( $im ), 'create from 2d PDLA without a LUT' );
    $im->DESTROY(); $im = undef;

    # TEST 20:
    # Create from a 2d PDLA and a LUT:
    $im = PDLA::IO::GD->new({ pdl => $pic, lut => $lut });
    ok( defined( $im ), 'create from 2d PDLA and a LUT' );
    $im->DESTROY(); $im = undef;

    # TEST 21:
    # Create from a RGB PDLA:
    my $pic3d = $pic->dummy(2,3);
    $im = PDLA::IO::GD->new({ pdl => $pic3d });
    ok( defined( $im ), 'create from a RGB PDLA' );
    $im->DESTROY(); $im = undef;

    # TEST 22:
    # Create an RGB from scratch:
    $im = PDLA::IO::GD->new({ x => 100, y => 100, true_color => 1 });
    ok( defined( $im ), 'create an RGB from scratch' );
    $im->DESTROY(); $im = undef;

    # TEST 23-24:
    # Create from a 2d PNG data glob:
    my $rc = open( TF1, $testfile1 );
    ok( $rc, 'opened test file and handle' );
    binmode( TF1 );
    $/ = undef;
    my $blob = <TF1>;
    close( TF1 );
    $im = PDLA::IO::GD->new({ data => $blob });
    ok( defined( $im ), 'create from a 2d PNG data glob' );
    $im->DESTROY(); $im = undef;

    # TEST 25:
    # Create from a 2d PNG data glob, with the type given:
    $im = PDLA::IO::GD->new({ data => $blob, type => 'png' });
    ok( defined( $im ), 'create from glob with type given' );
    $im->DESTROY(); $im = undef;

    # TEST 26-27:
    # Create from a 3d PNG data glob:
    $rc = open( TF3, $testfile3 );
    ok( $rc , 'testfile3 successfully opened');
    binmode( TF3 );
    $/ = undef;
    my $blob3d = <TF3>;
    close( TF3 );
    $im = PDLA::IO::GD->new({ data => $blob3d });
    ok( defined( $im ), 'create from a 3d PNG data glob' );

    # TEST 28:
    # 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' );
    $im->DESTROY(); $im = undef;

    # TEST 29:
    # Try a nicer way to make an object. Just pass in a filename:
    my $gd_new_just_filename = PDLA::IO::GD->new( $testfile1 );
    ok( defined( $gd_new_just_filename ), 'initialize an object from JUST the filename' );

    # TEST 30:
    # Try another nicer way to make an object: Pass in an inline hash:
    my $gd_new_inline_hash = PDLA::IO::GD->new( filename => $testfile1 );
    ok( defined( $gd_new_inline_hash ), 'initialize an object from an inline hash' );

    # TEST 31:
    # 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 = PDLA::IO::GD->new( filename => $testfile1, 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 = PDLA::IO::GD->new( filename => $testfile1, [34] => 12 ) };
    ok( $@ && !defined( $gd_new_inline_hash_broken2 ), 'incorrectly initialize an object from an inline hash: non-string key' );


    # Remove our test files:
    #
    unlink( $lutfile );
    unlink( $testfile1 );
    unlink( $testfile2 );
    unlink( $testfile3 );

#}

exit (0);
# 
sub write_lut
{
    my $filename = shift;
    open( LUT, ">$filename" );
    print LUT <<'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