File Coverage

blib/lib/ICC/Profile/cvst.pm

Criterion	Covered	Total	%
statement	42	1010	4.1
branch	6	394	1.5
condition	2	212	0.9
subroutine	12	61	19.6
pod	1	35	2.8
total	63	1712	3.6

package ICC::Profile::cvst;

use strict;
use Carp;

our $VERSION = 0.48;

# revised 2019-09-28
#
# Copyright © 2004-2020 by William B. Birkett

# inherit from Shared
use parent qw(ICC::Shared);

# support modules
use Template;
use Time::Piece;
use XML::LibXML;

# enable static variables
use feature 'state';

# create new cvst object
# array contains curve objects for each channel
# file path to 'iso_18620', 'store', or 'text' format curves
# curve objects must have 'transform' and 'derivative' methods
# parameters: ([ref_to_array])
# parameters: ([file_path])
# returns: (ref_to_object)
sub new {

	# get object class
	my $class = shift;

	# create empty cvst object
	my $self = [
		{},    # object header
		[],    # curve object array
	];

	# if there are parameters
	if (@_) {

		# if one parameter, an array reference
		if (@_ == 1 && ref($_[0]) eq 'ARRAY') {

			# make new cvst object from array
			_new_from_array($self, shift());

		# if one parameter, a scalar
		} elsif (@_ == 1 && ! ref($_[0])) {

			# make new cvst object from curve file
			_new_from_file($self, shift());

		} else {

			# error
			croak('\'cvst\' invalid parameter');

		}

	}

	# bless object
	bless($self, $class);

	# return object reference
	return($self);

}

# create inverse 'cvst' object
# returns: (ref_to_object)
sub inv {

	# get object
	my $self = shift();

	# local variables
	my ($array);

	# for each curve object
	for my $i (0 .. $#{$self->[1]}) {

		# verify curve object has 'inv' method
		($self->[1][$i]->can('inv')) or croak('curve element lacks \'inv\' method');

		# make inverse curve object
		$array->[$i] = $self->[1][$i]->inv();

	}

	# return
	return(ICC::Profile::cvst->new($array));

}

# create cvst object from ICC profile
# assumes file handle is positioned at start of cvst data
# header information must be read separately by the calling function
# parameters: (ref_to_parent_object, file_handle, input_channels, output_channels)
# returns: (ref_to_object)
sub new_fh {

	# get object class
	my $class = shift();

	# create empty cvst object
	my $self = [
		{},    # object header
		[],    # curve object array
	];

	# verify 3 parameters
	(@_ == 3) or croak('wrong number of parameters');

	# read cvst data from profile
	_readICCcvst($self, @_);

	# bless object
	bless($self, $class);

	# return object reference
	return($self);

}

# writes cvst tag object to ICC profile
# parameters: (ref_to_parent_object, file_handle, ref_to_tag_table_entry)
sub write_fh {

	# verify 4 parameters
	(@_ == 4) or croak('wrong number of parameters');

	# write cvst data to profile
	goto &_writeICCcvst;

}

# get cvst size (for writing to profile)
# returns: (cvst_size)
sub size {

	# get parameter
	my $self = shift();

	# get size of header and table
	my $size = 12 + 8 * @{$self->[1]};

	# for each curve object
	for my $crv (@{$self->[1]}) {

		# add size
		$size += $crv->size();

		# adjust to 4-byte boundary
		$size += -$size % 4;

	}

	# return size
	return($size);

}

# get number of input channels
# returns: (number)
sub cin {

	# get object reference
	my $self = shift();

	# return
	return(scalar(@{$self->[1]}));

}

# get number of output channels
# returns: (number)
sub cout {

	# get object reference
	my $self = shift();

	# return
	return(scalar(@{$self->[1]}));

}

# transform data
# hash key: 'clip'
# supported input types:
# parameters: (list, [hash])
# parameters: (vector, [hash])
# parameters: (matrix, [hash])
# parameters: (Math::Matrix_object, [hash])
# parameters: (structure, [hash])
# returns: (same_type_as_input)
sub transform {

	# set hash value (0 or 1)
	my $h = ref($_[-1]) eq 'HASH' ? 1 : 0;

	# if input a 'Math::Matrix' object
	if (@_ == $h + 2 && UNIVERSAL::isa($_[1], 'Math::Matrix')) {

		# call matrix transform
		&_trans2;

	# if input an array reference
	} elsif (@_ == $h + 2 && ref($_[1]) eq 'ARRAY') {

		# if array contains numbers (vector)
		if (! ref($_[1][0]) && @{$_[1]} == grep {Scalar::Util::looks_like_number($_)} @{$_[1]}) {

			# call vector transform
			&_trans1;

		# if array contains vectors (2-D array)
		} elsif (ref($_[1][0]) eq 'ARRAY' && @{$_[1]} == grep {ref($_) eq 'ARRAY' && Scalar::Util::looks_like_number($_->[0])} @{$_[1]}) {

			# call matrix transform
			&_trans2;

		} else {

			# call structure transform
			&_trans3;

		}

	# if input a list (of numbers)
	} elsif (@_ == $h + 1 + grep {Scalar::Util::looks_like_number($_)} @_) {

		# call list transform
		&_trans0;

	} else {

		# error
		croak('invalid transform input');

	}

}

# invert data
# hash key: 'clip'
# supported input types:
# parameters: (list, [hash])
# parameters: (vector, [hash])
# parameters: (matrix, [hash])
# parameters: (Math::Matrix_object, [hash])
# parameters: (structure, [hash])
# returns: (same_type_as_input)
sub inverse {

	# set hash value (0 or 1)
	my $h = ref($_[-1]) eq 'HASH' ? 1 : 0;

	# if input a 'Math::Matrix' object
	if (@_ == $h + 2 && UNIVERSAL::isa($_[1], 'Math::Matrix')) {

		# call matrix transform
		&_inv2;

	# if input an array reference
	} elsif (@_ == $h + 2 && ref($_[1]) eq 'ARRAY') {

		# if array contains numbers (vector)
		if (! ref($_[1][0]) && @{$_[1]} == grep {Scalar::Util::looks_like_number($_)} @{$_[1]}) {

			# call vector transform
			&_inv1;

		# if array contains vectors (2-D array)
		} elsif (ref($_[1][0]) eq 'ARRAY' && @{$_[1]} == grep {ref($_) eq 'ARRAY' && Scalar::Util::looks_like_number($_->[0])} @{$_[1]}) {

			# call matrix transform
			&_inv2;

		} else {

			# call structure transform
			&_inv3;

		}

	# if input a list (of numbers)
	} elsif (@_ == $h + 1 + grep {Scalar::Util::looks_like_number($_)} @_) {

		# call list transform
		&_inv0;

	} else {

		# error
		croak('invalid transform input');

	}

}

# compute Jacobian matrix
# hash key 'diag' for diagonal vector
# parameters: (input_vector, [hash])
# returns: (Jacobian_matrix, [output_vector])
sub jacobian {

	# get parameters
	my ($self, $in, $hash) = @_;

	# local variables
	my (@drv, $out, $jac);

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute derivative
		$drv[$i] = $self->[1][$i]->derivative($in->[$i]);

		# compute transform
		$out->[$i] = $self->[1][$i]->transform($in->[$i]) if wantarray;

	}

	# if 'diag' enabled
	if ($hash->{'diag'}) {

		# make diagonal vector
		$jac = [@drv];

	} else {

		# make diagonal matrix
		$jac = Math::Matrix->diagonal(@drv);

	}

	# if output values wanted
	if (wantarray) {

		# return Jacobian matrix and output vector
		return($jac, $out);

	} else {

		# return Jacobian matrix only
		return($jac);

	}

}

# compute parametric Jacobian matrix
# parameters are selected by the 'slice' array -or- matrix
# note: see 'cvst_parajac_matrix.plx' for explanation
# parameters: (input_vector)
# returns: (parametric_jacobian_matrix)
sub parajac {

	# get parameters
	my ($self, $in) = @_;

	# local variables
	my ($s, $type, @pj, $jac);

	# verify curve object has 'parametric' method
	($self->[1][0]->can('parametric')) or croak("curve object has no 'parametric' method");

	# get 'slice' value
	$s = $self->[0]{'slice'};

	# determine 'slice' type (0 is undef, 1 is vector, 2 is matrix)
	$type = ! defined($s) ? 0 : ICC::Shared::is_num_vector($s) ? 1 : ICC::Shared::is_num_matrix($s) && @{$s} == @{$self->[1]} ? 2 : croak("invalid slice for 'parajac' method");

	# initialize matrix
	$jac = [map {[]} 0 .. $#{$self->[1]}];

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# skip if slice empty
		next if (($type == 1 && ! @{$s}) || ($type == 2 && ! @{$s->[$i]}));

		# get parametric partial derivatives
		@pj = $self->[1][$i]->parametric($in->[$i]);

		# for each channel
		for my $j (0 .. $#{$self->[1]}) {

			# if current channel
			if ($j == $i) {

				# if vector slice
				if ($type == 1) {

					# push slice parameters on matrix row
					push(@{$jac->[$j]}, @pj[@{$s}]);

				# if matrix slice
				} elsif ($type == 2) {

					# push slice parameters on matrix row
					push(@{$jac->[$j]}, @pj[@{$s->[$i]}]);

				} else {

					# push all parameters on matrix row
					push(@{$jac->[$j]}, @pj);

				}

			} else {

				# if vector slice
				if ($type == 1) {

					# push zeros on matrix row
					push(@{$jac->[$j]}, (0) x @{$s});

				# if matrix slice
				} elsif ($type == 2) {

					# push zeros on matrix row
					push(@{$jac->[$j]}, (0) x @{$s->[$i]});

				} else {

					# push zeros on matrix row
					push(@{$jac->[$j]}, (0) x @pj);

				}

			}

		}

	}

	# return Jacobian matrix
	return(bless($jac, 'Math::Matrix'));

}

# get/set reference to header hash
# parameters: ([ref_to_new_hash])
# returns: (ref_to_hash)
sub header {

	# get object reference
	my $self = shift();

	# if there are parameters
	if (@_) {

		# if one parameter, a hash reference
		if (@_ == 1 && ref($_[0]) eq 'HASH') {

			# set header to new hash
			$self->[0] = {%{shift()}};

		} else {

			# error
			croak('parameter must be a hash reference');

		}

	}

	# return reference
	return($self->[0]);

}

# get/set array reference
# parameters: ([ref_to_new_array])
# returns: (ref_to_array)
sub array {

	# get object reference
	my $self = shift();

	# if one parameter supplied
	if (@_ == 1) {

		# verify array reference
		(ref($_[0]) eq 'ARRAY') or croak('not an array reference');

		# get array reference
		my $array = shift();

		# for each curve element
		for my $i (0 .. $#{$array}) {

			# verify object has processing methods
			($array->[$i]->can('transform') && $array->[$i]->can('derivative')) or croak('curve element lacks \'transform\' or \'derivative\' method');

			# add curve element
			$self->[1][$i] = $array->[$i];

		}

	} elsif (@_) {

		# error
		croak("too many parameters\n");

	}

	# return array reference
	return($self->[1]);

}

# get 'para' or 'parf' curve parameters
# returns: (ref_to_array)
sub pars {

	# get object reference
	my $self = shift();

	# local variables
	my ($pars);

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# verify curve is a 'para' or 'parf' object
		(UNIVERSAL::isa($self->[1][$i], 'ICC::Profile::para') || UNIVERSAL::isa($self->[1][$i], 'ICC::Profile::parf')) or croak('curve is not a \'para\' or \'parf\' object');

		# copy parameters
		$pars->[$i] = [@{$self->[1][$i]->array}];

	}

	# return parameter array
	return($pars);

}

# make new 'cvst' object containing 'curv' objects
# assumes curve domain/range is (0 - 1)
# direction: 0 - normal, 1 - inverse
# parameters: (number_of_table_entries, [direction])
# returns: (cvst_object)
sub curv {

	# get parameters
	my ($self, $n, $dir) = @_;

	# local variables
	my ($curv);

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# create table array
		$curv->[$i] = $self->[1][$i]->curv($n, $dir);

	}

	# return 'cvst' object
	return(ICC::Profile::cvst->new($curv));

}

# write Agfa Apogee tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub apogee {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, %ink);
	my ($dom, $root, @obj);
	my ($i, @out);

	# process options
	($dir, $steps) = _options($opts);

	# set ink hash
	%ink = ('Cyan', 0, 'Magenta', 1, 'Yellow', 2, 'Black', 3);

	# filter path
	ICC::Shared::filterPath($path);

	# open curve set template
	eval {$dom = XML::LibXML->load_xml('location' => ICC::Shared::getICCPath('Templates/Apogee_template.xml'))} or croak('can\'t load Apogee curve template');

	# get the root element
	$root = $dom->documentElement();

	# get the 'Curve' nodes
	@obj = $root->findnodes('Curve');

	# for each 'Curve' node
	for my $n (@obj) {

		# look-up the color index (0 - 3)
		$i = $ink{$n->getAttribute('Name')};

		# set the 'Stimuli' values
		$n->setAttribute('Stimuli', join(' ', @{$steps}));

		# set the 'Measured' values
		$n->setAttribute('Measured', join(' ', @{$steps}));

		# compute and set the 'Wanted' values
		$n->setAttribute('Wanted', join(' ', map {sprintf("%f", 100 * ($self->[1][$i]->_transform($dir, $_/100)))} @{$steps}));

		# compute and set the 'TransferCurve' values
		$n->setAttribute('TransferCurve', join(' ', map {sprintf("%f", 100 * ($self->[1][$i]->_transform($dir, $_/255)))} (0 .. 255)));

	}

	# add namespace attribute
	$root->setAttribute('xmlns', 'file:///procres');

	# write XML file
	$dom->toFile($path, 1);

}

# write CGATS tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub cgats {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $mat, $fmt, $chart);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# for each step
	for my $i (0 .. $#{$steps}) {

		# add SampleID
		$mat->[$i][0] = "A$i";

		# add input step value
		$mat->[$i][1] = sprintf("\"%.2f\"", $steps->[$i]);

		# for each curve
		for my $j (0 .. $#{$self->[1]}) {

			# add output step value
			$mat->[$i][$j + 2] = sprintf("%.2f", 100 * ($self->[1][$j]->_transform($dir, $steps->[$i]/100)));

		}

	}

	# make format string
	$fmt = [qw(SampleID SAMPLE_NAME CMYK_C CMYK_M CMYK_Y CMYK_K), map {"SPOT_$_"} 1 .. ($#{$self->[1]} - 3)];

	# make Chart object
	$chart = ICC::Support::Chart->new($mat, {'format' => $fmt});

	# add keywords
	$chart->keyword('ORIGINATOR', '"PressCal"');
	$chart->created(time);
	$chart->keyword('LGOROWLENGTH', 5);

	# write chart object
	$chart->write($path);

}

# write device link profile containing tone curves
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub device_link {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $n, $sig, $clrt, $profile, $b);

	# process options
	($dir) = _options($opts);

	# get number of channels
	$n = @{$self->[1]};

	# filter path
	ICC::Shared::filterPath($path);

	# if grayscale
	if ($n == 1) {

		# make signature
		$sig = 'GRAY';

	} elsif ($n == 3) {

		# make signature
		$sig = 'RGB ';

	} elsif ($n == 4) {

		# make signature
		$sig = 'CMYK';

	} else {

		# make signature
		$sig = sprintf("%XCLR", $n);

		# make colorant tag (could be developed further)
		$clrt = ICC::Profile::clrt->new();

	}

	# make device link profile object
	$profile = ICC::Profile->new({'class' => 'link', 'data' => $sig, 'PCS' => $sig, 'version' => '04200000'});

	# add copyright tag
	$profile->tag({'cprt' => ICC::Profile::mluc->new('en', 'US', 'Copyright (c) 2004-2019 by William B. Birkett')});

	# add description tag
	$profile->tag({'desc' => ICC::Profile::mluc->new('en', 'US', 'tone curves')});

	# add profile sequence tag
	$profile->tag({'pseq' => ICC::Profile::pseq->new()});

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# if direction is forward and curve is an ICC::Profile object
		if ($dir == 0 && (UNIVERSAL::isa($self->[1][$i], 'ICC::Profile::curv') || UNIVERSAL::isa($self->[1][$i], 'ICC::Profile::para'))) {

			# use curve object as-is
			$b->[$i] = $self->[1][$i];

		} else {

			# use ICC::Profile::curv equivalent
			$b->[$i] = $self->[1][$i]->curv(1285, $dir);

		}

	}

	# add A2B0 tag (B-curves only)
	$profile->tag({'A2B0' => ICC::Profile::mAB_->new({'b_curves' => ICC::Profile::cvst->new($b)})});

	# add colorant tags, if nCLR
	$profile->tag({'clrt' => $clrt, 'clot' => $clrt}) if (defined($clrt));

	# write profile
	$profile->write($path);

}

# write EFI (.vpc/.vcc) tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub efi {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @ch, $include, $tt, $t, $fh, $str, $vars);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# channel lookup (EFI ink sequence is YMCK)
	@ch = (2, 1, 0, 3, 4, 5, 6, 7);

	# if ICC::Templates folder is found in @INC (may be relative)
	if (($include) = grep {-d} map {File::Spec->catdir($_, 'ICC', 'Templates')} @INC) {

		# make a template processing object
		$tt = Template->new({'INCLUDE_PATH' => $include});

		# for each curve
		for my $i (0 .. 7) {

			# open file handle to string
			open($fh, '>', \$str);

			# print header
			print $fh "BEGIN\n";

			# if curve object is defined
			if (defined($self->[1][$i])) {

				# print number of points
				printf $fh "%d\n", scalar(@{$steps});

				# for each curve input
				for my $t (@{$steps}) {

					# print output and input device values
					printf $fh "%.5f %.5f\n", $self->[1][$i]->_transform($dir, $t/100), $t/100;

				}

				# for each integer byte value
				for my $t (0 .. 255) {

					# print input and output values
					printf $fh "%d %.0f\n", $t, 255 * $self->[1][$i]->_transform($dir, $t/255);

				}

			} else {

				# print identity curve
				print $fh "2\n0.00000 0.00000\n1.00000 1.00000\n";

				# for each integer byte value
				for my $t (0 .. 255) {

					# print input and output values
					printf $fh "%d %d\n", $t, $t;

				}

			}

			# print footer
			print $fh "END";

			# add string to template hash
			$vars->{"curve$ch[$i]"} = $str;

			# close file handle
			close($fh);

		}

		# make Time::Piece object
		$t = localtime;

		# add date to template hash
		$vars->{'date'} = $t->strftime('%m-%d-%y');

		# process the template
		$tt->process('cvst_efi_vcc.tt2', $vars, $path) || CORE::die $tt->error();

	}

}

# write Fuji XMF tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub fuji_xmf {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $fh, $rs, @colors, @Tdot);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# disable :crlf translation
	binmode($fh);

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# set color list
	@colors = qw(Cyan Magenta Yellow Black);

	# print colors
	print $fh join(';', @colors), $rs;

	# for each step
	for my $j (0 .. 100) {

		# if a valid dot value
		if (grep {$j == $_} @{$steps}) {

			# for each channel
			for my $i (0 .. 3) {

				# compute transformed dot value
				$Tdot[$i] = sprintf("%.2f", 100 * ($self->[1][$i]->_transform($dir, $j/100)));

			}

			# print transformed values
			print $fh join(';', @Tdot), $rs;

		} else {

			# print empty line
			print $fh '‐;‐;‐;‐', $rs;

		}

	}

	# close the file
	close($fh);

}

# write Harlequin tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# note: values must be entered manually in RIP
# use 'navigator' method to make Postscript curves
# parameters: (file_path, [options])
sub harlequin {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @files, $fh, $rs, @colors);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# disable :crlf translation
	binmode($fh);

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# set color list
	@colors = qw(Cyan Magenta Yellow Black);

	# for each channel
	for my $i (0 .. 3) {

		# print color
		print $fh "$colors[$i]$rs";

		# for each step
		for my $j (0 .. $#{$steps}) {

			# print input and transformed values
			printf $fh "%7.2f   %7.2f$rs", $steps->[$j], 100 * ($self->[1][$i]->_transform($dir, $steps->[$j]/100));

		}

		# print space
		print $fh "$rs$rs";

	}

	# close the file
	close($fh);

}

# write HP Indigo tone curve file set
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (folder_path, [options])
sub indigo {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $rs, $fh, $file);
	my (@CMYK, $dotr, $dotp);

	# process options
	($dir, $steps) = _options($opts);

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# filter path
	ICC::Shared::filterPath($path);

	# make the folder
	File::Path::make_path($path);

	# ink color array (for building file names)
	@CMYK = qw(Cyan Magenta Yellow Black);

	# for each color
	for my $i (0 .. 3) {

		# build the file path
		$file = $^O eq 'MSWin32' ? "$path\\tone_curve-$CMYK[$i].lut" : "$path/tone_curve-$CMYK[$i].lut";

		# create the file
		open($fh, '>', $file) or croak("can't open $file: $!");

		# disable :crlf translation
		binmode($fh);

		# for each step
		for my $j (0 .. $#{$steps}) {

			# get reference device value
			$dotr = $steps->[$j]/100;

			# get press device value
			$dotp = $self->[1][$i]->_transform($dir, $dotr);

			# limit %-dot (0 - 100)
			$dotr = ($dotr < 0) ? 0 : $dotr;
			$dotp = ($dotp < 0) ? 0 : $dotp;
			$dotr = ($dotr > 1) ? 1 : $dotr;
			$dotp = ($dotp > 1) ? 1 : $dotp;

			# print step info
			printf $fh "%4.2f\t%6.4f$rs", $dotr, $dotp;

		}

		# close file
		close($fh);

	}

}

# write ISO 18620 (TED) tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps', 'inks', 'origin',
#	'Creator', 'OperatorName', 'PressName', 'MediaName',
#	'TransferCurveSetID', 'Side'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub iso_18620 {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @inks, $zflag);
	my ($doc, $root, $t, $datetime, $curve, @out);

	# process options
	($dir, $steps) = _options($opts);

	# set ink colors
	@inks = $#{$self->[1]} ? qw(Cyan Magenta Yellow Black) : qw(Black);

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# set ink value, defaults to 'inkN'
		$inks[$i] = $opts->{'inks'}[$i] // $self->[0]{'inks'}[$i] // $inks[$i] // sprintf("ink%d", $i + 1);

	}

	# filter path
	ICC::Shared::filterPath($path);

	# create XML document
	$doc = XML::LibXML->createDocument('1.0', 'UTF-8');

	# create root element
	$root = $doc->createElement('TransferCurveSet');

	# add root node
	$doc->setDocumentElement($root);

	# make Time::Piece object
	$t = localtime;

	# set 'CreationDate' attribute
	$root->setAttribute('CreationDate', sprintf("%s%+03d:00", $t->datetime, $t->tzoffset->hours));

	# verify 'Side' attribute
	(! defined($opts->{'Side'}) || $opts->{'Side'} eq 'Front' || $opts->{'Side'} eq 'Back') or croak('invalid \'Side\' attribute');

	# for each optional TransferCurveSet attribute
	for my $key (qw(Creator OperatorName PressName MediaName TransferCurveSetID Side)) {

		# if attribute contained in hash
		if (defined($opts->{$key})) {

			# set attribute value
			$root->setAttribute($key, $opts->{$key});

		}

	}

	# set 'Creator' attribute, if undefined
	$root->setAttribute('Creator', 'ICC-Profile Toolkit') if (! defined($opts->{'Creator'}));

	# get 'origin' flag
	$zflag = $opts->{'origin'} // 0;

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# create curve element
		$curve = $doc->createElement('TransferCurve');

		# set the 'Separation' attribute
		$curve->setAttribute('Separation', $inks[$i]);

		# compute and set the 'Curve' values
		$curve->setAttribute('Curve', join(' ', map {sprintf("%f %f", $_/100, ($_ == 0 && $zflag) ? 0 : $self->[1][$i]->_transform($dir, $_/100))} @{$steps}));

		# add curve node
		$root->addChild($curve);

	}

	# add namespace attribute
	$root->setAttribute('xmlns', 'http://www.npes.org/schema/ISO18620/');

	# write XML file
	$doc->toFile($path, 1);

}

# write Xitron Navigator tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir', 'inks', 'name', 'colorspace'
# direction: 0 - normal, 1 - inverse
# note: makes a Postscript file for 'push calibration'
# see Harlequin technical note Hqn081
# parameters: (file_path, [options])
sub navigator {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @inks, $tt, $include, $vars, $fh, $str);

	# process options
	($dir, $steps) = _options($opts);

	# set ink colors
	@inks = $#{$self->[1]} ? qw(Cyan Magenta Yellow Black) : qw(Black);

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# set ink value, defaults to 'inkN'
		$inks[$i] = $opts->{'inks'}[$i] // $self->[0]{'inks'}[$i] // $inks[$i] // sprintf("ink%d", $i + 1);

	}

	# filter path
	ICC::Shared::filterPath($path);

	# if ICC::Templates folder is found in @INC (may be relative)
	if (($include) = grep {-d} map {File::Spec->catdir($_, 'ICC', 'Templates')} @INC) {

		# make a template processing object
		$tt = Template->new({'INCLUDE_PATH' => $include});

		# set channels
		$vars->{'channels'} = join(' ', map {"/$_"} @inks);

		# set channel colors
		$vars->{'channelcolors'} = join(' ', map {"($_)"} @inks);

		# set number of channels
		$vars->{'number'} = @inks;

		# set name
		$vars->{'name'} = $opts->{'name'} // 'PressCal Calset ' . time();

		# set colorspace
		$vars->{'colorspace'} = $opts->{'colorspace'} // 'DeviceCMYK';

		# open file handle to string
		open($fh, '>', \$str);

		# for each channel
		for my $i (0 .. $#{$self->[1]}) {

			# start curve
			printf $fh "    /%s [\n", $inks[$i];

			# for each step
			for my $j (0 .. $#{$steps}) {

				# print input and transformed values
				printf $fh "    %.2f %% C%s\n", 100 * ($self->[1][$i]->_transform($dir, $steps->[$j]/100)), $steps->[$j];

			}

			# end curve
			print $fh "    ]\n";

		}

		# add string to template hash
		$vars->{'curves'} = $str;

		# close file handle
		close($fh);

		# process the template
		$tt->process('cvst_navigator.tt2', $vars, $path) || CORE::die $tt->error();

	}

}

# write Photoshop tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps'
# direction: 0 - normal, 1 - inverse
# note: Photoshop curves must have between 2 and 16 steps
# parameters: (file_path, [options])
sub photoshop {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $xval, $n, $fh, $x, $y, $xmin, $xmax, $xp, @yx);

	# process options
	($dir, $steps) = _options($opts);

	# if 'steps' array supplied
	if (@{$steps}) {

		# copy step values
		$xval = [map {$_/100} @{$steps}];

		# verify maximum number of curve points
		($#{$xval} < 16) or croak('photoshop curve steps array has more than 16 points');

		# verify minimum number of curve points
		($#{$xval} > 0) or croak('photoshop curve steps array has less than 2 points');

	# if 'bern' curve objects
	} elsif (UNIVERSAL::isa($self->[1][0], 'ICC::Support::bern')) {

		# get maximum upper index of Bernstein coefficient arrays
		$n = ($#{$self->[1][0]->input} > $#{$self->[1][0]->output}) ? $#{$self->[1][0]->input} : $#{$self->[1][0]->output};

		# compute upper index
		$n = 2 * $n < 16 ? 2 * $n : 15;

		# make x-value array
		$xval = [map {$_/$n} (0 .. $n)];

	# if 'spline' curve objects
	} elsif (UNIVERSAL::isa($self->[1][0], 'ICC::Support::spline')) {

		# compute upper index
		$n = 2 * $#{$self->[1][0]->output} < 16 ? 2 * $#{$self->[1][0]->output} : 15;

		# make x-value array
		$xval = [map {$_/$n} (0 .. $n)];

	} else {

		# use default array (5 points)
		$xval = [map {$_/4} (0 .. 4)];

	}

	# sort the x-values from low to high
	@{$xval} = sort {$a <=> $b} @{$xval};

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# set binary mode
	binmode($fh);

	# print the version and number of curves (including master curve)
	print $fh pack('n2', 4, scalar(@{$self->[1]}) + 1);

	# print null master curve
	print $fh pack('n5', 2, 0, 0, 255, 255);

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute min and max x-values (correspond to y-values of 0 and 1)
		$xmin = $self->[1][$i]->_transform((1 - $dir), 0);
		$xmax = $self->[1][$i]->_transform((1 - $dir), 1);

		# swap min and max if negative curve
		($xmax, $xmin) = ($xmin, $xmax) if ($xmin > $xmax);

		# initialize point array
		@yx = ();

		# initialize previous x-value
		$xp = -1;

		# for each point
		for my $j (0 .. $#{$xval}) {

			# get x-value
			$x = $xval->[$j];

			# limit x-value (previously limited domain 0 - 1)
			$x = $x > $xmax ? $xmax : ($x < $xmin ? $xmin : $x);

			# skip if x-value same as previous
			next if ($x == $xp);

			# set previous x-value
			$xp = $x;

			# get y-value
			$y = $self->[1][$i]->_transform($dir, $x);

			# limit y-value
			$y = $y > 1 ? 1 : ($y < 0 ? 0 : $y);

			# push y-x pair on array (Photoshop curve points are [output, input])
			push(@yx, [$y, $x]);

		}

		# print number of points
		print $fh pack('n', scalar(@yx));

		# if 3 channels (RGB)
		if (@{$self->[1]} == 3) {

			# for each point
			for (@yx) {

				# print point value (y, x), normal for RGB
				print $fh pack('n2', map {255 * $_ + 0.5} @{$_});

			}

		} else {

			# for each point (in reverse order)
			for (reverse(@yx)) {

				# print point value (y, x), complemented for Grayscale, CMYK, Multichannel
				print $fh pack('n2', map {255 * (1 - $_) + 0.5} @{$_});

			}

		}

	}

	# close the file
	close($fh);

	# set file creator and type (OS X only)
	ICC::Shared::setFile($path, '8BIM', '8BSC');

}

# write Prinergy (Harmony) tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'Comments', 'CurveSet', 'DefaultFrequency', 'DefaultMedium',
#	'DefaultResolution', 'DefaultSpotFunction', 'Enabled', 'FirstName', 'FreqFrom', 'FreqTo',
#	'ID', 'Medium', 'Resolution', 'ScreeningType', 'SpotFunction', 'SpotFunctionMode'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub prinergy {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @inks, $tt, $include, $vars, @time, @month, $fh, $rs, @map, $str);

	# process options
	($dir, $steps) = _options($opts);

	# set ink colors
	@inks = $#{$self->[1]} ? qw(Cyan Magenta Yellow Black) : qw(Black);

	# for each curve
	for my $i (0 .. $#{$self->[1]}) {

		# set ink value, defaults to 'inkN'
		$inks[$i] = $opts->{'inks'}[$i] // $self->[0]{'inks'}[$i] // $inks[$i] // sprintf("ink%d", $i + 1);

	}

	# filter path
	ICC::Shared::filterPath($path);

	# if ICC::Templates folder is found in @INC (may be relative)
	if (($include) = grep {-d} map {File::Spec->catdir($_, 'ICC', 'Templates')} @INC) {

		# make a template processing object
		$tt = Template->new({'INCLUDE_PATH' => $include});

		# copy options hash
		$vars = Storable::dclone($opts);

		# set time
		$vars->{'Time'} = time();

		# get localtime
		@time = localtime($vars->{'Time'});

		# set date as string
		$vars->{'date'} = sprintf "%d/%d/%d %2.2d:%2.2d:%2.2d", $time[4] + 1, $time[3], $time[5] + 1900, $time[2], $time[1], $time[0];

		# make array of months
		@month = qw(January February March April May June July August September October November December);

		# set DateTime as string
		$vars->{'DateTime'} = sprintf "%2.2d %s %d %2.2d:%2.2d:%2.2d", $time[3], $month[$time[4]], $time[5] + 1900, $time[2], $time[1], $time[0];

		# set defaults
		$vars->{'FirstName'} = $vars->{'FirstName'} // 'PressCal';
		$vars->{'ID'} = $vars->{'ID'} // '0001';
		$vars->{'Enabled'} = $vars->{'Enabled'} // 'FALSE';
		$vars->{'CurveSet'} = $vars->{'CurveSet'} // 'CmykCurves';
		$vars->{'SpotFunctionMode'} = $vars->{'SpotFunctionMode'} // 'UserDefined';

		# set true or false
		$vars->{'MediumUsed'} = defined($vars->{'Medium'}) ? 'TRUE' : 'FALSE';
		$vars->{'ScreeningTypeUsed'} = defined($vars->{'ScreeningType'}) ? 'TRUE' : 'FALSE';
		$vars->{'ResolutionUsed'} = defined($vars->{'Resolution'}) ? 'TRUE' : 'FALSE';
		$vars->{'FrequencyUsed'} = (defined($vars->{'FreqFrom'}) && defined($vars->{'FreqFrom'})) ? 'TRUE' : 'FALSE';
		$vars->{'SpotFunctionUsed'} = defined($vars->{'SpotFunction'}) ? 'TRUE' : 'FALSE';

		# set combined description
		$vars->{'description'} = join(' ', grep {$_} @{$vars}{qw(FirstName Medium CurveSet FreqFrom Resolution)});

		# open file handle to string
		open($fh, '>', \$str);

		# disable :crlf translation
		binmode($fh);

		# set output record separator (Windows CR-LF)
		$rs = "\015\012";

		# set color map (KCMY + spot)
		@map = (3, 0, 1, 2, 4 .. 15);

		# for each channel
		for my $i (0 .. $#{$self->[1]}) {

			# print curve dropoff
			printf $fh "Curve%d DropOff = %d$rs", $i + 1, 0;

			# print curve color
			printf $fh "Curve%d Color = %s$rs", $i + 1, $inks[$map[$i]];

			# print curve start
			printf $fh "Curve%d = ", $i + 1;

			# print curve points
			for my $t (@{$steps}) {

				# print curve values
				printf $fh "%d %d ", 1E7 * $t/100 + 0.5, 1E7 * $self->[1][$map[$i]]->_transform($dir, $t/100) + 0.5;

			}

			# print curve end
			print $fh "$rs";

		}

		# add string to template hash
		$vars->{'curves'} = $str;

		# close the file
		close($fh);

		# process the template
		$tt->process('cvst_prinergy.tt2', $vars, $path) || CORE::die $tt->error();

	}

}

# write Rampage tone curve file set
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (folder_path, [options])
sub rampage {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $name, $rs, $fh0, $fh1, $file);
	my (@CMYK, $dotr, $dotp);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# make the folder, if needed
	File::Path::make_path($path);

	# get the folder name
	$name = (File::Spec->splitdir($path))[-1];

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# ink color array (for building file names)
	@CMYK = qw(C M Y K);

	# for each color
	for my $i (0 .. 3) {

		# build the DESIRED file path
		$file = $path . '/' . $name . '_DESIRED_' . $CMYK[$i];

		# create the DESIRED file
		open($fh0, '>', $file) or croak("can't open $file: $!");

		# disable :crlf translation
		binmode($fh0);

		# set file creator and type
		ICC::Shared::setFile($file, 'RamC', 'Clst');

		# build the ACT file path
		$file = $path . '/' . $name . '_ACT_' . $CMYK[$i];

		# create the ACT file
		open($fh1, '>', $file) or croak("can't open $file: $!");

		# disable :crlf translation
		binmode($fh1);

		# set file creator and type
		ICC::Shared::setFile($file, 'RamC', 'Clst');

		# print DESIRED header
		print $fh0 "2$rs";
		print $fh0 "0.0000000000$rs";
		print $fh0 "0.0000000000$rs";
		printf $fh0 "%2d$rs", $steps + 1;

		# print ACT header
		print $fh1 "2$rs";
		print $fh1 "0.0000000000$rs";
		print $fh1 "0.0000000000$rs";
		printf $fh1 "%2d$rs", $steps + 1;

		# for each step
		for my $j (0 .. $#{$steps}) {

			# get reference %-dot
			$dotr = $steps->[$j];

			# get press %-dot
			$dotp = 100 * $self->[1][$i]->_transform($dir, $dotr/100);

			# limit %-dot (0 - 100)
			$dotr = ($dotr < 0) ? 0 : $dotr;
			$dotp = ($dotp < 0) ? 0 : $dotp;
			$dotr = ($dotr > 100) ? 100 : $dotr;
			$dotp = ($dotp > 100) ? 100 : $dotp;

			# print DESIRED step info
			printf $fh0 "%3.1f    %3.1f$rs", $dotr, $dotp;

			# print ACT step info
			printf $fh1 "%3.1f    %3.1f$rs", $dotr, $dotr;

		}

		# print DESIRED footer
		print $fh0 "Version: 2.0$rs";

		# print ACT footer
		print $fh1 "Version: 2.0$rs";

		# close the DESIRED file
		close($fh0);

		# close the ACT file
		close($fh1);

	}

}

# write Xitron Sierra tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub sierra {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $fh, $rs, @colors, @Tdot);

	# process options
	($dir, $steps) = _options($opts);

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# disable :crlf translation
	binmode($fh);

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# set color list
	@colors = qw(Cyan Magenta Yellow Black);

	# print colors
	print $fh join(';', @colors), $rs;

	# for each step
	for my $j (0 .. $#{$steps}) {

		# for each channel
		for my $i (0 .. 3) {

			# compute transformed dot value
			$Tdot[$i] = sprintf("%.4f", 100 * ($self->[1][$i]->_transform($dir, $steps->[$j]/100)));

		}

		# print transformed values
		print $fh join(';', @Tdot), $rs;

	}

	# close the file
	close($fh);

}

# write Trueflow tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash key: 'dir'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub trueflow {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, @names, @colors, @map);
	my ($fh, $in, $out, $dg, @lut, $float);

	# process options
	($dir, $steps) = _options($opts);

	# set curve names
	@names = qw(Y M C K);

	# set curve display colors (YMCK)
	@colors = (0x00ffff, 0xff00ff, 0xffff00, 0x000000);

	# set color map (YMCK)
	@map = (2, 1, 0, 3);

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# set binary mode
	binmode($fh);

	# print the header
	print $fh pack('C4a4', 4, 3, 2, 1, 'DGT'); 	# file signature
	print $fh pack('V', 256);					# offset to first curve
	print $fh pack('V', 100);					#
	print $fh pack('V', 4);						# number of curves
	print $fh pack('V4', 640, 640, 640, 640);	# curve block sizes

	# seek start of first curve
	seek($fh, 256, 0);

	# loop thru colors (0-3) (YMCK)
	for my $i (0 .. 3) {

		# print curve name
		print $fh pack('a128', $names[$i]);

		# print display color
		print $fh pack('V', $colors[$i]);

		# print curve parameters (LUT_size, dot_gain_steps, dot_gain_table_size)
		print $fh pack('V3', 256, 15, 240);

		# print binary LUT
		#
		# for each step
		for my $j (0 .. 255) {

			# compute output value
			$out = $self->[1][$map[$i]]->_transform($dir, $j/255);

			# print LUT value (limited and rounded)
			print $fh pack('C', 255 * ($out < 0 ? 0 : ($out > 1 ? 1 : $out)) + 0.5);

		}

		# print dot gain table
		#
		# for each tone curve step
		for my $j (0 .. $#{$steps}) {

			# compute input value
			$in = $steps->[$j]/100;

			# compute output value
			$out = $self->[1][$map[$i]]->_transform($dir, $in);

			# compute dot gain (rounded to 0.1%)
			$dg = POSIX::floor(1000 * ($out - $in) + 0.5)/10;

			# print dot gain value (little-endian double)
			print $fh pack('C2 x6 d<', $steps->[$j], 1, $dg);

		}

	}

	# close the file
	close($fh);

}

# write tab delimited text tone curve file
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'steps'
# direction: 0 - normal, 1 - inverse
# parameters: (file_path, [options])
sub text {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $steps, $fp, $fh, $rs, @Tdot);

	# process options
	($dir, $steps) = _options($opts);

	# check for non-integer values
	$fp = grep {$_ != int($_)} @{$steps};

	# filter path
	ICC::Shared::filterPath($path);

	# open the file
	open($fh, '>', $path) or croak("can't open $path: $!");

	# disable :crlf translation
	binmode($fh);

	# set output record separator (Windows CR-LF)
	$rs = "\015\012";

	# for each step
	for my $t (@{$steps}) {

		# format input value
		$Tdot[0] = $fp ? sprintf("%.2f", $t) : $t;

		# for each channel
		for my $i (0 .. $#{$self->[1]}) {

			# compute transformed dot value
			$Tdot[$i + 1] = sprintf("%.2f", 100 * ($self->[1][$i]->_transform($dir, $t/100)));

		}

		# print step values
		print $fh join("\t", @Tdot), $rs;

	}

	# close the file
	close($fh);

}

# graph tone curves
# assumes curve domain/range is (0 - 1)
# options parameter may be a hash reference or direction flag
# hash keys: 'dir', 'lib', 'composite', 'titles', 'inks', 'files', 'open'
# direction: 0 - normal, 1 - inverse
# parameters: (folder_path, [options])
# returns: (graph_path_list)
sub graph {

	# get parameters
	my ($self, $path, $opts) = @_;

	# local variables
	my ($dir, $include, $tt, $vars, $min, $max, @inks, %exc, @colors, @data, @tooltips, $file, $s, @html);

	# process options
	($dir) = _options($opts);

	# if ICC::Templates folder is found in @INC (may be relative)
	if (($include) = grep {-d} map {File::Spec->catdir($_, 'ICC', 'Templates')} @INC) {

		# purify folder path
		ICC::Shared::filterPath($path);

		# make a template processing object
		$tt = Template->new({'INCLUDE_PATH' => $include, 'OUTPUT_PATH' => $path});

		# if gray scale curve
		if ($#{$self->[1]} == 0) {

			# set default ink color
			@inks = qw(gray);

		# if RGB curves
		} elsif ($#{$self->[1]} == 2) {

			# set default ink colors
			@inks = qw(red green blue);

		# if CMYK+ curves
		} else {

			# set default ink colors
			@inks = qw(cyan magenta yellow black);

		}

		# for each curve
		for my $i (0 .. $#{$self->[1]}) {

			# set ink value, defaults to 'inkN'
			$inks[$i] = $opts->{'inks'}[$i] // $self->[0]{'inks'}[$i] // $inks[$i] // sprintf("ink%d", $i + 1);

		}

		# graph color exceptions
		%exc = ('yellow' => '#ee0', 'orange' => '#f80', 'violet' => '#80f', 'gray' => '#777');

		# get graph colors, mapping exceptions
		@colors = map {$exc{$_} // $_} map {m/^ink_/ ? 'gray' : $_} @inks;

		# set RGraph library folder
		$vars->{'libjs'} = $opts->{'lib'} // 'lib';

		# set yaxis scale
		$vars->{'yscalemin'} = $min = $opts->{'yscalemin'} // 0.0;
		$vars->{'yscalemax'} = $max = $opts->{'yscalemax'} // 1.0;

		# if 'composite' curve
		if ($opts->{'composite'}) {

			# for each curve
			for my $i (0 .. $#{$self->[1]}) {

				# compute curve data
				@data = map {sprintf("%.3f", $self->[1][$i]->_transform($dir, $_/100))} (0 .. 100);

				# clip the data
				@data = map {$_ < $min ? $min : $_ > $max ? $max : $_} @data;

				# make javascript string of curve data
				$s->[$i] = '[' . join(', ', @data) . ']';

			}

			# make composite javascript string of curve data
			$vars->{'data'} = '[' . join(', ', @{$s}) . ']';

			# disable tooltips
			$vars->{'tooltips'} = '[]';

			# set graph title
			$vars->{'title'} = $opts->{'titles'}[0] // "composite tone curves";

			# set graph colors
			$vars->{'colors'} = '[' . join(', ', map {"'$_'"} @colors) . ']';

			# get file name
			$file = $opts->{'files'}[0] // 'composite';

			# process the template
			$tt->process('cvst_graph_svg.tt2', $vars, "$file.html") || CORE::die $tt->error();

		} else {

			# for each curve
			for my $i (0 .. $#{$self->[1]}) {

				# compute curve data
				@data = map {sprintf("%.3f", $self->[1][$i]->_transform($dir, $_/100))} (0 .. 100);

				# clip the data
				@data = map {$_ < $min ? $min : $_ > $max ? $max : $_} @data;

				# make javascript string of curve data
				$vars->{'data'} = '[[' . join(', ', @data) . ']]';

				# compute tooltips array
				@tooltips = map {$_ % 5 ? 'null' : sprintf("'%d%% ➔ %.1f%%'", $_, 100 * $data[$_])} (0 .. 100);

				# make tooltips
				$vars->{'tooltips'} = '[' . join(', ', @tooltips) . ']';

				# set graph title
				$vars->{'title'} = $opts->{'titles'}[$i] // "$inks[$i] tone curve";

				# set graph color
				$vars->{'colors'} = "['$colors[$i]']";

				# get file name
				$file = $opts->{'files'}[$i] // $inks[$i];

				# process the template
				$tt->process('cvst_graph_svg.tt2', $vars, "$file.html") || CORE::die $tt->error();

			}

		}

		# if 'composite' curve
		if ($opts->{'composite'}) {

			# if Windows OS
			if ($^O eq 'MSWin32') {

				# set file list
				@html = ("$path\\$file.html");

			} else {

				# set file list
				@html = ("$path/$file.html");

			}

		} else {

			# for each curve
			for my $i (0 .. $#{$self->[1]}) {

				# get file name
				$file = $opts->{'files'}[$i] // $inks[$i];

				# if Windows OS
				if ($^O eq 'MSWin32') {

					# add path to file list
					push(@html, "$path\\$file.html");

				} else {

					# add path to file list
					push(@html, "$path/$file.html");

				}

			}

		}

	}

	# open files, if enabled
	open_files(\@html) if ($opts->{'open'} // 1);

	# return
	return(@html);

}

# display graphs in web browser
# parameters: (ref_to_file_list)
sub open_files {

	# get file list
	my $files = shift();

	# local parameters
	my ($RGraph, $vol, $dir, $file, $lib, $app, @fox, @pid, @esc, $esc0, $flag, $timeout);

	# find RGraph folder path in @INC (may be relative)
	($RGraph) = grep {-d} map {File::Spec->catdir($_, 'ICC', 'JavaScripts', 'RGraph')} @INC;

	# if valid file list and RGraph folder found
	if (ref($files) eq 'ARRAY' && defined($files->[0]) && -f $files->[0] && defined($RGraph)) {

		# split first file path
		($vol, $dir, $file) = File::Spec->splitpath($files->[0]);

		# make 'lib' folder path
		$lib = File::Spec->catdir($vol, $dir, 'lib');

		# if macOS
		if ($^O eq 'darwin') {

			# copy RGraph JavaScripts to 'lib' folder
			qx(cp -Rp '$RGraph/' '$lib');

			# escape the file paths
			@esc = map {quotemeta()} @{$files};

			# get default app (using JXA)
			$app = qx(osascript -l JavaScript -e "Application('System Events').files.byName('$files->[0]').defaultApplication.name()");

			# remove endline
			chomp($app);

			# if default app is Firefox
			if ($app eq 'Firefox.app') {

				# get first file path
				$esc0 = shift(@esc);

				# open first graph
				qx(open $esc0);

				# if more graphs
				if (@esc) {

					# set timeout (5 secs)
					$timeout = time() + 5;

					# loop until we get Firefox pid -or- timeout
					while (! @fox && time() < $timeout) {

						# get Firefox pid
						@fox = split(/\s+/, qx(pgrep firefox));

					}

					# set flag
					$flag = 1;

					# loop until flag is cleared -or- timeout
					while ($flag && time() < $timeout) {

						# if 4 or more child processes
						if ((@pid = split(/\s+/, qx(pgrep -P $fox[0]))) > 3) {

							# for each child process
							for (@pid) {

								# clear flag if ps command contains '-sbAllowFileAccess'
								$flag = 0 if (qx(ps -p $_ -o command) =~ m/-sbAllowFileAccess/m);

							}

						}

					}

					# open remaining graphs
					qx(open @esc);

				}

			} else {

				# open all graphs
				qx(open @esc);

			}

		# if Windows OS
		} elsif ($^O eq 'MSWin32') {

			# copy RGraph JavaScripts to 'lib' folder
			qx(xcopy /I "$RGraph\\" "$lib\\");

			print "to be implemented\n\n"; ###########

		} else {

			print "unsupported OS\n\n";

		}

	}

	# return
	return();

}

# normalize all curve objects
# sets the domain and range of curves
# parameters: (as_appropriate_for_curve_objects)
sub normalize {

	# get object reference
	my $self = shift();

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# if curve object has 'normalize' method
		if ($self->[1][$i]->can('normalize')) {

			# call 'normalize' method
			$self->[1][$i]->normalize(@_);

		} else {

			# warning
			carp('\'normalize\' method not supported by ' . ref($self->[1][$i]) . ' object');

		}

	}

}

# update all curve objects
# update internal object elements
# this method used primarily when optimizing
# parameters: (as_appropriate_for_curve_objects)
sub update {

	# get object reference
	my $self = shift();

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# if curve object has 'update' method
		if ($self->[1][$i]->can('update')) {

			# call 'update' method
			$self->[1][$i]->update(@_);

		} else {

			# warning
			carp('\'update\' method not supported by ' . ref($self->[1][$i]) . ' object');

		}

	}

}

# print object contents to string
# format is an array structure
# parameter: ([format])
# returns: (string)
sub sdump {

	# get parameters
	my ($self, $p) = @_;

	# local variables
	my ($element, $fmt, $s, $pt, $st);

	# resolve parameter to an array reference
	$p = defined($p) ? ref($p) eq 'ARRAY' ? $p : [$p] : [];

	# get format string
	$fmt = defined($p->[0]) && ! ref($p->[0]) ? $p->[0] : 's';

	# set string to object ID
	$s = sprintf("'%s' object, (0x%x)\n", ref($self), $self);

	# if format contains 'o'
	if ($fmt =~ m/s/) {

		# get default parameter
		$pt = $p->[-1];

		# for each processing element
		for my $i (0 .. $#{$self->[1]}) {

			# get element reference
			$element = $self->[1][$i];

			# if processing element is undefined
			if (! defined($element)) {

				# append message
				$s .= "\tprocessing element is undefined\n";

			# if processing element is not a blessed object
			} elsif (! Scalar::Util::blessed($element)) {

				# append message
				$s .= "\tprocessing element is not a blessed object\n";

			# if processing element has an 'sdump' method
			} elsif ($element->can('sdump')) {

				# get 'sdump' string
				$st = $element->sdump(defined($p->[$i + 1]) ? $p->[$i + 1] : $pt);

				# prepend tabs to each line
				$st =~ s/^/\t/mg;

				# append 'sdump' string
				$s .= $st;

			# processing element is object without an 'sdump' method
			} else {

				# append object info
				$s .= sprintf("\t'%s' object, (0x%x)\n", ref($element), $element);

			}

		}

	}

	# return
	return($s);

}

# transform list
# parameters: (ref_to_object, list, [hash])
# returns: (list)
sub _trans0 {

	# local variables
	my ($self, @out, $hash);

	# get object reference
	$self = shift();

	# get optional hash
	$hash = pop() if (ref($_[-1]) eq 'HASH');

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute transform
		$out[$i] = $self->[1][$i]->transform($_[$i]);

	}

	# clip, if enabled
	ICC::Shared::clip_struct(\@out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return output array
	return(@out);

}

# transform vector
# parameters: (ref_to_object, vector, [hash])
# returns: (vector)
sub _trans1 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# local variable
	my ($out);

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute transform
		$out->[$i] = $self->[1][$i]->transform($in->[$i]);

	}

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return($out);

}

# transform matrix (2-D array -or- Math::Matrix object)
# parameters: (ref_to_object, matrix, [hash])
# returns: (matrix)
sub _trans2 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# local variable
	my ($out);

	# for each input vector
	for my $i (0 .. $#{$in}) {

		# for each channel
		for my $j (0 .. $#{$self->[1]}) {

			# compute transform
			$out->[$i][$j] = $self->[1][$j]->transform($in->[$i][$j]);

		}

	}

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return(UNIVERSAL::isa($in, 'Math::Matrix') ? bless($out, 'Math::Matrix') : $out);

}

# transform structure
# parameters: (ref_to_object, structure, [hash])
# returns: (structure)
sub _trans3 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# transform the array structure
	_crawl($self, $in, my $out = [], $hash);

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return($out);

}

# recursive transform
# array structure is traversed until scalar arrays are found and transformed
# parameters: (ref_to_object, input_array_reference, output_array_reference, hash)
sub _crawl {

	# get parameters
	my ($self, $in, $out, $hash) = @_;

	# if input is a vector (reference to a scalar array)
	if (@{$in} == grep {! ref()} @{$in}) {

		# transform input vector and copy to output
		@{$out} = @{_trans1($self, $in, $hash)};

	} else {

		# for each input element
		for my $i (0 .. $#{$in}) {

			# if an array reference
			if (ref($in->[$i]) eq 'ARRAY') {

				# transform next level
				_crawl($self, $in->[$i], $out->[$i] = [], $hash);

			} else {

				# error
				croak('invalid transform input');

			}

		}

	}

}

# invert list
# parameters: (ref_to_object, list, [hash])
# returns: (list)
sub _inv0 {

	# local variables
	my ($self, $hash, @out);

	# get object reference
	$self = shift();

	# get optional hash
	$hash = pop() if (ref($_[-1]) eq 'HASH');

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute invert
		$out[$i] = $self->[1][$i]->inverse($_[$i]);

	}

	# clip, if enabled
	ICC::Shared::clip_struct(\@out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return output array
	return(@out);

}

# invert vector
# parameters: (ref_to_object, vector, [hash])
# returns: (vector)
sub _inv1 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# local variable
	my ($out);

	# for each channel
	for my $i (0 .. $#{$self->[1]}) {

		# compute invert
		$out->[$i] = $self->[1][$i]->inverse($in->[$i]);

	}

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return($out);

}

# invert matrix (2-D array -or- Math::Matrix object)
# parameters: (ref_to_object, matrix, [hash])
# returns: (matrix)
sub _inv2 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# local variable
	my ($out);

	# for each input vector
	for my $i (0 .. $#{$in}) {

		# for each channel
		for my $j (0 .. $#{$self->[1]}) {

			# compute invert
			$out->[$i][$j] = $self->[1][$j]->inverse($in->[$i][$j]);

		}

	}

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return(UNIVERSAL::isa($in, 'Math::Matrix') ? bless($out, 'Math::Matrix') : $out);

}

# invert structure
# parameters: (ref_to_object, structure, [hash])
# returns: (structure)
sub _inv3 {

	# get parameters
	my ($self, $in, $hash) = @_;

	# recursive inverse
	_crawl2($self, $in, my $out = []);

	# clip, if enabled
	ICC::Shared::clip_struct($out) if ($self->[0]{'clip'} || $hash->{'clip'});

	# return
	return($out);

}

# recursive inverse
# array structure is traversed until scalar arrays are found and inverted
# parameters: (ref_to_object, input_array_reference, output_array_reference, hash)
sub _crawl2 {

	# get parameters
	my ($self, $in, $out, $hash) = @_;

	# if input is a vector (reference to a scalar array)
	if (@{$in} == grep {! ref()} @{$in}) {

		# invert input vector and copy to output
		@{$out} = @{_inv1($self, $in, $hash)};

	} else {

		# for each input element
		for my $i (0 .. $#{$in}) {

			# if an array reference
			if (ref($in->[$i]) eq 'ARRAY') {

				# invert next level
				_crawl2($self, $in->[$i], $out->[$i] = []);

			} else {

				# error
				croak('invalid inverse input');

			}

		}

	}

}

# process the curve output options parameter
# the parameter may be a scalar or hash reference
# output is based on the name of the calling method
# parameter: ([options])
# returns: (direction_flag, steps)
sub _options {

	# get options
	my $opts = $_[0];

	# local variable
	my ($dir, $steps, @ctx, $caller, $n);

	# make hash of standard step ramps (method_name => [ref_to_steps_array, custom_flag])
	# steps array contains device values (%), flag indicate values may be custom
	state $std = {
		'apogee' => [[0 .. 6, (map {5 * $_} 2 .. 18), 94 .. 100], 1],
		'device_link' => [[], 0],
		'cgats' => [[0, 2, 4, 6, 8, (map {5 * $_} 2 .. 19), 98, 100], 1], # P2P51 ramp
		'efi' => [[0 .. 3, map {5 * $_} 1 .. 20], 0],
		'fuji_xmf' => [[0 .. 5, 10, 20, 25, 30, 40, 50, 60, 70, 75, 80, 90, 95 .. 100], 0],
		'harlequin' => [[100, 95, 90, 85, 80, 70, 60, 50, 40, 30, 20, 15, 10, 8, 6, 4, 2, 0], 0],
		'indigo' => [[map {5 * $_} 0 .. 20], 0],
		'iso_18620' => [[0, 1, 2, 5, (map {10 * $_} (1 .. 9)), 95, 100], 1],
		'navigator' => [[100, 95, 90, 85, 80, 70, 60, 50, 40, 30, 20, 15, 10, 8, 6, 4, 2, 0], 0],
		'photoshop' => [[], 1],
		'prinergy' => [[0 .. 100], 0],
		'rampage' => [[0, 1, 3, (map {5 * $_} 1 .. 19), 97, 99, 100], 0],
		'sierra' => [[0 .. 5, 10, 20, 25, 30, 40, 50, 60, 70, 75, 80, 90, 95 .. 100], 0],
		'trueflow' => [[0, 2, 5, (map {10 * $_} 1 .. 9), 95, 98, 100], 0],
		'text' => [[map {$_ * 5} 0 .. 20], 1],
		'graph' => [[], 0],
	};

	# match caller method name
	$ctx[3] =~ m/::(\w+)$/ if (@ctx = caller(1));

	# set caller, default is 'text'
	$caller = defined($1) && exists($std->{$1}) ? $1 : 'text';

	# set default direction (forward)
	$dir = 0;

	# set default steps value for caller
	$steps = $std->{$caller}[0];

	# return if options undefined
	return($dir, $steps) if (! defined($opts));

	# if options is a scalar
	if (! ref($opts)) {

		# set direction
		$dir = $opts ? 1 : 0;

		# undefine options (for caller, $_[0] is an alias)
		undef($_[0]);

	# if options is a hash ref
	} elsif (ref($opts) eq 'HASH') {

		# use 'dir' hash value, if any
		$dir = $opts->{'dir'} // 0;

		# if 'steps' defined in hash
		if (defined($opts->{'steps'})) {

			# if custom step values allowed
			if ($std->{$caller}[1]) {

				# set steps to hash value
				$steps = $opts->{'steps'};

				# if 'steps' value is a numeric vector
				if (ICC::Shared::is_num_vector($steps)) {

					# warn if values out of range (0 - 100)
					(0 == grep {$_ < 0 || $_ > 100} @{$steps}) or carp("'steps' value(s) out of range\n");

				# if 'steps' value is a number
				} elsif (Scalar::Util::looks_like_number($steps)) {

					# set upper range
					$n = int($steps) - 1;

					# limit number of steps (1 - 255)
					$n = $n < 1 ? 1 : $n > 255 ? 255 : $n;

					# set steps
					$steps = [map {100 * $_/$n} (0 .. $n)];

				# if 'steps' value is a string
				} elsif (! ref($steps)) {

					# if string a valid key
					if (exists($std->{$steps})) {

						# set steps
						$steps = $std->{$steps}[0];

					} else {

						# print warning
						carp("'steps' value '$steps' is invalid, using default steps\n");

						# set steps
						$steps = $std->{$caller}[0];

					}

				} else {

					# print warning
					carp("'steps' value must be a scalar or an array reference\n");

				}

			} else {

				# print warning
				carp("custom step values not allowed in $caller curves\n");

			}

		}

	} else {

		# print warning
		carp("options parameter must be a scalar or hash reference\n");

	}

	# return
	return($dir, $steps);

}

# read curves from text file
# returns true if successful
# parameters: (ref_to_object, file_handle)
# returns: (flag)
sub _read_text {

	# get parameters
	my ($self, $fh) = @_;

	# local variables
	my (@data, @cnt, $n, $last, $f, $mat);

	# localize input record separator
	local $/ = $self->[0]{'read_rs'};

	# localize loop variable
	local $_;

	# read the file, line by line
	while (<$fh>) {

		# split the line, and filter numeric values
		push(@data, [grep {Scalar::Util::looks_like_number($_)} split('[\s"]')]);

	}

	# for each line
	for my $line (@data) {

		# increment count
		$cnt[@{$line}]++

	}

	# get index with max count
	$n = List::Util::reduce {($cnt[$a] // 0) > ($cnt[$b] // 0) ? $a : $b} (1 .. $#cnt);

	# filter out extraneous lines
	@data = grep {$n == @{$_}} @data;

	# verify data table size
	(@data > 1 && @{$data[0]} > 1) or return(0);

	# sort by first value in each line
	@data = sort {$a->[0] <=> $b->[0]} @data;

	# filter any duplicates
	@data = grep {$f = (defined($last) ? $last->[0] != $_->[0] : 1); $last = $_; $f} @data;

	# convert to device values
	@data = map {[map {$_/100} @{$_}]} @data;

	# make a transposed matrix of the data
	$mat = Math::Matrix->new(@data)->transpose();

	# for each channel
	for my $i (1 .. $#{$mat}) {

		# it is assumed the first column of numbers are the input values
		# and the remaining columns are output values for each channel

		# add a 'spline' curve
		$self->[1][$i - 1] = ICC::Support::spline->new({'input' => $mat->[0], 'output' => $mat->[$i], 'type' => 'akima'});

	}

	# return
	return(1);

}

# read curves from ISO 18620 file
# returns true if successful
# parameters: (ref_to_object, file_handle)
# returns: (flag)
sub _read_iso_18620 {

	# get parameters
	my ($self, $fh) = @_;

	# local variables
	my ($dom, $root, @obj, $k, @sep, $curve, @xy, @x, @y);

	# parse ISO 18620 document
	eval{$dom = XML::LibXML->load_xml('IO' => $fh)} or return(0);

	# get root element
	$root = $dom->documentElement();

	# get all nodes (we select later)
	@obj = $root->findnodes('*');

	# init curve counter
	$k = 0;

	# for each element
	for my $s (@obj) {

		# if a 'TransferCurve' node
		if ($s->nodeName() eq 'TransferCurve') {

			# get the Separation attribute
			$sep[$k] = $s->getAttribute('Separation');

			# get the Curve attribute
			$curve = $s->getAttribute('Curve');

			# split the Curve data
			@xy = split('\s', $curve);

			# init value arrays
			@x = @y = ();

			# for each value
			for my $i (0 .. $#xy) {

				# if index is odd
				if ($i % 2) {

					# save as y-value
					$y[int($i/2)] = $xy[$i];

				} else {

					# save as x-value
					$x[int($i/2)] = $xy[$i];

				}

			}

			# add a 'spline' curve to object
			$self->[1][$k++] = ICC::Support::spline->new({'input' => \@x, 'output' => \@y, 'type' => 'akima'});

		}

	}

	# add ink sequence
	$self->[0]{'inks'} = \@sep;

	# return
	return($k);

}

# read curves from Esko .icpro/.dgc file set
# returns true if successful
# parameters: (ref_to_object, file_handle, path)
# returns: (flag)
sub _read_icpro {

	# get parameters
	my ($self, $fh, $path) = @_;

	# local variables
	my ($dom, $root, @obj, $k, @sep, $dgc, $curve);
	my ($vol, $dir, $file, $fh2, $buf, $ptr, $n, $max, @data);

	# split .icpro path
	($vol, $dir, $file) = File::Spec->splitpath($path);

	# parse .icpro document
	eval{$dom = XML::LibXML->load_xml('IO' => $fh)} or return(0);

	# get root element
	$root = $dom->documentElement();

	# get all 'ink' nodes
	@obj = $root->findnodes('*/ink');

	# init curve counter
	$k = 0;

	# for each 'ink' node
	for my $s (@obj) {

		# if there is a 'dgc' node
		if (($dgc) = $s->findnodes('dgc')) {

			# get the 'fileName' attribute
			$file = $dgc->getAttribute('fileName');

			# concatenate file path
			$path = File::Spec->catfile($vol, $dir, $file);

			# open the file (read-only)
			open($fh2, '<', $path) or croak("$! when opening file $path");

			# seek table 4 index
			seek($fh2, 0x0000020C, 0);

			# read index to table 4
			read($fh2, $buf, 12);

			# unpack table pointer, number of points
			($ptr, $n, $max) = unpack('N*', $buf);

			# seek table 4
			seek($fh2, $ptr, 0);

			# read table data
			read($fh2, $buf, $n * 4);

			# unpack table data
			@data = map {$_/$max} unpack('N*', $buf);

			# close file
			close($fh2);

			# make 'curv' object
			$self->[1][$k] = ICC::Profile::curv->new(\@data);

			# get the 'inkName' attribute
			$sep[$k++] = $s->getAttribute('inkName');

		}

	}

	# add ink sequence
	$self->[0]{'inks'} = \@sep;

	# return
	return($k);

}

# read curves from file
# file path to 'iso_18620', 'icpro', 'text' or 'store' format curves
# parameters: (ref_to_object, file_path)
sub _new_from_file {

	# get parameters
	my ($self, $path) = @_;

	# local variables
	my ($fh, $buf, $result, $obj);

	# filter path name
	ICC::Shared::filterPath($path);

	# open the file (read-only)
	open($fh, '<', $path) or croak("$! when opening file $path");

	# set binary mode
	binmode($fh);

	# read start of file
	read($fh, $buf, 1024) or croak("file $path is zero length");

	# reset file pointer
	seek($fh, 0, 0);

	# if an ISO 18620 (.ted) file
	if ($buf =~ m/<\?xml.*\?>/ && $buf =~ m/ISO18620/) {

		# read ISO 18620 file
		_read_iso_18620($self, $fh) or croak("failed parsing ISO 18620 (XML) file $path");

		# save file type
		$self->[0]{'file_type'} = 'ISO_18620';

	# if an Esko .icpro file
	} elsif ($buf =~ m/<\?xml.*\?>/ && $buf =~ m/colDgc_xml/) {

		# read .icpro/.dgc file set
		_read_icpro($self, $fh, $path) or croak("failed parsing .icpro/.dgc file set $path");

		# save file type
		$self->[0]{'file_type'} = 'ESKO_ICPRO';

	# if a Storable file
	} elsif ($buf =~ m/ICC::Profile::cvst/) {

		# retrieve 'cvst' object from Storable file
		($obj = Storable::fd_retrieve($fh)) or croak("failed retrieving Storable object $path");

		# verify a cvst object
		(UNIVERSAL::isa($obj, 'ICC::Profile::cvst')) or croak("not a 'cvst' object, retrieved from $path");

		# copy object elements
		@{$self} = @{$obj};

		# save file type
		$self->[0]{'file_type'} = 'STORABLE';

	} else {

		# check for CR-LF (DOS/Windows)
		if ($buf =~ m/\015\012/) {

			# set record separator
			$self->[0]{'read_rs'} = "\015\012";

		# check for LF (Unix/OSX)
		} elsif ($buf =~ m/\012/) {

			# set record separator
			$self->[0]{'read_rs'} = "\012";

		# check for CR (Mac)
		} elsif ($buf =~ m/\015/) {

			# set record separator
			$self->[0]{'read_rs'} = "\015";

		# not a text file
		} else {

			# close the file
			close($fh);

			# error
			croak('unknown file type');

		}

		# read text file
		_read_text($self, $fh) or croak("failed parsing text file $path");

		# save file type
		$self->[0]{'file_type'} = 'TEXT';

	}

	# close the file
	close($fh);

}

# make new cvst object from array
# parameters: (ref_to_object, ref_to_array)
sub _new_from_array {

	# get parameters
	my ($self, $array) = @_;

	# for each curve element
	for my $i (0 .. $#{$array}) {

		# verify object has processing methods
		($array->[$i]->can('transform') && $array->[$i]->can('derivative')) or croak('curve element lacks \'transform\' or \'derivative\' method');

		# add curve element
		$self->[1][$i] = $array->[$i];

	}

}

# read cvst tag from ICC profile
# parameters: (ref_to_object, ref_to_parent_object, file_handle, ref_to_tag_table_entry)
sub _readICCcvst {

	# get parameters
	my ($self, $parent, $fh, $tag) = @_;

	# local variables
	my ($buf, @mft, $table, $tag2, $type, $class, %hash);

	# set tag signature
	$self->[0]{'signature'} = $tag->[0];

	# seek start of tag
	seek($fh, $tag->[1], 0);

	# read tag header
	read($fh, $buf, 12);

	# unpack header
	@mft = unpack('a4 x4 n2', $buf);

	# verify tag signature
	($mft[0] eq 'cvst') or croak('wrong tag type');

	# for each curve set element
	for my $i (0 .. $mft[1] - 1) {

		# read positionNumber
		read($fh, $buf, 8);

		# unpack to processing element tag table
		$table->[$i] = ['cvst', unpack('N2', $buf)];

	}

	# for each curve set element
	for my $i (0 .. $mft[1] - 1) {

		# get tag table entry
		$tag2 = $table->[$i];

		# make offset absolute
		$tag2->[1] += $tag->[1];

		# if a duplicate tag
		if (exists($hash{$tag2->[1]})) {

			# use original tag object
			$self->[1][$i] = $hash{$tag2->[1]};

		} else {

			# seek to start of tag
			seek($fh, $tag2->[1], 0);

			# read tag type signature
			read($fh, $type, 4);

			# convert non-word characters to underscores
			$type =~ s|\W|_|g;

			# form class specifier
			$class = "ICC::Profile::$type";

			# if 'class->new_fh' method exists
			if ($class->can('new_fh')) {

				# create specific tag object
				$self->[1][$i] = $class->new_fh($self, $fh, $tag2);

			} else {

				# create generic tag object
				$self->[1][$i] = ICC::Profile::Generic->new_fh($self, $fh, $tag2);

				# print warning
				print "curve set element $type opened as generic\n";

			}

			# save tag object in hash
			$hash{$tag2->[1]} = $self->[1][$i];

		}

	}

}

# write cvst tag to ICC profile
# parameters: (ref_to_object, ref_to_parent_object, file_handle, ref_to_tag_table_entry)
sub _writeICCcvst {

	# get parameters
	my ($self, $parent, $fh, $tag) = @_;

	# local variables
	my ($n, $offset, $size, @cept, %hash);

	# get number of curve elements
	$n = @{$self->[1]};

	# verify number of channels (1 to 15)
	($n > 0 && $n < 16) or croak('unsupported number of channels');

	# seek start of tag
	seek($fh, $tag->[1], 0);

	# write tag type signature and number channels
	print $fh pack('a4 x4 n2', 'cvst', $n, $n);

	# initialize tag offset
	$offset = 12 + 8 * $n;

	# for each curve element
	for my $i (0 .. $#{$self->[1]}) {

		# verify curve element is 'curf' object
		(UNIVERSAL::isa($self->[1][$i], 'ICC::Profile::curf')) or croak('curve element must a \'curf\' object');

		# if tag not in hash
		if (! exists($hash{$self->[1][$i]})) {

			# get size
			$size = $self->[1][$i]->size();

			# set table entry and add to hash
			$cept[$i] = $hash{$self->[1][$i]} = [$offset, $size];

			# update offset
			$offset += $size;

			# adjust to 4-byte boundary
			$offset += -$offset % 4;

		} else {

			# set table entry
			$cept[$i] = $hash{$self->[1][$i]};

		}

		# write curve element position entry
		print $fh pack('N2', @{$cept[$i]});

	}

	# initialize hash
	%hash = ();

	# for each curve element
	for my $i (0 .. $#{$self->[1]}) {

		# if tag not in hash
		if (! exists($hash{$self->[1][$i]})) {

			# make offset absolute
			$cept[$i][0] += $tag->[1];

			# write tag
			$self->[1][$i]->write_fh($self, $fh, ['cvst', $cept[$i][0], $cept[$i][1]]);

			# add key to hash
			$hash{$self->[1][$i]}++;

		}

	}

}

1;