Initial commit of OpenSPARC T2 design and verification files.

[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / site_perl / 5.8.0 / Pastel / Color.pm

package Pastel::Color;\r
@ISA = qw (Pastel::Mixin::Mixin);\r
use Carp;\r
use strict;\r
\r
# Perl module for Pastel::Color\r
# Cared for by Malay<curiouser@ccmb.ap.nic.in>\r
# Copyright 2001, Malay Kumar Basu\r
# You may distribute this module under the same terms as perl itself\r
\r
=head1 NAME\r
\r
Pastel::Color\r
\r
The Pastel::Color class encapsulates colors in the default sRGB color space. At present\r
sRGB is the only Colorspace implemented.\r
\r
=head1 Description\r
\r
Every color has an implicit alpha value of 1.0 or an explicit one provided in the\r
constructor. The alpha value defines the transparency of a color and can be represented\r
by a float value in the range 0.0 - 1.0 . An alpha value of 1.0 \r
means that the color is completely opaque and an alpha value of 0 or 0.0 means that\r
the color is completely transparent.\r
\r
The default color space for the Pastel::Color API is sRGB (at present the only colorspace\r
implemented). For further information on sRGB, see\r
L<http://www.w3.org/pub/WWW/Graphics/Color/sRGB.html>.\r
\r
=head1 Synopsis\r
\r
  use Pastel::Graphics;\r
  use strict;\r
\r
  my $color  = Pastel::Color->new (10, 20, 30);\r
  my $color1 = Pastel::Color->new (-r=>10, -g=>20, -b=>30, -a=>0.5);\r
  my $color2 = Pastel::Color->new (10, 20, 30, 0.5); # $color now 50% transparent\r
\r
  my $graphics = Pastel::Graphics->new(-width=>800, -height=>600);\r
  $graphics->set_paint($color); # All the drawing from now on will be in $color\r
  ...\r
  ...\r
\r
=head1 CONSTRUCTOR\r
\r
=over 4\r
\r
=item Pastel::Color->new( $int, $int, $int);\r
\r
Creates an sRGB color with the specified red, green, blue in the range (0 - 255).\r
The tranparency is set to 1.0. Fully opaque.\r
\r
=item Pastel::Color->new( $int, $int, $int, $float_alpha)\r
\r
Creates an sRGB color with the specified red, green, blue in the range (0 - 255).\r
Alpha values in the range (0.0 - 1.0). \r
\r
=item Pastel::Color->new(-r=>$int, -g=>$int, -b=>$int, -a=>$float);\r
\r
With Perl style named parameters.\r
-r = Red, -g = Green , -b = Blue, -a = Alpha\r
\r
=back\r
\r
=head1 FIELDS\r
\r
=over 4\r
\r
=item _rgb_value\r
\r
Private.A value calculated from the Red, Green and the Blue integers supplied in the\r
constructors. Alpha value supplied is not stored in this value because of rounding\r
problems is Perl.\r
\r
=item _alpha\r
\r
Private. Stores the transparency float value.\r
\r
=back\r
\r
=cut\r
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
sub new {\r
    my $class = shift;\r
    my $self = {};\r
    bless $self, ref($class) || $class;\r
    $self->_init(@_);\r
    return $self;\r
}\r
\r
sub _init {\r
     my ($self, @args) = @_;\r
\r
     if ( (@args < 3) || (@args > 4) ){\r
       croak "Too many parameters\n";\r
       return 0;\r
     }\r
\r
     # Get the parameters in order by calling Pastel::Mixin::Mixin::_rearrange()\r
     my ($r, $g, $b, $a) = $self->_rearrange(["R", "G", "B", "A"], @args);\r
\r
     # Check for the correct range\r
\r
     if ( defined($r) ){\r
	 croak "Illegal value for red channel!!! I prefer B/W !!!\n"\r
	     if ( ($r < 0) || ($r >  255) );\r
     }\r
\r
     if ( defined($g) ){\r
	 croak "Illegal value for the green channel!!! Trying to be too young!\n"\r
	     if ( ($g< 0) || ($g > 255) );\r
\r
     }\r
\r
     if (defined($b)){\r
	 croak "Illegal value for the blue channel!!! \n"\r
	     if ( ($b< 0) || ($b > 255) );\r
     }\r
\r
     if (defined($a)){\r
	 if ( ($a < 0) ||($a > 1.0) ){\r
	   croak  "Illegal Alpha value in Color.pm";\r
	 }\r
	 else {\r
	     $self->{_alpha} = $a;\r
	 }\r
\r
     }\r
     else {\r
	 $self->{_alpha} = 1.0;\r
     }\r
\r
     $self->{_rgb_value} = ( ($r & 0xFF) << 16 ) |\r
                       ( ($g & 0xFF) << 8 ) |\r
		       ( ($b & 0xFF) << 0 );\r
     return $self;\r
} # Init\r
	 \r
###################################################################\r
\r
=head1 ACCESSORS\r
\r
=cut\r
\r
=head2 get_rgb()\r
\r
Returns RGB value of the color. Red channel by bits 16-23, Green by bits 8-15\r
and Blue by bits 0-7. Transparency value is not stored at bits 24-32, unlike the\r
Java implementation, to avoid rounding error problems in Perl. To get Transparency\r
(alpha) value use get_alpha() method.\r
\r
Usage: $color->get_rgb()\r
\r
=cut\r
\r
sub get_rgb { $_[0]->{_rgb_value}; }\r
\r
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
=head2 get_red()\r
\r
Return the Red chaneel value in integer in the range 0-255.\r
\r
Usage: $color->get_red()\r
\r
=cut\r
\r
sub get_red { ($_[0]->get_rgb() >> 16) & 0xFF ; }\r
\r
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
=head2 get_green()\r
\r
Return the Green chaneel value in integer in the range 0-255.\r
\r
Usage: $color->get_green()\r
\r
=cut\r
\r
sub get_green { ($_[0]->get_rgb() >> 8) & 0xFF ; }\r
\r
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
=head2 get_blue()\r
\r
Return the Blue chaneel value in integer in the range 0-255.\r
\r
Usage: $color->get_blue()\r
\r
=cut\r
\r
sub get_blue { ($_[0]->get_rgb() >> 0) & 0xFF ; }\r
\r
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\r
\r
=head2 get_alpha()\r
\r
Return the Alpha (transparency) value in the range 0.0 - 1.0.\r
\r
Usage: $color->get_alpha()\r
\r
=cut\r
\r
sub get_alpha {\r
    if ( ($_[0]->{_alpha} == 1) ||\r
	!(defined ($_[0]->{_alpha}))\r
       )\r
     {\r
	 return undef;\r
     }else {\r
	 return $_[0]->{_alpha};\r
	 }\r
    }\r
\r
###################################################################\r
\r
=head1 METHODS\r
\r
=head2 brighter()\r
\r
Return a brighter version of the present Color object.\r
\r
    Usage: my $brighter = $color->brighter();\r
\r
=cut\r
\r
sub brighter {\r
    my $self = shift;\r
    my $r = $self->get_red();\r
    my $g = $self->get_green();\r
    my $b = $self->get_blue();\r
\r
    my $factor = 0.7; \r
    my $check = int (1.0/ (1.0 - $factor) );\r
\r
    if ( ($r == 0) && ($g == 0) && ($b == 0) ){\r
	return $self->new($check, $check, $check);\r
    }\r
\r
    if ( ($r > 0) && ($r < $check) ){ $r = $check; }\r
    if ( ($g > 0) && ($g < $check) ){ $g = $check; }\r
    if ( ($b > 0) && ($b < $check) ){ $b = $check; }\r
\r
    # Function _min is defined in Pastel::Mixin::Mixin.pm\r
    # It returns the lower of the two value passed \r
\r
    my $newr = $self->_min( int(($r/$factor)), 255);\r
    my $newg = $self->_min( int(($g/$factor)), 255);\r
    my $newb = $self->_min( int(($b/$factor)), 255);\r
\r
    return $self->new( $newr, $newg, $newb );\r
}\r
\r
\r
=head2 darker()\r
\r
Return a darker version of the present color object.\r
\r
 Usage: my $darker_color = $color->darker();\r
\r
=cut\r
\r
sub darker {\r
    my $self = shift;\r
    my $r = $self->get_red();\r
    my $g = $self->get_green();\r
    my $b = $self->get_blue();\r
\r
    my $factor = 0.7;\r
    my $newr = $self->_max( int( $r * $factor), 0 );\r
    my $newg = $self->_max( int( $g * $factor), 0 );\r
    my $newb = $self->_max( int( $b * $factor), 0 );\r
\r
    return $self->new( $newr, $newg, $newb);\r
}\r
\r
\r
=head2 black()\r
\r
Return a color object "black".\r
\r
 Usage: my $graphics->set_paint( Pastel::Color->black() );\r
\r
=cut\r
  \r
sub black {\r
\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(0, 0, 0);\r
    return $self;\r
\r
}    \r
\r
=head2 blue()\r
\r
Return a color object "blue"\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->blue());\r
\r
=cut\r
\r
sub blue {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(0, 0, 255);\r
    return $self;\r
\r
}\r
\r
=head2 red()\r
\r
Returns a color object "red".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->red());\r
\r
=cut\r
\r
sub red {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 0, 0);\r
    return $self;\r
\r
}\r
\r
=head2 white()\r
\r
Returns a color object "white".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->white());\r
\r
=cut\r
\r
sub white {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 255, 255);\r
    return $self;\r
\r
}\r
\r
=head2 light_gray()\r
\r
Returns a color object "light_gray".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->light_gray());\r
\r
=cut\r
\r
sub light_gray {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(192, 192, 192);\r
    return $self;\r
\r
}\r
\r
=head2 gray()\r
\r
Returns a color object "gray".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->gray());\r
\r
=cut\r
\r
sub gray {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(128, 128, 128);\r
    return $self;\r
\r
}\r
\r
=head2 dark_gray()\r
\r
Returns a color object "dark_gray".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->dark_gray());\r
\r
=cut\r
\r
sub dark_gray {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(64, 64, 64);\r
    return $self;\r
\r
}\r
\r
\r
=head2 pink()\r
\r
Returns a color object "pink".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->pink());\r
\r
=cut\r
\r
sub pink {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 175, 175);\r
    return $self;\r
\r
}\r
\r
=head2 orange()\r
\r
Returns a color object "red".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->orange());\r
\r
=cut\r
\r
sub orange {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 200, 0);\r
    return $self;\r
\r
}\r
\r
=head2 yellow()\r
\r
Returns a color object "yellow".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->yellow());\r
\r
=cut\r
\r
sub yellow {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 255, 0);\r
    return $self;\r
\r
}\r
\r
=head2 green()\r
\r
Returns a color object "green".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->green());\r
\r
=cut\r
\r
sub green {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(0, 255, 0);\r
    return $self;\r
\r
}\r
\r
=head2 magenta()\r
\r
Returns a color object "magenta".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->magenta());\r
\r
=cut\r
\r
sub magenta {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(255, 0, 255);\r
    return $self;\r
\r
}\r
\r
=head2 cyan()\r
\r
Returns a color object "cyan".\r
\r
 Usage: my $graphics->set_paint ( Pastel::Color->cyan());\r
\r
=cut\r
\r
sub cyan {\r
    my $class = ref( $_[0]) || $_[0];\r
    my $self = {};\r
    bless $self, $class;\r
    $self->_init(0, 255, 255);\r
    return $self;\r
\r
}\r
\r
=head2 equals(Color $color)\r
\r
Returns true if $color is equivalent to the present color. This method\r
compares the "red", "green", "blue" and the "alpha" value of the two colors\r
and return 1 if both are same or returns 0 if they are diffrent.\r
\r
 Usage: my $color1 = Pastel::Color->new(255, 255, 255);\r
        my $white = Pastel::Color->white();\r
        print "They are same" if $color1->equals($white);\r
\r
=cut\r
\r
sub equals {\r
    my $self = shift;\r
    my $color = shift;\r
\r
    if ( ($self->get_rgb() == $color->get_rgb()     ) &&\r
	 ($self->get_alpha() == $color->get_alpha() )\r
	) {\r
	      return 1;\r
	  }\r
\r
    else {\r
	return 0;\r
    }\r
}\r
\r
\r
=head2 to_string()\r
\r
Returns the string representation of the object.\r
\r
 Usage: $color->to_string();\r
\r
=cut\r
\r
sub to_string {\r
    my $self =shift;\r
    return ref($self)."[r=".$self->get_red().",g=".$self->get_green().",b=".$self->get_blue()."]";\r
}\r
\r
=head1 PRIVATE METHODS\r
\r
=head2 to_svg()\r
\r
Return the string Pastel coded form of this object. Called by any object with\r
style color.\r
\r
=cut\r
\r
sub to_svg {\r
  my $self =shift;\r
  $self->to_svg_stroke();\r
}\r
   \r
sub to_hex {\r
    my $self = shift;\r
     my $red = unpack ("H2", pack("I",$self->get_red()));\r
    my $green = unpack ("H2", pack("I",$self->get_green()));\r
    my $blue = unpack ("H2", pack("I",$self->get_blue()));\r
return "\#".$red.$green.$blue;\r
}\r
\r
sub to_svg_fill {\r
   my $self = shift;\r
   my $red = unpack ("H2", pack("I",$self->get_red()));\r
   my $green = unpack ("H2", pack("I",$self->get_green()));\r
   my $blue = unpack ("H2", pack("I",$self->get_blue()));\r
   my $s = "fill:\#".$red.$green.$blue;\r
   if ($self->get_alpha()){\r
   $s .= ';'. "fill-opacity:". $self->get_alpha();\r
}\r
return $s;\r
}\r
\r
sub to_svg_stroke {\r
 my $self = shift;\r
    my $red = unpack ("H2", pack("I",$self->get_red()));\r
    my $green = unpack ("H2", pack("I",$self->get_green()));\r
    my $blue = unpack ("H2", pack("I",$self->get_blue()));\r
    my $s = "stroke:\#".$red.$green.$blue;\r
if ($self->get_alpha()){\r
   $s .= ';'. "stroke-opacity:".$self->get_alpha();\r
}else {\r
    $s .= ';';\r
    }\r
return $s;\r
}\r
\r
\r
1;\r