File Coverage

lib/Graphics/Toolkit/Color/Calculator.pm
Criterion Covered Total %
statement 90 115 78.2
branch 53 74 71.6
condition 11 18 61.1
subroutine 9 19 47.3
pod 0 14 0.0
total 163 240 67.9


line stmt bran cond sub pod time code
1              
2             # methods to compute one related color
3              
4             package Graphics::Toolkit::Color::Calculator;
5 7     7   199050 use v5.12;
  7         23  
6 7     7   28 use warnings;
  7         10  
  7         362  
7 7     7   435 use Graphics::Toolkit::Color::Space::Util qw/is_nr spow/;
  7         9  
  7         427  
8 7     7   2209 use Graphics::Toolkit::Color::Values;
  7         16  
  7         10979  
9              
10             sub apply_gamma {
11 9     9 0 1488 my ($color_values, $gamma, $color_space) = @_;
12 9         11 my $gamma_array = '';
13 9 50       19 return "need a color space as third argument" if ref $color_space ne 'Graphics::Toolkit::Color::Space';
14 9 100       16 if (ref $gamma eq 'HASH'){
15 3         8 ($gamma_array, my $deduced_space_name) =
16             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $gamma, $color_space->name );
17 3 100       11 return 'axis names: '.join(', ', keys %$gamma).' do not correlate to the selected color space: '.
18             ($color_space->name).'!' unless ref $gamma_array;
19             }
20 8 100       21 $gamma_array = [ ($gamma) x $color_space->axis_count] if is_nr( $gamma );
21 8 50 33     17 $gamma_array = $gamma if not defined $gamma_array and ref $gamma eq 'ARRAY';
22 8 50       12 return 'got badly formatted gamma value' if ref $gamma_array ne 'ARRAY';
23            
24 8         13 my $tuple = $color_values->normalized( $color_space->name );
25 8         13 for my $axis_nr ($color_space->basis->axis_iterator){
26 24 100       49 $tuple->[$axis_nr] = spow($tuple->[$axis_nr], $gamma_array->[$axis_nr]) if exists $gamma_array->[$axis_nr];
27             }
28 8         12 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
29             }
30              
31             sub set_value { # .values, %newval -- ~space_name --> _
32 13     13 0 1681 my ($color_values, $partial_hash, $preselected_space_name) = @_;
33 13         29 my ($new_values, $deduced_space_name) =
34             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $partial_hash, $preselected_space_name );
35 13 100       22 unless (ref $new_values){
36 4         13 my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to ';
37 4 100       19 return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!'
38             : $help_start.'any supported color space!';
39             }
40 9         24 my $tuple = $color_values->shaped( $deduced_space_name );
41 9         16 my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
42 9         18 for my $pos ($color_space->basis->axis_iterator) {
43 27 100       46 $tuple->[$pos] = $new_values->[$pos] if defined $new_values->[$pos];
44             }
45 9         18 return $color_values->new_from_tuple( $tuple, $color_space->name );
46             }
47              
48             sub add_value { # .values, %newval -- ~space_name --> _
49 13     13 0 2102 my ($color_values, $partial_hash, $preselected_space_name) = @_;
50 13         33 my ($new_values, $deduced_space_name) =
51             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( $partial_hash, $preselected_space_name );
52 13 100       29 unless (ref $new_values){
53 5         18 my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to ';
54 5 100       24 return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!'
55             : $help_start.'any supported color space!';
56             }
57 8         47 my $tuple = $color_values->shaped( $deduced_space_name );
58 8         16 my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
59 8         17 for my $pos ($color_space->basis->axis_iterator) {
60 24 100       45 $tuple->[$pos] += $new_values->[$pos] if defined $new_values->[$pos];
61             }
62 8         15 return $color_values->new_from_tuple( $tuple, $color_space->name );
63             }
64              
65              
66             #### light designer API ################################################
67             sub _clear_values_amount_space_name {
68 0     0   0 my ($color_values, $amount, $space_name, @more) = @_;
69 0 0       0 return "need a G::T::Color::Values object as first argument"
70             unless ref $color_values eq 'Graphics::Toolkit::Color::Values';
71 0 0       0 return "need a numeric amount between 0 and 1 as first argument" unless defined $amount;
72 0         0 my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name );
73 0 0       0 return "$space_name is not a known color space" unless ref $color_space;
74 0         0 return ($color_values, $amount, $color_space, @more);
75             }
76              
77 0     0 0 0 sub lighten { add_axis_value( @_, 'lightness') }
78             sub darken {
79 0     0 0 0 my ($color_values, $amount, $color_space) = @_;
80 0         0 add_axis_value($color_values, -$amount, $color_space, 'lightness');
81             }
82 0     0 0 0 sub saturate { add_axis_value( @_, 'saturation') }
83             sub desaturate {
84 0     0 0 0 my ($color_values, $amount, $color_space) = @_;
85 0         0 add_axis_value($color_values, -$amount, $color_space, 'saturation');
86             }
87             sub add_axis_value {
88 0     0 0 0 my ($color_values, $amount, $color_space, $axis_name) = _clear_values_amount_space_name(@_);
89 0 0       0 return $color_values unless ref $color_values;
90 0         0 my $axis_nr = $color_space->pos_from_axis_role( $axis_name );
91 0 0       0 return "color space: '".$color_space->name."' has no $axis_name axis" unless defined $axis_nr;
92 0         0 my $tuple = $color_values->normalized( $color_space->name );
93 0         0 $tuple->[$axis_nr] += $amount;
94 0         0 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
95             }
96              
97 0     0 0 0 sub tint { mix_with(@_, [255 ,255 ,255 ]) } # white
98 0     0 0 0 sub tone { mix_with(@_, [127.5,127.5,127.5]) } # grey50
99 0     0 0 0 sub shade { mix_with(@_, [ 0, 0, 0 ]) } # black
100             sub mix_with {
101 0     0 0 0 my ($color_values, $amount, $color_space, $tuple) = _clear_values_amount_space_name(@_);
102 0 0       0 return $color_values unless ref $color_values;
103 0         0 return mix( $color_values, [Graphics::Toolkit::Color::Values->new_from_tuple( $tuple )], $amount, $color_space);
104             }
105              
106             #### deep designer methods #############################################
107             sub mix { # .base_color_vals, @.added_volor_vals, @+|+add_amount, .space --> .color_values
108 79     79 0 469 my ($base_color, $added_color, $add_amount, $color_space ) = @_;
109 79 50       160 return "need color value object as first argument !\n" unless ref $base_color eq 'Graphics::Toolkit::Color::Values';
110 79 50       147 return "second argument has to be an ARRAY !\n" unless ref $added_color eq 'ARRAY';
111 79 50       150 return "need a color space object !\n" unless ref $color_space eq 'Graphics::Toolkit::Color::Space';
112              
113 79         129 my $color_count = @$added_color + 1;
114 79 100       130 $add_amount = 1 / $color_count unless defined $add_amount;
115 79 100       194 $add_amount = [($add_amount) x ($color_count - 1)] unless ref $add_amount eq 'ARRAY';
116 79 100       143 return "ARRAY of mix amounts needs a value for every color !\n" unless @$add_amount == $color_count - 1;
117 77         95 my $mix_sum = 0;
118 77         216 $mix_sum += $_ for @$add_amount;
119 77 100       129 if ($mix_sum > 1){
120 4         15 for my $reciepe_index (0 .. $#$add_amount){
121 7         19 $add_amount->[$reciepe_index] = $add_amount->[$reciepe_index] / $mix_sum;
122             }
123             } else {
124 73         140 push @$add_amount, 1 - $mix_sum;
125 73         90 push @$added_color, $base_color;
126             }
127            
128 77         214 my $result_values = [(0) x $color_space->axis_count];
129 77         174 for my $color_nr (0 .. $#$added_color){
130 158         313 my $tuple = $added_color->[$color_nr]->shaped( $color_space->name );
131 158         761 $result_values->[$_] += $tuple->[$_] * $add_amount->[$color_nr] for 0 .. $#$tuple;
132             }
133 77         156 return $base_color->new_from_tuple( $result_values, $color_space->name );
134             }
135              
136             sub invert {
137 25     25 0 408 my ($color_values, $only, $color_space, $default_color_space ) = @_;
138 25 100 100     160 $only = [$only] if defined $only and not ref $only; # selected axes
139 25 50 66     85 return "need argument only as axis name (short or long) or as ARRAY of names!"
140             if defined $only and ref $only ne 'ARRAY';
141 25 100       60 if (defined $only){
142 9         24 my %partial_hash = map { $_ => 1 } @$only;
  12         58  
143 9 100       44 my $preselected_space_name = defined($color_space) ? $color_space->name : undef;
144 9         34 my ($new_values, $deduced_space_name) =
145             Graphics::Toolkit::Color::Space::Hub::deformat_search_partial_hash( \%partial_hash, $preselected_space_name );
146 9 50 66     26 return "could not find any color space that contains the axes: ". join(', ', @$only).' !'
147             if not defined $deduced_space_name and not defined $color_space;
148 8 50 33     16 return "axes ". join(', ', @$only) . 'do not match color space '.$color_space->name.' !'
149             if not defined $deduced_space_name and ref $color_space;
150 8         15 $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $deduced_space_name );
151             }
152 24   66     60 $color_space //= $default_color_space;
153            
154 24 100       95 my $selected_axis = (defined $only) ? [ ] : [$color_space->basis->axis_iterator];
155 24 100       56 if (defined $only) {
156 8         10 for my $axis_name (@$only){
157 11         19 my $pos = $color_space->pos_from_axis_role( $axis_name );
158 11         18 $selected_axis->[$pos] = $pos;
159             }
160             }
161 24         56 my $tuple = $color_values->normalized( $color_space->name );
162 24         54 for my $axis_nr ($color_space->basis->axis_iterator){
163 72 100       101 next unless defined $selected_axis->[$axis_nr];
164 59 100       79 if ($color_space->shape->is_axis_euclidean( $axis_nr )){
165 50         102 $tuple->[$axis_nr] = 0.5 - ($tuple->[$axis_nr] - 0.5);
166             } else {
167 9         20 $tuple->[$axis_nr]++ while $tuple->[$axis_nr] < 0;
168 9         19 $tuple->[$axis_nr]-- while $tuple->[$axis_nr] > 1;
169 9 100       28 $tuple->[$axis_nr] = ($tuple->[$axis_nr] < 0.5)
170             ? $tuple->[$axis_nr] + 0.5
171             : $tuple->[$axis_nr] - 0.5;
172             }
173             }
174 24         45 return $color_values->new_from_tuple( $tuple, $color_space->name, 'normal' );
175             }
176            
177             1;