| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Imager::Color::Float; | 
| 2 | 58 |  |  | 58 |  | 1096 | use 5.006; | 
|  | 58 |  |  |  |  | 173 |  | 
| 3 | 58 |  |  | 58 |  | 276 | use Imager; | 
|  | 58 |  |  |  |  | 95 |  | 
|  | 58 |  |  |  |  | 963 |  | 
| 4 | 58 |  |  | 58 |  | 447 | use strict; | 
|  | 58 |  |  |  |  | 94 |  | 
|  | 58 |  |  |  |  | 1073 |  | 
| 5 | 58 |  |  | 58 |  | 240 | use Scalar::Util (); | 
|  | 58 |  |  |  |  | 90 |  | 
|  | 58 |  |  |  |  | 61775 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | our $VERSION = "1.008"; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | # It's just a front end to the XS creation functions. | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | sub _rgb_alpha { | 
| 12 | 19 |  |  | 19 |  | 40 | my ($alpha) = @_; | 
| 13 | 19 | 100 |  |  |  | 47 | if ($alpha =~ /^(.*)%\z/) { | 
| 14 | 3 |  |  |  |  | 16 | return $1 / 100; | 
| 15 |  |  |  |  |  |  | } | 
| 16 |  |  |  |  |  |  | else { | 
| 17 | 16 |  |  |  |  | 49 | return $alpha; | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  | } | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | my $rgb_key = qr/rgba?/; | 
| 22 |  |  |  |  |  |  | my $rgb_samp = qr/(\d+(?:\.\d*)?)/; | 
| 23 |  |  |  |  |  |  | my $rgb_pc = qr/(\d+(?:\.\d*)?)%/; | 
| 24 |  |  |  |  |  |  | my $rgb_sep = qr/ *[, ] */; | 
| 25 |  |  |  |  |  |  | my $rgb_rgb = qr/$rgb_samp $rgb_sep $rgb_samp $rgb_sep $rgb_samp/x; | 
| 26 |  |  |  |  |  |  | my $rgb_rgb_pc = qr/$rgb_pc $rgb_sep $rgb_pc $rgb_sep $rgb_pc/x; | 
| 27 |  |  |  |  |  |  | my $rgb_alpha_sep = qr/ *[\/,] */; | 
| 28 |  |  |  |  |  |  | my $rgb_alpha = qr/((?:\.\d+|\d+(?:\.\d*)?)%?)/; | 
| 29 |  |  |  |  |  |  |  | 
| 30 |  |  |  |  |  |  | # Parse color spec into an a set of 4 colors | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | sub _pspec { | 
| 33 | 169 | 100 | 100 | 169 |  | 534 | if (@_ == 1 && Scalar::Util::blessed($_[0])) { | 
| 34 | 4 | 50 |  |  |  | 35 | if ($_[0]->isa("Imager::Color::Float")) { | 
|  |  | 50 |  |  |  |  |  | 
| 35 | 0 |  |  |  |  | 0 | return $_[0]->rgba; | 
| 36 |  |  |  |  |  |  | } elsif ($_[0]->isa("Imager::Color")) { | 
| 37 | 4 |  |  |  |  | 12 | return $_[0]->as_float->rgba; | 
| 38 |  |  |  |  |  |  | } | 
| 39 |  |  |  |  |  |  | } | 
| 40 | 165 | 100 |  |  |  | 392 | return (@_,1) if @_ == 3; | 
| 41 | 109 | 100 |  |  |  | 248 | return (@_    ) if @_ == 4; | 
| 42 | 46 | 100 |  |  |  | 179 | if ($_[0] =~ | 
| 43 |  |  |  |  |  |  | /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) { | 
| 44 | 1 |  |  |  |  | 10 | return (hex($1)/255,hex($2)/255,hex($3)/255,hex($4)/255); | 
| 45 |  |  |  |  |  |  | } | 
| 46 | 45 | 100 |  |  |  | 101 | if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) { | 
| 47 | 3 |  |  |  |  | 18 | return (hex($1)/255,hex($2)/255,hex($3)/255,1); | 
| 48 |  |  |  |  |  |  | } | 
| 49 | 42 | 50 |  |  |  | 72 | if (@_ == 1) { | 
| 50 |  |  |  |  |  |  | # CSS Color 4 says that color values are rounded to +Inf | 
| 51 | 42 | 100 |  |  |  | 792 | if ($_[0] =~ /\A$rgb_key\( *$rgb_rgb *\)\z/) { | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
|  |  | 100 |  |  |  |  |  | 
| 52 | 9 |  |  |  |  | 55 | return ( $1 / 255, $2 / 255, $3 / 255, 1.0 ); | 
| 53 |  |  |  |  |  |  | } | 
| 54 |  |  |  |  |  |  | elsif ($_[0] =~ /\A$rgb_key\( *$rgb_rgb_pc *\)\z/) { | 
| 55 | 12 |  |  |  |  | 69 | return ( $1 / 100, $2 / 100, $3 / 100, 1.0 ); | 
| 56 |  |  |  |  |  |  | } | 
| 57 |  |  |  |  |  |  | elsif ($_[0] =~ /\A$rgb_key\( *$rgb_rgb$rgb_alpha_sep$rgb_alpha *\)\z/) { | 
| 58 | 9 |  |  |  |  | 50 | return ( $1 / 255, $2 / 255, $3 / 255, _rgb_alpha($4) ); | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  | elsif ($_[0] =~ /\A$rgb_key\( *$rgb_rgb_pc$rgb_alpha_sep$rgb_alpha *\)\z/) { | 
| 61 | 10 |  |  |  |  | 53 | return ( $1 / 100, $2 / 100, $3 / 100, _rgb_alpha($4) ); | 
| 62 |  |  |  |  |  |  | } | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 2 |  |  |  |  | 6 | return (); | 
| 66 |  |  |  |  |  |  | } | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | sub new { | 
| 69 | 167 |  |  | 167 | 1 | 6402 | shift; # get rid of class name. | 
| 70 | 167 |  |  |  |  | 348 | my @arg = _pspec(@_); | 
| 71 | 167 | 100 |  |  |  | 13589 | return @arg ? new_internal($arg[0],$arg[1],$arg[2],$arg[3]) : (); | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | sub set { | 
| 75 | 2 |  |  | 2 | 1 | 10 | my $self = shift; | 
| 76 | 2 |  |  |  |  | 7 | my @arg = _pspec(@_); | 
| 77 | 2 | 100 |  |  |  | 16 | return @arg ? set_internal($self, $arg[0],$arg[1],$arg[2],$arg[3]) : (); | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 | 0 |  |  | 0 |  | 0 | sub CLONE_SKIP { 1 } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | sub as_8bit { | 
| 83 | 4 |  |  | 4 | 1 | 20 | my ($self) = @_; | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 4 |  |  |  |  | 5 | my @out; | 
| 86 | 4 |  |  |  |  | 16 | for my $s ($self->rgba) { | 
| 87 | 16 |  |  |  |  | 40 | my $result = 0+sprintf("%.f", $s * 255); | 
| 88 | 16 | 100 |  |  |  | 31 | $result = $result < 0 ? 0 : | 
|  |  | 100 |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | $result > 255 ? 255 : | 
| 90 |  |  |  |  |  |  | $result; | 
| 91 | 16 |  |  |  |  | 24 | push @out, $result; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 4 |  |  |  |  | 16 | return Imager::Color->new(@out); | 
| 95 |  |  |  |  |  |  | } | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  | sub as_css_rgb { | 
| 98 | 24 |  |  | 24 | 1 | 91 | my ($self) = @_; | 
| 99 |  |  |  |  |  |  |  | 
| 100 | 24 |  |  |  |  | 91 | my (@rgb) = $self->rgba; | 
| 101 | 24 |  |  |  |  | 36 | my $alpha = pop @rgb; | 
| 102 |  |  |  |  |  |  | # check if they're all representable as byte type samples | 
| 103 | 24 |  |  |  |  | 31 | my $can_byte = 1; | 
| 104 | 24 |  |  |  |  | 40 | for my $s (@rgb) { | 
| 105 | 46 | 100 |  |  |  | 178 | if (abs(sprintf("%.0f", $s * 255) - $s*255) > 0.0001) { | 
| 106 | 16 |  |  |  |  | 24 | $can_byte = 0; | 
| 107 | 16 |  |  |  |  | 30 | last; | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  | } | 
| 110 |  |  |  |  |  |  |  | 
| 111 | 24 | 100 |  |  |  | 54 | if ($alpha == 1.0) { | 
| 112 | 13 | 100 |  |  |  | 20 | if ($can_byte) { | 
| 113 | 4 |  |  |  |  | 10 | return sprintf("rgb(%.0f, %.0f, %.0f)", map { 255 * $_ } @rgb); | 
|  | 12 |  |  |  |  | 48 |  | 
| 114 |  |  |  |  |  |  | } | 
| 115 |  |  |  |  |  |  | else { | 
| 116 |  |  |  |  |  |  | # avoid outputting 2 decimals unless the precision is needed | 
| 117 | 9 |  |  |  |  | 17 | my ($rpc, $gpc, $bpc) = map { 0 + sprintf("%.2f", 100 * $_) } @rgb; | 
|  | 27 |  |  |  |  | 141 |  | 
| 118 | 9 |  |  |  |  | 81 | return "rgb($rpc% $gpc% $bpc%)"; | 
| 119 |  |  |  |  |  |  | } | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  | else { | 
| 122 | 11 |  |  |  |  | 63 | my $apf = 0+sprintf("%.4f", $alpha); | 
| 123 | 11 | 100 |  |  |  | 26 | if ($can_byte) { | 
| 124 | 4 |  |  |  |  | 9 | return sprintf("rgba(%.0f, %.0f, %.0f, %s)", ( map { 255 * $_ } @rgb ), $apf); | 
|  | 12 |  |  |  |  | 46 |  | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  | else { | 
| 127 |  |  |  |  |  |  | # avoid outputting 2 decimals unless the precision is needed | 
| 128 | 7 |  |  |  |  | 16 | my ($rpc, $gpc, $bpc) = map { 0 + sprintf("%.2f", 100 * $_) } @rgb; | 
|  | 21 |  |  |  |  | 81 |  | 
| 129 | 7 |  |  |  |  | 70 | return "rgba($rpc% $gpc% $bpc% / $apf)"; | 
| 130 |  |  |  |  |  |  | } | 
| 131 |  |  |  |  |  |  | } | 
| 132 |  |  |  |  |  |  | } | 
| 133 |  |  |  |  |  |  |  | 
| 134 |  |  |  |  |  |  | 1; | 
| 135 |  |  |  |  |  |  |  | 
| 136 |  |  |  |  |  |  | __END__ |