Re: [FWP] Tasteful colour generator

[Peter Scott <Peter@PSDT.com>]

A while ago I wanted to calibrate my color printer and I didn't like the 
PhotoShop test page 'cos I didn't know the CMYK values for most of the 
colors on it.  What I wanted was a gamut of useful colors.  I therefore 
wrote this program to produce three views of the color cube: one looking 
end-on at the black corner, one end-on at the white corner, and one slice 
through the midpoints of the axes.  Enjoy.


use strict;
use GD;

use constant PI    => 3.14159265358979;
use constant S30   => sin (30 * PI / 180);
use constant C30   => cos (30 * PI / 180);
use constant SIZE  => 300;
use constant NCOLS => 8;
use constant RES   => SIZE * 2;

sub iterate (&$$) {
   for ($_[1] = 0, my $i = 0; $i <= $_[2]; $_[1] = ++$i / $_[2]) {
     &{$_[0]};
   }
}

my $im = new GD::Image (SIZE * 2 + 2, SIZE * 2 + 2);
$im->colorAllocate (255,255,255);
my ($r, $g, $b);

# Set color ranges for first cube

$b = 1;
iterate { iterate { setcol ($r, $g, $b) } $g, NCOLS } $r, NCOLS;
$g = 1;
iterate { iterate { setcol ($r, $g, $b) } $r, NCOLS } $b, NCOLS;
$r = 1;
iterate { iterate { setcol ($r, $g, $b) } $b, NCOLS } $g, NCOLS;

# Now the pixels

$b = 1;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $g, RES } $r, RES;
$g = 1;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $r, RES } $b, RES;
$r = 1;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $b, RES } $g, RES;

open (DISPLAY,">1.gif") || die $!;
binmode DISPLAY;
print DISPLAY $im->gif;
close DISPLAY || die "can't close: $!\n";

# Second cube

$im = new GD::Image (SIZE * 2 + 2, SIZE * 2 + 2);
$im->colorAllocate (255,255,255);
for (my $i = 1; $i <= $im->colorAllocate(1,1,1); $i++)
{ $im->colorDeallocate ($i); }

$b = 0;
iterate { iterate { setcol ($r, $g, $b) } $g, NCOLS } $r, NCOLS;
$g = 0;
iterate { iterate { setcol ($r, $g, $b) } $r, NCOLS } $b, NCOLS;
$r = 0;
iterate { iterate { setcol ($r, $g, $b) } $b, NCOLS } $g, NCOLS;

# Now the pixels

$b = 0;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $g, RES } $r, RES;
$g = 0;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $r, RES } $b, RES;
$r = 0;
iterate { iterate { display (xypos ($r, $g, $b), $r, $g, $b) }
	  $b, RES } $g, RES;

open (DISPLAY,">2.gif") || die $!;
binmode DISPLAY;
print DISPLAY $im->gif;
close DISPLAY || die "can't close: $!\n";

# Third cube

$im = new GD::Image (SIZE * 2 + 2, SIZE * 2 + 2);
$im->colorAllocate (255,255,255);
for (my $i = 1; $i <= $im->colorAllocate(1,1,1); $i++)
{ $im->colorDeallocate ($i); }

iterate { iterate { $b = 1.5 - $r - $g;
		    setcol ($r, $g, $b) if $b <= 1 && $b >= 0 }
	  $g, NCOLS } $r, NCOLS;

# Now the pixels

iterate { iterate { $b = 1.5 - $r - $g;
		    display (xypos ($r, $g, $b), $r, $g, $b)
			if $b <= 1 && $b >= 0 }
	  $g, RES } $r, RES;

open (DISPLAY,">3.gif") || die $!;
binmode DISPLAY;
print DISPLAY $im->gif;
close DISPLAY || die "can't close: $!\n";


sub true_color {
   my @new = ();
   for (@_) {
     push @new, int ($_ * 255 + .5);
   }
   return @new;
}


sub setcol {
   my ($r, $g, $b) = true_color (@_);
   $im->colorAllocate ($r, $g, $b);
}


sub xypos {
   my ($r, $g, $b) = @_;
   return ($g - S30 * $r - S30 * $b, C30 * $b - C30 * $r);
}


sub display {
   my ($x, $y, $r, $g, $b) = (@_[0..1], true_color(@_[2..4]));
   $x = int ($x * SIZE + SIZE + 1);
   $y = int ($y * SIZE + SIZE + 1);
   my $c = $im->colorClosest ($r, $g, $b);

   $im->setPixel ($x, $y, $c);
}


--
Peter Scott
Pacific Systems Design Technologies


==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe