1use strict;
2
3use File::Path ();
4use File::Spec::Functions;
5use FindBin ();
6use Test::More tests => 30;
7require Test::NoWarnings;
8
9use Image::Scale;
10
11my $png_version = Image::Scale->png_version();
12
13my $tmpdir = catdir( $FindBin::Bin, 'tmp' );
14if ( -d $tmpdir ) {
15    File::Path::rmtree($tmpdir);
16}
17mkdir $tmpdir;
18
19my @types = qw(
20    1bit
21    4bit
22    8bit
23    16bit_555
24    16bit_565
25    24bit
26    32bit
27    32bit_alpha
28);
29
30# XXX 4bit_rle, 8bit_os2, 8bit_rle
31
32# We don't need to test all resizes, JPEG can do that
33my @resizes = qw(
34    resize_gd_fixed_point
35);
36
37# width/height
38for my $type ( @types ) {
39    my $im = Image::Scale->new( _f("${type}.bmp") );
40
41    is( $im->width, 127, "BMP $type width ok" );
42    is( $im->height, 64, "BMP $type height ok" );
43}
44
45SKIP:
46{
47    skip "PNG support not built, skipping file comparison tests", 8 if !$png_version;
48
49    # Normal width resize
50    for my $resize ( @resizes ) {
51        for my $type ( @types ) {
52            my $outfile = _tmp("${type}_${resize}_w127.png");
53
54            my $im = Image::Scale->new( _f("${type}.bmp") );
55            $im->$resize( { width => 127 } );
56            $im->save_png($outfile);
57
58            is( _compare( _load($outfile), "${type}_${resize}_w127.png" ), 1, "BMP $type $resize 127 file ok" );
59        }
60    }
61}
62
63# XXX flipped image (negative height)
64
65# multiple resize calls on same $im object, should throw away previous resize data
66SKIP:
67{
68    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
69
70    my $outfile = _tmp("24bit_multiple_resize_gd_fixed_point.png");
71    my $im = Image::Scale->new( _f("24bit.bmp") );
72    $im->resize_gd_fixed_point( { width => 50 } );
73    $im->resize_gd_fixed_point( { width => 127 } );
74    $im->save_png($outfile);
75
76    is( _compare( _load($outfile), "24bit_multiple_resize_gd_fixed_point.png" ), 1, "BMP multiple resize_gd_fixed_point ok" );
77}
78
79# resize from BMP in scalar
80SKIP:
81{
82    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
83
84    my $dataref = _load( _f("24bit.bmp") );
85
86    my $outfile = _tmp("24bit_resize_gd_fixed_point_w127_scalar.png");
87    my $im = Image::Scale->new($dataref);
88    $im->resize_gd_fixed_point( { width => 127 } );
89    $im->save_png($outfile);
90
91    is( _compare( _load($outfile), "24bit_resize_gd_fixed_point_w127.png" ), 1, "BMP resize_gd_fixed_point from scalar ok" );
92}
93
94# resize multiple from BMP scalar
95SKIP:
96{
97    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
98
99    my $dataref = _load( _f("24bit.bmp") );
100
101    my $outfile = _tmp("24bit_multiple_resize_gd_fixed_point_w127_scalar.png");
102    my $im = Image::Scale->new($dataref);
103    $im->resize_gd_fixed_point( { width => 150 } );
104    $im->resize_gd_fixed_point( { width => 127 } );
105    $im->save_png($outfile);
106
107    is( _compare( _load($outfile), "24bit_resize_gd_fixed_point_w127.png" ), 1, "BMP resize_gd_fixed_point multiple from scalar ok" );
108}
109
110# offset image in MP3 ID3v2 tag
111SKIP:
112{
113    my $outfile = _tmp("apic_gd_fixed_point_w127.png");
114    my $im = Image::Scale->new(
115        _f('v2.4-apic-bmp-318-24632.mp3'),
116        { offset => 318, length => 24632 }
117    );
118
119    is( $im->width, 127, 'BMP from offset ID3 tag width ok' );
120    is( $im->height, 64, 'BMP from offset ID3 tag height ok' );
121
122    $im->resize_gd_fixed_point( { width => 127 } );
123
124    skip "PNG support not built, skipping file comparison tests", 1 if !$png_version;
125
126    $im->save_png($outfile);
127
128    is( _compare( _load($outfile), "apic_gd_fixed_point_w127.png" ), 1, "BMP resize_gd_fixed_point from offset ID3 tag ok" );
129}
130
131END {
132    File::Path::rmtree($tmpdir);
133}
134
135sub _f {
136    return catfile( $FindBin::Bin, 'images', 'bmp', shift );
137}
138
139sub _tmp {
140    return catfile( $tmpdir, shift );
141}
142
143sub _load {
144    my $path = shift;
145
146    open my $fh, '<', $path or die "Cannot open $path";
147    binmode $fh;
148    my $data = do { local $/; <$fh> };
149    close $fh;
150
151    return \$data;
152}
153
154sub _compare {
155    my ( $test, $path ) = @_;
156
157    my $ref = _load( catfile( $FindBin::Bin, 'ref', 'bmp', $path ) );
158
159    return $$ref eq $$test;
160}
161