/[amv]/amv.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 4 by dpavlin, Thu Jul 19 20:49:06 2007 UTC revision 31 by dpavlin, Mon Oct 1 16:34:08 2007 UTC
# Line 3  Line 3 
3  # amv.pl  # amv.pl
4  #  #
5  # 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>  # 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6    #
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    # http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11    # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12    # http://mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm
13    # http://wiki.multimedia.cx/index.php?title=IMA_ADPCM
14    
15  use strict;  use strict;
16    
17  use Data::Dump qw/dump/;  use Data::Dump qw/dump/;
18  use Carp qw/confess/;  use Carp qw/confess/;
19    use File::Path;
20    use Getopt::Long;
21    
22    my $dump_amv = 0;
23    my $dump_video = 0;
24    my $dump_jpeg = 0;
25    my $dump_audio = 0;
26    my $debug = 0;
27    my $verbose = 0;
28    my $dump_dir = '/tmp/dump/';
29    my $dump_avi = "dump.avi";
30    my $no_jpeg_header = 0;
31    my $jpeg_q = 100;
32    my $jpegtran;
33    
34    GetOptions(
35            "dump-amv!"             => \$dump_amv,
36            "dump-video!"   => \$dump_video,
37            "dump-jpeg!"    => \$dump_jpeg,
38            "dump-audio!"   => \$dump_audio,
39            "debug!"                => \$debug,
40            "dump-dir=s"    => \$dump_dir,
41            "no-jpeg-headers!" => \$no_jpeg_header,
42            "jpegtran=s"    => \$jpegtran,
43            "verbose!"              => \$verbose,
44    );
45    
46  my $path = shift @ARGV || die "usage: $0 movie.amv\n";  my $path = shift @ARGV || die "usage: $0 movie.amv\n";
47    
48    # by default, flip frames
49    $jpegtran = '-flip vertical' unless defined($jpegtran);
50    
51    rmtree $dump_dir if -e $dump_dir;
52    mkpath $dump_dir || die "can't create $dump_dir: $!";
53    
54    $| = 1;
55    
56  open(my $fh, '<', $path) || die "can't open $path: $!";  open(my $fh, '<', $path) || die "can't open $path: $!";
57    
58  # offset in file  # offset in file
# Line 20  my $o = 0; Line 62  my $o = 0;
62  my $d;  my $d;
63    
64  sub hex_dump {  sub hex_dump {
65          my $bytes = shift || return;          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          my $ascii = $bytes;          my $ascii = $bytes;
75          $ascii =~ s/\W/./gs;          $ascii =~ s/\W/./gs;
76          my $hex = unpack('h*', $bytes);          my $hex = uc( unpack('h*', $bytes) );
77          $hex =~ s/(..)/$1 /g;          $hex =~ s/(..)/$1 /g;
78          # calculate number of characters for offset          # calculate number of characters for offset
79          #my $d = length( sprintf("%x",length($bytes)) );          #my $d = length( sprintf("%x",length($bytes)) );
80          my $d = 4;          my $d = 4;
81            my $prefix = '#.';
82          while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {          while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
83                  printf "## %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );                  printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
84                    $prefix = '##';
85                  if ( length($ascii) >= 16 ) {                  if ( length($ascii) >= 16 ) {
86                          $ascii = substr( $ascii, 16 );                          $ascii = substr( $ascii, 16 );
87                          $o += 16;                          $o += 16;
# Line 39  sub hex_dump { Line 90  sub hex_dump {
90                          last;                          last;
91                  }                  }
92          }          }
93    
94            $o = $old_o if $old_o;
95  }  }
96    
97  sub x {  sub x {
# Line 50  sub x { Line 103  sub x {
103          my $r_len = length($bytes);          my $r_len = length($bytes);
104          confess "read $r_len bytes, expected $len" if $len != $r_len;          confess "read $r_len bytes, expected $len" if $len != $r_len;
105    
106          hex_dump( $bytes );          if ( $dump_amv ) {
107                    print "## raw $len bytes\n";
108                    hex_dump( $bytes );
109            }
110    
111          if ( $bytes eq 'AMV_END_' ) {          if ( $bytes eq 'AMV_END_' ) {
112                  warn "## end of file marker AMV_END_\n";                  print "> end of file marker AMV_END_\n" if $dump_video;
113                  $d->{eof}++;                  $d->{eof}++;
114                  return;                  return;
115          }          }
116    
117          if ( $format ) {          if ( $format ) {
118                  my @data = unpack($format, $bytes);                  my @data = unpack($format, $bytes);
119                  warn "## unpacked = ",dump(@data),"\n";                  print "## unpacked = ",dump(@data),"\n" if $debug;
120                  return @data;                  return @data;
121          } else {          } else {
122                  return $bytes;                  return $bytes;
123          }          }
124  }  }
125    
126    # my $len = next_part( 'boob' );
127    # my ( $len, $part ) = next_part();
128    
129  sub next_part {  sub next_part {
130          my ( $expected_part, $expected_len, $skip ) = @_;          my ( $expected_part, $expected_len, $skip ) = @_;
131          my ( $part, $len ) = x(8,'A4V');          my ( $part, $len ) = x(8,'A4V');
132          return unless $len;          return unless $len;
133          confess "not $expected_part but $part" if $expected_part ne $part;          confess "not $expected_part but $part" if $expected_part && $expected_part ne $part;
134          if ( $expected_len ) {          if ( $expected_len ) {
135                  confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;                  confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
136          }          }
137          printf ">>> %s | %d 0x%x bytes\n", $part, $len, $len;          printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
138          x($len) if $skip;          x($len) if $skip;
139            return ( $len, $part )  if wantarray;
140          return $len;          return $len;
141  }  }
142    
143  my ( $riff, $amv ) = x(12, 'Z8Z4');  sub quality {
144  die "not RIFF but $riff" if $riff ne 'RIFF';          my @table = @_;
145  die "not AMV but $amv" if $amv ne 'AMV ';          die "quantization matrice needs to have 64 bytes!" if $#table != 63;
146    
147            my $in = join('', map { chr($_) } @table );
148            my $out;
149    
150            foreach my $t ( @table ) {
151                    $t = int( ( $t * $jpeg_q ) / 100 );
152                    $t = 255 if $t > 255;
153                    $out .= chr($t);
154            }
155    
156            if ( $dump_video ) {
157                    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    }
165    
166    =for obsolete
167    
168    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    =cut
232    
233    my @subframes;
234    my $frame_nr = 1;
235    
236    # how many subframes to join into single frame?
237    my $join_subframes = 0;
238    
239    sub mkjpg {
240            my ($data) = @_;
241    
242            confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
243            confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
244            $data = substr($data,2,-2);
245    
246            if ( $#subframes < ( $join_subframes - 1 ) ) {
247                    push @subframes, $data;
248                    print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
249                    return;
250            }
251    
252            my $w = $d->{amvh}->{width} || die "no width?";
253            my $h = $d->{amvh}->{height} || confess "no height?";
254    
255            my $header =
256            # Start of Image (SOI) marker
257            "\xFF\xD8".
258            # JFIF marker
259            "\xFF\xE0".
260            pack("nZ5CCCnnCC",
261                    16,                     # length
262                    'JFIF',         # identifier (JFIF)
263                    1,1,            # version
264                    0,                      # units (none)
265                    1,1,            # X,Y density
266                    0,0,            # X,Y thumbnail
267            ).
268            "\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            pack("ncnncc9",
302                    17,                     # len
303                    8,                      # sample precision in bits
304                    $h,$w,          # X,Y size
305                    3,                      # number of components
306                    1,0x22,0,       # Component ID, H+V sampling factors, Quantization table number
307                    2,0x11,1,
308                    3,0x11,1,
309            ).
310            # Define huffman table (section B.2.4.1)
311            "\xFF\xC4".     # Marker
312            "\x00\x1F".     # Length (31 bytes)
313            "\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            # Define huffman table (section B.2.4.1)
317            "\xFF\xC4".     # Marker
318            "\x00\xB5".     # Length (181 bytes)
319            "\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            "\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            # 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            #/* Define huffman table (section B.2.4.1) */
343            "\xFF\xC4".     # Marker
344            "\x00\xB5".     # Length (181 bytes)
345            "\x11".         # AC chrominance, table 1
346            "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
347            "\x00\x01\x02\x77".
348            "\x00\x01\x02\x03\x11\x04\x05\x21".
349            "\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            # 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    
374            if ( $dump_jpeg ) {
375                    print "## created JPEG header...\n";
376                    hex_dump( $header, 0 );
377            }
378    
379            my $frame = join('', @subframes ) . $data;
380            @subframes = ();
381    
382            my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
383    
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            if ( ! $no_jpeg_header ) {
392                    print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
393            } else {
394                    print $fh $frame || die "can't write raw jpeg $path: $!";
395            }
396            close $fh || die "can't close $path: $!";
397            print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
398    }
399    
400    #
401    # IMA ADPCM decoder
402    #
403    
404    my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
405    
406    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    );
417    
418    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    my $au_path = "$dump_dir/sound.au";
470    open(my $au_fh, '>', $au_path) || die "can't open $au_path: $!";
471    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    );
485    
486    sub audio_frame {
487            my $data = shift || die "no data?";
488    
489            my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
490    
491            $pred_val = $origin;
492            $step_idx = $index;
493    
494            my $size = 0;
495    
496            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                    $size += 2;
500            }
501    
502            warn "length isn't corrent $bytes != $size" if $bytes != $size;
503    }
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    my $fps = 16;
569    my $duration;
570    
571  while ( ! defined($d->{eof}) ) {  while ( ! defined($d->{eof}) ) {
572          my ( $list, $name ) = x(12,'A4x4A4');          my ( $list, $name ) = x(12,'A4x4A4');
573          die "not LIST but $list" if $list ne 'LIST';          die "not LIST but $list" if $list ne 'LIST';
574          print "> $list .. $name\n";          print "< $list * $name\n" if $verbose;
575    
576          if ( $name eq 'hdrl' ) {          if ( $name eq 'hdrl' ) {
577    
# Line 101  while ( ! defined($d->{eof}) ) { Line 585  while ( ! defined($d->{eof}) ) {
585                          $h->{$n} = $v;                          $h->{$n} = $v;
586                  } x($len, 'Vx28VVVx8CCv');                  } x($len, 'Vx28VVVx8CCv');
587    
588                  printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",                  $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
589                          $h->{path},  
590                    printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
591                            $path,
592                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
593                          $h->{hh}, $h->{mm}, $h->{ss};                          $duration;
594    
595                  $d->{amvh} = $h;                  $d->{amvh} = $h;
596                    $fps = $h->{fps};
597    
598          } elsif ( $name eq 'strl' ) {          } elsif ( $name eq 'strl' ) {
599    
# Line 115  while ( ! defined($d->{eof}) ) { Line 602  while ( ! defined($d->{eof}) ) {
602    
603          } elsif ( $name eq 'movi' ) {          } elsif ( $name eq 'movi' ) {
604    
605                  while (1) {                  my $have_parts = 1;
606    
607                    while ( $have_parts ) {
608                          my $frame = $d->{movi}++;                          my $frame = $d->{movi}++;
                   
                         my $len = next_part( '00dc', 0, 1 );  
                         last unless $len;  
                         printf ">> %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;  
609    
610                          my $len = next_part( '01wb', 0, 1 );                          my $parts = 0;
611                          printf ">> %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;  
612                            while ( $parts < 2 ) {
613    
614                                    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                                    warn "## #$frame_nr $name $part has $parts parts\n";
646                            }
647    
648                            $frame_nr++;
649    
650                            if ( $frame_nr % $fps == 0 ) {
651                                    print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
652                                    print ".";
653                            }
654                  };                  };
655    
656          } else {          } else {
657                  die "unknown $list $name";                  die "unknown $list $name";
658          }          }
659  }  }
660    
661    my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
662    system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
663    
664    print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";
Legend:
Removed from v.4  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.26