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