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