📄 color.pm
字号:
package PDF::API2::Color;
use vars qw( $VERSION );
( $VERSION ) = '$Revisioning: 20020418.102155 $ ' =~ /\$Revisioning:\s+([^\s]+)/;
use POSIX;
=pod
=head1 NAME
PDF::API2::Color - A OO-Color Module for PDFs.
=head1 DESCRIPTION
A module for manipulation Colors within RGB, HSV and HSL color-spaces for
usage within PDF-Documents especially with the Text::PDF::API modules.
=head1 SYNOPSIS
use PDF::API2::Color;
$cl = PDF::API2::Color->new;
$cl = PDF::API2::Color->newRGB($r,$g,$b);
$cl = PDF::API2::Color->newHSV($h,$s,$v);
$cl = PDF::API2::Color->newHSL($h,$s,$l);
$cl->setRGB($r,$g,$b);
$cl->addBrightness($br);
($h,$s,$l) = $cl->asHSL;
=head1 METHODS
=cut
sub mMin {
my $n=HUGE_VAL;
map { $n=($n>$_) ? $_ : $n } @_;
return($n);
}
sub mMax {
my $n=-(HUGE_VAL);
map { $n=($n<$_) ? $_ : $n } @_;
return($n);
}
sub RGBtoHSV ($$$) {
my ($r,$g,$b)=@_;
my ($h,$s,$v,$min,$max,$delta);
$min= mMin($r,$g,$b);
$max= mMax($r,$g,$b);
$v = $max;
$delta = $max - $min;
if( $delta > 0.000000001 ) {
$s = $delta / $max;
} else {
$s = 0;
$h = 0;
return($h,$s,$v);
}
if( $r == $max ) {
$h = ( $g - $b ) / $delta;
} elsif( $g == $max ) {
$h = 2 + ( $b - $r ) / $delta;
} else {
$h = 4 + ( $r - $g ) / $delta;
}
$h *= 60;
if( $h < 0 ) {$h += 360;}
return($h,$s,$v);
}
sub HSVtoRGB ($$$) {
my ($h,$s,$v)=@_;
my ($r,$g,$b,$i,$f,$p,$q,$t);
if( $s == 0 ) {
## achromatic (grey)
return ($v,$v,$v);
}
$h /= 60; ## sector 0 to 5
$i = POSIX::floor( $h );
$f = $h - $i; ## factorial part of h
$p = $v * ( 1 - $s );
$q = $v * ( 1 - $s * $f );
$t = $v * ( 1 - $s * ( 1 - $f ) );
if($i<1) {
$r = $v;
$g = $t;
$b = $p;
} elsif($i<2){
$r = $q;
$g = $v;
$b = $p;
} elsif($i<3){
$r = $p;
$g = $v;
$b = $t;
} elsif($i<4){
$r = $p;
$g = $q;
$b = $v;
} elsif($i<5){
$r = $t;
$g = $p;
$b = $v;
} else {
$r = $v;
$g = $p;
$b = $q;
}
return ($r,$g,$b);
}
sub RGBtoHSL ($$$) {
my ($r,$g,$b)=@_;
my ($h,$s,$v,$l,$min,$max,$delta);
$min= mMin($r,$g,$b);
$max= mMax($r,$g,$b);
($h,$s,$v)=RGBtoHSV($r,$g,$b);
$l=($max+$min)/2.0;
$delta = $max - $min;
if($delta<0.00000000001){
return(0,0,$l);
} else {
if($l<=0.5){
$s=$delta/($max+$min);
} else {
$s=$delta/(2-$max-$min);
}
}
return($h,$s,$l);
}
sub RGBquant ($$$) {
my($q1,$q2,$h)=@_;
while($h<0){$h+=360;}
$h%=360;
if ($h<60) {
return($q1+(($q2-$q1)*$h/60));
} elsif ($h<180) {
return($q2);
} elsif ($h<240) {
return($q1+(($q2-$q1)*(240-$h)/60));
} else {
return($q1);
}
}
sub HSLtoRGB ($$$) {
my($h,$l,$s,$r,$g,$b,$p1,$p2)=@_;
if($l<=0.5){
$p2=$l*(1+$s);
} else {
$p2=$l+$s-($l*$s);
}
$p1=2*$l-$p2;
if($s<0.0000000000001){
$r=$l; $g=$l; $b=$l;
} else {
$r=RGBquant($p1,$p2,$h+120);
$g=RGBquant($p1,$p2,$h);
$b=RGBquant($p1,$p2,$h-120);
}
return($r,$g,$b);
}
=item ::Color->new
=cut
sub new {
my $class=shift @_;
my $self={};
bless($self,$class);
return($self);
}
=item ::Color->newRGB $r, $g, $b
=cut
sub newRGB {
my $class=shift @_;
my ($r,$g,$b)=@_;
my $self=$class->new;
$self->setRGB($r,$g,$b);
return $self;
}
=item ::Color->newHSV $h, $s, $v
=cut
sub newHSV {
my $class=shift @_;
my ($h,$s,$v)=@_;
my $self=$class->new;
$self->setHSV($h,$s,$v);
return $self;
}
=item ::Color->newHSL $h, $s, $l
=cut
sub newHSL {
my $class=shift @_;
my ($h,$s,$l)=@_;
my $self=$class->new;
$self->setHSL($h,$s,$l);
return $self;
}
=item ::Color->newGrey $grey
=cut
sub newGrey {
my $class=shift @_;
my ($g)=@_;
my $self=$class->new;
$self->setGrey($g);
return $self;
}
=item ( $r, $g, $b ) = $cl->asRGB
Returns $cl's rgb values. Range [0 .. 1].
=cut
sub asRGB {
my $self=shift @_;
return @{$self->{'rgb'}};
}
=item ( $h, $s, $v ) = $cl->asHSV
Returns $cl's hsv values. Ranges h [0 .. 360], s/v [0 .. 1].
=cut
sub asHSV {
my $self=shift @_;
return @{$self->{'hsv'}};
}
=item ( $h, $s, $l ) = $cl->asHSL
Returns $cl's hsl values. Ranges h [0 .. 360], s/l [0 .. 1].
=cut
sub asHSL {
my $self=shift @_;
return @{$self->{'hsl'}};
}
=item $grey = $cl->asGrey
=item $grey = $cl->asGrey2
Returns $cl's grey value. Range [0 .. 1]. Functions 2 returns the geometric mean of the corresponding RGB values.
=cut
sub asGrey {
my $self=shift @_;
return $self->{'grey'};
}
sub asGrey2 {
my $self=shift @_;
my ($r,$g,$b)=@{$self->{'rgb'}};
return((($r**2+$g**2+$b**2)**0.5)/3);
}
=item ( $c, $m, $y )= $cl->asCMY
Returns $cl's cmy values. Range [0 .. 1].
=cut
sub asCMY {
my $self=shift @_;
return(map { 1-$_ } $self->asRGB);
}
=item ( $c, $m, $y, $k )= $cl->asCMYK
=item ( $c, $m, $y, $k )= $cl->asCMYK2
=item ( $c, $m, $y, $k )= $cl->asCMYK3
Returns $cl's cmyk values. Range [0 .. 1].
Function 2 returns a 25% lighter color-equivalent.
Function 3 returns a 25% lighter color-equivalent.
=cut
sub asCMYK {
my $self=shift @_;
my @cmy=(map { 1-$_ } $self->asRGB);
my $k=mMin(@cmy);
return((map { $_-$k } @cmy),$k);
}
sub asCMYK2 {
my $self=shift @_;
my @cmyk=$self->asCMYK;
$cmyk[3]*=0.75;
return(@cmyk);
}
sub asCMYK3 {
my $self=shift @_;
my @cmyk=$self->asCMY;
$cmyk[3]=0;
return(map { $_*0.75 } @cmyk);
return(@cmyk);
}
=item $hex = $cl->asHex
Returns $cl's rgb values as 6 hex-digits.
=cut
sub asHex {
my $self=shift @_;
return sprintf('%02X%02X%02X',map {$_*255} $self->asRGB);
}
=item $cl->setRGB $r, $g, $b
Sets the $cl's rgb values. Valid range [0 .. 1].
=cut
sub setRGB {
my $self=shift @_;
my ($r,$g,$b)=@_;
$self->{'rgb'}=[$r,$g,$b];
$self->{'hsv'}=[RGBtoHSV($r,$g,$b)];
$self->{'grey'}=(0.299*$r)+(0.587*$g)+(0.144*$b);
$self->{'hsl'}=[RGBtoHSL($r,$g,$b)];
}
=item $cl->setHSV $h, $s, $v
Sets the $cl's hsv values. Valid ranges: h [0..360], s/v [0..1].
=cut
sub setHSV {
my $self=shift @_;
my ($h,$s,$v)=@_;
$self->setRGB(HSVtoRGB($h,$s,$v));
}
=item $cl->setHSL $h, $s, $l
Sets the $cl's hsl values. Valid ranges: h [0..360], s/l [0..1].
=cut
sub setHSL {
my $self=shift @_;
my ($h,$s,$l)=@_;
$self->setRGB(HSLtoRGB($h,$s,$l));
}
=item $cl->setGrey $grey
Sets the $cl's grey value. Valid range [0 .. 1].
=cut
sub setGrey {
my $self=shift @_;
my ($g)=@_;
$self->setRGB($g,$g,$g);
}
=item $cl->setHex $hex
Sets the $cl's rgb values using 6 hex-nibbles.
=cut
sub setHex {
my $self=shift @_;
my ($hx)=@_;
my($r,$g,$b) = map { $_/255 } unpack('H3',$hx);
$self->setRGB($r,$g,$b);
}
=item $cl->addSaturation $saturation
Adds to the $cl's saturation in the HSV model. Valid range [-1 .. 1].
=cut
sub addSaturation {
my $this=shift @_;
my $sat=shift @_;
my ($h,$s,$v)=$this->asHSV;
$this->setHSV($h,$s+$sat,$v);
}
=item $cl->setSaturation $saturation
Sets the $cl's saturation in the HSV model. Valid range [0 .. 1].
=cut
sub setSaturation {
my $this=shift @_;
my $sat=shift @_;
my ($h,$s,$v)=$this->asHSV;
$this->setHSV($h,$sat,$v);
}
=item $cl->rotHue $degrees
Rotates the $cl's hue in the HSV/L model. Valid range [-360 .. 360].
=cut
sub rotHue {
my $this=shift @_;
my $rot=shift @_;
my ($h,$s,$v)=$this->asHSV;
$h+=$rot;
$h%=360;
$this->setHSV($h,$s,$v);
}
=item $cl->setHue $hue
Sets the $cl's hue in the HSV/L model. Valid range [0 .. 360].
=cut
sub setHue {
my $this=shift @_;
my $hue=shift @_;
my ($h,$s,$v)=$this->asHSV;
$this->setHSV($hue,$s,$v);
}
=item $cl->addBrightness $brightness
Adds to the $cl's brightness in the HSV model. Valid range [-1 .. 1].
=cut
sub addBrightness {
my $this=shift @_;
my $vol=shift @_;
my ($h,$s,$v)=$this->asHSV;
$this->setHSV($h,$s,$v+$vol);
}
=item $cl->setBrightness $brightness
Sets the $cl's brightness in the HSV model. Valid range [0 .. 1].
=cut
sub setBrightness {
my $this=shift @_;
my $v=shift @_;
my ($h,$s)=$this->asHSV;
$this->setHSV($h,$s,$v);
}
=item $cl->addLightness $lightness
Adds to the $cl's lightness in the HSL model. Valid range [-1 .. 1].
=cut
sub addLightness {
my $this=shift @_;
my $vol=shift @_;
my ($h,$s,$v)=$this->asHSL;
$this->setHSL($h,$s,$v+$vol);
}
=item $cl->setLightness $lightness
Sets the $cl's lightness in the HSL model. Valid range [0 .. 1].
=cut
sub setLightness {
my $this=shift @_;
my $l=shift @_;
my ($h,$s)=$this->asHSL;
$this->setHSL($h,$s,$l);
}
1;
__END__
=back
=head1 AUTHOR
Alfred Reibenschuh alfredreibenschuh@yahoo.com.
=head1 HISTORY
version 0.1_03 -- first public test release
=head1 BUGS
Some ... please report them.
=head1 TODO
more color spaces ?
=cut
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -