/[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 23 by dpavlin, Sat Jul 21 17:03:56 2007 UTC revision 33 by dpavlin, Mon Oct 1 20:26:13 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 = '-flip vertical';  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          "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 48  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 91  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 108  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 134  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 159  sub mkjpg { Line 178  sub mkjpg {
178    
179          if ( $#subframes < ( $join_subframes - 1 ) ) {          if ( $#subframes < ( $join_subframes - 1 ) ) {
180                  push @subframes, $data;                  push @subframes, $data;
181                  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;
182                  return;                  return;
183          }          }
184    
# Line 285  sub mkjpg { Line 304  sub mkjpg {
304                  0,                      # Ah, Ai (not used)                  0,                      # Ah, Ai (not used)
305          );          );
306    
307          if ( $dump ) {          if ( $dump_jpeg ) {
308                  print "## created JPEG header...\n";                  print "## created JPEG header...\n";
309                  hex_dump( $header, 0 );                  hex_dump( $header, 0 );
310          }          }
# Line 293  sub mkjpg { Line 312  sub mkjpg {
312          my $frame = join('', @subframes ) . $data;          my $frame = join('', @subframes ) . $data;
313          @subframes = ();          @subframes = ();
314    
315          my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr++ );          my $path = sprintf("$dump_dir/%04d.jpg", $frame_nr );
316    
317          my $fh;          my $fh;
318          if ( $jpegtran ) {          if ( $jpegtran ) {
# Line 308  sub mkjpg { Line 327  sub mkjpg {
327                  print $fh $frame || die "can't write raw jpeg $path: $!";                  print $fh $frame || die "can't write raw jpeg $path: $!";
328          }          }
329          close $fh || die "can't close $path: $!";          close $fh || die "can't close $path: $!";
330          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;
331  }  }
332    
333    #
334    # IMA ADPCM decoder
335    #
336    
337    my @index_adjust = ( -1, -1, -1, -1, 2, 4, 6, 8 );
338    
339    my @step_size = (
340            7, 8, 9, 10, 11, 12, 13, 14, 16, 17,
341            19, 21, 23, 25, 28, 31, 34, 37, 41, 45,
342            50, 55, 60, 66, 73, 80, 88, 97, 107, 118,
343            130, 143, 157, 173, 190, 209, 230, 253, 279, 307,
344            337, 371, 408, 449, 494, 544, 598, 658, 724, 796,
345            876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066,
346            2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358,
347            5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899,
348            15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767
349    );
350    
351    my $pred_val = 0;
352    my $step_idx = 0;
353    
354    # This code is "borrowed" from the ALSA library
355    # http://www.alsa-project.org
356    
357    sub adpcm_decode_sample {
358            my $code = shift;
359    
360            my $pred_diff;  # Predicted difference to next sample
361            my $step;               # holds previous step_size value
362    
363            # Separate sign and magnitude
364            my $sign = $code & 0x8;
365            $code &= 0x7;
366    
367            # Computes pred_diff = (code + 0.5) * step / 4,
368            # but see comment in adpcm_coder.
369    
370            $step = $step_size[$step_idx] || die "no step_size[$step_idx]";
371    
372            # Compute difference and new predicted value
373            $pred_diff = $step >> 3;
374            my $i = 0x4;
375            while( $i ) {
376                    if ($code & $i) {
377                            $pred_diff += $step;
378                    }
379                    $i >>= 1;
380                    $step >>= 1;
381            }
382            $pred_val += $sign ? -$pred_diff : $pred_diff;
383    
384            # Clamp output value
385            if ($pred_val > 32767) {
386                    $pred_val = 32767;
387            } elsif ($pred_val < -32768) {
388                    $pred_val = -32768;
389            }
390    
391            # Find new step_size index value
392            $step_idx += $index_adjust[$code];
393    
394            if ($step_idx < 0) {
395                    $step_idx = 0;
396            } elsif ($step_idx > 88) {
397                    $step_idx = 88;
398            }
399            return $pred_val;
400    }
401    
402    my $au_path = "$dump_dir/sound.au";
403    open(my $au_fh, '>', $au_path) || die "can't open $au_path: $!";
404    print $au_fh pack 'a4N5', (
405            # magic
406            '.snd',
407            # data offset
408            24,
409            # data size
410            -1,
411            # encoding - 16-bit linear PCM
412            3,
413            # sample rate
414            22050,
415            #channels
416            1,
417    );
418    
419    sub audio_frame {
420            my $data = shift || die "no data?";
421    
422            my ( $origin, $index, $bytes ) = unpack 'ssL', substr($data,0,8);
423    
424            $pred_val = $origin;
425            $step_idx = $index;
426    
427            my $size = 0;
428    
429            foreach my $b ( map { ord($_) } split(//, substr($data,8)) ) {
430                    print $au_fh pack 'n', adpcm_decode_sample( $b >> 4 );          
431                    print $au_fh pack 'n', adpcm_decode_sample( $b & 15 );          
432                    $size += 2;
433            }
434    
435            warn "length isn't corrent $bytes != $size" if $bytes != $size;
436    }
437    
438    #
439    # read AMV file
440    #
441    
442  my ( $riff, $amv ) = x(12, 'Z4x4Z4');  my ( $riff, $amv ) = x(12, 'Z4x4Z4');
443  die "$path not RIFF but $riff" if $riff ne 'RIFF';  die "$path not RIFF but $riff" if $riff ne 'RIFF';
444  die "$path not AMV but $amv" if $amv ne 'AMV ';  die "$path not AMV but $amv" if $amv ne 'AMV ';
445    
446    my $fps = 16;
447    my $duration;
448    
449  while ( ! defined($d->{eof}) ) {  while ( ! defined($d->{eof}) ) {
450          my ( $list, $name ) = x(12,'A4x4A4');          my ( $list, $name ) = x(12,'A4x4A4');
451          die "not LIST but $list" if $list ne 'LIST';          die "not LIST but $list" if $list ne 'LIST';
452          print "< $list * $name\n";          print "< $list * $name\n" if $verbose;
453    
454          if ( $name eq 'hdrl' ) {          if ( $name eq 'hdrl' ) {
455    
# Line 332  while ( ! defined($d->{eof}) ) { Line 463  while ( ! defined($d->{eof}) ) {
463                          $h->{$n} = $v;                          $h->{$n} = $v;
464                  } x($len, 'Vx28VVVx8CCv');                  } x($len, 'Vx28VVVx8CCv');
465    
466                  printf "## %s %d*%d %s fps (%d ms/frame) %02d:%02d:%02d\n",                  $duration = sprintf('%02d:%02d:%02d', $h->{hh}, $h->{mm}, $h->{ss} );
467    
468                    printf "## %s %d*%d %s fps (%d ms/frame) %s\n",
469                          $path,                          $path,
470                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},                          $h->{width}, $h->{height}, $h->{fps}, $h->{ms_per_frame},
471                          $h->{hh}, $h->{mm}, $h->{ss};                          $duration;
472    
473                  $d->{amvh} = $h;                  $d->{amvh} = $h;
474                    $fps = $h->{fps};
475    
476          } elsif ( $name eq 'strl' ) {          } elsif ( $name eq 'strl' ) {
477    
# Line 346  while ( ! defined($d->{eof}) ) { Line 480  while ( ! defined($d->{eof}) ) {
480    
481          } elsif ( $name eq 'movi' ) {          } elsif ( $name eq 'movi' ) {
482    
483                  while (1) {                  my $have_parts = 1;
484    
485                    while ( $have_parts ) {
486                          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) );  
487    
488                          $len = next_part( '01wb', 0, 1 );                          my $parts = 0;
489                          printf "<< %s 01wb - frame %d audio %d 0x%x bytes\n", $name, $frame, $len, $len;  
490                            while ( $parts < 2 ) {
491    
492                                    my ( $len, $part ) = next_part();
493    
494                                    if ( ! $len ) {
495                                            $have_parts = 0;
496                                            last;
497                                    }
498    
499                                    if ( $part eq '00dc' ) {
500    
501                                            printf "<< %s 00dc - part %d jpeg %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
502                                            mkjpg( x($len) );
503                                            $parts++;
504    
505                                    } elsif ( $part eq '01wb' ) {
506                                            printf "<< %s 01wb - part %d audio %d 0x%x bytes\n", $name, $frame, $len, $len if $verbose;
507    
508                                            my $audio_frame = x( $len );
509    
510                                            if ( $dump_audio ) {
511                                                    printf "#### dumping audio frame %d 0x%x bytes\n", length($audio_frame), length($audio_frame);
512                                                    hex_dump( $audio_frame );
513                                            }
514    
515                    #                       print $audio_fh mp3_frame;
516                                            audio_frame( $audio_frame );
517    
518                                            $parts++;
519                                    } else {
520                                            warn "unknown next part $part with $len bytes, skipping!";
521                                    }
522    
523                                    warn "## #$frame_nr $name $part has $parts parts\n" if $debug;
524                            }
525    
526                            $frame_nr++;
527    
528                            if ( $frame_nr % $fps == 0 ) {
529                                    print "\n" if ( ( $frame_nr / $fps ) % 60 == 0 );
530                                    print ".";
531                            }
532                  };                  };
533    
534          } else {          } else {
# Line 363  while ( ! defined($d->{eof}) ) { Line 536  while ( ! defined($d->{eof}) ) {
536          }          }
537  }  }
538    
539  my $cmd = "ffmpeg -i $dump_dir/%04d.jpg -r 16 -y $dump_avi";  my $cmd = "ffmpeg -r $fps -i $dump_dir/%04d.jpg -i $au_path -y $dump_avi";
540  system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";  system($cmd) == 0 || die "can't convert frames to avi using $cmd: $!";
541    
542    print ">>>> created $frame_nr frames $dump_avi ", -s $dump_avi, "\n";

Legend:
Removed from v.23  
changed lines
  Added in v.33

  ViewVC Help
Powered by ViewVC 1.1.26