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

Annotation of /frames.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (hide annotations)
Sat Jul 21 15:02:51 2007 UTC (16 years, 8 months ago) by dpavlin
File MIME type: text/plain
File size: 1722 byte(s)
default quality is 100%, more colors, generate frames which quaility 1-100 %
1 dpavlin 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 dpavlin 17 use Getopt::Long;
12 dpavlin 1
13     my $tmp = '/tmp/frames';
14     my $out = '/tmp/frames.avi';
15 dpavlin 18 my $jpeg_q = 100;
16 dpavlin 17 my $repeat = 1;
17 dpavlin 1
18 dpavlin 17 GetOptions(
19     "jpeg-q=i" => \$jpeg_q,
20     "repeat=i" => \$repeat,
21     );
22    
23 dpavlin 10 rmtree $tmp if -e $tmp;
24 dpavlin 1 mkpath $tmp || die "can't create $tmp: $!";
25    
26     my $im = new GD::Image( 160, 120 );
27    
28     my $im_col;
29    
30     sub col {
31     my $hex = shift;
32     $hex = lc($hex);
33     die "not hex: $hex" unless ( $hex =~ m/^([0-9a-f])([0-9a-f])([0-9a-f])$/i );
34     my ( $r,$g,$b ) = ( hex($1 . $1),hex($2 . $2),hex($3 . $3) );
35     if ( ! defined( $im_col->{$hex} ) ) {
36     my $col = $im->colorAllocate( $r, $g, $b );
37     warn "creating color $col $hex\n";
38     $im_col->{$hex} = $col;
39     }
40     return $im_col->{$hex};
41     }
42    
43     my @cols = (
44 dpavlin 18 'fff',
45 dpavlin 1 '000',
46     'f00',
47 dpavlin 18 '000',
48 dpavlin 1 '0f0',
49 dpavlin 18 '000',
50 dpavlin 1 '00f',
51 dpavlin 18 '000',
52 dpavlin 1 'ff0',
53 dpavlin 18 '000',
54 dpavlin 1 '0ff',
55 dpavlin 18 '000',
56 dpavlin 1 'fff',
57     );
58    
59     my $frame = 1;
60    
61 dpavlin 18 sub save_jpeg {
62     my ( $path, $q ) = @_;
63     open(my $fh, '>', $path ) || die "can't open $path: $!";
64     print $fh $im->jpeg( $q ) || die "can't save picture $path: $!";
65     close($fh) || die "can't close picture $path: $!";
66     }
67    
68 dpavlin 1 foreach my $c ( @cols ) {
69 dpavlin 10 foreach ( 1 .. $repeat ) {
70 dpavlin 1 $im->fill(50,50, col($c) );
71 dpavlin 18 my $path = sprintf('%s/%03d.jpg', $tmp, $frame);
72     save_jpeg( $path, $jpeg_q );
73    
74     foreach my $q ( 1 .. 100 ) {
75     my $path = sprintf('%s/%03d-q%03d.jpg', $tmp, $frame, $q );
76     save_jpeg( $path, $q );
77     }
78 dpavlin 17 warn "frame $frame $jpeg_q% ", -s $path, " bytes\n";
79 dpavlin 18 $frame++;
80 dpavlin 1 }
81     }
82    
83 dpavlin 12 my $cmd = "ffmpeg -i $tmp/%03d.jpg -r 16 -y $out";
84     warn "## $cmd\n";
85     system($cmd) == 0 or die "encoding failed: $?";
86 dpavlin 1
87 dpavlin 17 #rmdir $tmp || die "can't remove $tmp: $!";
88 dpavlin 10
89     warn "created $out ", -s $out, " bytes\n";

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26