/[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 24 - (hide annotations)
Sun Jul 22 11:05:47 2007 UTC (11 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 13068 byte(s)
attempt to decode audio: implement mp3 and riff/wav file generation. Audio *seems* to
be DVD/IMA ADPC, but I don't know what to do with extra 8 bytes in each audio frame.
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 3
14     use strict;
15    
16     use Data::Dump qw/dump/;
17     use Carp qw/confess/;
18 dpavlin 8 use File::Path;
19 dpavlin 15 use Getopt::Long;
20 dpavlin 3
21 dpavlin 8 my $dump = 0;
22     my $debug = 0;
23 dpavlin 24 my $verbose = 0;
24 dpavlin 15 my $dump_dir = '/tmp/dump/';
25 dpavlin 20 my $dump_avi = "dump.avi";
26 dpavlin 19 my $no_jpeg_header = 0;
27     my $jpeg_q = 100;
28 dpavlin 24 my $jpegtran;
29 dpavlin 8
30 dpavlin 15 GetOptions(
31     "dump!" => \$dump,
32     "debug!" => \$debug,
33     "dump-dir=s" => \$dump_dir,
34 dpavlin 19 "no-jpeg-headers!" => \$no_jpeg_header,
35 dpavlin 24 "jpegtran=s" => \$jpegtran,
36     "verbose!" => \$verbose,
37 dpavlin 15 );
38    
39 dpavlin 3 my $path = shift @ARGV || die "usage: $0 movie.amv\n";
40    
41 dpavlin 24 # by default, flip frames
42     #$jpegtran = '-flip vertical' unless defined($jpegtran);
43 dpavlin 15
44 dpavlin 11 rmtree $dump_dir if -e $dump_dir;
45     mkpath $dump_dir || die "can't create $dump_dir: $!";
46 dpavlin 8
47 dpavlin 3 open(my $fh, '<', $path) || die "can't open $path: $!";
48    
49 dpavlin 4 # offset in file
50     my $o = 0;
51    
52     # shared data hash
53     my $d;
54    
55 dpavlin 3 sub hex_dump {
56 dpavlin 8 return unless $dump;
57 dpavlin 3
58 dpavlin 8 my ( $bytes, $offset ) = @_;
59     return unless $bytes;
60    
61     my $old_o;
62     if (defined($offset)) {
63     $old_o = $o;
64     $o = $offset;
65     }
66    
67 dpavlin 3 my $ascii = $bytes;
68     $ascii =~ s/\W/./gs;
69 dpavlin 8 my $hex = uc( unpack('h*', $bytes) );
70 dpavlin 3 $hex =~ s/(..)/$1 /g;
71     # calculate number of characters for offset
72 dpavlin 4 #my $d = length( sprintf("%x",length($bytes)) );
73     my $d = 4;
74 dpavlin 6 my $prefix = '#.';
75 dpavlin 3 while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
76 dpavlin 6 printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
77     $prefix = '##';
78 dpavlin 3 if ( length($ascii) >= 16 ) {
79     $ascii = substr( $ascii, 16 );
80 dpavlin 4 $o += 16;
81 dpavlin 3 } else {
82 dpavlin 4 $o += length($ascii);
83 dpavlin 3 last;
84     }
85     }
86 dpavlin 8
87     $o = $old_o if $old_o;
88 dpavlin 3 }
89    
90     sub x {
91     my ($len,$format) = @_;
92    
93     my $bytes;
94     read($fh, $bytes, $len);
95    
96     my $r_len = length($bytes);
97     confess "read $r_len bytes, expected $len" if $len != $r_len;
98    
99     hex_dump( $bytes );
100    
101 dpavlin 4 if ( $bytes eq 'AMV_END_' ) {
102 dpavlin 19 print "> end of file marker AMV_END_\n" if $dump;
103 dpavlin 4 $d->{eof}++;
104     return;
105     }
106    
107 dpavlin 3 if ( $format ) {
108     my @data = unpack($format, $bytes);
109 dpavlin 19 print "## unpacked = ",dump(@data),"\n" if $debug;
110 dpavlin 3 return @data;
111     } else {
112     return $bytes;
113     }
114     }
115    
116     sub next_part {
117     my ( $expected_part, $expected_len, $skip ) = @_;
118     my ( $part, $len ) = x(8,'A4V');
119 dpavlin 4 return unless $len;
120 dpavlin 3 confess "not $expected_part but $part" if $expected_part ne $part;
121     if ( $expected_len ) {
122     confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
123     }
124 dpavlin 24 printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
125 dpavlin 3 x($len) if $skip;
126     return $len;
127     }
128    
129 dpavlin 19 sub quality {
130     my @table = @_;
131     die "quantization matrice needs to have 64 bytes!" if $#table != 63;
132 dpavlin 3
133 dpavlin 19 my $in = join('', map { chr($_) } @table );
134     my $out;
135 dpavlin 8
136 dpavlin 19 foreach my $t ( @table ) {
137     $t = int( ( $t * $jpeg_q ) / 100 );
138     $t = 255 if $t > 255;
139     $out .= chr($t);
140     }
141    
142     if ( $dump ) {
143     print "## quantization table original\n";
144     hex_dump( $in );
145     print "## quantization table for $jpeg_q %\n";
146     hex_dump( $out );
147     }
148    
149     return $out;
150 dpavlin 8 }
151    
152 dpavlin 24 sub mp3_frame {
153     my $frame = join('',
154     # Frame sync (all bits set)
155     1 x 11 .
156     # MPEG Audio version ID
157     # 00 - MPEG Version 2.5 (unofficial)
158     # 01 - reserved
159     # 10 - MPEG Version 2 (ISO/IEC 13818-3)
160     # 11 - MPEG Version 1 (ISO/IEC 11172-3)
161     1,0,
162     # Layer description
163     # 00 - reserved
164     # 01 - Layer III
165     # 10 - Layer II
166     # 11 - Layer I
167     0,1,
168     # Protection bit
169     # 0 - Protected by CRC (16bit crc follows header)
170     # 1 - Not protected
171     0,
172     # Bitrate index
173     0,0,0,0,
174     # Sampling rate frequency index (22050)
175     0,0,
176     # Padding bit
177     # 0 - frame is not padded
178     # 1 - frame is padded with one extra slot
179     0,
180     # Private bit
181     0,
182     # Channel Mode
183     # 00 - Stereo
184     # 01 - Joint stereo (Stereo)
185     # 10 - Dual channel (2 mono channels)
186     # 11 - Single channel (Mono)
187     1,1,
188     # Mode extension (Only if Joint stereo)
189     0,0,
190     # Copyright
191     0,
192     # Original
193     0,
194     # Emphasis
195     # 00 - none
196     # 01 - 50/15 ms
197     # 10 - reserved
198     # 11 - CCIT J.17
199     0,0,
200     );
201    
202     die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;
203    
204     my $bits = pack("b32", $frame);
205    
206     die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;
207    
208     my $t = $frame;
209     $t =~ s/(.{8})/$1 /g;
210     warn "## mp3 frame frame = $t\n";
211    
212     return $bits;
213     }
214    
215 dpavlin 19 my @subframes;
216     my $frame_nr = 1;
217    
218     # how many subframes to join into single frame?
219     my $join_subframes = 0;
220    
221 dpavlin 8 sub mkjpg {
222 dpavlin 19 my ($data) = @_;
223 dpavlin 8
224     confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
225 dpavlin 19 confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
226     $data = substr($data,2,-2);
227 dpavlin 8
228 dpavlin 19 if ( $#subframes < ( $join_subframes - 1 ) ) {
229     push @subframes, $data;
230 dpavlin 24 print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
231 dpavlin 19 return;
232     }
233    
234 dpavlin 16 my $w = $d->{amvh}->{width} || die "no width?";
235     my $h = $d->{amvh}->{height} || confess "no height?";
236    
237 dpavlin 8 my $header =
238 dpavlin 19 # Start of Image (SOI) marker
239     "\xFF\xD8".
240     # JFIF marker
241     "\xFF\xE0".
242 dpavlin 8 pack("nZ5CCCnnCC",
243     16, # length
244 dpavlin 19 'JFIF', # identifier (JFIF)
245 dpavlin 8 1,1, # version
246     0, # units (none)
247     1,1, # X,Y density
248     0,0, # X,Y thumbnail
249     ).
250 dpavlin 19 "\xFF\xFE".
251     "\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
252     # quantization table (quaility=100%)
253     "\xFF\xDB".
254     "\x00\x43".
255     # 8 bit values, table 1
256     "\x00".
257     quality(
258     0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
259     0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
260     0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
261     0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
262     0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
263     0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
264     0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
265     0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
266     ).
267     "\xFF\xDB".
268     "\x00\x43".
269     # 8 bit values, table 1
270     "\x01".
271     quality(
272     0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
273     0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
274     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
275     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
276     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
277     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
278     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
279     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
280     ).
281     # start of frame
282     "\xFF\xC0".
283 dpavlin 8 pack("ncnncc9",
284     17, # len
285     8, # sample precision in bits
286 dpavlin 16 $h,$w, # X,Y size
287 dpavlin 8 3, # number of components
288 dpavlin 19 1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
289 dpavlin 11 2,0x11,1,
290     3,0x11,1,
291 dpavlin 8 ).
292 dpavlin 11 # Define huffman table (section B.2.4.1)
293 dpavlin 13 "\xFF\xC4". # Marker
294     "\x00\x1F". # Length (31 bytes)
295 dpavlin 14 "\x00". # DC luminance, table 0
296     "\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
297     "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
298 dpavlin 13 # Define huffman table (section B.2.4.1)
299     "\xFF\xC4". # Marker
300     "\x00\xB5". # Length (181 bytes)
301 dpavlin 14 "\x10". # AC luminance, table 0
302     "\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
303     "\x01\x02\x03\x00\x04\x11\x05\x12".
304 dpavlin 13 "\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
305     "\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
306     "\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
307     "\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
308     "\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
309     "\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
310     "\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
311     "\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
312     "\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
313     "\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
314     "\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
315     "\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
316     "\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
317 dpavlin 19 # Define huffman table (section B.2.4.1)
318     "\xFF\xC4". # Marker
319     "\x00\x1F". # Length (31 bytes)
320     "\x01". # DC chrominance, table 1
321     "\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
322     "\x00\x00\x00\x00".
323     "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
324 dpavlin 13 #/* Define huffman table (section B.2.4.1) */
325 dpavlin 14 "\xFF\xC4". # Marker
326     "\x00\xB5". # Length (181 bytes)
327     "\x11". # AC chrominance, table 1
328 dpavlin 13 "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
329 dpavlin 14 "\x00\x01\x02\x77".
330     "\x00\x01\x02\x03\x11\x04\x05\x21".
331 dpavlin 13 "\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
332     "\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
333     "\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
334     "\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
335     "\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
336     "\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
337     "\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
338     "\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
339     "\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
340     "\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
341     "\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
342     "\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
343     "\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
344 dpavlin 19 # Start of Scan marker
345     "\xFF\xDA".
346     pack("nC10",
347     12, # length
348     3, # number of components
349     1,0x00, # Scan 1: use DC/AC huff tables 0/0
350     2,0x11, # Scan 2: use DC/AC huff tables 1/1
351     3,0x11, # Scan 3: use DC/AC huff tables 1/1
352     0,0x3f, # Ss, Se
353     0, # Ah, Ai (not used)
354     );
355 dpavlin 8
356 dpavlin 11 if ( $dump ) {
357 dpavlin 19 print "## created JPEG header...\n";
358 dpavlin 11 hex_dump( $header, 0 );
359     }
360 dpavlin 8
361 dpavlin 19 my $frame = join('', @subframes ) . $data;
362     @subframes = ();
363    
364 dpavlin 24 my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
365 dpavlin 23
366     my $fh;
367     if ( $jpegtran ) {
368     open($fh, '|-', "jpegtran $jpegtran > $path") || die "can't create $path: $!";
369     } else {
370     open($fh, '>', $path) || die "can't create $path: $!";
371     }
372    
373 dpavlin 19 if ( ! $no_jpeg_header ) {
374 dpavlin 23 print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
375 dpavlin 19 } else {
376     print $fh $frame || die "can't write raw jpeg $path: $!";
377     }
378 dpavlin 8 close $fh || die "can't close $path: $!";
379 dpavlin 24 print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
380 dpavlin 8 }
381    
382     my ( $riff, $amv ) = x(12, 'Z4x4Z4');
383     die "$path not RIFF but $riff" if $riff ne 'RIFF';
384     die "$path not AMV but $amv" if $amv ne 'AMV ';
385    
386 dpavlin 24 my $apath = "$dump_dir/audio.wav";
387     open(my $audio_fh, '>', $apath) || die "can't open audio file $apath: $!";
388    
389     print $audio_fh pack 'a4Va4a4VvvVVv4', (
390     # header 'RIFF', size
391     'RIFF',-1,
392     # type: 'WAVE'
393     'WAVE',
394     'fmt ',0x14,
395     # format: DVI (IMA) ADPCM Wave Type
396     0x11,
397     # channels
398     1,
399     # samples/sec
400     22050,
401     # avg. bytes/sec (for esimation)
402     11567,
403     # block align (size of block)
404     0x800,
405     # bits per sample (mono data)
406     4,
407     # cbSize (ADPCM with 7 soefficient pairs)
408     2,
409     # nSamplesPerBlock
410     # (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
411     0x0ff9,
412     );
413    
414     print $audio_fh pack 'a4VVa4V', (
415     # time length of the data in samples
416     'fact',4,
417     220500,
418     #
419     'data',-1,
420     );
421    
422     my $riff_header_len = tell($audio_fh);
423    
424 dpavlin 4 while ( ! defined($d->{eof}) ) {
425 dpavlin 3 my ( $list, $name ) = x(12,'A4x4A4');
426     die "not LIST but $list" if $list ne 'LIST';
427 dpavlin 24 print "< $list * $name\n" if $verbose;
428 dpavlin 3
429     if ( $name eq 'hdrl' ) {
430    
431     my $len = next_part( 'amvh', hex(38) );
432    
433     my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
434     my $h;
435     map {
436     my $v = $_;
437     my $n = shift @names || die "no more names?";
438     $h->{$n} = $v;
439     } x($len, 'Vx28VVVx8CCv');
440    
441     printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",
442 dpavlin 8 $path,
443 dpavlin 3 $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
444     $h->{hh}, $h->{mm}, $h->{ss};
445    
446     $d->{amvh} = $h;
447    
448     } elsif ( $name eq 'strl' ) {
449    
450     next_part( 'strh', 0, 1 );
451     next_part( 'strf', 0, 1 );
452    
453 dpavlin 4 } elsif ( $name eq 'movi' ) {
454    
455     while (1) {
456     my $frame = $d->{movi}++;
457    
458 dpavlin 8 my $len = next_part( '00dc' );
459 dpavlin 4 last unless $len;
460 dpavlin 24 printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
461 dpavlin 19 mkjpg( x($len) );
462 dpavlin 4
463 dpavlin 24 $len = next_part( '01wb' );
464     printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
465    
466     my $audio_frame = x( $len );
467    
468     # remove 8 bytes of something
469     $audio_frame = substr( $audio_frame, 8 );
470    
471     if ( length($audio_frame) % 2 == 0 ) {
472     print "#### even sized frame!";
473     # $audio_frame = substr( $audio_frame, 0, -1 );
474     }
475    
476     if ( $dump ) {
477     print "#### dumping audio frame ", length($audio_frame), " bytes\n";
478     hex_dump( $audio_frame );
479     }
480    
481     # print $audio_fh mp3_frame;
482     print $audio_fh $audio_frame || die "can't write audio frame in $apath: $!";
483    
484     $frame_nr++;
485 dpavlin 4 };
486    
487 dpavlin 3 } else {
488     die "unknown $list $name";
489     }
490     }
491 dpavlin 20
492 dpavlin 23 my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -y $dump_avi";
493 dpavlin 20 system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
494    
495 dpavlin 24 my $size = tell($audio_fh);
496     warn "## wav file size: $size\n";
497    
498     seek( $audio_fh, 4, 0 );
499     print $audio_fh pack("V", $size - 8);
500     seek( $audio_fh, $riff_header_len - 4, 0 );
501     print $audio_fh pack("V", $size - $riff_header_len);
502    
503     close($audio_fh) || die "can't close audio file $apath: $!";
504    
505     print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, " and $apath ", -s $apath, "\n";

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26