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