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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26