/[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

Annotation of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26