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