viewvc.cgi/amv/frames.pl

#!/usr/bin/perl -w

# frames.pl
#
# 07/19/07 18:06:13 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;

use GD;
use File::Path;

my $tmp = '/tmp/frames';
my $out = '/tmp/frames.avi';
my $jpeg_q = 10;

mkpath $tmp || die "can't create $tmp: $!";

my $im = new GD::Image( 160, 120 );

my $im_col;

sub col {
        my $hex = shift;
        $hex = lc($hex);
        die "not hex: $hex" unless ( $hex =~ m/^([0-9a-f])([0-9a-f])([0-9a-f])$/i );
        my ( $r,$g,$b ) = ( hex($1 . $1),hex($2 . $2),hex($3 . $3) );
        if ( ! defined( $im_col->{$hex} ) ) {
                my $col = $im->colorAllocate( $r, $g, $b );
                warn "creating color $col $hex\n";
                $im_col->{$hex} = $col;
        }
        return $im_col->{$hex};
}

my @cols = (
        '000',
        'f00',
        '0f0',
        '00f',
        'ff0',
        '0ff',
        'fff',
);

my $frame = 1;

foreach my $c ( @cols ) {
        foreach ( 1 .. 16 ) {
                $im->fill(50,50, col($c) );
                warn "frame $frame\n";
                my $path = sprintf('%s/%03d.jpg', $tmp, $frame++);
                open(my $fh, '>', $path) || die "can't open $path: $!";
                print $fh $im->jpeg( $jpeg_q ) || die "can't save picture $path: $!";
                close($fh) || die "can't close picture $path: $!";
        }
}

system("ffmpeg -i $tmp/%03d.jpg -r 16 -vcodec copy -y $out") == 0 or
        die "encoding failed: $?";

rmdir $tmp || die "can't remove $tmp: $!";
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
12			my $tmp = '/tmp/frames';
13			my $out = '/tmp/frames.avi';
14	dpavlin	2	my $jpeg_q = 10;
15	dpavlin	1
16			mkpath $tmp \|\| die "can't create $tmp: $!";
17
18			my $im = new GD::Image( 160, 120 );
19
20			my $im_col;
21
22			sub col {
23			my $hex = shift;
24			$hex = lc($hex);
25			die "not hex: $hex" unless ( $hex =~ m/^([0-9a-f])([0-9a-f])([0-9a-f])$/i );
26			my ( $r,$g,$b ) = ( hex($1 . $1),hex($2 . $2),hex($3 . $3) );
27			if ( ! defined( $im_col->{$hex} ) ) {
28			my $col = $im->colorAllocate( $r, $g, $b );
29			warn "creating color $col $hex\n";
30			$im_col->{$hex} = $col;
31			}
32			return $im_col->{$hex};
33			}
34
35			my @cols = (
36			'000',
37			'f00',
38			'0f0',
39			'00f',
40			'ff0',
41			'0ff',
42			'fff',
43			);
44
45			my $frame = 1;
46
47			foreach my $c ( @cols ) {
48			foreach ( 1 .. 16 ) {
49			$im->fill(50,50, col($c) );
50			warn "frame $frame\n";
51			my $path = sprintf('%s/%03d.jpg', $tmp, $frame++);
52			open(my $fh, '>', $path) \|\| die "can't open $path: $!";
53	dpavlin	2	print $fh $im->jpeg( $jpeg_q ) \|\| die "can't save picture $path: $!";
54	dpavlin	1	close($fh) \|\| die "can't close picture $path: $!";
55			}
56			}
57
58			system("ffmpeg -i $tmp/%03d.jpg -r 16 -vcodec copy -y $out") == 0 or
59			die "encoding failed: $?";
60
61			rmdir $tmp \|\| die "can't remove $tmp: $!";