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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26