1use strict; 2use warnings; 3 4use Test::More; 5use Prima::sys::Test qw(noX11); 6 7my @types = ( 8 ['bpp1', im::Mono], 9 ['bpp1 gray', im::BW], 10 ['bpp4', im::bpp4], 11 ['bpp4 gray', im::bpp4|im::GrayScale], 12 ['bpp8', im::bpp8], 13 ['bpp8 gray', im::Byte], 14 ['rgb', im::RGB], 15 ['int16', im::Short], 16 ['int32', im::Long], 17 ['float', im::Float], 18 ['double', im::Double], 19 ['complex', im::Complex], 20 ['dcomplex', im::DComplex], 21# trigs are same as complex here 22); 23 24my @inttypes = ( 25 ['bpp1', im::BW], 26 ['bpp4', im::bpp4], 27 ['bpp8', im::bpp8], 28 ['rgb', im::RGB], 29 ['int16', im::Short], 30 ['int32', im::Long], 31); 32 33my @filters; 34for ( keys %ist:: ) { 35 next if /^(AUTOLOAD|Constant)$/i; 36 push @filters, [ $_, &{$ist::{$_}}() ]; 37} 38 39sub bytes { unpack('H*', shift ) } 40sub is_bytes 41{ 42 my ( $bytes_actual, $bytes_expected, $name ) = @_; 43 my $ok = $bytes_actual eq $bytes_expected; 44 ok( $ok, $name ); 45 warn "# " . bytes($bytes_actual) . " (actual)\n# " . bytes($bytes_expected) . " (expected)\n" unless $ok; 46# exit unless $ok; 47 return $ok; 48} 49 50for ( @types ) { 51 my ( $typename, $type ) = @$_; 52 my $i = Prima::Image->create( 53 width => 32, 54 height => 32, 55 type => im::Byte, 56 conversion => ict::None, 57 preserveType => 1, 58 color => 0x0, 59 backColor => 0xffffff, 60 rop2 => rop::CopyPut, 61 ); 62 $i->fillPattern([(7) x 3, (0) x 5]); 63 $i->bar(0,0,32,32); 64 my @stats1 = map { $i->stats($_) } (is::RangeLo, is::RangeHi, is::Variance, is::StdDev); 65 my @max = ( 256, 256, 256 * 256, 256 ); 66 $i->type($type); 67 for ( @filters ) { 68 my ( $filtername, $filter ) = @$_; 69 my $j = $i-> clone( scaling => $filter ); 70 $j-> size( 64, 64 ); 71 $j-> size( 32, 32 ); 72 $j-> type(im::Byte); 73 my @stats2 = map { $j->stats($_) } (is::RangeLo, is::RangeHi, is::Variance, is::StdDev); 74 my @err; 75 for ( my $k = 0; $k < @stats1; $k++) { 76 my $err = int(abs(($stats1[$k] - $stats2[$k]) / $max[$k]) * 100); 77 $err = 100 if $err > 100; 78 push @err, $err; 79 } 80 my $lim = ( $filter > ist::OR ) ? 10 : 0; 81 my $nonzero = grep { $_ > $lim } @err; 82 ok(!$nonzero, "$typename $filtername"); 83 diag( "accumulated errors: @err" ) if $nonzero; 84 } 85} 86 87for ( @inttypes ) { 88 my ( $typename, $type ) = @$_; 89 my $i = Prima::Image->create( 90 width => 8, 91 height => 8, 92 type => $type, 93 color => 0x0, 94 backColor => (($type == im::Short) ? 0x7fff : 0xffffff), 95 rop2 => rop::CopyPut, 96 ); 97 my $j = $i->dup; 98 $i->fillPattern([(0x11,0x11,0x44,0x44)x2]); 99 $i->bar(0,0,7,7); 100 $i->scaling(ist::AND); 101 $i->size(4,4); 102 $i->type(im::Byte); 103 is_bytes($i->data, 104 "\xff\x00\xff\x00". 105 "\x00\xff\x00\xff". 106 "\xff\x00\xff\x00". 107 "\x00\xff\x00\xff", 108 "$typename ist::AND"); 109 110 $i = $j; 111 $i->set( 112 color => 0x0, 113 backColor => (($type == im::Short) ? 0x7fff : 0xffffff), 114 rop2 => rop::CopyPut, 115 ); 116 $i->fillPattern([(0xee,0xee,0xbb,0xbb)x2]); 117 $i->bar(0,0,7,7); 118 $i->scaling(ist::OR); 119 $i->size(4,4); 120 $i->type(im::Byte); 121 is_bytes($i->data, 122 "\x00\xff\x00\xff". 123 "\xff\x00\xff\x00". 124 "\x00\xff\x00\xff". 125 "\xff\x00\xff\x00", 126 "$typename ist::OR"); 127} 128 129done_testing; 130