view release on metacpan or  search on metacpan

lib/ICC/Shared.pm  view on Meta::CPAN

	$derv = ($errx - $err)/1E-3;

	# initialize delta T
	$dT = $derv > 0 ? -2 : 2;

	# optimization loop
	for (0 .. 30) {
		
		# adjust T value
		$T += $dT;
		
		# compute current u,v values
		($u, $v) = bbuv($T);
		
		# compute current error
		$err = sqrt(($u - $ut)**2 + ($v - $vt)**2);
		
		# compute delta values
		($ux, $vx) = bbuv($T + 1E-3);
		
		# compute delta error
		$errx = sqrt(($ux - $ut)**2 + ($vx - $vt)**2);
		
		# save previous derr/dT values
		$derv0 = $derv;
		
		# compute new derr/dT
		$derv = ($errx - $err)/1E-3;
		
		# quit loop if derr/dT < 1E-9
		last if (abs($derv) < 1E-9);
		
		# adjust delta T if sign of derivative changes
		$dT /= -2 if (($derv > 0) ^ ($derv0 > 0));
		
	}

	# return CCT
	return($T, $err);

}

# correlated color temperature (CCT)
# using McCamy's approximation
# parameters: (x, y)
# returns: (CCT)
sub CCT2 {

	# get parameters
	my ($x, $y) = @_;

	# compute n
	my $n = ($x - 0.3320)/($y - 0.1858);

	# return CCT
	return(-449 * $n**3 + 3525 * $n**2 - 6823.3 * $n + 5520.33);

}

# black body radiance (Planck's law)
# using constants and formula per CIE 15
# wavelength in nm, temperature in degrees Kelvin
# parameters: (wavelength, temperature)
# returns: (radiance)
sub bbrad {

	# get parameters
	my ($lambda, $T) = @_;

	# CIE constants
	my $c1 = 3.741771E-16; # 2πhc²
	my $c2 = 1.4388E-2; # hc/kB

	# convert wavelength to meters
	$lambda *= 1E-9;

	# return radiance value
	return($c1/(PI * $lambda**5 * (exp($c2/($lambda * $T)) - 1)));

}

# compute chromaticity values of black body radiator
# parameter: (temperature)
# returns: (x, y)
sub bbxy {

	# get temperature
	my $T = shift();

	# local variables
	my ($b, $X, $Y, $Z, $d);

	# load CIE color matching functions (YAML format)
	state $cmf = YAML::Tiny->read(getICCPath('Data/CIE_cmfs_360-830_x_1.yml'))->[0];

	# for each wavelength (360 - 830 nm)
	for my $i (0 .. 470) {
		
		# compute black body reflectance
		$b->[$i] = bbrad($i + 360, $T);
		
	}

	# compute colorimetry
	$X = dotProduct($cmf->{'CIE1931x'}, $b);
	$Y = dotProduct($cmf->{'CIE1931y'}, $b);
	$Z = dotProduct($cmf->{'CIE1931z'}, $b);

	# compute denominator
	($d = $X + $Y + $Z) || croak('X + Y + Z = 0 when computing chromaticity');

	# return x,y
	return($X/$d, $Y/$d);

}

# compute UCS 1960 values of black body radiator
# parameter: (temperature)
# returns: (u, v)
sub bbuv {