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

Contents of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 36 - (show annotations)
Tue Oct 2 19:12:07 2007 UTC (10 years, 10 months ago) by dpavlin
File MIME type: text/plain
File size: 14001 byte(s)
warn about length mismatch only with debug
1 #!/usr/bin/perl -w
2
3 # amv.pl
4 #
5 # 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;
16
17 use Data::Dump qw/dump/;
18 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";
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: $!";
57
58 # offset in file
59 my $o = 0;
60
61 # shared data hash
62 my $d;
63
64 sub hex_dump {
65 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;
75 $ascii =~ s/\W/./gs;
76 my $hex = uc( unpack('h*', $bytes) );
77 $hex =~ s/(..)/$1 /g;
78 # calculate number of characters for offset
79 #my $d = length( sprintf("%x",length($bytes)) );
80 my $d = 4;
81 my $prefix = '#.';
82 while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
83 printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
84 $prefix = '##';
85 if ( length($ascii) >= 16 ) {
86 $ascii = substr( $ascii, 16 );
87 $o += 16;
88 } else {
89 $o += length($ascii);
90 last;
91 }
92 }
93
94 $o = $old_o if $old_o;
95 }
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 if ( $dump_amv ) {
107 print "## raw $len bytes\n";
108 hex_dump( $bytes );
109 }
110
111 if ( $bytes eq 'AMV_END_' ) {
112 print "> end of file marker AMV_END_\n" if $dump_video;
113 $d->{eof}++;
114 return;
115 }
116
117 if ( $format ) {
118 my @data = unpack($format, $bytes);
119 print "## unpacked = ",dump(@data),"\n" if $debug;
120 return @data;
121 } else {
122 return $bytes;
123 }
124 }
125
126 # my $len = next_part( 'boob' );
127 # my ( $len, $part ) = next_part();
128
129 sub next_part {
130 my ( $expected_part, $expected_len, $skip ) = @_;
131 my ( $part, $len ) = x(8,'A4V');
132 return unless $len;
133 confess "not $expected_part but $part" if $expected_part && $expected_part ne $part;
134 if ( $expected_len ) {
135 confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
136 }
137 printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
138 x($len) if $skip;
139 return ( $len, $part ) if wantarray;
140 return $len;
141 }
142
143 sub quality {
144 my @table = @_;
145 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 my @subframes;
167 my $frame_nr = 1;
168
169 # how many subframes to join into single frame?
170 my $join_subframes = 0;
171
172 sub mkjpg {
173 my ($data) = @_;
174
175 confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
176 confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
177 $data = substr($data,2,-2);
178
179 if ( $#subframes < ( $join_subframes - 1 ) ) {
180 push @subframes, $data;
181 print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
182 return;
183 }
184
185 my $w = $d->{amvh}->{width} || die "no width?";
186 my $h = $d->{amvh}->{height} || confess "no height?";
187
188 my $header =
189 # Start of Image (SOI) marker
190 "\xFF\xD8".
191 # JFIF marker
192 "\xFF\xE0".
193 pack("nZ5CCCnnCC",
194 16, # length
195 'JFIF', # identifier (JFIF)
196 1,1, # version
197 0, # units (none)
198 1,1, # X,Y density
199 0,0, # X,Y thumbnail
200 ).
201 "\xFF\xFE".
202 "\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
203 # quantization table (quaility=100%)
204 "\xFF\xDB".
205 "\x00\x43".
206 # 8 bit values, table 1
207 "\x00".
208 quality(
209 0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
210 0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
211 0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
212 0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
213 0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
214 0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
215 0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
216 0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
217 ).
218 "\xFF\xDB".
219 "\x00\x43".
220 # 8 bit values, table 1
221 "\x01".
222 quality(
223 0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
224 0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
225 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
226 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
227 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
228 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
229 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
230 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
231 ).
232 # start of frame
233 "\xFF\xC0".
234 pack("ncnncc9",
235 17, # len
236 8, # sample precision in bits
237 $h,$w, # X,Y size
238 3, # number of components
239 1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
240 2,0x11,1,
241 3,0x11,1,
242 ).
243 # Define huffman table (section B.2.4.1)
244 "\xFF\xC4". # Marker
245 "\x00\x1F". # Length (31 bytes)
246 "\x00". # DC luminance, table 0
247 "\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
248 "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
249 # Define huffman table (section B.2.4.1)
250 "\xFF\xC4". # Marker
251 "\x00\xB5". # Length (181 bytes)
252 "\x10". # AC luminance, table 0
253 "\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
254 "\x01\x02\x03\x00\x04\x11\x05\x12".
255 "\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
256 "\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
257 "\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
258 "\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
259 "\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
260 "\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
261 "\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
262 "\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
263 "\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
264 "\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
265 "\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
266 "\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
267 "\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
268 # Define huffman table (section B.2.4.1)
269 "\xFF\xC4". # Marker
270 "\x00\x1F". # Length (31 bytes)
271 "\x01". # DC chrominance, table 1
272 "\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
273 "\x00\x00\x00\x00".
274 "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
275 #/* Define huffman table (section B.2.4.1) */
276 "\xFF\xC4". # Marker
277 "\x00\xB5". # Length (181 bytes)
278 "\x11". # AC chrominance, table 1
279 "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
280 "\x00\x01\x02\x77".
281 "\x00\x01\x02\x03\x11\x04\x05\x21".
282 "\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
283 "\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
284 "\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
285 "\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
286 "\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
287 "\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
288 "\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
289 "\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
290 "\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
291 "\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
292 "\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
293 "\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
294 "\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
295 # Start of Scan marker
296 "\xFF\xDA".
297 pack("nC10",
298 12, # length
299 3, # number of components
300 1,0x00, # Scan 1: use DC/AC huff tables 0/0
301 2,0x11, # Scan 2: use DC/AC huff tables 1/1
302 3,0x11, # Scan 3: use DC/AC huff tables 1/1
303 0,0x3f, # Ss, Se
304 0, # Ah, Ai (not used)
305 );
306
307 if ( $dump_jpeg ) {
308 print "## created JPEG header...\n";
309 hex_dump( $header, 0 );
310 }
311
312 my $frame = join('', @subframes ) . $data;
313 @subframes = ();
314
315 my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
316
317 my $fh;
318 if ( $jpegtran ) {
319 open($fh, '|-', "jpegtran $jpegtran > $path") || die "can't create $path: $!";
320 } else {
321 open($fh, '>', $path) || die "can't create $path: $!";
322 }
323
324 if ( ! $no_jpeg_header ) {
325 print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
326 } else {
327 print $fh $frame || die "can't write raw jpeg $path: $!";
328 }
329 close $fh || die "can't close $path: $!";
330 print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
331 }
332
333 #
334 # IMA ADPCM decoder
335 #
336
337 my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
338
339 my @step_size = (
340 7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
341 19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
342 50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
343 130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
344 337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
345 876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
346 2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
347 5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
348 15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
349 );
350
351 my $pred_val = 0;
352 my $step_idx = 0;
353
354 # This code is "borrowed" from the ALSA library
355 # http://www.alsa-project.org
356
357 sub adpcm_decode_sample {
358 my $code = shift;
359
360 my $pred_diff; # Predicted difference to next sample
361 my $step; # holds previous step_size value
362
363 # Separate sign and magnitude
364 my $sign = $code & 0x8;
365 $code &= 0x7;
366
367 # Computes pred_diff = (code + 0.5) * step / 4,
368 # but see comment in adpcm_coder.
369
370 $step = $step_size[$step_idx] || die "no step_size[$step_idx]";
371
372 # Compute difference and new predicted value
373 $pred_diff = $step >> 3;
374 my $i = 0x4;
375 while( $i ) {
376 if ($code & $i) {
377 $pred_diff += $step;
378 }
379 $i >>= 1;
380 $step >>= 1;
381 }
382 $pred_val += $sign ? -$pred_diff : $pred_diff;
383
384 # Clamp output value
385 if ($pred_val > 32767) {
386 $pred_val = 32767;
387 } elsif ($pred_val < -32768) {
388 $pred_val = -32768;
389 }
390
391 # Find new step_size index value
392 $step_idx += $index_adjust[$code];
393
394 if ($step_idx < 0) {
395 $step_idx = 0;
396 } elsif ($step_idx > 88) {
397 $step_idx = 88;
398 }
399 return $pred_val;
400 }
401
402 my $au_path = "$dump_dir/sound.au";
403 open(my $au_fh, '>', $au_path) || die "can't open $au_path: $!";
404 print $au_fh pack 'a4N5', (
405 # magic
406 '.snd',
407 # data offset
408 24,
409 # data size
410 -1,
411 # encoding - 16-bit linear PCM
412 3,
413 # sample rate
414 22050,
415 #channels
416 1,
417 );
418
419 sub audio_frame {
420 my $data = shift || die "no data?";
421
422 my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
423
424 $pred_val = $origin;
425 $step_idx = $index;
426
427 my $size = 0;
428
429 foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
430 print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );
431 print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );
432 $size += 2;
433 }
434
435 warn "length isn't corrent $bytes != $size" if $debug && $bytes != $size;
436 }
437
438 #
439 # read AMV file
440 #
441
442 my ( $riff, $amv ) = x(12, 'Z4x4Z4');
443 die "$path not RIFF but $riff" if $riff ne 'RIFF';
444 die "$path not AMV but $amv" if $amv ne 'AMV ';
445
446 my $fps = 16;
447 my $duration;
448
449 while ( ! defined($d->{eof}) ) {
450 my ( $list, $name ) = x(12,'A4x4A4');
451 die "not LIST but $list" if $list ne 'LIST';
452 print "< $list * $name\n" if $verbose;
453
454 if ( $name eq 'hdrl' ) {
455
456 my $len = next_part( 'amvh', hex(38) );
457
458 my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
459 my $h;
460 map {
461 my $v = $_;
462 my $n = shift @names || die "no more names?";
463 $h->{$n} = $v;
464 } x($len, 'Vx28VVVx8CCv');
465
466 $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
467
468 printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
469 $path,
470 $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
471 $duration;
472
473 $d->{amvh} = $h;
474 $fps = $h->{fps};
475
476 } elsif ( $name eq 'strl' ) {
477
478 next_part( 'strh', 0, 1 );
479 next_part( 'strf', 0, 1 );
480
481 } elsif ( $name eq 'movi' ) {
482
483 my $have_parts = 1;
484
485 while ( $have_parts ) {
486 my $frame = $d->{movi}++;
487
488 my $parts = 0;
489
490 while ( $parts < 2 ) {
491
492 my ( $len, $part ) = next_part();
493
494 if ( ! $len ) {
495 $have_parts = 0;
496 last;
497 }
498
499 if ( $part eq '00dc' ) {
500
501 printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
502 mkjpg( x($len) );
503 $parts++;
504
505 } elsif ( $part eq '01wb' ) {
506 printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
507
508 my $audio_frame = x( $len );
509
510 if ( $dump_audio ) {
511 printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
512 hex_dump( $audio_frame );
513 }
514
515 # print $audio_fh mp3_frame;
516 audio_frame( $audio_frame );
517
518 $parts++;
519 } else {
520 warn "unknown next part $part with $len bytes, skipping!";
521 }
522
523 warn "## #$frame_nr $name $part has $parts parts\n" if $debug;
524 }
525
526 $frame_nr++;
527
528 if ( $frame_nr % $fps == 0 ) {
529 print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
530 print ".";
531 }
532 };
533
534 } else {
535 die "unknown $list $name";
536 }
537 }
538
539 if ( $fps == 12 ) {
540 warn "fixup $au_path for $fps fps -- 16000 Hz\n";
541 seek($au_fh, 16, 0); # sample rate offset
542 print $au_fh pack 'N', 16000;
543 }
544
545 my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
546 system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
547
548 print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26