r62745 - in /branches/upstream/libconvert-color-perl/current: ./ lib/Convert/ lib/Convert/Color/ t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Tue Sep 21 14:07:49 UTC 2010
Author: angelabad-guest
Date: Tue Sep 21 14:07:12 2010
New Revision: 62745
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=62745
Log:
[svn-upgrade] new version libconvert-color-perl (0.07)
Added:
branches/upstream/libconvert-color-perl/current/t/21rgb-blend.t
branches/upstream/libconvert-color-perl/current/t/22rgb-dst.t
Removed:
branches/upstream/libconvert-color-perl/current/t/40rgb-blend.t
branches/upstream/libconvert-color-perl/current/t/50rgb-dst.t
Modified:
branches/upstream/libconvert-color-perl/current/Build.PL
branches/upstream/libconvert-color-perl/current/Changes
branches/upstream/libconvert-color-perl/current/LICENSE
branches/upstream/libconvert-color-perl/current/MANIFEST
branches/upstream/libconvert-color-perl/current/META.yml
branches/upstream/libconvert-color-perl/current/Makefile.PL
branches/upstream/libconvert-color-perl/current/README
branches/upstream/libconvert-color-perl/current/lib/Convert/Color.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMY.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMYK.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSL.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSV.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB16.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB8.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/VGA.pm
branches/upstream/libconvert-color-perl/current/lib/Convert/Color/X11.pm
branches/upstream/libconvert-color-perl/current/t/30vga.t
branches/upstream/libconvert-color-perl/current/t/31x11.t
Modified: branches/upstream/libconvert-color-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/Build.PL?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/Build.PL (original)
+++ branches/upstream/libconvert-color-perl/current/Build.PL Tue Sep 21 14:07:12 2010
@@ -3,19 +3,19 @@
use Module::Build;
-my $build = Module::Build->new
- (
+my $build = Module::Build->new(
module_name => 'Convert::Color',
requires => {
- 'Module::Pluggable' => 0,
- },
+ 'List::UtilsBy' => 0,
+ 'Module::Pluggable' => 0,
+ },
build_requires => {
- 'Test::More' => 0,
- },
+ 'Test::More' => 0,
+ },
license => 'perl',
create_makefile_pl => 'traditional',
create_license => 1,
create_readme => 1,
- );
+);
$build->create_build_script;
Modified: branches/upstream/libconvert-color-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/Changes?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/Changes (original)
+++ branches/upstream/libconvert-color-perl/current/Changes Tue Sep 21 14:07:12 2010
@@ -1,4 +1,18 @@
Revision history for Convert-Color
+
+0.07 CHANGES:
+ * Add warnings in 'deprecated' category for AUTOLOAD and COLOR_SPACE
+ behaviours
+
+ BUGFIXES:
+ * Declare dependency on List::UtilsBy
+
+0.06 CHANGES:
+ * Introduced ->register_color_space and ->register_palette
+ declarations
+ * Announce AUTOLOAD behaviour as deprecated
+ * Provide automatic "best match" palette searches on registered
+ palette spaces
0.05 CHANGES:
* Documentation fixes
Modified: branches/upstream/libconvert-color-perl/current/LICENSE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/LICENSE?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/LICENSE (original)
+++ branches/upstream/libconvert-color-perl/current/LICENSE Tue Sep 21 14:07:12 2010
@@ -1,4 +1,4 @@
-This software is copyright (c) 2009 by Paul Evans <leonerd at leonerd.org.uk>.
+This software is copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
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 Paul Evans <leonerd at leonerd.org.uk>.
+This software is Copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
This is free software, licensed under:
@@ -270,7 +270,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2009 by Paul Evans <leonerd at leonerd.org.uk>.
+This software is Copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
This is free software, licensed under:
Modified: branches/upstream/libconvert-color-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/MANIFEST?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/MANIFEST (original)
+++ branches/upstream/libconvert-color-perl/current/MANIFEST Tue Sep 21 14:07:12 2010
@@ -29,8 +29,8 @@
t/14convert-cmy.t
t/15convert-cmyk.t
t/20magic-const.t
+t/21rgb-blend.t
+t/22rgb-dst.t
t/30vga.t
t/31x11.t
-t/40rgb-blend.t
-t/50rgb-dst.t
t/99pod.t
Modified: branches/upstream/libconvert-color-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/META.yml?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/META.yml (original)
+++ branches/upstream/libconvert-color-perl/current/META.yml Tue Sep 21 14:07:12 2010
@@ -1,48 +1,51 @@
---
-name: Convert-Color
-version: 0.05
+abstract: 'color space conversions and named lookups'
author:
- 'Paul Evans <leonerd at leonerd.org.uk>'
-abstract: color space conversions and named lookups
-license: perl
-resources:
- license: http://dev.perl.org/licenses/
-requires:
- Module::Pluggable: 0
build_requires:
Test::More: 0
+configure_requires:
+ Module::Build: 0.36
+generated_by: 'Module::Build version 0.3607'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Convert-Color
provides:
Convert::Color:
file: lib/Convert/Color.pm
- version: 0.05
+ version: 0.07
Convert::Color::CMY:
file: lib/Convert/Color/CMY.pm
- version: 0.05
+ version: 0.07
Convert::Color::CMYK:
file: lib/Convert/Color/CMYK.pm
- version: 0.05
+ version: 0.07
Convert::Color::HSL:
file: lib/Convert/Color/HSL.pm
- version: 0.05
+ version: 0.07
Convert::Color::HSV:
file: lib/Convert/Color/HSV.pm
- version: 0.05
+ version: 0.07
Convert::Color::RGB:
file: lib/Convert/Color/RGB.pm
- version: 0.05
+ version: 0.07
Convert::Color::RGB16:
file: lib/Convert/Color/RGB16.pm
- version: 0.05
+ version: 0.07
Convert::Color::RGB8:
file: lib/Convert/Color/RGB8.pm
- version: 0.05
+ version: 0.07
Convert::Color::VGA:
file: lib/Convert/Color/VGA.pm
- version: 0.05
+ version: 0.07
Convert::Color::X11:
file: lib/Convert/Color/X11.pm
- version: 0.05
-generated_by: Module::Build version 0.33
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: 0.07
+requires:
+ List::UtilsBy: 0
+ Module::Pluggable: 0
+resources:
+ license: http://dev.perl.org/licenses/
+version: 0.07
Modified: branches/upstream/libconvert-color-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/Makefile.PL?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/Makefile.PL (original)
+++ branches/upstream/libconvert-color-perl/current/Makefile.PL Tue Sep 21 14:07:12 2010
@@ -1,10 +1,11 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.33
+# Note: this file was auto-generated by Module::Build::Compat version 0.3607
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'Convert::Color',
'VERSION_FROM' => 'lib/Convert/Color.pm',
'PREREQ_PM' => {
+ 'List::UtilsBy' => 0,
'Module::Pluggable' => 0,
'Test::More' => 0
},
Modified: branches/upstream/libconvert-color-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/README?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/README (original)
+++ branches/upstream/libconvert-color-perl/current/README Tue Sep 21 14:07:12 2010
@@ -108,6 +108,15 @@
Attempt to convert the color into its representation in the given space.
See above for the various ways this may be achieved.
+ If the relevant subclass has already been loaded (either explicitly, or
+ implicitly by either the "new" or "convert_to" methods), then a specific
+ conversion method will be installed in the class.
+
+ $other = $color->as_$space
+
+ Methods of this form are currently "AUTOLOAD"ed if they do not yet
+ exist, but this feature should not be relied upon - see below.
+
AUTOLOADED CONVERSION METHODS
This class provides "AUTOLOAD" and "can" behaviour which automatically
constructs conversion methods. The following method calls are identical:
@@ -118,12 +127,42 @@
The generated method will be stored in the package, so that future calls
will not have the AUTOLOAD overhead.
+ This feature is deprecated and should not be relied upon, due to the
+ delicate nature of "AUTOLOAD".
+
OTHER METHODS
As well as the above, it is likely the subclass will provide accessors
to directly obtain the components of its representation in the specific
space. For more detail, see the documentation for the specific subclass
in question.
+SUBCLASS METHODS
+ This base class is intended to be subclassed to provide more color
+ spaces.
+
+ $class->register_color_space( $space )
+ A subclass should call this method to register itself as a named color
+ space.
+
+ $class->register_palette( %args )
+ A subclass that provides a fixed set of color values should call this
+ method, to set up automatic conversions that look for the closest match
+ within the set. This conversion process is controlled by the %args:
+
+ enumerate => STRING or CODE
+ A method name or anonymous CODE reference which will be used to
+ generate the list of color values.
+
+ enumerate_once => STRING or CODE
+ As per "enumerate", but will be called only once and the results
+ cached.
+
+ This conversion process only finds the closest match in RGB space, so it
+ may not give exact results.
+
+ In the case of a tie, where two or more colors have the same distance
+ from the target, the first one will be chosen.
+
AUTHOR
Paul Evans <leonerd at leonerd.org.uk>
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color.pm Tue Sep 21 14:07:12 2010
@@ -1,7 +1,7 @@
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
-# (C) Paul Evans, 2009 -- leonerd at leonerd.org.uk
+# (C) Paul Evans, 2009,2010 -- leonerd at leonerd.org.uk
package Convert::Color;
@@ -10,11 +10,13 @@
use Carp;
-use Module::Pluggable require => 1,
+use List::UtilsBy qw( min_by );
+
+use Module::Pluggable require => 0,
search_path => [ 'Convert::Color' ];
my @plugins = Convert::Color->plugins;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
@@ -100,20 +102,47 @@
=cut
+my $_space2class_cache_initialised;
my %_space2class_cache; # {$space} = $class
+my %_class2space_cache; # {$class} = $space
+
+# doc'ed later for readability...
+sub register_color_space
+{
+ my $class = shift;
+ my ( $space ) = @_;
+
+ exists $_space2class_cache{$space} and croak "Color space $space is already defined";
+ exists $_class2space_cache{$class} and croak "Class $class already declared a color space";
+
+ $_space2class_cache{$space} = $class;
+ $_class2space_cache{$class} = $space;
+
+ no strict 'refs';
+ *{"as_$space"} = sub { shift->convert_to( $space ) };
+}
+
sub _space2class
{
my ( $space ) = @_;
- return $_space2class_cache{$space} if exists $_space2class_cache{$space};
-
- foreach my $class ( @plugins ) {
- $class->can( 'COLOR_SPACE' ) or next;
-
- return $_space2class_cache{$space} = $class if $class->COLOR_SPACE eq $space;
- }
-
- return undef;
+ unless( $_space2class_cache_initialised ) {
+ $_space2class_cache_initialised++;
+ # Initialise the space name to class cache
+ foreach my $class ( @plugins ) {
+ ( my $file = "$class.pm" ) =~ s{::}{/}g;
+ require $file or next;
+
+ $class->can( 'COLOR_SPACE' ) or next;
+ my $thisspace = $class->COLOR_SPACE or next;
+
+ warnings::warn( deprecated => "Discovered $class by deprecated COLOR_SPACE method" );
+
+ $class->register_color_space( $thisspace );
+ }
+ }
+
+ return $_space2class_cache{$space};
}
=head2 $color = Convert::Color->new( STRING )
@@ -219,6 +248,15 @@
Attempt to convert the color into its representation in the given space. See
above for the various ways this may be achieved.
+If the relevant subclass has already been loaded (either explicitly, or
+implicitly by either the C<new> or C<convert_to> methods), then a specific
+conversion method will be installed in the class.
+
+ $other = $color->as_$space
+
+Methods of this form are currently C<AUTOLOAD>ed if they do not yet exist, but
+this feature should not be relied upon - see below.
+
=cut
sub convert_to
@@ -228,7 +266,7 @@
my $to_class = _space2class( $to_space ) or croak "Unrecognised color space name '$to_space'";
- my $from_space = ref($self)->COLOR_SPACE;
+ my $from_space = $_class2space_cache{ref $self};
if( $from_space eq $to_space ) {
# Identity conversion
@@ -270,6 +308,9 @@
The generated method will be stored in the package, so that future calls will
not have the AUTOLOAD overhead.
+
+This feature is deprecated and should not be relied upon, due to the delicate
+nature of C<AUTOLOAD>.
=cut
@@ -300,13 +341,18 @@
return if $method eq "DESTROY";
- if( my $code = $_[0]->can( $method ) ) {
+ if( ref $_[0] and my $code = $_[0]->can( $method ) ) {
+ # It's possible that the lazy loading by ->can has just created this method
+ warnings::warn( deprecated => "Relying on AUTOLOAD to provide $method" );
no strict 'refs';
- *{$method} = $code;
+ unless( defined &{$method} ) {
+ *{$method} = $code;
+ }
goto &$code;
}
- croak "$_[0] cannot do $method";
+ my $class = ref $_[0] || $_[0];
+ croak qq(Cannot locate object method "$method" via package "$class");
}
=head1 OTHER METHODS
@@ -317,6 +363,82 @@
=cut
+=head1 SUBCLASS METHODS
+
+This base class is intended to be subclassed to provide more color spaces.
+
+=cut
+
+=head2 $class->register_color_space( $space )
+
+A subclass should call this method to register itself as a named color space.
+
+=cut
+
+=head2 $class->register_palette( %args )
+
+A subclass that provides a fixed set of color values should call this method,
+to set up automatic conversions that look for the closest match within the
+set. This conversion process is controlled by the C<%args>:
+
+=over 8
+
+=item enumerate => STRING or CODE
+
+A method name or anonymous CODE reference which will be used to generate the
+list of color values.
+
+=item enumerate_once => STRING or CODE
+
+As per C<enumerate>, but will be called only once and the results cached.
+
+=back
+
+This conversion process only finds the closest match in RGB space, so it may
+not give exact results.
+
+In the case of a tie, where two or more colors have the same distance from the
+target, the first one will be chosen.
+
+=cut
+
+sub register_palette
+{
+ my $pkg = shift;
+ my %args = @_;
+
+ my $enumerate;
+
+ if( $args{enumerate} ) {
+ $enumerate = $args{enumerate};
+ }
+ elsif( my $enumerate_once = $args{enumerate_once} ) {
+ my @colors;
+ $enumerate = sub {
+ my $class = shift;
+ @colors = $class->$enumerate_once unless @colors;
+ return @colors;
+ }
+ }
+ else {
+ croak "Require 'enumerate' or 'enumerate_once'";
+ }
+
+ no strict 'refs';
+
+ *{"${pkg}::new_from_rgb"} = sub {
+ my $class = shift;
+ my ( $rgb ) = @_;
+
+ return min_by { $rgb->dst_rgb_cheap( $_ ) } $class->$enumerate;
+ };
+
+ *{"${pkg}::new_rgb"} = sub {
+ my $class = shift;
+ return $class->new_from_rgb( Convert::Color::RGB->new( @_ ) );
+ };
+}
+
# Keep perl happy; keep Britain tidy
1;
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMY.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMY.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMY.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMY.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color );
-use constant COLOR_SPACE => 'cmy';
+__PACKAGE__->register_color_space( 'cmy' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMYK.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMYK.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMYK.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/CMYK.pm Tue Sep 21 14:07:12 2010
@@ -9,13 +9,13 @@
use warnings;
use base qw( Convert::Color );
-use constant COLOR_SPACE => 'cmyk';
+__PACKAGE__->register_color_space( 'cmyk' );
use List::Util qw( min );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSL.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSL.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSL.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color::HueBased );
-use constant COLOR_SPACE => 'hsl';
+__PACKAGE__->register_color_space( 'hsl' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSV.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSV.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSV.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/HSV.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color::HueBased );
-use constant COLOR_SPACE => 'hsv';
+__PACKAGE__->register_color_space( 'hsv' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color );
-use constant COLOR_SPACE => 'rgb';
+__PACKAGE__->register_color_space( 'rgb' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB16.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB16.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB16.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB16.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color );
-use constant COLOR_SPACE => 'rgb16';
+__PACKAGE__->register_color_space( 'rgb16' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB8.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB8.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB8.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/RGB8.pm Tue Sep 21 14:07:12 2010
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color );
-use constant COLOR_SPACE => 'rgb8';
+__PACKAGE__->register_color_space( 'rgb8' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/VGA.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/VGA.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/VGA.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/VGA.pm Tue Sep 21 14:07:12 2010
@@ -1,7 +1,7 @@
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
-# (C) Paul Evans, 2009 -- leonerd at leonerd.org.uk
+# (C) Paul Evans, 2009,2010 -- leonerd at leonerd.org.uk
package Convert::Color::VGA;
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color::RGB );
-use constant COLOR_SPACE => 'vga';
+__PACKAGE__->register_color_space( 'vga' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
=head1 NAME
@@ -68,6 +68,13 @@
# Also indexes
my @vga_colors = qw(
black blue green cyan red magenta yellow white
+);
+
+__PACKAGE__->register_palette(
+ enumerate_once => sub {
+ my $class = shift;
+ map { $class->new( $_ ) } @vga_colors;
+ },
);
=head1 CONSTRUCTOR
Modified: branches/upstream/libconvert-color-perl/current/lib/Convert/Color/X11.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/lib/Convert/Color/X11.pm?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/lib/Convert/Color/X11.pm (original)
+++ branches/upstream/libconvert-color-perl/current/lib/Convert/Color/X11.pm Tue Sep 21 14:07:12 2010
@@ -1,7 +1,7 @@
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
-# (C) Paul Evans, 2009 -- leonerd at leonerd.org.uk
+# (C) Paul Evans, 2009,2010 -- leonerd at leonerd.org.uk
package Convert::Color::X11;
@@ -9,11 +9,11 @@
use warnings;
use base qw( Convert::Color::RGB8 );
-use constant COLOR_SPACE => 'x11';
+__PACKAGE__->register_color_space( 'x11' );
use Carp;
-our $VERSION = '0.05';
+our $VERSION = '0.07';
# Different systems put it in different places. We'll try all of them taking
# the first we find
@@ -49,7 +49,34 @@
=cut
+my @x11_color_names; # To preserve order
my $x11_colors;
+
+sub _load_x11_colors
+{
+ my $rgbtxt;
+
+ foreach ( @RGB_TXT ) {
+ -f $_ or next;
+
+ open( $rgbtxt, "<", $_ ) or die "Cannot read $_ - $!\n";
+ last;
+ }
+
+ $rgbtxt or die "No rgb.txt file was found\n";
+
+ local $_;
+
+ while( <$rgbtxt> ) {
+ s/^\s+//; # trim leading WS
+ next if m/^!/; # comment
+
+ my ( $r, $g, $b, $name ) = m/^(\d+)\s+(\d+)\s+(\d+)\s+(.*)$/ or next;
+
+ $x11_colors->{$name} = [ $r, $g, $b ];
+ push @x11_color_names, $name;
+ }
+}
=head1 CLASS METHODS
@@ -71,10 +98,17 @@
{
my $class = shift;
- $x11_colors ||= _load_x11_colors();
+ $x11_colors or _load_x11_colors;
- return keys %$x11_colors;
+ return @x11_color_names;
}
+
+__PACKAGE__->register_palette(
+ enumerate => sub {
+ my $class = shift;
+ map { $class->new( $_ ) } $class->colors;
+ },
+);
=head1 CONSTRUCTOR
@@ -93,7 +127,7 @@
if( @_ == 1 ) {
my $name = $_[0];
- $x11_colors ||= _load_x11_colors();
+ $x11_colors or _load_x11_colors;
my $color = $x11_colors->{$name} or
croak "No such X11 color named '$name'";
@@ -125,35 +159,6 @@
return $self->[3];
}
-sub _load_x11_colors
-{
- my %colors;
-
- my $rgbtxt;
-
- foreach ( @RGB_TXT ) {
- -f $_ or next;
-
- open( $rgbtxt, "<", $_ ) or die "Cannot read $_ - $!\n";
- last;
- }
-
- $rgbtxt or die "No rgb.txt file was found\n";
-
- local $_;
-
- while( <$rgbtxt> ) {
- s/^\s+//; # trim leading WS
- next if m/^!/; # comment
-
- my ( $r, $g, $b, $name ) = m/^(\d+)\s+(\d+)\s+(\d+)\s+(.*)$/ or next;
-
- $colors{$name} = [ $r, $g, $b ];
- }
-
- return \%colors;
-}
-
# Keep perl happy; keep Britain tidy
1;
Added: branches/upstream/libconvert-color-perl/current/t/21rgb-blend.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/t/21rgb-blend.t?rev=62745&op=file
==============================================================================
--- branches/upstream/libconvert-color-perl/current/t/21rgb-blend.t (added)
+++ branches/upstream/libconvert-color-perl/current/t/21rgb-blend.t Tue Sep 21 14:07:12 2010
@@ -1,0 +1,62 @@
+#!/usr/bin/perl
+
+use Test::More tests => 23;
+
+use Convert::Color::RGB;
+use Convert::Color::RGB8;
+
+my $red = Convert::Color::RGB->new( 1, 0, 0 );
+my $white = Convert::Color::RGB->new( 1, 1, 1 );
+my $black = Convert::Color::RGB->new( 0, 0, 0 );
+
+my $pink = $red->alpha_blend( $white );
+isa_ok( $pink, "Convert::Color::RGB", 'red->alpha_blend constructs Convert::Color::RGB' );
+
+is_deeply( [ $pink->rgb ], [ 1, 0.5, 0.5 ], 'alpha_blend rgb' );
+
+is_deeply( [ $red->alpha_blend( $white, 0.25 )->rgb ], [ 1, 0.25, 0.25 ], 'alpha_blend(0.25) white' );
+is_deeply( [ $red->alpha_blend( $white, 0.75 )->rgb ], [ 1, 0.75, 0.75 ], 'alpha_blend(0.75) white' );
+
+is_deeply( [ $red->alpha_blend( $black, 0.25 )->rgb ], [ 0.75, 0, 0 ], 'alpha_blend(0.25) black' );
+
+my $red8 = Convert::Color::RGB8->new( 255, 0, 0 );
+my $white8 = Convert::Color::RGB8->new( 255, 255, 255 );
+my $black8 = Convert::Color::RGB8->new( 0, 0, 0 );
+
+my $pink8 = $red8->alpha_blend( $white8 );
+isa_ok( $pink8, "Convert::Color::RGB8", 'red8->alpha_blend constructs Convert::Color::RGB8' );
+
+is_deeply( [ $pink8->rgb8 ], [ 255, 128, 128 ], 'alpha_blend rgb' );
+
+is_deeply( [ $red8->alpha_blend( $white8, 0.25 )->rgb8 ], [ 255, 64, 64 ], 'alpha_blend(0.25) white8' );
+is_deeply( [ $red8->alpha_blend( $white8, 0.75 )->rgb8 ], [ 255, 191, 191 ], 'alpha_blend(0.75) white8' );
+
+is_deeply( [ $red8->alpha_blend( $black8, 0.25 )->rgb8 ], [ 191, 0, 0 ], 'alpha_blend(0.25) black8' );
+
+isa_ok( $red8->alpha8_blend( $white8 ), "Convert::Color::RGB8", 'red8->alpha8_blend constructs Convert::Color::RGB8' );
+
+is_deeply( [ $red8->alpha8_blend( $white8, 64 )->rgb8 ], [ 255, 64, 64 ], 'alpha8_blend(64) white8' );
+is_deeply( [ $red8->alpha8_blend( $white8, 191 )->rgb8 ], [ 255, 191, 191 ], 'alpha8_blend(191) white8' );
+
+is_deeply( [ $red8->alpha8_blend( $black8, 64 )->rgb8 ], [ 191, 0, 0 ], 'alpha8_blend(64) black8' );
+
+my $red16 = Convert::Color::RGB16->new( 0xffff, 0, 0 );
+my $white16 = Convert::Color::RGB16->new( 0xffff, 0xffff, 0xffff );
+my $black16 = Convert::Color::RGB16->new( 0, 0, 0 );
+
+my $pink16 = $red16->alpha_blend( $white16 );
+isa_ok( $pink16, "Convert::Color::RGB16", 'red16->alpha_blend constructs Convert::Color::RGB16' );
+
+is_deeply( [ $pink16->rgb16 ], [ 0xffff, 0x8000, 0x8000 ], 'alpha_blend rgb' );
+
+is_deeply( [ $red16->alpha_blend( $white16, 0.25 )->rgb16 ], [ 0xffff, 0x4000, 0x4000 ], 'alpha_blend(0.25) white16' );
+is_deeply( [ $red16->alpha_blend( $white16, 0.75 )->rgb16 ], [ 0xffff, 0xbfff, 0xbfff ], 'alpha_blend(0.75) white16' );
+
+is_deeply( [ $red16->alpha_blend( $black16, 0.25 )->rgb16 ], [ 0xbfff, 0, 0 ], 'alpha_blend(0.25) black16' );
+
+isa_ok( $red16->alpha16_blend( $white16 ), "Convert::Color::RGB16", 'red16->alpha16_blend constructs Convert::Color::RGB16' );
+
+is_deeply( [ $red16->alpha16_blend( $white16, 0x4000 )->rgb16 ], [ 0xffff, 0x4000, 0x4000 ], 'alpha16_blend(0x4000) white16' );
+is_deeply( [ $red16->alpha16_blend( $white16, 0xbfff )->rgb16 ], [ 0xffff, 0xbfff, 0xbfff ], 'alpha16_blend(0xbfff) white16' );
+
+is_deeply( [ $red16->alpha16_blend( $black16, 0x4000 )->rgb16 ], [ 0xbfff, 0, 0 ], 'alpha16_blend(0x4000) black16' );
Added: branches/upstream/libconvert-color-perl/current/t/22rgb-dst.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/t/22rgb-dst.t?rev=62745&op=file
==============================================================================
--- branches/upstream/libconvert-color-perl/current/t/22rgb-dst.t (added)
+++ branches/upstream/libconvert-color-perl/current/t/22rgb-dst.t Tue Sep 21 14:07:12 2010
@@ -1,0 +1,77 @@
+#!/usr/bin/perl
+
+use Test::More tests => 34;
+
+use Convert::Color::RGB;
+use Convert::Color::RGB8;
+use Convert::Color::RGB16;
+
+my $black = Convert::Color::RGB->new( 0, 0, 0 );
+my $white = Convert::Color::RGB->new( 1, 1, 1 );
+my $red = Convert::Color::RGB->new( 1, 0, 0 );
+my $green = Convert::Color::RGB->new( 0, 1, 0 );
+my $blue = Convert::Color::RGB->new( 0, 0, 1 );
+
+is( $black->dst_rgb( $black ), 0, 'black->dst_rgb black' );
+
+is( $black->dst_rgb( $red ), 1/sqrt(3), 'black->dst_rgb red' );
+is( $black->dst_rgb( $green ), 1/sqrt(3), 'black->dst_rgb green' );
+is( $black->dst_rgb( $blue ), 1/sqrt(3), 'black->dst_rgb blue' );
+
+is( $black->dst_rgb( $white ), 1, 'black->dst_rgb white' );
+
+is( $black->dst_rgb_cheap( $black ), 0, 'black->dst_rgb_cheap black' );
+
+is( $black->dst_rgb_cheap( $red ), 1, 'black->dst_rgb_cheap red' );
+is( $black->dst_rgb_cheap( $green ), 1, 'black->dst_rgb_cheap green' );
+is( $black->dst_rgb_cheap( $blue ), 1, 'black->dst_rgb_cheap blue' );
+
+is( $black->dst_rgb_cheap( $white ), 3, 'black->dst_rgb_cheap white' );
+
+my $black8 = Convert::Color::RGB8->new( 0, 0, 0 );
+my $white8 = Convert::Color::RGB8->new( 255, 255, 255 );
+my $red8 = Convert::Color::RGB8->new( 255, 0, 0 );
+my $green8 = Convert::Color::RGB8->new( 0, 255, 0 );
+my $blue8 = Convert::Color::RGB8->new( 0, 0, 255 );
+
+is( $black8->dst_rgb8( $black8 ), 0, 'black8->dst_rgb8 black8' );
+is( $black8->dst_rgb8( $black ), 0, 'black8->dst_rgb8 black' );
+
+is( $black8->dst_rgb8( $red8 ), 1/sqrt(3), 'black8->dst_rgb8 red8' );
+is( $black8->dst_rgb8( $green8 ), 1/sqrt(3), 'black8->dst_rgb8 green8' );
+is( $black8->dst_rgb8( $blue8 ), 1/sqrt(3), 'black8->dst_rgb8 blue8' );
+
+is( $black8->dst_rgb8( $white8 ), 1, 'black8->dst_rgb8 white8' );
+is( $black8->dst_rgb8( $white ), 1, 'black8->dst_rgb8 white' );
+
+is( $black8->dst_rgb8_cheap( $black8 ), 0, 'black8->dst_rgb8_cheap black8' );
+
+is( $black8->dst_rgb8_cheap( $red8 ), 255*255, 'black8->dst_rgb8_cheap red8' );
+is( $black8->dst_rgb8_cheap( $green8 ), 255*255, 'black8->dst_rgb8_cheap green8' );
+is( $black8->dst_rgb8_cheap( $blue8 ), 255*255, 'black8->dst_rgb8_cheap blue8' );
+
+is( $black8->dst_rgb8_cheap( $white8 ), 3*255*255, 'black8->dst_rgb8_cheap white8' );
+
+my $black16 = Convert::Color::RGB16->new( 0, 0, 0 );
+my $white16 = Convert::Color::RGB16->new( 0xffff, 0xffff, 0xffff );
+my $red16 = Convert::Color::RGB16->new( 0xffff, 0, 0 );
+my $green16 = Convert::Color::RGB16->new( 0, 0xffff, 0 );
+my $blue16 = Convert::Color::RGB16->new( 0, 0, 0xffff );
+
+is( $black16->dst_rgb16( $black16 ), 0, 'black16->dst_rgb16 black16' );
+is( $black16->dst_rgb16( $black ), 0, 'black16->dst_rgb16 black' );
+
+is( $black16->dst_rgb16( $red16 ), 1/sqrt(3), 'black16->dst_rgb16 red16' );
+is( $black16->dst_rgb16( $green16 ), 1/sqrt(3), 'black16->dst_rgb16 green16' );
+is( $black16->dst_rgb16( $blue16 ), 1/sqrt(3), 'black16->dst_rgb16 blue16' );
+
+is( $black16->dst_rgb16( $white16 ), 1, 'black16->dst_rgb16 white16' );
+is( $black16->dst_rgb16( $white ), 1, 'black16->dst_rgb16 white' );
+
+is( $black16->dst_rgb16_cheap( $black16 ), 0, 'black16->dst_rgb16_cheap black16' );
+
+is( $black16->dst_rgb16_cheap( $red16 ), 0xffff*0xffff, 'black16->dst_rgb16_cheap red16' );
+is( $black16->dst_rgb16_cheap( $green16 ), 0xffff*0xffff, 'black16->dst_rgb16_cheap green16' );
+is( $black16->dst_rgb16_cheap( $blue16 ), 0xffff*0xffff, 'black16->dst_rgb16_cheap blue16' );
+
+is( $black16->dst_rgb16_cheap( $white16 ), 3*0xffff*0xffff, 'black16->dst_rgb16_cheap white16' );
Modified: branches/upstream/libconvert-color-perl/current/t/30vga.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/t/30vga.t?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/t/30vga.t (original)
+++ branches/upstream/libconvert-color-perl/current/t/30vga.t Tue Sep 21 14:07:12 2010
@@ -1,8 +1,10 @@
#!/usr/bin/perl
-use Test::More tests => 14;
+use Test::More tests => 16;
use Convert::Color::VGA;
+use Convert::Color::RGB;
+use Convert::Color::RGB8;
my $red = Convert::Color::VGA->new( 'red' );
@@ -29,3 +31,10 @@
is( $blue->red, 0, 'blue red' );
is( $blue->green, 0, 'blue green' );
is( $blue->blue, 1, 'blue blue' );
+
+my $darkred = Convert::Color::RGB->new( 0.8, 0, 0 );
+
+my $best_red = $darkred->as_vga;
+
+is( $best_red->name, "red", 'best red name' );
+is( $best_red->index, 4, 'best red index' );
Modified: branches/upstream/libconvert-color-perl/current/t/31x11.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconvert-color-perl/current/t/31x11.t?rev=62745&op=diff
==============================================================================
--- branches/upstream/libconvert-color-perl/current/t/31x11.t (original)
+++ branches/upstream/libconvert-color-perl/current/t/31x11.t Tue Sep 21 14:07:12 2010
@@ -1,11 +1,12 @@
#!/usr/bin/perl
use Convert::Color::X11;
+use Convert::Color::RGB8;
require Test::More;
if( eval { Convert::Color::X11->colors; 1 } ) {
- import Test::More tests => 10;
+ import Test::More tests => 11;
}
else {
import Test::More skip_all => "Cannot load X11 rgb.txt database";
@@ -30,3 +31,7 @@
is( $green->blue, 0, 'green blue' );
is( $green->name, "green", 'green name' );
+
+my $white = Convert::Color::RGB8->new( 255, 255, 255 )->as_x11;
+
+is( $white->name, "white", 'white from RGB8 name' );
More information about the Pkg-perl-cvs-commits
mailing list