#!/usr/bin/env perl
use strict;
use warnings;
use GD;
GD::Image->trueColor(1);
my %color_cache;
sub cached_allocate {
my $img = shift;
my @rgb = @_;
my $rgb = join(",", @rgb);
$color_cache{$rgb} = $img->colorAllocate(@rgb) unless($color_cache{$rgb});
return $color_cache{$rgb};
}
my $img = GD::Image->new("barn.png");
my ($height, $width) = ($img->height, $img->width);
my $yuv_img = GD::Image->new($width, $height*4);
foreach my $y (0..$height-1) {
foreach my $x (0..$width-1) {
my ($r, $g, $b) = map { $_ / 256 } my @rgb = $img->rgb($img->getPixel($x, $y));
my $Y = 0.299 * $r + 0.587 * $g + 0.114 * $b;
my $U = 0.436 * ($b - $Y) / (1 - 0.114);
my $V = 0.615 * ($r - $Y) / (1 - 0.299);
$Y *= 256;
$U += .436; $U *= (256/.872);
$V += .615; $V *= (256/1.23);
($Y, $U, $V) = map { int(0.5+$_) } ($Y, $U, $V);
die "YUV: $Y,$U,$V" if (($Y > 255) or ($U > 255) or ($V > 255));
$yuv_img->setPixel($x, $y, cached_allocate($yuv_img, @rgb));
$yuv_img->setPixel($x, $height+$y, cached_allocate($yuv_img, $Y, $Y, $Y));
$yuv_img->setPixel($x, 2*$height+$y, cached_allocate($yuv_img, 0, 255-$U, $U));
$yuv_img->setPixel($x, 3*$height+$y, cached_allocate($yuv_img, $V, 255-$V, 0));
}
};
$yuv_img->_file("barn-yuv.png");
CPAN module.