File Coverage

lib/Graphics/Toolkit/Color/Space/Hub.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	34	38	89.4
condition	7	8	87.5
subroutine	16	16	100.0
pod	11	12	91.6
total	129	135	95.5

use v5.12;
use warnings;

# check, convert and measure color values

package Graphics::Toolkit::Color::Space::Hub;
use Carp;
our $base_package = 'RGB';
my @space_packages = ($base_package, qw/CMY CMYK HSL HSV HSB HWB YIQ /); # search order # HCL LUV Ncol ?XYZ LAB
my %space_obj = map { $_ => require "Graphics/Toolkit/Color/Space/Instance/$_.pm" } @space_packages;

sub get_space { $space_obj{ uc $_[0] } if exists $space_obj{ uc $_[0] } }
sub is_space  { (defined $_[0] and ref get_space($_[0])) ? 1 : 0 }
sub base_space { $space_obj{$base_package} }
sub space_names { @space_packages }

########################################################################

sub check_space_name {
    return unless defined $_[0];
    my $error = "called with unknown color space name '$_[0]', please try one of: " . join (', ', @space_packages);
    is_space( $_[0] ) ? 0 : carp $error;
}
sub _check_values_and_space {
    my ($sub_name, $values, $space_name) = @_;
    $space_name //= $base_package;
    check_space_name( $space_name ) and return;
    my $space = get_space($space_name);
    $space->is_array( $values ) ? $space
                                : carp 'need an ARRAY ref with '.$space->dimensions." $space_name values as first argument of $sub_name";
}

########################################################################

sub partial_hash_deformat { # convert partial hash into
    my ($value_hash) = @_;
    return unless ref $value_hash eq 'HASH';
    for my $space_name (space_names()) {
        my $color_space = get_space( $space_name );
        my $pos_hash = $color_space->basis->deformat_partial_hash( $value_hash );
        return $pos_hash, $color_space->name if ref $pos_hash eq 'HASH';
    }
    return undef;
}

sub deformat { # convert from any format into list of values of any space
    my ($formated_values) = @_;
    for my $space_name (space_names()) {
        my $color_space = get_space( $space_name );
        my @val = $color_space->deformat( $formated_values );
        return \@val, $space_name if defined $val[0];
    }
}

sub format { # @tuple --> % | % |~ ...
    my ($values, $space_name, $format_name) = @_;

    my $space = _check_values_and_space( 'format', $values, $space_name );
    return unless ref $space;
    my @values = $space->format( $values, $format_name // 'list' );
    return @values, carp "got unknown format name: '$format_name'" unless defined $values[0];
    return @values == 1 ? $values[0] : @values;
}

sub deconvert { # @... --> @RGB (base color space) # normalized values only
    my ($values, $space_name) = @_;
    my $space = _check_values_and_space( 'deconvert', $values, $space_name );
    return unless ref $space;
    my @values = $space->clamp( $values, 'normal');
    return @values if $space->name eq base_space->name;
    $space->convert( \@values, $base_package);
}

sub convert { # @RGB --> @...                      # normalized values only
    my ($values, $space_name) = @_;
    my $space = _check_values_and_space( 'convert', $values, $space_name );
    return unless ref $space;
    my @values = base_space->clamp( $values, 'normal');
    return @values if $space->name eq base_space->name;
    $space->deconvert( \@values, $base_package);
}

sub denormalize { # result clamped, alway in space
    my ($values, $space_name, $range) = @_;
    my $space = _check_values_and_space( 'denormalize', $values, $space_name );
    return unless ref $space;
    my @values = $space->clamp($values, 'normal');
    $space->denormalize( \@values, $range);
}

sub normalize {
    my ($values, $space_name, $range) = @_;
    my $space = _check_values_and_space( 'normalize', $values, $space_name );
    return unless ref $space;
    my @values = $space->clamp($values, $range);
    return unless defined $values[0];
    $space->normalize( $values, $range);
}


1;

__END__