r49780 - in /branches/upstream/libcolor-calc-perl/current: ./ lib/Color/ lib/Color/Calc/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Fri Jan 1 20:25:36 UTC 2010
Author: jawnsy-guest
Date: Fri Jan 1 20:25:31 2010
New Revision: 49780
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=49780
Log:
[svn-upgrade] Integrating new upstream version, libcolor-calc-perl (1.060)
Removed:
branches/upstream/libcolor-calc-perl/current/TODO
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/hex.pm
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/html.pm
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/object.pm
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/pdf.pm
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/tuple.pm
branches/upstream/libcolor-calc-perl/current/t/DEPRECATED_import_hex.t
branches/upstream/libcolor-calc-perl/current/t/DEPRECATED_import_html.t
branches/upstream/libcolor-calc-perl/current/t/DEPRECATED_import_object.t
branches/upstream/libcolor-calc-perl/current/t/DEPRECATED_import_tuple.t
branches/upstream/libcolor-calc-perl/current/t/DEPRECATED_non-import.t
Modified:
branches/upstream/libcolor-calc-perl/current/Build.PL
branches/upstream/libcolor-calc-perl/current/Changes
branches/upstream/libcolor-calc-perl/current/LICENSE
branches/upstream/libcolor-calc-perl/current/MANIFEST
branches/upstream/libcolor-calc-perl/current/META.yml
branches/upstream/libcolor-calc-perl/current/Makefile.PL
branches/upstream/libcolor-calc-perl/current/README
branches/upstream/libcolor-calc-perl/current/SIGNATURE
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc.pm
branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/WWW.pm
Modified: branches/upstream/libcolor-calc-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/Build.PL?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/Build.PL (original)
+++ branches/upstream/libcolor-calc-perl/current/Build.PL Fri Jan 1 20:25:31 2010
@@ -2,26 +2,45 @@
use 5.006;
use strict;
+use utf8;
use Module::Build;
my $b = Module::Build->new(
'module_name' => 'Color::Calc',
'license' => 'perl',
+ 'dist_author' => 'Claus Färber <CFAERBER at cpan.org>',
'sign' => 1,
'create_license' => 1,
'create_makefile_pl' => 'traditional',
'requires' => {
- 'Graphics::ColorNames' => 0.32,
+ 'Graphics::ColorNames' => 2.10,
'Graphics::ColorNames::WWW' => 0.01,
+ 'Graphics::ColorNames::HTML'=> 0,
'Params::Validate' => 0.75,
},
'build_requires' => {
'Test::More' => 0,
'Test::NoWarnings' => 0,
},
+
+ auto_features => {
+ 'color_object_support' => {
+ 'description' => 'support for Color::Object (obsolete)',
+ 'requires' => {
+ 'Color::Object' => 1,
+ }
+ },
+ 'graphics_colorobject_support' => {
+ 'description' => 'support for Graphics::ColorObject',
+ 'requires' => {
+ 'Graphics::ColorObject' => 0.005,
+ }
+ },
+ },
+
'no_index' => {
'directory' => 'eg'
},
@@ -29,6 +48,7 @@
'homepage' => 'http://search.cpan.org/dist/Color-Calc',
'repository' => 'http://github.com/cfaerber/Color-Calc',
},
+
);
$b->create_build_script;
Modified: branches/upstream/libcolor-calc-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/Changes?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/Changes (original)
+++ branches/upstream/libcolor-calc-perl/current/Changes Fri Jan 1 20:25:31 2010
@@ -1,9 +1,20 @@
Revision history for Perl extension Color::Calc.
+
+1.060 (2010-01-01)
+ - release 1.059_20091227
+
+1.059_20091227
+ - new calc functions: opposite, round, safe
+
+1.059_20091226
+ - use Scalar::Util, List::Util
+ - some clean-ups and refactorisations
+ - remove obsolete modules
1.052 Mon Dec 14 00:00:00 2009
- switch to Module::Build
- - FIXES: #52744: Undeclared dependency on Test::NoWarnings (reported by
- ANDK)
+ - FIXES: #52744: Undeclared dependency on Test::NoWarnings
+ (reported by ANDK)
- better documentation
1.051 Fri Dec 11 00:00:00 2009
Modified: branches/upstream/libcolor-calc-perl/current/LICENSE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/LICENSE?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/LICENSE (original)
+++ branches/upstream/libcolor-calc-perl/current/LICENSE Fri Jan 1 20:25:31 2010
@@ -1,4 +1,4 @@
-This software is copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
+This software is copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
+This software is Copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
This is free software, licensed under:
@@ -270,7 +270,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
+This software is Copyright (c) 2009 by Claus Färber <CFAERBER at cpan.org>.
This is free software, licensed under:
Modified: branches/upstream/libcolor-calc-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/MANIFEST?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/MANIFEST (original)
+++ branches/upstream/libcolor-calc-perl/current/MANIFEST Fri Jan 1 20:25:31 2010
@@ -1,10 +1,5 @@
Changes
lib/Color/Calc.pm
-lib/Color/Calc/hex.pm
-lib/Color/Calc/html.pm
-lib/Color/Calc/object.pm
-lib/Color/Calc/pdf.pm
-lib/Color/Calc/tuple.pm
lib/Color/Calc/WWW.pm
Build.PL
Makefile.PL
@@ -13,13 +8,8 @@
t/00basic.t
t/10pod.t
t/11pod_cover.t
-t/DEPRECATED_import_hex.t
-t/DEPRECATED_import_html.t
t/DEPRECATED_import_MODEval.t
-t/DEPRECATED_import_object.t
t/DEPRECATED_import_suffix.t
-t/DEPRECATED_import_tuple.t
-t/DEPRECATED_non-import.t
t/DEPRECATED_non-import_MODEval.t
t/DEPRECATED_non-import_suffix.t
t/import_hex.t
@@ -34,7 +24,6 @@
t/schemes_import_HTML.t
t/schemes_import_X.t
t/schemes_oo.t
-TODO
META.yml
LICENSE
SIGNATURE Added here by Module::Build
Modified: branches/upstream/libcolor-calc-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/META.yml?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/META.yml (original)
+++ branches/upstream/libcolor-calc-perl/current/META.yml Fri Jan 1 20:25:31 2010
@@ -1,8 +1,8 @@
---
name: Color-Calc
-version: 1.052
+version: 1.060
author:
- - 'Claus Färber <CFAERBER at cpan.org>'
+ - 'Claus Färber <CFAERBER at cpan.org>'
abstract: Simple calculations with RGB colors.
license: perl
resources:
@@ -11,7 +11,8 @@
Test::More: 0
Test::NoWarnings: 0
requires:
- Graphics::ColorNames: 0.32
+ Graphics::ColorNames: 2.1
+ Graphics::ColorNames::HTML: 0
Graphics::ColorNames::WWW: 0.01
Params::Validate: 0.75
configure_requires:
@@ -19,25 +20,10 @@
provides:
Color::Calc:
file: lib/Color/Calc.pm
- version: 1.052
+ version: 1.060
Color::Calc::WWW:
file: lib/Color/Calc/WWW.pm
- version: 1.052
- Color::Calc::hex:
- file: lib/Color/Calc/hex.pm
- version: 1.052
- Color::Calc::html:
- file: lib/Color/Calc/html.pm
- version: 1.052
- Color::Calc::object:
- file: lib/Color/Calc/object.pm
- version: 1.052
- Color::Calc::pdf:
- file: lib/Color/Calc/pdf.pm
- version: 1.052
- Color::Calc::tuple:
- file: lib/Color/Calc/tuple.pm
- version: 1.052
+ version: 1.060
no_index:
directory: eg
generated_by: Module::Build version 0.35
Modified: branches/upstream/libcolor-calc-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/Makefile.PL?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/Makefile.PL (original)
+++ branches/upstream/libcolor-calc-perl/current/Makefile.PL Fri Jan 1 20:25:31 2010
@@ -10,9 +10,10 @@
'PREREQ_PM' => {
'Test::More' => 0,
'Params::Validate' => '0.75',
+ 'Graphics::ColorNames::HTML' => 0,
'Graphics::ColorNames::WWW' => '0.01',
'Test::NoWarnings' => 0,
- 'Graphics::ColorNames' => '0.32'
+ 'Graphics::ColorNames' => '2.1'
}
)
;
Modified: branches/upstream/libcolor-calc-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/README?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/README (original)
+++ branches/upstream/libcolor-calc-perl/current/README Fri Jan 1 20:25:31 2010
@@ -12,10 +12,10 @@
To install this module type the following:
- perl Makefile.PL
- make
- make test
- make install
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
DEPENDENCIES
@@ -25,12 +25,11 @@
The following modules are optional:
- Color::Object
Graphics::ColorObject
COPYRIGHT AND LICENCE
-Copyright © 2004-2008 Claus Färber
+Copyright © 2004-2010 Claus Färber
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
Modified: branches/upstream/libcolor-calc-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/SIGNATURE?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/SIGNATURE (original)
+++ branches/upstream/libcolor-calc-perl/current/SIGNATURE Fri Jan 1 20:25:31 2010
@@ -14,31 +14,20 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 4eeac526032d738d6b0da2703241ea112e6ae6dc Build.PL
-SHA1 5446171442391ea8e5971508cec41ed3d1dc8eb6 Changes
-SHA1 74fd30b81efd53fa6a95170d825b8760a1520863 LICENSE
-SHA1 6fbbab25670900234ce9878bb2d9427fee4ee4ec MANIFEST
-SHA1 2a3c7c86ab8d04f35372b0f78dba2b01822c3aaa META.yml
-SHA1 2e435f4cae2d2797e150b685e85dd6e7d741adb6 Makefile.PL
-SHA1 01432f0b9ea99f4dbc3fb5324e0cc0b32a869f80 README
-SHA1 2ee5434fbedc975253ae505251fad76b8f86af5c TODO
-SHA1 460d5f89d0d4c9a90c7b5331c81ded3e0f02dc61 lib/Color/Calc.pm
-SHA1 2ce36c1ffceb04299c8e46712be1ee51cc7bec75 lib/Color/Calc/WWW.pm
-SHA1 91e3cd1c43d6ce1e9fe7a18565f740a190da9d82 lib/Color/Calc/hex.pm
-SHA1 d47169975591c4e579b317b7610673b5841e8dfe lib/Color/Calc/html.pm
-SHA1 9fc2227b747a3330fd6b4b77d5390fe65666307b lib/Color/Calc/object.pm
-SHA1 5419a16bed2eda5dc6169d7c24c1e7a7141977c5 lib/Color/Calc/pdf.pm
-SHA1 3450414550d8c7d78509a5d32290bab01881f3e3 lib/Color/Calc/tuple.pm
+SHA1 248ceaf62d4049c2d62de7f6e0d3933cd209c59e Build.PL
+SHA1 e63f4c74bf5ac8136f108bb406c56959fcb36355 Changes
+SHA1 5e8892b211d2e08c1b98d3a033b4d8439158339e LICENSE
+SHA1 f51962c7a43c271f18fb8de867b11f6a2ed9bfb8 MANIFEST
+SHA1 04309d43ef362092ebe75c2d346bed8235108d00 META.yml
+SHA1 167c32f192b2e25bcb5e737578f0faf0412716e7 Makefile.PL
+SHA1 5ed9e2aadb613986d5ac3a78aaad9c75ffbed777 README
+SHA1 6993a9eb4277359cae55f3262c79b640cd37a90f lib/Color/Calc.pm
+SHA1 604be3c31f371b6100c88640bd8b880f07a655eb lib/Color/Calc/WWW.pm
SHA1 dd5e2852432a4d8a54d31a74f4f003f88b405473 t/00basic.t
SHA1 056063d18c3f48338620bbff698f81f91f2ea4d0 t/10pod.t
SHA1 e2b1f468d6ea1199f0d68655d25532095435aac8 t/11pod_cover.t
SHA1 54e4cc9aa1b95c1207a0b7fe505a7fc3096ef5b4 t/DEPRECATED_import_MODEval.t
-SHA1 8383f21c3a945b30e4be722f6b2b46a64a8cdfbe t/DEPRECATED_import_hex.t
-SHA1 d585280d0c1c6175af5073fde3297b663570cdb5 t/DEPRECATED_import_html.t
-SHA1 48c29297226fcbeddf9037cee8fb16a42ec0bc4d t/DEPRECATED_import_object.t
SHA1 06bf92fe8ca89d99d76b1c19e698ffff50e1a3f9 t/DEPRECATED_import_suffix.t
-SHA1 329d41defa3b886a6fd9113dccb5a25e7f736191 t/DEPRECATED_import_tuple.t
-SHA1 210a70371bb396ac754461832465aa4cb0d0d8f8 t/DEPRECATED_non-import.t
SHA1 35bac9ad47423d312eb8ad4afd549d43af2e0487 t/DEPRECATED_non-import_MODEval.t
SHA1 a3986b8e72a3085f8eae6c7c68ff114fa59f0ad5 t/DEPRECATED_non-import_suffix.t
SHA1 193eb24082f96dbdf2583e7befd20431d857484d t/import_MODEval.t
@@ -56,7 +45,7 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.10 (Darwin)
-iEYEARECAAYFAksmelsACgkQSKUOY2OWgPD3zgCgpJ/sErFx015lQVcZyl3PY9XB
-AZoAnigeNqSaxvhi1d21jStCdEVOItfX
-=iM03
+iEYEARECAAYFAks35DgACgkQSKUOY2OWgPCSewCeLSydHILB1pWOme1wYc+MSenu
+D98AnRMAYlZ3laa5q6yOZyWd/HUQS96J
+=YzZp
-----END PGP SIGNATURE-----
Modified: branches/upstream/libcolor-calc-perl/current/lib/Color/Calc.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/lib/Color/Calc.pm?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/lib/Color/Calc.pm (original)
+++ branches/upstream/libcolor-calc-perl/current/lib/Color/Calc.pm Fri Jan 1 20:25:31 2010
@@ -1,5 +1,6 @@
package Color::Calc;
+use attributes;
use strict;
use utf8;
use warnings;
@@ -9,25 +10,43 @@
use Params::Validate qw(:all);
use POSIX;
+use Scalar::Util qw(dualvar);
+use List::Util qw(min max reduce sum);
+
use Graphics::ColorNames qw( hex2tuple tuple2hex );
-use Graphics::ColorNames::HTML;
-
-our $VERSION = '1.052';
+use Graphics::ColorNames::HTML qw();
+
+our $VERSION = "1.060";
$VERSION = eval $VERSION;
our $MODE = ();
my %__HTMLColors = ();
-our @__subs = qw( blend blend_bw bw contrast contrast_bw dark get grey gray invert light mix );
+our @__subs = qw(
+ blend blend_bw
+ bw
+ contrast contrast_bw
+ dark
+ get
+ gray
+ grey
+ invert
+ light
+ mix
+ opposite
+ round
+ safe
+);
my %__formats = (
- 'tuple' => sub { return __normtuple_out(@_); },
- 'hex' => sub { return tuple2hex((@_)); },
- 'html' => sub { my $col = lc(tuple2hex((@_))); return $__HTMLColors{$col} || '#'.$col; },
- 'object' => sub { eval { require Graphics::ColorObject; }; return Graphics::ColorObject->new_RGB255( [(@_)] ); },
+ 'tuple' => sub { map { my $a = int($_); length($a) % 3 ? $a : dualvar($a, "0$a") } @_ },
+ 'hex' => sub { dualvar((reduce { ($a << 8) | ($b & 0xFF) } @_), tuple2hex(@_)) },
+ 'html' => sub { my $col = lc(tuple2hex(@_)); $__HTMLColors{$col} || '#'.$col; },
+ 'object' => sub { eval { require Graphics::ColorObject; }; return Graphics::ColorObject->new_RGB255( \@_ ); },
'obj' => sub { eval { require Color::Object; }; return Color::Object->newRGB(map { 255*$_; } @_); },
- 'pdf' => sub { return '#'.(tuple2hex(@_)) },
);
+
+$__formats{'pdf'} = $__formats{'html'};
my @__formats = keys %__formats;
my $__formats_re = join('|', @__formats,'__MODEvar');
@@ -69,10 +88,10 @@
return $__default_object;
}
-my $__tuple_object = undef;
-sub __get_tuple {
- $__tuple_object = __PACKAGE__->new('OutputFormat' => 'tuple') unless $__tuple_object;
- return $__tuple_object;
+my $__raw_object = undef;
+sub __get_raw {
+ $__raw_object = __PACKAGE__->new('OutputFormat' => 'tuple') unless $__raw_object;
+ return $__raw_object;
}
my %import_param = (
@@ -126,17 +145,14 @@
return 1;
}
+sub __dualvar_tuple {
+ my $str = shift;
+ my $num = reduce { ($a << 8) | ($b & 0xFF) } @_;
+ return dualvar $num, $str;
+}
sub __normtuple_in {
return map { ($_ < 0) ? 0 : (($_ > 255) ? 255 : int($_+.5)) } @_;
-}
-
-sub __normtuple_out {
- return map { (length $_) == 3 ? '0'.$_ : $_ } __normtuple_in(@_)
-}
-
-sub __normtuple {
- return __normtuple_out(__normtuple_in(@_));
}
sub __is_col_val {
@@ -223,85 +239,6 @@
}
}
-sub get {
- my $self = __get_self(\@_);
- return $self->__put($self->__get(\@_));
-}
-
-sub invert {
- my $self = __get_self(\@_);
- return $self->__put(map { 255 - $_ } $self->__get(\@_));
-}
-
-sub bw {
- my $self = __get_self(\@_);
- my @c = $self->__get(\@_);
- my $g = $c[0]*.3 + $c[1]*.59 + $c[2]*.11;
- return $self->__put(__normtuple($g,$g,$g));
-}
-
-*grey = \&bw;
-*gray = \&bw;
-
-sub mix {
- my $self = __get_self(\@_);
- my @c1 = ($self->__get(\@_,1));
- my @c2 = ($self->__get(\@_));
- my $alpha = shift(@_); $alpha = 0.5 unless defined $alpha;
-
- return $self->__put(__normtuple(
- ($c1[0] + ($c2[0]-$c1[0])*$alpha),
- ($c1[1] + ($c2[1]-$c1[1])*$alpha),
- ($c1[2] + ($c2[2]-$c1[2])*$alpha) ));
-}
-
-sub light {
- my $self = __get_self(\@_);
- return $self->__put(__get_tuple->mix([$self->__get(\@_)],[255,255,255],shift));
-}
-
-sub dark {
- my $self = __get_self(\@_);
- return $self->__put(__get_tuple->mix([$self->__get(\@_)],[0,0,0],shift));
-}
-
-sub contrast {
- my $self = __get_self(\@_);
- my @rgb = $self->__get(\@_);
- my $cut = (shift || .5) * 255;
- return $self->__put(map { $_ >= $cut ? 0 : '0255' } @rgb);
-}
-
-sub contrast_bw {
- my $self = __get_self(\@_);
- my @rgb = $self->__get(\@_);
- return $self->__put(__get_tuple->contrast([__get_tuple->bw(@rgb)], shift));
-}
-
-sub blend {
- my $self = __get_self(\@_);
- my @c1 = $self->__get(\@_);
- return $self->mix(\@c1,[__get_tuple->contrast(\@c1)],shift);
-}
-
-sub blend_bw {
- my $self = __get_self(\@_);
- my @c = $self->__get(\@_);
- return $self->mix(\@c,[__get_tuple->contrast_bw(\@c)],shift);
-}
-
-foreach my $format (@__formats) {
- __import(__PACKAGE__, 'Prefix' => 'color', '__Suffix' => "_$format", 'OutputFormat' => $format);
- __import(__PACKAGE__, 'Prefix' => '', '__Suffix' => "_$format", 'OutputFormat' => $format);
-}
-
-__import(__PACKAGE__, 'Prefix' => 'color', 'OutputFormat' => '__MODEvar');
-
-1;
-__END__
-
-=encoding utf8
-
=head1 NAME
Color::Calc - Simple calculations with RGB colors.
@@ -326,7 +263,7 @@
=over
-=item Color::Calc->new( ⦠)
+=item Color::Calc->new( ... )
This class method creates a new C<Color::Calc> object.
@@ -362,7 +299,8 @@
=item hex
-Returns a hexadecimal RGB value as a string in the format RRGGBB.
+Returns a hexadecimal RGB value as a scalar that contains a string in the
+format RRGGBB and a number representing the hexadecimal number 0xRRGGBB.
=item html
@@ -371,8 +309,8 @@
=item obj
-Returns a C<Color::Object> reference. The module
-C<Color::Object> must be installed, of course.
+(DEPRECATED) Returns a C<Color::Object> reference. The module C<Color::Object>
+must be installed, of course.
=item object
@@ -397,7 +335,7 @@
=back
-=item Color::Calc->import( ⦠)
+=item Color::Calc->import( ... )
This method creates a new, hidden object and binds its methods to the namespace
of the calling module.
@@ -501,10 +439,43 @@
Returns C<$color> as-is (but in the selected output format). This
function can be used for color format conversion/normalisation.
+=cut
+
+sub get {
+ my $self = __get_self(\@_);
+ return $self->__put($self->__get(\@_));
+}
+
=item $cc->invert($color) / color_invert($color)
Returns the inverse of C<$color>.
+=cut
+
+sub invert {
+ my $self = __get_self(\@_);
+ return $self->__put(map { 255 - $_ } $self->__get(\@_));
+}
+
+=item $cc->opposite($color) / color_opposite($color)
+
+Returns a color that is on the opposite side of the color wheel but roughly
+keeps the saturation and lightness.
+
+=cut
+
+sub opposite {
+ my $self = __get_self(\@_);
+ my @rgb = $self->__get(\@_);
+
+ my $min = min @rgb;
+ my $max = max @rgb;
+
+ return $self->__put(
+ map { $max - $_ + $min } @rgb
+ );
+}
+
=item $cc->bw($color) / color_bw($color)
=item $cc->grey($color) / color_grey($color)
@@ -512,6 +483,74 @@
=item $cc->gray($color) / color_gray($color)
Converts C<$color> to greyscale.
+
+=cut
+
+sub bw {
+ my $self = __get_self(\@_);
+ my @c = $self->__get(\@_);
+ my $g = $c[0]*.3 + $c[1]*.59 + $c[2]*.11;
+ return $self->__put($g, $g, $g);
+}
+
+*grey = \&bw;
+*gray = \&bw;
+
+=item $cc->round($color, $value_count) / color_round($color, $value_count)
+
+Rounds each component to to the nearest number determined by dividing the range
+0..255 into C<$value_count>+1 portions.
+
+The default for C<$value_count> is 6, yielding S<6^3 = 216> colors. Values
+that are one higher than divisors of 255 yield the best results (e.g. 3+1, 5+1,
+7+1, 9+1, 15+1, 17+1, ...).
+
+=cut
+
+sub round {
+ my $self = __get_self(\@_);
+ my @rgb = $self->__get(\@_);
+ my $steps = shift || 6;
+ $steps--;
+
+ return $self->__put(
+ map { int(int( $_ * $steps / 255 + 0.5) * 255 / $steps + 0.5) } @rgb
+ );
+}
+
+=item $cc->safe($color) / color_safe($color)
+
+Rounds each color component to a multiple of 0x33 (dec. 51) or to a named color
+defined in the HTML 4.01 specification.
+
+Historically, these colors have been known as web-safe colors. They still
+provide a convenient color palette.
+
+=cut
+
+sub __dist2 {
+ my @a = splice @_, 0, 3;
+ return sum map { POSIX::pow($_ - shift @a, 2) } @_;
+}
+
+sub safe {
+ my $self = __get_self(\@_);
+ my @rgb = $self->__get(\@_);
+
+ my @new_rgb = __get_raw->round(@rgb);
+ my $new_d2 = __dist2(@rgb, @new_rgb);
+
+ foreach my $h (keys %__HTMLColors) {
+ my @h_rgb = hex2tuple($h);
+ my $h_d2 = __dist2(@rgb, @h_rgb);
+
+ if($h_d2 <= $new_d2) {
+ @new_rgb = @h_rgb;
+ $new_d2 = $h_d2;
+ }
+ }
+ return $self->__put(@new_rgb);
+}
=item $cc->mix($color1, $color2 [, $alpha]) / color_mix($color1, $color2 [, $alpha])
@@ -520,6 +559,20 @@
The optional C<$alpha> parameter can be a value between 0.0 (use
C<$color1> only) and 1.0 (use C<$color2> only), the default is 0.5.
+=cut
+
+sub mix {
+ my $self = __get_self(\@_);
+ my @c1 = ($self->__get(\@_,1));
+ my @c2 = ($self->__get(\@_));
+ my $alpha = shift(@_); $alpha = 0.5 unless defined $alpha;
+
+ return $self->__put(
+ ($c1[0] + ($c2[0]-$c1[0])*$alpha),
+ ($c1[1] + ($c2[1]-$c1[1])*$alpha),
+ ($c1[2] + ($c2[2]-$c1[2])*$alpha) );
+}
+
=item $cc->light($color [, $alpha]) / color_light($color [, $alpha])
Returns a lighter version of C<$color>, i.e. returns
@@ -528,6 +581,13 @@
The optional C<$alpha> parameter can be a value between 0.0 (use C<$color>
only) and 1.0 (use [255,255,255] only), the default is 0.5.
+=cut
+
+sub light {
+ my $self = __get_self(\@_);
+ return $self->__put(__get_raw->mix([$self->__get(\@_)],[255,255,255],shift));
+}
+
=item $cc->dark($color [, $alpha]) / color_dark($color [, $alpha])
Returns a darker version of C<$color>, i.e. returns
@@ -535,6 +595,14 @@
The optional C<$alpha> parameter can be a value between 0.0 (use
C<$color> only) and 1.0 (use [0,0,0] only), the default is 0.5.
+
+=cut
+
+sub dark {
+ my $self = __get_self(\@_);
+ return $self->__put(__get_raw->mix([$self->__get(\@_)],[0,0,0],shift));
+}
+
=item $cc->contrast($color [, $cut]) / color_contrast($color [, $cut])
@@ -547,6 +615,15 @@
The default for C<$cut> is .5, representing a cutoff between 127 and 128.
+=cut
+
+sub contrast {
+ my $self = __get_self(\@_);
+ my @rgb = $self->__get(\@_);
+ my $cut = (shift || .5) * 255;
+ return $self->__put(map { $_ >= $cut ? 0 : 255 } @rgb);
+}
+
=item $cc->contrast_bw($color [, $cut]) / color_contrast_bw($color [, $cut])
Returns black or white, whichever has the higher contrast to C<$color>.
@@ -556,8 +633,15 @@
The default for C<$cut> is .5, representing a cutoff between 127 and 128.
-=item $cc->blend($color [, $alpha])
-color_blend($color [, $alpha])
+=cut
+
+sub contrast_bw {
+ my $self = __get_self(\@_);
+ my @rgb = $self->__get(\@_);
+ return $self->__put(__get_raw->contrast([__get_raw->bw(@rgb)], shift));
+}
+
+=item $cc->blend($color [, $alpha]) / color_blend($color [, $alpha])
Returns a color that blends into the background, i.e. it returns
C<mix($color,contrast($color),$alpha)>.
@@ -573,6 +657,14 @@
You might want to use C<mix($color, $background, $alpha)> instead
if you know the real background color.
+=cut
+
+sub blend {
+ my $self = __get_self(\@_);
+ my @c1 = $self->__get(\@_);
+ return $self->mix(\@c1,[__get_raw->contrast(\@c1)],shift);
+}
+
=item $cc->blend_bw($color [, $alpha]) / color_blend_bw($color [, $alpha])
Returns a mix of C<$color> and black or white, whichever has the
@@ -580,6 +672,14 @@
The optional C<$alpha> parameter can be a value between 0.0 (use
C<$color> only) and 1.0 (use black/white only), the default is 0.5.
+
+=cut
+
+sub blend_bw {
+ my $self = __get_self(\@_);
+ my @c = $self->__get(\@_);
+ return $self->mix(\@c,[__get_raw->contrast_bw(\@c)],shift);
+}
=back
@@ -597,15 +697,15 @@
=over
-=item color, color_mix, â¦
+=item color, color_mix, ...
Use C<$Color::Calc::MODE> as the output format. This is the default.
-=item color_hex, color_mix_html, â¦
+=item color_hex, color_mix_html, ...
Use C<hex> as the output format.
-=item color_html, color_mix_html, â¦
+=item color_html, color_mix_html, ...
Use C<html> as the output format. Please note that the color names recognized
are still based on X's color names, which are incompatible with HTML. You can't
@@ -614,29 +714,41 @@
See L<Color::Calc::WWW> for an alternative that does not suffer from this
problem.
-=item color_pdf, color_mix_pdf, â¦
+=item color_pdf, color_mix_pdf, ...
Use C<pdf> as the output format.
-=item color_object, color_mix_object, â¦
+=item color_object, color_mix_object, ...
Use C<object> as the output format.
=back
+=cut
+
+foreach my $format (@__formats) {
+ __import(__PACKAGE__, 'Prefix' => 'color', '__Suffix' => "_$format", 'OutputFormat' => $format);
+ __import(__PACKAGE__, 'Prefix' => '', '__Suffix' => "_$format", 'OutputFormat' => $format);
+}
+
+__import(__PACKAGE__, 'Prefix' => 'color', 'OutputFormat' => '__MODEvar');
+
=head1 SEE ALSO
L<Graphics::ColorNames> (required); L<Graphics::ColorObject> (optional)
=head1 AUTHOR
-Claus Färber <CFAERBER at cpan.org>
+Claus FE<auml>rber <CFAERBER at cpan.org>
=head1 LICENSE
-Copyright © 2004-2009 Claus Färber. All rights reserved.
+Copyright 2004-2010 Claus FE<auml>rber. All rights reserved.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
+
+1;
+__END__
Modified: branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/WWW.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/WWW.pm?rev=49780&op=diff
==============================================================================
--- branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/WWW.pm (original)
+++ branches/upstream/libcolor-calc-perl/current/lib/Color/Calc/WWW.pm Fri Jan 1 20:25:31 2010
@@ -8,15 +8,14 @@
use Exporter;
use Color::Calc('OutputFormat' => 'html', 'ColorScheme' => 'WWW');
-our $VERSION = 1.052;
+our $VERSION = "1.060";
+$VERSION = eval $VERSION;
our @ISA = qw(Exporter);
our @EXPORT = ('color', map { 'color_'.$_ } @Color::Calc::__subs);
1;
__END__
-
-=encoding utf8
=head1 NAME
@@ -67,11 +66,11 @@
=head1 AUTHOR
-Claus Färber <CFAERBER at cpan.org>
+Claus FE<auml>rber <CFAERBER at cpan.org>
=head1 LICENSE
-Copyright © 2004-2009 Claus Färber.
+Copyright 2004-2010 Claus FE<auml>rber.
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
More information about the Pkg-perl-cvs-commits
mailing list