/[amv]/frames.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

Contents of /frames.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 35 - (show annotations)
Mon Oct 1 20:48:54 2007 UTC (16 years, 6 months ago) by dpavlin
File MIME type: text/plain
File size: 1866 byte(s)
tweak generator
1 #!/usr/bin/perl -w
2
3 # frames.pl
4 #
5 # 07/19/07 18:06:13 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7 use strict;
8
9 use GD;
10 use File::Path;
11 use Getopt::Long;
12
13 my $tmp = '/tmp/frames';
14 my $out = '/tmp/frames.avi';
15 my $jpeg_q = 100;
16 my $repeat = 1;
17 my $vary_jpeg_q = 0;
18 $repeat = 16;
19 my $audio = '-i adpcm.wav -acodec adpcm_ms -ar 22050';
20
21 GetOptions(
22 "jpeg-q=i" => \$jpeg_q,
23 "repeat=i" => \$repeat,
24 );
25
26 rmtree $tmp if -e $tmp;
27 mkpath $tmp || die "can't create $tmp: $!";
28
29 my $im = new GD::Image( 160, 120 );
30
31 my $im_col;
32
33 sub col {
34 my $hex = shift;
35 $hex = lc($hex);
36 die "not hex: $hex" unless ( $hex =~ m/^([0-9a-f])([0-9a-f])([0-9a-f])$/i );
37 my ( $r,$g,$b ) = ( hex($1 . $1),hex($2 . $2),hex($3 . $3) );
38 if ( ! defined( $im_col->{$hex} ) ) {
39 my $col = $im->colorAllocate( $r, $g, $b );
40 warn "creating color $col $hex\n";
41 $im_col->{$hex} = $col;
42 }
43 return $im_col->{$hex};
44 }
45
46 my @cols = (
47 'fff',
48 '000',
49 'f00',
50 '000',
51 '0f0',
52 '000',
53 '00f',
54 '000',
55 'ff0',
56 '000',
57 '0ff',
58 '000',
59 'fff',
60 );
61
62 my $frame = 1;
63
64 sub save_jpeg {
65 my ( $path, $q ) = @_;
66 open(my $fh, '>', $path ) || die "can't open $path: $!";
67 print $fh $im->jpeg( $q ) || die "can't save picture $path: $!";
68 close($fh) || die "can't close picture $path: $!";
69 }
70
71 foreach my $c ( @cols ) {
72 foreach ( 1 .. $repeat ) {
73 $im->fill(50,50, col($c) );
74 my $path = sprintf('%s/%03d.jpg', $tmp, $frame);
75 save_jpeg( $path, $jpeg_q );
76
77 if ( $vary_jpeg_q ) {
78 foreach my $q ( 1 .. 100 ) {
79 my $path = sprintf('%s/%03d-q%03d.jpg', $tmp, $frame, $q );
80 save_jpeg( $path, $q );
81 }
82 }
83
84 warn "frame $frame $jpeg_q% ", -s $path, " bytes\n";
85 $frame++;
86 }
87 }
88
89 my $cmd = "ffmpeg -i $tmp/%03d.jpg -r 16 -vcodec mjpeg $audio -y $out";
90 warn "## $cmd\n";
91 system($cmd) == 0 or die "encoding failed: $?";
92
93 #rmdir $tmp || die "can't remove $tmp: $!";
94
95 warn "created $out ", -s $out, " bytes\n";

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26