Convert-Color-0.10000755001750001750 012260143752 12651 5ustar00leoleo000000000000Convert-Color-0.10/Changes000444001750001750 416512260143752 14307 0ustar00leoleo000000000000Revision history for Convert-Color 0.10 2013/12/30 01:07:36 [CHANGES] * Resolve a cornercase ambiguity between CORE::hex() and sub hex which affects unclean code reloading on 5.16 (RT91722) 0.09 CHANGES: * Add ->chroma method to HSV and HSL spaces * Add distance metrics in HSV and HSL spaces * Allow palette spaces to perform custom closest-match in any color space by using its distance metric 0.08 CHANGES: * Fix VGA colours so the indices agree with VT100/ANSI colour numbering * Don't rely on rgb8:255,255,255 as X11 being called 'white' during testing * Added an example script for generating gradients 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 * Various small updates to keep CPANTS happy 0.04 CHANGES: * Distance metrics in RGB{,8,16} color spaces * Remember name/index of X11 and VGA colors 0.03 CHANGES: * Alpha-blending in RGB{,8,16} color spaces BUGFIXES: * More candidate paths to find X11's rgb.txt 0.02 ADDITIONS: * Support CMY and CMYK color spaces CHANGES: * Neater and more internal implementation of space->space conversions * ->rgb8 / ->rgb16 are no longer methods on Convert::Color, but instead on the specific ::RGB8 / ::RGB16 subclasses * Added ->hsl etc.. component list accessors for other color spaces BUGFIXES: * Cache plugin list and space-to-class mapping to avoid @INC search overhead in Module::Pluggable each time a new object is constructed 0.01 First version, released on an unsuspecting world. Convert-Color-0.10/META.json000444001750001750 365212260143752 14435 0ustar00leoleo000000000000{ "abstract" : "color space conversions and named lookups", "author" : [ "Paul Evans " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4202", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Convert-Color", "prereqs" : { "build" : { "requires" : { "Test::More" : "0.88" } }, "runtime" : { "requires" : { "List::UtilsBy" : "0", "Module::Pluggable" : "0" } } }, "provides" : { "Convert::Color" : { "file" : "lib/Convert/Color.pm", "version" : "0.10" }, "Convert::Color::CMY" : { "file" : "lib/Convert/Color/CMY.pm", "version" : "0.10" }, "Convert::Color::CMYK" : { "file" : "lib/Convert/Color/CMYK.pm", "version" : "0.10" }, "Convert::Color::HSL" : { "file" : "lib/Convert/Color/HSL.pm", "version" : "0.10" }, "Convert::Color::HSV" : { "file" : "lib/Convert/Color/HSV.pm", "version" : "0.10" }, "Convert::Color::RGB" : { "file" : "lib/Convert/Color/RGB.pm", "version" : "0.10" }, "Convert::Color::RGB16" : { "file" : "lib/Convert/Color/RGB16.pm", "version" : "0.10" }, "Convert::Color::RGB8" : { "file" : "lib/Convert/Color/RGB8.pm", "version" : "0.10" }, "Convert::Color::VGA" : { "file" : "lib/Convert/Color/VGA.pm", "version" : "0.10" }, "Convert::Color::X11" : { "file" : "lib/Convert/Color/X11.pm", "version" : "0.10" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "0.10" } Convert-Color-0.10/README000444001750001750 1372112260143752 13712 0ustar00leoleo000000000000NAME `Convert::Color' - color space conversions and named lookups SYNOPSIS use Convert::Color; my $color = Convert::Color->new( 'hsv:76,0.43,0.89' ); my ( $red, $green, $blue ) = $color->rgb; # GTK uses 16-bit values my $gtk_col = Gtk2::Gdk::Color->new( $color->as_rgb16->rgb16 ); # HTML uses #rrggbb in hex my $html = ''; DESCRIPTION This module provides conversions between commonly used ways to express colors. It provides conversions between color spaces such as RGB and HSV, and it provides ways to look up colors by a name. This class provides a base for subclasses which represent particular color values in particular spaces. The base class provides methods to represent the color in a few convenient forms, though subclasses may provide more specific details for the space in question. For more detail, read the documentation on these classes; namely: * Convert::Color::RGB - red/green/blue as floats between 0 and 1 * Convert::Color::RGB8 - red/green/blue as 8-bit integers * Convert::Color::RGB16 - red/green/blue as 16-bit integers * Convert::Color::HSV - hue/saturation/value * Convert::Color::HSL - hue/saturation/lightness * Convert::Color::CMY - cyan/magenta/yellow * Convert::Color::CMYK - cyan/magenta/yellow/key (blackness) The following classes are subclasses of one of the above, which provide a way to access predefined colors by names: * Convert::Color::VGA - named lookup for the basic VGA colors * Convert::Color::X11 - named lookup of colors from X11's rgb.txt CONSTRUCTOR $color = Convert::Color->new( STRING ) Return a new value to represent the color specified by the string. This string should be prefixed by the name of the color space to which it applies. For example rgb:RED,GREEN,BLUE rgb8:RRGGBB rgb16:RRRRGGGGBBBB hsv:HUE,SAT,VAL hsl:HUE,SAT,LUM cmy:CYAN,MAGENTA,YELLOW cmyk:CYAN,MAGENTA,YELLOW,KEY vga:NAME vga:INDEX x11:NAME For more detail, see the constructor of the color space subclass in question. METHODS ( $red, $green, $blue ) = $color->rgb Returns the individual red, green and blue color components of the color value. For RGB values, this is done directly. For values in other spaces, this is done by first converting them to an RGB value using their `to_rgb()' method. COLOR SPACE CONVERSIONS Cross-conversion between color spaces is provided by the `convert_to()' method, assisted by helper methods in the two color space classes involved. When converting `$color' from color space SRC to color space DEST, the following operations are attemped, in this order. SRC and DEST refer to the names of the color spaces, e.g. `rgb'. 1. If SRC and DEST are equal, return `$color' as it stands. 2. If the SRC space's class provides a `convert_to_DEST' method, use it. 3. If the DEST space's class provides a `new_from_SRC' constructor, call it and pass `$color'. 4. If the DEST space's class provides a `new_rgb' constructor, convert `$color' to red/green/blue components then call it. 5. If none of these operations worked, then throw an exception. These functions may be called in the following ways: $other = $color->convert_to_DEST() $other = Dest::Class->new_from_SRC( $color ) $other = Dest::Class->new_rgb( $color->rgb ) $other = $color->convert_to( $space ) 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: $color->convert_to('rgb') $color->as_rgb 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 method creates a new class method on the calling package, called `closest_to'. $color = $pkg->closest_to( $orig, $space ) Returns the color in the space closest to the given value. The distance is measured in the named space; defaulting to `rgb' if this is not provided. 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 Convert-Color-0.10/Build.PL000444001750001750 74712260143752 14272 0ustar00leoleo000000000000use strict; use warnings; use Module::Build; my $build = Module::Build->new( module_name => 'Convert::Color', requires => { 'List::UtilsBy' => 0, 'Module::Pluggable' => 0, }, build_requires => { 'Test::More' => '0.88', # done_testing }, auto_configure_requires => 0, # Don't add M::B to configure_requires license => 'perl', create_makefile_pl => 'traditional', create_license => 1, create_readme => 1, ); $build->create_build_script; Convert-Color-0.10/LICENSE000444001750001750 4376012260143752 14045 0ustar00leoleo000000000000This software is copyright (c) 2013 by Paul Evans . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Paul Evans . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Paul Evans . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Convert-Color-0.10/META.yml000444001750001750 235012260143752 14257 0ustar00leoleo000000000000--- abstract: 'color space conversions and named lookups' author: - 'Paul Evans ' build_requires: Test::More: 0.88 dynamic_config: 1 generated_by: 'Module::Build version 0.4202, CPAN::Meta::Converter version 2.133380' 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.10 Convert::Color::CMY: file: lib/Convert/Color/CMY.pm version: 0.10 Convert::Color::CMYK: file: lib/Convert/Color/CMYK.pm version: 0.10 Convert::Color::HSL: file: lib/Convert/Color/HSL.pm version: 0.10 Convert::Color::HSV: file: lib/Convert/Color/HSV.pm version: 0.10 Convert::Color::RGB: file: lib/Convert/Color/RGB.pm version: 0.10 Convert::Color::RGB16: file: lib/Convert/Color/RGB16.pm version: 0.10 Convert::Color::RGB8: file: lib/Convert/Color/RGB8.pm version: 0.10 Convert::Color::VGA: file: lib/Convert/Color/VGA.pm version: 0.10 Convert::Color::X11: file: lib/Convert/Color/X11.pm version: 0.10 requires: List::UtilsBy: 0 Module::Pluggable: 0 resources: license: http://dev.perl.org/licenses/ version: 0.10 Convert-Color-0.10/MANIFEST000444001750001750 125212260143752 14137 0ustar00leoleo000000000000Build.PL Changes examples/gradient.pl examples/html-sample.pl lib/Convert/Color.pm lib/Convert/Color/CMY.pm lib/Convert/Color/CMYK.pm lib/Convert/Color/HSL.pm lib/Convert/Color/HSV.pm lib/Convert/Color/HueChromaBased.pm lib/Convert/Color/RGB.pm lib/Convert/Color/RGB16.pm lib/Convert/Color/RGB8.pm lib/Convert/Color/VGA.pm lib/Convert/Color/X11.pm LICENSE Makefile.PL MANIFEST This list of files META.json META.yml README t/00use.t t/01rgb.t t/02hsv.t t/03hsl.t t/04cmy.t t/05cmyk.t t/11convert-rgb.t t/12convert-hsv.t t/13convert-hsl.t t/14convert-cmy.t t/15convert-cmyk.t t/20magic-const.t t/21rgb-blend.t t/22rgb-dst.t t/23hsv-dst.t t/24hsl-dst.t t/30vga.t t/31x11.t t/99pod.t Convert-Color-0.10/Makefile.PL000444001750001750 65612260143752 14747 0ustar00leoleo000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4202 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Convert::Color', 'VERSION_FROM' => 'lib/Convert/Color.pm', 'PREREQ_PM' => { 'List::UtilsBy' => 0, 'Module::Pluggable' => 0, 'Test::More' => '0.88' }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Convert-Color-0.10/lib000755001750001750 012260143752 13417 5ustar00leoleo000000000000Convert-Color-0.10/lib/Convert000755001750001750 012260143752 15037 5ustar00leoleo000000000000Convert-Color-0.10/lib/Convert/Color.pm000444001750001750 2555312260143752 16642 0ustar00leoleo000000000000# 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-2013 -- leonerd@leonerd.org.uk package Convert::Color; use strict; use warnings; use Carp; use List::UtilsBy qw( min_by ); use Module::Pluggable require => 0, search_path => [ 'Convert::Color' ]; my @plugins = Convert::Color->plugins; our $VERSION = '0.10'; =head1 NAME C - color space conversions and named lookups =head1 SYNOPSIS use Convert::Color; my $color = Convert::Color->new( 'hsv:76,0.43,0.89' ); my ( $red, $green, $blue ) = $color->rgb; # GTK uses 16-bit values my $gtk_col = Gtk2::Gdk::Color->new( $color->as_rgb16->rgb16 ); # HTML uses #rrggbb in hex my $html = ''; =head1 DESCRIPTION This module provides conversions between commonly used ways to express colors. It provides conversions between color spaces such as RGB and HSV, and it provides ways to look up colors by a name. This class provides a base for subclasses which represent particular color values in particular spaces. The base class provides methods to represent the color in a few convenient forms, though subclasses may provide more specific details for the space in question. For more detail, read the documentation on these classes; namely: =over 4 =item * L - red/green/blue as floats between 0 and 1 =item * L - red/green/blue as 8-bit integers =item * L - red/green/blue as 16-bit integers =item * L - hue/saturation/value =item * L - hue/saturation/lightness =item * L - cyan/magenta/yellow =item * L - cyan/magenta/yellow/key (blackness) =back The following classes are subclasses of one of the above, which provide a way to access predefined colors by names: =over 4 =item * L - named lookup for the basic VGA colors =item * L - named lookup of colors from X11's F =back =cut =head1 CONSTRUCTOR =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 ) = @_; 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 ) Return a new value to represent the color specified by the string. This string should be prefixed by the name of the color space to which it applies. For example rgb:RED,GREEN,BLUE rgb8:RRGGBB rgb16:RRRRGGGGBBBB hsv:HUE,SAT,VAL hsl:HUE,SAT,LUM cmy:CYAN,MAGENTA,YELLOW cmyk:CYAN,MAGENTA,YELLOW,KEY vga:NAME vga:INDEX x11:NAME For more detail, see the constructor of the color space subclass in question. =cut sub new { shift; my ( $str ) = @_; $str =~ m/^(\w+):(.*)$/ or croak "Unable to parse color name $str"; ( my $space, $str ) = ( $1, $2 ); my $class = _space2class( $space ) or croak "Unrecognised color space name '$space'"; return $class->new( $str ); } =head1 METHODS =cut =head2 ( $red, $green, $blue ) = $color->rgb Returns the individual red, green and blue color components of the color value. For RGB values, this is done directly. For values in other spaces, this is done by first converting them to an RGB value using their C method. =cut sub rgb { my $self = shift; croak "Abstract method - should be overloaded by ".ref($self); } =head1 COLOR SPACE CONVERSIONS Cross-conversion between color spaces is provided by the C method, assisted by helper methods in the two color space classes involved. When converting C<$color> from color space SRC to color space DEST, the following operations are attemped, in this order. SRC and DEST refer to the names of the color spaces, e.g. C. =over 4 =item 1. If SRC and DEST are equal, return C<$color> as it stands. =item 2. If the SRC space's class provides a C method, use it. =item 3. If the DEST space's class provides a C constructor, call it and pass C<$color>. =item 4. If the DEST space's class provides a C constructor, convert C<$color> to red/green/blue components then call it. =item 5. If none of these operations worked, then throw an exception. =back These functions may be called in the following ways: $other = $color->convert_to_DEST() $other = Dest::Class->new_from_SRC( $color ) $other = Dest::Class->new_rgb( $color->rgb ) =cut =head2 $other = $color->convert_to( $space ) 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 or C methods), then a specific conversion method will be installed in the class. $other = $color->as_$space Methods of this form are currently Ced if they do not yet exist, but this feature should not be relied upon - see below. =cut sub convert_to { my $self = shift; my ( $to_space ) = @_; my $to_class = _space2class( $to_space ) or croak "Unrecognised color space name '$to_space'"; my $from_space = $_class2space_cache{ref $self}; if( $from_space eq $to_space ) { # Identity conversion return $self; } my $code; if( $code = $self->can( "convert_to_$to_space" ) ) { return $code->( $self ); } elsif( $code = $to_class->can( "new_from_$from_space" ) ) { return $code->( $to_class, $self ); } elsif( $code = $to_class->can( "new_rgb" ) ) { # TODO: check that $self->rgb is overloaded return $code->( $to_class, $self->rgb ); } else { croak "Cannot convert from space '$from_space' to space '$to_space'"; } } # Fallback implementations in case subclasses don't provide anything better sub convert_to_rgb { my $self = shift; require Convert::Color::RGB; return Convert::Color::RGB->new( $self->rgb ); } =head1 AUTOLOADED CONVERSION METHODS This class provides C and C behaviour which automatically constructs conversion methods. The following method calls are identical: $color->convert_to('rgb') $color->as_rgb 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. =cut # Since this is AUTOLOADed, we can dynamically provide new methods for classes # discovered at runtime. sub can { my $self = shift; my ( $method ) = @_; if( $method =~ m/^as_(.*)$/ ) { my $to_space = $1; _space2class( $to_space ) or return undef; return sub { my $self = shift; return $self->convert_to( $to_space ); }; } return $self->SUPER::can( $method ); } sub AUTOLOAD { my ( $method ) = our $AUTOLOAD =~ m/::([^:]+)$/; return if $method eq "DESTROY"; 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'; unless( defined &{$method} ) { *{$method} = $code; } goto &$code; } my $class = ref $_[0] || $_[0]; croak qq(Cannot locate object method "$method" via package "$class"); } =head1 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. =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, but will be called only once and the results cached. =back This method creates a new class method on the calling package, called C. =head3 $color = $pkg->closest_to( $orig, $space ) Returns the color in the space closest to the given value. The distance is measured in the named space; defaulting to C if this is not provided. 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}::closest_to"} = sub { my $class = shift; my ( $orig, $space ) = @_; $space ||= "rgb"; $orig = $orig->convert_to( $space ); my $dst = "dst_${space}_cheap"; return min_by { $orig->$dst( $_->convert_to( $space ) ) } $class->$enumerate; }; foreach my $space (qw( rgb hsv hsl )) { *{"${pkg}::new_from_${space}"} = sub { my $class = shift; my ( $rgb ) = @_; return $pkg->closest_to( $rgb, $space ); }; } *{"${pkg}::new_rgb"} = sub { my $class = shift; return $class->closest_to( Convert::Color::RGB->new( @_ ), "rgb" ); }; } =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color000755001750001750 012260143752 16115 5ustar00leoleo000000000000Convert-Color-0.10/lib/Convert/Color/RGB8.pm000444001750001750 1426312260143752 17340 0ustar00leoleo000000000000# 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@leonerd.org.uk package Convert::Color::RGB8; use strict; use warnings; use base qw( Convert::Color ); __PACKAGE__->register_color_space( 'rgb8' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as red/green/blue in 8-bit integers =head1 SYNOPSIS Directly: use Convert::Color::RGB8; my $red = Convert::Color::RGB8->new( 255, 0, 0 ); # Can also parse strings my $pink = Convert::Color::RGB8->new( '255,192,192' ); # or $pink = Convert::Color::RGB8->new( 'ffc0c0' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'rgb8:0,255,255' ); =head1 DESCRIPTION Objects in this class represent a color in RGB space, as a set of three integer values in the range 0 to 255; i.e. as 8 bits. For representations using floating point values, see L. For representations using 16-bit integers, see L. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::RGB8->new( $red, $green, $blue ) Returns a new object to represent the set of values given. These values should be integers between 0 and 255. Values outside of this range will be clamped. =head2 $color = Convert::Color::RGB8->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form red,green,blue containing the three integer values in decimal notation. It can also be given in the form of a hex encoded string, such as would be returned by the C method: rrggbb =cut sub new { my $class = shift; my ( $r, $g, $b ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/ ) { ( $r, $g, $b ) = ( hex( $1 ), hex( $2 ), hex( $3 ) ); } elsif( m/^(\d+),(\d+),(\d+)$/ ) { ( $r, $g, $b ) = ( $1, $2, $3 ); } else { croak "Unrecognised RGB8 string spec '$_'"; } } elsif( @_ == 3 ) { ( $r, $g, $b ) = map int, @_; } else { croak "usage: Convert::Color::RGB8->new( SPEC ) or ->new( R, G, B )"; } # Clamp to the range [0,255] map { $_ < 0 and $_ = 0; $_ > 255 and $_ = 255 } ( $r, $g, $b ); return bless [ $r, $g, $b ], $class; } =head1 METHODS =cut =head2 $r = $color->red =head2 $g = $color->green =head2 $b = $color->blue Accessors for the three components of the color. =cut # Simple accessors sub red { shift->[0] } sub green { shift->[1] } sub blue { shift->[2] } # Conversions sub rgb { my $self = shift; return map { $_ / 255 } @{$self}[0..2]; } sub new_rgb { my $class = shift; return $class->new( map { $_ * 255 } @_ ); } =head2 ( $red, $green, $blue ) = $color->rgb8 Returns the individual red, green and blue color components of the color value in RGB8 space. =cut sub rgb8 { my $self = shift; return $self->red, $self->green, $self->blue; } =head2 $str = $color->hex Returns a string representation of the color components in the RGB8 space, in a convenient C hex string, likely to be useful HTML, or other similar places. =cut sub hex :method { my $self = shift; sprintf "%02x%02x%02x", $self->rgb8; } =head2 $mix = $color->alpha_blend( $other, [ $alpha ] ) Return a new color which is a blended combination of the two passed into it. The optional C<$alpha> parameter defines the mix ratio between the two colors, defaulting to 0.5 if not defined. Values closer to 0 will blend more of C<$color>, closer to 1 will blend more of C<$other>. =cut sub alpha_blend { my $self = shift; my ( $other, $alpha ) = @_; $alpha = 0.5 unless defined $alpha; $alpha = 0 if $alpha < 0; $alpha = 1 if $alpha > 1; my $alphaP = 1 - $alpha; my ( $rA, $gA, $bA ) = $self->rgb8; my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; # Add 0.5 for rounding return __PACKAGE__->new( $rA * $alphaP + $rB * $alpha + 0.5, $gA * $alphaP + $gB * $alpha + 0.5, $bA * $alphaP + $bB * $alpha + 0.5, ); } =head2 $mix = $color->alpha8_blend( $other, [ $alpha ] ) Similar to C but works with integer arithmetic. C<$alpha> should be an integer in the range 0 to 255. =cut sub alpha8_blend { my $self = shift; my ( $other, $alpha ) = @_; $alpha = 127 unless defined $alpha; $alpha = 0 if $alpha < 0; $alpha = 255 if $alpha > 255; $alpha = int $alpha; my $alphaP = 255 - $alpha; my ( $rA, $gA, $bA ) = $self->rgb8; my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; return __PACKAGE__->new( ( $rA * $alphaP + $rB * $alpha ) / 255, ( $gA * $alphaP + $gB * $alpha ) / 255, ( $bA * $alphaP + $bB * $alpha ) / 255, ); } =head2 $measure = $color->dst_rgb8( $other ) Return a measure of the distance between the two colors. This is the unweighted Euclidean distance of the three color components. Two identical colors will have a measure of 0, pure black and pure white have a distance of 1, and all others will lie somewhere inbetween. =cut sub dst_rgb8 { my $self = shift; my ( $other ) = @_; return sqrt( $self->dst_rgb8_cheap( $other ) ) / sqrt(3*255*255); } =head2 $measure = $color->dst_rgb8_cheap( $other ) Return a measure of the distance between the two colors. This is the sum of the squares of the differences of each of the color components. This is part of the value used to calculate C, but since it involves no square root it will be cheaper to calculate, for use in cases where only the relative values matter, such as when picking the "best match" out of a set of colors. It ranges between 0 for identical colours and 3*(255^2) for the distance between pure black and pure white. =cut sub dst_rgb8_cheap { my $self = shift; my ( $other ) = @_; my ( $rA, $gA, $bA ) = $self->rgb8; my ( $rB, $gB, $bB ) = $other->as_rgb8->rgb8; my $dr = $rA - $rB; my $dg = $gA - $gB; my $db = $bA - $bB; return $dr*$dr + $dg*$dg + $db*$db; } =head1 SEE ALSO =over 4 =item * L - color space conversions =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/VGA.pm000444001750001750 540312260143752 17227 0ustar00leoleo000000000000# 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-2011 -- leonerd@leonerd.org.uk package Convert::Color::VGA; use strict; use warnings; use base qw( Convert::Color::RGB ); __PACKAGE__->register_color_space( 'vga' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - named lookup for the basic VGA colors =head1 SYNOPSIS Directly: use Convert::Color::VGA; my $red = Convert::Color::VGA->new( 'red' ); # Can also use index my $black = Convert::Color::VGA->new( 0 ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'vga:cyan' ); =head1 DESCRIPTION This subclass of L provides predefined colors for the 8 basic VGA colors. Their names are black red green yellow blue magenta cyan white They may be looked up either by name, or by numerical index within this list. =cut my %vga_colors = ( black => [ 0, 0, 0 ], red => [ 1, 0, 0 ], green => [ 0, 1, 0 ], yellow => [ 1, 1, 0 ], blue => [ 0, 0, 1 ], magenta => [ 1, 0, 1 ], cyan => [ 0, 1, 1 ], white => [ 1, 1, 1 ], ); # Also indexes my @vga_colors = qw( black red green yellow blue magenta cyan white ); __PACKAGE__->register_palette( enumerate_once => sub { my $class = shift; map { $class->new( $_ ) } @vga_colors; }, ); =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::VGA->new( $name ) Returns a new object to represent the named color. =head2 $color = Convert::Color::VGA->new( $index ) Returns a new object to represent the color at the given index. =cut sub new { my $class = shift; if( @_ == 1 ) { my ( $name, $index ); if( $_[0] =~ m/^\d+$/ ) { $index = $_[0]; $index >= 0 and $index < @vga_colors or croak "No such VGA color at index $index"; $name = $vga_colors[$index]; } else { $name = $_[0]; $vga_colors[$_] eq $name and ( $index = $_, last ) for 0 .. 7; defined $index or croak "No such VGA color named '$name'"; } my $self = $class->SUPER::new( @{ $vga_colors{$name} } ); $self->[3] = $index; return $self; } else { croak "usage: Convert::Color::VGA->new( NAME ) or ->new( INDEX )"; } } =head1 METHODS =cut =head2 $index = $color->index The index of the VGA color. =cut sub index { my $self = shift; return $self->[3]; } =head2 $name = $color->name The name of the VGA color. =cut sub name { my $self = shift; return $vga_colors[$self->index]; } =head1 SEE ALSO =over 4 =item * L - color space conversions =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/HSV.pm000444001750001750 1376612260143752 17305 0ustar00leoleo000000000000# 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-2013 -- leonerd@leonerd.org.uk package Convert::Color::HSV; use strict; use warnings; use base qw( Convert::Color::HueChromaBased ); __PACKAGE__->register_color_space( 'hsv' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as hue/saturation/value =head1 SYNOPSIS Directly: use Convert::Color::HSV; my $red = Convert::Color::HSV->new( 0, 1, 1 ); # Can also parse strings my $pink = Convert::Color::HSV->new( '0,0.7,1' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'hsv:300,1,1' ); =head1 DESCRIPTION Objects in this class represent a color in HSV space, as a set of three floating-point values. Hue is stored as a value in degrees, in the range 0 to 360 (exclusive). Saturation and value are in the range 0 to 1. This color space may be considered as a cylinder, of height and radius 1. Hue represents the position of the color as the angle around the axis, the saturation the distance from the axis, and the value the height above the base. In this shape, the entire base of the cylinder is pure black, the axis through the centre represents the range of greys, and the circumference of the top of the cylinder contains the pure-saturated color wheel, with a pure white point at its centre. Because the entire bottom surface of this cylinder contains black, a closely-related color space can be created by reshaping the cylinder into a cone by contracting the base of the cylinder into a point. The radius from the axis is called the chroma (though this is a different definition of "chroma" than that used by CIE). =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::HSV->new( $hue, $saturation, $value ) Returns a new object to represent the set of values given. The hue should be in the range 0 to 360 (exclusive), and saturation and value should be between 0 and 1. Values outside of these ranges will be clamped. =head2 $color = Convert::Color::HSV->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form hue,saturation,value containing the three floating-point values in decimal notation. =cut sub new { my $class = shift; my ( $h, $s, $v ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) { ( $h, $s, $v ) = ( $1, $2, $3 ); } else { croak "Unrecognised HSV string spec '$_'"; } } elsif( @_ == 3 ) { ( $h, $s, $v ) = @_; } else { croak "usage: Convert::Color::HSV->new( SPEC ) or ->new( H, S, V )"; } # Clamp map { $_ < 0 and $_ = 0; $_ > 1 and $_ = 1 } ( $s, $v ); # Fit to range [0,360) $h += 360 while $h < 0; $h -= 360 while $h >= 360; return bless [ $h, $s, $v ], $class; } =head1 METHODS =cut =head2 $h = $color->hue =head2 $s = $color->saturation =head2 $v = $color->value Accessors for the three components of the color. =cut # Simple accessors sub hue { shift->[0] } sub saturation { shift->[1] } sub value { shift->[2] } =head2 $c = $color->chroma Returns the derived property of "chroma", which maps the color space onto a cone instead of a cylinder. This more closely measures the intuitive concept of how "colorful" the color is than the saturation value and is useful for distance calculations. =cut sub chroma { my $self = shift; return $self->saturation * $self->value; } =head2 ( $hue, $saturation, $value ) = $color->hsv Returns the individual hue, saturation and value components of the color value. =cut sub hsv { my $self = shift; return @$self; } # Conversions sub rgb { my $self = shift; # See also # http://en.wikipedia.org/wiki/HSV_color_space my ( $h, $s, $v ) = $self->hsv; my $hi = int( $h / 60 ); my $f = $h / 60 - $hi; my $p = $v * ( 1 - $s ); my $q = $v * ( 1 - $f * $s ); my $t = $v * ( 1 - ( 1 - $f ) * $s ); my ( $r, $g, $b ); if( $hi == 0 ) { ( $r, $g, $b ) = ( $v, $t, $p ); } elsif( $hi == 1 ) { ( $r, $g, $b ) = ( $q, $v, $p ); } elsif( $hi == 2 ) { ( $r, $g, $b ) = ( $p, $v, $t ); } elsif( $hi == 3 ) { ( $r, $g, $b ) = ( $p, $q, $v ); } elsif( $hi == 4 ) { ( $r, $g, $b ) = ( $t, $p, $v ); } elsif( $hi == 5 ) { ( $r, $g, $b ) = ( $v, $p, $q ); } return ( $r, $g, $b ); } sub new_rgb { my $class = shift; my ( $r, $g, $b ) = @_; my ( $hue, $min, $max ) = $class->_hue_min_max( $r, $g, $b ); return $class->new( $hue, $max == 0 ? 0 : 1 - ( $min / $max ), $max ); } =head2 $measure = $color->dst_hsv( $other ) Returns a measure of the distance between the two colors. This is the Euclidean distance between the two colors as points in the chroma-adjusted cone space. =cut sub dst_hsv { my $self = shift; my ( $other ) = @_; # ... / sqrt(4) return sqrt( $self->dst_hsv_cheap( $other ) ) / 2; } =head2 $measure = $color->dst_hsv_cheap( $other ) Returns a measure of the distance between the two colors. This is used in the calculation of C but since it omits the final square-root and scaling it is cheaper to calculate, for use in cases where only the relative values matter, such as when picking the "best match" out of a set of colors. It ranges between 0 for identical colors and 4 for the distance between complementary pure-saturated colors. =cut sub dst_hsv_cheap { my $self = shift; my ( $other ) = @_; my $dv = $self->value - $other->value; return $self->_huechroma_dst_squ( $other ) + $dv*$dv; } =head1 SEE ALSO =over 4 =item * L - color space conversions =item * L - a color value represented as red/green/blue =item * L - HSL and HSV on Wikipedia =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/RGB16.pm000444001750001750 1436112260143752 17416 0ustar00leoleo000000000000# 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@leonerd.org.uk package Convert::Color::RGB16; use strict; use warnings; use base qw( Convert::Color ); __PACKAGE__->register_color_space( 'rgb16' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as red/green/blue in 16-bit integers =head1 SYNOPSIS Directly: use Convert::Color::RGB16; my $red = Convert::Color::RGB16->new( 65535, 0, 0 ); # Can also parse strings my $pink = Convert::Color::RGB16->new( '65535,49152,49152' ); # or $pink = Convert::Color::RGB16->new( 'ffffc000c000' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'rgb16:0,65535,65535' ); =head1 DESCRIPTION Objects in this class represent a color in RGB space, as a set of three integer values in the range 0 to 65535; i.e. as 16 bits. For representations using floating point values, see L. For representations using 8-bit integers, see L. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::RGB16->new( $red, $green, $blue ) Returns a new object to represent the set of values given. These values should be integers between 0 and 65535. Values outside of this range will be clamped. =head2 $color = Convert::Color::RGB16->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form red,green,blue containing the three integer values in decimal notation. It can also be given in the form of a hex encoded string, such as would be returned by the C method: rrrrggggbbbb =cut sub new { my $class = shift; my ( $r, $g, $b ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^([[:xdigit:]]{4})([[:xdigit:]]{4})([[:xdigit:]]{4})$/ ) { ( $r, $g, $b ) = ( hex( $1 ), hex( $2 ), hex( $3 ) ); } elsif( m/^(\d+),(\d+),(\d+)$/ ) { ( $r, $g, $b ) = ( $1, $2, $3 ); } else { croak "Unrecognised RGB16 string spec '$_'"; } } elsif( @_ == 3 ) { ( $r, $g, $b ) = map int, @_; } else { croak "usage: Convert::Color::RGB16->new( SPEC ) or ->new( R, G, B )"; } # Clamp to the range [0,0xffff] map { $_ < 0 and $_ = 0; $_ > 0xffff and $_ = 0xffff } ( $r, $g, $b ); return bless [ $r, $g, $b ], $class; } =head1 METHODS =cut =head2 $r = $color->red =head2 $g = $color->green =head2 $b = $color->blue Accessors for the three components of the color. =cut # Simple accessors sub red { shift->[0] } sub green { shift->[1] } sub blue { shift->[2] } # Conversions sub rgb { my $self = shift; return map { $_ / 0xffff } @{$self}[0..2]; } sub new_rgb { my $class = shift; return $class->new( map { $_ * 0xffff } @_ ); } =head2 ( $red, $green, $blue ) = $color->rgb16 Returns the individual red, green and blue color components of the color value in RGB16 space. =cut sub rgb16 { my $self = shift; return $self->red, $self->green, $self->blue; } =head2 $str = $color->hex Returns a string representation of the color components in the RGB16 space, in a convenient C hex string. =cut sub hex :method { my $self = shift; sprintf "%04x%04x%04x", $self->rgb16; } =head2 $mix = $color->alpha_blend( $other, [ $alpha ] ) Return a new color which is a blended combination of the two passed into it. The optional C<$alpha> parameter defines the mix ratio between the two colors, defaulting to 0.5 if not defined. Values closer to 0 will blend more of C<$color>, closer to 1 will blend more of C<$other>. =cut sub alpha_blend { my $self = shift; my ( $other, $alpha ) = @_; $alpha = 0.5 unless defined $alpha; $alpha = 0 if $alpha < 0; $alpha = 1 if $alpha > 1; my $alphaP = 1 - $alpha; my ( $rA, $gA, $bA ) = $self->rgb16; my ( $rB, $gB, $bB ) = $other->as_rgb16->rgb16; # Add 0.5 for rounding return __PACKAGE__->new( $rA * $alphaP + $rB * $alpha + 0.5, $gA * $alphaP + $gB * $alpha + 0.5, $bA * $alphaP + $bB * $alpha + 0.5, ); } =head2 $mix = $color->alpha16_blend( $other, [ $alpha ] ) Similar to C but works with integer arithmetic. C<$alpha> should be an integer in the range 0 to 65535. =cut sub alpha16_blend { my $self = shift; my ( $other, $alpha ) = @_; $alpha = 0x7fff unless defined $alpha; $alpha = 0 if $alpha < 0; $alpha = 0xffff if $alpha > 0xffff; $alpha = int $alpha; my $alphaP = 0xffff - $alpha; my ( $rA, $gA, $bA ) = $self->rgb16; my ( $rB, $gB, $bB ) = $other->as_rgb16->rgb16; return __PACKAGE__->new( ( $rA * $alphaP + $rB * $alpha ) / 0xffff, ( $gA * $alphaP + $gB * $alpha ) / 0xffff, ( $bA * $alphaP + $bB * $alpha ) / 0xffff, ); } =head2 $measure = $color->dst_rgb16( $other ) Return a measure of the distance between the two colors. This is the unweighted Euclidean distance of the three color components. Two identical colors will have a measure of 0, pure black and pure white have a distance of 1, and all others will lie somewhere inbetween. =cut sub dst_rgb16 { my $self = shift; my ( $other ) = @_; return sqrt( $self->dst_rgb16_cheap( $other ) ) / sqrt(3*65535*65535); } =head2 $measure = $color->dst_rgb16_cheap( $other ) Return a measure of the distance between the two colors. This is the sum of the squares of the differences of each of the color components. This is part of the value used to calculate C, but since it involves no square root it will be cheaper to calculate, for use in cases where only the relative values matter, such as when picking the "best match" out of a set of colors. It ranges between 0 for identical colours and 3*(65535^2) for the distance between pure black and pure white. =cut sub dst_rgb16_cheap { my $self = shift; my ( $other ) = @_; my ( $rA, $gA, $bA ) = $self->rgb16; my ( $rB, $gB, $bB ) = $other->as_rgb16->rgb16; my $dr = $rA - $rB; my $dg = $gA - $gB; my $db = $bA - $bB; return $dr*$dr + $dg*$dg + $db*$db; } =head1 SEE ALSO =over 4 =item * L - color space conversions =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/HueChromaBased.pm000444001750001750 265012260143752 21425 0ustar00leoleo000000000000# 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@leonerd.org.uk package # hide from CPAN Convert::Color::HueChromaBased; use strict; use warnings; use base qw( Convert::Color ); # For converting degrees to radians # atan2(1,0) == PI/2 use constant PIover180 => atan2(1,0) / 90; # No space name since we're not a complete space use List::Util qw( max min ); # HSV and HSL are related, using some common elements. # See also # http://en.wikipedia.org/wiki/HSV_color_space sub _hue_min_max { my $class = shift; my ( $r, $g, $b ) = @_; my $max = max $r, $g, $b; my $min = min $r, $g, $b; my $hue; if( $max == $min ) { $hue = 0; } elsif( $max == $r ) { $hue = 60 * ( $g - $b ) / ( $max - $min ); } elsif( $max == $g ) { $hue = 60 * ( $b - $r ) / ( $max - $min ) + 120; } elsif( $max == $b ) { $hue = 60 * ( $r - $g ) / ( $max - $min ) + 240; } return ( $hue, $min, $max ); } # Useful for distance calculations - calculates the square of the distance # between two points in polar space sub _huechroma_dst_squ { my ( $col1, $col2 ) = @_; my $r1 = $col1->chroma; my $r2 = $col2->chroma; my $dhue = $col1->hue - $col2->hue; # Square of polar distance return $r1*$r1 + $r2*$r2 - 2*$r1*$r2*cos( $dhue * PIover180 ); } 0x55AA; Convert-Color-0.10/lib/Convert/Color/RGB.pm000444001750001750 1220412260143752 17241 0ustar00leoleo000000000000# 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-2011 -- leonerd@leonerd.org.uk package Convert::Color::RGB; use strict; use warnings; use base qw( Convert::Color ); __PACKAGE__->register_color_space( 'rgb' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as red/green/blue =head1 SYNOPSIS Directly: use Convert::Color::RGB; my $red = Convert::Color::RGB->new( 1, 0, 0 ); # Can also parse strings my $pink = Convert::Color::RGB->new( '1,0.7,0.7' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'rgb:0,1,1' ); =head1 DESCRIPTION Objects in this class represent a color in RGB space, as a set of three floating-point values in the range 0 to 1. For representations using 8- or 16-bit integers, see L and L. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::RGB->new( $red, $green, $blue ) Returns a new object to represent the set of values given. These values should be floating-point numbers between 0 and 1. Values outside of this range will be clamped. =head2 $color = Convert::Color::RGB->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form red,green,blue containing the three floating-point values in decimal notation. =cut sub new { my $class = shift; my ( $r, $g, $b ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) { ( $r, $g, $b ) = ( $1, $2, $3 ); } else { croak "Unrecognised RGB string spec '$_'"; } } elsif( @_ == 3 ) { ( $r, $g, $b ) = @_; } else { croak "usage: Convert::Color::RGB->new( SPEC ) or ->new( R, G, B )"; } # Clamp to the range [0,1] map { $_ < 0 and $_ = 0; $_ > 1 and $_ = 1 } ( $r, $g, $b ); return bless [ $r, $g, $b ], $class; } =head1 METHODS =cut =head2 $r = $color->red =head2 $g = $color->green =head2 $b = $color->blue Accessors for the three components of the color. =cut # Simple accessors sub red { shift->[0] } sub green { shift->[1] } sub blue { shift->[2] } =head2 ( $red, $green, $blue ) = $color->rgb Returns the individual red, green and blue color components of the color value. =cut sub rgb { my $self = shift; return @{$self}[0..2]; } sub new_rgb { my $class = shift; return $class->new( @_ ); } =head2 $mix = $color->alpha_blend( $other, [ $alpha ] ) Return a new color which is a blended combination of the two passed into it. The optional C<$alpha> parameter defines the mix ratio between the two colors, defaulting to 0.5 if not defined. Values closer to 0 will blend more of C<$color>, closer to 1 will blend more of C<$other>. =cut sub alpha_blend { my $self = shift; my ( $other, $alpha ) = @_; $alpha = 0.5 unless defined $alpha; $alpha = 0 if $alpha < 0; $alpha = 1 if $alpha > 1; my $alphaP = 1 - $alpha; my ( $rA, $gA, $bA ) = $self->rgb; my ( $rB, $gB, $bB ) = $other->rgb; return __PACKAGE__->new( $rA * $alphaP + $rB * $alpha, $gA * $alphaP + $gB * $alpha, $bA * $alphaP + $bB * $alpha, ); } =head2 $measure = $color->dst_rgb( $other ) Return a measure of the distance between the two colors. This is the unweighted Euclidean distance of the three color components. Two identical colors will have a measure of 0, pure black and pure white have a distance of 1, and all others will lie somewhere inbetween. =cut sub dst_rgb { my $self = shift; my ( $other ) = @_; return sqrt( $self->dst_rgb_cheap( $other ) ) / sqrt(3); } =head2 $measure = $color->dst_rgb_cheap( $other ) Return a measure of the distance between the two colors. This is the sum of the squares of the differences of each of the color components. This is part of the value used to calculate C, but since it involves no square root it will be cheaper to calculate, for use in cases where only the relative values matter, such as when picking the "best match" out of a set of colors. It ranges between 0 for identical colours and 3 for the distance between pure black and pure white. =cut sub dst_rgb_cheap { my $self = shift; my ( $other ) = @_; my ( $rA, $gA, $bA ) = $self->rgb; my ( $rB, $gB, $bB ) = $other->rgb; my $dr = $rA - $rB; my $dg = $gA - $gB; my $db = $bA - $bB; return $dr*$dr + $dg*$dg + $db*$db; } =head1 EXAMPLES =head2 Generating Gradients The C method can be used to generate a smooth gradient between two colours. use Convert::Color; my $blue = Convert::Color->new("vga:blue"); my $cyan = Convert::Color->new("vga:cyan"); say $blue->alpha_blend( $cyan, $_/10 )->as_rgb8->hex for 0 .. 10 =head1 SEE ALSO =over 4 =item * L - color space conversions =item * L - a color value represented as hue/saturation/value =item * L - a color value represented as hue/saturation/lightness =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/CMYK.pm000444001750001750 764412260143752 17366 0ustar00leoleo000000000000# 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@leonerd.org.uk package Convert::Color::CMYK; use strict; use warnings; use base qw( Convert::Color ); __PACKAGE__->register_color_space( 'cmyk' ); use List::Util qw( min ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as cyan/magenta/yellow/key =head1 SYNOPSIS Directly: use Convert::Color::CMYK; my $red = Convert::Color::CMYK->new( 0, 1, 1, 0 ); # Can also parse strings my $pink = Convert::Color::CMYK->new( '0,0.3,0.3,0' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'cmyk:1,0,0,0' ); =head1 DESCRIPTION Objects in this class represent a color in CMYK space, as a set of four floating-point values in the range 0 to 1. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::CMYK->new( $cyan, $magenta, $yellow, $key ) Returns a new object to represent the set of values given. These values should be floating-point numbers between 0 and 1. Values outside of this range will be clamped. =head2 $color = Convert::Color::CMYK->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form cyan,magenta,yellow,key containing the three floating-point values in decimal notation. =cut sub new { my $class = shift; my ( $c, $m, $y, $k ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) { ( $c, $m, $y, $k ) = ( $1, $2, $3, $4 ); } else { croak "Unrecognised CMYK string spec '$_'"; } } elsif( @_ == 4 ) { ( $c, $m, $y, $k ) = @_; } else { croak "usage: Convert::Color::CMYK->new( SPEC ) or ->new( C, M, Y, K )"; } # Clamp map { $_ < 0 and $_ = 0; $_ > 1 and $_ = 1 } ( $c, $m, $y, $k ); return bless [ $c, $m, $y, $k ], $class; } =head1 METHODS =cut =head2 $c = $color->cyan =head2 $m = $color->magenta =head2 $y = $color->yellow =head2 $k = $color->key Accessors for the four components of the color. =cut # Simple accessors sub cyan { shift->[0] } sub magenta { shift->[1] } sub yellow { shift->[2] } sub key { shift->[3] } =head2 $k = $color->black An alias to C =cut *black = \&key; # alias =head2 ( $cyan, $magenta, $yellow, $key ) = $color->cmyk Returns the individual cyan, magenta, yellow and key components of the color value. =cut sub cmyk { my $self = shift; return @$self; } # Conversions sub cmy { my $self = shift; if( $self->key == 1 ) { # Pure black return ( 1, 1, 1 ); } my $k = $self->key; my $w = 1 - $k; return ( ($self->cyan * $w) + $k, ($self->magenta * $w) + $k, ($self->yellow * $w) + $k ); } sub rgb { my $self = shift; my ( $c, $m, $y ) = $self->cmy; return ( 1 - $c, 1 - $m, 1 - $y ); } sub new_cmy { my $class = shift; my ( $c, $m, $y ) = @_; my $k = min( $c, $m, $y ); if( $k == 1 ) { # Pure black return $class->new( 0, 0, 0, 1 ); } else { # Rescale other components around key my $w = 1 - $k; # whiteness return $class->new( ($c - $k) / $w, ($m - $k) / $w, ($y - $k) / $w, $k ); } } sub new_rgb { my $class = shift; my ( $r, $g, $b ) = @_; return $class->new_cmy( 1-$r, 1-$g, 1-$b ); } sub convert_to_cmy { my $self = shift; require Convert::Color::CMY; return Convert::Color::CMY->new( $self->cmy ); } sub new_from_cmy { my $class = shift; my ( $cmy ) = @_; return $class->new_cmy( $cmy->cyan, $cmy->magenta, $cmy->yellow ); } =head1 SEE ALSO =over 4 =item * L - color space conversions =item * L - a color value represented as cyan/magenta/yellow =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/X11.pm000444001750001750 553612260143752 17172 0ustar00leoleo000000000000# 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-2011 -- leonerd@leonerd.org.uk package Convert::Color::X11; use strict; use warnings; use base qw( Convert::Color::RGB8 ); __PACKAGE__->register_color_space( 'x11' ); use Carp; our $VERSION = '0.10'; # Different systems put it in different places. We'll try all of them taking # the first we find our @RGB_TXT = ( '/etc/X11/rgb.txt', '/usr/share/X11/rgb.txt', '/usr/X11R6/lib/X11/rgb.txt', ); =head1 NAME C - named lookup of colors from X11's F =head1 SYNOPSIS Directly: use Convert::Color::X11; my $red = Convert::Color::X11->new( 'red' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'x11:cyan' ); =head1 DESCRIPTION This subclass of L provides lookup of color names provided by X11's F file. =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 =cut =head2 @colors = Convert::Color::X11->colors Returns a list of the defined color names, in the order they were found in the F file. =head2 $num_colors = Convert::Color::X11->colors When called in scalar context, this method returns the count of the number of defined colors. =cut sub colors { my $class = shift; $x11_colors or _load_x11_colors; return @x11_color_names; } __PACKAGE__->register_palette( enumerate => sub { my $class = shift; map { $class->new( $_ ) } $class->colors; }, ); =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::X11->new( $name ) Returns a new object to represent the named color. =cut sub new { my $class = shift; if( @_ == 1 ) { my $name = $_[0]; $x11_colors or _load_x11_colors; my $color = $x11_colors->{$name} or croak "No such X11 color named '$name'"; my $self = $class->SUPER::new( @$color ); $self->[3] = $name; return $self; } else { croak "usage: Convert::Color::X11->new( NAME )"; } } =head1 METHODS =cut =head2 $name = $color->name The name of the VGA color. =cut sub name { my $self = shift; return $self->[3]; } =head1 SEE ALSO =over 4 =item * L - color space conversions =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/CMY.pm000444001750001750 563412260143752 17250 0ustar00leoleo000000000000# 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@leonerd.org.uk package Convert::Color::CMY; use strict; use warnings; use base qw( Convert::Color ); __PACKAGE__->register_color_space( 'cmy' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as cyan/magenta/yellow =head1 SYNOPSIS Directly: use Convert::Color::CMY; my $red = Convert::Color::CMY->new( 0, 1, 1 ); # Can also parse strings my $pink = Convert::Color::CMY->new( '0,0.3,0.3' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'cmy:1,0,0' ); =head1 DESCRIPTION Objects in this class represent a color in CMY space, as a set of three floating-point values in the range 0 to 1. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::CMY->new( $cyan, $magenta, $yellow ) Returns a new object to represent the set of values given. These values should be floating-point numbers between 0 and 1. Values outside of this range will be clamped. =head2 $color = Convert::Color::CMY->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form cyan,magenta,yellow containing the three floating-point values in decimal notation. =cut sub new { my $class = shift; my ( $c, $m, $y ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) { ( $c, $m, $y ) = ( $1, $2, $3 ); } else { croak "Unrecognised CMY string spec '$_'"; } } elsif( @_ == 3 ) { ( $c, $m, $y ) = @_; } else { croak "usage: Convert::Color::CMY->new( SPEC ) or ->new( C, M, Y )"; } # Clamp map { $_ < 0 and $_ = 0; $_ > 1 and $_ = 1 } ( $c, $m, $y ); return bless [ $c, $m, $y ], $class; } =head1 METHODS =cut =head2 $c = $color->cyan =head2 $m = $color->magenta =head2 $y = $color->yellow Accessors for the three components of the color. =cut # Simple accessors sub cyan { shift->[0] } sub magenta { shift->[1] } sub yellow { shift->[2] } =head2 ( $cyan, $magenta, $yellow ) = $color->cmy Returns the individual cyan, magenta and yellow color components of the color value. =cut sub cmy { my $self = shift; return @$self; } # Conversions sub rgb { my $self = shift; return 1 - $self->cyan, 1 - $self->magenta, 1 - $self->yellow; } sub new_rgb { my $class = shift; my ( $r, $g, $b ) = @_; $class->new( 1 - $r, 1 - $g, 1 - $b ); } =head1 SEE ALSO =over 4 =item * L - color space conversions =item * L - a color value represented as red/green/blue =item * L - a color value represented as cyan/magenta/yellow/key =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/lib/Convert/Color/HSL.pm000444001750001750 1466312260143752 17270 0ustar00leoleo000000000000# 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-2013 -- leonerd@leonerd.org.uk package Convert::Color::HSL; use strict; use warnings; use base qw( Convert::Color::HueChromaBased ); __PACKAGE__->register_color_space( 'hsl' ); use Carp; our $VERSION = '0.10'; =head1 NAME C - a color value represented as hue/saturation/lightness =head1 SYNOPSIS Directly: use Convert::Color::HSL; my $red = Convert::Color::HSL->new( 0, 1, 0.5 ); # Can also parse strings my $pink = Convert::Color::HSL->new( '0,1,0.8' ); Via L: use Convert::Color; my $cyan = Convert::Color->new( 'hsl:300,1,0.5' ); =head1 DESCRIPTION Objects in this class represent a color in HSL space, as a set of three floating-point values. Hue is stored as a value in degrees, in the range 0 to 360 (exclusive). Saturation and lightness are in the range 0 to 1. This color space may be considered as a cylinder, of height and radius 1. Hue represents the position of the color as the angle around the axis, the saturation as the distance from the axis, and the lightness the height above the base. In this shape, the entire base of the cylinder is pure black, the axis through the centre represents the range of greys, and the entire top of the cylinder is pure white. The circumference of the circular cross-section midway along the axis contains the pure-saturated color wheel. Because both surfaces of this cylinder contain pure black or white discs, a closely-related color space can be created by reshaping the cylinder into a bi-cone such that the top and bottom of the cylinder become single points. The radius from the axis of this shape is called the chroma (though this is a different definition of "chroma" than that used by CIE). While the components of this space are called Hue-Chroma-Lightness, it should not be confused with the similarly-named Hue-Chroma-Luminance (HCL) space. =cut =head1 CONSTRUCTOR =cut =head2 $color = Convert::Color::HSL->new( $hue, $saturation, $lightness ) Returns a new object to represent the set of values given. The hue should be in the range 0 to 360 (exclusive), and saturation and lightness should be between 0 and 1. Values outside of these ranges will be clamped. =head2 $color = Convert::Color::HSL->new( $string ) Parses C<$string> for values, and construct a new object similar to the above three-argument form. The string should be in the form hue,saturation,lightnes containing the three floating-point values in decimal notation. =cut sub new { my $class = shift; my ( $h, $s, $l ); if( @_ == 1 ) { local $_ = $_[0]; if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) { ( $h, $s, $l ) = ( $1, $2, $3 ); } else { croak "Unrecognised HSL string spec '$_'"; } } elsif( @_ == 3 ) { ( $h, $s, $l ) = @_; } else { croak "usage: Convert::Color::HSL->new( SPEC ) or ->new( H, S, L )"; } # Clamp map { $_ < 0 and $_ = 0; $_ > 1 and $_ = 1 } ( $s, $l ); # Fit to range [0,360) $h += 360 while $h < 0; $h -= 360 while $h >= 360; return bless [ $h, $s, $l ], $class; } =head1 METHODS =cut =head2 $h = $color->hue =head2 $s = $color->saturation =head2 $v = $color->lightness Accessors for the three components of the color. =cut # Simple accessors sub hue { shift->[0] } sub saturation { shift->[1] } sub lightness { shift->[2] } =head2 $c = $color->chroma Returns the derived property of "chroma", which maps the color space onto a bicone instead of a cylinder. This more closely measures the intuitive concept of how "colorful" the color is than the saturation value and is useful for distance calculations. =cut sub chroma { my $self = shift; my ( undef, $s, $l ) = $self->hsl; if( $l > 0.5 ) { # upper bicone return 2 * $s * ( $l - 1 ); } else { # lower bicone return 2 * $s * $l; } } =head2 ( $hue, $saturation, $lightness ) = $color->hsl Returns the individual hue, saturation and lightness components of the color value. =cut sub hsl { my $self = shift; return @$self; } # Conversions sub rgb { my $self = shift; # See also # http://en.wikipedia.org/wiki/HSV_color_space my ( $h, $s, $l ) = $self->hsl; my $q = $l < 0.5 ? $l * ( 1 + $s ) : $l + $s - ( $l * $s ); my $p = 2 * $l - $q; # Modify the algorithm slightly, so we scale this up by 6 my $hk = $h / 60; my $tr = $hk + 2; my $tg = $hk; my $tb = $hk - 2; map { $_ += 6 while $_ < 0; $_ -= 6 while $_ > 6; } ( $tr, $tg, $tb ); return map { $_ < 1 ? $p + ( ( $q - $p ) * $_ ) : $_ < 3 ? $q : $_ < 4 ? $p + ( ( $q - $p ) * ( 4 - $_ ) ) : $p } ( $tr, $tg, $tb ); } sub new_rgb { my $class = shift; my ( $r, $g, $b ) = @_; my ( $hue, $min, $max ) = $class->_hue_min_max( $r, $g, $b ); my $l = ( $max + $min ) / 2; my $s = $min == $max ? 0 : $l <= 1/2 ? ( $max - $min ) / ( 2 * $l ) : ( $max - $min ) / ( 2 - 2 * $l ); return $class->new( $hue, $s, $l ); } =head2 $measure = $color->dst_hsl( $other ) Returns a measure of the distance between the two colors. This is the Euclidean distance between the two colors as points in the chroma-adjusted cone space. =cut sub dst_hsl { my $self = shift; my ( $other ) = @_; # ... / sqrt(4) return sqrt( $self->dst_hsl_cheap( $other ) ) / 2; } =head2 $measure = $color->dst_hsl_cheap( $other ) Returns a measure of the distance between the two colors. This is used in the calculation of C but since it omits the final square-root and scaling it is cheaper to calculate, for use in cases where only the relative values matter, such as when picking the "best match" out of a set of colors. It ranges between 0 for identical colors and 4 for the distance between complementary pure-saturated colors. =cut sub dst_hsl_cheap { my $self = shift; my ( $other ) = @_; my $dl = $self->lightness - $other->lightness; return $self->_huechroma_dst_squ( $other ) + $dl*$dl; } =head1 SEE ALSO =over 4 =item * L - color space conversions =item * L - a color value represented as red/green/blue =item * L - HSL and HSV on Wikipedia =back =head1 AUTHOR Paul Evans =cut 0x55AA; Convert-Color-0.10/examples000755001750001750 012260143752 14467 5ustar00leoleo000000000000Convert-Color-0.10/examples/gradient.pl000444001750001750 173112260143752 16760 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Convert::Color; use Getopt::Long; my $steps = 10; my $space = "hsv"; my $html; GetOptions( 'number|n=i' => \$steps, 'space=s' => \$space, 'html' => \$html, ) or exit 1; my $as_space = "as_$space"; my @start = Convert::Color->new( shift @ARGV || die "No start colour\n" )->$as_space->$space; my @end = Convert::Color->new( shift @ARGV || die "No end colour\n" )->$as_space->$space; print qq[\n] if $html; foreach ( 0 .. $steps ) { my $alpha = $_ / $steps; my $col = Convert::Color->new( "$space:" . join ",", map { (1-$alpha) * $start[$_] + $alpha * $end[$_] } 0 .. 2 ); my $rgb = $col->as_rgb8; if( $html ) { my $hex = $rgb->hex; printf qq[\n], $hex, $hex; } else { printf "%s h: %3s, s: %3s, v: %3s\n", $rgb->hex, $col->hue, $col->saturation, $col->value; } } print qq[
#%s
\n] if $html; Convert-Color-0.10/examples/html-sample.pl000444001750001750 437612260143752 17416 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use Convert::Color; use Getopt::Long; print < EOF my @COL; sub span { my ( $text, $col ) = @_; my $hex = $col->as_rgb8->hex; if( $col->as_hsl->lightness < 0.5 ) { return qq{$text}; } else { return qq{$text}; } } my $SORT = 0; GetOptions( 's|sort+' => \$SORT, ) or exit(1); while( my $colname = shift @ARGV ) { if( $colname eq "x11:*" ) { require Convert::Color::X11; unshift @ARGV, map { "x11:$_" } sort Convert::Color::X11->colors; next; } my $col = Convert::Color->new( $colname ); my $c_rgb8 = $col->as_rgb8; my $rgb8_hex = $c_rgb8->hex; my ( $r, $g, $b ) = $c_rgb8->rgb8; my $rgb = join ",", span( sprintf('%03d',$r), Convert::Color::RGB8->new( $r, 0, 0 ) ), span( sprintf('%03d',$g), Convert::Color::RGB8->new( 0, $g, 0 ) ), span( sprintf('%03d',$b), Convert::Color::RGB8->new( 0, 0, $b ) ); my $c_hsl = $col->as_hsl; my ( $hue, $sat, $lig ) = $c_hsl->hsl; my $hsl = join ",", ( $sat <= 0.0001 ? span( "---", Convert::Color::HSL->new( 0, 0, 0.5 ) ) : span( sprintf('%.1f',$hue), Convert::Color::HSL->new( $hue, 1, 0.5 ) ) ), span( sprintf('%0.3f',$sat), Convert::Color::HSL->new( $hue, $sat, 0.5 ) ), span( sprintf('%0.3f',$lig), Convert::Color::HSL->new( 0, 0, $lig ) ); my $c_cmyk = $col->as_cmyk; my ( $c, $m, $y, $k ) = $c_cmyk->cmyk; my $cmyk = join ",", span( sprintf('%0.3f',$c), Convert::Color::CMY->new( $c, 0, 0 ) ), span( sprintf('%0.3f',$m), Convert::Color::CMY->new( 0, $m, 0 ) ), span( sprintf('%0.3f',$y), Convert::Color::CMY->new( 0, 0, $y ) ), span( sprintf('%0.3f',$k), Convert::Color::CMYK->new( 0, 0, 0, $k ) ); push @COL, [ ( $sat <= 0.0001 ? $lig - 2 : $hue ), <<"EOF" ]; EOF } if( $SORT ) { @COL = sort { $a->[0] <=> $b->[0] } @COL; } print map { $_->[1] } @COL; print < EOF Convert-Color-0.10/t000755001750001750 012260143752 13114 5ustar00leoleo000000000000Convert-Color-0.10/t/12convert-hsv.t000444001750001750 220412260143752 16055 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSV; my $red = Convert::Color::HSV->new( 0, 1, 1 ); my $red_rgb = $red->convert_to("rgb"); is( $red_rgb->red, 1, 'red red' ); is( $red_rgb->green, 0, 'red green' ); is( $red_rgb->blue, 0, 'red blue' ); my $green = Convert::Color::HSV->new( 120, 1, 1 ); my $green_rgb = $green->convert_to("rgb"); is( $green_rgb->red, 0, 'green red' ); is( $green_rgb->green, 1, 'green green' ); is( $green_rgb->blue, 0, 'green blue' ); my $blue = Convert::Color::HSV->new( 240, 1, 1 ); my $blue_rgb = $blue->convert_to("rgb"); is( $blue_rgb->red, 0, 'blue red' ); is( $blue_rgb->green, 0, 'blue green' ); is( $blue_rgb->blue, 1, 'blue blue' ); my $white = Convert::Color::HSV->new( 0, 0, 1 ); my $white_rgb = $white->as_rgb; is( $white_rgb->red, 1, 'white red' ); is( $white_rgb->green, 1, 'white green' ); is( $white_rgb->blue, 1, 'white blue' ); my $black = Convert::Color::HSV->new( 0, 0, 0 ); my $black_rgb = $black->as_rgb; is( $black_rgb->red, 0, 'black red' ); is( $black_rgb->green, 0, 'black green' ); is( $black_rgb->blue, 0, 'black blue' ); done_testing; Convert-Color-0.10/t/05cmyk.t000444001750001750 302612260143752 14547 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::CMYK; my $red = Convert::Color::CMYK->new( 0, 1, 1, 0 ); is( $red->cyan, 0, 'red cyan' ); is( $red->magenta, 1, 'red magenta' ); is( $red->yellow, 1, 'red yellow' ); is( $red->key, 0, 'red key' ); is_deeply( [ $red->cmyk ], [ 0, 1, 1, 0 ], 'red cmyk' ); my $green = Convert::Color::CMYK->new( 1, 0, 1, 0 ); is( $green->cyan, 1, 'green cyan' ); is( $green->magenta, 0, 'green magenta' ); is( $green->yellow, 1, 'green yellow' ); is( $green->key, 0, 'green key' ); is_deeply( [ $green->cmyk ], [ 1, 0, 1, 0 ], 'green cmyk' ); my $blue = Convert::Color::CMYK->new( 1, 1, 0, 0 ); is( $blue->cyan, 1, 'blue cyan' ); is( $blue->magenta, 1, 'blue magenta' ); is( $blue->yellow, 0, 'blue yellow' ); is( $blue->key, 0, 'blue key' ); is_deeply( [ $blue->cmyk ], [ 1, 1, 0, 0 ], 'blue cmyk' ); my $yellow = Convert::Color::CMYK->new( '0,0,1,0' ); is( $yellow->cyan, 0, 'yellow cyan' ); is( $yellow->magenta, 0, 'yellow magenta' ); is( $yellow->yellow, 1, 'yellow yellow' ); is( $yellow->key, 0, 'yellow key' ); is_deeply( [ $yellow->cmyk ], [ 0, 0, 1, 0 ], 'yellow cmyk' ); # So far none of these colours have any key; we'll do black just to check my $black = Convert::Color::CMYK->new( '0,0,0,1' ); is( $black->cyan, 0, 'black cyan' ); is( $black->magenta, 0, 'black magenta' ); is( $black->yellow, 0, 'black yellow' ); is( $black->key, 1, 'black key' ); is_deeply( [ $black->cmyk ], [ 0, 0, 0, 1 ], 'black cmyk' ); done_testing; Convert-Color-0.10/t/22rgb-dst.t000444001750001750 702512260143752 15150 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; 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' ); done_testing; Convert-Color-0.10/t/13convert-hsl.t000444001750001750 221212260143752 16043 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSL; my $red = Convert::Color::HSL->new( 0, 1, 0.5 ); my $red_rgb = $red->convert_to("rgb"); is( $red_rgb->red, 1, 'red red' ); is( $red_rgb->green, 0, 'red green' ); is( $red_rgb->blue, 0, 'red blue' ); my $green = Convert::Color::HSL->new( 120, 1, 0.5 ); my $green_rgb = $green->convert_to("rgb"); is( $green_rgb->red, 0, 'green red' ); is( $green_rgb->green, 1, 'green green' ); is( $green_rgb->blue, 0, 'green blue' ); my $blue = Convert::Color::HSL->new( 240, 1, 0.5 ); my $blue_rgb = $blue->convert_to("rgb"); is( $blue_rgb->red, 0, 'blue red' ); is( $blue_rgb->green, 0, 'blue green' ); is( $blue_rgb->blue, 1, 'blue blue' ); my $white = Convert::Color::HSL->new( 0, 0, 1 ); my $white_rgb = $white->as_rgb; is( $white_rgb->red, 1, 'white red' ); is( $white_rgb->green, 1, 'white green' ); is( $white_rgb->blue, 1, 'white blue' ); my $black = Convert::Color::HSL->new( 0, 0, 0 ); my $black_rgb = $black->as_rgb; is( $black_rgb->red, 0, 'black red' ); is( $black_rgb->green, 0, 'black green' ); is( $black_rgb->blue, 0, 'black blue' ); done_testing; Convert-Color-0.10/t/00use.t000444001750001750 46712260143752 14361 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use_ok( 'Convert::Color::RGB' ); use_ok( 'Convert::Color::RGB8' ); use_ok( 'Convert::Color::RGB16' ); use_ok( 'Convert::Color::HSV' ); use_ok( 'Convert::Color::HSL' ); use_ok( 'Convert::Color::CMY' ); use_ok( 'Convert::Color::CMYK' ); done_testing; Convert-Color-0.10/t/31x11.t000444001750001750 222212260143752 14211 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::X11; use Convert::Color::RGB8; unless( eval { Convert::Color::X11->colors; 1 } ) { import Test::More skip_all => "Cannot load X11 rgb.txt database"; } ok( Convert::Color::X11->colors > 0, 'colors is > 0' ); my $red = Convert::Color::X11->new( 'red' ); is( $red->red, 255, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); is( $red->name, "red", 'red name' ); is_deeply( [ $red->as_rgb8->rgb8 ], [ 255, 0, 0 ], 'red as_rgb8' ); my $green = Convert::Color->new( 'x11:green' ); is( $green->red, 0, 'green red' ); is( $green->green, 255, 'green green' ); is( $green->blue, 0, 'green blue' ); is( $green->name, "green", 'green name' ); my $white = Convert::Color::RGB8->new( 255, 255, 255 )->as_x11; # It's not quite guaranteed that this is "white", as some rgb.txt files might # contain other names with the same value, such as "Gray100" # https://rt.cpan.org/Ticket/Display.html?id=66544 isa_ok( $white, "Convert::Color::X11", '$white' ); is_deeply( [ $white->as_rgb8->rgb8 ], [ 255, 255, 255 ], 'white as_rgb8' ); done_testing; Convert-Color-0.10/t/14convert-cmy.t000444001750001750 305512260143752 16054 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::CMY; my $red = Convert::Color::CMY->new( 0, 1, 1 ); my $red_rgb = $red->convert_to("rgb"); is( $red_rgb->red, 1, 'red red' ); is( $red_rgb->green, 0, 'red green' ); is( $red_rgb->blue, 0, 'red blue' ); my $red_cmyk = $red->convert_to("cmyk"); is( $red_cmyk->cyan, 0, 'red cyan' ); is( $red_cmyk->magenta, 1, 'red magenta' ); is( $red_cmyk->yellow, 1, 'red yellow' ); is( $red_cmyk->key, 0, 'red key' ); my $green = Convert::Color::CMY->new( 1, 0, 1 ); my $green_rgb = $green->convert_to("rgb"); is( $green_rgb->red, 0, 'green red' ); is( $green_rgb->green, 1, 'green green' ); is( $green_rgb->blue, 0, 'green blue' ); my $blue = Convert::Color::CMY->new( 1, 1, 0 ); my $blue_rgb = $blue->convert_to("rgb"); is( $blue_rgb->red, 0, 'blue red' ); is( $blue_rgb->green, 0, 'blue green' ); is( $blue_rgb->blue, 1, 'blue blue' ); my $white = Convert::Color::CMY->new( 0, 0, 0 ); my $white_rgb = $white->as_rgb; is( $white_rgb->red, 1, 'white red' ); is( $white_rgb->green, 1, 'white green' ); is( $white_rgb->blue, 1, 'white blue' ); my $black = Convert::Color::CMY->new( 1, 1, 1 ); my $black_rgb = $black->as_rgb; is( $black_rgb->red, 0, 'black red' ); is( $black_rgb->green, 0, 'black green' ); is( $black_rgb->blue, 0, 'black blue' ); my $black_cmyk = $black->as_cmyk; is( $black_cmyk->cyan, 0, 'black cyan' ); is( $black_cmyk->magenta, 0, 'black magenta' ); is( $black_cmyk->yellow, 0, 'black yellow' ); is( $black_cmyk->key, 1, 'black key' ); done_testing; Convert-Color-0.10/t/21rgb-blend.t000444001750001750 613012260143752 15435 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; 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' ); done_testing; Convert-Color-0.10/t/23hsv-dst.t000444001750001750 254112260143752 15175 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSV; my $black = Convert::Color::HSV->new( 0, 1, 0 ); my $white = Convert::Color::HSV->new( 0, 0, 1 ); my $red = Convert::Color::HSV->new( 0, 1, 1 ); my $green = Convert::Color::HSV->new( 120, 1, 1 ); my $cyan = Convert::Color::HSV->new( 180, 1, 1 ); my $blue = Convert::Color::HSV->new( 240, 1, 1 ); sub about { my ( $got, $expect, $name ) = @_; ok( abs( $got - $expect ) < 0.000001, $name ) or diag( "got $got, expected $expect" ); } is( $black->dst_hsv( $black ), 0, 'black->dst_hsv black' ); about( $black->dst_hsv( $red ), 1/sqrt(2), 'black->dst_hsv red' ); about( $black->dst_hsv( $green ), 1/sqrt(2), 'black->dst_hsv green' ); about( $black->dst_hsv( $blue ), 1/sqrt(2), 'black->dst_hsv blue' ); about( $black->dst_hsv( $white ), 1/2, 'black->dst_hsv white' ); is( $red->dst_hsv( $cyan ), 1, 'red->dst_hsv cyan' ); is( $black->dst_hsv_cheap( $black ), 0, 'black->dst_hsv_cheap black' ); is( $black->dst_hsv_cheap( $red ), 2, 'black->dst_hsv_cheap red' ); is( $black->dst_hsv_cheap( $green ), 2, 'black->dst_hsv_cheap green' ); is( $black->dst_hsv_cheap( $blue ), 2, 'black->dst_hsv_cheap blue' ); is( $black->dst_hsv_cheap( $white ), 1, 'black->dst_hsv_cheap white' ); is( $red->dst_hsv_cheap( $cyan ), 4, 'red->dst_hsv_cheap cyan' ); done_testing; Convert-Color-0.10/t/01rgb.t000444001750001750 636312260143752 14361 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::RGB; use Convert::Color::RGB8; use Convert::Color::RGB16; my $red = Convert::Color::RGB->new( 1, 0, 0 ); is( $red->red, 1, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); is_deeply( [ $red->rgb ], [ 1, 0, 0 ], 'red rgb' ); is_deeply( [ $red->as_rgb8->rgb8 ], [ 255, 0, 0 ], 'red rgb8' ); is_deeply( [ $red->as_rgb16->rgb16 ], [ 0xffff, 0, 0 ], 'red rgb16' ); is( $red->as_rgb8->hex, 'ff0000', 'red rgb8 hex' ); is( $red->as_rgb16->hex, 'ffff00000000', 'red rgb16 hex' ); my $green = Convert::Color::RGB->new( 0, 1, 0 ); is( $green->red, 0, 'green red' ); is( $green->green, 1, 'green green' ); is( $green->blue, 0, 'green blue' ); is_deeply( [ $green->rgb ], [ 0, 1, 0 ], 'green rgb' ); is_deeply( [ $green->as_rgb8->rgb8 ], [ 0, 255, 0 ], 'green rgb8' ); is_deeply( [ $green->as_rgb16->rgb16 ], [ 0, 0xffff, 0 ], 'green rgb16' ); is( $green->as_rgb8->hex, '00ff00', 'green rgb8_hex' ); is( $green->as_rgb16->hex, '0000ffff0000', 'green rgb16_hex' ); my $blue = Convert::Color::RGB->new( 0, 0, 1 ); is( $blue->red, 0, 'blue red' ); is( $blue->green, 0, 'blue green' ); is( $blue->blue, 1, 'blue blue' ); is_deeply( [ $blue->rgb ], [ 0, 0, 1 ], 'blue rgb' ); is_deeply( [ $blue->as_rgb8->rgb8 ], [ 0, 0, 255 ], 'blue rgb8' ); is_deeply( [ $blue->as_rgb16->rgb16 ], [ 0, 0, 0xffff ], 'blue rgb16' ); is( $blue->as_rgb8->hex, '0000ff', 'blue rgb8_hex' ); is( $blue->as_rgb16->hex, '00000000ffff', 'blue rgb16_hex' ); my $yellow = Convert::Color::RGB8->new( 'ffff00' ); is( $yellow->red, 255, 'yellow red' ); is( $yellow->green, 255, 'yellow green' ); is( $yellow->blue, 0, 'yellow blue' ); is_deeply( [ $yellow->rgb ], [ 1, 1, 0 ], 'yellow rgb' ); is_deeply( [ $yellow->as_rgb8->rgb8 ], [ 255, 255, 0 ], 'yellow rgb8' ); is_deeply( [ $yellow->as_rgb16->rgb16 ], [ 0xffff, 0xffff, 0 ], 'yellow rgb16' ); is( $yellow->as_rgb8->hex, 'ffff00', 'yellow rgb8_hex' ); is( $yellow->as_rgb16->hex, 'ffffffff0000', 'yellow rgb16_hex' ); my $cyan = Convert::Color::RGB16->new( '0000ffffffff' ); is( $cyan->red, 0, 'cyan red' ); is( $cyan->green, 0xffff, 'cyan green' ); is( $cyan->blue, 0xffff, 'cyan blue' ); is_deeply( [ $cyan->rgb ], [ 0, 1, 1 ], 'cyan rgb' ); is_deeply( [ $cyan->as_rgb8->rgb8 ], [ 0, 255, 255 ], 'cyan rgb8' ); is_deeply( [ $cyan->as_rgb16->rgb16 ], [ 0, 0xffff, 0xffff ], 'cyan rgb16' ); is( $cyan->as_rgb8->hex, '00ffff', 'cyan rgb8_hex' ); is( $cyan->as_rgb16->hex, '0000ffffffff', 'cyan rgb16_hex' ); my $grey = Convert::Color::RGB->new( '0.5,0.5,0.5' ); is( $grey->red, 0.5, 'grey red' ); is( $grey->green, 0.5, 'grey green' ); is( $grey->blue, 0.5, 'grey blue' ); is_deeply( [ $grey->rgb ], [ 0.5, 0.5, 0.5 ], 'grey rgb' ); is_deeply( [ $grey->as_rgb8->rgb8 ], [ 127, 127, 127 ], 'grey rgb8' ); is_deeply( [ $grey->as_rgb16->rgb16 ], [ 0x7fff, 0x7fff, 0x7fff ], 'grey rgb16' ); is( $grey->as_rgb8->hex, '7f7f7f', 'grey rgb8_hex' ); is( $grey->as_rgb16->hex, '7fff7fff7fff', 'grey rgb16_hex' ); my $grey_2 = $grey->as_rgb; isa_ok( $grey_2, 'Convert::Color::RGB', '->rgb (identity) conversion' ); is( $grey_2->red, 0.5, 'grey_2 red' ); is( $grey_2->green, 0.5, 'grey_2 green' ); is( $grey_2->blue, 0.5, 'grey_2 blue' ); done_testing; Convert-Color-0.10/t/11convert-rgb.t000444001750001750 1111512260143752 16047 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::RGB; my $red = Convert::Color::RGB->new( 1, 0, 0 ); my $red_rgb8 = $red->convert_to("rgb8"); is( $red_rgb8->red, 255, 'red RGB8 red' ); is( $red_rgb8->green, 0, 'red RGB8 green' ); is( $red_rgb8->blue, 0, 'red RGB8 blue' ); my $red_hsv = $red->convert_to("hsv"); is( $red_hsv->hue, 0, 'red HSV hue' ); is( $red_hsv->saturation, 1, 'red HSV saturation' ); is( $red_hsv->value, 1, 'red HSV value' ); my $red_hsl = $red->convert_to("hsl"); is( $red_hsl->hue, 0, 'red HSL hue' ); is( $red_hsl->saturation, 1, 'red HSL saturation' ); is( $red_hsl->lightness, 0.5, 'red HSL lightness' ); my $red_cmy = $red->convert_to("cmy"); is( $red_cmy->cyan, 0, 'red CMY cyan' ); is( $red_cmy->magenta, 1, 'red CMY magenta' ); is( $red_cmy->yellow, 1, 'red CMY yellow' ); my $red_cmyk = $red->convert_to("cmyk"); is( $red_cmyk->cyan, 0, 'red CMYK cyan' ); is( $red_cmyk->magenta, 1, 'red CMYK magenta' ); is( $red_cmyk->yellow, 1, 'red CMYK yellow' ); is( $red_cmyk->key, 0, 'red CMYK key' ); my $green = Convert::Color::RGB->new( 0, 1, 0 ); my $green_hsv = $green->convert_to("hsv"); is( $green_hsv->hue, 120, 'green HSV hue' ); is( $green_hsv->saturation, 1, 'green HSV saturation' ); is( $green_hsv->value, 1, 'green HSV value' ); my $green_hsl = $green->convert_to("hsl"); is( $green_hsl->hue, 120, 'green HSL hue' ); is( $green_hsl->saturation, 1, 'green HSL saturation' ); is( $green_hsl->lightness, 0.5, 'green HSL lightness' ); my $green_cmy = $green->convert_to("cmy"); is( $green_cmy->cyan, 1, 'green CMY cyan' ); is( $green_cmy->magenta, 0, 'green CMY magenta' ); is( $green_cmy->yellow, 1, 'green CMY yellow' ); my $green_cmyk = $green->convert_to("cmyk"); is( $green_cmyk->cyan, 1, 'green CMYK cyan' ); is( $green_cmyk->magenta, 0, 'green CMYK magenta' ); is( $green_cmyk->yellow, 1, 'green CMYK yellow' ); is( $green_cmyk->key, 0, 'green CMYK key' ); my $blue = Convert::Color::RGB->new( 0, 0, 1 ); my $blue_hsv = $blue->convert_to("hsv"); is( $blue_hsv->hue, 240, 'blue HSV hue' ); is( $blue_hsv->saturation, 1, 'blue HSV saturation' ); is( $blue_hsv->value, 1, 'blue HSV value' ); my $blue_hsl = $blue->convert_to("hsl"); is( $blue_hsl->hue, 240, 'blue HSL hue' ); is( $blue_hsl->saturation, 1, 'blue HSL saturation' ); is( $blue_hsl->lightness, 0.5, 'blue HSL lightness' ); my $blue_cmy = $blue->convert_to("cmy"); is( $blue_cmy->cyan, 1, 'blue CMY cyan' ); is( $blue_cmy->magenta, 1, 'blue CMY magenta' ); is( $blue_cmy->yellow, 0, 'blue CMY yellow' ); my $blue_cmyk = $blue->convert_to("cmyk"); is( $blue_cmyk->cyan, 1, 'blue CMYK cyan' ); is( $blue_cmyk->magenta, 1, 'blue CMYK magenta' ); is( $blue_cmyk->yellow, 0, 'blue CMYK yellow' ); is( $blue_cmyk->key, 0, 'blue CMYK key' ); my $white = Convert::Color::RGB->new( 1, 1, 1 ); my $white_hsv = $white->as_hsv; is( $white_hsv->hue, 0, 'white HSV hue' ); is( $white_hsv->saturation, 0, 'white HSV saturation' ); is( $white_hsv->value, 1, 'white HSV value' ); my $white_hsl = $white->as_hsl; is( $white_hsl->hue, 0, 'white HSL hue' ); is( $white_hsl->saturation, 0, 'white HSL saturation' ); is( $white_hsl->lightness, 1, 'white HSL lightness' ); my $white_cmy = $white->as_cmy; is( $white_cmy->cyan, 0, 'white CMY cyan' ); is( $white_cmy->magenta, 0, 'white CMY magenta' ); is( $white_cmy->yellow, 0, 'white CMY yellow' ); my $white_cmyk = $white->convert_to("cmyk"); is( $white_cmyk->cyan, 0, 'white CMYK cyan' ); is( $white_cmyk->magenta, 0, 'white CMYK magenta' ); is( $white_cmyk->yellow, 0, 'white CMYK yellow' ); is( $white_cmyk->key, 0, 'white CMYK key' ); my $black = Convert::Color::RGB->new( 0, 0, 0 ); my $black_hsv = $black->as_hsv; is( $black_hsv->hue, 0, 'black HSV hue' ); is( $black_hsv->saturation, 0, 'black HSV saturation' ); is( $black_hsv->value, 0, 'black HSV value' ); my $black_hsl = $black->as_hsl; is( $black_hsl->hue, 0, 'black HSL hue' ); is( $black_hsl->saturation, 0, 'black HSL saturation' ); is( $black_hsl->lightness, 0, 'black HSL lightness' ); my $black_cmy = $black->as_cmy; is( $black_cmy->cyan, 1, 'black CMY cyan' ); is( $black_cmy->magenta, 1, 'black CMY magenta' ); is( $black_cmy->yellow, 1, 'black CMY yellow' ); my $black_cmyk = $black->convert_to("cmyk"); is( $black_cmyk->cyan, 0, 'black CMYK cyan' ); is( $black_cmyk->magenta, 0, 'black CMYK magenta' ); is( $black_cmyk->yellow, 0, 'black CMYK yellow' ); is( $black_cmyk->key, 1, 'black CMYK key' ); done_testing; Convert-Color-0.10/t/30vga.t000444001750001750 201712260143752 14356 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::VGA; use Convert::Color::RGB; use Convert::Color::RGB8; my $red = Convert::Color::VGA->new( 'red' ); is( $red->red, 1, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); is( $red->name, "red", 'red name' ); is( $red->index, 1, 'red index' ); is_deeply( [ $red->as_rgb8->rgb8 ], [ 255, 0, 0 ], 'red as_rgb8' ); my $green = Convert::Color::VGA->new( 2 ); is( $green->red, 0, 'green red' ); is( $green->green, 1, 'green green' ); is( $green->blue, 0, 'green blue' ); is( $green->name, "green", 'green name' ); is( $green->index, 2, 'green index' ); my $blue = Convert::Color->new( 'vga:blue' ); 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, 1, 'best red index' ); done_testing; Convert-Color-0.10/t/20magic-const.t000444001750001750 314112260143752 16003 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color; my $red = Convert::Color->new( 'rgb:1,0,0' ); isa_ok( $red, 'Convert::Color::RGB' ); is( $red->red, 1, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); $red = Convert::Color->new( 'rgb8:255,0,0' ); isa_ok( $red, 'Convert::Color::RGB8' ); is( $red->red, 255, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); $red = Convert::Color->new( 'rgb16:65535,0,0' ); isa_ok( $red, 'Convert::Color::RGB16' ); is( $red->red, 65535, 'red red' ); is( $red->green, 0, 'red green' ); is( $red->blue, 0, 'red blue' ); my $green = Convert::Color->new( 'hsv:120,1,1' ); isa_ok( $green, 'Convert::Color::HSV' ); is( $green->hue, 120, 'green hue' ); is( $green->saturation, 1, 'green saturation' ); is( $green->value, 1, 'green value' ); my $blue = Convert::Color->new( 'hsl:240,1,0.5' ); isa_ok( $blue, 'Convert::Color::HSL' ); is( $blue->hue, 240, 'blue hue' ); is( $blue->saturation, 1, 'blue saturation' ); is( $blue->lightness, 0.5, 'blue lightness' ); my $yellow = Convert::Color->new( 'cmy:0,0,1' ); isa_ok( $yellow, 'Convert::Color::CMY' ); is( $yellow->cyan, 0, 'yellow cyan' ); is( $yellow->magenta, 0, 'yellow magenta' ); is( $yellow->yellow, 1, 'yellow yellow' ); my $cyan = Convert::Color->new( 'cmyk:1,0,0,0' ); isa_ok( $cyan, 'Convert::Color::CMYK' ); is( $cyan->cyan, 1, 'cyan cyan' ); is( $cyan->magenta, 0, 'cyan magenta' ); is( $cyan->yellow, 0, 'cyan yellow' ); is( $cyan->key, 0, 'cyan key' ); done_testing; Convert-Color-0.10/t/03hsl.t000444001750001750 335712260143752 14377 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSL; my $red = Convert::Color::HSL->new( 0, 1, 0.5 ); is( $red->hue, 0, 'red hue' ); is( $red->saturation, 1, 'red saturation' ); is( $red->lightness, 0.5, 'red lightness' ); is( $red->chroma, 1, 'red chroma' ); is_deeply( [ $red->hsl ], [ 0, 1, 0.5 ], 'red hsl' ); my $green = Convert::Color::HSL->new( 120, 1, 0.5 ); is( $green->hue, 120, 'green hue' ); is( $green->saturation, 1, 'green saturation' ); is( $green->lightness, 0.5, 'green lightness' ); is( $green->chroma, 1, 'green chroma' ); is_deeply( [ $green->hsl ], [ 120, 1, 0.5 ], 'green hsl' ); my $blue = Convert::Color::HSL->new( 240, 1, 0.5 ); is( $blue->hue, 240, 'blue hue' ); is( $blue->saturation, 1, 'blue saturation' ); is( $blue->lightness, 0.5, 'blue lightness' ); is( $blue->chroma, 1, 'blue chroma' ); is_deeply( [ $blue->hsl ], [ 240, 1, 0.5 ], 'blue hsl' ); my $yellow = Convert::Color::HSL->new( '60,1,0.5' ); is( $yellow->hue, 60, 'yellow hue' ); is( $yellow->saturation, 1, 'yellow saturation' ); is( $yellow->lightness, 0.5, 'yellow lightness' ); is( $yellow->chroma, 1, 'yellow chroma' ); is_deeply( [ $yellow->hsl ], [ 60, 1, 0.5 ], 'yellow hsl' ); # "black" is anything at value 0 my $black = Convert::Color::HSL->new( '0,1,0' ); is( $black->saturation, 1, 'black saturation' ); is( $black->lightness, 0, 'black lightness' ); is( $black->chroma, 0, 'black chroma' ); # "white" is anything at value 1 my $white = Convert::Color::HSL->new( '0,1,1' ); is( $white->saturation, 1, 'white saturation' ); is( $white->lightness, 1, 'white lightness' ); is( $white->chroma, 0, 'white chroma' ); done_testing; Convert-Color-0.10/t/02hsv.t000444001750001750 336112260143752 14403 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSV; my $red = Convert::Color::HSV->new( 0, 1, 1 ); is( $red->hue, 0, 'red hue' ); is( $red->saturation, 1, 'red saturation' ); is( $red->value, 1, 'red value' ); is( $red->chroma, 1, 'red chroma' ); is_deeply( [ $red->hsv ], [ 0, 1, 1 ], 'red hsv' ); my $green = Convert::Color::HSV->new( 120, 1, 1 ); is( $green->hue, 120, 'green hue' ); is( $green->saturation, 1, 'green saturation' ); is( $green->value, 1, 'green value' ); is( $green->chroma, 1, 'green chroma' ); is_deeply( [ $green->hsv ], [ 120, 1, 1 ], 'green hsv' ); my $blue = Convert::Color::HSV->new( 240, 1, 1 ); is( $blue->hue, 240, 'blue hue' ); is( $blue->saturation, 1, 'blue saturation' ); is( $blue->value, 1, 'blue value' ); is( $blue->chroma, 1, 'blue chroma' ); is_deeply( [ $blue->hsv ], [ 240, 1, 1 ], 'blue hsv' ); my $yellow = Convert::Color::HSV->new( '60,1,1' ); is( $yellow->hue, 60, 'yellow hue' ); is( $yellow->saturation, 1, 'yellow saturation' ); is( $yellow->value, 1, 'yellow value' ); is( $yellow->chroma, 1, 'yellow chroma' ); is_deeply( [ $yellow->hsv ], [ 60, 1, 1 ], 'yellow hsv' ); # "black" is anything at value 0 my $black = Convert::Color::HSV->new( '0,1,0' ); is( $black->saturation, 1, 'black saturation' ); is( $black->value, 0, 'black value' ); is( $black->chroma, 0, 'black chroma' ); my $bluegrey = Convert::Color::HSV->new( '240,1,0.5' ); is( $bluegrey->hue, 240, 'bluegrey hue' ); is( $bluegrey->saturation, 1, 'bluegrey saturation' ); is( $bluegrey->value, 0.5, 'bluegrey value' ); is( $bluegrey->chroma, 0.5, 'bluegrey chroma' ); done_testing; Convert-Color-0.10/t/99pod.t000444001750001750 25712260143752 14366 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Convert-Color-0.10/t/04cmy.t000444001750001750 176712260143752 14405 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::CMY; my $red = Convert::Color::CMY->new( 0, 1, 1 ); is( $red->cyan, 0, 'red cyan' ); is( $red->magenta, 1, 'red magenta' ); is( $red->yellow, 1, 'red yellow' ); is_deeply( [ $red->cmy ], [ 0, 1, 1 ], 'red cmy' ); my $green = Convert::Color::CMY->new( 1, 0, 1 ); is( $green->cyan, 1, 'green cyan' ); is( $green->magenta, 0, 'green magenta' ); is( $green->yellow, 1, 'green yellow' ); is_deeply( [ $green->cmy ], [ 1, 0, 1 ], 'green cmy' ); my $blue = Convert::Color::CMY->new( 1, 1, 0 ); is( $blue->cyan, 1, 'blue cyan' ); is( $blue->magenta, 1, 'blue magenta' ); is( $blue->yellow, 0, 'blue yellow' ); is_deeply( [ $blue->cmy ], [ 1, 1, 0 ], 'blue cmy' ); my $yellow = Convert::Color::CMY->new( '0,0,1' ); is( $yellow->cyan, 0, 'yellow cyan' ); is( $yellow->magenta, 0, 'yellow magenta' ); is( $yellow->yellow, 1, 'yellow yellow' ); is_deeply( [ $yellow->cmy ], [ 0, 0, 1 ], 'yellow cmy' ); done_testing; Convert-Color-0.10/t/15convert-cmyk.t000444001750001750 274412260143752 16234 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::CMYK; my $red = Convert::Color::CMYK->new( 0, 1, 1, 0 ); my $red_rgb = $red->convert_to("rgb"); is( $red_rgb->red, 1, 'red red' ); is( $red_rgb->green, 0, 'red green' ); is( $red_rgb->blue, 0, 'red blue' ); my $red_cmy = $red->convert_to("cmy"); is( $red_cmy->cyan, 0, 'red cyan' ); is( $red_cmy->magenta, 1, 'red magenta' ); is( $red_cmy->yellow, 1, 'red yellow' ); my $green = Convert::Color::CMYK->new( 1, 0, 1, 0 ); my $green_rgb = $green->convert_to("rgb"); is( $green_rgb->red, 0, 'green red' ); is( $green_rgb->green, 1, 'green green' ); is( $green_rgb->blue, 0, 'green blue' ); my $blue = Convert::Color::CMYK->new( 1, 1, 0, 0 ); my $blue_rgb = $blue->convert_to("rgb"); is( $blue_rgb->red, 0, 'blue red' ); is( $blue_rgb->green, 0, 'blue green' ); is( $blue_rgb->blue, 1, 'blue blue' ); my $white = Convert::Color::CMYK->new( 0, 0, 0, 0 ); my $white_rgb = $white->as_rgb; is( $white_rgb->red, 1, 'white red' ); is( $white_rgb->green, 1, 'white green' ); is( $white_rgb->blue, 1, 'white blue' ); my $black = Convert::Color::CMYK->new( 0, 0, 0, 1 ); my $black_rgb = $black->as_rgb; is( $black_rgb->red, 0, 'black red' ); is( $black_rgb->green, 0, 'black green' ); is( $black_rgb->blue, 0, 'black blue' ); my $black_cmy = $black->as_cmy; is( $black_cmy->cyan, 1, 'black cyan' ); is( $black_cmy->magenta, 1, 'black magenta' ); is( $black_cmy->yellow, 1, 'black yellow' ); done_testing; Convert-Color-0.10/t/24hsl-dst.t000444001750001750 257312260143752 15171 0ustar00leoleo000000000000#!/usr/bin/perl use strict; use warnings; use Test::More; use Convert::Color::HSL; my $black = Convert::Color::HSL->new( 0, 1, 0 ); my $white = Convert::Color::HSL->new( 0, 1, 1 ); my $red = Convert::Color::HSL->new( 0, 1, 0.5 ); my $green = Convert::Color::HSL->new( 120, 1, 0.5 ); my $cyan = Convert::Color::HSL->new( 180, 1, 0.5 ); my $blue = Convert::Color::HSL->new( 240, 1, 0.5 ); sub about { my ( $got, $expect, $name ) = @_; ok( abs( $got - $expect ) < 0.000001, $name ) or diag( "got $got, expected $expect" ); } is( $black->dst_hsl( $black ), 0, 'black->dst_hsl black' ); about( $black->dst_hsl( $red ), sqrt(1.25/4), 'black->dst_hsl red' ); about( $black->dst_hsl( $green ), sqrt(1.25/4), 'black->dst_hsl green' ); about( $black->dst_hsl( $blue ), sqrt(1.25/4), 'black->dst_hsl blue' ); about( $black->dst_hsl( $white ), 0.5, 'black->dst_hsl white' ); is( $red->dst_hsl( $cyan ), 1, 'red->dst_hsl cyan' ); is( $black->dst_hsl_cheap( $black ), 0, 'black->dst_hsl_cheap black' ); is( $black->dst_hsl_cheap( $red ), 1.25, 'black->dst_hsl_cheap red' ); is( $black->dst_hsl_cheap( $green ), 1.25, 'black->dst_hsl_cheap green' ); is( $black->dst_hsl_cheap( $blue ), 1.25, 'black->dst_hsl_cheap blue' ); is( $black->dst_hsl_cheap( $white ), 1, 'black->dst_hsl_cheap white' ); is( $red->dst_hsl_cheap( $cyan ), 4, 'red->dst_hsl_cheap cyan' ); done_testing;
NameRGBHSLCMYK
$colname   $rgb$hsl$cmyk