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
# http://wiki.multimedia.cx/index.php?title=IMA_ADPCM

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: $!";

$| = 1;

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;
        }
}

# my $len = next_part( 'boob' );
# my ( $len, $part ) = next_part();

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 && $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, $part )  if wantarray;
        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;
}

=for obsolete

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;
}

=cut

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;
}

#
# IMA ADPCM decoder
#

my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );

my @step_size = (
        7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
        19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
        50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
        130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
        337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
        876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
        2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
        5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
        15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
);

my $pred_val = 0;
my $step_idx = 0;

# This code is "borrowed" from the ALSA library 
# http://www.alsa-project.org

sub adpcm_decode_sample {
        my $code = shift;

        my $pred_diff;  # Predicted difference to next sample
        my $step;               # holds previous step_size value

        # Separate sign and magnitude
        my $sign = $code & 0x8;
        $code &= 0x7;

        # Computes pred_diff = (code + 0.5) * step / 4,
        # but see comment in adpcm_coder.

        $step = $step_size[$step_idx] || die "no step_size[$step_idx]";

        # Compute difference and new predicted value 
        $pred_diff = $step >> 3;
        my $i = 0x4;
        while( $i ) {
                if ($code & $i) {
                        $pred_diff += $step;
                }
                $i >>= 1;
                $step >>= 1;
        }
        $pred_val += $sign ? -$pred_diff : $pred_diff;

        # Clamp output value 
        if ($pred_val > 32767) {
                $pred_val = 32767;
        } elsif ($pred_val < -32768) {
                $pred_val = -32768;
        }

        # Find new step_size index value
        $step_idx += $index_adjust[$code];

        if ($step_idx < 0) {
                $step_idx = 0;
        } elsif ($step_idx > 88) {
                $step_idx = 88;
        }
        return $pred_val;
}

my $au_path = "$dump_dir/sound.au";
open(my $au_fh, '>', $au_path) || die "can't open $au_path: $!";
print $au_fh pack 'a4N5', (
        # magic
        '.snd',
        # data offset
        24,
        # data size
        -1,
        # encoding - 16-bit linear PCM
        3,
        # sample rate
        22050,
        #channels
        1,
);

sub audio_frame {
        my $data = shift || die "no data?";

        my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);

        $pred_val = $origin;
        $step_idx = $index;

        my $size = 0;

        foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
                print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );          
                print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );          
                $size += 2;
        }

        warn "length isn't corrent $bytes != $size" if $bytes != $size;
}


sub x_audio_frame {
        my $data = shift || die "no data?";

        my $apath = sprintf("$dump_dir/%04d.wav", $frame_nr );
        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
                0x03f9,
        );

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

        my $riff_header_len = tell($audio_fh);

        print $audio_fh $data;

        my $size = tell($audio_fh);
        warn "## wav file $apath 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: $!";
}

#
# read AMV file
#

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 $fps = 16;
my $duration;

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');

                $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );

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

                $d->{amvh} = $h;
                $fps = $h->{fps};

        } elsif ( $name eq 'strl' ) {

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

        } elsif ( $name eq 'movi' ) {

                my $have_parts = 1;

                while ( $have_parts ) {
                        my $frame = $d->{movi}++;

                        my $parts = 0;

                        while ( $parts < 2 ) {

                                my ( $len, $part ) = next_part();

                                if ( ! $len ) {
                                        $have_parts = 0;
                                        last;
                                }

                                if ( $part eq '00dc' ) {

                                        printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
                                        mkjpg( x($len) );
                                        $parts++;

                                } elsif ( $part eq '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 );
                                        }

                #                       print $audio_fh mp3_frame;
                                        audio_frame( $audio_frame );

                                        $parts++;
                                } else {
                                        warn "unknown next part $part with $len bytes, skipping!";
                                }

                                warn "## #$frame_nr $name $part has $parts parts\n" if $debug;
                        }

                        $frame_nr++;

                        if ( $frame_nr % $fps == 0 ) {
                                print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
                                print ".";
                        }
                };

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

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

print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\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	27	# http://wiki.multimedia.cx/index.php?title=IMA_ADPCM
14	dpavlin	3
15			use strict;
16
17			use Data::Dump qw/dump/;
18			use Carp qw/confess/;
19	dpavlin	8	use File::Path;
20	dpavlin	15	use Getopt::Long;
21	dpavlin	3
22	dpavlin	25	my $dump_amv = 0;
23			my $dump_video = 0;
24			my $dump_jpeg = 0;
25			my $dump_audio = 0;
26	dpavlin	8	my $debug = 0;
27	dpavlin	24	my $verbose = 0;
28	dpavlin	15	my $dump_dir = '/tmp/dump/';
29	dpavlin	20	my $dump_avi = "dump.avi";
30	dpavlin	19	my $no_jpeg_header = 0;
31			my $jpeg_q = 100;
32	dpavlin	24	my $jpegtran;
33	dpavlin	8
34	dpavlin	15	GetOptions(
35	dpavlin	25	"dump-amv!" => \$dump_amv,
36			"dump-video!" => \$dump_video,
37			"dump-jpeg!" => \$dump_jpeg,
38			"dump-audio!" => \$dump_audio,
39	dpavlin	15	"debug!" => \$debug,
40			"dump-dir=s" => \$dump_dir,
41	dpavlin	19	"no-jpeg-headers!" => \$no_jpeg_header,
42	dpavlin	24	"jpegtran=s" => \$jpegtran,
43			"verbose!" => \$verbose,
44	dpavlin	15	);
45
46	dpavlin	3	my $path = shift @ARGV \|\| die "usage: $0 movie.amv\n";
47
48	dpavlin	24	# by default, flip frames
49	dpavlin	29	$jpegtran = '-flip vertical' unless defined($jpegtran);
50	dpavlin	15
51	dpavlin	11	rmtree $dump_dir if -e $dump_dir;
52			mkpath $dump_dir \|\| die "can't create $dump_dir: $!";
53	dpavlin	8
54	dpavlin	29	$\| = 1;
55
56	dpavlin	3	open(my $fh, '<', $path) \|\| die "can't open $path: $!";
57
58	dpavlin	4	# offset in file
59			my $o = 0;
60
61			# shared data hash
62			my $d;
63
64	dpavlin	3	sub hex_dump {
65	dpavlin	8	my ( $bytes, $offset ) = @_;
66			return unless $bytes;
67
68			my $old_o;
69			if (defined($offset)) {
70			$old_o = $o;
71			$o = $offset;
72			}
73
74	dpavlin	3	my $ascii = $bytes;
75			$ascii =~ s/\W/./gs;
76	dpavlin	8	my $hex = uc( unpack('h*', $bytes) );
77	dpavlin	3	$hex =~ s/(..)/$1 /g;
78			# calculate number of characters for offset
79	dpavlin	4	#my $d = length( sprintf("%x",length($bytes)) );
80			my $d = 4;
81	dpavlin	6	my $prefix = '#.';
82	dpavlin	3	while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
83	dpavlin	6	printf "$prefix %0${d}x \| %-48s\| %s\n", $o, $1, substr( $ascii, 0, 16 );
84			$prefix = '##';
85	dpavlin	3	if ( length($ascii) >= 16 ) {
86			$ascii = substr( $ascii, 16 );
87	dpavlin	4	$o += 16;
88	dpavlin	3	} else {
89	dpavlin	4	$o += length($ascii);
90	dpavlin	3	last;
91			}
92			}
93	dpavlin	8
94			$o = $old_o if $old_o;
95	dpavlin	3	}
96
97			sub x {
98			my ($len,$format) = @_;
99
100			my $bytes;
101			read($fh, $bytes, $len);
102
103			my $r_len = length($bytes);
104			confess "read $r_len bytes, expected $len" if $len != $r_len;
105
106	dpavlin	25	if ( $dump_amv ) {
107			print "## raw $len bytes\n";
108			hex_dump( $bytes );
109			}
110	dpavlin	3
111	dpavlin	4	if ( $bytes eq 'AMV_END_' ) {
112	dpavlin	25	print "> end of file marker AMV_END_\n" if $dump_video;
113	dpavlin	4	$d->{eof}++;
114			return;
115			}
116
117	dpavlin	3	if ( $format ) {
118			my @data = unpack($format, $bytes);
119	dpavlin	19	print "## unpacked = ",dump(@data),"\n" if $debug;
120	dpavlin	3	return @data;
121			} else {
122			return $bytes;
123			}
124			}
125
126	dpavlin	31	# my $len = next_part( 'boob' );
127			# my ( $len, $part ) = next_part();
128
129	dpavlin	3	sub next_part {
130			my ( $expected_part, $expected_len, $skip ) = @_;
131			my ( $part, $len ) = x(8,'A4V');
132	dpavlin	4	return unless $len;
133	dpavlin	31	confess "not $expected_part but $part" if $expected_part && $expected_part ne $part;
134	dpavlin	3	if ( $expected_len ) {
135			confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
136			}
137	dpavlin	24	printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
138	dpavlin	3	x($len) if $skip;
139	dpavlin	31	return ( $len, $part ) if wantarray;
140	dpavlin	3	return $len;
141			}
142
143	dpavlin	19	sub quality {
144			my @table = @_;
145			die "quantization matrice needs to have 64 bytes!" if $#table != 63;
146	dpavlin	3
147	dpavlin	19	my $in = join('', map { chr($_) } @table );
148			my $out;
149	dpavlin	8
150	dpavlin	19	foreach my $t ( @table ) {
151			$t = int( ( $t * $jpeg_q ) / 100 );
152			$t = 255 if $t > 255;
153			$out .= chr($t);
154			}
155
156	dpavlin	25	if ( $dump_video ) {
157	dpavlin	19	print "## quantization table original\n";
158			hex_dump( $in );
159			print "## quantization table for $jpeg_q %\n";
160			hex_dump( $out );
161			}
162
163			return $out;
164	dpavlin	8	}
165
166	dpavlin	31	=for obsolete
167
168	dpavlin	24	sub mp3_frame {
169			my $frame = join('',
170			# Frame sync (all bits set)
171			1 x 11 .
172			# MPEG Audio version ID
173			# 00 - MPEG Version 2.5 (unofficial)
174			# 01 - reserved
175			# 10 - MPEG Version 2 (ISO/IEC 13818-3)
176			# 11 - MPEG Version 1 (ISO/IEC 11172-3)
177			1,0,
178			# Layer description
179			# 00 - reserved
180			# 01 - Layer III
181			# 10 - Layer II
182			# 11 - Layer I
183			0,1,
184			# Protection bit
185			# 0 - Protected by CRC (16bit crc follows header)
186			# 1 - Not protected
187			0,
188			# Bitrate index
189			0,0,0,0,
190			# Sampling rate frequency index (22050)
191			0,0,
192			# Padding bit
193			# 0 - frame is not padded
194			# 1 - frame is padded with one extra slot
195			0,
196			# Private bit
197			0,
198			# Channel Mode
199			# 00 - Stereo
200			# 01 - Joint stereo (Stereo)
201			# 10 - Dual channel (2 mono channels)
202			# 11 - Single channel (Mono)
203			1,1,
204			# Mode extension (Only if Joint stereo)
205			0,0,
206			# Copyright
207			0,
208			# Original
209			0,
210			# Emphasis
211			# 00 - none
212			# 01 - 50/15 ms
213			# 10 - reserved
214			# 11 - CCIT J.17
215			0,0,
216			);
217
218			die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;
219
220			my $bits = pack("b32", $frame);
221
222			die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;
223
224			my $t = $frame;
225			$t =~ s/(.{8})/$1 /g;
226			warn "## mp3 frame frame = $t\n";
227
228			return $bits;
229			}
230
231	dpavlin	31	=cut
232
233	dpavlin	19	my @subframes;
234			my $frame_nr = 1;
235
236			# how many subframes to join into single frame?
237			my $join_subframes = 0;
238
239	dpavlin	8	sub mkjpg {
240	dpavlin	19	my ($data) = @_;
241	dpavlin	8
242			confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
243	dpavlin	19	confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
244			$data = substr($data,2,-2);
245	dpavlin	8
246	dpavlin	19	if ( $#subframes < ( $join_subframes - 1 ) ) {
247			push @subframes, $data;
248	dpavlin	24	print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
249	dpavlin	19	return;
250			}
251
252	dpavlin	16	my $w = $d->{amvh}->{width} \|\| die "no width?";
253			my $h = $d->{amvh}->{height} \|\| confess "no height?";
254
255	dpavlin	8	my $header =
256	dpavlin	19	# Start of Image (SOI) marker
257			"\xFF\xD8".
258			# JFIF marker
259			"\xFF\xE0".
260	dpavlin	8	pack("nZ5CCCnnCC",
261			16, # length
262	dpavlin	19	'JFIF', # identifier (JFIF)
263	dpavlin	8	1,1, # version
264			0, # units (none)
265			1,1, # X,Y density
266			0,0, # X,Y thumbnail
267			).
268	dpavlin	19	"\xFF\xFE".
269			"\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
270			# quantization table (quaility=100%)
271			"\xFF\xDB".
272			"\x00\x43".
273			# 8 bit values, table 1
274			"\x00".
275			quality(
276			0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
277			0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
278			0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
279			0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
280			0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
281			0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
282			0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
283			0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
284			).
285			"\xFF\xDB".
286			"\x00\x43".
287			# 8 bit values, table 1
288			"\x01".
289			quality(
290			0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
291			0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
292			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
293			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
294			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
295			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
296			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
297			0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
298			).
299			# start of frame
300			"\xFF\xC0".
301	dpavlin	8	pack("ncnncc9",
302			17, # len
303			8, # sample precision in bits
304	dpavlin	16	$h,$w, # X,Y size
305	dpavlin	8	3, # number of components
306	dpavlin	19	1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
307	dpavlin	11	2,0x11,1,
308			3,0x11,1,
309	dpavlin	8	).
310	dpavlin	11	# Define huffman table (section B.2.4.1)
311	dpavlin	13	"\xFF\xC4". # Marker
312			"\x00\x1F". # Length (31 bytes)
313	dpavlin	14	"\x00". # DC luminance, table 0
314			"\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
315			"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
316	dpavlin	13	# Define huffman table (section B.2.4.1)
317			"\xFF\xC4". # Marker
318			"\x00\xB5". # Length (181 bytes)
319	dpavlin	14	"\x10". # AC luminance, table 0
320			"\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
321			"\x01\x02\x03\x00\x04\x11\x05\x12".
322	dpavlin	13	"\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
323			"\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
324			"\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
325			"\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
326			"\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
327			"\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
328			"\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
329			"\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
330			"\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
331			"\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
332			"\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
333			"\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
334			"\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
335	dpavlin	19	# Define huffman table (section B.2.4.1)
336			"\xFF\xC4". # Marker
337			"\x00\x1F". # Length (31 bytes)
338			"\x01". # DC chrominance, table 1
339			"\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
340			"\x00\x00\x00\x00".
341			"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
342	dpavlin	13	#/* Define huffman table (section B.2.4.1) */
343	dpavlin	14	"\xFF\xC4". # Marker
344			"\x00\xB5". # Length (181 bytes)
345			"\x11". # AC chrominance, table 1
346	dpavlin	13	"\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
347	dpavlin	14	"\x00\x01\x02\x77".
348			"\x00\x01\x02\x03\x11\x04\x05\x21".
349	dpavlin	13	"\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
350			"\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
351			"\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
352			"\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
353			"\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
354			"\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
355			"\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
356			"\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
357			"\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
358			"\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
359			"\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
360			"\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
361			"\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
362	dpavlin	19	# Start of Scan marker
363			"\xFF\xDA".
364			pack("nC10",
365			12, # length
366			3, # number of components
367			1,0x00, # Scan 1: use DC/AC huff tables 0/0
368			2,0x11, # Scan 2: use DC/AC huff tables 1/1
369			3,0x11, # Scan 3: use DC/AC huff tables 1/1
370			0,0x3f, # Ss, Se
371			0, # Ah, Ai (not used)
372			);
373	dpavlin	8
374	dpavlin	25	if ( $dump_jpeg ) {
375	dpavlin	19	print "## created JPEG header...\n";
376	dpavlin	11	hex_dump( $header, 0 );
377			}
378	dpavlin	8
379	dpavlin	19	my $frame = join('', @subframes ) . $data;
380			@subframes = ();
381
382	dpavlin	24	my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
383	dpavlin	23
384			my $fh;
385			if ( $jpegtran ) {
386			open($fh, '\|-', "jpegtran $jpegtran > $path") \|\| die "can't create $path: $!";
387			} else {
388			open($fh, '>', $path) \|\| die "can't create $path: $!";
389			}
390
391	dpavlin	19	if ( ! $no_jpeg_header ) {
392	dpavlin	23	print $fh $header . $frame . "\xFF\xD9" \|\| die "can't write jpeg $path: $!";
393	dpavlin	19	} else {
394			print $fh $frame \|\| die "can't write raw jpeg $path: $!";
395			}
396	dpavlin	8	close $fh \|\| die "can't close $path: $!";
397	dpavlin	24	print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
398	dpavlin	8	}
399
400	dpavlin	28	#
401			# IMA ADPCM decoder
402			#
403	dpavlin	8
404	dpavlin	28	my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
405	dpavlin	24
406	dpavlin	28	my @step_size = (
407			7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
408			19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
409			50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
410			130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
411			337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
412			876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
413			2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
414			5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
415			15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
416	dpavlin	24	);
417
418	dpavlin	28	my $pred_val = 0;
419			my $step_idx = 0;
420
421			# This code is "borrowed" from the ALSA library
422			# http://www.alsa-project.org
423
424			sub adpcm_decode_sample {
425			my $code = shift;
426
427			my $pred_diff; # Predicted difference to next sample
428			my $step; # holds previous step_size value
429
430			# Separate sign and magnitude
431			my $sign = $code & 0x8;
432			$code &= 0x7;
433
434			# Computes pred_diff = (code + 0.5) * step / 4,
435			# but see comment in adpcm_coder.
436
437			$step = $step_size[$step_idx] \|\| die "no step_size[$step_idx]";
438
439			# Compute difference and new predicted value
440			$pred_diff = $step >> 3;
441			my $i = 0x4;
442			while( $i ) {
443			if ($code & $i) {
444			$pred_diff += $step;
445			}
446			$i >>= 1;
447			$step >>= 1;
448			}
449			$pred_val += $sign ? -$pred_diff : $pred_diff;
450
451			# Clamp output value
452			if ($pred_val > 32767) {
453			$pred_val = 32767;
454			} elsif ($pred_val < -32768) {
455			$pred_val = -32768;
456			}
457
458			# Find new step_size index value
459			$step_idx += $index_adjust[$code];
460
461			if ($step_idx < 0) {
462			$step_idx = 0;
463			} elsif ($step_idx > 88) {
464			$step_idx = 88;
465			}
466			return $pred_val;
467			}
468
469	dpavlin	29	my $au_path = "$dump_dir/sound.au";
470			open(my $au_fh, '>', $au_path) \|\| die "can't open $au_path: $!";
471	dpavlin	28	print $au_fh pack 'a4N5', (
472			# magic
473			'.snd',
474			# data offset
475			24,
476			# data size
477			-1,
478			# encoding - 16-bit linear PCM
479			3,
480			# sample rate
481			22050,
482			#channels
483			1,
484	dpavlin	24	);
485
486	dpavlin	28	sub audio_frame {
487			my $data = shift \|\| die "no data?";
488	dpavlin	24
489	dpavlin	28	my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
490
491			$pred_val = $origin;
492			$step_idx = $index;
493
494	dpavlin	30	my $size = 0;
495
496	dpavlin	28	foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
497			print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );
498			print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );
499	dpavlin	30	$size += 2;
500	dpavlin	28	}
501	dpavlin	30
502			warn "length isn't corrent $bytes != $size" if $bytes != $size;
503	dpavlin	28	}
504
505
506			sub x_audio_frame {
507			my $data = shift \|\| die "no data?";
508
509			my $apath = sprintf("$dump_dir/%04d.wav", $frame_nr );
510			open(my $audio_fh, '>', $apath) \|\| die "can't open audio file $apath: $!";
511
512			print $audio_fh pack 'a4Va4a4VvvVVv4', (
513			# header 'RIFF', size
514			'RIFF',-1,
515			# type: 'WAVE'
516			'WAVE',
517			'fmt ',0x14,
518			# format: DVI (IMA) ADPCM Wave Type
519			0x11,
520			# channels
521			1,
522			# samples/sec
523			22050,
524			# avg. bytes/sec (for esimation)
525			11567,
526			# block align (size of block)
527			0x800,
528			# bits per sample (mono data)
529			4,
530			# cbSize (ADPCM with 7 soefficient pairs)
531			2,
532			# nSamplesPerBlock
533			# (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
534			0x03f9,
535			);
536
537			print $audio_fh pack 'a4VVa4V', (
538			# time length of the data in samples
539			'fact',4,
540			220500,
541			#
542			'data',-1,
543			);
544
545			my $riff_header_len = tell($audio_fh);
546
547			print $audio_fh $data;
548
549			my $size = tell($audio_fh);
550			warn "## wav file $apath size: $size\n";
551
552			seek( $audio_fh, 4, 0 );
553			print $audio_fh pack("V", $size - 8);
554			seek( $audio_fh, $riff_header_len - 4, 0 );
555			print $audio_fh pack("V", $size - $riff_header_len);
556
557			close($audio_fh) \|\| die "can't close audio file $apath: $!";
558			}
559
560			#
561			# read AMV file
562			#
563
564			my ( $riff, $amv ) = x(12, 'Z4x4Z4');
565			die "$path not RIFF but $riff" if $riff ne 'RIFF';
566			die "$path not AMV but $amv" if $amv ne 'AMV ';
567
568	dpavlin	29	my $fps = 16;
569			my $duration;
570
571	dpavlin	4	while ( ! defined($d->{eof}) ) {
572	dpavlin	3	my ( $list, $name ) = x(12,'A4x4A4');
573			die "not LIST but $list" if $list ne 'LIST';
574	dpavlin	24	print "< $list * $name\n" if $verbose;
575	dpavlin	3
576			if ( $name eq 'hdrl' ) {
577
578			my $len = next_part( 'amvh', hex(38) );
579
580			my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
581			my $h;
582			map {
583			my $v = $_;
584			my $n = shift @names \|\| die "no more names?";
585			$h->{$n} = $v;
586			} x($len, 'Vx28VVVx8CCv');
587
588	dpavlin	29	$duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
589
590			printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
591	dpavlin	8	$path,
592	dpavlin	3	$h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
593	dpavlin	29	$duration;
594	dpavlin	3
595			$d->{amvh} = $h;
596	dpavlin	29	$fps = $h->{fps};
597	dpavlin	3
598			} elsif ( $name eq 'strl' ) {
599
600			next_part( 'strh', 0, 1 );
601			next_part( 'strf', 0, 1 );
602
603	dpavlin	4	} elsif ( $name eq 'movi' ) {
604
605	dpavlin	31	my $have_parts = 1;
606
607			while ( $have_parts ) {
608	dpavlin	4	my $frame = $d->{movi}++;
609
610	dpavlin	31	my $parts = 0;
611	dpavlin	24
612	dpavlin	31	while ( $parts < 2 ) {
613	dpavlin	24
614	dpavlin	31	my ( $len, $part ) = next_part();
615
616			if ( ! $len ) {
617			$have_parts = 0;
618			last;
619			}
620
621			if ( $part eq '00dc' ) {
622
623			printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
624			mkjpg( x($len) );
625			$parts++;
626
627			} elsif ( $part eq '01wb' ) {
628			printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
629
630			my $audio_frame = x( $len );
631
632			if ( $dump_audio ) {
633			printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
634			hex_dump( $audio_frame );
635			}
636
637			# print $audio_fh mp3_frame;
638			audio_frame( $audio_frame );
639
640			$parts++;
641			} else {
642			warn "unknown next part $part with $len bytes, skipping!";
643			}
644
645	dpavlin	32	warn "## #$frame_nr $name $part has $parts parts\n" if $debug;
646	dpavlin	25	}
647
648	dpavlin	24	$frame_nr++;
649	dpavlin	29
650			if ( $frame_nr % $fps == 0 ) {
651			print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
652			print ".";
653			}
654	dpavlin	4	};
655
656	dpavlin	3	} else {
657			die "unknown $list $name";
658			}
659			}
660	dpavlin	20
661	dpavlin	29	my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
662	dpavlin	20	system($cmd) == 0 \|\| die "can't convert frames to avi using $cmd: $!";
663
664	dpavlin	28	print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";