/[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 29 - (hide annotations)
Sun Aug 19 19:23:03 2007 UTC (11 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 15689 byte(s)
- re-enable frame flipping using jpegtran
- don't buffer output to support showing dot every second and lf every minute
- put -r *before* -i for ffmpeg, video framerate is now correct

In total: video decoding now works (aside from jpegtran problems with
flipping which produce wrong last row)
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     foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
487     print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );
488     print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );
489     }
490     }
491    
492    
493     sub x_audio_frame {
494     my $data = shift || die "no data?";
495    
496     my $apath = sprintf("$dump_dir/%04d.wav", $frame_nr );
497     open(my $audio_fh, '>', $apath) || die "can't open audio file $apath: $!";
498    
499     print $audio_fh pack 'a4Va4a4VvvVVv4', (
500     # header 'RIFF', size
501     'RIFF',-1,
502     # type: 'WAVE'
503     'WAVE',
504     'fmt ',0x14,
505     # format: DVI (IMA) ADPCM Wave Type
506     0x11,
507     # channels
508     1,
509     # samples/sec
510     22050,
511     # avg. bytes/sec (for esimation)
512     11567,
513     # block align (size of block)
514     0x800,
515     # bits per sample (mono data)
516     4,
517     # cbSize (ADPCM with 7 soefficient pairs)
518     2,
519     # nSamplesPerBlock
520     # (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
521     0x03f9,
522     );
523    
524     print $audio_fh pack 'a4VVa4V', (
525     # time length of the data in samples
526     'fact',4,
527     220500,
528     #
529     'data',-1,
530     );
531    
532     my $riff_header_len = tell($audio_fh);
533    
534     print $audio_fh $data;
535    
536     my $size = tell($audio_fh);
537     warn "## wav file $apath size: $size\n";
538    
539     seek( $audio_fh, 4, 0 );
540     print $audio_fh pack("V", $size - 8);
541     seek( $audio_fh, $riff_header_len - 4, 0 );
542     print $audio_fh pack("V", $size - $riff_header_len);
543    
544     close($audio_fh) || die "can't close audio file $apath: $!";
545     }
546    
547     #
548     # read AMV file
549     #
550    
551     my ( $riff, $amv ) = x(12, 'Z4x4Z4');
552     die "$path not RIFF but $riff" if $riff ne 'RIFF';
553     die "$path not AMV but $amv" if $amv ne 'AMV ';
554    
555 dpavlin 29 my $fps = 16;
556     my $duration;
557    
558 dpavlin 4 while ( ! defined($d->{eof}) ) {
559 dpavlin 3 my ( $list, $name ) = x(12,'A4x4A4');
560     die "not LIST but $list" if $list ne 'LIST';
561 dpavlin 24 print "< $list * $name\n" if $verbose;
562 dpavlin 3
563     if ( $name eq 'hdrl' ) {
564    
565     my $len = next_part( 'amvh', hex(38) );
566    
567     my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
568     my $h;
569     map {
570     my $v = $_;
571     my $n = shift @names || die "no more names?";
572     $h->{$n} = $v;
573     } x($len, 'Vx28VVVx8CCv');
574    
575 dpavlin 29 $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
576    
577     printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
578 dpavlin 8 $path,
579 dpavlin 3 $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
580 dpavlin 29 $duration;
581 dpavlin 3
582     $d->{amvh} = $h;
583 dpavlin 29 $fps = $h->{fps};
584 dpavlin 3
585     } elsif ( $name eq 'strl' ) {
586    
587     next_part( 'strh', 0, 1 );
588     next_part( 'strf', 0, 1 );
589    
590 dpavlin 4 } elsif ( $name eq 'movi' ) {
591    
592     while (1) {
593     my $frame = $d->{movi}++;
594    
595 dpavlin 8 my $len = next_part( '00dc' );
596 dpavlin 4 last unless $len;
597 dpavlin 24 printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
598 dpavlin 19 mkjpg( x($len) );
599 dpavlin 4
600 dpavlin 24 $len = next_part( '01wb' );
601     printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
602    
603     my $audio_frame = x( $len );
604    
605 dpavlin 25 if ( $dump_audio ) {
606     printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
607     hex_dump( $audio_frame );
608     }
609    
610 dpavlin 24 # print $audio_fh mp3_frame;
611 dpavlin 28 audio_frame( $audio_frame );
612 dpavlin 24
613     $frame_nr++;
614 dpavlin 29
615     if ( $frame_nr % $fps == 0 ) {
616     print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
617     print ".";
618     }
619 dpavlin 4 };
620    
621 dpavlin 3 } else {
622     die "unknown $list $name";
623     }
624     }
625 dpavlin 20
626 dpavlin 29 my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
627 dpavlin 20 system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
628    
629 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