viewvc.cgi/amv/amv.pl

#!/usr/bin/perl -w

# amv.pl
#
# 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
#
# Various useful links used to produce this:
# http://www.moviecodec.com/topics/15431p1.html
# http://en.wikipedia.org/wiki/RIFF_(File_format)
# http://www.obrador.com/essentialjpeg/HeaderInfo.htm
# http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
# http://mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm

use strict;

use Data::Dump qw/dump/;
use Carp qw/confess/;
use File::Path;
use Getopt::Long;

my $dump_amv = 0;
my $dump_video = 0;
my $dump_jpeg = 0;
my $dump_audio = 0;
my $debug = 0;
my $verbose = 0;
my $dump_dir = '/tmp/dump/';
my $dump_avi = "dump.avi";
my $no_jpeg_header = 0;
my $jpeg_q = 100;
my $jpegtran;

GetOptions(
        "dump-amv!"             => \$dump_amv,
        "dump-video!"   => \$dump_video,
        "dump-jpeg!"    => \$dump_jpeg,
        "dump-audio!"   => \$dump_audio,
        "debug!"                => \$debug,
        "dump-dir=s"    => \$dump_dir,
        "no-jpeg-headers!" => \$no_jpeg_header,
        "jpegtran=s"    => \$jpegtran,
        "verbose!"              => \$verbose,
);

my $path = shift @ARGV || die "usage: $0 movie.amv\n";

# by default, flip frames
#$jpegtran = '-flip vertical' unless defined($jpegtran);

rmtree $dump_dir if -e $dump_dir;
mkpath $dump_dir || die "can't create $dump_dir: $!";

open(my $fh, '<', $path) || die "can't open $path: $!";

# offset in file
my $o = 0;

# shared data hash
my $d;

sub hex_dump {
        my ( $bytes, $offset ) = @_;
        return unless $bytes;

        my $old_o;
        if (defined($offset)) {
                $old_o = $o;
                $o = $offset;
        }

        my $ascii = $bytes;
        $ascii =~ s/\W/./gs;
        my $hex = uc( unpack('h*', $bytes) );
        $hex =~ s/(..)/$1 /g;
        # calculate number of characters for offset
        #my $d = length( sprintf("%x",length($bytes)) );
        my $d = 4;
        my $prefix = '#.';
        while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
                printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
                $prefix = '##';
                if ( length($ascii) >= 16 ) {
                        $ascii = substr( $ascii, 16 );
                        $o += 16;
                } else {
                        $o += length($ascii);
                        last;
                }
        }

        $o = $old_o if $old_o;
}

sub x {
        my ($len,$format) = @_;

        my $bytes;
        read($fh, $bytes, $len);

        my $r_len = length($bytes);
        confess "read $r_len bytes, expected $len" if $len != $r_len;

        if ( $dump_amv ) {
                print "## raw $len bytes\n";
                hex_dump( $bytes );
        }

        if ( $bytes eq 'AMV_END_' ) {
                print "> end of file marker AMV_END_\n" if $dump_video;
                $d->{eof}++;
                return;
        }

        if ( $format ) {
                my @data = unpack($format, $bytes);
                print "## unpacked = ",dump(@data),"\n" if $debug;
                return @data;
        } else {
                return $bytes;
        }
}

sub next_part {
        my ( $expected_part, $expected_len, $skip ) = @_;
        my ( $part, $len ) = x(8,'A4V');
        return unless $len;
        confess "not $expected_part but $part" if $expected_part ne $part;
        if ( $expected_len ) {
                confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
        }
        printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
        x($len) if $skip;
        return $len;
}

sub quality {
        my @table = @_;
        die "quantization matrice needs to have 64 bytes!" if $#table != 63;

        my $in = join('', map { chr($_) } @table );
        my $out;

        foreach my $t ( @table ) {
                $t = int( ( $t * $jpeg_q ) / 100 );
                $t = 255 if $t > 255;
                $out .= chr($t);
        }

        if ( $dump_video ) {
                print "## quantization table original\n";
                hex_dump( $in );
                print "## quantization table for $jpeg_q %\n";
                hex_dump( $out );
        }

        return $out;
}

sub mp3_frame {
        my $frame = join('',
                # Frame sync (all bits set)
                1 x 11 .
                # MPEG Audio version ID
                # 00 - MPEG Version 2.5 (unofficial)
                # 01 - reserved
                # 10 - MPEG Version 2 (ISO/IEC 13818-3)
                # 11 - MPEG Version 1 (ISO/IEC 11172-3)
                1,0,
                # Layer description
                # 00 - reserved
                # 01 - Layer III
                # 10 - Layer II
                # 11 - Layer I
                0,1,
                # Protection bit
                # 0 - Protected by CRC (16bit crc follows header)
                # 1 - Not protected
                0,
                # Bitrate index
                0,0,0,0,
                # Sampling rate frequency index (22050)
                0,0,
                # Padding bit
                # 0 - frame is not padded
                # 1 - frame is padded with one extra slot
                0,
                # Private bit
                0,
                # Channel Mode
                # 00 - Stereo
                # 01 - Joint stereo (Stereo)
                # 10 - Dual channel (2 mono channels)
                # 11 - Single channel (Mono)
                1,1,
                # Mode extension (Only if Joint stereo)
                0,0,
                # Copyright
                0,
                # Original
                0,
                # Emphasis
                # 00 - none
                # 01 - 50/15 ms
                # 10 - reserved
                # 11 - CCIT J.17
                0,0,
        );

        die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;

        my $bits = pack("b32", $frame);

        die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;

        my $t = $frame;
        $t =~ s/(.{8})/$1 /g;
        warn "## mp3 frame frame = $t\n";

        return $bits;
}

my @subframes;
my $frame_nr = 1;

# how many subframes to join into single frame?
my $join_subframes = 0;

sub mkjpg {
        my ($data) = @_;

        confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
        confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
        $data = substr($data,2,-2);

        if ( $#subframes < ( $join_subframes - 1 ) ) {
                push @subframes, $data;
                print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
                return;
        }

        my $w = $d->{amvh}->{width} || die "no width?";
        my $h = $d->{amvh}->{height} || confess "no height?";

        my $header = 
        # Start of Image (SOI) marker
        "\xFF\xD8".
        # JFIF marker
        "\xFF\xE0".
        pack("nZ5CCCnnCC",
                16,                     # length
                'JFIF',         # identifier (JFIF)
                1,1,            # version
                0,                      # units (none)
                1,1,            # X,Y density
                0,0,            # X,Y thumbnail
        ).
        "\xFF\xFE".
        "\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
        # quantization table (quaility=100%)
        "\xFF\xDB".
        "\x00\x43".
        # 8 bit values, table 1
        "\x00".
        quality(
    0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
    0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
    0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
    0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
    0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
    0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
    0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
    0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
        ).
        "\xFF\xDB".
        "\x00\x43".
        # 8 bit values, table 1
        "\x01".
        quality(
    0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
    0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
    0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
        ).
        # start of frame
        "\xFF\xC0".
        pack("ncnncc9",
                17,                     # len
                8,                      # sample precision in bits
                $h,$w,          # X,Y size
                3,                      # number of components
                1,0x22,0,       # Component ID, H+V sampling factors, Quantization table number
                2,0x11,1,
                3,0x11,1,
        ).
        # Define huffman table (section B.2.4.1)
        "\xFF\xC4".     # Marker
        "\x00\x1F".     # Length (31 bytes)
        "\x00".         # DC luminance, table 0
        "\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
        "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
        # Define huffman table (section B.2.4.1)
        "\xFF\xC4".     # Marker
        "\x00\xB5".     # Length (181 bytes)
        "\x10".         # AC luminance, table 0
        "\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
        "\x01\x02\x03\x00\x04\x11\x05\x12".
        "\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
        "\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
        "\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
        "\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
        "\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
        "\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
        "\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
        "\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
        "\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
        "\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
        "\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
        "\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
        "\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
        # Define huffman table (section B.2.4.1)
        "\xFF\xC4".     # Marker
        "\x00\x1F".     # Length (31 bytes)
        "\x01".         # DC chrominance, table 1
        "\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
        "\x00\x00\x00\x00".
        "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
        #/* Define huffman table (section B.2.4.1) */
        "\xFF\xC4".     # Marker
        "\x00\xB5".     # Length (181 bytes)
        "\x11".         # AC chrominance, table 1
        "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
        "\x00\x01\x02\x77".
        "\x00\x01\x02\x03\x11\x04\x05\x21".
        "\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
        "\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
        "\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
        "\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
        "\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
        "\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
        "\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
        "\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
        "\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
        "\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
        "\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
        "\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
        "\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
        # Start of Scan marker
        "\xFF\xDA".
        pack("nC10",
                12,                     # length
                3,                      # number of components
                1,0x00,         # Scan 1: use DC/AC huff tables 0/0
                2,0x11,         # Scan 2: use DC/AC huff tables 1/1
                3,0x11,         # Scan 3: use DC/AC huff tables 1/1
                0,0x3f,         # Ss, Se
                0,                      # Ah, Ai (not used)
        );

        if ( $dump_jpeg ) {
                print "## created JPEG header...\n";
                hex_dump( $header, 0 );
        }

        my $frame = join('', @subframes ) . $data;
        @subframes = ();

        my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );

        my $fh;
        if ( $jpegtran ) {
                open($fh, '|-', "jpegtran $jpegtran > $path") || die "can't create $path: $!";
        } else {
                open($fh, '>', $path) || die "can't create $path: $!";
        }

        if ( ! $no_jpeg_header ) {
                print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
        } else {
                print $fh $frame || die "can't write raw jpeg $path: $!";
        }
        close $fh || die "can't close $path: $!";
        print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
}

my ( $riff, $amv ) = x(12, 'Z4x4Z4');
die "$path not RIFF but $riff" if $riff ne 'RIFF';
die "$path not AMV but $amv" if $amv ne 'AMV ';

my $apath = "$dump_dir/audio.wav";
open(my $audio_fh, '>', $apath) || die "can't open audio file $apath: $!";

print $audio_fh pack 'a4Va4a4VvvVVv4', (
        # header 'RIFF', size
        'RIFF',-1,
        # type: 'WAVE'
        'WAVE',
        'fmt ',0x14,
        # format: DVI (IMA) ADPCM Wave Type
        0x11,
        # channels
        1,
        # samples/sec
        22050,
        # avg. bytes/sec (for esimation)
        11567,
        # block align (size of block)
        0x800,
        # bits per sample (mono data)
        4,
        # cbSize (ADPCM with 7 soefficient pairs)
        2,
        # nSamplesPerBlock
        # (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
        0x0ff9,
);

print $audio_fh pack 'a4VVa4V', (
        # time length of the data in samples
        'fact',4,
        220500,
        #
        'data',-1,
);

my $riff_header_len = tell($audio_fh);

while ( ! defined($d->{eof}) ) {
        my ( $list, $name ) = x(12,'A4x4A4');
        die "not LIST but $list" if $list ne 'LIST';
        print "< $list * $name\n" if $verbose;

        if ( $name eq 'hdrl' ) {

                my $len = next_part( 'amvh', hex(38) );

                my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
                my $h;
                map {
                        my $v = $_;
                        my $n = shift @names || die "no more names?";
                        $h->{$n} = $v;
                } x($len, 'Vx28VVVx8CCv');

                printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",
                        $path,
                        $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
                        $h->{hh}, $h->{mm}, $h->{ss};

                $d->{amvh} = $h;

        } elsif ( $name eq 'strl' ) {

                next_part( 'strh', 0, 1 );
                next_part( 'strf', 0, 1 );

        } elsif ( $name eq 'movi' ) {

                while (1) {
                        my $frame = $d->{movi}++;
                
                        my $len = next_part( '00dc' );
                        last unless $len;
                        printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
                        mkjpg( x($len) );

                        $len = next_part( '01wb' );
                        printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;

                        my $audio_frame = x( $len );

                        if ( $dump_audio ) {
                                printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
                                hex_dump( $audio_frame );
                        }

                        # remove 8 bytes of something
                        $audio_frame = substr( $audio_frame, 8 );

                        if ( length($audio_frame) % 2 == 0 ) {
                                print "#### even sized frame!";
#                               $audio_frame = substr( $audio_frame, 0, -1 );
                        }

#                       print $audio_fh mp3_frame;
                        print $audio_fh $audio_frame || die "can't write audio frame in $apath: $!";

                        $frame_nr++;
                };

        } else {
                die "unknown $list $name";
        }
}

my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -y $dump_avi";
system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";

my $size = tell($audio_fh);
warn "## wav file size: $size\n";

seek( $audio_fh, 4, 0 );
print $audio_fh pack("V", $size - 8);
seek( $audio_fh, $riff_header_len - 4, 0 );
print $audio_fh pack("V", $size - $riff_header_len);

close($audio_fh) || die "can't close audio file $apath: $!";

print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, " and $apath ", -s $apath, "\n";
1	dpavlin	3	#!/usr/bin/perl -w
2
3			# amv.pl
4			#
5			# 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6	dpavlin	7	#
7			# Various useful links used to produce this:
8			# http://www.moviecodec.com/topics/15431p1.html
9			# http://en.wikipedia.org/wiki/RIFF_(File_format)
10	dpavlin	8	# http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11			# http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12	dpavlin	24	# http://mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm
13	dpavlin	3
14			use strict;
15
16			use Data::Dump qw/dump/;
17			use Carp qw/confess/;
18	dpavlin	8	use File::Path;
19	dpavlin	15	use Getopt::Long;
20	dpavlin	3
21	dpavlin	25	my $dump_amv = 0;
22			my $dump_video = 0;
23			my $dump_jpeg = 0;
24			my $dump_audio = 0;
25	dpavlin	8	my $debug = 0;
26	dpavlin	24	my $verbose = 0;
27	dpavlin	15	my $dump_dir = '/tmp/dump/';
28	dpavlin	20	my $dump_avi = "dump.avi";
29	dpavlin	19	my $no_jpeg_header = 0;
30			my $jpeg_q = 100;
31	dpavlin	24	my $jpegtran;
32	dpavlin	8
33	dpavlin	15	GetOptions(
34	dpavlin	25	"dump-amv!" => \$dump_amv,
35			"dump-video!" => \$dump_video,
36			"dump-jpeg!" => \$dump_jpeg,
37			"dump-audio!" => \$dump_audio,
38	dpavlin	15	"debug!" => \$debug,
39			"dump-dir=s" => \$dump_dir,
40	dpavlin	19	"no-jpeg-headers!" => \$no_jpeg_header,
41	dpavlin	24	"jpegtran=s" => \$jpegtran,
42			"verbose!" => \$verbose,
43	dpavlin	15	);
44
45	dpavlin	3	my $path = shift @ARGV \|\| die "usage: $0 movie.amv\n";
46
47	dpavlin	24	# by default, flip frames
48			#$jpegtran = '-flip vertical' unless defined($jpegtran);
49	dpavlin	15
50	dpavlin	11	rmtree $dump_dir if -e $dump_dir;
51			mkpath $dump_dir \|\| die "can't create $dump_dir: $!";
52	dpavlin	8
53	dpavlin	3	open(my $fh, '<', $path) \|\| die "can't open $path: $!";
54
55	dpavlin	4	# offset in file
56			my $o = 0;
57
58			# shared data hash
59			my $d;
60
61	dpavlin	3	sub hex_dump {
62	dpavlin	8	my ( $bytes, $offset ) = @_;
63			return unless $bytes;
64
65			my $old_o;
66			if (defined($offset)) {
67			$old_o = $o;
68			$o = $offset;
69			}
70
71	dpavlin	3	my $ascii = $bytes;
72			$ascii =~ s/\W/./gs;
73	dpavlin	8	my $hex = uc( unpack('h*', $bytes) );
74	dpavlin	3	$hex =~ s/(..)/$1 /g;
75			# calculate number of characters for offset
76	dpavlin	4	#my $d = length( sprintf("%x",length($bytes)) );
77			my $d = 4;
78	dpavlin	6	my $prefix = '#.';
79	dpavlin	3	while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
80	dpavlin	6	printf "$prefix %0${d}x \| %-48s\| %s\n", $o, $1, substr( $ascii, 0, 16 );
81			$prefix = '##';
82	dpavlin	3	if ( length($ascii) >= 16 ) {
83			$ascii = substr( $ascii, 16 );
84	dpavlin	4	$o += 16;
85	dpavlin	3	} else {
86	dpavlin	4	$o += length($ascii);
87	dpavlin	3	last;
88			}
89			}
90	dpavlin	8
91			$o = $old_o if $old_o;
92	dpavlin	3	}
93
94			sub x {
95			my ($len,$format) = @_;
96
97			my $bytes;
98			read($fh, $bytes, $len);
99
100			my $r_len = length($bytes);
101			confess "read $r_len bytes, expected $len" if $len != $r_len;
102
103	dpavlin	25	if ( $dump_amv ) {
104			print "## raw $len bytes\n";
105			hex_dump( $bytes );
106			}
107	dpavlin	3
108	dpavlin	4	if ( $bytes eq 'AMV_END_' ) {
109	dpavlin	25	print "> end of file marker AMV_END_\n" if $dump_video;
110	dpavlin	4	$d->{eof}++;
111			return;
112			}
113
114	dpavlin	3	if ( $format ) {
115			my @data = unpack($format, $bytes);
116	dpavlin	19	print "## unpacked = ",dump(@data),"\n" if $debug;
117	dpavlin	3	return @data;
118			} else {
119			return $bytes;
120			}
121			}
122
123			sub next_part {
124			my ( $expected_part, $expected_len, $skip ) = @_;
125			my ( $part, $len ) = x(8,'A4V');
126	dpavlin	4	return unless $len;
127	dpavlin	3	confess "not $expected_part but $part" if $expected_part ne $part;
128			if ( $expected_len ) {
129			confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
130			}
131	dpavlin	24	printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
132	dpavlin	3	x($len) if $skip;
133			return $len;
134			}
135
136	dpavlin	19	sub quality {
137			my @table = @_;
138			die "quantization matrice needs to have 64 bytes!" if $#table != 63;
139	dpavlin	3
140	dpavlin	19	my $in = join('', map { chr($_) } @table );
141			my $out;
142	dpavlin	8
143	dpavlin	19	foreach my $t ( @table ) {
144			$t = int( ( $t * $jpeg_q ) / 100 );
145			$t = 255 if $t > 255;
146			$out .= chr($t);
147			}
148
149	dpavlin	25	if ( $dump_video ) {
150	dpavlin	19	print "## quantization table original\n";
151			hex_dump( $in );
152			print "## quantization table for $jpeg_q %\n";
153			hex_dump( $out );
154			}
155
156			return $out;
157	dpavlin	8	}
158
159	dpavlin	24	sub mp3_frame {
160			my $frame = join('',
161			# Frame sync (all bits set)
162			1 x 11 .
163			# MPEG Audio version ID
164			# 00 - MPEG Version 2.5 (unofficial)
165			# 01 - reserved
166			# 10 - MPEG Version 2 (ISO/IEC 13818-3)
167			# 11 - MPEG Version 1 (ISO/IEC 11172-3)
168			1,0,
169			# Layer description
170			# 00 - reserved
171			# 01 - Layer III
172			# 10 - Layer II
173			# 11 - Layer I
174			0,1,
175			# Protection bit
176			# 0 - Protected by CRC (16bit crc follows header)
177			# 1 - Not protected
178			0,
179			# Bitrate index
180			0,0,0,0,
181			# Sampling rate frequency index (22050)
182			0,0,
183			# Padding bit
184			# 0 - frame is not padded
185			# 1 - frame is padded with one extra slot
186			0,
187			# Private bit
188			0,
189			# Channel Mode
190			# 00 - Stereo
191			# 01 - Joint stereo (Stereo)
192			# 10 - Dual channel (2 mono channels)
193			# 11 - Single channel (Mono)
194			1,1,
195			# Mode extension (Only if Joint stereo)
196			0,0,
197			# Copyright
198			0,
199			# Original
200			0,
201			# Emphasis
202			# 00 - none
203			# 01 - 50/15 ms
204			# 10 - reserved
205			# 11 - CCIT J.17
206			0,0,
207			);
208
209			die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;
210
211			my $bits = pack("b32", $frame);
212
213			die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;
214
215			my $t = $frame;
216			$t =~ s/(.{8})/$1 /g;
217			warn "## mp3 frame frame = $t\n";
218
219			return $bits;
220			}
221
222	dpavlin	19	my @subframes;
223			my $frame_nr = 1;
224
225			# how many subframes to join into single frame?
226			my $join_subframes = 0;
227
228	dpavlin	8	sub mkjpg {
229	dpavlin	19	my ($data) = @_;
230	dpavlin	8
231			confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
232	dpavlin	19	confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
233			$data = substr($data,2,-2);
234	dpavlin	8
235	dpavlin	19	if ( $#subframes < ( $join_subframes - 1 ) ) {
236			push @subframes, $data;
237	dpavlin	24	print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
238	dpavlin	19	return;
239			}
240
241	dpavlin	16	my $w = $d->{amvh}->{width} \|\| die "no width?";
242			my $h = $d->{amvh}->{height} \|\| confess "no height?";
243
244	dpavlin	8	my $header =
245	dpavlin	19	# Start of Image (SOI) marker
246			"\xFF\xD8".
247			# JFIF marker
248			"\xFF\xE0".
249	dpavlin	8	pack("nZ5CCCnnCC",
250			16, # length
251	dpavlin	19	'JFIF', # identifier (JFIF)
252	dpavlin	8	1,1, # version
253			0, # units (none)
254			1,1, # X,Y density
255			0,0, # X,Y thumbnail
256			).
257	dpavlin	19	"\xFF\xFE".
258			"\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
259			# quantization table (quaility=100%)
260			"\xFF\xDB".
261			"\x00\x43".
262			# 8 bit values, table 1
263			"\x00".
264			quality(
265			0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
266			0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
267			0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
268			0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
269			0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
270			0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
271			0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
272			0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
273			).
274			"\xFF\xDB".
275			"\x00\x43".
276			# 8 bit values, table 1
277			"\x01".
278			quality(
279			0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
280			0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
281			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
282			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
283			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
284			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
285			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
286			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
287			).
288			# start of frame
289			"\xFF\xC0".
290	dpavlin	8	pack("ncnncc9",
291			17, # len
292			8, # sample precision in bits
293	dpavlin	16	$h,$w, # X,Y size
294	dpavlin	8	3, # number of components
295	dpavlin	19	1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
296	dpavlin	11	2,0x11,1,
297			3,0x11,1,
298	dpavlin	8	).
299	dpavlin	11	# Define huffman table (section B.2.4.1)
300	dpavlin	13	"\xFF\xC4". # Marker
301			"\x00\x1F". # Length (31 bytes)
302	dpavlin	14	"\x00". # DC luminance, table 0
303			"\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
304			"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
305	dpavlin	13	# Define huffman table (section B.2.4.1)
306			"\xFF\xC4". # Marker
307			"\x00\xB5". # Length (181 bytes)
308	dpavlin	14	"\x10". # AC luminance, table 0
309			"\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
310			"\x01\x02\x03\x00\x04\x11\x05\x12".
311	dpavlin	13	"\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
312			"\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
313			"\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
314			"\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
315			"\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
316			"\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
317			"\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
318			"\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
319			"\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
320			"\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
321			"\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
322			"\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
323			"\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
324	dpavlin	19	# Define huffman table (section B.2.4.1)
325			"\xFF\xC4". # Marker
326			"\x00\x1F". # Length (31 bytes)
327			"\x01". # DC chrominance, table 1
328			"\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
329			"\x00\x00\x00\x00".
330			"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
331	dpavlin	13	#/* Define huffman table (section B.2.4.1) */
332	dpavlin	14	"\xFF\xC4". # Marker
333			"\x00\xB5". # Length (181 bytes)
334			"\x11". # AC chrominance, table 1
335	dpavlin	13	"\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
336	dpavlin	14	"\x00\x01\x02\x77".
337			"\x00\x01\x02\x03\x11\x04\x05\x21".
338	dpavlin	13	"\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
339			"\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
340			"\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
341			"\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
342			"\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
343			"\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
344			"\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
345			"\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
346			"\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
347			"\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
348			"\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
349			"\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
350			"\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
351	dpavlin	19	# Start of Scan marker
352			"\xFF\xDA".
353			pack("nC10",
354			12, # length
355			3, # number of components
356			1,0x00, # Scan 1: use DC/AC huff tables 0/0
357			2,0x11, # Scan 2: use DC/AC huff tables 1/1
358			3,0x11, # Scan 3: use DC/AC huff tables 1/1
359			0,0x3f, # Ss, Se
360			0, # Ah, Ai (not used)
361			);
362	dpavlin	8
363	dpavlin	25	if ( $dump_jpeg ) {
364	dpavlin	19	print "## created JPEG header...\n";
365	dpavlin	11	hex_dump( $header, 0 );
366			}
367	dpavlin	8
368	dpavlin	19	my $frame = join('', @subframes ) . $data;
369			@subframes = ();
370
371	dpavlin	24	my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
372	dpavlin	23
373			my $fh;
374			if ( $jpegtran ) {
375			open($fh, '\|-', "jpegtran $jpegtran > $path") \|\| die "can't create $path: $!";
376			} else {
377			open($fh, '>', $path) \|\| die "can't create $path: $!";
378			}
379
380	dpavlin	19	if ( ! $no_jpeg_header ) {
381	dpavlin	23	print $fh $header . $frame . "\xFF\xD9" \|\| die "can't write jpeg $path: $!";
382	dpavlin	19	} else {
383			print $fh $frame \|\| die "can't write raw jpeg $path: $!";
384			}
385	dpavlin	8	close $fh \|\| die "can't close $path: $!";
386	dpavlin	24	print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
387	dpavlin	8	}
388
389			my ( $riff, $amv ) = x(12, 'Z4x4Z4');
390			die "$path not RIFF but $riff" if $riff ne 'RIFF';
391			die "$path not AMV but $amv" if $amv ne 'AMV ';
392
393	dpavlin	24	my $apath = "$dump_dir/audio.wav";
394			open(my $audio_fh, '>', $apath) \|\| die "can't open audio file $apath: $!";
395
396			print $audio_fh pack 'a4Va4a4VvvVVv4', (
397			# header 'RIFF', size
398			'RIFF',-1,
399			# type: 'WAVE'
400			'WAVE',
401			'fmt ',0x14,
402			# format: DVI (IMA) ADPCM Wave Type
403			0x11,
404			# channels
405			1,
406			# samples/sec
407			22050,
408			# avg. bytes/sec (for esimation)
409			11567,
410			# block align (size of block)
411			0x800,
412			# bits per sample (mono data)
413			4,
414			# cbSize (ADPCM with 7 soefficient pairs)
415			2,
416			# nSamplesPerBlock
417			# (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
418			0x0ff9,
419			);
420
421			print $audio_fh pack 'a4VVa4V', (
422			# time length of the data in samples
423			'fact',4,
424			220500,
425			#
426			'data',-1,
427			);
428
429			my $riff_header_len = tell($audio_fh);
430
431	dpavlin	4	while ( ! defined($d->{eof}) ) {
432	dpavlin	3	my ( $list, $name ) = x(12,'A4x4A4');
433			die "not LIST but $list" if $list ne 'LIST';
434	dpavlin	24	print "< $list * $name\n" if $verbose;
435	dpavlin	3
436			if ( $name eq 'hdrl' ) {
437
438			my $len = next_part( 'amvh', hex(38) );
439
440			my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
441			my $h;
442			map {
443			my $v = $_;
444			my $n = shift @names \|\| die "no more names?";
445			$h->{$n} = $v;
446			} x($len, 'Vx28VVVx8CCv');
447
448			printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",
449	dpavlin	8	$path,
450	dpavlin	3	$h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
451			$h->{hh}, $h->{mm}, $h->{ss};
452
453			$d->{amvh} = $h;
454
455			} elsif ( $name eq 'strl' ) {
456
457			next_part( 'strh', 0, 1 );
458			next_part( 'strf', 0, 1 );
459
460	dpavlin	4	} elsif ( $name eq 'movi' ) {
461
462			while (1) {
463			my $frame = $d->{movi}++;
464
465	dpavlin	8	my $len = next_part( '00dc' );
466	dpavlin	4	last unless $len;
467	dpavlin	24	printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
468	dpavlin	19	mkjpg( x($len) );
469	dpavlin	4
470	dpavlin	24	$len = next_part( '01wb' );
471			printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
472
473			my $audio_frame = x( $len );
474
475	dpavlin	25	if ( $dump_audio ) {
476			printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
477			hex_dump( $audio_frame );
478			}
479
480	dpavlin	24	# remove 8 bytes of something
481			$audio_frame = substr( $audio_frame, 8 );
482
483			if ( length($audio_frame) % 2 == 0 ) {
484			print "#### even sized frame!";
485			# $audio_frame = substr( $audio_frame, 0, -1 );
486			}
487
488			# print $audio_fh mp3_frame;
489			print $audio_fh $audio_frame \|\| die "can't write audio frame in $apath: $!";
490
491			$frame_nr++;
492	dpavlin	4	};
493
494	dpavlin	3	} else {
495			die "unknown $list $name";
496			}
497			}
498	dpavlin	20
499	dpavlin	23	my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -y $dump_avi";
500	dpavlin	20	system($cmd) == 0 \|\| die "can't convert frames to avi using $cmd: $!";
501
502	dpavlin	24	my $size = tell($audio_fh);
503			warn "## wav file size: $size\n";
504
505			seek( $audio_fh, 4, 0 );
506			print $audio_fh pack("V", $size - 8);
507			seek( $audio_fh, $riff_header_len - 4, 0 );
508			print $audio_fh pack("V", $size - $riff_header_len);
509
510			close($audio_fh) \|\| die "can't close audio file $apath: $!";
511
512			print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, " and $apath ", -s $apath, "\n";