Skip to content

Commit

Permalink
implementd NCol
Browse files Browse the repository at this point in the history
  • Loading branch information
@lichtkind
lichtkind committed Apr 30, 2024
1 parent 20f77da commit 7a4f381
Show file tree
Hide file tree
Showing 7 changed files with 168 additions and 76 deletions.
4 changes: 2 additions & 2 deletions Changes
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@

1.8 2024-04-22 lichtkind
1.8 2024-05-04 lichtkind
-------
* = mid level feature release
* * added color space support for: XYZ LAB LUV LCHab LCHuv NCol
* * added support of 8 color spaces: CIEXYZ CIELAB CIELUV CIELCHab CIELCHuv NCol OKLAB
* + extended range definitions with explicit type names
* + color spaces can now define value procision,
value suffix ('%') and
Expand Down
3 changes: 2 additions & 1 deletion lib/Graphics/Toolkit/Color/Space.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ sub new {
return $basis unless ref $basis;
my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, $args{'type'}, $args{'range'}, $args{'precision'} );
return $shape unless ref $shape;
my $format = Graphics::Toolkit::Color::Space::Format->new( $basis, $args{'suffix'}, $args{'value_format'} );
my $format = Graphics::Toolkit::Color::Space::Format->new( $basis, $args{'suffix'}, $args{'value_form'} );
return $format unless ref $format;
bless { basis => $basis, shape => $shape, format => $format, convert => {} };
}
Expand Down Expand Up @@ -48,6 +48,7 @@ sub has_format { shift->form->has_format(@_) } # ~format_name
sub has_deformat { shift->form->has_deformat(@_) } # ~format_name --> ?
sub add_formatter { shift->form->add_formatter(@_) } # ~format_name, &formatter --> &?
sub add_deformatter { shift->form->add_deformatter(@_) } # ~format_name, &deformatter --> &?
sub set_value_formatter{shift->form->set_value_formatter(@_)}# &pre_formatter, &post_formatter --> &?

#### conversion ########################################################

Expand Down
65 changes: 39 additions & 26 deletions lib/Graphics/Toolkit/Color/Space/Format.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,20 +6,20 @@ use warnings;
package Graphics::Toolkit::Color::Space::Format;

sub new {
my ($pkg, $basis, $suffix, $value_format ) = @_;
my ($pkg, $basis, $suffix, $value_form ) = @_;
return 'first argument has to be an Color::Space::Basis reference'
unless ref $basis eq 'Graphics::Toolkit::Color::Space::Basis';

$suffix = make_suffix( $basis, $suffix ) ;
return $suffix unless ref $suffix;

my $number_format = '-?(?:\d+|\d+\.\d+|.\d+)';
my $number_form = '-?(?:\d+|\d+\.\d+|.\d+)';
my $count = $basis->count;
$value_format = [($number_format) x $count] unless defined $value_format;
$value_format = [($value_format) x $count] unless ref $suffix;
$value_format = [ map {(defined $_ and $_) ? $_ : $number_format } @$value_format]; # fill missing defs with default
return 'need an ARRAY as definition of value format' unless ref $value_format eq 'ARRAY';
return 'definition value format has to have same lengths as basis' unless @$value_format == $count;
$value_form = [($number_form) x $count] unless defined $value_form;
$value_form = [($value_form) x $count] unless ref $suffix;
$value_form = [ map {(defined $_ and $_) ? $_ : $number_form } @$value_form]; # fill missing defs with default
return 'need an ARRAY as definition of value format' unless ref $value_form eq 'ARRAY';
return 'definition value format has to have same length as basis (number of axis)' unless @$value_form == $count;

# format --> tuple
my %deformats = ( hash => sub { tuple_from_hash(@_) },
Expand All @@ -35,8 +35,8 @@ sub new {
named_string => sub { $_[0]->named_string_from_tuple($_[1]) }, # 'rgb: 1, 2, 3'
css_string => sub { $_[0]->css_string_from_tuple($_[1]) }, # 'rgb(1,2,3)'
);
bless { basis => $basis, suffix => $suffix, value_format => $value_format ,
format => \%formats, deformat => \%deformats, }
bless { basis => $basis, suffix => $suffix, value_form => $value_form ,
format => \%formats, deformat => \%deformats, pre => '', post => ''}
}

sub make_suffix {
Expand All @@ -57,8 +57,8 @@ sub _suffix {
sub _value_regex {
my ($self, $match) = @_;
(defined $match and $match)
? (map {'\s*('.$self->{'value_format'}[$_].'\s*(?:'.quotemeta($self->{'suffix'}[$_]).')?)\s*' } $self->basis->iterator)
: (map {'\s*'.$self->{'value_format'}[$_].'\s*(?:'.quotemeta($self->{'suffix'}[$_]).')?\s*' } $self->basis->iterator);
? (map {'\s*('.$self->{'value_form'}[$_].'\s*(?:'.quotemeta($self->{'suffix'}[$_]).')?)\s*' } $self->basis->iterator)
: (map {'\s*'.$self->{'value_form'}[$_].'\s*(?:'.quotemeta($self->{'suffix'}[$_]).')?\s*' } $self->basis->iterator);
}
#### public API: formatting value tuples ###############################

Expand All @@ -76,14 +76,11 @@ sub add_deformatter {
return if not defined $format or ref $format or exists $self->{'deformat'}{$format} or ref $code ne 'CODE';
$self->{'deformat'}{ lc $format } = $code;
}

sub format {
my ($self, $values, $format, $suffix) = @_;
return unless $self->basis->is_value_tuple( $values );
$suffix = $self->_suffix( $suffix );
return $suffix unless ref $suffix;
$values = $self->add_suffix( $values, $suffix );
$self->{'format'}{ lc $format }->($self, $values) if $self->has_format( $format );
sub set_value_formatter {
my ($self, $pre_code, $post_code) = @_;
return 0 if ref $pre_code ne 'CODE' or ref $post_code ne 'CODE';
$self->{'pre'} = $pre_code;
$self->{'post'} = $post_code;
}

sub deformat {
Expand All @@ -100,29 +97,45 @@ sub deformat {
}
return undef;
}

#### helper ############################################################

sub add_suffix {
my ($self, $values, $suffix) = @_;
sub format {
my ($self, $values, $format, $suffix) = @_;
return unless $self->basis->is_value_tuple( $values );
$suffix = $self->_suffix( $suffix );
return $suffix unless ref $suffix;
[ map { ($suffix->[$_] and substr( $values->[$_], - length $suffix->[$_]) ne $suffix->[$_])
? $values->[$_] . $suffix->[$_] : $values->[$_] } $self->basis->iterator ];
$values = $self->add_suffix( $values, $suffix );
$self->{'format'}{ lc $format }->($self, $values) if $self->has_format( $format );
}

#### helper ############################################################

sub remove_suffix { # and unnecessary white space
my ($self, $values, $suffix) = @_;
return unless $self->basis->is_value_tuple( $values );
$suffix = $self->_suffix( $suffix );
return $suffix unless ref $suffix;
if (ref $self->{'pre'}){
$values = $self->{'pre'}->($values);
return unless $self->basis->is_value_tuple( $values );
}
local $/ = ' ';
chomp $values->[$_] for $self->basis->iterator;
[ map { eval $_ }
map { ($self->{'suffix'}[$_] and substr( $values->[$_], - length($self->{'suffix'}[$_])) eq $self->{'suffix'}[$_])
? (substr( $values->[$_], 0, length($values->[$_]) - length($self->{'suffix'}[$_])))
: $values->[$_] } $self->basis->iterator ];
}
sub add_suffix {
my ($self, $values, $suffix) = @_;
return unless $self->basis->is_value_tuple( $values );
$suffix = $self->_suffix( $suffix );
return $suffix unless ref $suffix;
if (ref $self->{'post'}){
$values = $self->{'post'}->($values);
return unless $self->basis->is_value_tuple( $values );
}
[ map { ($suffix->[$_] and substr( $values->[$_], - length $suffix->[$_]) ne $suffix->[$_])
? $values->[$_] . $suffix->[$_] : $values->[$_] } $self->basis->iterator ];
}

sub match_number_values {
my ($self, $values) = @_;
Expand Down
3 changes: 2 additions & 1 deletion lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,10 @@ use Graphics::Toolkit::Color::Space::Util qw/min max/;
use Graphics::Toolkit::Color::Space;

my $hwb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue whiteness blackness/],
type => [qw/angular linear linear/],
range => [360, 100, 100], precision => 0,
suffix => ['', '%', '%'],
type => [qw/angular linear linear/], );
);

$hwb_def->add_converter('RGB', \&to_rgb, \&from_rgb );

Expand Down
55 changes: 21 additions & 34 deletions lib/Graphics/Toolkit/Color/Space/Instance/NCol.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,48 +9,32 @@ use Graphics::Toolkit::Color::Space;

my $hsl_def = Graphics::Toolkit::Color::Space->new( name => 'NCol',
axis => [qw/hue whiteness blackness/],
range => [360, 100, 100], precision => 0,
type => [qw/angular linear linear/],
range => [600, 100, 100], precision => 0,
value_form => ['[RYGCBM]\d{2}','\d{2}','\d{2}'],
suffix => ['', '%', '%'],
type => [qw/no linear linear/],
);
);

$hsl_def->set_value_formatter( \&pre_value, \&post_value );
$hsl_def->add_converter('RGB', \&to_rgb, \&from_rgb );

my @letter = qw/R Y G C B M/;
my %pos = (map { $letter[$_] => $_ } 0 .. $#letter);

sub from_rgb {
my ($r, $g, $b) = @_;
my $vmax = max($r, $g, $b),
my $vmin = min($r, $g, $b);
my $l = ($vmax + $vmin) / 2;
return (0, 0, $l) if $vmax == $vmin;
my $d = $vmax - $vmin;
my $s = ($l > 0.5) ? ($d / (2 - $vmax - $vmin)) : ($d / ($vmax + $vmin));
my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
($vmax == $g) ? (($b - $r) / $d + 2)
: (($r - $g) / $d + 4);
return ($h/6, $s, $l);
sub pre_value {
my $val = shift;
my $hue = $pos{ substr($val->[0], 0, 1) } * 100 + substr($val->[0], 1);
[$hue, $val->[1], $val->[2]];
}

sub to_rgb {
my ($h, $s, $l) = @_;
$h *= 6;
my $C = $s * (1 - abs($l * 2 - 1));
my $X = $C * (1 - abs( rmod($h, 2) - 1) );
my $m = $l - ($C / 2);
return ($h < 1) ? ($C + $m, $X + $m, $m)
: ($h < 2) ? ($X + $m, $C + $m, $m)
: ($h < 3) ? ( $m, $C + $m, $X + $m)
: ($h < 4) ? ( $m, $X + $m, $C + $m)
: ($h < 5) ? ($X + $m, $m, $C + $m)
: ($C + $m, $m, $X + $m);
sub post_value {
my $val = shift;
my $h = int($val->[0] / 100);
my $hue = $letter[ $h ] . sprintf "%02u", $val->[0] - $h;
[$hue, $val->[1], $val->[2]];
}

$hsl_def;

__END__
sub from_rgb {
my ($r, $g, $b) = @_;
my ($r, $g, $b) = @{$_[0]};
my $vmax = max($r, $g, $b);
my $white = my $vmin = min($r, $g, $b);
my $black = 1 - ($vmax);
Expand All @@ -66,7 +50,7 @@ sub from_rgb {


sub to_rgb {
my ($h, $w, $b) = @_;
my ($h, $w, $b) = @{$_[0]};
return (0, 0, 0) if $b == 1;
return (1, 1, 1) if $w == 1;
my $v = 1 - $b;
Expand All @@ -86,3 +70,6 @@ sub to_rgb {
: ($hi == 5) ? ($v, $p, $q)
: ($v, $t, $p);
}

$hsl_def;

11 changes: 9 additions & 2 deletions t/16_hwb_space.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@

use v5.12;
use warnings;
use Test::More tests => 54;
use Test::More tests => 59;

BEGIN { unshift @INC, 'lib', '../lib'}
my $module = 'Graphics::Toolkit::Color::Space::Instance::HWB';
Expand All @@ -28,6 +28,13 @@ is( ref $def->in_range([0, 0, -1 ] ), '', "blackness value is too small"
is( ref $def->in_range([0, 0, 1.1] ), '', "blackness value is not integer");
is( ref $def->in_range([0, 0, 101] ), '', "blackness value is too big");

my $val = $def->round([1,22.5, 11.111111]);
is( ref $val, 'ARRAY', 'rounded value tuple int tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 1, 'first value kept');
is( $val->[1], 23, 'second value rounded up');
is( $val->[2], 11, 'third value rounded down');

my $hwb = $def->deconvert( [ .5, .5, .5], 'RGB');
is( int @$hwb, 3, 'converted color grey has three hwb values');
is( $hwb->[0], 0, 'converted color grey has computed right hue value');
Expand Down Expand Up @@ -58,7 +65,7 @@ is( $rgb->[0], 0, 'right red value');
is( $rgb->[1], 0, 'right green value');
is( $rgb->[2], 0, 'right blue value');

my $val = $def->form->remove_suffix([qw/360 100% 100%/]);
$val = $def->form->remove_suffix([qw/360 100% 100%/]);
is( ref $val, 'ARRAY', 'value tuple without suffixes is a tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 360, 'first value is right');
Expand Down
103 changes: 93 additions & 10 deletions t/17_ncol_space.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,18 +12,21 @@ use Graphics::Toolkit::Color::Space::Util ':all';

is( not($@), 1, 'could load the module');
is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module');
is( $def->name, 'YIQ', 'color space has right name');
is( $def->dimensions, 3, 'color space has 3 dimensions');
is( $def->is_array([0,0,0]), 1, 'vector has 3 elements');
is( $def->is_partial_hash({i => 1, quadrature => 0}), 1, 'found hash with some keys');
is( $def->name, 'NCol', 'color space has right name');
is( $def->axis, 3, 'color space has 3 axis');
is( $def->is_value_tuple([0,0,0]), 1, 'value tuple has 3 elements');

exit 0;
is( $def->is_partial_hash({whiteness => 1, blackness => 0}), 1, 'found hash with some keys');
is( $def->can_convert('rgb'), 1, 'do only convert from and to rgb');
is( $def->can_convert('yiq'), 0, 'can not convert to itself');
is( $def->format([0,0,0], 'css_string'), 'yiq(0,0,0)', 'can format css string');
my @val = $def->deformat(['YIQ', 1, 0, -0.1]);
is( int @val, 3, 'deformated value triplet (vector)');
is( $val[0], 1, 'first value good');
is( $val[1], 0, 'second value good');
is( $val[2], -0.1, 'third value good');
is( $def->format([0,0,0], 'css_string'), 'ncol(0, 0%, 0%)', 'can format css string');
my $val = $def->deformat(['NCol', 1, 0, -0.1]);
is( ref $val, 'ARRAY', 'deformated named array into tuple (ARRAY)');
is( int @$val, 3, 'deformated value triplet (vector)');
is( $val->[0], 1, 'first value good');
is( $val->[1], 0, 'second value good');
is( $val->[2], -0.1, 'third value good');

ok( !$def->check([0, -0.5959, -0.5227]), 'check YIO values works on lower bound values');
ok( !$def->check([1, 0.5959, 0.5227]), 'check YIO values works on upper bound values');
Expand Down Expand Up @@ -66,3 +69,83 @@ is( close_enough($rgb[1], 0 ), 1, 'right green value');
is( close_enough($rgb[2], 1, ), 1, 'right blue value');

exit 0;

__END__
is( not($@), 1, 'could load the module');
is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module');
is( $def->name, 'HWB', 'color space has right name');
is( $def->axis, 3, 'color space has 3 axis');
is( ref $def->in_range([0, 0, 0]), 'ARRAY', 'check HWB values works on lower bound values');
is( ref $def->in_range([360,100,100]), 'ARRAY', 'check HWB values works on upper bound values');
is( ref $def->in_range([0,0]), '', "HWB got too few values");
is( ref $def->in_range([0, 0, 0, 0]), '', "HWB got too many values");
is( ref $def->in_range([-1, 0, 0]), '', "hue value is too small");
is( ref $def->in_range([1.1, 0, 0]), '', "hue is not integer");
is( ref $def->in_range([361, 0, 0]), '', "hue value is too big");
is( ref $def->in_range([0, -1, 0]), '', "whiteness value is too small");
is( ref $def->in_range([0, 1.1, 0]), '', "whiteness value is not integer");
is( ref $def->in_range([0, 101, 0]), '', "whiteness value is too big");
is( ref $def->in_range([0, 0, -1 ] ), '', "blackness value is too small");
is( ref $def->in_range([0, 0, 1.1] ), '', "blackness value is not integer");
is( ref $def->in_range([0, 0, 101] ), '', "blackness value is too big");
my $val = $def->round([1,22.5, 11.111111]);
is( ref $val, 'ARRAY', 'rounded value tuple int tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 1, 'first value kept');
is( $val->[1], 23, 'second value rounded up');
is( $val->[2], 11, 'third value rounded down');
my $hwb = $def->deconvert( [ .5, .5, .5], 'RGB');
is( int @$hwb, 3, 'converted color grey has three hwb values');
is( $hwb->[0], 0, 'converted color grey has computed right hue value');
is( $hwb->[1], .5, 'converted color grey has computed right whiteness');
is( $hwb->[2], .5, 'converted color grey has computed right blackness');
my $rgb = $def->convert( [0, 0.5, .5], 'RGB');
is( int @$rgb, 3, 'converted back color grey has three rgb values');
is( $rgb->[0], 0.5, 'converted back color grey has right red value');
is( $rgb->[1], 0.5, 'converted back color grey has right green value');
is( $rgb->[2], 0.5, 'converted back color grey has right blue value');
$hwb = $def->deconvert( [210/255, 20/255, 70/255], 'RGB');
is( int @$hwb, 3, 'converted nice magents has three hwb values');
is( close_enough( $hwb->[0], 0.95555), 1, 'converted nice magenta has computed right hue value');
is( close_enough( $hwb->[1], 0.08, ), 1, 'converted nice magenta has computed right whiteness');
is( close_enough( $hwb->[2], 0.18, ), 1, 'converted nice magenta has computed right blackness');
$rgb = $def->convert( [0.95555, 0.08, 0.18], 'RGB');
is( int @$rgb, 3, 'converted back nice magenta');
is( close_enough( $rgb->[0], 210/255), 1, 'right red value');
is( close_enough( $rgb->[1], 20/255) , 1, 'right green value');
is( close_enough( $rgb->[2], 70/255) , 1, 'right blue value');
$rgb = $def->convert( [0.83333, 0, 1], 'RGB'); # should become black despite color value
is( int @$rgb, 3, 'converted black');
is( $rgb->[0], 0, 'right red value');
is( $rgb->[1], 0, 'right green value');
is( $rgb->[2], 0, 'right blue value');
$val = $def->form->remove_suffix([qw/360 100% 100%/]);
is( ref $val, 'ARRAY', 'value tuple without suffixes is a tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 360, 'first value is right');
is( $val->[1], 100, 'second value right');
is( $val->[2], 100, 'third value right');
$val = $def->deformat('hwb(240, 88%, 22%)');
is( ref $val, 'ARRAY', 'deformated CSS string into value tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 240, 'first value is right');
is( $val->[1], 88, 'second value right');
is( $val->[2], 22, 'third value right');
$val = $def->deformat('hwb(240, 88, 22)');
is( ref $val, 'ARRAY', 'deformated CSS string without suffix into value tuple');
is( int @$val, 3, 'right amount of values');
is( $val->[0], 240, 'first value is right');
is( $val->[1], 88, 'second value right');
is( $val->[2], 22, 'third value right');
is( $def->format([240, 88, 22], 'css_string'), 'hwb(240, 88%, 22%)', 'converted tuple into css string');
is( $def->format([240, 88, 22], 'css_string', ''), 'hwb(240, 88, 22)', 'converted tuple into css string without suffixes');

0 comments on commit 7a4f381

Please sign in to comment.