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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26