Graphics::ColorDeficiency - Color Deficiency Simulation

Graphics-ColorDeficiency documentation Contained in the Graphics-ColorDeficiency distribution.

Index

Code Index:

NAME

Top

Graphics::ColorDeficiency - Color Deficiency Simulation

SYNOPSIS

Top

  use Graphics::ColorDeficiency;

  my $col = Graphics::ColorDeficiency->newRGB(0.5, 0.7, 1);

  my $col2 = $col->asProtanopia;

  print $col2->asHex;

DESCRIPTION

Top

This module allows easy transformation of colors for color deficiency simulation. All the known and theorhetical color deficiencies are represented here, with the exception of 4-cone vision (tetrachromatism).

Each of the transformation methods returns a Graphics::ColorObject object, with the internal color values set. This can then be used to return the color in many different formats (see the Graphics::ColorObject manpage).

METHODS

Top

asProtanopia()
asDeutanopia()
asTritanopia()

The three dichromat methods return a Graphics::ColorObject object, simulated for the three dichromatic vision modes.

asProtanomaly( $amount )
asDeuteranomaly( $amount )
asTritanomaly( $amount )

The three anomalous trichromat methods return a Graphics::ColorObject object, simulated for the three anomalous trichromatic vision modes. The optional $amount agrument allows you to specify the severity of anomaly, ranging from 0 (trichromatic) to 1 (dichromatic). If not specified, it defaults to 0.5.

asTypicalMonochrome()

Returns a Graphics::ColorObject object in Typical Monochromatic (Rod Monochromat) mode.

asAtypicalMonochrome( $amount )

Returns a Graphics::ColorObject object in Atypical Monochromatic (Cone Monochromat) mode. The amount specified in $amount can vary between 1 (trichromatic) and 0 (monochromatic). The default is 0.2 (four fifths gray).

Clone()

Clones the current object, returning a Graphics::ColorDeficiency object with the same color values as the current object.

asMix( $color, $amount )

Returns a new Graphics::ColorDeficiency, consisting of the current color values, mixed with the values of the $color object. $amount specifies the amount of the new color to mix in, from 0 (which is equal to $self.Clone()), up to 1 (which is equal to $color.Clone()). The mix is a linear RGB interpolation.

This method is used internally.

AUTHOR

Top

Copyright (C) 2003 Cal Henderson <cal@iamcal.com>

SEE ALSO

Top

Graphics::ColorObject

http://www.iamcal.com/toys/colors/

Graphics-ColorDeficiency documentation Contained in the Graphics-ColorDeficiency distribution. 
package Graphics::ColorDeficiency;

use Graphics::ColorObject;
use Graphics::ColorDeficiency::Data;

@ISA = ('Graphics::ColorObject');
$VERSION = 0.05;

sub Clone {
	my ($self) = @_;
	my ($r,$g,$b) = $self->asRGB;
	return Graphics::ColorDeficiency->newRGB($r, $g, $b);
}

sub asProtanomaly {
	my ($self, $ratio) = @_;
	$ratio = 0.5 unless defined $ratio;
	my $temp = $self->asProtanopia;
	return $self->asMix($temp, $ratio);
}

sub asDeuteranomaly {
	my ($self, $ratio) = @_;
	$ratio = 0.5 unless defined $ratio;
	my $temp = $self->asDeutanopia;
	return $self->asMix($temp, $ratio);
}

sub asTritanomaly {
	my ($self, $ratio) = @_;
	$ratio = 0.5 unless defined $ratio;
	my $temp = $self->asTritanopia;
	return $self->asMix($temp, $ratio);
}

sub asProtanopia {
	return shift->asHash(0);
}

sub asDeutanopia {
	return shift->asHash(1);
}

sub asTritanopia {
	return shift->asHash(2);
}

sub asTypicalMonochrome {
	my ($self) = @_;
	my $val = $self->asGrey2;
	my ($h1, $s1, $v1) = $self->asHSV;
	my $temp = Graphics::ColorObject->newRGB($val, $val, $val);
	my ($h2, $s2, $v2) = $temp->asHSV;
	$temp->setHSV($h2, $s2, ($v1+$v2)/2);
	return $temp;
}

sub asAtypicalMonochrome {
	my ($self, $ratio) = @_;
	$ratio = 0.2 unless defined $ratio;
	my $temp = $self->asTypicalMonochrome;
	return $self->asMix($temp, 1 - $ratio);
}

sub asHash {
	my ($self, $id) = @_;

	my ($r, $g, $b) = $self->asRGB();

	my ($lo_r, $hi_r) = $self->getColorBounds($r);
	my ($lo_r_rat, $hi_r_rat) = $self->getMixRatios($r, $hi_r, $lo_r);

	my ($lo_g, $hi_g) = $self->getColorBounds($g);
	my ($lo_g_rat, $hi_g_rat) = $self->getMixRatios($g, $hi_g, $lo_g);

	my ($lo_b, $hi_b) = $self->getColorBounds($b);
	my ($lo_b_rat, $hi_b_rat) = $self->getMixRatios($b, $hi_b, $lo_b);

	my $lo_col = Graphics::ColorObject->newRGB($lo_r, $lo_g, $lo_b);
	my $hi_col = Graphics::ColorObject->newRGB($hi_r, $hi_g, $hi_b);

	my $from_lo = $Graphics::ColorDeficiency::Data::HASH->{substr(lc $lo_col->asHex,1)}[$id];
	my $from_hi = $Graphics::ColorDeficiency::Data::HASH->{substr(lc $hi_col->asHex,1)}[$id];

	my ($f_l_r, $f_l_g, $f_l_b) = map{hex($_) / 255} ($from_lo =~ /../g);
	my ($f_h_r, $f_h_g, $f_h_b) = map{hex($_) / 255} ($from_hi =~ /../g);

	my $r_out = ($f_l_r * $lo_r_rat) + ($f_h_r * $hi_r_rat);
	my $g_out = ($f_l_g * $lo_g_rat) + ($f_h_g * $hi_g_rat);
	my $b_out = ($f_l_b * $lo_b_rat) + ($f_h_b * $hi_b_rat);

	return Graphics::ColorObject->newRGB($r_out, $g_out, $b_out);
}

sub asMix {
	my ($self, $mix, $rat2) = @_;
	my $rat1 = 1 - $rat2;
	my ($r1, $g1, $b1) = $self->asRGB();
	my ($r2, $g2, $b2) = $mix->asRGB();
	return Graphics::ColorDeficiency->newRGB( ($r1*$rat1)+($r2*$rat2), ($g1*$rat1)+($g2*$rat2), ($b1*$rat1)+($b2*$rat2) );
}

sub getColorBounds {
	my ($self, $val) = @_;
	$val *= 10;
	my ($lo, $hi) = (0, 10);
	for(my $i=0; $i<=10; $i+=2){
		$lo = $i if $val >= $i;
		$hi = $i if $val <= $i && $i < $hi;
	}
	return ($lo/10, $hi/10);
}

sub getMixRatios {
	my ($self, $val, $hi, $lo) = @_;

	return (0.5, 0.5) if ($hi == $val);

	$r1 = ($val - $lo) / 0x33;
	return ($r1, 1-$r1);
}