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;
use Getopt::Long;

my $tmp = '/tmp/frames';
my $out = '/tmp/frames.avi';
my $jpeg_q = 20;
my $repeat = 1;

GetOptions(
        "jpeg-q=i" => \$jpeg_q,
        "repeat=i" => \$repeat,
);

rmtree $tmp if -e $tmp;
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 .. $repeat ) {
                $im->fill(50,50, col($c) );
                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: $!";
                warn "frame $frame $jpeg_q% ", -s $path, " bytes\n";
        }
}

my $cmd = "ffmpeg -i $tmp/%03d.jpg -r 16 -y $out";
warn "## $cmd\n";
system($cmd) == 0 or die "encoding failed: $?";

#rmdir $tmp || die "can't remove $tmp: $!";

warn "created $out ", -s $out, " bytes\n";
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 = 20;
16	my $repeat = 1;
17
18	GetOptions(
19	"jpeg-q=i" => \$jpeg_q,
20	"repeat=i" => \$repeat,
21	);
22
23	rmtree $tmp if -e $tmp;
24	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	'000',
45	'f00',
46	'0f0',
47	'00f',
48	'ff0',
49	'0ff',
50	'fff',
51	);
52
53	my $frame = 1;
54
55	foreach my $c ( @cols ) {
56	foreach ( 1 .. $repeat ) {
57	$im->fill(50,50, col($c) );
58	my $path = sprintf('%s/%03d.jpg', $tmp, $frame++);
59	open(my $fh, '>', $path) \|\| die "can't open $path: $!";
60	print $fh $im->jpeg( $jpeg_q ) \|\| die "can't save picture $path: $!";
61	close($fh) \|\| die "can't close picture $path: $!";
62	warn "frame $frame $jpeg_q% ", -s $path, " bytes\n";
63	}
64	}
65
66	my $cmd = "ffmpeg -i $tmp/%03d.jpg -r 16 -y $out";
67	warn "## $cmd\n";
68	system($cmd) == 0 or die "encoding failed: $?";
69
70	#rmdir $tmp \|\| die "can't remove $tmp: $!";
71
72	warn "created $out ", -s $out, " bytes\n";