view release on metacpan or  search on metacpan

lib/Math/Zap/Color.pm  view on Meta::CPAN

  if (ref($C))
   {if (ref($C) eq 'ARRAY')
     {@rgb = @$C;
     }
    else
     {die "Unknown color format $C";
     }
   } 
  else
   {my $c =  lc($C);    # lowercase
       $c =~ s/\s+//g;  # remove spaces
       $c =~ s/^-//g;   # remove leading '-' as alternative to quotes
       $c =~ s/^#//g;   # remove leading '#'

    if ($color->{$c})
     {@rgb = ($color->{$c}[0], $color->{$c}[1], $color->{$c}[2]);
     }
    elsif ($c =~ /^([[:xdigit:]][[:xdigit:]])([[:xdigit:]][[:xdigit:]])([[:xdigit:]][[:xdigit:]])/)
     {@rgb = (hex($1), hex($2), hex($3));
     }
    elsif ($c =~ /^(\d+),(\d+),(\d+)$/)
     {@rgb = ($1, $2, $3);
     }
    else
     {croak "Unknown color format $C";
     }
   }
  bless \@rgb;
 }


=head2 Methods


=head3 check

Check that an anonymous reference is a reference to a color and confess
if it is not.

=cut


sub check(@)
 {if (debug)
   {for my $t(@_)
     {confess "$t is not a color" unless ref($t) eq __PACKAGE__;
     }
   } 
  return (@_)
 }


=head3 is

Same as L</check> but return the result to the caller.   

=cut


sub is(@)
 {for my $t(@_)
   {return 0 unless ref($t) eq __PACKAGE__;
   }
  'color';
 }


=head3 normal

Normal value of the color

=cut


sub normal($)
 {my $c = shift;
     $c = color($c) unless ref($c) eq __PACKAGE__;
  sprintf("#%02x%02x%02x", $c->[0], $c->[1], $c->[2]);
 }


=head3 light

Lighter shade of the color

=cut


sub light($)
 {my $c = shift;
     $c = color($c) unless ref($c) eq __PACKAGE__;
  sprintf("#%02x%02x%02x", 128+int($c->[0]/2), 128+int($c->[1]/2), 128+int($c->[2]/2));
 }


=head3 dark

Darker shade of the color

=cut


sub dark($)
 {my $c = shift;
     $c = color($c) unless ref($c) eq __PACKAGE__;
  sprintf("#%02x%02x%02x", int($c->[0]/2), int($c->[1]/2), int($c->[2]/2));
 }


=head3 invert

Inversion of the color

=cut


sub invert($)
 {my $c = shift;
     $c = color($c) unless ref($c) eq __PACKAGE__;
  sprintf("#%02x%02x%02x", 255-$c->[0], 255-$c->[1], 255-$c->[2]);