Skip to content

Commit 348252c

Browse files
lichtkindlichtkind
committed
fix color space class tests
1 parent b652ab9 commit 348252c

File tree

5 files changed

+117
-65
lines changed

5 files changed

+117
-65
lines changed

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

Lines changed: 14 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -31,21 +31,22 @@ sub is_partial_hash { shift->basis->is_partial_hash(@_) } # %+values --> ?
3131
########################################################################
3232

3333
sub shape { $_[0]{'shape'} }
34-
sub in_range { shift->shape->in_range( @_ ) } # @+values -- @+range, @+precision --> @+values|!~ # errmsg
35-
sub clamp { shift->shape->clamp( @_ ) } # @+values -- @+range, @+precision --> @+rvals # result values
36-
sub normalize { shift->shape->normalize(@_)} # @+values -- @+range --> @+rvals|!~
37-
sub denormalize { shift->shape->denormalize(@_)} # @+values -- @+range, @+precision --> @+rvals|!~
38-
sub denormalize_delta { shift->shape->denormalize_delta(@_)} # @+values -- @+range --> @+rvals|!~
39-
sub delta { shift->shape->delta( @_ ) } # @+values1, @+values2 --> @+rvals| # on normalized values
34+
sub in_range { shift->shape->in_range( @_ ) } # @+values -- @+range, @+precision --> @+values|!~ # errmsg
35+
sub clamp { shift->shape->clamp( @_ ) } # @+values -- @+range, @+precision --> @+rvals # result values
36+
sub normalize { shift->shape->normalize(@_)} # @+values -- @+range --> @+rvals|!~
37+
sub denormalize { shift->shape->denormalize(@_)} # @+values -- @+range, @+precision --> @+rvals|!~
38+
sub denormalize_delta { shift->shape->denormalize_delta(@_)} # @+values -- @+range --> @+rvals|!~
39+
sub delta { shift->shape->delta( @_ ) } # @+values1, @+values2 --> @+rvals| # on normalized values
4040

4141
########################################################################
4242

4343
sub form { $_[0]{'format'} }
44-
sub format { shift->form->format(@_) } # @+values, ~format_name -- @~suffix --> $*color
45-
sub deformat { shift->form->deformat(@_) } # $*color -- @~suffix --> @+values, ~format_name
46-
sub has_format { shift->form->has_format(@_) } # ~format_name --> ?
47-
sub add_formatter { shift->form->add_formatter(@_) } # ~format_name, &formatter --> &?
48-
sub add_deformatter { shift->form->add_deformatter(@_) } # ~format_name, &deformatter --> &?
44+
sub format { shift->form->format(@_) } # @+values, ~format_name -- @~suffix --> $*color
45+
sub deformat { shift->form->deformat(@_) } # $*color -- @~suffix --> @+values, ~format_name
46+
sub has_format { shift->form->has_format(@_) } # ~format_name --> ?
47+
sub has_deformat { shift->form->has_deformat(@_) } # ~format_name --> ?
48+
sub add_formatter { shift->form->add_formatter(@_) } # ~format_name, &formatter --> &?
49+
sub add_deformatter { shift->form->add_deformatter(@_) } # ~format_name, &deformatter --> &?
4950

5051
#### conversion ########################################################
5152

@@ -62,10 +63,10 @@ sub deconvert {
6263
}
6364

6465
sub add_converter {
65-
my ($self, $space_name, $to_code, $from_code, $mode) = @_;
66+
my ($self, $space_name, $to_code, $from_code) = @_;
6667
return 0 if not defined $space_name or ref $space_name or ref $from_code ne 'CODE' or ref $to_code ne 'CODE';
6768
return 0 if $self->can_convert( $space_name );
68-
$self->{'convert'}{ uc $space_name } = { from => $from_code, to => $to_code, mode => $mode }; # what is mode ?
69+
$self->{'convert'}{ uc $space_name } = { from => $from_code, to => $to_code }; # what is mode ?
6970
}
7071

7172

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,7 @@ sub _check_values_and_space {
4444
check_space_name( $space_name ) and return;
4545
my $space = get_space($space_name);
4646
$space->is_array( $values ) ? $space
47-
: 'need an ARRAY ref with '.$space->dimensions." $space_name values as first argument of $sub_name";
47+
: 'need an ARRAY ref with '.$space->axis." $space_name values as first argument of $sub_name";
4848
}
4949

5050
#### value API #########################################################

‎lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,12 @@ use Graphics::Toolkit::Color::Space;
88
use Graphics::Toolkit::Color::Space::Util ':all';
99

1010
my $rgb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/red green blue/], range => 255 );
11-
11+
$rgb_def->add_converter('RGB', \&pass, \&pass );
1212
$rgb_def->add_deformatter( 'array', sub { $_[1] if $rgb_def->is_value_tuple( $_[1] ) } );
1313
$rgb_def->add_formatter( 'hex_string', \&hex_from_rgb );
1414
$rgb_def->add_deformatter( 'hex_string', \&rgb_from_hex );
1515

16+
sub pass { @{$_[0]} }
1617

1718
sub hex_from_rgb { sprintf("#%02x%02x%02x", @{$_[1]} ) }
1819

‎t/02_space_basis.t

Lines changed: 16 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
use v5.12;
44
use warnings;
5-
use Test::More tests => 120;
5+
use Test::More tests => 128;
66

77
BEGIN { unshift @INC, 'lib', '../lib'}
88
my $module = 'Graphics::Toolkit::Color::Space::Basis';
@@ -65,12 +65,21 @@ is( $s3d->is_value_tuple([2,2]), 0, 'too small ARRAY');
6565
is( $s3d->is_value_tuple([1,2,3,4]), 0, 'too large ARRAY');
6666
is( $s3d->is_value_tuple([1,2,3]), 1, 'correctly sized value ARRAY');
6767

68-
is( $s3d->pos_from_long('alpha'), 0, 'alpha is the first key');
69-
is( $s3d->pos_from_long('beta'), 1, 'beta is the second key');
70-
is( $s3d->pos_from_long('emma'), undef, 'emma is not akey');
71-
is( $s5d->pos_from_long('aleph'), 0, 'aleph is the first key');
72-
is( $s5d->pos_from_long('he'), 4, 'he is the fourth key');
73-
is( $s5d->pos_from_long('emma'), undef, 'emma is not akey');
68+
is( $s3d->pos_from_long('alpha'), 0, 'alpha name of first axis');
69+
is( $s3d->pos_from_long('beta'), 1, 'beta is name of second axis');
70+
is( $s3d->pos_from_long('emma'), undef, 'emma is not an axis name');
71+
is( $s5d->pos_from_long('aleph'), 0, 'aleph is the first name');
72+
is( $s5d->pos_from_long('he'), 4, 'he is the fourth nam');
73+
is( $s5d->pos_from_long('emma'), undef, 'emma is not an axis name');
74+
75+
is( $s3d->short_from_long_name('alpha'), 'a', 'a is short for alpha');
76+
is( $s3d->short_from_long_name('BETA'), 'b', 'upper case axis name recognized');
77+
is( $s3d->short_from_long_name('emma'), undef, 'emma is not a an axis name and there fore has no shortcut');
78+
is( $s5d->short_from_long_name('He'), 'q', 'custom shortcut provided');
79+
is( $s3d->long_from_short_name('a'), 'alpha', 'alpha is long axis name for shortcut a');
80+
is( $s3d->long_from_short_name('B'), 'beta', 'upper case shortcut recognized');
81+
is( $s3d->long_from_short_name('e'), undef, 'e is not a a shortcut axis name: there is no full name');
82+
is( $s5d->long_from_short_name('q'), 'he', 'long axis name from custom shortcut');
7483

7584
is( $s3d->is_hash([]), 0, 'array is not a hash');
7685
is( $s3d->is_hash({alpha => 1, beta => 20, gamma => 3}), 1, 'valid hash with right keys');

‎t/05_space.t

Lines changed: 84 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
use v5.12;
44
use warnings;
5-
use Test::More tests => 67;
5+
use Test::More tests => 126;
66

77
BEGIN { unshift @INC, 'lib', '../lib'}
88
my $module = 'Graphics::Toolkit::Color::Space';
@@ -12,7 +12,7 @@ my $fspace = Graphics::Toolkit::Color::Space->new();
1212
is( ref $fspace, '', 'need axis names to create color space');
1313

1414
my $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/]);
15-
is( ref $space, $module, 'got axis names and created color space');
15+
is( ref $space, $module, 'created color space just with axis names');
1616
is( $space->name, 'ABCD', 'got space name from AXIS short names');
1717
is( $space->axis, 4, 'counted axis right');
1818
is( $space->is_value_tuple([1,2,3,4]), 1, 'correct value tuple');
@@ -32,44 +32,100 @@ is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, z => 4}), 0, 'one bad key
3232
is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object');
3333
is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
3434
is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object');
35+
36+
$space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], name => 'name');
37+
is( ref $space, $module, 'created color space just with axis names and space name');
38+
is( $space->name, 'name', 'got given space name back');
39+
is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object');
40+
is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
41+
is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object');
42+
43+
$space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], prefix => 'pre');
44+
is( $space->name, 'preABCD', 'got space name with given prefix');
45+
is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object');
46+
is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
47+
is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object');
48+
49+
$space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], prefix => 'pre', name => 'Name');
50+
is( $space->name, 'preName', 'got space name with given prefix and givn Name');
51+
is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object');
52+
is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
53+
is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object');
54+
3555
is( ref $space->in_range([0,1,0.5,0.001]), 'ARRAY', 'default to normal range');
3656
is( ref $space->in_range([1,1.1,1,1]), '', 'one value of tuple is out of range');
3757
my $val = $space->clamp([-1,1.1,1]);
38-
is( ref $val, 'ARRAY', 'got tuple back');
58+
is( ref $val, 'ARRAY', 'clamped value tuple is a tuple');
3959
is( int @$val, 4, 'filled mising value in');
4060
is( $val->[0], 0, 'clamped up first value');
4161
is( $val->[1], 1, 'clamped down second value');
4262
is( $val->[2], 1, 'passed through third value');
4363
is( $val->[3], 0, 'zero is default value');
4464

65+
$space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], range => [10,20,'normal', [-10,10]]);
66+
is( ref $space, $module, 'created color space with axis names and ranges');
67+
is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object');
68+
is( ref $space->in_range([10,10,1,10]), 'ARRAY', 'max values are in range');
69+
is( ref $space->in_range([0,0,0,-10]), 'ARRAY', 'min values are in range');
70+
is( ref $space->in_range([0,0,2,-10]), '', 'one value is ou of range');
71+
$val = $space->clamp([-1,20.1,1]);
72+
is( ref $val, 'ARRAY', 'clamped value tuple is a tuple');
73+
is( int @$val, 4, 'filled mising value in');
74+
is( $val->[0], 0, 'clamped up first value');
75+
is( $val->[1], 20, 'clamped down second value');
76+
is( $val->[2], 1, 'passed through third value');
77+
is( $val->[3], 0, 'zero is default value');
4578

46-
exit 0;
47-
48-
__END__
49-
my $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], range => 20);
79+
$val = $space->normalize([5,10,0.5,0]);
80+
is( ref $val, 'ARRAY', 'normalized value tuple is a tuple');
81+
is( int @$val, 4, 'right amount of values');
82+
is( $val->[0], 0.5, 'first value correct');
83+
is( $val->[1], 0.5, 'second value correct');
84+
is( $val->[2], 0.5, 'third value correct');
85+
is( $val->[3], 0.5, 'fourth value correct');
86+
87+
$val = $space->denormalize([ 0.5, 0.5, 0.5, 0.5]);
88+
is( ref $val, 'ARRAY', 'denormalized value tuple is a tuple');
89+
is( int @$val, 4, 'right amount of values');
90+
is( $val->[0], 5, 'first value correct');
91+
is( $val->[1], 10, 'second value correct');
92+
is( $val->[2], 0.5, 'third value correct');
93+
is( $val->[3], 0, 'fourth value correct');
94+
95+
$val = $space->denormalize_delta([ 0.5, 0.5, 0.5, 0.5]);
96+
is( ref $val, 'ARRAY', 'denormalized range value tuple is a tuple');
97+
is( int @$val, 4, 'right amount of values');
98+
is( $val->[0], 5, 'first value correct');
99+
is( $val->[1], 10, 'second value correct');
100+
is( $val->[2], 0.5, 'third value correct');
101+
is( $val->[3], 10, 'fourth value correct - range had none zero min');
102+
103+
$val = $space->delta([ 1, 1, 1, 1], [ 5, 20, 0, -1]);
104+
is( ref $val, 'ARRAY', 'delta between value tuples is a tuple');
105+
is( int @$val, 4, 'right amount of values');
106+
is( $val->[0], 4, 'first value correct');
107+
is( $val->[1], 19, 'second value correct');
108+
is( $val->[2], -1, 'third value correct');
109+
is( $val->[3], -2, 'fourth value correct - range had none zero min');
50110

51-
is( ref $space, $module, 'could create a space object');
52-
is( $space->name, 'ABCD', 'space has right name');
53-
is( $space->dimensions, 4, 'space has four dimension');
54111
is( $space->has_format('bbb'), 0, 'vector name is not a format');
55112
is( $space->has_format('c'), 0, 'vector sigil is not a format');
56113
is( $space->has_format('list'),1, 'list is a format');
57114
is( $space->has_format('hash'),1, 'hash is a format');
58115
is( $space->has_format('char_hash'),1, 'char_hash is a format');
59-
60116
is( ref $space->format([1,2,3,4], 'hash'), 'HASH', 'formatted values into a hash');
61117
is( int($space->format([1,2,3,4], 'list')), 4, 'got long enough list of values');
62-
63118
is( $space->format([1,2,3,4], 'bbb'), 0, 'got no value by key name');
64119
is( $space->format([1,2,3,4], 'AAA'), 0, 'got no value by uc key name');
65120
is( $space->format([1,2,3,4], 'c'), 0, 'got no value by shortcut name');
66121
is( $space->format([1,2,3,4], 'D'), 0, 'got no value by uc shortcut name');
122+
is( $space->has_format('str'), 0, 'formatter not yet inserted');
67123

68-
is( $space->has_format('str'), 0, 'formatter not yet inserted');
69-
my $c = $space->add_formatter('str', sub { $_[0] . $_[1] . $_[2] . $_[3]});
70-
is( ref $c, 'CODE', 'formatter code accepted');
71-
is( $space->has_format('str'), 1, 'formatter inserted');
72-
is( $space->format([1,2,3,4], 'str'), '1234', 'inserted formatter works');
124+
my $c = $space->add_formatter('str', sub { $_[1][0] . $_[1][1] . $_[1][2] . $_[1][3]});
125+
is( ref $c, 'CODE', 'formatter code accepted');
126+
is( $space->has_format('str'), 1, 'formatter inserted');
127+
my $str = $space->format([1,2,3,4], 'str');
128+
is( $str, '1234', 'inserted formatter works');
73129

74130
my $fval = $space->deformat({a => 1, b => 2, c => 3, d => 4});
75131
is( int @$fval, 4, 'deformatter recognized char hash');
@@ -90,8 +146,10 @@ is( $fval, undef, 'char hash with bad key got ignored');
90146
$fval = $space->deformat({aaa => 1, bbb => 2, ccc => 3, dd => 4});
91147
is( $fval, undef, 'char hash with bad key got ignored');
92148

93-
my $dc = $space->add_deformatter('str', sub { split ':', $_[0] });
149+
is( $space->has_deformat('str'), 0, 'deformatter not yet inserted');
150+
my $dc = $space->add_deformatter('str', sub { [split ':', $_[1]] });
94151
is( ref $dc, 'CODE', 'deformatter code accepted');
152+
is( $space->has_deformat('str'), 1, 'deformatter accessible');
95153
$fval = $space->deformat('1:2:3:4');
96154
is( int @$fval, 4, 'self made deformatter recognized str');
97155
is( $fval->[0], 1, 'first value correctly deformatted');
@@ -100,45 +158,28 @@ is( $fval->[2], 3, 'third value correctly deformatted');
100158
is( $fval->[3], 4, 'fourth value correctly deformatted');
101159

102160
is( $space->can_convert('XYZ'), 0, 'converter not yet inserted');
103-
my $h = $space->add_converter('XYZ', sub { $_[0]+1, $_[1]+1, $_[2]+1, $_[3]+1},
104-
sub { $_[0]-1, $_[1]-1, $_[2]-1, $_[3]-1} );
161+
my $h = $space->add_converter('XYZ', sub { $_[0][0]+1, $_[0][1]+1, $_[0][2]+1, $_[0][3]+1},
162+
sub { $_[0][0]-1, $_[0][1]-1, $_[0][2]-1, $_[0][3]-1} );
105163
is( ref $h, 'HASH', 'converter code accepted');
106164
is( $space->can_convert('XYZ'), 1, 'converter inserted');
107-
my $val = $space->convert([1,2,3,4], 'XYZ');
108-
is( int @$val, 4, 'converter did something');
165+
$val = $space->convert([1,2,3,4], 'XYZ');
166+
is( int @$val, 4, 'converter did something');
109167
is( $val->[0], 2, 'first value correctly converted');
110168
is( $val->[1], 3, 'second value correctly converted');
111169
is( $val->[2], 4, 'third value correctly converted');
112170
is( $val->[3], 5, 'fourth value correctly converted');
113171
$val = $space->deconvert([2,3,4,5], 'xyz');
114-
is( int @$val, 4, 'deconverter did something even if space spelled in lower case');
172+
is( int @$val, 4, 'deconverter did something even if space spelled in lower case');
115173
is( $val->[0], 1, 'first value correctly deconverted');
116174
is( $val->[1], 2, 'second value correctly deconverted');
117175
is( $val->[2], 3, 'third value correctly deconverted');
118176
is( $val->[3], 4, 'fourth value correctly deconverted');
119177

178+
exit 0;
179+
180+
120181

121-
my $d = $space->delta([2,3,4,5], [1,5,1,1] );
122-
is( int @$d, 4, 'delta result has right length');
123-
is( $d->[0], -1, 'first value correctly deconverted');
124-
is( $d->[1], 2, 'second value correctly deconverted');
125-
is( $d->[2], -3, 'third value correctly deconverted');
126-
is( $d->[3], -4, 'fourth value correctly deconverted');
127182

128-
my $tr = $space->clamp([-1, 0, 20.1, 21, 1]);
129-
is( int @$tr, 4, 'clamp kept correct vector length = 4');
130-
is( $tr->[0], 0, 'clamp up value below minimum');
131-
is( $tr->[1], 0, 'do not touch minimal value');
132-
is( $tr->[2], 20, 'clamp real into int');
133-
is( $tr->[3], 20, 'clamp down value above range max');
134183

135-
is( ref $space->in_range([1,2,3,4]), 'ARRAY', 'all values in range');
136184

137-
my $norm = $space->normalize([0, 10, 20, 15]);
138-
is( int @$norm, 4, 'normalized 4 into 4 values');
139-
is( $norm->[0], 0, 'normalized first min value');
140-
is( $norm->[1], 0.5, 'normalized second mid value');
141-
is( $norm->[2], 1, 'normalized third max value');
142-
is( $norm->[3], 0.75, 'normalized fourth value');
143185

144-
exit 0;

0 commit comments

Comments
 (0)