7 |
# Various useful links used to produce this: |
# Various useful links used to produce this: |
8 |
# http://www.moviecodec.com/topics/15431p1.html |
# http://www.moviecodec.com/topics/15431p1.html |
9 |
# http://en.wikipedia.org/wiki/RIFF_(File_format) |
# 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; |
use strict; |
14 |
|
|
15 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
16 |
use Carp qw/confess/; |
use Carp qw/confess/; |
17 |
|
use File::Path; |
18 |
|
|
19 |
|
my $dump = 0; |
20 |
|
my $debug = 0; |
21 |
|
|
22 |
my $path = shift @ARGV || die "usage: $0 movie.amv\n"; |
my $path = shift @ARGV || die "usage: $0 movie.amv\n"; |
23 |
|
|
24 |
|
my $dump_dir = '/tmp/dump/'; |
25 |
|
if ( ! -e $dump_dir ) { |
26 |
|
mkpath $dump_dir || die "can't create $dump_dir: $!"; |
27 |
|
} |
28 |
|
|
29 |
open(my $fh, '<', $path) || die "can't open $path: $!"; |
open(my $fh, '<', $path) || die "can't open $path: $!"; |
30 |
|
|
31 |
# offset in file |
# offset in file |
35 |
my $d; |
my $d; |
36 |
|
|
37 |
sub hex_dump { |
sub hex_dump { |
38 |
my $bytes = shift || return; |
return unless $dump; |
39 |
|
|
40 |
|
my ( $bytes, $offset ) = @_; |
41 |
|
return unless $bytes; |
42 |
|
|
43 |
|
my $old_o; |
44 |
|
if (defined($offset)) { |
45 |
|
$old_o = $o; |
46 |
|
$o = $offset; |
47 |
|
} |
48 |
|
|
49 |
my $ascii = $bytes; |
my $ascii = $bytes; |
50 |
$ascii =~ s/\W/./gs; |
$ascii =~ s/\W/./gs; |
51 |
my $hex = unpack('h*', $bytes); |
my $hex = uc( unpack('h*', $bytes) ); |
52 |
$hex =~ s/(..)/$1 /g; |
$hex =~ s/(..)/$1 /g; |
53 |
# calculate number of characters for offset |
# calculate number of characters for offset |
54 |
#my $d = length( sprintf("%x",length($bytes)) ); |
#my $d = length( sprintf("%x",length($bytes)) ); |
65 |
last; |
last; |
66 |
} |
} |
67 |
} |
} |
68 |
|
|
69 |
|
$o = $old_o if $old_o; |
70 |
} |
} |
71 |
|
|
72 |
sub x { |
sub x { |
88 |
|
|
89 |
if ( $format ) { |
if ( $format ) { |
90 |
my @data = unpack($format, $bytes); |
my @data = unpack($format, $bytes); |
91 |
warn "## unpacked = ",dump(@data),"\n"; |
warn "## unpacked = ",dump(@data),"\n" if $debug; |
92 |
return @data; |
return @data; |
93 |
} else { |
} else { |
94 |
return $bytes; |
return $bytes; |
103 |
if ( $expected_len ) { |
if ( $expected_len ) { |
104 |
confess "expected $expected_len bytes for $part got $len" if $len != $expected_len; |
confess "expected $expected_len bytes for $part got $len" if $len != $expected_len; |
105 |
} |
} |
106 |
printf ">> %s - %d 0x%x bytes\n", $part, $len, $len; |
printf "<< %s - %d 0x%x bytes\n", $part, $len, $len; |
107 |
x($len) if $skip; |
x($len) if $skip; |
108 |
return $len; |
return $len; |
109 |
} |
} |
110 |
|
|
111 |
my ( $riff, $amv ) = x(12, 'Z8Z4'); |
sub huffman { |
112 |
die "not RIFF but $riff" if $riff ne 'RIFF'; |
|
113 |
die "not AMV but $amv" if $amv ne 'AMV '; |
# JPEG DHT Segment for YCrCb omitted from MJPG data |
114 |
|
return |
115 |
|
"\xFF\xC4\x01\xA2" . |
116 |
|
"\x00\x00\x01\x05\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00\x00" . |
117 |
|
"\x00\x00\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x01" . |
118 |
|
"\x00\x03\x01\x01\x01\x01\x01\x01\x01\x01\x01\x00\x00\x00\x00" . |
119 |
|
"\x00\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0A\x0B\x10\x00" . |
120 |
|
"\x02\x01\x03\x03\x02\x04\x03\x05\x05\x04\x04\x00\x00\x01\x7D" . |
121 |
|
"\x01\x02\x03\x00\x04\x11\x05\x12\x21\x31\x41\x06\x13\x51\x61" . |
122 |
|
"\x07\x22\x71\x14\x32\x81\x91\xA1\x08\x23\x42\xB1\xC1\x15\x52" . |
123 |
|
"\xD1\xF0\x24\x33\x62\x72\x82\x09\x0A\x16\x17\x18\x19\x1A\x25" . |
124 |
|
"\x26\x27\x28\x29\x2A\x34\x35\x36\x37\x38\x39\x3A\x43\x44\x45" . |
125 |
|
"\x46\x47\x48\x49\x4A\x53\x54\x55\x56\x57\x58\x59\x5A\x63\x64" . |
126 |
|
"\x65\x66\x67\x68\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x83" . |
127 |
|
"\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98\x99" . |
128 |
|
"\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2\xB3\xB4\xB5\xB6" . |
129 |
|
"\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2\xD3" . |
130 |
|
"\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8" . |
131 |
|
"\xE9\xEA\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\x11\x00\x02" . |
132 |
|
"\x01\x02\x04\x04\x03\x04\x07\x05\x04\x04\x00\x01\x02\x77\x00" . |
133 |
|
"\x01\x02\x03\x11\x04\x05\x21\x31\x06\x12\x41\x51\x07\x61\x71" . |
134 |
|
"\x13\x22\x32\x81\x08\x14\x42\x91\xA1\xB1\xC1\x09\x23\x33\x52" . |
135 |
|
"\xF0\x15\x62\x72\xD1\x0A\x16\x24\x34\xE1\x25\xF1\x17\x18\x19" . |
136 |
|
"\x1A\x26\x27\x28\x29\x2A\x35\x36\x37\x38\x39\x3A\x43\x44\x45" . |
137 |
|
"\x46\x47\x48\x49\x4A\x53\x54\x55\x56\x57\x58\x59\x5A\x63\x64" . |
138 |
|
"\x65\x66\x67\x68\x69\x6A\x73\x74\x75\x76\x77\x78\x79\x7A\x82" . |
139 |
|
"\x83\x84\x85\x86\x87\x88\x89\x8A\x92\x93\x94\x95\x96\x97\x98" . |
140 |
|
"\x99\x9A\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xB2\xB3\xB4\xB5" . |
141 |
|
"\xB6\xB7\xB8\xB9\xBA\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xD2" . |
142 |
|
"\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xE2\xE3\xE4\xE5\xE6\xE7\xE8" . |
143 |
|
"\xE9\xEA\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA"; |
144 |
|
|
145 |
|
} |
146 |
|
|
147 |
|
sub mkjpg { |
148 |
|
my ($path,$data) = @_; |
149 |
|
open(my $fh, '>', $path) || die "can't create $path: $!"; |
150 |
|
|
151 |
|
confess "no SOI marker in data" if substr($data,0,2) ne "\xFF\xD8"; |
152 |
|
$data = substr($data,2); |
153 |
|
|
154 |
|
my $header = |
155 |
|
"\xFF\xD8". # Start of Image (SOI) marker |
156 |
|
#------------------------------------------------------------------ |
157 |
|
"\xFF\xE0". # JFIF marker |
158 |
|
pack("nZ5CCCnnCC", |
159 |
|
16, # length |
160 |
|
'JFIF', # identifier |
161 |
|
1,1, # version |
162 |
|
0, # units (none) |
163 |
|
1,1, # X,Y density |
164 |
|
0,0, # X,Y thumbnail |
165 |
|
). |
166 |
|
#------------------------------------------------------------------ |
167 |
|
"\xFF\xDB". # Define Quantization table marker |
168 |
|
"\x00\x43". # len |
169 |
|
"\x00". # the precision and the quantization table index |
170 |
|
"\x00" x 64 . |
171 |
|
#------------------------------------------------------------------ |
172 |
|
"\xFF\xC0". # Start of frame |
173 |
|
pack("ncnncc9", |
174 |
|
17, # len |
175 |
|
8, # sample precision in bits |
176 |
|
120,160, # X,Y size |
177 |
|
3, # number of components |
178 |
|
1,0x22,0, # Component ID, H+V sampling factors, Quantization table number |
179 |
|
2,0x11,0, |
180 |
|
3,0x11,0, |
181 |
|
). |
182 |
|
#------------------------------------------------------------------ |
183 |
|
# huffman("\x00"). # 0 DC |
184 |
|
huffman("\x01"). # 1 DC |
185 |
|
# huffman("\x10"). # 0 AC |
186 |
|
# huffman("\x11"). # 1 AC |
187 |
|
#------------------------------------------------------------------ |
188 |
|
"\xFF\xDA". # Start of Scan marker |
189 |
|
pack("nC11", |
190 |
|
12, # length |
191 |
|
3, # number of components |
192 |
|
1,0, # components DC+AC table numbers |
193 |
|
2,17, |
194 |
|
3,17, |
195 |
|
0,63, # Ss, Se |
196 |
|
0,165, # Ah, Ai |
197 |
|
); |
198 |
|
#------------------------------------------------------------------ |
199 |
|
|
200 |
|
|
201 |
|
warn "## created JPEG header...", dump( $header ); |
202 |
|
hex_dump( $header, 0 ); |
203 |
|
|
204 |
|
print $fh $header . $data || die "can't write frame into $path: $!"; |
205 |
|
close $fh || die "can't close $path: $!"; |
206 |
|
print ">> created $path ", -s $path, " bytes\n"; |
207 |
|
} |
208 |
|
|
209 |
|
my ( $riff, $amv ) = x(12, 'Z4x4Z4'); |
210 |
|
die "$path not RIFF but $riff" if $riff ne 'RIFF'; |
211 |
|
die "$path not AMV but $amv" if $amv ne 'AMV '; |
212 |
|
|
213 |
while ( ! defined($d->{eof}) ) { |
while ( ! defined($d->{eof}) ) { |
214 |
my ( $list, $name ) = x(12,'A4x4A4'); |
my ( $list, $name ) = x(12,'A4x4A4'); |
215 |
die "not LIST but $list" if $list ne 'LIST'; |
die "not LIST but $list" if $list ne 'LIST'; |
216 |
print "> $list .. $name\n"; |
print "< $list * $name\n"; |
217 |
|
|
218 |
if ( $name eq 'hdrl' ) { |
if ( $name eq 'hdrl' ) { |
219 |
|
|
228 |
} x($len, 'Vx28VVVx8CCv'); |
} x($len, 'Vx28VVVx8CCv'); |
229 |
|
|
230 |
printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n", |
printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n", |
231 |
$h->{path}, |
$path, |
232 |
$h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame}, |
$h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame}, |
233 |
$h->{hh}, $h->{mm}, $h->{ss}; |
$h->{hh}, $h->{mm}, $h->{ss}; |
234 |
|
|
244 |
while (1) { |
while (1) { |
245 |
my $frame = $d->{movi}++; |
my $frame = $d->{movi}++; |
246 |
|
|
247 |
my $len = next_part( '00dc', 0, 1 ); |
my $len = next_part( '00dc' ); |
248 |
last unless $len; |
last unless $len; |
249 |
printf ">> %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len; |
printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len; |
250 |
|
mkjpg( sprintf("$dump_dir/%03d.jpg", $frame ), x($len) ); |
251 |
|
|
252 |
my $len = next_part( '01wb', 0, 1 ); |
$len = next_part( '01wb', 0, 1 ); |
253 |
printf ">> %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len; |
printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len; |
254 |
}; |
}; |
255 |
|
|
256 |
} else { |
} else { |