/[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 21 - (hide annotations)
Sat Jul 21 15:17:48 2007 UTC (11 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 9776 byte(s)
overwrite existing dump.avi
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 3
13     use strict;
14    
15     use Data::Dump qw/dump/;
16     use Carp qw/confess/;
17 dpavlin 8 use File::Path;
18 dpavlin 15 use Getopt::Long;
19 dpavlin 3
20 dpavlin 8 my $dump = 0;
21     my $debug = 0;
22 dpavlin 15 my $dump_dir = '/tmp/dump/';
23 dpavlin 20 my $dump_avi = "dump.avi";
24 dpavlin 19 my $no_jpeg_header = 0;
25     my $jpeg_q = 100;
26 dpavlin 8
27 dpavlin 15 GetOptions(
28     "dump!" => \$dump,
29     "debug!" => \$debug,
30     "dump-dir=s" => \$dump_dir,
31 dpavlin 19 "no-jpeg-headers!" => \$no_jpeg_header,
32 dpavlin 15 );
33    
34 dpavlin 3 my $path = shift @ARGV || die "usage: $0 movie.amv\n";
35    
36 dpavlin 15
37 dpavlin 11 rmtree $dump_dir if -e $dump_dir;
38     mkpath $dump_dir || die "can't create $dump_dir: $!";
39 dpavlin 8
40 dpavlin 3 open(my $fh, '<', $path) || die "can't open $path: $!";
41    
42 dpavlin 4 # offset in file
43     my $o = 0;
44    
45     # shared data hash
46     my $d;
47    
48 dpavlin 3 sub hex_dump {
49 dpavlin 8 return unless $dump;
50 dpavlin 3
51 dpavlin 8 my ( $bytes, $offset ) = @_;
52     return unless $bytes;
53    
54     my $old_o;
55     if (defined($offset)) {
56     $old_o = $o;
57     $o = $offset;
58     }
59    
60 dpavlin 3 my $ascii = $bytes;
61     $ascii =~ s/\W/./gs;
62 dpavlin 8 my $hex = uc( unpack('h*', $bytes) );
63 dpavlin 3 $hex =~ s/(..)/$1 /g;
64     # calculate number of characters for offset
65 dpavlin 4 #my $d = length( sprintf("%x",length($bytes)) );
66     my $d = 4;
67 dpavlin 6 my $prefix = '#.';
68 dpavlin 3 while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
69 dpavlin 6 printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
70     $prefix = '##';
71 dpavlin 3 if ( length($ascii) >= 16 ) {
72     $ascii = substr( $ascii, 16 );
73 dpavlin 4 $o += 16;
74 dpavlin 3 } else {
75 dpavlin 4 $o += length($ascii);
76 dpavlin 3 last;
77     }
78     }
79 dpavlin 8
80     $o = $old_o if $old_o;
81 dpavlin 3 }
82    
83     sub x {
84     my ($len,$format) = @_;
85    
86     my $bytes;
87     read($fh, $bytes, $len);
88    
89     my $r_len = length($bytes);
90     confess "read $r_len bytes, expected $len" if $len != $r_len;
91    
92     hex_dump( $bytes );
93    
94 dpavlin 4 if ( $bytes eq 'AMV_END_' ) {
95 dpavlin 19 print "> end of file marker AMV_END_\n" if $dump;
96 dpavlin 4 $d->{eof}++;
97     return;
98     }
99    
100 dpavlin 3 if ( $format ) {
101     my @data = unpack($format, $bytes);
102 dpavlin 19 print "## unpacked = ",dump(@data),"\n" if $debug;
103 dpavlin 3 return @data;
104     } else {
105     return $bytes;
106     }
107     }
108    
109     sub next_part {
110     my ( $expected_part, $expected_len, $skip ) = @_;
111     my ( $part, $len ) = x(8,'A4V');
112 dpavlin 4 return unless $len;
113 dpavlin 3 confess "not $expected_part but $part" if $expected_part ne $part;
114     if ( $expected_len ) {
115     confess "expected $expected_len bytes for $part got $len" if $len != $expected_len;
116     }
117 dpavlin 8 printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;
118 dpavlin 3 x($len) if $skip;
119     return $len;
120     }
121    
122 dpavlin 19 sub quality {
123     my @table = @_;
124     die "quantization matrice needs to have 64 bytes!" if $#table != 63;
125 dpavlin 3
126 dpavlin 19 my $in = join('', map { chr($_) } @table );
127     my $out;
128 dpavlin 8
129 dpavlin 19 foreach my $t ( @table ) {
130     $t = int( ( $t * $jpeg_q ) / 100 );
131     $t = 255 if $t > 255;
132     $out .= chr($t);
133     }
134    
135     if ( $dump ) {
136     print "## quantization table original\n";
137     hex_dump( $in );
138     print "## quantization table for $jpeg_q %\n";
139     hex_dump( $out );
140     }
141    
142     return $out;
143 dpavlin 8 }
144    
145 dpavlin 19 my @subframes;
146     my $frame_nr = 1;
147    
148     # how many subframes to join into single frame?
149     my $join_subframes = 0;
150    
151 dpavlin 8 sub mkjpg {
152 dpavlin 19 my ($data) = @_;
153 dpavlin 8
154     confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
155 dpavlin 19 confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
156     $data = substr($data,2,-2);
157 dpavlin 8
158 dpavlin 19 if ( $#subframes < ( $join_subframes - 1 ) ) {
159     push @subframes, $data;
160     print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n";
161     return;
162     }
163    
164     my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr++ );
165    
166     open(my $fh, '>', $path) || die "can't create $path: $!";
167    
168 dpavlin 16 my $w = $d->{amvh}->{width} || die "no width?";
169     my $h = $d->{amvh}->{height} || confess "no height?";
170    
171 dpavlin 8 my $header =
172 dpavlin 19 # Start of Image (SOI) marker
173     "\xFF\xD8".
174     # JFIF marker
175     "\xFF\xE0".
176 dpavlin 8 pack("nZ5CCCnnCC",
177     16, # length
178 dpavlin 19 'JFIF', # identifier (JFIF)
179 dpavlin 8 1,1, # version
180     0, # units (none)
181     1,1, # X,Y density
182     0,0, # X,Y thumbnail
183     ).
184 dpavlin 19 "\xFF\xFE".
185     "\x00\x3CCREATOR: amv dumper (compat. IJG JPEG v62), quality = 100\n".
186     # quantization table (quaility=100%)
187     "\xFF\xDB".
188     "\x00\x43".
189     # 8 bit values, table 1
190     "\x00".
191     quality(
192     0x10, 0x0B, 0x0C, 0x0E, 0x0C, 0x0A, 0x10, 0x0E,
193     0x0D, 0x0E, 0x12, 0x11, 0x10, 0x13, 0x18, 0x28,
194     0x1A, 0x18, 0x16, 0x16, 0x18, 0x31, 0x23, 0x25,
195     0x1D, 0x28, 0x3A, 0x33, 0x3D, 0x3C, 0x39, 0x33,
196     0x38, 0x37, 0x40, 0x48, 0x5C, 0x4E, 0x40, 0x44,
197     0x57, 0x45, 0x37, 0x38, 0x50, 0x6D, 0x51, 0x57,
198     0x5F, 0x62, 0x67, 0x68, 0x67, 0x3E, 0x4D, 0x71,
199     0x79, 0x70, 0x64, 0x78, 0x5C, 0x65, 0x67, 0x63,
200     ).
201     "\xFF\xDB".
202     "\x00\x43".
203     # 8 bit values, table 1
204     "\x01".
205     quality(
206     0x11, 0x12, 0x12, 0x18, 0x15, 0x18, 0x2F, 0x1A,
207     0x1A, 0x2F, 0x63, 0x42, 0x38, 0x42, 0x63, 0x63,
208     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
209     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
210     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
211     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
212     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
213     0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63, 0x63,
214     ).
215     # start of frame
216     "\xFF\xC0".
217 dpavlin 8 pack("ncnncc9",
218     17, # len
219     8, # sample precision in bits
220 dpavlin 16 $h,$w, # X,Y size
221 dpavlin 8 3, # number of components
222 dpavlin 19 1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
223 dpavlin 11 2,0x11,1,
224     3,0x11,1,
225 dpavlin 8 ).
226 dpavlin 11 # Define huffman table (section B.2.4.1)
227 dpavlin 13 "\xFF\xC4". # Marker
228     "\x00\x1F". # Length (31 bytes)
229 dpavlin 14 "\x00". # DC luminance, table 0
230     "\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00\x00\x00".
231     "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
232 dpavlin 13 # Define huffman table (section B.2.4.1)
233     "\xFF\xC4". # Marker
234     "\x00\xB5". # Length (181 bytes)
235 dpavlin 14 "\x10". # AC luminance, table 0
236     "\x00\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D".
237     "\x01\x02\x03\x00\x04\x11\x05\x12".
238 dpavlin 13 "\x21\x31\x41\x06\x13\x51\x61\x07\x22\x71\x14\x32".
239     "\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52\xD1\xF0".
240     "\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A".
241     "\x25\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39".
242     "\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54\x55".
243     "\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68\x69".
244     "\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83\x84\x85".
245     "\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98".
246     "\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2".
247     "\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5".
248     "\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6\xD7\xD8".
249     "\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA".
250     "\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
251 dpavlin 19 # Define huffman table (section B.2.4.1)
252     "\xFF\xC4". # Marker
253     "\x00\x1F". # Length (31 bytes)
254     "\x01". # DC chrominance, table 1
255     "\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00".
256     "\x00\x00\x00\x00".
257     "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B".
258 dpavlin 13 #/* Define huffman table (section B.2.4.1) */
259 dpavlin 14 "\xFF\xC4". # Marker
260     "\x00\xB5". # Length (181 bytes)
261     "\x11". # AC chrominance, table 1
262 dpavlin 13 "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
263 dpavlin 14 "\x00\x01\x02\x77".
264     "\x00\x01\x02\x03\x11\x04\x05\x21".
265 dpavlin 13 "\x31\x06\x12\x41\x51\x07\x61\x71\x13\x22\x32\x81".
266     "\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52\xF0".
267     "\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17".
268     "\x18\x19\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38".
269     "\x39\x3A\x43\x44\x45\x46\x47\x48\x49\x4A\x53\x54".
270     "\x55\x56\x57\x58\x59\x5A\x63\x64\x65\x66\x67\x68".
271     "\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82\x83".
272     "\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96".
273     "\x97\x98\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9".
274     "\xAA\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xC2\xC3".
275     "\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3\xD4\xD5\xD6".
276     "\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9".
277     "\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA".
278 dpavlin 19 # Start of Scan marker
279     "\xFF\xDA".
280     pack("nC10",
281     12, # length
282     3, # number of components
283     1,0x00, # Scan 1: use DC/AC huff tables 0/0
284     2,0x11, # Scan 2: use DC/AC huff tables 1/1
285     3,0x11, # Scan 3: use DC/AC huff tables 1/1
286     0,0x3f, # Ss, Se
287     0, # Ah, Ai (not used)
288     );
289 dpavlin 8
290 dpavlin 11 if ( $dump ) {
291 dpavlin 19 print "## created JPEG header...\n";
292 dpavlin 11 hex_dump( $header, 0 );
293     }
294 dpavlin 8
295 dpavlin 19 my $frame = join('', @subframes ) . $data;
296     @subframes = ();
297    
298     if ( ! $no_jpeg_header ) {
299     print $fh $header, $frame, "\xFF\xD9" || die "can't write jpeg $path: $!";
300     } else {
301     print $fh $frame || die "can't write raw jpeg $path: $!";
302     }
303 dpavlin 8 close $fh || die "can't close $path: $!";
304 dpavlin 19 print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n";
305 dpavlin 8 }
306    
307     my ( $riff, $amv ) = x(12, 'Z4x4Z4');
308     die "$path not RIFF but $riff" if $riff ne 'RIFF';
309     die "$path not AMV but $amv" if $amv ne 'AMV ';
310    
311 dpavlin 4 while ( ! defined($d->{eof}) ) {
312 dpavlin 3 my ( $list, $name ) = x(12,'A4x4A4');
313     die "not LIST but $list" if $list ne 'LIST';
314 dpavlin 8 print "< $list * $name\n";
315 dpavlin 3
316     if ( $name eq 'hdrl' ) {
317    
318     my $len = next_part( 'amvh', hex(38) );
319    
320     my @names = ( qw/ms_per_frame width height fps ss mm hh/ );
321     my $h;
322     map {
323     my $v = $_;
324     my $n = shift @names || die "no more names?";
325     $h->{$n} = $v;
326     } x($len, 'Vx28VVVx8CCv');
327    
328     printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",
329 dpavlin 8 $path,
330 dpavlin 3 $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
331     $h->{hh}, $h->{mm}, $h->{ss};
332    
333     $d->{amvh} = $h;
334    
335     } elsif ( $name eq 'strl' ) {
336    
337     next_part( 'strh', 0, 1 );
338     next_part( 'strf', 0, 1 );
339    
340 dpavlin 4 } elsif ( $name eq 'movi' ) {
341    
342     while (1) {
343     my $frame = $d->{movi}++;
344    
345 dpavlin 8 my $len = next_part( '00dc' );
346 dpavlin 4 last unless $len;
347 dpavlin 8 printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;
348 dpavlin 19 mkjpg( x($len) );
349 dpavlin 4
350 dpavlin 8 $len = next_part( '01wb', 0, 1 );
351     printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;
352 dpavlin 4 };
353    
354 dpavlin 3 } else {
355     die "unknown $list $name";
356     }
357     }
358 dpavlin 20
359 dpavlin 21 my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -f $dump_avi";
360 dpavlin 20 system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
361    

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26