Line # Revision Author
1 3 dpavlin #!/usr/bin/perl -w
2
3 # amv.pl
4 #
5 # 07/19/07 19:21:39 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6 7 dpavlin #
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 8 dpavlin # http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11 # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12 3 dpavlin
13 use strict;
14
15 use Data::Dump qw/dump/;
16 use Carp qw/confess/;
17 8 dpavlin use File::Path;
18 15 dpavlin use Getopt::Long;
19 3 dpavlin
20 8 dpavlin my $dump = 0;
21 my $debug = 0;
22 15 dpavlin my $dump_dir = '/tmp/dump/';
23 20 dpavlin my $dump_avi = "dump.avi";
24 19 dpavlin my $no_jpeg_header = 0;
25 my $jpeg_q = 100;
26 8 dpavlin
27 15 dpavlin GetOptions(
28 "dump!" => \$dump,
29 "debug!" => \$debug,
30 "dump-dir=s" => \$dump_dir,
31 19 dpavlin "no-jpeg-headers!" => \$no_jpeg_header,
32 15 dpavlin );
33
34 3 dpavlin my $path = shift @ARGV || die "usage: $0 movie.amv\n";
35
36 15 dpavlin
37 11 dpavlin rmtree $dump_dir if -e $dump_dir;
38 mkpath $dump_dir || die "can't create $dump_dir: $!";
39 8 dpavlin
40 3 dpavlin open(my $fh, '<', $path) || die "can't open $path: $!";
41
42 4 dpavlin # offset in file
43 my $o = 0;
44
45 # shared data hash
46 my $d;
47
48 3 dpavlin sub hex_dump {
49 8 dpavlin return unless $dump;
50 3 dpavlin
51 8 dpavlin 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 3 dpavlin my $ascii = $bytes;
61 $ascii =~ s/\W/./gs;
62 8 dpavlin my $hex = uc( unpack('h*', $bytes) );
63 3 dpavlin $hex =~ s/(..)/$1 /g;
64 # calculate number of characters for offset
65 4 dpavlin #my $d = length( sprintf("%x",length($bytes)) );
66 my $d = 4;
67 6 dpavlin my $prefix = '#.';
68 3 dpavlin while ( $hex =~ s/^((?:\w\w\s){1,16})// ) {
69 6 dpavlin printf "$prefix %0${d}x | %-48s| %s\n", $o, $1, substr( $ascii, 0, 16 );
70 $prefix = '##';
71 3 dpavlin if ( length($ascii) >= 16 ) {
72 $ascii = substr( $ascii, 16 );
73 4 dpavlin $o += 16;
74 3 dpavlin } else {
75 4 dpavlin $o += length($ascii);
76 3 dpavlin last;
77 }
78 }
79 8 dpavlin
80 $o = $old_o if $old_o;
81 3 dpavlin }
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 4 dpavlin if ( $bytes eq 'AMV_END_' ) {
95 19 dpavlin print "> end of file marker AMV_END_\n" if $dump;
96 4 dpavlin $d->{eof}++;
97 return;
98 }
99
100 3 dpavlin if ( $format ) {
101 my @data = unpack($format, $bytes);
102 19 dpavlin print "## unpacked = ",dump(@data),"\n" if $debug;
103 3 dpavlin 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 4 dpavlin return unless $len;
113 3 dpavlin 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 8 dpavlin printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;
118 3 dpavlin x($len) if $skip;
119 return $len;
120 }
121
122 19 dpavlin sub quality {
123 my @table = @_;
124 die "quantization matrice needs to have 64 bytes!" if $#table != 63;
125 3 dpavlin
126 19 dpavlin my $in = join('', map { chr($_) } @table );
127 my $out;
128 8 dpavlin
129 19 dpavlin 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 8 dpavlin }
144
145 19 dpavlin my @subframes;
146 my $frame_nr = 1;
147
148 # how many subframes to join into single frame?
149 my $join_subframes = 0;
150
151 8 dpavlin sub mkjpg {
152 19 dpavlin my ($data) = @_;
153 8 dpavlin
154 confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8";
155 19 dpavlin confess "no EOI marker in data" if substr($data,-2,2) ne "\xFF\xD9";
156 $data = substr($data,2,-2);
157 8 dpavlin
158 19 dpavlin 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 16 dpavlin my $w = $d->{amvh}->{width} || die "no width?";
169 my $h = $d->{amvh}->{height} || confess "no height?";
170
171 8 dpavlin my $header =
172 19 dpavlin # Start of Image (SOI) marker
173 "\xFF\xD8".
174 # JFIF marker
175 "\xFF\xE0".
176 8 dpavlin pack("nZ5CCCnnCC",
177 16, # length
178 19 dpavlin 'JFIF', # identifier (JFIF)
179 8 dpavlin 1,1, # version
180 0, # units (none)
181 1,1, # X,Y density
182 0,0, # X,Y thumbnail
183 ).
184 19 dpavlin "\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 8 dpavlin pack("ncnncc9",
218 17, # len
219 8, # sample precision in bits
220 16 dpavlin $h,$w, # X,Y size
221 8 dpavlin 3, # number of components
222 19 dpavlin 1,0x22,0, # Component ID, H+V sampling factors, Quantization table number
223 11 dpavlin 2,0x11,1,
224 3,0x11,1,
225 8 dpavlin ).
226 11 dpavlin # Define huffman table (section B.2.4.1)
227 13 dpavlin "\xFF\xC4". # Marker
228 "\x00\x1F". # Length (31 bytes)
229 14 dpavlin "\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 13 dpavlin # Define huffman table (section B.2.4.1)
233 "\xFF\xC4". # Marker
234 "\x00\xB5". # Length (181 bytes)
235 14 dpavlin "\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 13 dpavlin "\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 19 dpavlin # 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 13 dpavlin #/* Define huffman table (section B.2.4.1) */
259 14 dpavlin "\xFF\xC4". # Marker
260 "\x00\xB5". # Length (181 bytes)
261 "\x11". # AC chrominance, table 1
262 13 dpavlin "\x00\x02\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04".
263 14 dpavlin "\x00\x01\x02\x77".
264 "\x00\x01\x02\x03\x11\x04\x05\x21".
265 13 dpavlin "\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 19 dpavlin # 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 8 dpavlin
290 11 dpavlin if ( $dump ) {
291 19 dpavlin print "## created JPEG header...\n";
292 11 dpavlin hex_dump( $header, 0 );
293 }
294 8 dpavlin
295 19 dpavlin 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 8 dpavlin close $fh || die "can't close $path: $!";
304 19 dpavlin print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n";
305 8 dpavlin }
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 4 dpavlin while ( ! defined($d->{eof}) ) {
312 3 dpavlin my ( $list, $name ) = x(12,'A4x4A4');
313 die "not LIST but $list" if $list ne 'LIST';
314 8 dpavlin print "< $list * $name\n";
315 3 dpavlin
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 8 dpavlin $path,
330 3 dpavlin $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 4 dpavlin } elsif ( $name eq 'movi' ) {
341
342 while (1) {
343 my $frame = $d->{movi}++;
344
345 8 dpavlin my $len = next_part( '00dc' );
346 4 dpavlin last unless $len;
347 8 dpavlin printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;
348 19 dpavlin mkjpg( x($len) );
349 4 dpavlin
350 8 dpavlin $len = next_part( '01wb', 0, 1 );
351 printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;
352 4 dpavlin };
353
354 3 dpavlin } else {
355 die "unknown $list $name";
356 }
357 }
358 20 dpavlin
359 my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 $dump_avi";
360 system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
361