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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26