/[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

Diff of /amv.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 19 by dpavlin, Sat Jul 21 15:03:30 2007 UTC revision 28 by dpavlin, Sun Aug 19 11:45:39 2007 UTC
# Line 9  Line 9 
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  # http://www.obrador.com/essentialjpeg/HeaderInfo.htm
11  # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html  # http://lists.helixcommunity.org/pipermail/datatype-dev/2005-January/001886.html
12    # http://mpgedit.org/mpgedit/mpeg_format/mpeghdr.htm
13    # http://wiki.multimedia.cx/index.php?title=IMA_ADPCM
14    
15  use strict;  use strict;
16    
# Line 17  use Carp qw/confess/; Line 19  use Carp qw/confess/;
19  use File::Path;  use File::Path;
20  use Getopt::Long;  use Getopt::Long;
21    
22  my $dump = 0;  my $dump_amv = 0;
23    my $dump_video = 0;
24    my $dump_jpeg = 0;
25    my $dump_audio = 0;
26  my $debug = 0;  my $debug = 0;
27    my $verbose = 0;
28  my $dump_dir = '/tmp/dump/';  my $dump_dir = '/tmp/dump/';
29    my $dump_avi = "dump.avi";
30  my $no_jpeg_header = 0;  my $no_jpeg_header = 0;
31  my $jpeg_q = 100;  my $jpeg_q = 100;
32    my $jpegtran;
33    
34  GetOptions(  GetOptions(
35          "dump!"                 => \$dump,          "dump-amv!"             => \$dump_amv,
36            "dump-video!"   => \$dump_video,
37            "dump-jpeg!"    => \$dump_jpeg,
38            "dump-audio!"   => \$dump_audio,
39          "debug!"                => \$debug,          "debug!"                => \$debug,
40          "dump-dir=s"    => \$dump_dir,          "dump-dir=s"    => \$dump_dir,
41          "no-jpeg-headers!" => \$no_jpeg_header,          "no-jpeg-headers!" => \$no_jpeg_header,
42            "jpegtran=s"    => \$jpegtran,
43            "verbose!"              => \$verbose,
44  );  );
45    
46  my $path = shift @ARGV || die "usage: $0 movie.amv\n";  my $path = shift @ARGV || die "usage: $0 movie.amv\n";
47    
48    # by default, flip frames
49    #$jpegtran = '-flip vertical' unless defined($jpegtran);
50    
51  rmtree $dump_dir if -e $dump_dir;  rmtree $dump_dir if -e $dump_dir;
52  mkpath $dump_dir || die "can't create $dump_dir: $!";  mkpath $dump_dir || die "can't create $dump_dir: $!";
# Line 45  my $o = 0; Line 60  my $o = 0;
60  my $d;  my $d;
61    
62  sub hex_dump {  sub hex_dump {
         return unless $dump;  
   
63          my ( $bytes, $offset ) = @_;          my ( $bytes, $offset ) = @_;
64          return unless $bytes;          return unless $bytes;
65    
# Line 88  sub x { Line 101  sub x {
101          my $r_len = length($bytes);          my $r_len = length($bytes);
102          confess "read $r_len bytes, expected $len" if $len != $r_len;          confess "read $r_len bytes, expected $len" if $len != $r_len;
103    
104          hex_dump( $bytes );          if ( $dump_amv ) {
105                    print "## raw $len bytes\n";
106                    hex_dump( $bytes );
107            }
108    
109          if ( $bytes eq 'AMV_END_' ) {          if ( $bytes eq 'AMV_END_' ) {
110                  print "> end of file marker AMV_END_\n" if $dump;                  print "> end of file marker AMV_END_\n" if $dump_video;
111                  $d->{eof}++;                  $d->{eof}++;
112                  return;                  return;
113          }          }
# Line 113  sub next_part { Line 129  sub next_part {
129          if ( $expected_len ) {          if ( $expected_len ) {
130                  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;
131          }          }
132          printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;          printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
133          x($len) if $skip;          x($len) if $skip;
134          return $len;          return $len;
135  }  }
# Line 131  sub quality { Line 147  sub quality {
147                  $out .= chr($t);                  $out .= chr($t);
148          }          }
149    
150          if ( $dump ) {          if ( $dump_video ) {
151                  print "## quantization table original\n";                  print "## quantization table original\n";
152                  hex_dump( $in );                  hex_dump( $in );
153                  print "## quantization table for $jpeg_q %\n";                  print "## quantization table for $jpeg_q %\n";
# Line 141  sub quality { Line 157  sub quality {
157          return $out;          return $out;
158  }  }
159    
160    sub mp3_frame {
161            my $frame = join('',
162                    # Frame sync (all bits set)
163                    1 x 11 .
164                    # MPEG Audio version ID
165                    # 00 - MPEG Version 2.5 (unofficial)
166                    # 01 - reserved
167                    # 10 - MPEG Version 2 (ISO/IEC 13818-3)
168                    # 11 - MPEG Version 1 (ISO/IEC 11172-3)
169                    1,0,
170                    # Layer description
171                    # 00 - reserved
172                    # 01 - Layer III
173                    # 10 - Layer II
174                    # 11 - Layer I
175                    0,1,
176                    # Protection bit
177                    # 0 - Protected by CRC (16bit crc follows header)
178                    # 1 - Not protected
179                    0,
180                    # Bitrate index
181                    0,0,0,0,
182                    # Sampling rate frequency index (22050)
183                    0,0,
184                    # Padding bit
185                    # 0 - frame is not padded
186                    # 1 - frame is padded with one extra slot
187                    0,
188                    # Private bit
189                    0,
190                    # Channel Mode
191                    # 00 - Stereo
192                    # 01 - Joint stereo (Stereo)
193                    # 10 - Dual channel (2 mono channels)
194                    # 11 - Single channel (Mono)
195                    1,1,
196                    # Mode extension (Only if Joint stereo)
197                    0,0,
198                    # Copyright
199                    0,
200                    # Original
201                    0,
202                    # Emphasis
203                    # 00 - none
204                    # 01 - 50/15 ms
205                    # 10 - reserved
206                    # 11 - CCIT J.17
207                    0,0,
208            );
209    
210            die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;
211    
212            my $bits = pack("b32", $frame);
213    
214            die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;
215    
216            my $t = $frame;
217            $t =~ s/(.{8})/$1 /g;
218            warn "## mp3 frame frame = $t\n";
219    
220            return $bits;
221    }
222    
223  my @subframes;  my @subframes;
224  my $frame_nr = 1;  my $frame_nr = 1;
225    
# Line 156  sub mkjpg { Line 235  sub mkjpg {
235    
236          if ( $#subframes < ( $join_subframes - 1 ) ) {          if ( $#subframes < ( $join_subframes - 1 ) ) {
237                  push @subframes, $data;                  push @subframes, $data;
238                  print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n";                  print "## saved $frame_nr/", $#subframes + 1, " subframe of ", length($data), " bytes\n" if $debug;
239                  return;                  return;
240          }          }
241    
         my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr++ );  
   
         open(my $fh, '>', $path) || die "can't create $path: $!";  
   
242          my $w = $d->{amvh}->{width} || die "no width?";          my $w = $d->{amvh}->{width} || die "no width?";
243          my $h = $d->{amvh}->{height} || confess "no height?";          my $h = $d->{amvh}->{height} || confess "no height?";
244    
# Line 286  sub mkjpg { Line 361  sub mkjpg {
361                  0,                      # Ah, Ai (not used)                  0,                      # Ah, Ai (not used)
362          );          );
363    
364          if ( $dump ) {          if ( $dump_jpeg ) {
365                  print "## created JPEG header...\n";                  print "## created JPEG header...\n";
366                  hex_dump( $header, 0 );                  hex_dump( $header, 0 );
367          }          }
# Line 294  sub mkjpg { Line 369  sub mkjpg {
369          my $frame = join('', @subframes ) . $data;          my $frame = join('', @subframes ) . $data;
370          @subframes = ();          @subframes = ();
371    
372            my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
373    
374            my $fh;
375            if ( $jpegtran ) {
376                    open($fh, '|-', "jpegtran $jpegtran > $path") || die "can't create $path: $!";
377            } else {
378                    open($fh, '>', $path) || die "can't create $path: $!";
379            }
380    
381          if ( ! $no_jpeg_header ) {          if ( ! $no_jpeg_header ) {
382                  print $fh $header, $frame, "\xFF\xD9" || die "can't write jpeg $path: $!";                  print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
383          } else {          } else {
384                  print $fh $frame || die "can't write raw jpeg $path: $!";                  print $fh $frame || die "can't write raw jpeg $path: $!";
385          }          }
386          close $fh || die "can't close $path: $!";          close $fh || die "can't close $path: $!";
387          print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n";          print ">> created $frame_nr ", $no_jpeg_header ? 'raw' : '', " jpeg $path ", -s $path, " bytes\n" if $verbose;
388  }  }
389    
390    #
391    # IMA ADPCM decoder
392    #
393    
394    my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
395    
396    my @step_size = (
397            7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
398            19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
399            50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
400            130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
401            337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
402            876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
403            2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
404            5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
405            15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
406    );
407    
408    my $pred_val = 0;
409    my $step_idx = 0;
410    
411    # This code is "borrowed" from the ALSA library
412    # http://www.alsa-project.org
413    
414    sub adpcm_decode_sample {
415            my $code = shift;
416    
417            my $pred_diff;  # Predicted difference to next sample
418            my $step;               # holds previous step_size value
419    
420            # Separate sign and magnitude
421            my $sign = $code & 0x8;
422            $code &= 0x7;
423    
424            # Computes pred_diff = (code + 0.5) * step / 4,
425            # but see comment in adpcm_coder.
426    
427            $step = $step_size[$step_idx] || die "no step_size[$step_idx]";
428    
429            # Compute difference and new predicted value
430            $pred_diff = $step >> 3;
431            my $i = 0x4;
432            while( $i ) {
433                    if ($code & $i) {
434                            $pred_diff += $step;
435                    }
436                    $i >>= 1;
437                    $step >>= 1;
438            }
439            $pred_val += $sign ? -$pred_diff : $pred_diff;
440    
441            # Clamp output value
442            if ($pred_val > 32767) {
443                    $pred_val = 32767;
444            } elsif ($pred_val < -32768) {
445                    $pred_val = -32768;
446            }
447    
448            # Find new step_size index value
449            $step_idx += $index_adjust[$code];
450    
451            if ($step_idx < 0) {
452                    $step_idx = 0;
453            } elsif ($step_idx > 88) {
454                    $step_idx = 88;
455            }
456            return $pred_val;
457    }
458    
459    open(my $au_fh, '>', 'out.au') || die "can't open out.au: $!";
460    print $au_fh pack 'a4N5', (
461            # magic
462            '.snd',
463            # data offset
464            24,
465            # data size
466            -1,
467            # encoding - 16-bit linear PCM
468            3,
469            # sample rate
470            22050,
471            #channels
472            1,
473    );
474    
475    sub audio_frame {
476            my $data = shift || die "no data?";
477    
478            my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
479    
480    warn "audio_frame origin $origin index $index bytes $bytes\n";
481    hex_dump( substr($data,0,8) );
482    
483            $pred_val = $origin;
484            $step_idx = $index;
485    
486            foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
487                    print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );          
488                    print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );          
489            }
490    }
491    
492    
493    sub x_audio_frame {
494            my $data = shift || die "no data?";
495    
496            my $apath = sprintf("$dump_dir/%04d.wav", $frame_nr );
497            open(my $audio_fh, '>', $apath) || die "can't open audio file $apath: $!";
498    
499            print $audio_fh pack 'a4Va4a4VvvVVv4', (
500                    # header 'RIFF', size
501                    'RIFF',-1,
502                    # type: 'WAVE'
503                    'WAVE',
504                    'fmt ',0x14,
505                    # format: DVI (IMA) ADPCM Wave Type
506                    0x11,
507                    # channels
508                    1,
509                    # samples/sec
510                    22050,
511                    # avg. bytes/sec (for esimation)
512                    11567,
513                    # block align (size of block)
514                    0x800,
515                    # bits per sample (mono data)
516                    4,
517                    # cbSize (ADPCM with 7 soefficient pairs)
518                    2,
519                    # nSamplesPerBlock
520                    # (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
521                    0x03f9,
522            );
523    
524            print $audio_fh pack 'a4VVa4V', (
525                    # time length of the data in samples
526                    'fact',4,
527                    220500,
528                    #
529                    'data',-1,
530            );
531    
532            my $riff_header_len = tell($audio_fh);
533    
534            print $audio_fh $data;
535    
536            my $size = tell($audio_fh);
537            warn "## wav file $apath size: $size\n";
538    
539            seek( $audio_fh, 4, 0 );
540            print $audio_fh pack("V", $size - 8);
541            seek( $audio_fh, $riff_header_len - 4, 0 );
542            print $audio_fh pack("V", $size - $riff_header_len);
543    
544            close($audio_fh) || die "can't close audio file $apath: $!";
545    }
546    
547    #
548    # read AMV file
549    #
550    
551  my ( $riff, $amv ) = x(12, 'Z4x4Z4');  my ( $riff, $amv ) = x(12, 'Z4x4Z4');
552  die "$path not RIFF but $riff" if $riff ne 'RIFF';  die "$path not RIFF but $riff" if $riff ne 'RIFF';
553  die "$path not AMV but $amv" if $amv ne 'AMV ';  die "$path not AMV but $amv" if $amv ne 'AMV ';
# Line 310  die "$path not AMV but $amv" if $amv ne Line 555  die "$path not AMV but $amv" if $amv ne
555  while ( ! defined($d->{eof}) ) {  while ( ! defined($d->{eof}) ) {
556          my ( $list, $name ) = x(12,'A4x4A4');          my ( $list, $name ) = x(12,'A4x4A4');
557          die "not LIST but $list" if $list ne 'LIST';          die "not LIST but $list" if $list ne 'LIST';
558          print "< $list * $name\n";          print "< $list * $name\n" if $verbose;
559    
560          if ( $name eq 'hdrl' ) {          if ( $name eq 'hdrl' ) {
561    
# Line 343  while ( ! defined($d->{eof}) ) { Line 588  while ( ! defined($d->{eof}) ) {
588                                    
589                          my $len = next_part( '00dc' );                          my $len = next_part( '00dc' );
590                          last unless $len;                          last unless $len;
591                          printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;                          printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
592                          mkjpg( x($len) );                          mkjpg( x($len) );
593    
594                          $len = next_part( '01wb', 0, 1 );                          $len = next_part( '01wb' );
595                          printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;                          printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
596    
597                            my $audio_frame = x( $len );
598    
599                            if ( $dump_audio ) {
600                                    printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
601                                    hex_dump( $audio_frame );
602                            }
603    
604                            # remove 8 bytes of something
605    #                       $audio_frame = substr( $audio_frame, 8 );
606    
607                            if ( length($audio_frame) % 2 == 0 ) {
608                                    print "#### even sized frame!";
609    #                               $audio_frame = substr( $audio_frame, 0, -1 );
610                            }
611    
612    #                       print $audio_fh mp3_frame;
613                            audio_frame( $audio_frame );
614    
615                            $frame_nr++;
616                  };                  };
617    
618          } else {          } else {
619                  die "unknown $list $name";                  die "unknown $list $name";
620          }          }
621  }  }
622    
623    my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -y $dump_avi";
624    system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
625    
626    print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";
Legend:
Removed from v.19  
changed lines
  Added in v.28
  ViewVC Help
Powered by ViewVC 1.1.26