/[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 21 by dpavlin, Sat Jul 21 15:17:48 2007 UTC revision 31 by dpavlin, Mon Oct 1 16:34:08 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";  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: $!";
53    
54    $| = 1;
55    
56  open(my $fh, '<', $path) || die "can't open $path: $!";  open(my $fh, '<', $path) || die "can't open $path: $!";
57    
58  # offset in file  # offset in file
# Line 46  my $o = 0; Line 62  my $o = 0;
62  my $d;  my $d;
63    
64  sub hex_dump {  sub hex_dump {
         return unless $dump;  
   
65          my ( $bytes, $offset ) = @_;          my ( $bytes, $offset ) = @_;
66          return unless $bytes;          return unless $bytes;
67    
# Line 89  sub x { Line 103  sub x {
103          my $r_len = length($bytes);          my $r_len = length($bytes);
104          confess "read $r_len bytes, expected $len" if $len != $r_len;          confess "read $r_len bytes, expected $len" if $len != $r_len;
105    
106          hex_dump( $bytes );          if ( $dump_amv ) {
107                    print "## raw $len bytes\n";
108                    hex_dump( $bytes );
109            }
110    
111          if ( $bytes eq 'AMV_END_' ) {          if ( $bytes eq 'AMV_END_' ) {
112                  print "> end of file marker AMV_END_\n" if $dump;                  print "> end of file marker AMV_END_\n" if $dump_video;
113                  $d->{eof}++;                  $d->{eof}++;
114                  return;                  return;
115          }          }
# Line 106  sub x { Line 123  sub x {
123          }          }
124  }  }
125    
126    # my $len = next_part( 'boob' );
127    # my ( $len, $part ) = next_part();
128    
129  sub next_part {  sub next_part {
130          my ( $expected_part, $expected_len, $skip ) = @_;          my ( $expected_part, $expected_len, $skip ) = @_;
131          my ( $part, $len ) = x(8,'A4V');          my ( $part, $len ) = x(8,'A4V');
132          return unless $len;          return unless $len;
133          confess "not $expected_part but $part" if $expected_part ne $part;          confess "not $expected_part but $part" if $expected_part && $expected_part ne $part;
134          if ( $expected_len ) {          if ( $expected_len ) {
135                  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;
136          }          }
137          printf "<< %s - %d 0x%x bytes\n", $part, $len, $len;          printf "## next_part %s - %d 0x%x bytes\n", $part, $len, $len if $debug;
138          x($len) if $skip;          x($len) if $skip;
139            return ( $len, $part )  if wantarray;
140          return $len;          return $len;
141  }  }
142    
# Line 132  sub quality { Line 153  sub quality {
153                  $out .= chr($t);                  $out .= chr($t);
154          }          }
155    
156          if ( $dump ) {          if ( $dump_video ) {
157                  print "## quantization table original\n";                  print "## quantization table original\n";
158                  hex_dump( $in );                  hex_dump( $in );
159                  print "## quantization table for $jpeg_q %\n";                  print "## quantization table for $jpeg_q %\n";
# Line 142  sub quality { Line 163  sub quality {
163          return $out;          return $out;
164  }  }
165    
166    =for obsolete
167    
168    sub mp3_frame {
169            my $frame = join('',
170                    # Frame sync (all bits set)
171                    1 x 11 .
172                    # MPEG Audio version ID
173                    # 00 - MPEG Version 2.5 (unofficial)
174                    # 01 - reserved
175                    # 10 - MPEG Version 2 (ISO/IEC 13818-3)
176                    # 11 - MPEG Version 1 (ISO/IEC 11172-3)
177                    1,0,
178                    # Layer description
179                    # 00 - reserved
180                    # 01 - Layer III
181                    # 10 - Layer II
182                    # 11 - Layer I
183                    0,1,
184                    # Protection bit
185                    # 0 - Protected by CRC (16bit crc follows header)
186                    # 1 - Not protected
187                    0,
188                    # Bitrate index
189                    0,0,0,0,
190                    # Sampling rate frequency index (22050)
191                    0,0,
192                    # Padding bit
193                    # 0 - frame is not padded
194                    # 1 - frame is padded with one extra slot
195                    0,
196                    # Private bit
197                    0,
198                    # Channel Mode
199                    # 00 - Stereo
200                    # 01 - Joint stereo (Stereo)
201                    # 10 - Dual channel (2 mono channels)
202                    # 11 - Single channel (Mono)
203                    1,1,
204                    # Mode extension (Only if Joint stereo)
205                    0,0,
206                    # Copyright
207                    0,
208                    # Original
209                    0,
210                    # Emphasis
211                    # 00 - none
212                    # 01 - 50/15 ms
213                    # 10 - reserved
214                    # 11 - CCIT J.17
215                    0,0,
216            );
217    
218            die "frame must have 32 bits, not ", length($frame), " for $frame" if length($frame) != 32;
219    
220            my $bits = pack("b32", $frame);
221    
222            die "packed bits must be 4 bytes, not $bits" if length($bits) != 4;
223    
224            my $t = $frame;
225            $t =~ s/(.{8})/$1 /g;
226            warn "## mp3 frame frame = $t\n";
227    
228            return $bits;
229    }
230    
231    =cut
232    
233  my @subframes;  my @subframes;
234  my $frame_nr = 1;  my $frame_nr = 1;
235    
# Line 157  sub mkjpg { Line 245  sub mkjpg {
245    
246          if ( $#subframes < ( $join_subframes - 1 ) ) {          if ( $#subframes < ( $join_subframes - 1 ) ) {
247                  push @subframes, $data;                  push @subframes, $data;
248                  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;
249                  return;                  return;
250          }          }
251    
         my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr++ );  
   
         open(my $fh, '>', $path) || die "can't create $path: $!";  
   
252          my $w = $d->{amvh}->{width} || die "no width?";          my $w = $d->{amvh}->{width} || die "no width?";
253          my $h = $d->{amvh}->{height} || confess "no height?";          my $h = $d->{amvh}->{height} || confess "no height?";
254    
# Line 287  sub mkjpg { Line 371  sub mkjpg {
371                  0,                      # Ah, Ai (not used)                  0,                      # Ah, Ai (not used)
372          );          );
373    
374          if ( $dump ) {          if ( $dump_jpeg ) {
375                  print "## created JPEG header...\n";                  print "## created JPEG header...\n";
376                  hex_dump( $header, 0 );                  hex_dump( $header, 0 );
377          }          }
# Line 295  sub mkjpg { Line 379  sub mkjpg {
379          my $frame = join('', @subframes ) . $data;          my $frame = join('', @subframes ) . $data;
380          @subframes = ();          @subframes = ();
381    
382            my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
383    
384            my $fh;
385            if ( $jpegtran ) {
386                    open($fh, '|-', "jpegtran $jpegtran > $path") || die "can't create $path: $!";
387            } else {
388                    open($fh, '>', $path) || die "can't create $path: $!";
389            }
390    
391          if ( ! $no_jpeg_header ) {          if ( ! $no_jpeg_header ) {
392                  print $fh $header, $frame, "\xFF\xD9" || die "can't write jpeg $path: $!";                  print $fh $header . $frame . "\xFF\xD9" || die "can't write jpeg $path: $!";
393          } else {          } else {
394                  print $fh $frame || die "can't write raw jpeg $path: $!";                  print $fh $frame || die "can't write raw jpeg $path: $!";
395          }          }
396          close $fh || die "can't close $path: $!";          close $fh || die "can't close $path: $!";
397          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;
398    }
399    
400    #
401    # IMA ADPCM decoder
402    #
403    
404    my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
405    
406    my @step_size = (
407            7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
408            19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
409            50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
410            130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
411            337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
412            876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
413            2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
414            5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
415            15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
416    );
417    
418    my $pred_val = 0;
419    my $step_idx = 0;
420    
421    # This code is "borrowed" from the ALSA library
422    # http://www.alsa-project.org
423    
424    sub adpcm_decode_sample {
425            my $code = shift;
426    
427            my $pred_diff;  # Predicted difference to next sample
428            my $step;               # holds previous step_size value
429    
430            # Separate sign and magnitude
431            my $sign = $code & 0x8;
432            $code &= 0x7;
433    
434            # Computes pred_diff = (code + 0.5) * step / 4,
435            # but see comment in adpcm_coder.
436    
437            $step = $step_size[$step_idx] || die "no step_size[$step_idx]";
438    
439            # Compute difference and new predicted value
440            $pred_diff = $step >> 3;
441            my $i = 0x4;
442            while( $i ) {
443                    if ($code & $i) {
444                            $pred_diff += $step;
445                    }
446                    $i >>= 1;
447                    $step >>= 1;
448            }
449            $pred_val += $sign ? -$pred_diff : $pred_diff;
450    
451            # Clamp output value
452            if ($pred_val > 32767) {
453                    $pred_val = 32767;
454            } elsif ($pred_val < -32768) {
455                    $pred_val = -32768;
456            }
457    
458            # Find new step_size index value
459            $step_idx += $index_adjust[$code];
460    
461            if ($step_idx < 0) {
462                    $step_idx = 0;
463            } elsif ($step_idx > 88) {
464                    $step_idx = 88;
465            }
466            return $pred_val;
467    }
468    
469    my $au_path = "$dump_dir/sound.au";
470    open(my $au_fh, '>', $au_path) || die "can't open $au_path: $!";
471    print $au_fh pack 'a4N5', (
472            # magic
473            '.snd',
474            # data offset
475            24,
476            # data size
477            -1,
478            # encoding - 16-bit linear PCM
479            3,
480            # sample rate
481            22050,
482            #channels
483            1,
484    );
485    
486    sub audio_frame {
487            my $data = shift || die "no data?";
488    
489            my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
490    
491            $pred_val = $origin;
492            $step_idx = $index;
493    
494            my $size = 0;
495    
496            foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
497                    print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );          
498                    print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );          
499                    $size += 2;
500            }
501    
502            warn "length isn't corrent $bytes != $size" if $bytes != $size;
503  }  }
504    
505    
506    sub x_audio_frame {
507            my $data = shift || die "no data?";
508    
509            my $apath = sprintf("$dump_dir/%04d.wav", $frame_nr );
510            open(my $audio_fh, '>', $apath) || die "can't open audio file $apath: $!";
511    
512            print $audio_fh pack 'a4Va4a4VvvVVv4', (
513                    # header 'RIFF', size
514                    'RIFF',-1,
515                    # type: 'WAVE'
516                    'WAVE',
517                    'fmt ',0x14,
518                    # format: DVI (IMA) ADPCM Wave Type
519                    0x11,
520                    # channels
521                    1,
522                    # samples/sec
523                    22050,
524                    # avg. bytes/sec (for esimation)
525                    11567,
526                    # block align (size of block)
527                    0x800,
528                    # bits per sample (mono data)
529                    4,
530                    # cbSize (ADPCM with 7 soefficient pairs)
531                    2,
532                    # nSamplesPerBlock
533                    # (((nBlockAlign - (7 * nChannels)) * 8) / (wBitsPerSample * nChannels)) + 2
534                    0x03f9,
535            );
536    
537            print $audio_fh pack 'a4VVa4V', (
538                    # time length of the data in samples
539                    'fact',4,
540                    220500,
541                    #
542                    'data',-1,
543            );
544    
545            my $riff_header_len = tell($audio_fh);
546    
547            print $audio_fh $data;
548    
549            my $size = tell($audio_fh);
550            warn "## wav file $apath size: $size\n";
551    
552            seek( $audio_fh, 4, 0 );
553            print $audio_fh pack("V", $size - 8);
554            seek( $audio_fh, $riff_header_len - 4, 0 );
555            print $audio_fh pack("V", $size - $riff_header_len);
556    
557            close($audio_fh) || die "can't close audio file $apath: $!";
558    }
559    
560    #
561    # read AMV file
562    #
563    
564  my ( $riff, $amv ) = x(12, 'Z4x4Z4');  my ( $riff, $amv ) = x(12, 'Z4x4Z4');
565  die "$path not RIFF but $riff" if $riff ne 'RIFF';  die "$path not RIFF but $riff" if $riff ne 'RIFF';
566  die "$path not AMV but $amv" if $amv ne 'AMV ';  die "$path not AMV but $amv" if $amv ne 'AMV ';
567    
568    my $fps = 16;
569    my $duration;
570    
571  while ( ! defined($d->{eof}) ) {  while ( ! defined($d->{eof}) ) {
572          my ( $list, $name ) = x(12,'A4x4A4');          my ( $list, $name ) = x(12,'A4x4A4');
573          die "not LIST but $list" if $list ne 'LIST';          die "not LIST but $list" if $list ne 'LIST';
574          print "< $list * $name\n";          print "< $list * $name\n" if $verbose;
575    
576          if ( $name eq 'hdrl' ) {          if ( $name eq 'hdrl' ) {
577    
# Line 325  while ( ! defined($d->{eof}) ) { Line 585  while ( ! defined($d->{eof}) ) {
585                          $h->{$n} = $v;                          $h->{$n} = $v;
586                  } x($len, 'Vx28VVVx8CCv');                  } x($len, 'Vx28VVVx8CCv');
587    
588                  printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",                  $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
589    
590                    printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
591                          $path,                          $path,
592                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
593                          $h->{hh}, $h->{mm}, $h->{ss};                          $duration;
594    
595                  $d->{amvh} = $h;                  $d->{amvh} = $h;
596                    $fps = $h->{fps};
597    
598          } elsif ( $name eq 'strl' ) {          } elsif ( $name eq 'strl' ) {
599    
# Line 339  while ( ! defined($d->{eof}) ) { Line 602  while ( ! defined($d->{eof}) ) {
602    
603          } elsif ( $name eq 'movi' ) {          } elsif ( $name eq 'movi' ) {
604    
605                  while (1) {                  my $have_parts = 1;
606    
607                    while ( $have_parts ) {
608                          my $frame = $d->{movi}++;                          my $frame = $d->{movi}++;
                   
                         my $len = next_part( '00dc' );  
                         last unless $len;  
                         printf "<< %s 00dc - frame %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len;  
                         mkjpg( x($len) );  
609    
610                          $len = next_part( '01wb', 0, 1 );                          my $parts = 0;
611                          printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;  
612                            while ( $parts < 2 ) {
613    
614                                    my ( $len, $part ) = next_part();
615    
616                                    if ( ! $len ) {
617                                            $have_parts = 0;
618                                            last;
619                                    }
620    
621                                    if ( $part eq '00dc' ) {
622    
623                                            printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
624                                            mkjpg( x($len) );
625                                            $parts++;
626    
627                                    } elsif ( $part eq '01wb' ) {
628                                            printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
629    
630                                            my $audio_frame = x( $len );
631    
632                                            if ( $dump_audio ) {
633                                                    printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
634                                                    hex_dump( $audio_frame );
635                                            }
636    
637                    #                       print $audio_fh mp3_frame;
638                                            audio_frame( $audio_frame );
639    
640                                            $parts++;
641                                    } else {
642                                            warn "unknown next part $part with $len bytes, skipping!";
643                                    }
644    
645                                    warn "## #$frame_nr $name $part has $parts parts\n";
646                            }
647    
648                            $frame_nr++;
649    
650                            if ( $frame_nr % $fps == 0 ) {
651                                    print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
652                                    print ".";
653                            }
654                  };                  };
655    
656          } else {          } else {
# Line 356  while ( ! defined($d->{eof}) ) { Line 658  while ( ! defined($d->{eof}) ) {
658          }          }
659  }  }
660    
661  my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -f $dump_avi";  my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
662  system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";  system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
663    
664    print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";
Legend:
Removed from v.21  
changed lines
  Added in v.31
  ViewVC Help
Powered by ViewVC 1.1.26