#!/usr/bin/perl
#
#create, mix, and modify Graphics::ColorDeficiency objects
#
#the code is quick and dirty, but it has reasonable
#error-checking and reporting.
#
#usage: colormix [-v] [file ...]
#	-v   echo rule-set before results
#	-w   round all results to nearest color in "web-safe" palette
#	all files will be catenated before parsing

#the included sample covers all of the current rules:
#	- blank lines and #-comments are ignored
#	- all rules start with the name of the new color,
#	  followed by a colon
#	- next come one or more semicolon-separated
#	  operations, which can be any combination of:
#		- comma-separated list of colors as hex or names previously
#		  defined in the current rule-set; they are linearly
#		  interpolated with the current value of the color,
#		  working from left to right,
#		- a modification to a single color channel, one of
#		  (r,g,b,h,s,v). Supported operators are addition(+),
#		  subtraction(-), and assignment(=). Values are either
#		  a single integer or a pair of integers in [], which
#		  returns a random number in that range. The h channel
#		  is in degrees from 0 to 360; the others are
#		  percentages from 0 to 100.

use strict;
no strict 'refs';
use Graphics::ColorObject;
use Graphics::ColorDeficiency;
use Data::Dumper;
use Getopt::Long;

my $rules=<<EOF;
base: r=[0,100]; g=[0,100]; b=[0,100]
back: base; h+[-15,15]; s=[0,10]; v=[90,100]
side: base; h+[-90,90]; v=[75,85]
text: base; h+[-30,30]; s=[90,100]; v=[0,20]
head: back,side; s=[90,100]; v=[20,50]
link: back,side,text; s=100; v=40
visited: link; v-10

#samples
foo: #000000
bar: foo,#ffffff; r-25
EOF

my $verbose = 0;
my $websafe = 0;

GetOptions("verbose|v" => \$verbose, "websafe|w" => \$websafe) ||
	die "usage: $0 [-vw] file ...\n";
if (@ARGV) {
	$rules = join('',<>);
}

if ($verbose) {
	print "CURRENT RULES:\n";
	print map("\t$_\n",split(/\n/,$rules));
	print "OUTPUT:\n";
}
my $hashref = applyrules($rules);
foreach (sort keys %$hashref) {
	print "\t" if $verbose;
	websafe($hashref->{$_}) if $websafe;
	printf("%-7s  %s\n",$hashref->{$_}->asHex,$_);
}
exit 0;

sub applyrules {
	unless ($_[0]) {
		$@ = "no rules?";
		return undef;
	}
	my $c = {};
	my $num = 0;
	foreach my $line (split(/\n+/,$_[0])) {
		$num++;
		next if $line =~ /^\s*$|^\s*#/; #skip comments and blank lines
		my ($name,$exprs) = split(/\s*:\s*/,$line);
		my $color;
		unless ($name) {
			$@ = "can't find a name in '$line' (line $num)";
			return undef;
		}
		unless ($exprs) {
			$@ = "can't find an expression in '$line' (line $num)";
			return undef;
		}
		foreach my $expr (split(/\s*;\s*/,$exprs)) {
			if ($expr =~ /^(.)\s*([-=+])\s*(\S+)/) {
				$color = newHex('#000000') unless ref $color;
				unless (dochannel($color,$1,$2,$3)) {
					$@ .= " (line $num)";
					return undef;
				}
			}else{
				foreach my $cname (split(/\s*,\s*/,$expr)) {
					my $tmp;
					if (ref $c->{$cname}) {
						$tmp = $c->{$cname}->Clone;
					}elsif ($cname =~ /^#[0-9a-f]{6}/i) {
						$tmp = newHex($cname);
					}else{
						$@="unknown color '$cname' (line $num)";
						return undef;
					}
					if (ref $color) {
						mix($color,$tmp);
					}else{
						$color = $tmp;
					}
				}
			}
		}
		$c->{$name} = $color;
	}
	return $c;
}

sub dochannel {
	my($color,$channel,$op,$expr) = @_;
	my $value;
	if ($expr =~ /^\[\s*([-0-9]+)\s*,\s*([-0-9]+)\s*\]$/) {
		$value=range($1,$2);
	}elsif ($expr =~ /^[-0-9]+$/) {
		$value=$expr;
	}else{
		$@="invalid value for $channel: $expr";
		return undef;
	}
	#everything's in percent except hue
	$value /=100 unless $channel eq 'h';

	my $tmp = getchannel($color,$channel);
	if ($op eq '=') {
		$tmp = $value;
	}elsif ($op eq '+') {
		$tmp += $value;
	}elsif ($op eq '-') {
		$tmp -= $value;
	}else{
		$@ = "invalid operator '$op'";
		return undef;
	}
	putchannel($color,$channel,$tmp) || return undef;
	return 1;
}

sub getchannel {
	my($color,$channel) = @_;
	if ($channel eq 'r') {
		return ($color->asRGB)[0];
	}elsif ($channel eq 'g') {
		return ($color->asRGB)[1];
	}elsif ($channel eq 'b') {
		return ($color->asRGB)[3];
	}elsif ($channel eq 'h') {
		return ($color->asHSV)[0];
	}elsif ($channel eq 's') {
		return ($color->asHSV)[1];
	}elsif ($channel eq 'v') {
		return ($color->asHSV)[2];
	}else{
		$@ = "invalid color channel '$channel'";
		return undef;
	}
	return 1;
}

sub putchannel {
	my($color,$channel,$value) = @_;
	$value = 0 if $value < 0;
	if ($channel eq 'h') {
		$value = 360 if $value > 360;
	}else{
		$value = 1 if $value > 1;
	}
	if ($channel eq 'r') {
		my @x = $color->asRGB;
		$color->setRGB($value,$x[1],$x[2]);
	}elsif ($channel eq 'g') {
		my @x = $color->asRGB;
		$color->setRGB($x[0],$value,$x[2]);
	}elsif ($channel eq 'b') {
		my @x = $color->asRGB;
		$color->setRGB($x[0],$x[1],$value);
	}elsif ($channel eq 'h') {
		my @x = $color->asHSV;
		$color->setHSV($value,$x[1],$x[2]);
	}elsif ($channel eq 's') {
		my @x = $color->asHSV;
		$color->setHSV($x[0],$value,$x[2]);
	}elsif ($channel eq 'v') {
		my @x = $color->asHSV;
		$color->setHSV($x[0],$x[1],$value);
	}
	return 1;
}

sub newHex {
	return Graphics::ColorDeficiency->newRGB(map(hex($_)/255,
		unpack("xA2A2A2",$_[0])));
}

sub mix {
	my ($r1, $g1, $b1) = $_[0]->asRGB();
	my ($r2, $g2, $b2) = $_[1]->asRGB();
	$_[0]->setRGB(($r1+$r2)/2, ($g1+$g2)/2, ($b1+$b2)/2);
}

sub range {
	my ($min,$max) = @_;
	$min = 0 unless defined $min;
	$max = 100 unless defined $max;
	return $max if $min >= $max;
	return rand($max-$min) + $min;
}

sub websafe {
	my ($r, $g, $b) = $_[0]->asRGB();
	$_[0]->setRGB(int($r*5+0.5)/5,int($g*5+0.5)/5,int($b*5+0.5)/5);
}