more color space tests

Author: lichtkind

Changes

@@ -2,10 +2,13 @@
 1.8     2024-04-22    lichtkind
 -------
     * = mid level feature release
-    * * added color space support: XYZ LAB LUV HCL LCH
+    * * added color space support for: XYZ LAB LUV LCHab LCHuv NCol
     * + extended range definitions with explicit type names
+    * + color spaces can now define value procision,
+                                    value suffix ('%') and
+                                    value parsing regex
     * ? added documentation for color space object and missing formats
-    * & moved code into space::Format attr object class
+    * & moved code into Space::Format space attr object class
     * & removed Carp and Test::Warn as dependencies
     * & moved color set function into own package
     * ~ default space of methods 'distance', 'blend' and 'gradient'

lib/Graphics/Toolkit/Color/Space.pm

@@ -22,11 +22,11 @@ sub new {
 
 ########################################################################
 
-sub basis            { $_[0]{'basis'} }
-sub name             { $_[0]->basis->space_name }              #          --> ~
-sub axis             { $_[0]->basis->count }                   #          --> +
-sub is_value_tuple   { $_[0]->basis->is_value_tuple( $_[1] ) } # @+values --> ?
-sub is_partial_hash  { $_[0]->basis->is_partial_hash( $_[1] ) }# %+values --> ?
+sub basis             { $_[0]{'basis'} }
+sub name              { shift->basis->space_name }           #          --> ~
+sub axis              { shift->basis->count }                #          --> +
+sub is_value_tuple    { shift->basis->is_value_tuple(@_) }   # @+values --> ?
+sub is_partial_hash   { shift->basis->is_partial_hash(@_) }  # %+values --> ?
 
 ########################################################################
 
@@ -50,13 +50,11 @@ sub add_deformatter   { shift->form->add_deformatter(@_) } # ~format_name, &defo
 #### conversion ########################################################
 
 sub can_convert      { (defined $_[1] and exists $_[0]{'convert'}{ uc $_[1] }) ? 1 : 0 }
-
 sub convert {
     my ($self, $values, $space_name) = @_;
     return unless $self->is_value_tuple( $values ) and defined $space_name and $self->can_convert( $space_name );
     return [$self->{'convert'}{ uc $space_name }{'to'}->( $values )];
 }
-
 sub deconvert {
     my ($self, $values, $space_name) = @_;
     return unless ref $values eq 'ARRAY' and defined $space_name and $self->can_convert( $space_name );

t/02_space_basis.t

@@ -2,7 +2,7 @@
 
 use v5.12;
 use warnings;
-use Test::More tests => 117;
+use Test::More tests => 120;
 
 BEGIN { unshift @INC, 'lib', '../lib'}
 my $module = 'Graphics::Toolkit::Color::Space::Basis';
@@ -80,7 +80,10 @@ is( $s3d->is_hash({a => 1, B => 1, g => 3}),             1, 'shortcut casing get
 is( $s3d->is_hash({a => 1, b => 1, g => 3, h => 4}),     0, 'too many hash key shortcut ');
 is( $s3d->is_hash({alph => 1, beth => 1, gimel => 4, daleth => 2, he => 4}), 0, 'one wrong hash key');
 
-is( $s5d->is_partial_hash([]),   0,      'array is not a partial hash');
+is( $s5d->is_partial_hash(''),             0,      'string is not a partial hash');
+is( $s5d->is_partial_hash([]),             0,      'array is not a partial hash');
+is( $s5d->is_partial_hash({}),             0,      'empty hash is not a partial hash');
+is( $s5d->is_partial_hash({gamma => 1}),   0,      'wrong key for partial hash');
 is( $s5d->is_partial_hash({aleph => 1, beth => 2, gimel => 3, daleth => 4, he => 5}), 1, 'valid hash with right keys is also correct partial hash');
 is( $s5d->is_partial_hash({aleph => 1, beth => 20, gimel => 3, daleth => 4, he => 5, o => 6}), 0, 'partial hash can not have more keys than full hash definition');
 is( $s5d->is_partial_hash({aleph => 1 }),              1, 'valid partial hash to have only one korrect key');

t/03_space_shape.t

@@ -15,33 +15,33 @@ my $basis = Graphics::Toolkit::Color::Space::Basis->new( [qw/AAA BBB CCC/] );
 my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis);
 is( ref $shape,  $module, 'created shape with default settings');
 
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, {}), qr/invalid axis type/, 'type definition needs to be an ARRAY');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, []), qr/invalid axis type/, 'type definition needs to have same length');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, ['yes','no','maybe']), qr/invalid axis type/, 'undefined values');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, [1,2,3]), qr/invalid axis type/, 'undefined numeric values');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, {}), qr/invalid axis type/, 'type definition needs to be an ARRAY');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, []), qr/invalid axis type/, 'type definition needs to have same length');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, ['yes','no','maybe']), qr/invalid axis type/, 'undefined values');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, [1,2,3]), qr/invalid axis type/, 'undefined numeric values');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, ['linear','circular','no']), $module, 'valid type def');
 
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, {}), qr/invalid range/, 'range definition needs to be an ARRAY');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, {}), qr/invalid range/, 'range definition needs to be an ARRAY');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 1), $module, 'uniform scalar range');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 'normal'), $module, 'normal scalar range');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 'percent'), $module, 'percent scalar range');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, []), qr/invalid range/, 'range definition ARRAY has to have same lngth');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, []), qr/invalid range/, 'range definition ARRAY has to have same lngth');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [1,2,3]), $module, 'ARRAY range with right amount of ints');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2],[1,2]]), $module, 'full ARRAY range');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1.1,1.2],[1,2]]), $module, 'full ARRAY range with decimals');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2]]), qr/invalid range/, 'not enough elements in range def');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2],[1,2],[1,2]]), qr/invalid range/, 'too many elements in range def');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[2,1],[1,2]]), qr/lower bound/, 'one range def element is backward');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1],[1,2]]), qr/two elements/, 'one range def element is too small');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2,3],[1,2]]), qr/two elements/, 'one range def element is too big');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,'-'],[1,2]]), qr/none numeric/, 'one range def element has a none number');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2]]), qr/invalid range/, 'not enough elements in range def');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2],[1,2],[1,2]]), qr/invalid range/, 'too many elements in range def');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[2,1],[1,2]]), qr/lower bound/, 'one range def element is backward');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1],[1,2]]), qr/two elements/, 'one range def element is too small');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2,3],[1,2]]), qr/two elements/, 'one range def element is too big');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,'-'],[1,2]]), qr/none numeric/, 'one range def element has a none number');
 
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, 0), $module, 'accepting third constructor arg - precision zero');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, 2), $module, 'precision 2');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, -1), $module, 'precision -1');
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, [0,1,-1]), $module, 'full precision def');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, [1,2]), qr/value precision/, 'precision def too short');
-like( Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, [1,2,3,-1]), qr/value precision/, 'precision def too long');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, [1,2]), qr/value precision/, 'precision def too short');
+like(   Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef, [1,2,3,-1]), qr/value precision/, 'precision def too long');
 
 is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef,undef,undef, '%'), $module, 'accepting fourth constructor arg - a suffix for axis numbers');
 

t/05_space.t

@@ -19,7 +19,28 @@ is( $space->is_value_tuple([1,2,3,4]),   1, 'correct value tuple');
 is( $space->is_value_tuple([1,2,3,4,5]), 0, 'too long value tuple');
 is( $space->is_value_tuple([1,2,3,]),    0, 'too short value tuple');
 is( $space->is_value_tuple({1=>1,2=>2,3=>3,4=>4,}),  0, 'wrong ref type for value tuple');
-is( $space->is_value_tuple(''),                      0, 'no ref type can not be value tuple');
+is( $space->is_value_tuple(''),                      0, 'none ref type can not be value tuple');
+is( $space->is_partial_hash(''),                     0, 'need a hash ref to be a partial hash');
+is( $space->is_partial_hash({}),                     0, 'a partial hash needs to have at least one key');
+is( $space->is_partial_hash({eta =>1}),              0, 'wrong key for partial hash');
+is( $space->is_partial_hash({aaa =>1}),              1, 'right key for partial hash');
+is( $space->is_partial_hash({aaa =>1,bbb=> 2}),      1, 'two right keys for partial hash');
+is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3}),     1, 'three right keys for partial hash');
+is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, ddd => 4}), 1, 'four right keys for partial hash');
+is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, d => 4}), 1, 'can mix full names and shortcut names');
+is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, z => 4}), 0, 'one bad key makes partial hash invalid');
+is( ref $space->basis,  'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object');
+is( ref $space->shape,  'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
+is( ref $space->form,   'Graphics::Toolkit::Color::Space::Format','have a valid format sub object');
+is( ref $space->in_range([0,1,0.5,0.001]),       'ARRAY', 'default to normal range');
+is( ref $space->in_range([1,1.1,1,1]),                '', 'one value of tuple is out of range');
+my $val = $space->clamp([-1,1.1,1]);
+is( ref $val,                'ARRAY', 'got tuple back');
+is( int @$val,                     4, 'filled mising value in');
+is( $val->[0],                     0, 'clamped up first value');
+is( $val->[1],                     1, 'clamped down second value');
+is( $val->[2],                     1, 'passed through third value');
+is( $val->[3],                     0, 'zero is default value');
 
 
 exit 0;