summaryrefslogtreecommitdiffstats
path: root/test/pngtype.pl
blob: d7577a8f272f2079aa7f18e3fc5c84fdac7efc57 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
use warnings ;
use strict ;

binmode(STDIN);

my $a ;
read STDIN,$a,8 ;
if( $a ne "\x89PNG\x0d\x0a\x1a\x0a" ) {
    die "Malformed PNG header\n" ;
}
sub bv($) {
    ord(substr($a,$_[0],1)) ;
}
sub wv($) {
    my $a = shift ;
    return (bv($a) << 24) + (bv($a+1) << 16) + (bv($a+2)<<8) + bv($a+3);
}
my %all ;
while( !eof STDIN ) {
    read STDIN,$a,4 ;
    my $len = wv(0);
    read STDIN,$a,$len+8 ;
    my $type = substr($a,0,4) ;
    next if $type eq 'IDAT' ;
    last if $type eq 'IEND' ;
    if( $type eq 'IHDR' && $len == 13 ) {
        print wv(4),"x",wv(8),"x",bv(12),"\n" ;
        my $cmode = bv(13) ;
        print $cmode & 3 ? "color" : "gray" ;
        print "+index" if $cmode & 1 ;
        print "+alpha" if $cmode & 4 ;
        print "\nz",bv(14)," f",bv(15)," i",bv(16),"\n" ;
        next ;
    }
    my $aref = ($all{$type} ||= []) ;
    push @$aref, "$type($len)" ;
    {
        my $w = 16 ;
        $w = 24 if $type eq 'PLTE' ;
        $w = 8 if $type eq 'tRNS' ;
        for my $i ( 0 .. $len - 1 ) {
            push @$aref, sprintf("%s%02X", $i%$w ? " " : "\n ", bv($i+4) ) ;
            push @$aref, " " if
                $type eq 'PLTE' &&
                $i%3 == 2 &&
                ($i+1)%$w != 0 &&
                $i != $len-1 ;
        }
        push @$aref, "\n" ;
    }
}
for my $k ( sort keys %all ) {
    print @{$all{$k}} ;
}