Graphics-Toolkit-Color-1.71000755001750001750 014503102425 16146 5ustar00herbertherbert000000000000README100644001750001750 4231214503102425 17131 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71NAME Graphics::Toolkit::Color - color palette constructor SYNOPSIS use Graphics::Toolkit::Color qw/color/; my $red = Graphics::Toolkit::Color->new('red'); # create color object say $red->add( 'blue' => 255 )->name; # add blue value: 'fuchsia' my $blue = color( 0, 0, 255)->values('HSL'); # 240, 100, 50 = blue $blue->blend( with => [HSL => 0,0,80], pos => 0.1);# mix blue with a little grey in HSL $red->gradient( to => '#0000FF', steps => 10); # 10 colors from red to blue $red->complement( 3 ); # get fitting red green and blue DESCRIPTION ATTENTION: deprecated methods of the old API ( *string*, *rgb*, *red*, *green*, *blue*, *rgb_hex*, *rgb_hash*, *hsl*, *hue*, *saturation*, *lightness*, *hsl_hash*, *blend_with*, *gradient_to*, *rgb_gradient_to*, *hsl_gradient_to*, *complementary*) will be removed on version 2.0. Graphics::Toolkit::Color, for short GTC, is the top level API of this module and the only one a regular user should be concerned with. Its main purpose is the creation of sets of related colors, such as gradients, complements and others. GTC are read only color holding objects with no additional dependencies. Create them in many different ways (see section "CONSTRUCTOR"). Access its values via methods from section "GETTER". Measure differences with the *distance* method. "SINGLE-COLOR" methods create one a object that is related to the current one and "COLOR-SETS" methods will create a host of color that are not only related to the current color but also have relations between each other. While this module can understand and output color values in many spaces, such as YIQ, HSL and many more, RGB is the (internal) primal one, because GTC is about colors that can be shown on the screen, and these are usually encoded in RGB. Humans access colors on hardware level (eye) in RGB, on cognition level in HSL (brain) and on cultural level (language) with names. Having easy access to all three and some color math should enable you to get the color palette you desire quickly. CONSTRUCTOR There are many options to create a color objects. In short you can either use the name of a constant or provide values in one of several "COLOR-SPACES" in Graphics::Toolkit::Color::Space::Hub, which also can be formatted in many ways as described in this paragraph. new('name') Get a color by providing a name from the X11, HTML (CSS) or SVG standard or a Pantone report. UPPER or CamelCase will be normalized to lower case and inserted underscore letters ('_') will be ignored as perl does in numbers (1_000 == 1000). All available names are listed under "NAMES" in Graphics::Toolkit::Color::Name::Constant. (See also: "name") my $color = Graphics::Toolkit::Color->new('Emerald'); my @names = Graphics::Toolkit::Color::Name::all(); # select from these new('scheme:color') Get a color by name from a specific scheme or standard as provided by an external module Graphics::ColorNames::* , which has to be installed separately. * is a placeholder for the pallet name, which might be: Crayola, CSS, EmergyC, GrayScale, HTML, IE, Mozilla, Netscape, Pantone, PantoneReport, SVG, VACCC, Werner, Windows, WWW or X. In ladder case Graphics::ColorNames::X has to be installed. You can get them all at once via Bundle::Graphics::ColorNames. The color name will be normalized as above. my $color = Graphics::Toolkit::Color->new('SVG:green'); my @s = Graphics::ColorNames::all_schemes(); # look up the installed new('#rgb') Color definitions in hexadecimal format as widely used in the web, are also acceptable. my $color = Graphics::Toolkit::Color->new('#FF0000'); my $color = Graphics::Toolkit::Color->new('#f00'); # works too new( [$r, $g, $b] ) Triplet of integer RGB values (red, green and blue : 0 .. 255). Out of range values will be corrected to the closest value in range. my $red = Graphics::Toolkit::Color->new( 255, 0, 0 ); my $red = Graphics::Toolkit::Color->new([255, 0, 0]); # does the same my $red = Graphics::Toolkit::Color->new('RGB' => 255, 0, 0); # named tuple syntax my $red = Graphics::Toolkit::Color->new(['RGB' => 255, 0, 0]); # named ARRAY The named array syntax of the last example, as any here following, work for any supported color space. new({ r => $r, g => $g, b => $b }) Hash with the keys 'r', 'g' and 'b' does the same as shown in previous paragraph, only more declarative. Casing of the keys will be normalised and only the first letter of each key is significant. my $red = Graphics::Toolkit::Color->new( r => 255, g => 0, b => 0 ); my $red = Graphics::Toolkit::Color->new({r => 255, g => 0, b => 0}); # works too ... ->new( Red => 255, Green => 0, Blue => 0); # also fine ... ->new( Hue => 0, Saturation => 100, Lightness => 50 ); # same color ... ->new( Hue => 0, whiteness => 0, blackness => 0 ); # still the same new('rgb: $r, $g, $b') String format (good for serialisation) that maximizes readability. my $red = Graphics::Toolkit::Color->new( 'rgb: 255, 0, 0' ); my $blue = Graphics::Toolkit::Color->new( 'HSV: 240, 100, 100' ); new('rgb($r,$g,$b)') Variant of string format that is supported by CSS. my $red = Graphics::Toolkit::Color->new( 'rgb(255, 0, 0)' ); my $blue = Graphics::Toolkit::Color->new( 'hsv(240, 100, 100)' ); color If writing Graphics::Toolkit::Color->new( ...); is too much typing for you or takes to much space, import the subroutine "color", which takes all the same arguments as described above. use Graphics::Toolkit::Color qw/color/; my $green = color('green'); my $darkblue = color([20, 20, 250]); GETTER giving access to different parts of the objects data. name String with normalized name (lower case without *'_'*) of the color as in X11 or HTML (SVG) standard or the Pantone report. The name will be found and filled in, even when the object was created numerical values. If no color is found, "name" returns an empty string. All names are at: "NAMES" in Graphics::Toolkit::Color::Name::Constant (See als: "new('name')") values Returns the values of the color in given color space and format. It accepts three named, optional arguments. First argument is the name of a color space (named argument "in"). All options are under: "COLOR-SPACES" in Graphics::Toolkit::Color::Space::Hub The order of named arguments is of course chosen by the user, but I call it the first (most important) argument, because if you give the method only one value, it is assumed to be the color space. Second argument is the format (name: "as"). In short any SCALAR format acceptable to the "CONSTRUCTOR" can also be reproduced by a getter method and the numerical cases by this one. Not all formats are available under all color spaces, but the always present options are: "list" (default), "hash", "char_hash" and "array". Third named argument is the range inside which the numerical values have to be. RGB are normally between 0 .. 255 and CMYK between 0 .. 1 ('normal'). Only a range of 1 a.k.a. 'normal' displays decimals. There are three syntax option to set the ranges. One value will be understood as upper limit of all dimensions and zero being the lower one. If you want to set the upper limits of all dimensions separately, you have to deliver an ARRAY ref with the 3 or 4 upper limits. To also define the lower boundary, you replace the number with an ARRAY ref containing the lower and then the upper limit. $blue->values(); # get list in RGB: 0, 0, 255 $blue->values( in => 'RGB', as => 'list'); # same call $blue->values( in => 'RGB', as => 'hash'); # { red => 0, green => 0, blue => 255} $blue->values( in => 'RGB', as => 'char_hash');# { r => 0, g => 0, b => 255} $blue->values( in => 'RGB', as => 'hex'); # '#00FFFF' $color->values('HSL'); # 240, 100, 50 $color->values( in => 'HSL', range => 1); # 0.6666, 1, 0.5 $color->values( in => 'RGB', range => 2**16); # values in RGB16 $color->values( in => 'HSB', as => 'hash')->{'hue'}; # how to get single values ($color->values( 'HSB'))[0]; # same, but shorter distance Is a floating point number that measures the Euclidean distance between two colors. One color is the calling object itself and the second (C2) has to provided as a named argument (*to*), which is the only required one. It ca come in the form of a second GTC object or any scalar color definition *new* would accept. The *distance* is measured in HSL color space unless told otherwise by the argument *in*. The third argument is named *metric*. It's useful if you want to notice only certain dimensions. Metric is the long or short name of that dimension or the short names of several dimensions. They all have to come from one color space and one shortcut letter can be used several times to heighten the weight of this dimension. The last argument in named *range* and is a range definition, unless you don't want to compute the distance with the default ranges of the selected color space. my $d = $blue->distance( to => 'lapisblue' ); # how close is blue to lapis color? $d = $blue->distance( to => 'airyblue', in => 'RGB', select => 'Blue'); # same amount of blue? $d = $color->distance( to => $c2, in => 'HSL', select => 'hue' ); # same hue? # compute distance when with all value ranges 0 .. 1 $d = $color->distance( to => $c2, in => 'HSL', select => 'hue', range => 'normal' ); SINGLE COLOR construct colors that are related to the current object. set Create a new object that differs in certain values defined in the arguments as a hash. $black->set( blue => 255 )->name; # blue, same as #0000ff $blue->set( saturation => 50 ); # pale blue, same as $blue->set( s => 50 ); add Create a Graphics::Toolkit::Color object, by adding any RGB or HSL values to current color. (Same rules apply for key names as in new - values can be negative.) RGB and HSL can be combined, but please note that RGB are applied first. If the first argument is a Graphics::Toolkit::Color object, than RGB values will be added. In that case an optional second argument is a factor (default = 1), by which the RGB values will be multiplied before being added. Negative values of that factor lead to darkening of result colors, but its not subtractive color mixing, since this module does not support CMY color space. All RGB operations follow the logic of additive mixing, and the result will be rounded (clamped), to keep it inside the defined RGB space. my $blue = Graphics::Toolkit::Color->new('blue'); my $darkblue = $blue->add( Lightness => -25 ); my $blue2 = $blue->add( blue => 10 ); # this is bluer than blue blend Create a Graphics::Toolkit::Color object, that has the average values between the calling object (color 1 - C1) and another color (C2). It takes three named arguments, only the first is required. 1. The color C2 (scalar that is acceptable by the constructor: object, string, ARRAY, HASH). The name of the argument is *with* (color is blended with ...). 2. Blend position is a floating point number, which defaults to 0.5. (blending ratio of 1:1 ). 0 represents here C1 and 1 is pure C2. Numbers below 0 and above 1 are possible, butlikely to be clamped to fit inside the color space. Name of the argument is *pos*. 3. Color space name (default is *HSL* - all can be seen unter "COLOR-SPACES" in Graphics::Toolkit::Color::Space::Hub). Name of the argument is *in*. # a little more silver than $color in the mix $color->blend( with => 'silver', pos => 0.6 ); $color->blend({ with => 'silver', pos => 0.6 }); # works too! $blue->blend( with => {H => 240, S =>100, L => 50}, in => 'RGB' ); # teal COLOR SETS construct many interrelated color objects at once. gradient Creates a gradient (a list of colors that build a transition) between current (C1) and a second, given color (C2) by named argument *to*. The only required argument you have to give under the name *to* is C2. Either as an Graphics::Toolkit::Color object or a scalar (name, hex, HASH or ARRAY), which is acceptable to a "CONSTRUCTOR". This is the same behaviour as in "distance". An optional argument under the name *steps* sets the number of colors, which make up the gradient (including C1 and C2). It defaults to 3. Negative numbers will be rectified by "abs". These 3 color objects: C1, C2 and a color in between, which is the same as the result of method "blend". Another optional argument under the name *dynamic* is a float number, that defines the position of weight in the color transition from C1 to C2. It defaults to zero which gives you a linear transition, meaning the "distance" between neighbouring colors in the gradient is equal. If $dynamic > 0, the weight is moved toward C1 and vice versa. The greater $dynamic, the slower the color change is in the beginning of the gradient and the faster at the end (C2). The last optional argument named *in* defines the color space the changes are computed in. It parallels the argument of the same name from the method "blend" and "distance". # we turn to grey my @colors = $c->gradient( to => $grey, steps => 5, in => 'RGB'); # none linear gradient in HSL space : @colors = $c1->gradient( to =>[14,10,222], steps => 10, dynamic => 3 ); complement Creates a set of complementary colors, which will be computed in *HSL* color space. It accepts 4 optional, named arguments. Complementary colors have a different *hue* value but same *saturation* and *lightness*. Because they form a circle in HSL, they will be called in this paragraph a circle. If you provide no names (just a single argument), the value is understood as *steps*. *steps* is the amount (count) of complementary colors, which defaults to 1 (giving you then THE complementary color). If more than one color is requested, the result will contain the calling object as the first color. The second optional argument is *hue_tilt*, in short *h*, which defaults to zero. When zero, the hue distance between all resulting colors on the circle is the same. When not zero, the *hue_tilt* gets added (see "add") to THE complementary color. The so computed color divides the circle in a shorter and longer part. Both of these parts will now contain an equal amount of result colors. The distribution will be computed in a way, that there will be a place on the circle where the distance between colors is the highest (let's call it Dmax) and one where it is the lowest (Dmin). The distance between two colors increases or decreases steadily. When *hue_tilt* is zero, the axis through Dmax and Dmin and the axis through $self and C2 are orthogonal. The third optional argument *saturation_tilt*, or short *s*, which also defaults to zero. If the value differs from zero it gets added the color on Dmax (last paragraph), subtracted on Dmin, changed accordingly in between, so that the circle gets moved in direction Dmin. If you want to move the circle in any other direction you have to give *saturation_tilt* a HASH reference with 2 keys. First is *saturation* or *s*, which is the value as described. Secondly *hue* or *h* rotates the direction in which the circle will be moved. Please not, this will not change the position of Dmin and Dmax, because it just defines the angle between the Dmin-Dmax axis and the direction where the circle is moved. The fourth optional argument is *lightness_tilt* or *l*m which works analogously to *saturation_tilt*. Only difference is that it tilts the circle in the up-down direction, which is in HSL color space lightness. my @colors = $c->complement( 4 ); # $self + 3 compementary (square) colors my @colors = $c->complement( steps => 3, s => 20, l => -10 ); my @colors = $c->complement( steps => 3, hue_tilt => -40, saturation_tilt => {saturation => 300, hue => -50}, lightness_tilt => {l => -10, hue => 30} ); SEE ALSO * Color::Scheme * Graphics::ColorUtils * Color::Fade * Graphics::Color * Graphics::ColorObject * Color::Calc * Convert::Color * Color::Similarity COPYRIGHT & LICENSE Copyright 2022-2023 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. AUTHOR Herbert Breunung, Changes100644001750001750 1041014503102425 17536 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.711.71 2023-09-21 lichtkind ------- * = doc fixes * ? typos mispellings, boken sentence * ? added range def explanation * ? simplified HEADINGS * ? removed doc of deprecated methods 1.70 2023-09-20 lichtkind ------- * = mid level improvements, completed API change * + changed method complement to named arguments * + none linear complement circles by setting delta hue value * + select saturation and lightness change axis in complement * ~ renamed distance argument : metric => select * ? rewrote some main module documentation 1.61 2023-09-12 lichtkind ------- * = fix tests * ~ renamed complementary method => complement * - deprecated complementary, will be removed at 2.0 1.60 2023-09-11 lichtkind ------- * = API development * * added color spaces HSB HSW YIQ * + output format array: ['rgb',1,2,3] * + input and output format string: 'rgb: 1,2,3' * + input and output format css_string: 'rgb(1,2,3)' * - deprecated getter method string 1.54 2023-08-21 lichtkind ------- * = API development * + added named ARRAY syntax for constructor like [CMYK => 0,0,1,1] * - removed option to get single values from values method * & splittet GTC::Constant package into ::Name and ::Name::Constant * ? rewrote lot of documentation 1.53 2023-08-11 lichtkind ------- * = maintenance * ? more doc fixes to new API * ! fix rounding error under -Duselongdouble 1.52 2023-08-11 lichtkind ------- * = maintenance + third phase toward 2.0 * + added gradient method with new API * ? more doc fixes to new API * & more tests 1.51 2023-08-10 lichtkind ------- * = a few documentation fixes 1.50 2023-08-09 lichtkind ------- * = first + second phase of of 2.0 rewrite * + add CMY, CMYK and HSV support * + new universal getter method: values * + new modifier method: set, blend * ~ enhanced and strictened modifier method: add * \ deprecate all other numeric getter: rgb, red, green, blue, rgb_hex, rgb_hash, hsl, hue, saturation, lightnss, hsl_hash, string * \ till 2.0 will be also deprecated: rgb_gradient_to, hsl_gradient_to, gradient_to, distance_to, blend_with * & new getter API * & keep complex names like 'SVG:green' to be returned by getter: ->name * ? rewritten large part of documentation 1.09 2023-07-17 lichtkind ------- * = maintenance release * ? ever more POD fixes * ? new method chapter split * ? POD in HSL constructor * & enhance some tests and new ones * / split and rearrange value libs with tests 1.08 2023-01-24 lichtkind ------- * = small enhancements * + added method rgb_gradient_to * ~ changed gradient_to to hsl_gradient_to (but keeping compatibility) * ? even more POD fixes 1.07 2023-01-20 lichtkind ------- * = POD fixes 1.06 2023-01-20 lichtkind ------- * = maintenance release * + simplified string serialisation method (->new(eval $string) => ->new($string)) * ? small POD fixes 1.05 2022-12-31 lichtkind ------- * = small enhancements * + added getters for data hashes * ? cleaned some sentences and comments * ? synopsis cleanup 1.04 2022-11-04 lichtkind ------- * = small fixes * & fixing meta files * ? typos 1.03 2022-11-04 lichtkind ------- * = small enhancements * + recursive constructor that takes an object as argument * ? mention Bundle::Graphics::ColorNames in POD 1.02 2022-10-29 lichtkind ------- * = fixes * + sub color {} as importable constructor shortcut * ? cleaned some constructor related bits in POD * ! normalize constructor input color_name in 'palette_name:color_name' same as 'color_name' 1.01 2022-10-27 lichtkind ------- * = fixes * ? mention VACCC and other additional color palettes * ! loading from Graphics::ColorNames::* via 'palette_name:color_name' was actually broken 1.0 2022-10-04 lichtkind ------- * = initial release - moved code out of Chart module * \ created own distro * ~ small POD fixes * = new feature release * * added color set method: bowl * + added color spaces: XYZ, LAB LICENSE100644001750001750 4656114503102425 17270 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71This software is copyright (c) 2022-2023 by Herbert Breunung . 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) 2022-2023 by Herbert Breunung . 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, Fifth Floor, Boston, MA 02110-1301 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 Perl Artistic License 1.0 --- This software is Copyright (c) 2022-2023 by Herbert Breunung . This is free software, licensed under: The Perl 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 as specified below. "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 uunet.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) give non-standard executables non-standard names, and clearly document 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. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 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 whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644001750001750 212714503102425 17675 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71name = Graphics-Toolkit-Color ;main_module = lib/.. .pm ; will set automatically ;abstract = ; .. ;version = author = Herbert Breunung copyright_holder = Herbert Breunung license = Perl_5 copyright_year = 2022-2023 [Prereqs] perl = v5.12.0 Carp = 1.35 Exporter = 5 [Prereqs / RuntimeSuggests] Bundle::Graphics::ColorNames = 0 [Prereqs / TestRequires] Test::More = 1.3 Test::Warn = 0.30 [MetaNoIndex] directory = t ; pollutes meta section 'provides' [MetaProvides::Package] [Git::GatherDir] exclude_filename = README.md exclude_match = ^dev ; use RewriteVersion or VersionFromModule ;[VersionFromModule] [RewriteVersion] allow_decimal_underscore = 1 [Repository] [PodSyntaxTests] [AbstractFromPOD] [Pod2Readme] [MetaJSON] [MetaYAML] [Manifest] [MakeMaker] [License] [CPANFile] ;[Signature] [TestRelease] [ConfirmRelease] [UploadToCPAN] ;[PodSyntaxTests] ;[PodCoverageTests] ;[Pod2Html] ; dir = my_docs ; where to create HTML files ; ignore = bin/myscript1 ; what input file to ignore ; [=inc::Documentation] ; module = Chart::Manual META.yml100644001750001750 570714503102425 17511 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71--- abstract: 'color palette constructor' author: - 'Herbert Breunung ' build_requires: Test::More: '1.3' Test::Warn: '0.30' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Graphics-Toolkit-Color no_index: directory: - t provides: Graphics::Toolkit::Color: file: lib/Graphics/Toolkit/Color.pm version: '1.71' Graphics::Toolkit::Color::Name: file: lib/Graphics/Toolkit/Color/Name.pm version: '1.71' Graphics::Toolkit::Color::Name::Constant: file: lib/Graphics/Toolkit/Color/Name/Constant.pm version: '1.71' Graphics::Toolkit::Color::Space: file: lib/Graphics/Toolkit/Color/Space.pm version: '1.71' Graphics::Toolkit::Color::Space::Basis: file: lib/Graphics/Toolkit/Color/Space/Basis.pm version: '1.71' Graphics::Toolkit::Color::Space::Hub: file: lib/Graphics/Toolkit/Color/Space/Hub.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::CMY: file: lib/Graphics/Toolkit/Color/Space/Instance/CMY.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::CMYK: file: lib/Graphics/Toolkit/Color/Space/Instance/CMYK.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::HSB: file: lib/Graphics/Toolkit/Color/Space/Instance/HSB.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::HSL: file: lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::HSV: file: lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::HWB: file: lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::LAB: file: lib/Graphics/Toolkit/Color/Space/Instance/LAB.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::RGB: file: lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::XYZ: file: lib/Graphics/Toolkit/Color/Space/Instance/XYZ.pm version: '1.71' Graphics::Toolkit::Color::Space::Instance::YIQ: file: lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm version: '1.71' Graphics::Toolkit::Color::Space::Shape: file: lib/Graphics/Toolkit/Color/Space/Shape.pm version: '1.71' Graphics::Toolkit::Color::Space::Util: file: lib/Graphics/Toolkit/Color/Space/Util.pm version: '1.71' Graphics::Toolkit::Color::Values: file: lib/Graphics/Toolkit/Color/Values.pm version: '1.71' requires: Carp: '1.35' Exporter: '5' perl: v5.12.0 resources: repository: git://github.com/lichtkind/Graphics-Color-Toolkit.git version: '1.71' x_generated_by_perl: v5.34.0 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001750001750 256614503102425 17371 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.030. CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile dist.ini lib/Graphics/Toolkit/Color.pm lib/Graphics/Toolkit/Color/Name.pm lib/Graphics/Toolkit/Color/Name/Constant.pm lib/Graphics/Toolkit/Color/Space.pm lib/Graphics/Toolkit/Color/Space/Basis.pm lib/Graphics/Toolkit/Color/Space/Hub.pm lib/Graphics/Toolkit/Color/Space/Instance/CMY.pm lib/Graphics/Toolkit/Color/Space/Instance/CMYK.pm lib/Graphics/Toolkit/Color/Space/Instance/HSB.pm lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm lib/Graphics/Toolkit/Color/Space/Instance/LAB.pm lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm lib/Graphics/Toolkit/Color/Space/Instance/XYZ.pm lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm lib/Graphics/Toolkit/Color/Space/Shape.pm lib/Graphics/Toolkit/Color/Space/Util.pm lib/Graphics/Toolkit/Color/Values.pm t/01_util.t t/02_space_basis.t t/03_space_shape.t t/04_space.t t/10_space_rgb.t t/11_space_cmy.t t/12_space_cmyk.t t/13_space_hsl.t t/14_space_hsv.t t/15_space_hsb.t t/16_space_hwb.t t/17_space_yiq.t t/18_space_lab.t t/19_space_xyz.t t/30_space_hub.t t/40_values.t t/41_name.t t/50_color_new_getter_io.t t/51_color_measure.t t/52_color_change.t t/53_color_set.t xt/author/pod-syntax.t cpanfile100644001750001750 76314503102425 17721 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71# This file is generated by Dist::Zilla::Plugin::CPANFile v6.030 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "1.35"; requires "Exporter" => "5"; requires "perl" => "v5.12.0"; suggests "Bundle::Graphics::ColorNames" => "0"; on 'test' => sub { requires "Test::More" => "1.3"; requires "Test::Warn" => "0.30"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Test::Pod" => "1.41"; }; META.json100644001750001750 1062714503102425 17676 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71{ "abstract" : "color palette constructor", "author" : [ "Herbert Breunung " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Graphics-Toolkit-Color", "no_index" : { "directory" : [ "t" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "Carp" : "1.35", "Exporter" : "5", "perl" : "v5.12.0" }, "suggests" : { "Bundle::Graphics::ColorNames" : "0" } }, "test" : { "requires" : { "Test::More" : "1.3", "Test::Warn" : "0.30" } } }, "provides" : { "Graphics::Toolkit::Color" : { "file" : "lib/Graphics/Toolkit/Color.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Name" : { "file" : "lib/Graphics/Toolkit/Color/Name.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Name::Constant" : { "file" : "lib/Graphics/Toolkit/Color/Name/Constant.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space" : { "file" : "lib/Graphics/Toolkit/Color/Space.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Basis" : { "file" : "lib/Graphics/Toolkit/Color/Space/Basis.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Hub" : { "file" : "lib/Graphics/Toolkit/Color/Space/Hub.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::CMY" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CMY.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::CMYK" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CMYK.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::HSB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSB.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::HSL" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::HSV" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::HWB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::LAB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/LAB.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::RGB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::XYZ" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/XYZ.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Instance::YIQ" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Shape" : { "file" : "lib/Graphics/Toolkit/Color/Space/Shape.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Space::Util" : { "file" : "lib/Graphics/Toolkit/Color/Space/Util.pm", "version" : "1.71" }, "Graphics::Toolkit::Color::Values" : { "file" : "lib/Graphics/Toolkit/Color/Values.pm", "version" : "1.71" } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/lichtkind/Graphics-Color-Toolkit.git", "web" : "https://github.com/lichtkind/Graphics-Color-Toolkit" } }, "version" : "1.71", "x_generated_by_perl" : "v5.34.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.27", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } t000755001750001750 014503102425 16332 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.7101_util.t100644001750001750 430714503102425 20140 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 24; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Util'; eval "use $module"; is( not($@), 1, 'could load the module'); my $round = \&Graphics::Toolkit::Color::Space::Util::round; is( $round->(0.5), 1, 'round 0.5 upward'); is( $round->(0.500000001), 1, 'everything above 0.5 gets also increased'); is( $round->(0.4999999), 0, 'everything below 0.5 gets smaller'); is( $round->(-0.5), -1, 'round -0.5 downward'); is( $round->(-0.500000001), -1, 'everything beow -0.5 gets also lowered'); is( $round->(-0.4999999), 0, 'everything upward from -0.5 gets increased'); my $rmod = \&Graphics::Toolkit::Color::Space::Util::rmod; my $close = \&Graphics::Toolkit::Color::Space::Util::close_enough; is( $rmod->(), 0, 'default to 0 when both values missing'); is( $rmod->(1), 0, 'default to 0 when a value is missing'); is( $rmod->(1,0), 0, 'default to 0 when a divisor is zero'); is( $rmod->(3, 2), 1, 'normal int mod'); is( $close->($rmod->(2.1, 2), 0.1), 1, 'real mod when dividend is geater'); is( $close->($rmod->(.1, 2), 0.1), 1, 'real mod when divisor is geater'); is( $rmod->(-3, 2), -1, 'int mod with negative dividend'); is( $close->($rmod->(-3.1, 2), -1.1),1, 'real mod with negative dividend'); is( $rmod->(3, -2), 1, 'int mod with negative divisor'); is( $close->($rmod->(3.1, -2), 1.1), 1, 'real mod with negative divisor'); is( $rmod->(-3, -2), -1, 'int mod with negative divisor'); is( $close->($rmod->(-3.1, -2),-1.1),1, 'real mod with negative dividend and divisor'); is( $close->($rmod->(15.3, 4), 3.3), 1, 'real mod with different values'); my $min = \&Graphics::Toolkit::Color::Space::Util::min; my $max = \&Graphics::Toolkit::Color::Space::Util::max; is( $min->(1,2,3), 1 , 'simple minimum'); is( $min->(-1.1,2,3), -1.1, 'negative minimum'); is( $max->(1,2,3), 3, 'simple maximum'); is( $max->(-1,2,10E3), 10000, 'any syntax maximum'); exit 0; 41_name.t100644001750001750 1454714503102425 20136 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 57; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Name'; eval "use $module"; is( not($@), 1, 'could load the module'); my @names = Graphics::Toolkit::Color::Name::all(); is( @names > 700, 1, 'get a large list of names, all_names seems to working'); my $add_rgb = \&Graphics::Toolkit::Color::Name::add_rgb; my $add_hsl = \&Graphics::Toolkit::Color::Name::add_hsl; my $taken = \&Graphics::Toolkit::Color::Name::taken; my $get_name_rgb = \&Graphics::Toolkit::Color::Name::name_from_rgb; my $get_name_hsl = \&Graphics::Toolkit::Color::Name::name_from_hsl; my $get_name_range = \&Graphics::Toolkit::Color::Name::names_in_hsl_range; warning_like {$add_rgb->()} {carped => qr/missing first arg/}, "can't get color without name"; warning_like {$add_rgb->( 'one',1,1)} {carped => qr/needs 3 values/},'not enough args to add color'; warning_like {$add_rgb->( 'one', 0, -1, 25)} {carped => qr/green/}, 'too small green value got cought'; warning_like {$add_rgb->( 'one', 0, 1, 256)} {carped => qr/blue/}, 'too large blue value got cought'; warning_like {$add_rgb->( 'white', 0, 3, 22 )} {carped => qr/already/}, 'got cought overwriting white'; is( $taken->('one'), '', 'there is not color named "one"' ); is( ref $add_rgb->('one', 1, 2, 3 ), 'ARRAY', 'could add color to store'); is( $get_name_rgb->( 1, 2, 3 ), 'one', 'retrieve added color' ); is( $taken->('one'), 1, 'there is now a color named "one"' ); is( $taken->('One'), 1, 'even there with different spelling'); is( ref $add_hsl->('lucky', 0,100, 50),'ARRAY', 'added red under different name'); is( ref $add_hsl->('blob', 14, 10, 50),'ARRAY', 'added color by hsl definition'); is( $get_name_rgb->( 255 ,255, 255 ), 'white', 'could get a color def'); is( scalar $get_name_rgb->( 255, 215, 0 ), 'gold', 'selects shorter name: gold instead of gold1'); is( scalar $get_name_rgb->( [255, 215, 0]),'gold', 'array ref arg format works too'); is( scalar $get_name_rgb->( 255, 0, 0 ), 'red', 'selects shorter name red instead of inserted lucky'); is( $get_name_hsl->( 0, 100, 50 ), 'red', 'found red by hsl'); is( $get_name_hsl->( 14, 10, 50 ), 'blob', 'found inserted color by hsl'); my @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('white'); my @hsl = Graphics::Toolkit::Color::Name::hsl_from_name('white'); is( int @rgb, 3, 'white has 3 rgb values'); is( $rgb[0], 255, 'white has full red value'); is( $rgb[1], 255, 'white has full green value'); is( $rgb[2], 255, 'white has full blue value'); is( int @hsl, 3, 'white has 3 hsl values'); is( $hsl[0], 0, 'white has zero hue value'); is( $hsl[1], 0, 'white has zero sat value'); is( $hsl[2], 100, 'white has full light value'); @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('one'); @hsl = Graphics::Toolkit::Color::Name::hsl_from_name('one'); is( int @rgb, 3, 'self defined color has rgb values'); is( $rgb[0], 1, 'self defined color has defined red value'); is( $rgb[1], 2, 'self defined color has defined full green value'); is( $rgb[2], 3, 'self defined color has defined full blue value'); is( int @hsl, 3, 'self defined color has hsl values'); is( $hsl[0], 210, 'self defined color has computed hue value'); is( $hsl[1], 50, 'self defined color has computed saturation'); is( $hsl[2], 1, 'self defined color has computed lightness'); @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('One'); is( int @rgb, 3, 'upper case gets cleaned from color name'); @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('O_ne'); is( int @rgb, 3, 'under score gets cleaned from color name'); warning_like{ $get_name_range->( []) } {carped => qr/array with h s l values/},"can't get names in range without hsl values"; warning_like{ $get_name_range->( [1,1,1],[1,1,1],[1,1,1])} {carped => qr/array with h s l values/},'too many array arg'; warning_like{ $get_name_range->( [1,2],[1,2,3])} {carped => qr/in HSL needs 3 values/},'range center is missing a value'; warning_like{ $get_name_range->( [1,2,3],[2,3])} {carped => qr/in HSL needs 3 values/}, 'tolerances are missing a value'; warning_like{ $get_name_range->( [-1,2,3],[1,2,3])} {carped => qr/hue value/}, 'first value of search center is too small'; warning_like{ $get_name_range->( [361,2,3],[1,2,3])} {carped => qr/hue value/}, 'first value of search center is too large'; warning_like{ $get_name_range->( [1,-1,3],[2,10,3])} {carped => qr/saturation value/}, 'saturation center value is too small'; warning_like{ $get_name_range->( [1,101,3],[2,1,3])} {carped => qr/saturation value/}, 'saturation center value is too large'; warning_like{ $get_name_range->( [1,1,-1],[2,10,3])} {carped => qr/lightness value/}, 'first lightness value is too small'; warning_like{ $get_name_range->( [1,2,101],[2,1,1])} {carped => qr/lightness value/}, 'second lightness value is too large'; @names = $get_name_range->( [0, 0, 100], 0); is( int @names, 1, 'only one color has distance of 0 to white'); is( $names[0], 'white', 'only white has distance of 0 to white'); @names = sort $get_name_range->( [0, 0, 100], 5); is( int @names, 5, '5 colors are in short distance to white'); @names = grep { /whitesmoke/ } @names; is( int @names, 1, 'whitesmoke is near to white'); my @morenames = sort $get_name_range->( [0, 0, 100], 10); is( @names < @morenames, 1, 'bigger radius has to catch more colors'); @names = sort $get_name_range->( [240, 100, 50], [10, 20, 30]); @names = grep { /navy/ } @names; is( int @names, 1, 'navy is a shade of blue'); @names = sort $get_name_range->( [240, 100, 50], [100, 5, 5]); @names = grep { /aqua/ } @names; is( int @names, 1, 'aqua is a bluish color with high saturation and medium lightness'); @names = sort $get_name_range->( [ 0, 100, 50], [100, 5, 5]); @names = grep { /lightpurple/ } @names; is( int @names, 1, 'purple is near red because hue is circular'); @names = sort $get_name_range->( [ 359, 100, 50], [100, 5, 5]); @names = grep { /chartreuse/ } @names; is( @names > 0, 1, 'chartreuse is near purple because hue is circular'); #say for @names; #say scalar $get_name_hsl->(240, 100, 50); exit 0; Makefile.PL100644001750001750 220614503102425 20201 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.030. use strict; use warnings; use 5.012000; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "color palette constructor", "AUTHOR" => "Herbert Breunung ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Graphics-Toolkit-Color", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.012000", "NAME" => "Graphics::Toolkit::Color", "PREREQ_PM" => { "Carp" => "1.35", "Exporter" => 5 }, "TEST_REQUIRES" => { "Test::More" => "1.3", "Test::Warn" => "0.30" }, "VERSION" => "1.71", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => "1.35", "Exporter" => 5, "Test::More" => "1.3", "Test::Warn" => "0.30" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); CONTRIBUTING100644001750001750 71114503102425 20040 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71 Please submit Bug reports under https://rt.cpan.org/Dist/Display.html?Name=Graphics-Toolkit-Color (preferred) or if you like https://github.com/lichtkind/Graphics-Toolkit-Color/issues Patches are welcome under: https://github.com/lichtkind/Graphics-Toolkit-Color/pulls (preferred) but arrive also via https://rt.cpan.org/Dist/Display.html?Name=Graphics-Toolkit-Color Also feature Requests are welcome but please read the TODO first. 04_space.t100644001750001750 1212014503102425 20271 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 52; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space'; eval "use $module"; is( not($@), 1, 'could load the module'); my $fspace = Graphics::Toolkit::Color::Space->new(); is( ref $fspace, '', 'need vector names to create color space'); my $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], range => 20); is( ref $space, $module, 'could create a space object'); is( $space->name, 'ABCD', 'space has right name'); is( $space->dimensions, 4, 'space has four dimension'); is( $space->has_format('bbb'), 0, 'vector name is not a format'); is( $space->has_format('c'), 0, 'vector sigil is not a format'); is( $space->has_format('list'),1, 'list is a format'); is( $space->has_format('hash'),1, 'hash is a format'); is( $space->has_format('char_hash'),1, 'char_hash is a format'); is( ref $space->format([1,2,3,4], 'hash'), 'HASH', 'formatted values into a hash'); is( int($space->format([1,2,3,4], 'list')), 4, 'got long enough list of values'); is( $space->format([1,2,3,4], 'bbb'), 0, 'got no value by key name'); is( $space->format([1,2,3,4], 'AAA'), 0, 'got no value by uc key name'); is( $space->format([1,2,3,4], 'c'), 0, 'got no value by shortcut name'); is( $space->format([1,2,3,4], 'D'), 0, 'got no value by uc shortcut name'); is( $space->has_format('str'), 0, 'formatter not yet inserted'); my $c = $space->add_formatter('str', sub { $_[0] . $_[1] . $_[2] . $_[3]}); is( ref $c, 'CODE', 'formatter code accepted'); is( $space->has_format('str'), 1, 'formatter inserted'); is( $space->format([1,2,3,4], 'str'), '1234', 'inserted formatter works'); my @fval = $space->deformat({a => 1, b => 2, c => 3, d => 4}); is( int @fval, 4, 'deformatter recognized char hash'); is( $fval[0], 1, 'first value correctly deformatted'); is( $fval[1], 2, 'second value correctly deformatted'); is( $fval[2], 3, 'third value correctly deformatted'); is( $fval[3], 4, 'fourth value correctly deformatted'); @fval = $space->deformat({aaa => 1, bbb => 2, ccc => 3, ddd => 4}); is( int @fval, 4, 'deformatter recognized hash'); is( $fval[0], 1, 'first value correctly deformatted'); is( $fval[1], 2, 'second value correctly deformatted'); is( $fval[2], 3, 'third value correctly deformatted'); is( $fval[3], 4, 'fourth value correctly deformatted'); @fval = $space->deformat({a => 1, b => 2, c => 3, e => 4}); is( $fval[0], undef, 'char hash with bad key got ignored'); @fval = $space->deformat({aaa => 1, bbb => 2, ccc => 3, dd => 4}); is( $fval[0], undef, 'char hash with bad key got ignored'); my $dc = $space->add_deformatter('str', sub { split ':', $_[0] }); is( ref $dc, 'CODE', 'deformatter code accepted'); @fval = $space->deformat('1:2:3:4'); is( int @fval, 4, 'self made deformatter recognized str'); is( $fval[0], 1, 'first value correctly deformatted'); is( $fval[1], 2, 'second value correctly deformatted'); is( $fval[2], 3, 'third value correctly deformatted'); is( $fval[3], 4, 'fourth value correctly deformatted'); is( $space->can_convert('XYZ'), 0, 'converter not yet inserted'); my $h = $space->add_converter('XYZ', sub { $_[0]+1, $_[1]+1, $_[2]+1, $_[3]+1}, sub { $_[0]-1, $_[1]-1, $_[2]-1, $_[3]-1} ); is( ref $h, 'HASH', 'converter code accepted'); is( $space->can_convert('XYZ'), 1, 'converter inserted'); my @val = $space->convert([1,2,3,4], 'XYZ'); is( int @val, 4, 'converter did something'); is( $val[0], 2, 'first value correctly converted'); is( $val[1], 3, 'second value correctly converted'); is( $val[2], 4, 'third value correctly converted'); is( $val[3], 5, 'fourth value correctly converted'); @val = $space->deconvert([2,3,4,5], 'xyz'); is( int @val, 4, 'deconverter did something even if space spelled in lower case'); is( $val[0], 1, 'first value correctly deconverted'); is( $val[1], 2, 'second value correctly deconverted'); is( $val[2], 3, 'third value correctly deconverted'); is( $val[3], 4, 'fourth value correctly deconverted'); my @d = $space->delta([2,3,4,5], [1,5,1,1] ); is( int @d, 4, 'delta result has right length'); exit 0; is( $d[0], -1, 'first value correctly deconverted'); is( $d[1], 2, 'second value correctly deconverted'); is( $d[2], -3, 'third value correctly deconverted'); is( $d[3], -4, 'fourth value correctly deconverted'); my @tr = $space->clamp([-1, 0, 20.1, 21, 1]); is( int @tr, 4, 'clamp kept correct vector length = 4'); is( $tr[0], 0, 'clamp up value below minimum'); is( $tr[1], 0, 'do not touch minimal value'); is( $tr[2], 20, 'clamp real into int'); is( $tr[3], 20, 'clamp down value above range max'); is( $space->check([1,2,3,4]), undef, 'all values in range'); my @norm = $space->normalize([0, 10, 20, 15]); is( int @norm, 4, 'normalized 4 into 4 values'); is( $norm[0], 0, 'normalized first min value'); is( $norm[1], 0.5, 'normalized second mid value'); is( $norm[2], 1, 'normalized third max value'); is( $norm[3], 0.75, 'normalized fourth value'); exit 0; 40_values.t100644001750001750 751414503102425 20470 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 40; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Values'; eval "use $module"; is( not($@), 1, 'could load the module'); use Graphics::Toolkit::Color::Space::Util ':all'; sub val {Graphics::Toolkit::Color::Values->new( $_[0] )} my $v = val('#010203'); is( ref $v, $module, 'could create an object from rgb hex'); is( close_enough($v->{'RGB'}[0], 1/255), 1, 'normalized red value correct'); is( close_enough($v->{'RGB'}[1], 2/255), 1, 'normalized green value correct'); is( close_enough($v->{'RGB'}[2], 3/255), 1, 'normalized blue value correct'); my @values = $v->get; is( int @values, 3, 'rgb values are three'); is( $values[0], 1, 'spat out original red'); is( $values[1], 2, 'spat out original green'); is( $values[2], 3, 'spat out original blue'); $v = Graphics::Toolkit::Color::Values->new('hsl(240,100,50)'); is( ref $v, $module, 'could create an object from hsl css_string'); is( $v->{'RGB'}[0], 0, 'normalized red value'); is( $v->{'RGB'}[1], 0, 'normalized green value'); is( $v->{'RGB'}[2], 1, 'normalized blue value'); is( close_enough($v->{'HSL'}[0], 2/3), 1, 'normalized hue value'); is( close_enough($v->{'HSL'}[1], 1), 1, 'normalized saturation value'); is( close_enough($v->{'HSL'}[2], 0.5), 1, 'normalized lightness value'); is( $v->get('hsl','string'), 'hsl: 240, 100, 50', 'got all original values back in string format'); is( $v->string(), 'hsl: 240, 100, 50', 'string method works'); is( uc $v->get('RGB','HEX'), '#0000FF', 'got values in RGB hex format'); my $violet = $v->set({red => 255}); is( ref $violet, $module, 'created related color by set method'); is( uc $violet->get('RGB','HEX'), '#FF00FF', 'red value got boosted'); my $black = $violet->set({blackness => 100}); is( $black->get('RGB','HEX'), '#000000', 'made color black'); my $vn = $v->add({green => -10}) ; is( ref $violet, $module, 'added negative green value'); is( uc $vn->get('RGB','HEX'), '#0000FF', 'color got clamped into defined RGB'); $vn = $v->add({green => 10}); is( uc $vn->get('RGB','HEX'), '#000AFF', 'could add green'); my $vb = $v->blend( $vn, undef, 'RGB' ); is( ref $vb, $module, 'could blend two colors'); is( $vb->{'RGB'}[0], 0, 'red value correct'); is( close_enough($vb->{'RGB'}[1], 5/255), 1, 'blue value correct'); is( $vb->{'RGB'}[2], 1, 'blue value correct'); is( uc $v->blend( $vn, 0 )->get('RGB','HEX'), '#0000FF', 'blended nothing, kept original'); is( uc $v->blend( $violet, 1 )->get('RGB','HEX'), '#FF00FF', 'blended nothing, kept paint color'); is( uc $v->blend( $violet, 3, 'RGB' )->get('RGB','HEX'), '#FF00FF', 'clamp kept color in range'); my $one = val( [1,2,3] ); my $blue = val( '#0000FF' ); my $yellow = val( '#FFFF00' ); warning_like { $one->distance()} {carped => qr/need value object/}, "need at least second color"; warning_like { $one->distance([RGB =>1,2,3])} {carped => qr/need value object/}, "need value object, not a definition"; is( close_enough( $one->distance( val( [ 2, 3, 4] ), 'RGB', undef, 255), sqrt(3)), 1, 'computed simple rgb distance'); is( $one->distance( val( [ 2, 3, 4] ), 'RGB', 'b', 255), 1, 'only blue metric'); is( close_enough( $one->distance( val( [ 2, 3, 4] ), 'RGB', 'rrgb', 255), 2), 1, 'double red metric'); is( close_enough( $blue->distance( $yellow, undef, 'h', 'normal'), 0.5), 1, 'complement color has maximal hue distance, 0.5 normalized'); is( $blue->distance( $yellow, undef, 'h'), 180, 'complement has maximal hue distance'); is( $blue->distance( $yellow, undef, 'h', [[-100,100],1,1,]), 100, 'maximal hue distance with special range'); exit 0; 10_space_rgb.t100644001750001750 1430214503102425 21124 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 82; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::RGB'; my $def = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got right return value by loading module'); is( $def->name, 'RGB', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check rgb values works on lower bound values'); ok( !$def->check([255,255,255]), 'check rgb values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check rgb got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check rgb got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/red value/}, "red value is too small"; warning_like {$def->check([0.5, 0, 0])} {carped => qr/red value/}, "red value is not integer"; warning_like {$def->check([256, 0, 0])} {carped => qr/red value/}, "red value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/green value/}, "green value is too small"; warning_like {$def->check([0, 0.5, 0])} {carped => qr/green value/}, "green value is not integer"; warning_like {$def->check([0, 256, 0])} {carped => qr/green value/}, "green value is too big"; warning_like {$def->check([0, 0, -1 ] )} {carped => qr/blue value/}, "blue value is too small"; warning_like {$def->check([0, 0, 0.5] )} {carped => qr/blue value/}, "blue value is not integer"; warning_like {$def->check([0, 0, 256] )} {carped => qr/blue value/}, "blue value is too big"; my @rgb = $def->clamp([]); is( int @rgb, 3, 'clamp resets missing color to black'); is( $rgb[0], 0, 'default color is black (R)'); is( $rgb[1], 0, 'default color is black (G)'); is( $rgb[2], 0, 'default color is black (B)'); @rgb = $def->clamp([1,2]); is( $rgb[0], 1, 'carry over first arg'); is( $rgb[1], 2, 'carry over second arg'); is( $rgb[2], 0, 'set missing color value to zero'); @rgb = $def->clamp([1.1, 2, 3, 4]); is( $rgb[0], 1, 'clamped none int value down'); is( $rgb[1], 2, 'carried color is black (G) took second of too many args'); is( $rgb[2], 3, 'default color is black (B) too third of too many args'); is( int @rgb, 3, 'left out the needless argument'); @rgb = $def->clamp([-1,10,256]); is( int @rgb, 3, 'clamp does not change number of negative values'); is( $rgb[0], 0, 'too low red value is clamp up'); is( $rgb[1], 10, 'in range green value is not touched'); is( $rgb[2], 255, 'too large blue value is clamp down'); is( $def->format([0,0,0], 'hex'), '#000000', 'converted black from rgb to hex'); is( uc $def->format([255,255,255],'HEX'), '#FFFFFF', 'converted white from rgb to hex'); is( uc $def->format([ 10, 20, 30],'hex'), '#0A141E', 'converted random color from rgb to hex'); @rgb = $def->deformat('#332200'); is( int @rgb, 3, 'could deformat hex string'); is( $rgb[0], 51, 'red is correctly tranlated from hex'); is( $rgb[1], 34, 'green is correctly tranlated from hex'); is( $rgb[2], 0, 'blue is correctly tranlated from hex'); @rgb = $def->deformat('#DEF'); is( int @rgb, 3, 'could deformat short hex string'); is( $rgb[0], 221, 'converted (short form) hex to RGB red is correct'); is( $rgb[1], 238, 'converted (short form) hex to RGB green is correct'); is( $rgb[2], 255, 'converted (short form) hex to RGB blue is correct'); @rgb = $def->deformat([ 33, 44, 55]); is( int @rgb, 3, 'number triplet in ARRAY is recognized by ARRAY'); is( $rgb[0], 33, 'red is transported'); is( $rgb[1], 44, 'green is transported'); is( $rgb[2], 55, 'blue is transported'); @rgb = $def->deformat([rgb => 11, 22, 256]); is( int @rgb, 3, 'deformat lc named ARRAY: got 3 values'); is( $rgb[0], 11, 'red is correct'); is( $rgb[1], 22, 'green got transported'); is( $rgb[2], 256, 'blue value does not get clamped'); @rgb = $def->deformat(['CMY', 11, 22, 33]); is( $rgb[0], undef, 'OO deformat reacts only to right name'); @rgb = $def->deformat('RGB: -1, 256, 3.3 '); is( int @rgb, 3, 'deformat STRING format: got 3 values'); is( $rgb[0], -1, 'to small red is not clamped up'); is( $rgb[1], 256, 'too large green is not clamped down'); is( $rgb[2], 3.3, 'blue decimals do not get clamped'); @rgb = $def->deformat('rgb:0,1,2'); is( int @rgb, 3, 'deformat STRING format without spaces and lc name: got 3 values'); is( $rgb[0], 0, 'red is zero'); is( $rgb[1], 1, 'green is one'); is( $rgb[2], 2, 'blue is two'); @rgb = $def->deformat('cmy: 1,2,3.3'); is( $rgb[0], undef, 'OO deformat STRING reacts only to right space name'); is( $def->format([0,256,3.3], 'string'), 'rgb: 0, 256, 3.3', 'formated rgb triplet into value string'); @rgb = $def->deformat('rgb( -1 , 2.3, 4444)'); is( int @rgb, 3, 'deformat css STRING formatwith all hurdles: got 3 values'); is( $rgb[0], -1, 'red is -1'); is( $rgb[1], 2.3, 'green is one'); is( $rgb[2], 4444, 'blue is two'); is( $def->format([-1,2.3,4444], 'css_string'), 'rgb(-1,2.3,4444)', 'formated rgb triplet into css string'); my $rgb = $def->format([0,256,3.3], 'array'); is( ref $rgb, 'ARRAY', 'formated into ARRAY'); is( @$rgb, 4, 'named RGB tuple has 4 elements'); is( $rgb->[0], 'rgb', 'tuple color name space'); is( $rgb->[1], 0, 'red in minimal'); is( $rgb->[2], 256, 'green is too large'); is( $rgb->[3], 3.3, 'blue still has decimal'); is( $def->format([10,20,30], 'hex'), '#0a141e', 'formated rgb triplet into hex string'); my @d = $def->delta([0,44,256],[256,88,0]); is( int @d, 3, 'delta vector has right length'); is( $d[0], 256, 'delta in R component'); is( $d[1], 44, 'delta in G component'); is( $d[2], -256, 'delta in B component'); @rgb = $def->denormalize( [0.3, 0.4, 0.5], [[0,255],[0,255],[0,255]] ); is( int @rgb, 3, 'denormalized triplet'); is( $rgb[0], 77, 'right red value'); is( $rgb[1], 102, 'right green value'); is( $rgb[2], 128, 'right blue value'); exit 0; 11_space_cmy.t100644001750001750 632114503102425 21125 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 42; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::CMY'; my $def = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got space object by loading module'); is( $def->name, 'CMY', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check cmy values works on lower bound values'); ok( !$def->check([1, 1, 1]), 'check cmy values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check cmy got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check cmy got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/cyan value/}, "cyan value is too small"; warning_like {$def->check([2, 0, 0])} {carped => qr/cyan value/}, "cyan value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/magenta value/}, "magenta value is too small"; warning_like {$def->check([0, 2, 0])} {carped => qr/magenta value/}, "magenta value is too big"; warning_like {$def->check([0, 0, -1 ] )} {carped => qr/yellow value/}, "yellow value is too small"; warning_like {$def->check([0, 0, 2] )} {carped => qr/yellow value/}, "yellow value is too big"; my @cmy = $def->clamp([]); is( int @cmy, 3, 'default color is set by clamp'); is( $cmy[0], 0, 'default color is black (C) no args'); is( $cmy[1], 0, 'default color is black (M) no args'); is( $cmy[2], 0, 'default color is black (Y) no args'); @cmy = $def->clamp([0, 1]); is( int @cmy, 3, 'clamp added missing argument in vector'); is( $cmy[0], 0, 'passed (C) value'); is( $cmy[1], 1, 'passed (M) value'); is( $cmy[2], 0, 'added (Y) value when too few args'); @cmy = $def->clamp([-0.1, 2, 0.5, 0.4, 0.5]); is( int @cmy, 3, 'removed missing argument in value vector by clamp'); is( $cmy[0], 0, 'clamped up (C) value to minimum'); is( $cmy[1], 1, 'clamped down (M) value to maximum'); is( $cmy[2], 0.5, 'passed (Y) value'); @cmy = $def->deconvert( [0, 0.1, 1], 'RGB'); is( int @cmy, 3, 'converted RGB values to CMY'); is( $cmy[0], 1, 'converted to maximal cyan value'); is( $cmy[1], 0.9, 'converted to mid magenta value'); is( $cmy[2], 0, 'converted to minimal yellow value'); my @rgb = $def->convert( [1, 0.9, 0 ], 'RGB'); is( int @rgb, 3, 'converted CMY to RGB triplets'); is( $rgb[0], 0, 'converted red value'); is( $rgb[1], 0.1, 'converted green value'); is( $rgb[2], 1, 'converted blue value'); my @d = $def->delta([.2,.2,.2],[.2,.2,.2]); is( int @d, 3, 'zero delta vector has right length'); is( $d[0], 0, 'no delta in C component'); is( $d[1], 0, 'no delta in M component'); is( $d[2], 0, 'no delta in Y component'); @d = $def->delta([0.1,0.2,0.4],[0, 0.5, 1]); is( int @d, 3, 'delta vector has right length'); is( $d[0], -0.1, 'C delta'); is( $d[1], 0.3, 'M delta'); is( $d[2], 0.6, 'Y delta'); exit 0; 13_space_hsl.t100644001750001750 1105714503102425 21147 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 51; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSL'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'HSL', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check hsl values works on lower bound values'); ok( !$def->check([360,100,100]), 'check hsl values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check cmy got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check cmy got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/hue value/}, "hue value is too small"; warning_like {$def->check([0.5, 0,0])} {carped => qr/hue value/}, "hue value is not integer"; warning_like {$def->check([361, 0,0])} {carped => qr/hue value/}, "hue value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/saturation value/}, "saturation value is too small"; warning_like {$def->check([0, 0.5,0])} {carped => qr/saturation value/}, "saturation value is not integer"; warning_like {$def->check([0, 101,0])} {carped => qr/saturation value/}, "saturation value is too big"; warning_like {$def->check([0,0, -1 ])} {carped => qr/lightness value/}, "lightness value is too small"; warning_like {$def->check([0,0, 0.5])} {carped => qr/lightness value/}, "lightness value is not integer"; warning_like {$def->check([0,0, 101])} {carped => qr/lightness value/}, "lightness value is too big"; my @hsl = $def->clamp([]); is( int @hsl, 3, 'missing values are clamped to black (default color)'); is( $hsl[0], 0, 'default color is black (H)'); is( $hsl[1], 0, 'default color is black (S)'); is( $hsl[2], 0, 'default color is black (L)'); @hsl = $def->clamp([0,100]); is( int @hsl, 3, 'clamp added missing value'); is( $hsl[0], 0, 'carried first min value (H)'); is( $hsl[1], 100, 'carried second max value (S)'); is( $hsl[2], 0, 'set missing value to zero'); @hsl = $def->clamp( [-1, -1, 101, 4]); is( int @hsl, 3, 'clamp removed superfluous value'); is( $hsl[0], 359, 'rotated up (H) value'); is( $hsl[1], 0, 'clamped up (S) value'); is( $hsl[2], 100, 'clamped down(L) value');; @hsl = $def->deconvert( [0.5, 0.5, 0.5], 'RGB'); is( int @hsl, 3, 'converted color grey has three hsl values'); is( $hsl[0], 0, 'converted color grey has computed right hue value'); is( $hsl[1], 0, 'converted color grey has computed right saturation'); is( $hsl[2], 0.5, 'converted color grey has computed right lightness'); my @rgb = $def->convert( [0, 0, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @hsl = $def->deconvert( [0.00784, 0.7843, 0.0902], 'RGB'); is( int @hsl, 3, 'converted blue color has three hsl values'); is( close_enough($hsl[0], 0.35097493), 1, 'converted color grey has computed right hue value'); is( close_enough($hsl[1], 0.98), 1, 'converted color grey has computed right saturation'); is( close_enough($hsl[2], 0.4), 1, 'converted color grey has computed right lightness'); @rgb = $def->convert( [0.351, 0.98, 0.4], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( close_enough($rgb[0], 0.00784), 1, 'converted back color grey has right red value'); is( close_enough($rgb[1], 0.7843), 1, 'converted back color grey has right green value'); is( close_enough($rgb[2], 0.0902), 1, 'converted back color grey has right blue value'); my @d = $def->delta([0.3,0.3,0.3],[0.3,0.4,0.2]); is( int @d, 3, 'delta vector has right length'); is( $d[0], 0, 'no delta in hue component'); is( $d[1], 0.1, 'positive delta in saturation component'); is( $d[2], -0.1, 'negatve delta in lightness component'); @d = $def->delta([0.9,0,0],[0.1,0,0]); is( $d[0], .2, 'negative delta across the cylindrical border'); @d = $def->delta([0.3,0,0],[0.9,0,0]); is( $d[0], -.4, 'negative delta because cylindrical quality of dimension'); exit 0; 14_space_hsv.t100644001750001750 1105114503102425 21154 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 53; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSV'; use Graphics::Toolkit::Color::Space::Util ':all'; my $def = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'HSV', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check hsv values works on lower bound values'); ok( !$def->check([360,100,100]), 'check hsv values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check cmy got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check cmy got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/hue value/}, "hue value is too small"; warning_like {$def->check([0.5, 0,0])} {carped => qr/hue value/}, "hue value is not integer"; warning_like {$def->check([361, 0,0])} {carped => qr/hue value/}, "hue value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/saturation value/}, "saturation value is too small"; warning_like {$def->check([0, 0.5,0])} {carped => qr/saturation value/}, "saturation value is not integer"; warning_like {$def->check([0, 101,0])} {carped => qr/saturation value/}, "saturation value is too big"; warning_like {$def->check([0,0, -1 ])} {carped => qr/value value/}, "value value is too small"; warning_like {$def->check([0,0, 0.5])} {carped => qr/value value/}, "value value is not integer"; warning_like {$def->check([0,0, 101])} {carped => qr/value value/}, "value value is too big"; my @hsv = $def->clamp([]); is( int @hsv, 3, 'clamp added three missing values as zero'); is( $hsv[0], 0, 'default color is black (H)'); is( $hsv[1], 0, 'default color is black (S)'); is( $hsv[2], 0, 'default color is black (V)'); @hsv = $def->clamp([0,100]); is( int @hsv, 3, 'added one missing value'); is( $hsv[0], 0, 'carried first min value'); is( $hsv[1], 100, 'carried second max value'); is( $hsv[2], 0, 'set missing color value to zero (V)'); @hsv = $def->clamp([-1.1,-1,101,4]); is( int @hsv, 3, 'removed superfluous value'); is( $hsv[0], 359, 'rotated up (H) value and removed decimals'); is( $hsv[1], 0, 'clamped up too small (S) value'); is( $hsv[2], 100, 'clamped down too large (V) value');; @hsv = $def->deconvert( [0.5, 0.5, 0.5], 'RGB'); is( int @hsv, 3, 'converted color grey has three hsv values'); is( $hsv[0], 0, 'converted color grey has computed right hue value'); is( $hsv[1], 0, 'converted color grey has computed right saturation'); is( $hsv[2], 0.5, 'converted color grey has computed right value'); my @rgb = $def->convert( [0, 0, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @rgb = $def->convert( [0.972222222, 0.9, 0.78], 'RGB'); is( int @rgb, 3, 'converted red color into tripled'); is( $rgb[0], 0.78, 'right red value'); is( $rgb[1], 0.078, 'right green value'); is( close_enough($rgb[2], 0.196), 1, 'right blue value'); @hsv = $def->deconvert( [0.78, 0.078, 0.196078431], 'RGB'); is( int @hsv, 3, 'converted nice blue has three hsv values'); is( close_enough($hsv[0], 0.97222), 1, 'converted nice blue has computed right hue value'); is( $hsv[1], .9, 'converted nice blue has computed right saturation'); is( $hsv[2], .78, 'converted nice blue has computed right value'); @rgb = $def->convert( [0.76666, .83, .24], 'RGB'); is( int @rgb, 3, 'converted red color into tripled'); is( close_enough($rgb[0], 0.156862), 1, 'right red value'); is( close_enough($rgb[1], 0.03921), 1, 'right green value'); is( close_enough($rgb[2], 0.2352), 1, 'right blue value'); @hsv = $def->deconvert( [40/255, 10/255, 60/255], 'RGB'); is( int @hsv, 3, 'converted nice blue has three hsv values'); is( close_enough($hsv[0], 0.766666), 1, 'converted nice blue has computed right hue value'); is( close_enough($hsv[1], .83), 1, 'converted nice blue has computed right saturation'); is( close_enough($hsv[2], .24), 1, 'converted nice blue has computed right value'); exit 0; 15_space_hsb.t100644001750001750 1110714503102425 21133 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 53; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSB'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'HSB', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check hsb values works on lower bound values'); ok( !$def->check([360,100,100]), 'check hsb values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check cmy got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check cmy got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/hue value/}, "hue value is too small"; warning_like {$def->check([0.5, 0,0])} {carped => qr/hue value/}, "hue value is not integer"; warning_like {$def->check([361, 0,0])} {carped => qr/hue value/}, "hue value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/saturation value/}, "saturation value is too small"; warning_like {$def->check([0, 0.5,0])} {carped => qr/saturation value/}, "saturation value is not integer"; warning_like {$def->check([0, 101,0])} {carped => qr/saturation value/}, "saturation value is too big"; warning_like {$def->check([0,0, -1 ])} {carped => qr/brightness value/}, "value value is too small"; warning_like {$def->check([0,0, 0.5])} {carped => qr/brightness value/}, "value value is not integer"; warning_like {$def->check([0,0, 101])} {carped => qr/brightness value/}, "value value is too big"; my @hsb = $def->clamp([]); is( int @hsb, 3, 'clamp added three missing values as zero'); is( $hsb[0], 0, 'default color is black (H)'); is( $hsb[1], 0, 'default color is black (S)'); is( $hsb[2], 0, 'default color is black (B)'); @hsb = $def->clamp([0,100]); is( int @hsb, 3, 'added one missing value'); is( $hsb[0], 0, 'carried first min value'); is( $hsb[1], 100, 'carried second max value'); is( $hsb[2], 0, 'set missing color value to zero (B)'); @hsb = $def->clamp([-1.1,-1,101,4]); is( int @hsb, 3, 'removed superfluous value'); is( $hsb[0], 359, 'rotated up (H) value and removed decimals'); is( $hsb[1], 0, 'clamped up too small (S) value'); is( $hsb[2], 100, 'clamped down too large (B) value');; @hsb = $def->deconvert( [0.5, 0.5, 0.5], 'RGB'); is( int @hsb, 3, 'converted color grey has three hsb values'); is( $hsb[0], 0, 'converted color grey has computed right hue value'); is( $hsb[1], 0, 'converted color grey has computed right saturation'); is( $hsb[2], 0.5, 'converted color grey has computed right brightness'); my @rgb = $def->convert( [0, 0, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @rgb = $def->convert( [0.972222222, 0.9, 0.78], 'RGB'); is( int @rgb, 3, 'converted red color into tripled'); is( $rgb[0], 0.78, 'right red value'); is( $rgb[1], 0.078, 'right green value'); is( close_enough($rgb[2], 0.196), 1, 'right blue value'); @hsb = $def->deconvert( [0.78, 0.078, 0.196078431], 'RGB'); is( int @hsb, 3, 'converted nice blue has three hsb values'); is( close_enough($hsb[0], 0.97222), 1, 'converted nice blue has computed right hue value'); is( $hsb[1], .9, 'converted nice blue has computed right saturation'); is( $hsb[2], .78, 'converted nice blue has computed right brightness'); @rgb = $def->convert( [0.76666, .83, .24], 'RGB'); is( int @rgb, 3, 'converted red color into tripled'); is( close_enough($rgb[0], 0.156862), 1, 'right red value'); is( close_enough($rgb[1], 0.03921), 1, 'right green value'); is( close_enough($rgb[2], 0.2352), 1, 'right blue value'); @hsb = $def->deconvert( [40/255, 10/255, 60/255], 'RGB'); is( int @hsb, 3, 'converted nice blue has three hsb values'); is( close_enough($hsb[0], 0.766666), 1, 'converted nice blue has computed right hue value'); is( close_enough($hsb[1], .83), 1, 'converted nice blue has computed right saturation'); is( close_enough($hsb[2], .24), 1, 'converted nice blue has computed right brightness'); exit 0; 16_space_hwb.t100644001750001750 673614503102425 21134 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 37; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HWB'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'HWB', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); ok( !$def->check([0,0,0]), 'check hsl values works on lower bound values'); ok( !$def->check([360,100,100]), 'check hsl values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check cmy got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check cmy got too many values"; warning_like {$def->check([-1, 0, 0])} {carped => qr/hue value/}, "hue value is too small"; warning_like {$def->check([0.5, 0,0])} {carped => qr/hue value/}, "hue value is not integer"; warning_like {$def->check([361, 0,0])} {carped => qr/hue value/}, "hue value is too big"; warning_like {$def->check([0, -1, 0])} {carped => qr/whiteness value/}, "whiteness value is too small"; warning_like {$def->check([0, 0.5,0])} {carped => qr/whiteness value/}, "whiteness value is not integer"; warning_like {$def->check([0, 101,0])} {carped => qr/whiteness value/}, "whiteness value is too big"; warning_like {$def->check([0,0, -1 ])} {carped => qr/blackness value/}, "blackness value is too small"; warning_like {$def->check([0,0, 0.5])} {carped => qr/blackness value/}, "blackness value is not integer"; warning_like {$def->check([0,0, 101])} {carped => qr/blackness value/}, "blackness value is too big"; my @hwb = $def->deconvert( [ .5, .5, .5], 'RGB'); is( int @hwb, 3, 'converted color grey has three hwb values'); is( $hwb[0], 0, 'converted color grey has computed right hue value'); is( $hwb[1], .5, 'converted color grey has computed right whiteness'); is( $hwb[2], .5, 'converted color grey has computed right blackness'); my @rgb = $def->convert( [0, 0.5, .5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @hwb = $def->deconvert( [210/255, 20/255, 70/255], 'RGB'); is( int @hwb, 3, 'converted nice magents has three hwb values'); is( close_enough( $hwb[0], 0.95555), 1, 'converted nice magenta has computed right hue value'); is( close_enough( $hwb[1], 0.08, ), 1, 'converted nice magenta has computed right whiteness'); is( close_enough( $hwb[2], 0.18, ), 1, 'converted nice magenta has computed right blackness'); @rgb = $def->convert( [0.95555, 0.08, 0.18], 'RGB'); is( int @rgb, 3, 'converted back nice magenta'); is( close_enough( $rgb[0], 210/255), 1, 'right red value'); is( close_enough( $rgb[1], 20/255) , 1, 'right green value'); is( close_enough( $rgb[2], 70/255) , 1, 'right blue value'); @rgb = $def->convert( [0.83333, 0, 1], 'RGB'); # should become black despite color value is( int @rgb, 3, 'converted black'); is( $rgb[0], 0, 'right red value'); is( $rgb[1], 0, 'right green value'); is( $rgb[2], 0, 'right blue value'); exit 0; 17_space_yiq.t100644001750001750 725614503102425 21155 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 40; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::YIQ'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'YIQ', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); is( $def->is_array([0,0,0]), 1, 'vector has 3 elements'); is( $def->is_partial_hash({i => 1, quadrature => 0}), 1, 'found hash with some keys'); is( $def->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $def->can_convert('yiq'), 0, 'can not convert to itself'); is( $def->format([0,0,0], 'css_string'), 'yiq(0,0,0)', 'can format css string'); my @val = $def->deformat(['YIQ', 1, 0, -0.1]); is( int @val, 3, 'deformated value triplet (vector)'); is( $val[0], 1, 'first value good'); is( $val[1], 0, 'second value good'); is( $val[2], -0.1, 'third value good'); ok( !$def->check([0, -0.5959, -0.5227]), 'check YIO values works on lower bound values'); ok( !$def->check([1, 0.5959, 0.5227]), 'check YIO values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check YIQ got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check YIQ got too many values"; is( $def->check([0,0,0]), undef, 'checked neutral values'); warning_like {$def->check([-0.1, 0, 0])} {carped => qr/luminance value is below/}, "luminance value is too small"; warning_like {$def->check([ 1.1, 0,0])} {carped => qr/luminance value is above/}, "luminance value is too big"; warning_like {$def->check([0, -0.6, 0])} {carped => qr/in-phase value is below/}, "whiteness value is too small"; warning_like {$def->check([0, 0.6,0])} {carped => qr/in-phase value is above/}, "whiteness value is too big"; warning_like {$def->check([0,0, -0.53 ])} {carped => qr/quadrature value is below/},"quadrature value is too small"; warning_like {$def->check([0,0, 0.53])} {carped => qr/quadrature value is above/}, "quadrature value is too big"; my @yiq = $def->deconvert( [ 0.5, 0.5, 0.5], 'RGB'); is( int @yiq, 3, 'converted color grey has three YIQ values'); is( $yiq[0], 0.5, 'converted color grey has computed right luminance value'); is( $yiq[1], 0.5, 'converted color grey has computed right in-phase'); is( $yiq[2], 0.5, 'converted color grey has computed right quadrature'); my @rgb = $def->convert( [0.5, 0.5, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @yiq = $def->deconvert( [0.1, 0, 1], 'RGB'); is( int @yiq, 3, 'converted blue has three YIQ values'); is( close_enough( $yiq[0], 0.1439 ) , 1 , 'converted nice blue has right Y value'); is( close_enough( $yiq[1], 0.280407787), 1 , 'converted nice blue has right I value'); is( close_enough( $yiq[2], 0.817916587), 1 , 'converted nice blue has right Q value'); @rgb = $def->convert( [0.1439, 0.280407787, 0.817916587], 'RGB'); is( int @rgb, 3, 'converted back nice blue'); is( close_enough($rgb[0], 0.1), 1, 'right red value'); is( close_enough($rgb[1], 0 ), 1, 'right green value'); is( close_enough($rgb[2], 1, ), 1, 'right blue value'); exit 0; 18_space_lab.t100644001750001750 725614503102425 21112 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 40; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::YIQ'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'YIQ', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); is( $def->is_array([0,0,0]), 1, 'vector has 3 elements'); is( $def->is_partial_hash({i => 1, quadrature => 0}), 1, 'found hash with some keys'); is( $def->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $def->can_convert('yiq'), 0, 'can not convert to itself'); is( $def->format([0,0,0], 'css_string'), 'yiq(0,0,0)', 'can format css string'); my @val = $def->deformat(['YIQ', 1, 0, -0.1]); is( int @val, 3, 'deformated value triplet (vector)'); is( $val[0], 1, 'first value good'); is( $val[1], 0, 'second value good'); is( $val[2], -0.1, 'third value good'); ok( !$def->check([0, -0.5959, -0.5227]), 'check YIO values works on lower bound values'); ok( !$def->check([1, 0.5959, 0.5227]), 'check YIO values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check YIQ got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check YIQ got too many values"; is( $def->check([0,0,0]), undef, 'checked neutral values'); warning_like {$def->check([-0.1, 0, 0])} {carped => qr/luminance value is below/}, "luminance value is too small"; warning_like {$def->check([ 1.1, 0,0])} {carped => qr/luminance value is above/}, "luminance value is too big"; warning_like {$def->check([0, -0.6, 0])} {carped => qr/in-phase value is below/}, "whiteness value is too small"; warning_like {$def->check([0, 0.6,0])} {carped => qr/in-phase value is above/}, "whiteness value is too big"; warning_like {$def->check([0,0, -0.53 ])} {carped => qr/quadrature value is below/},"quadrature value is too small"; warning_like {$def->check([0,0, 0.53])} {carped => qr/quadrature value is above/}, "quadrature value is too big"; my @yiq = $def->deconvert( [ 0.5, 0.5, 0.5], 'RGB'); is( int @yiq, 3, 'converted color grey has three YIQ values'); is( $yiq[0], 0.5, 'converted color grey has computed right luminance value'); is( $yiq[1], 0.5, 'converted color grey has computed right in-phase'); is( $yiq[2], 0.5, 'converted color grey has computed right quadrature'); my @rgb = $def->convert( [0.5, 0.5, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @yiq = $def->deconvert( [0.1, 0, 1], 'RGB'); is( int @yiq, 3, 'converted blue has three YIQ values'); is( close_enough( $yiq[0], 0.1439 ) , 1 , 'converted nice blue has right Y value'); is( close_enough( $yiq[1], 0.280407787), 1 , 'converted nice blue has right I value'); is( close_enough( $yiq[2], 0.817916587), 1 , 'converted nice blue has right Q value'); @rgb = $def->convert( [0.1439, 0.280407787, 0.817916587], 'RGB'); is( int @rgb, 3, 'converted back nice blue'); is( close_enough($rgb[0], 0.1), 1, 'right red value'); is( close_enough($rgb[1], 0 ), 1, 'right green value'); is( close_enough($rgb[2], 1, ), 1, 'right blue value'); exit 0; 19_space_xyz.t100644001750001750 725614503102425 21207 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 40; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::YIQ'; my $def = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'YIQ', 'color space has right name'); is( $def->dimensions, 3, 'color space has 3 dimensions'); is( $def->is_array([0,0,0]), 1, 'vector has 3 elements'); is( $def->is_partial_hash({i => 1, quadrature => 0}), 1, 'found hash with some keys'); is( $def->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $def->can_convert('yiq'), 0, 'can not convert to itself'); is( $def->format([0,0,0], 'css_string'), 'yiq(0,0,0)', 'can format css string'); my @val = $def->deformat(['YIQ', 1, 0, -0.1]); is( int @val, 3, 'deformated value triplet (vector)'); is( $val[0], 1, 'first value good'); is( $val[1], 0, 'second value good'); is( $val[2], -0.1, 'third value good'); ok( !$def->check([0, -0.5959, -0.5227]), 'check YIO values works on lower bound values'); ok( !$def->check([1, 0.5959, 0.5227]), 'check YIO values works on upper bound values'); warning_like {$def->check([0,0])} {carped => qr/needs 3 values/}, "check YIQ got too few values"; warning_like {$def->check([0, 0, 0, 0])} {carped => qr/needs 3 values/}, "check YIQ got too many values"; is( $def->check([0,0,0]), undef, 'checked neutral values'); warning_like {$def->check([-0.1, 0, 0])} {carped => qr/luminance value is below/}, "luminance value is too small"; warning_like {$def->check([ 1.1, 0,0])} {carped => qr/luminance value is above/}, "luminance value is too big"; warning_like {$def->check([0, -0.6, 0])} {carped => qr/in-phase value is below/}, "whiteness value is too small"; warning_like {$def->check([0, 0.6,0])} {carped => qr/in-phase value is above/}, "whiteness value is too big"; warning_like {$def->check([0,0, -0.53 ])} {carped => qr/quadrature value is below/},"quadrature value is too small"; warning_like {$def->check([0,0, 0.53])} {carped => qr/quadrature value is above/}, "quadrature value is too big"; my @yiq = $def->deconvert( [ 0.5, 0.5, 0.5], 'RGB'); is( int @yiq, 3, 'converted color grey has three YIQ values'); is( $yiq[0], 0.5, 'converted color grey has computed right luminance value'); is( $yiq[1], 0.5, 'converted color grey has computed right in-phase'); is( $yiq[2], 0.5, 'converted color grey has computed right quadrature'); my @rgb = $def->convert( [0.5, 0.5, 0.5], 'RGB'); is( int @rgb, 3, 'converted back color grey has three rgb values'); is( $rgb[0], 0.5, 'converted back color grey has right red value'); is( $rgb[1], 0.5, 'converted back color grey has right green value'); is( $rgb[2], 0.5, 'converted back color grey has right blue value'); @yiq = $def->deconvert( [0.1, 0, 1], 'RGB'); is( int @yiq, 3, 'converted blue has three YIQ values'); is( close_enough( $yiq[0], 0.1439 ) , 1 , 'converted nice blue has right Y value'); is( close_enough( $yiq[1], 0.280407787), 1 , 'converted nice blue has right I value'); is( close_enough( $yiq[2], 0.817916587), 1 , 'converted nice blue has right Q value'); @rgb = $def->convert( [0.1439, 0.280407787, 0.817916587], 'RGB'); is( int @rgb, 3, 'converted back nice blue'); is( close_enough($rgb[0], 0.1), 1, 'right red value'); is( close_enough($rgb[1], 0 ), 1, 'right green value'); is( close_enough($rgb[2], 1, ), 1, 'right blue value'); exit 0; 30_space_hub.t100644001750001750 2221614503102425 21135 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 106; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Hub'; eval "use $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); my $deformat = \&Graphics::Toolkit::Color::Space::Hub::deformat; my $format = \&Graphics::Toolkit::Color::Space::Hub::format; my $deconvert = \&Graphics::Toolkit::Color::Space::Hub::deconvert; my $convert = \&Graphics::Toolkit::Color::Space::Hub::convert; my $normalize = \&Graphics::Toolkit::Color::Space::Hub::normalize; my $denormalize = \&Graphics::Toolkit::Color::Space::Hub::denormalize; my @hsl = $convert->([.5, .5, .5], 'HSL'); is( int @hsl, 3, 'converted hsl vector has right length'); is( $hsl[0], 0, 'converted color grey has computed right hue value'); is( $hsl[1], 0, 'converted color grey has computed right saturation'); is( $hsl[2], .5, 'converted color grey has computed right lightness'); my @rgb = $deconvert->([0, 0, .5], 'hsl'); is( int @rgb, 3, 'converted back color grey has rgb values'); is( $rgb[0], .5, 'converted back color grey has right red value'); is( $rgb[1], .5, 'converted back color grey has right green value'); is( $rgb[2], .5, 'converted back color grey has right blue value'); @rgb = $convert->([.1, -.2, 1.3], 'RGB'); is( int @rgb, 3, 'converted rgb vector has right length'); is( $rgb[0], .1, 'did not change red value'); is( $rgb[1], 0, 'clamped up green'); is( $rgb[2], 1, 'clamped blue even no conversion'); warning_like {$format->('112233', 'RGB', 'list')} {carped => qr/ARRAY ref with 3 RGB/}, "dont format none vectors"; warning_like {$format->([11,22,33,44], 'RGB', 'list')} {carped => qr/ARRAY ref with 3 RGB/}, "dont format too long vectors"; warning_like {$format->([11,22], 'RGB', 'list')} {carped => qr/ARRAY ref with 3 RGB/}, "dont format too short vectors"; my $str = $format->([11,22,33], 'RGB', 'hex'); is( ref $str, '', 'RGB string is not a reference'); is( uc $str, '#0B1621', 'created a RGB hex string'); @rgb = $format->([11,22,33], 'RGB', 'list'); is( int @rgb, 3, 'RGB list has right length'); is( $rgb[0], 11, 'put red value first'); is( $rgb[1], 22, 'put green value second'); is( $rgb[2], 33, 'put red value third'); my $h = $format->([1,2,3],'HSL', 'hash'); is( ref $h, 'HASH', 'created a HSL hash'); is( $h->{'hue'}, 1, 'put hue value under the right key'); is( $h->{'saturation'}, 2, 'put saturation value under the right key'); is( $h->{'lightness'}, 3, 'put lightness value under the right key'); $h = $format->([.2,.3,.4],'CMY', 'char_hash'); is( ref $h, 'HASH', 'created a CMY hash'); is( $h->{'c'}, .2, 'put hue value under the right key'); is( $h->{'m'}, .3, 'put saturation value under the right key'); is( $h->{'y'}, .4, 'put lightness value under the right key'); my ($rgb, $f) = $deformat->('#010203'); is( ref $rgb, 'ARRAY', 'deformated values int a list'); is( int @$rgb, 3, 'deformatted RGB hex string into triplet'); is( $rgb->[0], 1, 'deformatted red value from RGB hex string'); is( $rgb->[1], 2, 'deformatted green value from RGB hex string'); is( $rgb->[2], 3, 'deformatted blue value from RGB hex string'); is( $f, 'RGB', 'hex string was formatted in RGB'); ($rgb, $f) = $deformat->('#FFF'); is( ref $rgb, 'ARRAY', 'deformated values int a list'); is( int @$rgb, 3, 'deformatted RGB short hex string into triplet'); is( $rgb->[0], 255, 'deformatted red value from short RGB hex string'); is( $rgb->[1], 255, 'deformatted green value from short RGB hex string'); is( $rgb->[2], 255, 'deformatted blue value from short RGB hex string'); is( $f, 'RGB', 'short hex string was formatted in RGB'); my($cmy, $for) = $deformat->({c => 0.1, m => 0.5, Y => 1}); is( ref $cmy, 'ARRAY', 'got cmy key hash deformatted'); is( int @$cmy, 3, 'deformatted CMY HASH into triplet'); is( $cmy->[0], 0.1, 'cyan value correct'); is( $cmy->[1], 0.5, 'magenta value correct'); is( $cmy->[2], 1, 'yellow value is correct'); is( $for, 'CMY', 'key hash was formatted in CMY'); my($cmyk, $form) = $deformat->({c => -0.1, m => 0.5, Y => 2, k => 7}); is( ref $cmyk, 'ARRAY', 'got cmyk key hash deformatted'); is( int @$cmyk, 4, 'deformatted CMYK HASH into quadruel'); is( $cmyk->[0], -0.1, 'cyan value correct'); is( $cmyk->[1], 0.5, 'magenta value correct'); is( $cmyk->[2], 2, 'yellow value is correct'); is( $cmyk->[3], 7, 'key value got transported correctly'); is( $form, 'CMYK', 'key hash was formatted in CMY'); ($cmyk, $form) = $deformat->([cmyk => -0.1, 0.5, 2, 7]); is( ref $cmyk, 'ARRAY', 'got cmyk named ARRAY deformatted'); is( int @$cmyk, 4, 'deformatted CMYK ARRAY into quadrupel'); is( $cmyk->[0], -0.1, 'cyan value correct'); is( $cmyk->[1], 0.5, 'magenta value correct'); is( $cmyk->[2], 2, 'yellow value is correct'); is( $cmyk->[3], 7, 'key value got transported correctly'); is( $form, 'CMYK', 'named array recognized as CMYK'); ($cmyk, $form) = $deformat->('CMYK: -0.1, 0.5, 2, 7'); is( ref $cmyk, 'ARRAY', 'got cmyk STRING deformatted'); is( int @$cmyk, 4, 'deformatted CMYK STRING into quadruel'); is( $cmyk->[0], -0.1, 'cyan value correct'); is( $cmyk->[1], 0.5, 'magenta value correct'); is( $cmyk->[2], 2, 'yellow value is correct'); is( $cmyk->[3], 7, 'key value got transported correctly'); is( $form, 'CMYK', 'named array recognized as CMYK'); ($rgb, $f) = $deformat->({c => 0.1, n => 0.5, Y => 1}); is( ref $rgb, '', 'could not deformat cmy hash due bak key name'); # test partial_hash_deformat my $ph_deformat = \&Graphics::Toolkit::Color::Space::Hub::partial_hash_deformat; my ($pos_hash, $space_name) = $ph_deformat->(); is( $pos_hash, undef, 'got no HASH'); ($pos_hash, $space_name) = $ph_deformat->({}); is( $pos_hash, undef, 'HASH was empty'); ($pos_hash, $space_name) = $ph_deformat->({red => 255}); is( ref $pos_hash, 'HASH', 'partial hash could be deformated'); is( keys %$pos_hash, 1, 'there was only one key'); is( $pos_hash->{0}, 255, 'red value belongs on first position'); is( $space_name, 'RGB', 'found keys in RGB'); ($pos_hash, $space_name) = $ph_deformat->({H => 2, vAlue => 3}); is( ref $pos_hash, 'HASH', 'partial hash could be deformated, even one key was shortcut'); is( keys %$pos_hash, 2, 'there were two keys'); is( $pos_hash->{2}, 3, 'value is on third position in HSV'); is( $space_name, 'HSV', 'found keys in HSV'); ($pos_hash, $space_name) = $ph_deformat->({ whiteness => 1}); is( $pos_hash->{1}, 1, 'value is on second position in HWB'); is( $space_name, 'HWB', 'found keys in HWB'); warning_like { $normalize->({})} {carped => qr/need an ARRAY ref with 3 RGB/}, "normalize: first arg in bad format"; warning_like { $normalize->([1,2])} {carped => qr/need an ARRAY ref with 3 RGB/}, "normalize: not enough values in vector"; warning_like { $normalize->([1,2,3], 'BAD')} {carped => qr/unknown color space/}, "normalize: bas color space name"; warning_like { $normalize->([1,2,3], 'HSL', {})} {carped => qr/bad range/}, "normalize: bad range definition"; warning_like { $denormalize->({})} {carped => qr/need an ARRAY ref with 3 RGB/}, "denormalize: first arg in bad format"; warning_like { $denormalize->([1,2])} {carped => qr/need an ARRAY ref with 3 RGB/}, "denormalize: not enough values in vector"; warning_like { $denormalize->([1,2,3], 'BAD')} {carped => qr/unknown color space/}, "denormalize: bas color space name"; warning_like { $denormalize->([1,2,3], 'HSL', {})} {carped => qr/bad range/}, "denormalize: bad range definition"; my @rgb_n = $normalize->([10,20,30]); is( int @rgb_n, 3, 'normalized RGB by default'); is( close_enough( $rgb_n[0], 10/255), 1, 'red value correct'); is( close_enough( $rgb_n[1], 20/255), 1, 'green value correct'); is( close_enough( $rgb_n[2], 30/255), 1, 'blue value is correct'); @rgb_n = $normalize->([10,20,30], 'RGB', 100); is( int @rgb_n, 3, 'normalized RGB with special range'); is( $rgb_n[0], 0.1, 'red value correct'); is( $rgb_n[1], 0.2, 'green value correct'); is( $rgb_n[2], 0.3, 'blue value is correct'); @rgb_n = $denormalize->([0.1,0.2,0.3], 'RGB', 100); is( int @rgb_n, 3, 'denormalized RGB with special range'); is( $rgb_n[0], 10, 'red value correct'); is( $rgb_n[1], 20, 'green value correct'); is( $rgb_n[2], 30, 'blue value is correct'); my @hsl_n = $normalize->([480, 20, -10], 'HSL'); is( int @hsl_n, 3, 'normalized HSL'); is( close_enough( $hsl_n[0], 1/3), 1, 'hue rotated down'); is( $hsl_n[1], .2, 'saturation value clamped up'); is( $hsl_n[2], 0, 'lightness value is correct'); exit 0; 53_color_set.t100644001750001750 1554214503102425 21206 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl # use v5.12; use warnings; use Test::More tests => 62; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color qw/color/; my $red = Graphics::Toolkit::Color->new('#FF0000'); my $white = Graphics::Toolkit::Color->new('white'); my $black = Graphics::Toolkit::Color->new('black'); is( $black->gradient( to => $white, steps => 1 )->name, 'black','shortest gradient is $self'); my @g = $black->gradient_to( $white, 2 ); is( int @g, 2, 'gradient with length 2 has only boundary cases'); is( $g[0]->name, 'black', 'gradient with length 2 starts on left boundary'); is( $g[1]->name, 'white', 'gradient with length 2 ends on right boundary'); @g = $black->gradient_to( $white, 6 ); is( int @g, 6, 'gradient has right length = 6'); is( $g[1]->name, 'gray20', 'grey20 is between black and white'); is( $g[2]->name, 'gray40', 'grey40 is between black and white'); @g = $black->gradient_to( $white, 3, 0 ); is( int @g, 3, 'gradient has right length = 3'); is( $g[1]->name, 'gray', 'gray aka grey50 is between black and white in none linear gradient'); @g = $black->gradient_to( $white, 3, -1.4 ); is( $g[1]->name, 'gray75', 'grey75 is between black and white in none linear gradient'); @g = $red->gradient( to=>'#0000FF', steps => 3, in => 'RGB' ); is( $g[1]->name, 'purple', 'purple is between red and blue in RGB'); @g = $black->complement(); is( int @g, 1, "default is one complementary color"); is( $black->complementary()->name, 'black', "black has no complementary color"); is( $white->complementary()->name, 'white', "white has no complementary color"); is( $red->complementary()->name, 'aqua', "aqua is complementary to red"); @g = $red->complement(steps => 3); is( int @g, 3, "requested amount of complementary colors"); is( ($g[0]->values('HSL'))[1], ($g[1]->values('HSL'))[1], "saturation is equal on complementary circle"); is( ($g[1]->values('HSL'))[1], ($g[2]->values('HSL'))[1], "saturation is equal on complementary circle 2"); is( ($g[0]->values('HSL'))[2], ($g[1]->values('HSL'))[2], "lightness is equal on complementary circle"); is( ($g[1]->values('HSL'))[2], ($g[2]->values('HSL'))[2], "lightness is equal on complementary circle 2"); is( $g[0]->name, 'red', "complementary circle starts with C1"); is( $g[1]->name, 'lime', "complementary gos on to green"); is( $g[2]->name, 'blue', "complementary circle ends with blue"); @g = Graphics::Toolkit::Color->new(15,12,13)->complement( steps => 3); my @hsl0 = $g[0]->values('HSL'); my @hsl1 = $g[1]->values('HSL'); my @hsl2 = $g[2]->values('HSL'); is( $hsl0[1], $hsl1[1], "saturation is equal on complementary circle of random color"); is( $hsl1[1], $hsl2[1], "saturation is equal on complementary circle 2"); is( $hsl0[2], $hsl1[2], "lightness is equal on complementary circle of random color"); is( $hsl1[2], $hsl2[2], "lightness is equal on complementary circle 2"); @g = Graphics::Toolkit::Color->new(15,12,13)->complement( steps => 4, s => 12, l => 20 ); is( int @g, 4, "requested amount of complementary colors"); is( ($g[1]->values('HSL'))[0]+270, ($g[0]->values('HSL'))[0], "first hue value has expected 90 degree angle"); is( ($g[2]->values('HSL'))[0]+180, ($g[0]->values('HSL'))[0], "second hue value has expected 180 degree angle"); is( ($g[3]->values('HSL'))[0]+ 90, ($g[0]->values('HSL'))[0], "third hue value has expected 270 degree angle"); is( ($g[0]->values('HSL'))[1], ($g[2]->values('HSL'))[1], "tilted saturation still undisturbed on positions 0 and 2"); is( ($g[0]->values('HSL'))[2], ($g[2]->values('HSL'))[2], "tilted lightness still undisturbed on positions 0 and 2"); is( ($g[1]->values('HSL'))[1]-12, ($g[0]->values('HSL'))[1], "saturation om Dmax has expected value"); is( ($g[1]->values('HSL'))[2]-20, ($g[0]->values('HSL'))[2], "lightness om Dmax has expected value"); is( ($g[3]->values('HSL'))[1], 0, "saturation om Dmin got to absolute minimum"); is( ($g[3]->values('HSL'))[2], 0, "lightness om Dmin got to absolute minimum"); @g = Graphics::Toolkit::Color->new(15,12,13)->complement( steps => 7, hue_tilt => 40, saturation_tilt => { s => 5, h => -30 }, lightness_tilt => { l => 20, h => 50 }); is( int @g, 7, "requested amount of complementary colors"); my @hsl = map {[$g[$_]->values('HSL')]} 0 .. 6; is( int @g, 7, "amount is right"); is( $hsl[3][0] < 200, 1, "first three colors are before Dmax"); is( $hsl[4][0] > 200, 1, "second three colors are after Dmax"); is( $hsl[0][0], 340, "C1 hue did not move"); is( $hsl[1][0], 38, "second color hue is correct"); is( $hsl[2][0], 108, "third color hue is correct"); is( $hsl[3][0], 173, "fourth color hue is correct"); is( $hsl[4][0], 224, "5. color hue is correct"); is( $hsl[5][0], 262, "6. color hue is correct"); is( $hsl[6][0], 295, "7. color hue is correct"); is( $hsl[0][1], 13, "saturation of 1. color"); is( $hsl[1][1], 16, "saturation of 2. color"); is( $hsl[2][1], 14, "saturation of 3. color"); is( $hsl[3][1], 11, "saturation of 4. color"); is( $hsl[4][1], 8, "saturation of 5. color"); is( $hsl[5][1], 7, "saturation of 6. color"); is( $hsl[6][1], 10, "saturation of 7. color"); is( $hsl[0][2], 0, "C1 hue did not move"); is( $hsl[1][2], 5, "second color hue is correct"); is( $hsl[2][2], 17, "third color hue is correct"); is( $hsl[3][2], 22, "fourth color hue is correct"); is( $hsl[4][2], 10, "5. color hue is correct"); is( $hsl[5][2], 0, "6. color hue is correct"); is( $hsl[6][2], 0, "7. color hue is correct"); exit 0; 12_space_cmyk.t100644001750001750 1171414503102425 21323 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 65; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::CMYK'; my $def = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $def, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $def->name, 'CMYK', 'color space has right name'); is( $def->dimensions, 4, 'color space has 4 dimensions'); ok( !$def->check([0,0,0,0]), 'check cmy values works on lower bound values'); ok( !$def->check([1, 1, 1,1]), 'check cmy values works on upper bound values'); warning_like {$def->check([0,0,0])} {carped => qr/needs 4 values/}, "check cmyk got too few values"; warning_like {$def->check([0,0,0,0,0])} {carped => qr/needs 4 values/}, "check cmyk got too many values"; warning_like {$def->check([-1,0,0,0])} {carped => qr/cyan value/}, "cyan value is too small"; warning_like {$def->check([2,0,0,0])} {carped => qr/cyan value/}, "cyan value is too big"; warning_like {$def->check([0,-1,0,0])} {carped => qr/magenta value/}, "magenta value is too small"; warning_like {$def->check([0,2,0,0])} {carped => qr/magenta value/}, "magenta value is too big"; warning_like {$def->check([0,0,-1,0])} {carped => qr/yellow value/}, "yellow value is too small"; warning_like {$def->check([0,0,2,0])} {carped => qr/yellow value/}, "yellow value is too big"; warning_like {$def->check([0,0,0,-1])} {carped => qr/key value/}, "key value is too small"; warning_like {$def->check([0,0,0,2])} {carped => qr/key value/}, "key value is too big"; my @cmyk = $def->clamp([]); is( int @cmyk, 4, 'missing args are clamped down to black (default color)'); is( $cmyk[0], 0, 'default color is black (C)'); is( $cmyk[1], 0, 'default color is black (M)'); is( $cmyk[2], 0, 'default color is black (Y)'); is( $cmyk[3], 0, 'default color is black (K)'); @cmyk = $def->clamp([0.1, 0.2, 0.3]); is( int @cmyk, 4, 'clamp added missing argument in vector'); is( $cmyk[0], 0.1, 'passed (C) value when too few args'); is( $cmyk[1], 0.2, 'passed (M) value when too few args'); is( $cmyk[2], 0.3, 'passed (Y) value when too few args'); is( $cmyk[3], 0, 'added zero value (K) when too few args'); @cmyk = $def->clamp([0.1, 0.2, 0.3, 0.4, 0.5]); is( int @cmyk, 4, 'clamp removed missing argument in vector'); is( $cmyk[0], 0.1, 'passed (C) value when too few args'); is( $cmyk[1], 0.2, 'passed (M) value when too few args'); is( $cmyk[2], 0.3, 'passed (Y) value when too few args'); is( $cmyk[3], 0.4, 'added (K) value when too few args'); @cmyk = $def->clamp([-1,0,1,1.1]); is( int @cmyk, 4, 'clamp kept vector length'); is( $cmyk[0], 0, 'too low cyan value is clamped up'); is( $cmyk[1], 0, 'min magenta value is kept'); is( $cmyk[2], 1, 'max yellow value is kept'); is( $cmyk[3], 1, 'too large key value is clamped down'); @cmyk = $def->deconvert( [0.5, 0.5, 0.5], 'RGB'); is( int @cmyk, 4, 'converted grey has four cmyk values'); is( $cmyk[0], 0, 'converted grey has right cyan value'); is( $cmyk[1], 0, 'converted grey has right magenta value'); is( $cmyk[2], 0, 'converted grey has right yellow value'); is( $cmyk[3], 0.5, 'converted grey has right key value'); my @rgb = $def->convert( [0, 0, 0, 0.5], 'RGB'); is( int @rgb, 3, 'converted back grey has three rgb values'); is( $rgb[0], 0.5, 'converted back grey has right red value'); is( $rgb[1], 0.5, 'converted back grey has right green value'); is( $rgb[2], 0.5, 'converted back grey has right blue value'); @cmyk = $def->deconvert( [0.3, 0.4, 0.5], 'RGB'); is( int @cmyk, 4, 'converted color has four cmyk values'); is( $cmyk[0], 0.4, 'converted color has right cyan value'); is( $cmyk[1], 0.2, 'converted color has right magenta value'); is( $cmyk[2], 0 , 'converted color has right yellow value'); is( $cmyk[3], 0.5, 'converted color has right key value'); @rgb = $def->convert( [0.4, 0.2, 0, 0.5], 'RGB'); is( int @rgb, 3, 'trimmed and converted back color black'); is( $rgb[0], 0.3, 'right red value'); is( $rgb[1], 0.4, 'right green value'); is( $rgb[2], 0.5, 'right blue value'); @cmyk = $def->deformat([cmyk => 11, 22, 256, -1]); is( int @cmyk, 4, 'deformat lc named ARRAY: got 4 values'); is( $cmyk[0], 11, 'cyan got transported'); is( $cmyk[1], 22, 'also too large magenta'); is( $cmyk[2], 256, 'yallow transported, range ignored'); is( $cmyk[3], -1, 'too small key ignored'); @cmyk = $def->deformat(['CMYK', 11, 22, 33]); is( $cmyk[0], undef, 'OO deformat reacts only to right amount of values'); @cmyk = $def->deformat('cmyk: -1, 256, 3.3, 4 '); is( int @cmyk, 4, 'deformat STRING: got 4 values'); is( $cmyk[0], -1, 'cyan'); is( $cmyk[1], 256, 'magenta'); is( $cmyk[2], 3.3, 'yellow'); is( $cmyk[3], 4, 'key value'); exit 0; 02_space_basis.t100644001750001750 2223414503102425 21457 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 105; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Basis'; eval "use $module"; is( not($@), 1, 'could load the module'); my $obj = Graphics::Toolkit::Color::Space::Basis->new(); is( $obj, undef, 'constructor needs arguments'); $obj = Graphics::Toolkit::Color::Space::Basis->new([1]); is( ref $obj, $module, 'one constructor argument is enough'); my $bad = Graphics::Toolkit::Color::Space::Basis->new(qw/Aleph beth gimel daleth he/); my $s3d = Graphics::Toolkit::Color::Space::Basis->new([qw/Alpha beta gamma/]); my $s5d = Graphics::Toolkit::Color::Space::Basis->new([qw/Aleph beth gimel daleth he/], [qw/m n o p q/]); is( $bad, undef, 'need as els axis name array as argument'); is( ref $s3d, $module, 'created 3d space'); is( ref $s5d, $module, 'created 5d space'); is( $s3d->count, 3, 'did count three args'); is( $s5d->count, 5, 'did count five args'); is( ($s3d->keys)[0], 'alpha', 'repeat first 3d key back'); is( ($s3d->keys)[-1], 'gamma', 'repeat last 5d key back'); is( ($s5d->keys)[0], 'aleph', 'repeat first 3d key back'); is( ($s5d->keys)[-1], 'he', 'repeat last 5d key shortcut back'); is( ($s3d->shortcuts)[0], 'a', 'repeat first 3d key shortcut back'); is( ($s3d->shortcuts)[-1], 'g', 'repeat last 5d key shortcut back'); is( ($s5d->shortcuts)[0], 'm', 'repeat first 3d key shortcut back'); is( ($s5d->shortcuts)[-1], 'q', 'repeat last 5d key shortcut back'); is( $s3d->name, 'ABG', 'correct name from 3 initials'); is( $s5d->name, 'MNOPQ', 'correct name from 5 initials'); is( ($s3d->iterator)[-1], 2, 'correct last value of 0..2 iterator'); is( ($s5d->iterator)[-1], 4, 'correct last value of 0..4 iterator'); is( $s3d->is_key('Alpha'), 1, 'found key alpha'); is( $s3d->is_key('zeta'), 0, 'not found made up key zeta'); is( $s5d->is_key('gimel'), 1, 'found key gimel'); is( $s5d->is_key('lamed'), 0, 'not found made up key lamed'); is( $s3d->is_shortcut('G'), 1, 'found key shortcut g'); is( $s3d->is_shortcut('e'), 0, 'not found made up key shortcut e'); is( $s5d->is_shortcut('P'), 1, 'found key shortcut H'); is( $s5d->is_shortcut('l'), 0, 'not found made up key shortcut l'); is( $s3d->is_key_or_shortcut('Alpha'), 1, 'alpha is a key'); is( $s3d->is_key_or_shortcut('A'), 1, 'a is a shortcut'); is( $s3d->is_key_or_shortcut('Cen'), 0, 'Cen is not a key'); is( $s3d->is_key_or_shortcut('C'), 0, 'c is not a shortcut'); is( $s3d->is_array({}), 0, 'HASH is not an ARRAY'); is( $s3d->is_array([]), 0, 'empty ARRAY has not enogh content'); is( $s3d->is_array([2,2]), 0, 'too small ARRAY'); is( $s3d->is_array([1,2,3,4]), 0, 'too large ARRAY'); is( $s3d->is_array([1,2,3]), 1, 'correctly sized value ARRAY'); is( $s3d->is_hash([]), 0, 'array is not a hash'); is( $s3d->is_hash({alpha => 1, beta => 20, gamma => 3}), 1, 'valid hash with right keys'); is( $s3d->is_hash({ALPHA => 1, Beta => 20, gamma => 3}), 1, 'key casing gets ignored'); is( $s3d->is_hash({a => 1, b => 1, g => 3}), 1, 'valid shortcut hash'); is( $s3d->is_hash({a => 1, B => 1, g => 3}), 1, 'shortcut casing gets ignored'); is( $s3d->is_hash({a => 1, b => 1, g => 3, h => 4}), 0, 'too many hash key shortcut '); is( $s3d->is_hash({alph => 1, beth => 1, gimel => 4, daleth => 2, he => 4}), 0, 'one wrong hash key'); is( $s5d->is_partial_hash([]), 0, 'array is not a partial hash'); is( $s5d->is_partial_hash({aleph => 1, beth => 2, gimel => 3, daleth => 4, he => 5}), 1, 'valid hash with right keys is also correct partial hash'); is( $s5d->is_partial_hash({aleph => 1, beth => 20, gimel => 3, daleth => 4, he => 5, o => 6}), 0, 'partial hash can not have more keys than full hash definition'); is( $s5d->is_partial_hash({aleph => 1 }), 1, 'valid partial hash to have only one korrect key'); is( $s5d->is_partial_hash({ALEPH => 1 }), 1, 'ignore casing'); is( $s5d->is_partial_hash({aleph => 1, bet => 2, }), 0, 'one bad key makes partial invalid'); is( $s3d->key_pos('alpha'), 0, 'alpha is the first key'); is( $s3d->key_pos('beta'), 1, 'beta is the second key'); is( $s3d->key_pos('emma'), undef, 'emma is not akey'); is( $s5d->key_pos('aleph'), 0, 'aleph is the first key'); is( $s5d->key_pos('he'), 4, 'he is the fourth key'); is( $s5d->key_pos('emma'), undef, 'emma is not akey'); is( ref $s3d->shortcut_hash_from_list(1,2,3), 'HASH', 'HASH with given values and shortcut keys created'); is( ref $s3d->shortcut_hash_from_list(1,2,3,4), '', 'HASH not created because too many arguments'); is( ref $s3d->shortcut_hash_from_list(1,2), '', 'HASH not created because not enough arguments'); is( $s3d->shortcut_hash_from_list(1,2,3)->{'a'}, 1, 'right value under "a" key in the converted hash'); is( $s3d->shortcut_hash_from_list(1,2,3)->{'b'}, 2, 'right value under "b" key in the converted hash'); is( $s3d->shortcut_hash_from_list(1,2,3)->{'g'}, 3, 'right value under "g" key in the converted hash'); is( int keys %{$s3d->shortcut_hash_from_list(1,2,3)}, 3, 'right amount of shortcut keys'); is( ref $s5d->key_hash_from_list(1,2,3,4,5), 'HASH', 'HASH with given values and full name keys created'); is( ref $s5d->key_hash_from_list(1,2,3,4,5,6), '', 'HASH not created because too many arguments'); is( ref $s5d->key_hash_from_list(1,2,3,4), '', 'HASH not created because not enough arguments'); is( $s5d->key_hash_from_list(1,2,3,4,5)->{'aleph'}, 1, 'right value under "aleph" key in the converted hash'); is( $s5d->key_hash_from_list(1,2,3,4,5)->{'beth'}, 2, 'right value under "beta" key in the converted hash'); is( $s5d->key_hash_from_list(1,2,3,4,5)->{'gimel'}, 3, 'right value under "gimel" key in the converted hash'); is( $s5d->key_hash_from_list(1,2,3,4,5)->{'daleth'}, 4, 'right value under "daleth" key in the converted hash'); is( $s5d->key_hash_from_list(1,2,3,4,5)->{'he'}, 5, 'right value under "he" key in the converted hash'); is( int keys %{$s5d->key_hash_from_list(1,2,3,4,5)}, 5, 'right amount of shortcut keys'); my @list = $s5d->list_from_hash( {aleph => 1, beth => 2, gimel => 3, daleth => 4, he => 5} ); is( int @list, 5, 'right of values extracted keys'); is( $list[0], 1, 'first extracted value is correct'); is( $list[1], 2, 'second extracted value is correct'); is( $list[2], 3, 'third extracted value is correct'); is( $list[3], 4, 'fourth extracted value is correct'); is( $list[4], 5, 'fifth extracted value is correct'); @list = $s5d->list_from_hash( {aleph => 1, beth => 2, O => 3, daleth => 4, y => 5} ); is( $list[0], undef, 'no values extraced because one key was wrong'); is( $s3d->list_value_from_key('alpha', 1,2,3), 1, 'got correct first value from list by key'); is( $s3d->list_value_from_key('beta', 1,2,3), 2, 'got correct second value from list by key'); is( $s3d->list_value_from_key('gamma', 1,2,3), 3, 'got correct third value from list by key'); is( $s3d->list_value_from_key('he', 1,2,3), undef, 'get undef when asking with unknown key'); is( $s3d->list_value_from_key('alpha', 1,2), undef, 'get undef when giving not enough values'); is( $s3d->list_value_from_shortcut('a', 1,2,3), 1, 'got correct first value from list by shortcut'); is( $s3d->list_value_from_shortcut('b', 1,2,3), 2, 'got correct second value from list by shortcut'); is( $s3d->list_value_from_shortcut('g', 1,2,3), 3, 'got correct third value from list by shortcut'); is( $s3d->list_value_from_shortcut('h', 1,2,3), undef, 'get undef when asking with unknown key'); is( $s3d->list_value_from_key('a ', 1,2), undef, 'get undef when giving not enough values'); is( $s3d->deformat_partial_hash(), undef, 'partial deformat needs an HASH'); is( $s3d->deformat_partial_hash({}), undef, 'partial deformat needs an not empty HASH'); is( $s3d->deformat_partial_hash({a=>1,b=>1,g=>1,k=>1}), undef, 'partial HASH is too long'); is( ref $s3d->deformat_partial_hash({a=>1,b=>2,g=>3}), 'HASH', 'partial HASH has all the keys'); my $ph = $s3d->deformat_partial_hash({Alpha=>1,b=>2,g=>3}); is( ref $ph, 'HASH', 'deparse all keys with mixed case and shortcut'); is( $ph->{0}, 1, 'first key has right value'); is( $ph->{1}, 2, 'second key has right value'); is( $ph->{2}, 3, 'third key has right value'); is( int keys %$ph, 3, 'right amount of keys in deparsed hash'); $ph = $s3d->deformat_partial_hash({gamma => 3}); is( ref $ph, 'HASH', 'deparse just one key with mixed case and shortcut'); is( $ph->{2}, 3, 'third and only key has right value'); is( int keys %$ph, 1, 'right amount of keys in deparsed hash'); $ph = $s5d->deformat_partial_hash({Aleph => 6, q => 5}); is( ref $ph, 'HASH', 'deparse just two keys with mixed case and shortcut'); is( $ph->{0}, 6, 'first key aleph has right value'); is( $ph->{4}, 5, 'second key He has right value'); is( int keys %$ph, 2, 'right amount of keys in deparsed hash'); exit 0; 03_space_shape.t100644001750001750 1461114503102425 21457 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 75; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Shape'; eval "use $module;"; is( not($@), 1, 'could load the module'); use Graphics::Toolkit::Color::Space::Basis; my $obj = Graphics::Toolkit::Color::Space::Shape->new(); is( $obj, undef, 'constructor needs arguments'); my $basis = Graphics::Toolkit::Color::Space::Basis->new( [qw/AAA BBB CCC/] ); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, {}), undef, 'range definition needs to be an ARRAY'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3] ]), undef, 'not enough dimensions'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,3],[1,3] ]), undef, 'too many dimensions'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1] ]), undef, 'one dimension had too short def'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2,3] ]), undef, 'one dimension had too long def'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[2,2] ]), undef, 'range min is not smaller than max'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2] ],{}), undef, 'type def has to be array too'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2] ],[1,1]), undef, 'type def too short'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2] ],[1,1,1,1]), undef, 'type def too long'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2] ],[1,1,2]), undef, 'type def has out of range val'); is( Graphics::Toolkit::Color::Space::Shape->new( $basis, [[1,3],[1,3],[1,2] ],[1,1,'blub']), undef, 'unknown type name'); my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, 20); is( ref $shape, $module, 'created shape with 0..20 range'); my $bshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, [[-5,5],[-5,5],[-5,5]], ['angle', 'circular', 0]); is( ref $bshape, $module, 'created 3D bowl shape with -5..5 range'); my @d = $shape->delta(1, [1,5,4,5] ); is( int @d, 0, 'reject compute delta on none vector on first arg position'); @d = $shape->delta([1,5,4,5], 1 ); is( int @d, 0, 'reject compute delta on none vector on second arg position'); @d = $shape->delta([2,3,4,5], [1,5,4] ); is( int @d, 0, 'reject compute delta on too long first vector'); @d = $shape->delta([2,3], [1,5,1] ); is( int @d, 0, 'reject compute delta on too short first vector'); @d = $shape->delta([2,3,4], [5,1,4,5] ); is( int @d, 0, 'reject compute delta on too long second vector'); @d = $shape->delta([2,3,4], [5,1] ); is( int @d, 0, 'reject compute delta on too short second vector'); @d = $shape->delta([2,3,4], [1,5,1.1] ); is( int @d, 3, 'linear delta result has right length'); is( $d[0], -1, 'first delta value correct'); is( $d[1], 2, 'second delta value correct'); is( $d[2], -2.9, 'third delta value correct'); @d = $bshape->delta([0.1,0.9, .2], [0.9, 0.1, 0.8] ); is( int @d, 3, 'circular delta result has right length'); is( $d[0], -0.2, 'first delta value correct'); is( $d[1], .2, 'second delta value correct'); is( $d[2], -0.4, 'third delta value correct'); my @tr = $shape->clamp([-1, 0, 20.1, 21, 1]); is( int @tr, 3, 'clamp down to correct vector length = 3'); is( $tr[0], 0, 'clamp up value below minimum'); is( $tr[1], 0, 'do not touch minimal value'); is( $tr[2], 20, 'clamp real into int'); @tr = $shape->clamp( [360, 20] ); is( int @tr, 3, 'clamp added missing value'); is( $tr[0], 20, 'clamp down too large circular value'); is( $tr[1], 20, 'value was just max, clamped to min'); is( $tr[2], 0, 'added a zero into missing value'); @tr = $bshape->clamp( [-5.1, 6, 2] ); is( int @tr, 3, 'clamp kept right amount of values'); is( $tr[0], 5, 'rotated up too small value'); is( $tr[1], -4, 'value was just max, clamped to min'); is( $tr[2], 2, 'in range valu is kept'); @tr = $shape->clamp( [6, -1, 11], [5,7,[-5, 10]] ); is( int @tr, 3, 'clamp with special range def'); is( $tr[0], 5, 'too larg value clamped down to max'); is( $tr[1], 0, 'too small value clamped up to min'); is( $tr[2], 10, 'clamped down into special range'); is( $shape->check([1,2,3]), undef, 'all values in range'); warning_like {$shape->check([1,2])} {carped => qr/value vector/}, "not enough values"; warning_like {$shape->check([1,2,3,4])} {carped => qr/value vector/}, "too much values"; warning_like {$shape->check([-11,2,3])} {carped => qr/aaa value is below/}, "too small first value"; warning_like {$shape->check([0,21,3])} {carped => qr/bbb value is above/}, "too large second value"; warning_like {$shape->check([0,1,3.1])} {carped => qr/be an integer/}, "third value was not int"; my @norm = $shape->normalize([0, 10, 20]); is( int @norm, 3, 'normalized 3 into 3 values'); is( $norm[0], 0, 'normalized first min value'); is( $norm[1], 0.5, 'normalized second mid value'); is( $norm[2], 1, 'normalized third max value'); @norm = $shape->denormalize([0, 0.5 , 1]); is( int @norm, 3, 'denormalized 3 into 3 values'); is( $norm[0], 0, 'denormalized min value'); is( $norm[1], 10, 'denormalized second mid value'); is( $norm[2], 20, 'denormalized third max value'); @norm = $bshape->normalize([-1, 0, 5]); is( int @norm, 3, 'normalize bawl coordinates'); is( $norm[0], 0.4, 'normalized first min value'); is( $norm[1], 0.5, 'normalized second mid value'); is( $norm[2], 1, 'normalized third max value'); @norm = $bshape->denormalize([0.4, 0.5, 1]); is( int @norm, 3, 'denormalized 3 into 3 values'); is( $norm[0], -1, 'denormalized small value'); is( $norm[1], 0, 'denormalized mid value'); is( $norm[2], 5, 'denormalized max value'); @norm = $bshape->denormalize([1, 0, 0.5], [[-10,250],[30,50], [-70,70]]); is( int @norm, 3, 'denormalized bowl with custom range'); is( $norm[0], 250, 'denormalized with special ranges max value'); is( $norm[1], 30, 'denormalized with special ranges min value'); is( $norm[2], 0, 'denormalized with special ranges mid value'); @norm = $bshape->normalize([250, 30, 0], [[-10,250],[30,50], [-70,70]]); is( int @norm, 3, 'normalized bowl with custom range'); is( $norm[0], 1, 'normalized with special ranges max value'); is( $norm[1], 0, 'normalized with special ranges min value'); is( $norm[2], 0.5,'normalized with special ranges mid value'); exit 0; 52_color_change.t100644001750001750 710214503102425 21610 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl # use v5.12; use warnings; use Test::More tests => 29; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color qw/color/; my $red = color('#FF0000'); my $blue = color('#0000FF'); my $white = color('white'); my $black = color('black'); warning_like {$red->set()} {carped => qr/need arguments as hash/}, "set method needs arguments"; warning_like {$red->set([1,2,3])} {carped => qr/need arguments as hash/}, "input has to be a HASH not ARRAY"; warning_like {$red->set(fox => 4)} {carped => qr/to any supported color/}, "no color value keys detected"; is( $black->set( blue => 255 )->name, 'blue', 'could set the blue value' ); is( $black->set({blue => 255} )->name, 'blue', 'could set the blue value with HASH syntax' ); is( $white->set( r => 0 )->name, 'aqua', 'could set red value via key shortcut' ); is( $white->set( l => 0 )->name, 'black', 'could set HSL value' ); is( $blue->values(in => 'HSL', as => 'hash')->{'saturation'}, 100, 'blue has full saturation' ); is( $blue->set( saturation => 50 )->values(in => 'HSL', as => 'hash')->{'saturation'}, 50, 'could set it to half' ); warning_like {$red->add()} {carped => qr/need arguments as hash/}, "add method needs arguments"; warning_like {$red->add(r => 4, g => 2, t=> 3)} {carped => qr/not correlate to any/}, "fantasy value keys detected"; warning_like {$red->add({r => 4, g => 2, t=> 3})}{carped => qr/not correlate to any/}, "fantasy value keys detected in hash syntax"; is( $black->add( blue => 255 )->name, 'blue', 'could add the full blue value' ); is( $white->add( lightness => -100 )->name, 'black', 'subtract values via add' ); is( $white->add( red => 100 )->name, 'white', 'values will be trimmed' ); is( $black->blend( with => $white )->name, 'gray', "blend black + white = gray"); is( $black->blend( with => $white, pos => 0 )->name, 'black', "blend nothing, keep color"); is( $black->blend( with => $white, pos => 1 )->name, 'white', "blend nothing, take c2"); is( $black->blend( with => $white, pos => 2 )->name, 'white', "RGB limits kept"); is( $red->blend( with => 'blue')->name, 'lime', "blending with name"); is( $blue->blend( with => 'red')->name, 'lime', "flip the ingredients"); is( $red->blend( with => 'blue', in => 'RGB')->name, 'purple', "blending in RGB"); is( $red->blend( with => 'blue', in => 'CMYK')->name, 'purple', "blending in CMYK"); is( $red->blend( with => '#0000ff')->name, 'lime', "blending with hex def"); is( $red->blend( with => [0,0,255])->name, 'lime', "blending with array ref color def"); my $purple = $red->blend( with => {C => 1, M =>1, Y =>0}, in =>'CMY'); my @rgb = $purple->values('RGB'); is( $rgb[0], 128, "blending with RGB hash ref color def in CMY, red value"); is( $rgb[1], 0, "blending with RGB hash ref color def in CMY, green value"); is( $rgb[2], 128, "blending with RGB hash ref color def in CMY, blue value"); is( $red->blend( with => {H=> 240, S=> 100, L=>50}, in => 'RGB')->name,'purple', "blending with HSL hash in RGB"); # 'fuchsia' => [ 255, 0, 255, 300, 100, 50 ], # 'lime' => [ 0, 255, 0, 120, 100, 50 ], # 'purple' => [ 128, 0, 128, 300, 100, 25 ], exit 0; 51_color_measure.t100644001750001750 2233014503102425 22043 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl # use v5.12; use warnings; use Test::More tests => 66; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color qw/color/; use Graphics::Toolkit::Color::Space::Util ':all'; my $red = Graphics::Toolkit::Color->new('red'); my $blue = Graphics::Toolkit::Color->new('blue'); is( $blue->distance( $red ), 120, 'correct default hsl distance between red and blue'); is( $blue->distance( to => $red, in => 'HSL' ), 120, 'calling name space explicitly'); is( $blue->distance( to => $red, in => 'HSL', select => 'hsl'), 120, 'same in HASH syntax with full subspace'); is( $blue->distance( to => $red, in => 'HSL', select => 'HSL'), 120, 'same in list syntax with full subspace'); is( $blue->distance( to => $red, in => 'HSL', select => 'Hue'), 120, 'used only Hue subspace, long name'); is( $blue->distance( to => $red, in => 'HSL', select => 'h'), 120, 'used only Hue subspace, shortcut key'); is( $blue->distance( to => $red, in => 'HSL', select => 's'), 0, 'correct sturation distance between red and blue'); is( $blue->distance( to => $red, in => 'HSL', select => 'Saturation'), 0, 'correct sturation distance between red and blue, long name'); is( $blue->distance( to => $red, in => 'HSL', select => 'l'), 0, 'correct lightness distance between red and blue'); is( $blue->distance( to => $red, in => 'HSL', select => 'Lightness'), 0, 'correct lightness distance between red and blue, long name'); is( $blue->distance( to => $red, in => 'HSL', select => 'hs'), 120, 'correct hs distance between red and blue'); is( $blue->distance( to => $red, in => 'HSL', select => 'hl'), 120, 'correct hl distance between red and blue'); is( $blue->distance( to => $red, in => 'HSL', select => 'sl'), 0, 'correct sl distance between red and blue'); is( close_enough($blue->distance( to => $red, in => 'rgb'), 360.624458405 ), 1, 'correct rgb distance between red and blue'); is( $blue->distance( to => $red, in => 'rgb', select => 'Red'), 255, 'correct red distance between red and blue, long name'); is( $blue->distance( to => $red, in => 'rgb', select => 'r'), 255, 'correct red distance between red and blue'); is( $blue->distance( to => $red, in => 'rgb', select => 'Green'), 0, 'correct green distance between red and blue, long name'); is( $blue->distance( to => $red, in => 'rgb', select => 'g'), 0, 'correct green distance between red and blue'); is( $blue->distance( to => $red, in => 'rgb', select => 'Blue'), 255, 'correct blue distance between red and blue, long name'); is( $blue->distance( to => $red, in => 'rgb', select => 'b'), 255, 'correct blue distance between red and blue'); is( $blue->distance( to => $red, in => 'rgb', select => 'rg'), 255, 'correct rg distance between red and blue'); is( int $blue->distance( to => $red, in => 'rgb', select => 'rb'), 360, 'correct rb distance between red and blue'); is( $blue->distance(to => $red, in => 'rgb', select => 'gb'), 255, 'correct gb distance between red and blue'); is( int $blue->distance( to=> [10, 10, 245], ), 7, 'correct default hsl distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL'), 7, 'correct hsl distance between own rgb blue and blue'); is( $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'Hue'), 0, 'correct hue distance between own rgb blue and blue, long name'); is( $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'h'), 0, 'correct hue distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 's'), 7, 'correct sturation distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'Saturation'), 7, 'correct sturation distance between own rgb blue and blue, long name'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'l'), 0, 'correct lightness distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'Lightness'), 0, 'correct lightness distance between own rgb blue and blue, long name'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'hs'), 7, 'correct hs distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'hl'), 0, 'correct hl distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'HSL', select => 'sl'), 7, 'correct sl distance between own rgb blue and blue'); is( int $blue->distance( to=> [10, 10, 245], in => 'rgb'), 17, 'correct rgb distance between own rgb blue and blue'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'Red'), 10), 1, 'correct red distance between own rgb blue and blue, long name'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'r'), 10), 1, 'correct red distance between own rgb blue and blue'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'Green'),10), 1, 'correct green distance between own rgb blue and blue, long name'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'g'), 10), 1, 'correct green distance between own rgb blue and blue'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'Blue'), 10), 1, 'correct blue distance between own rgb blue and blue, long name'); is( close_enough( $blue->distance( to=> [10, 10, 245], in => 'rgb', select => 'b'), 10), 1, 'correct blue distance between own rgb blue and blue'); is( int $blue->distance( to => [10, 10, 245], in => 'rgb', select => 'rg'), 14, 'correct rg distance between own rgb blue and blue'); is( int $blue->distance( to => [10, 10, 245], in => 'rgb', select => 'rb'), 14, 'correct rb distance between own rgb blue and blue'); is( int $blue->distance( to => [10, 10, 245], in => 'rgb', select => 'gb'), 14, 'correct gb distance between own rgb blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}), 17, 'correct default hsl distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL'), 17, 'correct hsl distance between own hsl blue and blue'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'Hue'), 10, 'correct hue distance between own hsl blue and blue, long name'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'h'), 10, 'correct hue distance between own hsl blue and blue'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 's'), 10, 'correct sturation distance between own hsl blue and blue'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'Saturation'), 10, 'correct sturation distance between own hsl blue and blue, long name'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'l'), 10, 'correct lightness distance between own hsl blue and blue'); is( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'Lightness'),10, 'correct lightness distance between own hsl blue and blue, long name'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'hs'), 14, 'correct hs distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'hl'), 14, 'correct hl distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'HSL', select => 'sl'), 14, 'correct sl distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'rgb'), 74, 'correct rgb distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'Red'), 10, 'correct red distance between own hsl blue and blue, long name'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'r'), 10, 'correct red distance between own hsl blue and blue'); is( round( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'Green')),41, 'correct green distance between own hsl blue and blue, long name'); is( round( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'g')), 41, 'correct green distance between own hsl blue and blue'); is( round( $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'Blue')), 61, 'correct blue distance between own hsl blue and blue, long name'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'b'), 61, 'correct blue distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'rg'), 42, 'correct rg distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'rb'), 62, 'correct rb distance between own hsl blue and blue'); is( int $blue->distance( to => {h =>230, s => 90, l=>40}, in => 'RGB', select => 'gb'), 73, 'correct gb distance between own hsl blue and blue'); is( close_enough( $blue->distance(to => {h =>230, s => 0, l=>100}, in => 'CMYK' ), sqrt(2)), 1, 'measure distance between RGB ans HSL in CMYK'); exit 0; author000755001750001750 014503102425 20024 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/xtpod-syntax.t100644001750001750 25214503102425 22436 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/xt/author#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); 50_color_new_getter_io.t100644001750001750 3654114503102425 23244 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/t#!/usr/bin/perl # use v5.12; use warnings; use Test::More tests => 173; use Test::Warn; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color'; eval "use $module"; is( not( $@), 1, 'could load the module'); warning_like {Graphics::Toolkit::Color->new()} {carped => qr/constructor of/}, "need argument to create object"; warning_like {Graphics::Toolkit::Color->new('weirdcolorname')} {carped => qr/unknown color/}, "accept only known color names"; warning_like {Graphics::Toolkit::Color->new('CHIMNEY:red')} {carped => qr/ not installed/}, "accept only known palletes"; warning_like {Graphics::Toolkit::Color->new('#23232') } {carped => qr/could not recognize/}, "hex definition too short"; warning_like {Graphics::Toolkit::Color->new('#232321f') } {carped => qr/not recognize color/}, "hex definition too long"; warning_like {Graphics::Toolkit::Color->new('#23232g') } {carped => qr/not recognize color/}, "hex definition has forbidden chars"; warning_like {Graphics::Toolkit::Color->new('#2322%E') } {carped => qr/not recognize color/}, "hex definition has forbidden special chars"; warning_like {Graphics::Toolkit::Color->new(1,1)} {carped => qr/constructor of/}, "too few positional args"; warning_like {Graphics::Toolkit::Color->new(1,1,1,1,1)} {carped => qr/constructor of/}, "too many positional args"; warning_like {Graphics::Toolkit::Color->new([1,1])} {carped => qr/not recognize color/}, "too few positional args in ref"; warning_like {Graphics::Toolkit::Color->new([1,1,1,1])} {carped => qr/not recognize color/}, "too many positional args in ref"; warning_like {Graphics::Toolkit::Color->new({ r=>1, g=>1})} {carped => qr/not recognize color/}, "too few named args in ref"; warning_like {Graphics::Toolkit::Color->new({r=>1,g=>1,b=>1,h=>1,})} {carped => qr/not recognize color/},"too many name args in ref"; warning_like {Graphics::Toolkit::Color->new( r=>1)} {carped => qr/constructor of/}, "too few named args"; warning_like {Graphics::Toolkit::Color->new(r=>1,g=>1,b=>1,h=>1,a=>1)} {carped => qr/constructor of/}, "too many name args"; warning_like {Graphics::Toolkit::Color->new(r=>1,g=>1,h=>1)} {carped => qr/not recognize color/}, "don't mix named args"; warning_like {Graphics::Toolkit::Color->new(r=>1,g=>1,t=>1)} {carped => qr/not recognize color/}, "don't invent named args"; my $red = Graphics::Toolkit::Color->new('red'); is( ref $red, $module, 'could create object by name'); is( $red->red, 255, 'named red has correct red component value'); is( $red->green, 0, 'named red has correct green component value'); is( $red->blue, 0, 'named red has correct blue component value'); is( $red->hue, 0, 'named red has correct hue component value'); is( $red->saturation, 100, 'named red has correct saturation component value'); is( $red->lightness, 50, 'named red has correct lightness component value'); is( $red->name, 'red', 'named red has correct name'); is( $red->rgb_hex, '#ff0000', 'named red has correct hex value'); is(($red->rgb)[0], 255, 'named red has correct rgb red component value'); is(($red->rgb)[1], 0, 'named red has correct rgb green component value'); is(($red->rgb)[2], 0, 'named red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'named red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'named red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'named red has correct hsl lightness component value'); is(ref $red->rgb_hash,'HASH', 'named red has correct rgb HASH'); is(ref $red->hsl_hash,'HASH', 'named red has correct hsl HASH'); is( $red->rgb_hash->{'red'}, 255, 'named red has correct red value in rgb HASH'); is( $red->rgb_hash->{'green'}, 0, 'named red has correct green value in rgb HASH'); is( $red->rgb_hash->{'blue'}, 0, 'named red has correct blue value in rgb HASH'); is( $red->hsl_hash->{'hue'}, 0, 'named red has correct hue value in hsl HASH'); is( $red->hsl_hash->{'saturation'}, 100, 'named red has correct saturation value in hsl HASH'); is( $red->hsl_hash->{'lightness'}, 50, 'named red has correct lightness value in hsl HASH'); is( $red->string, 'red', 'named red does stringify correctly'); is( Graphics::Toolkit::Color->new(15,12,13)->string, 'rgb: 15, 12, 13', 'random color does stringify correctly'); $red = Graphics::Toolkit::Color->new('#FF0000'); is( ref $red, $module, 'could create object by hex value'); is( $red->red, 255, 'hex red has correct red component value'); is( $red->green, 0, 'hex red has correct green component value'); is( $red->blue, 0, 'hex red has correct blue component value'); is( $red->hue, 0, 'hex red has correct hue component value'); is( $red->saturation, 100, 'hex red has correct saturation component value'); is( $red->lightness, 50, 'hex red has correct lightness component value'); is( $red->name, 'red', 'hex red has correct name'); is( $red->rgb_hex, '#ff0000', 'hex red has correct hex value'); is(($red->rgb)[0], 255, 'hex red has correct rgb red component value'); is(($red->rgb)[1], 0, 'hex red has correct rgb green component value'); is(($red->rgb)[2], 0, 'hex red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'hex red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'hex red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'hex red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new('#f00'); is( ref $red, $module, 'could create object by short hex value'); is( $red->name, 'red', 'short hex red has correct name'); $red = Graphics::Toolkit::Color->new(255, 0, 0); is( ref $red, $module, 'could create object by positional RGB'); is( $red->red, 255, 'positional red has correct red component value'); is( $red->green, 0, 'positional red has correct green component value'); is( $red->blue, 0, 'positional red has correct blue component value'); is( $red->hue, 0, 'positional red has correct hue component value'); is( $red->saturation, 100, 'positional red has correct saturation component value'); is( $red->lightness, 50, 'positional red has correct lightness component value'); is( $red->name, 'red', 'positional red has correct name'); is( $red->rgb_hex, '#ff0000', 'positional red has correct hex value'); is(($red->rgb)[0], 255, 'positional red has correct rgb red component value'); is(($red->rgb)[1], 0, 'positional red has correct rgb green component value'); is(($red->rgb)[2], 0, 'positional red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'positional red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'positional red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'positional red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new([255, 0, 0]); is( ref $red, $module, 'could create object by RGB array ref'); is( $red->red, 255, 'array ref red has correct red component value'); is( $red->green, 0, 'array ref red has correct green component value'); is( $red->blue, 0, 'array ref red has correct blue component value'); is( $red->hue, 0, 'array ref red has correct hue component value'); is( $red->saturation, 100, 'array ref red has correct saturation component value'); is( $red->lightness, 50, 'array ref red has correct lightness component value'); is( $red->name, 'red', 'array ref red has correct name'); is( $red->rgb_hex, '#ff0000', 'array ref red has correct hex value'); is(($red->rgb)[0], 255, 'array ref red has correct rgb red component value'); is(($red->rgb)[1], 0, 'array ref red has correct rgb green component value'); is(($red->rgb)[2], 0, 'array ref red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'array ref red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'array ref red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'array ref red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new(r => 255, g => 0, b => 0); is( ref $red, $module, 'could create object by RGB named args'); is( $red->red, 255, 'named arg red has correct red component value'); is( $red->green, 0, 'named arg red has correct green component value'); is( $red->blue, 0, 'named arg red has correct blue component value'); is( $red->hue, 0, 'named arg red has correct hue component value'); is( $red->saturation, 100, 'named arg red has correct saturation component value'); is( $red->lightness, 50, 'named arg red has correct lightness component value'); is( $red->name, 'red', 'named arg red has correct name'); is( $red->rgb_hex, '#ff0000', 'named arg red has correct hex value'); is(($red->rgb)[0], 255, 'named arg red has correct rgb red component value'); is(($red->rgb)[1], 0, 'named arg red has correct rgb green component value'); is(($red->rgb)[2], 0, 'named arg red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'named arg red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'named arg red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'named arg red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new({Red => 255, Green => 0, Blue => 0 }); is( ref $red, $module, 'could create object by RGB hash ref'); is( $red->red, 255, 'hash ref red has correct red component value'); is( $red->green, 0, 'hash ref red has correct green component value'); is( $red->blue, 0, 'hash ref red has correct blue component value'); is( $red->hue, 0, 'hash ref red has correct hue component value'); is( $red->saturation, 100, 'hash ref red has correct saturation component value'); is( $red->lightness, 50, 'hash ref red has correct lightness component value'); is( $red->name, 'red', 'hash ref red has correct name'); is( $red->rgb_hex, '#ff0000', 'hash ref red has correct hex value'); is(($red->rgb)[0], 255, 'hash ref red has correct rgb red component value'); is(($red->rgb)[1], 0, 'hash ref red has correct rgb green component value'); is(($red->rgb)[2], 0, 'hash ref red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'hash ref red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'hash ref red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'hash ref red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new({h => 0, s => 100, l => 50 }); is( ref $red, $module, 'could create object by HSL hash ref'); is( $red->red, 255, 'hash ref red has correct red component value'); is( $red->green, 0, 'hash ref red has correct green component value'); is( $red->blue, 0, 'hash ref red has correct blue component value'); is( $red->hue, 0, 'hash ref red has correct hue component value'); is( $red->saturation, 100, 'hash ref red has correct saturation component value'); is( $red->lightness, 50, 'hash ref red has correct lightness component value'); is( $red->name, 'red', 'hash ref red has correct name'); is( $red->rgb_hex, '#ff0000', 'hash ref red has correct hex value'); is(($red->rgb)[0], 255, 'hash ref red has correct rgb red component value'); is(($red->rgb)[1], 0, 'hash ref red has correct rgb green component value'); is(($red->rgb)[2], 0, 'hash ref red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'hash ref red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'hash ref red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'hash ref red has correct hsl lightness component value'); $red = Graphics::Toolkit::Color->new( Hue => 0, Saturation => 100, Lightness => 50 ); is( ref $red, $module, 'could create object by HSL named args'); is( $red->red, 255, 'hash ref red has correct red component value'); is( $red->green, 0, 'hash ref red has correct green component value'); is( $red->blue, 0, 'hash ref red has correct blue component value'); is( $red->hue, 0, 'hash ref red has correct hue component value'); is( $red->saturation, 100, 'hash ref red has correct saturation component value'); is( $red->lightness, 50, 'hash ref red has correct lightness component value'); is( $red->name, 'red', 'hash ref red has correct name'); is( $red->rgb_hex, '#ff0000', 'hash ref red has correct hex value'); is(($red->rgb)[0], 255, 'hash ref red has correct rgb red component value'); is(($red->rgb)[1], 0, 'hash ref red has correct rgb green component value'); is(($red->rgb)[2], 0, 'hash ref red has correct rgb blue component value'); is(($red->hsl)[0], 0, 'hash ref red has correct hsl hue component value'); is(($red->hsl)[1], 100, 'hash ref red has correct hsl saturation component value'); is(($red->hsl)[2], 50, 'hash ref red has correct hsl lightness component value'); my $c = Graphics::Toolkit::Color->new( 1,2,3 ); is( ref $red, $module, 'could create object by random unnamed color'); is( $c->red, 1, 'random color has correct red component value'); is( $c->green, 2, 'random color has correct green component value'); is( $c->blue, 3, 'random color has correct blue component value'); is( $c->name, '', 'random color has no name'); is( $c->string, 'rgb: 1, 2, 3', 'blue color was stringified to hex'); my $blue = Graphics::Toolkit::Color->new( 'blue' ); is( $blue->red, 0, 'blue has correct red component value'); is( $blue->green, 0, 'blue has correct green component value'); is( $blue->blue, 255, 'blue has correct blue component value'); is( $blue->hue, 240, 'blue has correct hue component value'); is( $blue->saturation,100, 'blue has correct saturation component value'); is( $blue->lightness, 50, 'blue has correct lightness component value'); is( $blue->name, 'blue', 'blue color has correct name'); my $recursive = Graphics::Toolkit::Color->new( $red ); is( ref $recursive, $module, "recursive constructor option works"); ok( $recursive != $red, "recursive constructor produced object is new"); is( $recursive->name, 'red', "recursive constructor produced correct onject"); eval "color('blue')"; is( substr($@, 0, 20), 'Undefined subroutine', 'sub not there when not imported'); package New; use Graphics::Toolkit::Color qw/color/; use Test::More; is (ref color('blue'), $module, 'sub there when imported'); is (ref color('#ABC'), $module, 'created color from short RGB hex string'); is (ref color('#AABBCC'), $module, 'created color from long RGB hex string'); is (ref color([1,2,3]), $module, 'created color from Array Input'); is (ref color({r => 1, g => 2, b => 3,}), $module, 'created color from RGB hash'); is (ref color({h => 1, s => 2, l => 3,}), $module, 'created color from HSL hash'); exit 0; Toolkit000755001750001750 014503102425 22022 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/GraphicsColor.pm100644001750001750 7705414503102425 23633 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit # read only color holding object with methods for relation, mixing and transitions package Graphics::Toolkit::Color; our $VERSION = '1.71'; use v5.12; use warnings; use Carp; use Graphics::Toolkit::Color::Name; use Graphics::Toolkit::Color::Values; use Exporter 'import'; our @EXPORT_OK = qw/color/; my $new_help = 'constructor of Graphics::Toolkit::Color object needs either:'. ' 1. hash or ref (RGB, HSL or any other): ->new(r => 255, g => 0, b => 0), ->new({ h => 0, s => 100, l => 50 })'. ' 2. RGB array or ref: ->new( [255, 0, 0 ]) or >new( 255, 0, 0 )'. ' 3. hex form "#FF0000" or "#f00" 4. a name: "red" or "SVG:red".'; ## constructor ######################################################### sub color { Graphics::Toolkit::Color->new ( @_ ) } sub new { my ($pkg, @args) = @_; @args = ([@args]) if @args == 3 or Graphics::Toolkit::Color::Space::Hub::is_space( $args[0]); @args = ({ @args }) if @args == 6 or @args == 8; return carp $new_help unless @args == 1; _new_from_scalar($args[0]); } sub _new_from_scalar { my ($color_def) = shift; my ($value_obj, @rgb, $name, $origin); # strings that are not '#112233' or 'rgb: 23,34,56' if (not ref $color_def and substr($color_def, 0, 1) =~ /\w/ and $color_def !~ /,/){ $name = $color_def; $origin = 'name'; my $i = index( $color_def, ':'); if ($i > -1 ){ # resolve pallet:name my $pallet_name = substr $color_def, 0, $i; my $color_name = Graphics::Toolkit::Color::Name::_clean(substr $color_def, $i+1); my $module_base = 'Graphics::ColorNames'; eval "use $module_base"; return carp "$module_base is not installed, but it's needed to load external colors" if $@; my $module = $module_base.'::'.$pallet_name; eval "use $module"; return carp "$module is not installed, but needed to load color '$pallet_name:$color_name'" if $@; my $pallet = Graphics::ColorNames->new( $pallet_name ); @rgb = $pallet->rgb( $color_name ); return carp "color '$color_name' was not found, propably not part of $module" unless @rgb == 3; } else { # resolve name -> @rgb = Graphics::Toolkit::Color::Name::rgb_from_name( $color_def ); return carp "'$color_def' is an unknown color name, please check Graphics::Toolkit::Color::Name::all()." unless @rgb == 3; } $value_obj = Graphics::Toolkit::Color::Values->new( [@rgb] ); } elsif (ref $color_def eq __PACKAGE__) { # enables color objects to be passed as arguments $name = $color_def->name; $value_obj = Graphics::Toolkit::Color::Values->new( $color_def->{'values'}->string ); } else { # define color by numbers in any format my $value_obj = Graphics::Toolkit::Color::Values->new( $color_def ); return unless ref $value_obj; return _new_from_value_obj($value_obj); } bless {name => $name, values => $value_obj}; } sub _new_from_value_obj { my ($value_obj) = @_; return unless ref $value_obj eq 'Graphics::Toolkit::Color::Values'; bless {name => scalar Graphics::Toolkit::Color::Name::name_from_rgb( $value_obj->get() ), values => $value_obj}; } ## getter ############################################################## sub name { $_[0]{'name'} } sub string { $_[0]{'name'} || $_[0]->{'values'}->string } sub rgb { $_[0]->values( ) } sub red {($_[0]->values( in => 'rgb'))[0] } sub green {($_[0]->values( in => 'rgb'))[1] } sub blue {($_[0]->values( in => 'rgb'))[2] } sub rgb_hex { $_[0]->values( in => 'rgb', as => 'hex') } sub rgb_hash { $_[0]->values( in => 'rgb', as => 'hash') } sub hsl { $_[0]->values( in => 'hsl') } sub hue {($_[0]->values( in => 'hsl'))[0] } sub saturation {($_[0]->values( in => 'hsl'))[1] } sub lightness {($_[0]->values( in => 'hsl'))[2] } sub hsl_hash { $_[0]->values( in => 'hsl', as => 'hash') } sub values { my ($self) = shift; my %args = (not @_ % 2) ? @_ : (@_ == 1) ? (in => $_[0]) : return carp "accept three optional, named arguments: in => 'HSL', as => 'css_string', range => 16"; $self->{'values'}->get( $args{'in'}, $args{'as'}, $args{'range'} ); } ## measurement methods ############################################################## sub distance_to { distance(@_) } sub distance { my ($self) = shift; my %args = (not @_ % 2) ? @_ : (@_ == 1) ? (to => $_[0]) : return carp "accept four optional, named arguments: to => 'color or color definition', in => 'RGB', metric => 'r', range => 16"; my ($c2, $space_name, $select, $range) = ($args{'to'}, $args{'in'}, $args{'select'}, $args{'range'}); return carp "missing argument: color object or scalar color definition" unless defined $c2; $c2 = _new_from_scalar( $c2 ); return carp "second color for distance calculation (named argument 'to') is badly defined" unless ref $c2 eq __PACKAGE__; $self->{'values'}->distance( $c2->{'values'}, $space_name, $select, $range ); } ## single color creation methods ####################################### sub _get_arg_hash { my $arg = (ref $_[0] eq 'HASH') ? $_[0] : (not @_ % 2) ? {@_} : {} ; return (keys %$arg) ? $arg : carp "need arguments as hash (with or without braces)"; } sub set { my ($self, @args) = @_; my $arg = _get_arg_hash( @args ); return unless ref $arg; _new_from_value_obj( $self->{'values'}->set( $arg ) ); } sub add { my ($self, @args) = @_; my $arg = _get_arg_hash( @args ); return unless ref $arg; _new_from_value_obj( $self->{'values'}->add( $arg ) ); } sub blend_with { $_[0]->blend( with => $_[1], pos => $_[2], in => 'HSL') } sub blend { my ($self, @args) = @_; my $arg = _get_arg_hash( @args ); return unless ref $arg; my $c2 = _new_from_scalar( $arg->{'with'} ); return croak "need a second color under the key 'with' ( with => { h=>1, s=>2, l=>3 })" unless ref $c2; my $pos = $arg->{'pos'} // $arg->{'position'} // 0.5; my $space_name = $arg->{'in'} // 'HSL'; return carp "color space $space_name is unknown" unless Graphics::Toolkit::Color::Space::Hub::is_space( $space_name ); _new_from_value_obj( $self->{'values'}->blend( $c2->{'values'}, $pos, $space_name ) ); } ## color set creation methods ########################################## # for compatibility sub gradient_to { hsl_gradient_to( @_ ) } sub rgb_gradient_to { $_[0]->gradient( to => $_[1], steps => $_[2], dynamic => $_[3], in => 'RGB' ) } sub hsl_gradient_to { $_[0]->gradient( to => $_[1], steps => $_[2], dynamic => $_[3], in => 'HSL' ) } sub gradient { # $to ~in + steps +dynamic +variance --> @_ my ($self, @args) = @_; my $arg = _get_arg_hash( @args ); return unless ref $arg eq 'HASH'; my $c2 = _new_from_scalar( $arg->{'to'} ); return croak "need a second color under the key 'to' : ( to => ['HSL', 10, 20, 30])" unless ref $c2; my $space_name = $arg->{'in'} // 'HSL'; my $steps = int(abs($arg->{'steps'} // 3)); my $power = $arg->{'dynamic'} // 0; $power = ($power >= 0) ? $power + 1 : -(1/($power-1)); return $self if $steps == 1; my $space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); return carp "color space $space_name is unknown" unless ref $space; my @val1 = $self->{'values'}->get( $space_name, 'list', 'normal' ); my @val2 = $c2->{'values'}->get( $space_name, 'list', 'normal' ); my @delta_val = $space->delta (\@val1, \@val2 ); my @colors = (); for my $nr (1 .. $steps-2){ my $pos = ($nr / ($steps-1)) ** $power; my @rval = map {$val1[$_] + ($pos * $delta_val[$_])} 0 .. $space->dimensions - 1; @rval = $space->denormalize ( \@rval ); push @colors, _new_from_scalar( [ $space_name, @rval ] ); } return $self, @colors, $c2; } my $comp_help = 'set constructor "complement" accepts 4 named args: "steps" (positive int), '. '"hue_tilt" or "h" (-180 .. 180), '. '"saturation_tilt or "s" (-100..100) or { s => (-100..100), h => (-180..180)} and '. '"lightness_tilt or "l" (-100..100) or { l => (-100..100), h => (-180..180)}'; sub complementary { complement(@_) } sub complement { # +steps +hue_tilt +saturation_tilt +lightness_tilt --> @_ my ($self) = shift; my %arg = (not @_ % 2) ? @_ : (@_ == 1) ? (steps => $_[0]) : return carp $comp_help; my $steps = int abs($arg{'steps'} // 1); my $hue_tilt = (exists $arg{'h'}) ? (delete $arg{'h'}) : (exists $arg{'hue_tilt'}) ? (delete $arg{'hue_tilt'}) : 0; return carp $comp_help if ref $hue_tilt; my $saturation_tilt = (exists $arg{'s'}) ? (delete $arg{'s'}) : (exists $arg{'saturation_tilt'}) ? (delete $arg{'saturation_tilt'}) : 0; return carp $comp_help if ref $saturation_tilt and ref $saturation_tilt ne 'HASH'; my $saturation_axis_offset = 0; if (ref $saturation_tilt eq 'HASH'){ my ($pos_hash, $space_name) = Graphics::Toolkit::Color::Space::Hub::partial_hash_deformat( $saturation_tilt ); return carp $comp_help if not defined $space_name or $space_name ne 'HSL' or not exists $pos_hash->{1}; $saturation_axis_offset = $pos_hash->{0} if exists $pos_hash->{0}; $saturation_tilt = $pos_hash->{1}; } my $lightness_tilt = (exists $arg{'l'}) ? (delete $arg{'l'}) : (exists $arg{'lightness_tilt'}) ? (delete $arg{'lightness_tilt'}) : 0; return carp $comp_help if ref $lightness_tilt and ref $lightness_tilt ne 'HASH'; my $lightness_axis_offset = 0; if (ref $lightness_tilt eq 'HASH'){ my ($pos_hash, $space_name) = Graphics::Toolkit::Color::Space::Hub::partial_hash_deformat( $lightness_tilt ); return carp $comp_help if not defined $space_name or $space_name ne 'HSL' or not exists $pos_hash->{2}; $lightness_axis_offset = $pos_hash->{0} if exists $pos_hash->{0}; $lightness_tilt = $pos_hash->{2}; } my @hsl2 = my @hsl = $self->values('HSL'); my @hue_turn_point = ($hsl[0] + 90, $hsl[0] + 270, 800); # Dmax, Dmin and Pseudo-Inf my @sat_turn_point = ($hsl[0] + 90, $hsl[0] + 270, 800); my @light_turn_point = ($hsl[0] + 90, $hsl[0] + 270, 800); my $sat_max_hue = $hsl[0] + 90 + $saturation_axis_offset; my $sat_step = $saturation_tilt * 4 / $steps; my $light_max_hue = $hsl[0] + 90 + $lightness_axis_offset; my $light_step = $lightness_tilt * 4 / $steps; if ($saturation_axis_offset){ $sat_max_hue -= 360 while $sat_max_hue > $hsl[0]; # putting dmax in range $sat_max_hue += 360 while $sat_max_hue <= $hsl[0]; # above c1->hue my $dmin_first = $sat_max_hue > $hsl[0] + 180; @sat_turn_point = $dmin_first ? ($sat_max_hue - 180, $sat_max_hue, 800) : ($sat_max_hue, $sat_max_hue + 180, 800); $sat_step = - $sat_step if $dmin_first; my $sat_start_delta = $dmin_first ? ((($sat_max_hue - 180 - $hsl[0]) / 90 * $saturation_tilt) - $saturation_tilt) : (-(($sat_max_hue - $hsl[0]) / 90 * $saturation_tilt) + $saturation_tilt); $hsl[1] += $sat_start_delta; $hsl2[1] -= $sat_start_delta; } if ($lightness_axis_offset){ $light_max_hue -= 360 while $light_max_hue > $hsl[0]; $light_max_hue += 360 while $light_max_hue <= $hsl[0]; my $dmin_first = $light_max_hue > $hsl[0] + 180; @light_turn_point = $dmin_first ? ($light_max_hue - 180, $light_max_hue, 800) : ($light_max_hue, $light_max_hue + 180, 800); $light_step = - $light_step if $dmin_first; my $light_start_delta = $dmin_first ? ((($light_max_hue - 180 - $hsl[0]) / 90 * $lightness_tilt) - $lightness_tilt) : (-(($light_max_hue - $hsl[0]) / 90 * $lightness_tilt) + $lightness_tilt); $hsl[2] += $light_start_delta; $hsl2[2] -= $light_start_delta; } my $c1 = _new_from_scalar( [ 'HSL', @hsl ] ); $hsl2[0] += 180 + $hue_tilt; my $c2 = _new_from_scalar( [ 'HSL', @hsl2 ] ); # main complementary color return $c2 if $steps < 2; return $c1, $c2 if $steps == 2; my (@result) = $c1; my $hue_avg_step = 360 / $steps; my $hue_c2_distance = $self->distance( to => $c2, in => 'HSL', select => 'hue'); my $hue_avg_tight_step = $hue_c2_distance * 2 / $steps; my $hue_sec_deg_delta = 8 * ($hue_avg_step - $hue_avg_tight_step) / $steps; # second degree delta $hue_sec_deg_delta = -$hue_sec_deg_delta if $hue_tilt < 0; # if c2 on right side my $hue_last_step = my $hue_ak_step = $hue_avg_step; # bar height of pseudo integral my $hue_current = my $hue_current_naive = $hsl[0]; my $saturation_current = $hsl[1]; my $lightness_current = $hsl[2]; my $hi = my $si = my $li = 0; # index of next turn point where hue step increase gets flipped (at Dmax and Dmin) for my $i (1 .. $steps - 1){ $hue_current_naive += $hue_avg_step; if ($hue_current_naive >= $hue_turn_point[$hi]){ my $bar_width = ($hue_turn_point[$hi] - $hue_current_naive + $hue_avg_step) / $hue_avg_step; $hue_ak_step += $hue_sec_deg_delta * $bar_width; $hue_current += ($hue_ak_step + $hue_last_step) / 2 * $bar_width; $hue_last_step = $hue_ak_step; $bar_width = 1 - $bar_width; $hue_sec_deg_delta = -$hue_sec_deg_delta; $hue_ak_step += $hue_sec_deg_delta * $bar_width; $hue_current += ($hue_ak_step + $hue_last_step) / 2 * $bar_width; $hi++; } else { $hue_ak_step += $hue_sec_deg_delta; $hue_current += ($hue_ak_step + $hue_last_step) / 2; } $hue_last_step = $hue_ak_step; if ($hue_current_naive >= $sat_turn_point[$si]){ my $bar_width = ($sat_turn_point[$si] - $hue_current_naive + $hue_avg_step) / $hue_avg_step; $saturation_current += $sat_step * ((2 * $bar_width) - 1); $sat_step = -$sat_step; $si++; } else { $saturation_current += $sat_step; } if ($hue_current_naive >= $light_turn_point[$li]){ my $bar_width = ($light_turn_point[$li] - $hue_current_naive + $hue_avg_step) / $hue_avg_step; $lightness_current += $light_step * ((2 * $bar_width) - 1); $light_step = -$light_step; $li++; } else { $lightness_current += $light_step; } $result[$i] = _new_from_scalar( [ HSL => $hue_current, $saturation_current, $lightness_current ] ); } return @result; } sub bowl {# +radius +distance|count +variance ~in @range my ($self, @args) = @_; my $arg = _get_arg_hash( @args ); return unless ref $arg eq 'HASH'; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color - color palette constructor =head1 SYNOPSIS use Graphics::Toolkit::Color qw/color/; my $red = Graphics::Toolkit::Color->new('red'); # create color object say $red->add( 'blue' => 255 )->name; # add blue value: 'fuchsia' my $blue = color( 0, 0, 255)->values('HSL'); # 240, 100, 50 = blue $blue->blend( with => [HSL => 0,0,80], pos => 0.1);# mix blue with a little grey in HSL $red->gradient( to => '#0000FF', steps => 10); # 10 colors from red to blue $red->complement( 3 ); # get fitting red green and blue =head1 DESCRIPTION ATTENTION: deprecated methods of the old API ( I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I) will be removed on version 2.0. Graphics::Toolkit::Color, for short GTC, is the top level API of this module and the only one a regular user should be concerned with. Its main purpose is the creation of sets of related colors, such as gradients, complements and others. GTC are read only color holding objects with no additional dependencies. Create them in many different ways (see section L). Access its values via methods from section L. Measure differences with the I method. L methods create one a object that is related to the current one and L methods will create a host of color that are not only related to the current color but also have relations between each other. While this module can understand and output color values in many spaces, such as YIQ, HSL and many more, RGB is the (internal) primal one, because GTC is about colors that can be shown on the screen, and these are usually encoded in RGB. Humans access colors on hardware level (eye) in RGB, on cognition level in HSL (brain) and on cultural level (language) with names. Having easy access to all three and some color math should enable you to get the color palette you desire quickly. =head1 CONSTRUCTOR There are many options to create a color objects. In short you can either use the name of a constant or provide values in one of several L, which also can be formatted in many ways as described in this paragraph. =head2 new('name') Get a color by providing a name from the X11, HTML (CSS) or SVG standard or a Pantone report. UPPER or CamelCase will be normalized to lower case and inserted underscore letters ('_') will be ignored as perl does in numbers (1_000 == 1000). All available names are listed under L. (See also: L) my $color = Graphics::Toolkit::Color->new('Emerald'); my @names = Graphics::Toolkit::Color::Name::all(); # select from these =head2 new('scheme:color') Get a color by name from a specific scheme or standard as provided by an external module L::* , which has to be installed separately. * is a placeholder for the pallet name, which might be: Crayola, CSS, EmergyC, GrayScale, HTML, IE, Mozilla, Netscape, Pantone, PantoneReport, SVG, VACCC, Werner, Windows, WWW or X. In ladder case Graphics::ColorNames::X has to be installed. You can get them all at once via L. The color name will be normalized as above. my $color = Graphics::Toolkit::Color->new('SVG:green'); my @s = Graphics::ColorNames::all_schemes(); # look up the installed =head2 new('#rgb') Color definitions in hexadecimal format as widely used in the web, are also acceptable. my $color = Graphics::Toolkit::Color->new('#FF0000'); my $color = Graphics::Toolkit::Color->new('#f00'); # works too =head2 new( [$r, $g, $b] ) Triplet of integer RGB values (red, green and blue : 0 .. 255). Out of range values will be corrected to the closest value in range. my $red = Graphics::Toolkit::Color->new( 255, 0, 0 ); my $red = Graphics::Toolkit::Color->new([255, 0, 0]); # does the same my $red = Graphics::Toolkit::Color->new('RGB' => 255, 0, 0); # named tuple syntax my $red = Graphics::Toolkit::Color->new(['RGB' => 255, 0, 0]); # named ARRAY The named array syntax of the last example, as any here following, work for any supported color space. =head2 new({ r => $r, g => $g, b => $b }) Hash with the keys 'r', 'g' and 'b' does the same as shown in previous paragraph, only more declarative. Casing of the keys will be normalised and only the first letter of each key is significant. my $red = Graphics::Toolkit::Color->new( r => 255, g => 0, b => 0 ); my $red = Graphics::Toolkit::Color->new({r => 255, g => 0, b => 0}); # works too ... ->new( Red => 255, Green => 0, Blue => 0); # also fine ... ->new( Hue => 0, Saturation => 100, Lightness => 50 ); # same color ... ->new( Hue => 0, whiteness => 0, blackness => 0 ); # still the same =head2 new('rgb: $r, $g, $b') String format (good for serialisation) that maximizes readability. my $red = Graphics::Toolkit::Color->new( 'rgb: 255, 0, 0' ); my $blue = Graphics::Toolkit::Color->new( 'HSV: 240, 100, 100' ); =head2 new('rgb($r,$g,$b)') Variant of string format that is supported by CSS. my $red = Graphics::Toolkit::Color->new( 'rgb(255, 0, 0)' ); my $blue = Graphics::Toolkit::Color->new( 'hsv(240, 100, 100)' ); =head2 color If writing Graphics::Toolkit::Color->new( ...); is too much typing for you or takes to much space, import the subroutine C, which takes all the same arguments as described above. use Graphics::Toolkit::Color qw/color/; my $green = color('green'); my $darkblue = color([20, 20, 250]); =head1 GETTER giving access to different parts of the objects data. =head2 name String with normalized name (lower case without I<'_'>) of the color as in X11 or HTML (SVG) standard or the Pantone report. The name will be found and filled in, even when the object was created numerical values. If no color is found, C returns an empty string. All names are at: L (See als: L) =head2 values Returns the values of the color in given color space and format. It accepts three named, optional arguments. First argument is the name of a color space (named argument C). All options are under: L The order of named arguments is of course chosen by the user, but I call it the first (most important) argument, because if you give the method only one value, it is assumed to be the color space. Second argument is the format (name: C). In short any SCALAR format acceptable to the L can also be reproduced by a getter method and the numerical cases by this one. Not all formats are available under all color spaces, but the always present options are: C (default), C, C and C. Third named argument is the range inside which the numerical values have to be. RGB are normally between 0 .. 255 and CMYK between 0 .. 1 ('normal'). Only a range of C<1> a.k.a. C<'normal'> displays decimals. There are three syntax option to set the ranges. One value will be understood as upper limit of all dimensions and zero being the lower one. If you want to set the upper limits of all dimensions separately, you have to deliver an ARRAY ref with the 3 or 4 upper limits. To also define the lower boundary, you replace the number with an ARRAY ref containing the lower and then the upper limit. $blue->values(); # get list in RGB: 0, 0, 255 $blue->values( in => 'RGB', as => 'list'); # same call $blue->values( in => 'RGB', as => 'hash'); # { red => 0, green => 0, blue => 255} $blue->values( in => 'RGB', as => 'char_hash');# { r => 0, g => 0, b => 255} $blue->values( in => 'RGB', as => 'hex'); # '#00FFFF' $color->values('HSL'); # 240, 100, 50 $color->values( in => 'HSL', range => 1); # 0.6666, 1, 0.5 $color->values( in => 'RGB', range => 2**16); # values in RGB16 $color->values( in => 'HSB', as => 'hash')->{'hue'}; # how to get single values ($color->values( 'HSB'))[0]; # same, but shorter =head2 distance Is a floating point number that measures the Euclidean distance between two colors. One color is the calling object itself and the second (C2) has to provided as a named argument (I), which is the only required one. It ca come in the form of a second GTC object or any scalar color definition I would accept. The I is measured in HSL color space unless told otherwise by the argument I. The third argument is named I. It's useful if you want to notice only certain dimensions. Metric is the long or short name of that dimension or the short names of several dimensions. They all have to come from one color space and one shortcut letter can be used several times to heighten the weight of this dimension. The last argument in named I and is a range definition, unless you don't want to compute the distance with the default ranges of the selected color space. my $d = $blue->distance( to => 'lapisblue' ); # how close is blue to lapis color? $d = $blue->distance( to => 'airyblue', in => 'RGB', select => 'Blue'); # same amount of blue? $d = $color->distance( to => $c2, in => 'HSL', select => 'hue' ); # same hue? # compute distance when with all value ranges 0 .. 1 $d = $color->distance( to => $c2, in => 'HSL', select => 'hue', range => 'normal' ); =head1 SINGLE COLOR construct colors that are related to the current object. =head2 set Create a new object that differs in certain values defined in the arguments as a hash. $black->set( blue => 255 )->name; # blue, same as #0000ff $blue->set( saturation => 50 ); # pale blue, same as $blue->set( s => 50 ); =head2 add Create a Graphics::Toolkit::Color object, by adding any RGB or HSL values to current color. (Same rules apply for key names as in new - values can be negative.) RGB and HSL can be combined, but please note that RGB are applied first. If the first argument is a Graphics::Toolkit::Color object, than RGB values will be added. In that case an optional second argument is a factor (default = 1), by which the RGB values will be multiplied before being added. Negative values of that factor lead to darkening of result colors, but its not subtractive color mixing, since this module does not support CMY color space. All RGB operations follow the logic of additive mixing, and the result will be rounded (clamped), to keep it inside the defined RGB space. my $blue = Graphics::Toolkit::Color->new('blue'); my $darkblue = $blue->add( Lightness => -25 ); my $blue2 = $blue->add( blue => 10 ); # this is bluer than blue =head2 blend Create a Graphics::Toolkit::Color object, that has the average values between the calling object (color 1 - C1) and another color (C2). It takes three named arguments, only the first is required. 1. The color C2 (scalar that is acceptable by the constructor: object, string, ARRAY, HASH). The name of the argument is I (color is blended with ...). 2. Blend position is a floating point number, which defaults to 0.5. (blending ratio of 1:1 ). 0 represents here C1 and 1 is pure C2. Numbers below 0 and above 1 are possible, butlikely to be clamped to fit inside the color space. Name of the argument is I. 3. Color space name (default is I - all can be seen unter L). Name of the argument is I. # a little more silver than $color in the mix $color->blend( with => 'silver', pos => 0.6 ); $color->blend({ with => 'silver', pos => 0.6 }); # works too! $blue->blend( with => {H => 240, S =>100, L => 50}, in => 'RGB' ); # teal =head1 COLOR SETS construct many interrelated color objects at once. =head2 gradient Creates a gradient (a list of colors that build a transition) between current (C1) and a second, given color (C2) by named argument I. The only required argument you have to give under the name I is C2. Either as an Graphics::Toolkit::Color object or a scalar (name, hex, HASH or ARRAY), which is acceptable to a L. This is the same behaviour as in L. An optional argument under the name I sets the number of colors, which make up the gradient (including C1 and C2). It defaults to 3. Negative numbers will be rectified by C. These 3 color objects: C1, C2 and a color in between, which is the same as the result of method L. Another optional argument under the name I is a float number, that defines the position of weight in the color transition from C1 to C2. It defaults to zero which gives you a linear transition, meaning the L between neighbouring colors in the gradient is equal. If $dynamic > 0, the weight is moved toward C1 and vice versa. The greater $dynamic, the slower the color change is in the beginning of the gradient and the faster at the end (C2). The last optional argument named I defines the color space the changes are computed in. It parallels the argument of the same name from the method L and L. # we turn to grey my @colors = $c->gradient( to => $grey, steps => 5, in => 'RGB'); # none linear gradient in HSL space : @colors = $c1->gradient( to =>[14,10,222], steps => 10, dynamic => 3 ); =head2 complement Creates a set of complementary colors, which will be computed in I color space. It accepts 4 optional, named arguments. Complementary colors have a different I value but same I and I. Because they form a circle in HSL, they will be called in this paragraph a circle. If you provide no names (just a single argument), the value is understood as I. I is the amount (count) of complementary colors, which defaults to 1 (giving you then THE complementary color). If more than one color is requested, the result will contain the calling object as the first color. The second optional argument is I, in short I, which defaults to zero. When zero, the hue distance between all resulting colors on the circle is the same. When not zero, the I gets added (see L) to THE complementary color. The so computed color divides the circle in a shorter and longer part. Both of these parts will now contain an equal amount of result colors. The distribution will be computed in a way, that there will be a place on the circle where the distance between colors is the highest (let's call it Dmax) and one where it is the lowest (Dmin). The distance between two colors increases or decreases steadily. When I is zero, the axis through Dmax and Dmin and the axis through $self and C2 are orthogonal. The third optional argument I, or short I, which also defaults to zero. If the value differs from zero it gets added the color on Dmax (last paragraph), subtracted on Dmin, changed accordingly in between, so that the circle gets moved in direction Dmin. If you want to move the circle in any other direction you have to give I a HASH reference with 2 keys. First is I or I, which is the value as described. Secondly I or I rotates the direction in which the circle will be moved. Please not, this will not change the position of Dmin and Dmax, because it just defines the angle between the Dmin-Dmax axis and the direction where the circle is moved. The fourth optional argument is I or Im which works analogously to I. Only difference is that it tilts the circle in the up-down direction, which is in HSL color space lightness. my @colors = $c->complement( 4 ); # $self + 3 compementary (square) colors my @colors = $c->complement( steps => 3, s => 20, l => -10 ); my @colors = $c->complement( steps => 3, hue_tilt => -40, saturation_tilt => {saturation => 300, hue => -50}, lightness_tilt => {l => -10, hue => 30} ); =head1 SEE ALSO =over 4 =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back =head1 COPYRIGHT & LICENSE Copyright 2022-2023 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. =head1 AUTHOR Herbert Breunung, =cut Color000755001750001750 014503102425 23100 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/ToolkitName.pm100644001750001750 2525014503102425 24502 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Coloruse v5.12; # named colors from X11, HTML (SVG) standard and Pantone report package Graphics::Toolkit::Color::Name; use Graphics::Toolkit::Color::Values; use Carp; my $RGB = Graphics::Toolkit::Color::Space::Hub::get_space('RGB'); my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space('HSL'); my $constants = require Graphics::Toolkit::Color::Name::Constant; our (@name_from_rgb, @name_from_hsl); # search caches _add_color_to_reverse_search( $_, @{$constants->{$_}} ) for all(); sub all { sort keys %$constants } sub taken { exists $constants->{ _clean($_[0]) } } sub rgb_from_name { my $name = _clean(shift); @{$constants->{$name}}[0..2] if taken( $name ); } sub hsl_from_name { my $name = _clean(shift); @{$constants->{$name}}[3..5] if taken( $name ); } sub name_from_rgb { my (@rgb) = @_; @rgb = @{$rgb[0]} if (ref $rgb[0] eq 'ARRAY'); $RGB->check( [@rgb] ) and return; # return if sub did carp my @names = _names_from_rgb( @rgb ); wantarray ? @names : $names[0]; } sub name_from_hsl { my (@hsl) = @_; @hsl = @{$hsl[0]} if (ref $hsl[0] eq 'ARRAY'); $HSL->check( [ @hsl ] ) and return; my @names = _names_from_hsl( @hsl ); wantarray ? @names : $names[0]; } sub names_in_hsl_range { # @center, (@d | $d) --> @names my $help = 'need two arguments: 1. array with h s l values '. '2. radius (real number) or array with tolerances in h s l direction'; return carp $help if @_ != 2; my ($hsl_center, $radius) = @_; $HSL->check( $hsl_center ) and return; my $hsl_delta = (ref $radius eq 'ARRAY') ? $radius : [$radius, $radius, $radius]; $HSL->check( $hsl_delta ) and return; $hsl_delta->[0] = 180 if $hsl_delta->[0] > 180; # enough to search complete HSL space (prevent double results) my (@min, @max, @names, $minhrange, $maxhrange); $min[$_] = $hsl_center->[$_] - $hsl_delta->[$_] for 0..2; $max[$_] = $hsl_center->[$_] + $hsl_delta->[$_] for 0..2; $min[1] = 0 if $min[1] < 0; $min[2] = 0 if $min[2] < 0; $max[1] = 100 if $max[1] > 100; $max[2] = 100 if $max[2] > 100; my @hrange = ($min[0] < 0) ? ( 0 .. $max[0] , $min[0]+360 .. 359) : ($max[0] > 360) ? ( 0 .. $max[0]-360, $min[0] .. 359) : ($min[0] .. $max[0]); for my $h (@hrange){ next unless defined $name_from_hsl[ $h ]; for my $s ($min[1] .. $max[1]){ next unless defined $name_from_hsl[ $h ][ $s ]; for my $l ($min[2] .. $max[2]){ my $name = $name_from_hsl[ $h ][ $s ][ $l ]; next unless defined $name; push @names, (ref $name ? $name->[0] : $name); } } } @names = grep {Graphics::Toolkit::Color::Values->new(['HSL',@$hsl_center])->distance( Graphics::Toolkit::Color::Values->new(['HSL',hsl_from_name($_)]) ) <= $radius} @names if not ref $radius; @names; } sub add_rgb { my ($name, @rgb) = @_; @rgb = @{$rgb[0]} if (ref $rgb[0] eq 'ARRAY'); return carp "missing first argument: color name" unless defined $name and $name; $RGB->check( [@rgb] ) and return; my @hsl = $HSL->deconvert( [$RGB->normalize( \@rgb )], 'RGB'); _add_color( $name, @rgb, $HSL->denormalize(\@hsl) ); } sub add_hsl { my ($name, @hsl) = @_; @hsl = @{$hsl[0]} if (ref $hsl[0] eq 'ARRAY'); return carp "missing first argument: color name" unless defined $name and $name; $HSL->check( \@hsl ) and return; my @rgb = $HSL->convert( [$HSL->normalize( \@hsl )], 'RGB'); _add_color( $name, $RGB->denormalize( \@rgb ), @hsl ); } sub _add_color { my ($name, @rgb, @hsl) = @_; $name = _clean( $name ); return carp "there is already a color named '$name' in store of ".__PACKAGE__ if taken( $name ); _add_color_to_reverse_search( $name, @rgb, @hsl); my $ret = $constants->{$name} = [@rgb, @hsl]; # add to foreward search (ref $ret) ? [@$ret] : ''; # make returned ref not transparent } sub _clean { my $name = shift; $name =~ tr/_//d; lc $name; } sub _names_from_rgb { # each of AoAoA cells (if exists) contains name or array with names (shortes first) return '' unless exists $name_from_rgb[ $_[0] ] and exists $name_from_rgb[ $_[0] ][ $_[1] ] and exists $name_from_rgb[ $_[0] ][ $_[1] ][ $_[2] ]; my $cell = $name_from_rgb[ $_[0] ][ $_[1] ][ $_[2] ]; ref $cell ? @$cell : $cell; } sub _names_from_hsl { return '' unless exists $name_from_hsl[ $_[0] ] and exists $name_from_hsl[ $_[0] ][ $_[1] ] and exists $name_from_hsl[ $_[0] ][ $_[1] ][ $_[2] ]; my $cell = $name_from_hsl[ $_[0] ][ $_[1] ][ $_[2] ]; ref $cell ? @$cell : $cell; } sub _add_color_to_reverse_search { # my ($name, @rgb, @hsl) = @_; my $name = $_[0]; my $cell = $name_from_rgb[ $_[1] ][ $_[2] ][ $_[3] ]; if (defined $cell) { if (ref $cell) { if (length $name < length $cell->[0] ) { unshift @$cell, $name } else { push @$cell, $name } } else { $name_from_rgb[ $_[1] ][ $_[2] ][ $_[3] ] = (length $name < length $cell) ? [ $name, $cell ] : [ $cell, $name ] ; } } else { $name_from_rgb[ $_[1] ][ $_[2] ][ $_[3] ] = $name } $cell = $name_from_hsl[ $_[4] ][ $_[5] ][ $_[6] ]; if (defined $cell) { if (ref $cell) { if (length $name < length $cell->[0] ) { unshift @$cell, $name } else { push @$cell, $name } } else { $name_from_hsl[ $_[4] ][ $_[5] ][ $_[6] ] = (length $name < length $cell) ? [ $name, $cell ] : [ $cell, $name ] ; } } else { $name_from_hsl[ $_[4] ][ $_[5] ][ $_[6] ] = $name } } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Name - access values of color constants =head1 SYNOPSIS use Graphics::Toolkit::Color::Name qw/:all/; my @names = Graphics::Toolkit::Color::Name::all(); my @rgb = rgb_from_name('darkblue'); my @hsl = hsl_from_name('darkblue'); Graphics::Toolkit::Color::Value::add_rgb('lucky', [0, 100, 50]); =head1 DESCRIPTION RGB and HSL values of named colors from the X11, HTML(CSS), SVG standard and Pantone report. Allows also nearby search, reverse search and storage (not permanent) of additional names. One color may have multiple names. Own colors can be (none permanently) stored for later reference by name. For this a name has to be chosen, that is not already taken. The corresponding color may be defined by an RGB or HSL triplet. No symbol is imported by default. The sub symbols: C, C, C, C may be imported individually or by: use Graphics::Toolkit::Color::Name qw/:all/; =head1 ROUTINES =head2 rgb_from_name Red, Green and Blue value of the named color. These values are integer in 0 .. 255. my @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('darkblue'); @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('dark_blue'); # same result @rgb = Graphics::Toolkit::Color::Name::rgb_from_name('DarkBlue'); # still same =head2 hsl_from_name Hue, saturation and lightness of the named color. These are integer between 0 .. 359 (hue) or 100 (sat. & light.). A hue of 360 and 0 (degree in a cylindrical coordinate system) is considered to be the same, this modul deals only with the ladder. my @hsl = Graphics::Toolkit::Color::Name::hsl_from_name('darkblue'); =head2 name_from_rgb Returns name of color with given rgb value triplet. Returns empty string if color is not stored. When several names define given color, the shortest name will be selected in scalar context. In array context all names are given. say Graphics::Toolkit::Color::Name::name_from_rgb( 15, 10, 121 ); # 'darkblue' say Graphics::Toolkit::Color::Name::name_from_rgb([15, 10, 121]); # works too =head2 name_from_hsl Returns name of color with given hsl value triplet. Returns empty string if color is not stored. When several names define given color, the shortest name will be selected in scalar context. In array context all names are given. say scalar Graphics::Toolkit::Color::Name::name_from_hsl( 0, 100, 50 ); # 'red' scalar Graphics::Toolkit::Color::Name::name_from_hsl([0, 100, 50]); # works too say for Graphics::Toolkit::Color::Name::name_from_hsl( 0, 100, 50 ); # 'red', 'red1' =head2 names_in_hsl_range Color names in selected neighbourhood of hsl color space, that look similar. It requires two arguments. The first one is an array containing three values (hue, saturation and lightness), that define the center of the neighbourhood (searched area). The second argument can either be a number or again an array with three values (h,s and l). If its just a number, it will be the radius r of a ball, that defines the neighbourhood. From all colors inside that ball, that are equal distanced or nearer to the center than r, one name will returned. If the second argument is an array, it has to contain the tolerance (allowed distance) in h, s and l direction. Please note the h dimension is circular: the distance from 355 to 0 is 5. The s and l dimensions are linear, so that a center value of 90 and a tolerance of 15 will result in a search of in the range 75 .. 100. The results contains only one name per color (the shortest). # all bright red'ish clors my @names = Graphics::Toolkit::Color::Name::names_in_hsl_range([0, 90, 50], 5); # approximates to : my @names = Graphics::Toolkit::Color::Name::names_in_hsl_range([0, 90, 50],[ 3, 3, 3]); =head2 all A sorted list of all stored color names. =head2 taken A perlish pseudo boolean tells if the color name (first and only, required argument) is already in use. =head2 add_rgb Adding a color to the store under an not taken (not already used) name. Arguments are name, red, green and blue value (integer < 256, see rgb). Graphics::Toolkit::Color::Name::add_rgb('nightblue', 15, 10, 121 ); Graphics::Toolkit::Color::Name::add_rgb('nightblue', [15, 10, 121]); =head2 add_hsl Adding a color to the store under an not taken (not already used) name. Arguments are name, hue, saturation and lightness value (see hsl). Graphics::Toolkit::Color::Name::add_rgb('lucky', 0, 100, 50 ); Graphics::Toolkit::Color::Name::add_rgb('lucky', [0, 100, 50]); =head1 SEE ALSO L L =head1 COPYRIGHT & LICENSE Copyright 2022-23 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. =head1 AUTHOR Herbert Breunung, Space.pm100644001750001750 1111514503102425 24650 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Coloruse v5.12; use warnings; # common code of Graphics::Toolkit::Color::Space::Instance::* package Graphics::Toolkit::Color::Space; use Graphics::Toolkit::Color::Space::Basis; use Graphics::Toolkit::Color::Space::Shape; sub new { my $pkg = shift; my %args = @_; my $basis = Graphics::Toolkit::Color::Space::Basis->new( $args{'axis'}, $args{'short'} ); return unless ref $basis; my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, $args{'range'}, $args{'type'} ); return unless ref $shape; # which formats the constructor will accept, that can be deconverted into list my %deformats = ( hash => sub { $basis->list_from_hash(@_) if $basis->is_hash(@_) }, named_array => sub { @{$_[0]}[1 .. $#{$_[0]}] if $basis->is_named_array(@_) }, string => sub { $basis->list_from_string(@_) if $basis->is_string(@_) }, css_string => sub { $basis->list_from_css(@_) if $basis->is_css_string(@_) }, ); # which formats we can output my %formats = (list => sub { @_ }, # 1,2,3 hash => sub { $basis->key_hash_from_list(@_) }, # { red => 1, green => 2, blue => 3 } char_hash => sub { $basis->shortcut_hash_from_list(@_) },# { r =>1, g => 2, b => 3 } array => sub { $basis->named_array_from_list(@_) }, # ['rgb',1,2,3] string => sub { $basis->named_string_from_list(@_) }, # rgb: 1, 2, 3 css_string => sub { $basis->css_string_from_list(@_) }, # rgb(1,2,3) ); bless { basis => $basis, shape => $shape, format => \%formats, deformat => \%deformats, convert => {} }; } sub basis { $_[0]{'basis'}} sub name { $_[0]->basis->name } sub dimensions { $_[0]->basis->count } sub is_array { $_[0]->basis->is_array( $_[1] ) } sub is_partial_hash { $_[0]->basis->is_partial_hash( $_[1] ) } sub has_format { (defined $_[1] and exists $_[0]{'format'}{ lc $_[1] }) ? 1 : 0 } sub can_convert { (defined $_[1] and exists $_[0]{'convert'}{ uc $_[1] }) ? 1 : 0 } ######################################################################## sub delta { shift->{'shape'}->delta( @_ ) } # @values -- @vector, @vector --> |@vector # on normalize values sub check { shift->{'shape'}->check( @_ ) } # @values -- @range --> ? # pos if carp sub clamp { shift->{'shape'}->clamp( @_ ) } # @values -- @range --> |@vector sub normalize { shift->{'shape'}->normalize(@_)} # @values -- @range --> |@vector sub denormalize{ shift->{'shape'}->denormalize(@_)} # @values -- @range --> |@vector sub denormalize_range{ shift->{'shape'}->denormalize_range(@_)} # @values -- @range --> |@vector ######################################################################## sub add_formatter { my ($self, $format, $code) = @_; return 0 if not defined $format or ref $format or ref $code ne 'CODE'; return 0 if $self->has_format( $format ); $self->{'format'}{ $format } = $code; } sub format { my ($self, $values, $format) = @_; return unless $self->basis->is_array( $values ); $self->{'format'}{ lc $format }->(@$values) if $self->has_format( $format ); } sub add_deformatter { my ($self, $format, $code) = @_; return 0 if not defined $format or ref $format or exists $self->{'deformat'}{$format} or ref $code ne 'CODE'; $self->{'deformat'}{ lc $format } = $code; } sub deformat { my ($self, $values) = @_; return undef unless defined $values; for my $deformatter (values %{$self->{'deformat'}}){ my @values = $deformatter->($values); return @values if @values == $self->dimensions; } return undef; } ######################################################################## sub add_converter { my ($self, $space_name, $to_code, $from_code, $mode) = @_; return 0 if not defined $space_name or ref $space_name or ref $from_code ne 'CODE' or ref $to_code ne 'CODE'; return 0 if $self->can_convert( $space_name ); $self->{'convert'}{ uc $space_name } = { from => $from_code, to => $to_code, mode => $mode }; } sub convert { my ($self, $values, $space_name) = @_; return unless $self->{'basis'}->is_array( $values ) and defined $space_name; $self->{'convert'}{ uc $space_name }{'to'}->(@$values) if $self->can_convert( $space_name ); } sub deconvert { my ($self, $values, $space_name) = @_; return unless ref $values eq 'ARRAY' and defined $space_name; $self->{'convert'}{ uc $space_name }{'from'}->(@$values) if $self->can_convert( $space_name ); } 1; Values.pm100644001750001750 2351414503102425 25062 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Coloruse v5.12; use warnings; # value objects with cache of original values package Graphics::Toolkit::Color::Values; use Graphics::Toolkit::Color::Space::Hub; use Carp; sub new { my ($pkg, $color_val) = @_; my ($values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat( $color_val ); return carp "could not recognize color values" unless ref $values; my $space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); my $std_space = Graphics::Toolkit::Color::Space::Hub::base_space(); my $self = {}; $self->{'origin'} = $space->name; $values = [$space->clamp( $values )]; $values = [$space->normalize( $values )]; $self->{$space->name} = $values; $self->{$std_space->name} = [$space->convert($values, $std_space->name)] if $space ne $std_space; bless $self; } sub get { # get a value tuple in any color space, range and format my ($self, $space_name, $format_name, $range_def) = @_; Graphics::Toolkit::Color::Space::Hub::check_space_name( $space_name ) and return; my $std_space_name = $Graphics::Toolkit::Color::Space::Hub::base_package; $space_name //= $std_space_name; my $space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); my $values = (exists $self->{$space->name}) ? $self->{$space->name} : [$space->deconvert( $self->{$std_space_name}, $std_space_name)]; $values = [ $space->denormalize( $values, $range_def) ]; Graphics::Toolkit::Color::Space::Hub::format( $values, $space_name, $format_name); } sub string { $_[0]->get( $_[0]->{'origin'}, 'string' ) } ######################################################################## sub set { # %val --> _ my ($self, $val_hash) = @_; my ($pos_hash, $space_name) = Graphics::Toolkit::Color::Space::Hub::partial_hash_deformat( $val_hash ); return carp 'key names: '.join(', ', keys %$val_hash). ' do not correlate to any supported color space' unless defined $space_name; my @values = $self->get( $space_name ); for my $pos (keys %$pos_hash){ $values[$pos] = $pos_hash->{ $pos }; } __PACKAGE__->new([$space_name, @values]); } sub add { # %val --> _ my ($self, $val_hash) = @_; my ($pos_hash, $space_name) = Graphics::Toolkit::Color::Space::Hub::partial_hash_deformat( $val_hash ); return carp 'key names: '.join(', ', keys %$val_hash). ' do not correlate to any supported color space' unless defined $space_name; my @values = $self->get( $space_name ); for my $pos (keys %$pos_hash){ $values[$pos] += $pos_hash->{ $pos }; } __PACKAGE__->new([$space_name, @values]); } sub blend { # _c1 _c2 -- +factor ~space --> _ my ($self, $c2, $factor, $space_name ) = @_; return carp "need value object as second argument" unless ref $c2 eq __PACKAGE__; $factor //= 0.5; $space_name //= 'HSL'; Graphics::Toolkit::Color::Space::Hub::check_space_name( $space_name ) and return; my @values1 = $self->get( $space_name ); my @values2 = $c2->get( $space_name ); my @rvalues = map { ((1-$factor) * $values1[$_]) + ($factor * $values2[$_]) } 0 .. $#values1; __PACKAGE__->new([$space_name, @rvalues]); } ######################################################################## sub distance { # _c1 _c2 -- ~space ~select @range --> + my ($self, $c2, $space_name, $select, $range) = @_; return carp "need value object as second argument" unless ref $c2 eq __PACKAGE__; $space_name //= 'HSL'; Graphics::Toolkit::Color::Space::Hub::check_space_name( $space_name ) and return; my $space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); $select = $space->basis->key_shortcut($select) if $space->basis->is_key( $select ); my @values1 = $self->get( $space_name, 'list', 'normal' ); my @values2 = $c2->get( $space_name, 'list', 'normal' ); return unless defined $values1[0] and defined $values2[0]; my @delta = $space->delta( \@values1, \@values2 ); @delta = $space->denormalize_range( \@delta, $range); return unless defined $delta[0] and @delta == $space->dimensions; # grep values for individual select / subspace distance if (defined $select and $select){ my @components = split( '', $select ); my $pos = $space->basis->key_pos( $select ); @components = defined( $pos ) ? ($pos) : (map { $space->basis->shortcut_pos($_) } grep { defined $space->basis->shortcut_pos($_) } @components); return - carp "called 'distance' for select $select that does not fit color space $space_name!" unless @components; @delta = map { $delta [$_] } @components; } # Euclidean distance: @delta = map {$_ * $_} @delta; my $d = 0; for (@delta) {$d += $_} return sqrt $d; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Value - single color related high level methods =head1 SYNOPSIS Readonly object that holds values of a color. It provides methods to get the values back in different formats, to measure difference to other colors or to create value objects of related colors. use Graphics::Toolkit::Color::Value; my $blue = Graphics::Toolkit::Color::Value->new( 'hsl(220,50,60)' ); my @rgb = $blue->get(); my $purple = $blue->set({red => 220}); =head1 DESCRIPTION The object that holds the normalized values of the original color definition (getter argument) and the normalized RGB tripled, if the color was not defined in RGB values. This way we omit conversion and rounding errors as much as possible. This package is a mediation layer between L below, where its just about number crunching of value vectors and the user API above in L, where it's mainly about producing sets of colors and handling the arguments. This module is not meant to be used as an public API since it has much less comfort than I. =head1 METHODS =head2 new The constructor takes only one required argument, a scalar that completely and numerically defines a color. Inside color definitions are color space names case insensitive. Some possible formats are [ 1, 2, 3 ] # RGB triplet [ HSL => 220, 100, 3 ] # named HSL vector { h => 220, s =>100, l => 3} # char hash { cyan => 1, magenta => 0.5, yellow => 0} # hash 'hwb: 20, 60, 30' # string 'hwb(20,60,30)' # css_string '#2211FF' # rgb hex string =head2 get Universal getter method -almost reverse function to new: It can return the colors values in all supported color spaces (first argument) (see: L) and all mentioned formats above (second argument). Additionally a third arguments can convert the numerical values into different ranges. The default name space is RGB, default format is a list and every color space has its default range. my @rgb = $val_object->get(); my @cmyk = $val_object->get('CMYK', 'list', 255); my $YIQ = $val_object->get('YIQ', 'string'); =head2 set Constructs a new C object by absolutely changing some values of the current object and keeping others. (I changes some values relatively.) The only and required argument is a I reference which has keys that match only one of the supported color spaces (see: L). Values outside of the defined limits will be clamped to an acceptable value (or rotated in case of circular dimensions). my $more_blend_color = $val_object->set( {saturation => 40} ); my $bright_color = $val_object->set( {saturation => 2240} ); #saturation will be 100 =head2 add This method takes also a HASH reference as input and also produces a related color object as previous I. Only difference is: the hash values will be added to the current. If they go outside of the defined limits, they will be clamped (or rotated in case of circular dimensions). my $darker_color = $val_object->set( {lightness => -10} ); =head2 blend Creates a color value object by mixing two colors. First and only required argument is the second color value object. Second argument is the mixing ratio. Zero would result in the original color and one to the second color. Default value is 0.5 (1:1 mix). Values outside the 0..1 rande are possible and values will be clamped if they leave the defined bounds of the required color space. Third optional argument is the name of the color space the mix will be calculated in - it defaults to I<'HSL'>. my $green = Graphics::Toolkit::Color::Values->new( '#00ff00' ); my $cyan = $blue->blend( $green, 0.6, 'YIQ' ); =head2 distance Computes a real number which designates the (Euclidean) distance between two points in a color space (a.k.a. colors). The first and only required argument is the second color as an I object. Second and optional argument is the name of the color space, where the distance is calculated in (default is I<'HSL'>). Third argument is the metric, which currently is just the subset of dimension in the chosen space that should be observed. One can also mention the shortcut name of a dimension several times to increase their weight in the calculation. Fourth optional argument are the numeric ranges of the dimensions. If none are given, the method only uses normalised (range: 0..1) values. my $blue = Graphics::Toolkit::Color::Values->new( '#0000ff' ); my $green = Graphics::Toolkit::Color::Values->new( '#00ff00' ); my $d = $blue->distance( $green, 'HSV', 's', 255); # 0 : both have same saturation =head1 SEE ALSO =over 4 =item * L =back =head1 COPYRIGHT & LICENSE Copyright 2023 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. =head1 AUTHOR Herbert Breunung, =cut Space000755001750001750 014503102425 24133 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/ColorHub.pm100644001750001750 3022514503102425 25371 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Spaceuse v5.12; use warnings; # check, convert and measure color values package Graphics::Toolkit::Color::Space::Hub; use Carp; our $base_package = 'RGB'; my @space_packages = ($base_package, qw/CMY CMYK HSL HSV HSB HWB YIQ /); # search order # HCL LUV Ncol ?XYZ LAB my %space_obj = map { $_ => require "Graphics/Toolkit/Color/Space/Instance/$_.pm" } @space_packages; sub get_space { $space_obj{ uc $_[0] } if exists $space_obj{ uc $_[0] } } sub is_space { (defined $_[0] and ref get_space($_[0])) ? 1 : 0 } sub base_space { $space_obj{$base_package} } sub space_names { @space_packages } ######################################################################## sub check_space_name { return unless defined $_[0]; my $error = "called with unknown color space name '$_[0]', please try one of: " . join (', ', @space_packages); is_space( $_[0] ) ? 0 : carp $error; } sub _check_values_and_space { my ($sub_name, $values, $space_name) = @_; $space_name //= $base_package; check_space_name( $space_name ) and return; my $space = get_space($space_name); $space->is_array( $values ) ? $space : carp 'need an ARRAY ref with '.$space->dimensions." $space_name values as first argument of $sub_name"; } ######################################################################## sub partial_hash_deformat { # convert partial hash into my ($value_hash) = @_; return unless ref $value_hash eq 'HASH'; for my $space_name (space_names()) { my $color_space = get_space( $space_name ); my $pos_hash = $color_space->basis->deformat_partial_hash( $value_hash ); return $pos_hash, $color_space->name if ref $pos_hash eq 'HASH'; } return undef; } sub deformat { # convert from any format into list of values of any space my ($formated_values) = @_; for my $space_name (space_names()) { my $color_space = get_space( $space_name ); my @val = $color_space->deformat( $formated_values ); return \@val, $space_name if defined $val[0]; } } sub format { # @tuple --> % | % |~ ... my ($values, $space_name, $format_name) = @_; my $space = _check_values_and_space( 'format', $values, $space_name ); return unless ref $space; my @values = $space->format( $values, $format_name // 'list' ); return @values, carp "got unknown format name: '$format_name'" unless defined $values[0]; return @values == 1 ? $values[0] : @values; } sub deconvert { # @... --> @RGB (base color space) # normalized values only my ($values, $space_name) = @_; my $space = _check_values_and_space( 'deconvert', $values, $space_name ); return unless ref $space; my @values = $space->clamp( $values, 'normal'); return @values if $space->name eq base_space->name; $space->convert( \@values, $base_package); } sub convert { # @RGB --> @... # normalized values only my ($values, $space_name) = @_; my $space = _check_values_and_space( 'convert', $values, $space_name ); return unless ref $space; my @values = base_space->clamp( $values, 'normal'); return @values if $space->name eq base_space->name; $space->deconvert( \@values, $base_package); } sub denormalize { # result clamped, alway in space my ($values, $space_name, $range) = @_; my $space = _check_values_and_space( 'denormalize', $values, $space_name ); return unless ref $space; my @values = $space->clamp($values, 'normal'); $space->denormalize( \@values, $range); } sub normalize { my ($values, $space_name, $range) = @_; my $space = _check_values_and_space( 'normalize', $values, $space_name ); return unless ref $space; my @values = $space->clamp($values, $range); return unless defined $values[0]; $space->normalize( $values, $range); } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Space::Hub - convert, format and measure color values =head1 SYNOPSIS Central hub for all color value related math. Can handle vectors of all spaces mentioned in next paragraph and translates also into and from different formats such as I I ('#AABBCC'). use Graphics::Toolkit::Color::Space::Hub; my $true = Graphics::Toolkit::Color::Space::Hub::is_space( 'HSL' ); my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space( 'HSL'); my $RGB = Graphics::Toolkit::Color::Space::Hub::base_space(); Graphics::Toolkit::Color::Space::Hub::space_names(); # all space names $HSL->normalize([240,100, 0]); # 2/3, 1, 0 $HSL->convert([240, 100, 0], 'RGB'); # 0, 0, 1 $HSL->deconvert([0, 0, 1], 'RGB'); # 2/3, 1, 0 $RGB->denormalize([0, 0, 1]); # 0, 0, 255 $RGB->format([0, 0, 255], 'hex'); # '#0000ff' my ($values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat( '#0000ff' ); # [0, 0, 255] , 'RGB' =head1 DESCRIPTION This module is supposed to be used by L and not directly, thus it exports no symbols and has a much less DWIM API then the main module. =head1 COLOR SPACES Color space names can be written in any combination of upper and lower case. =head2 RGB has three integer values: B (0 .. 255), B (0 .. 255) and B (0 .. 255). All are scaling from no (0) to very much (255) light of that color, so that (0,0,0) is black, (255,255,255) is white and (0,0,255) is blue. =head2 CMY is the inverse of RGB but with the range: 0 .. 1. B is the inverse value of I, B is inverse green and B is inverse of I. Inverse meaning when a color has the maximal I value, it has to have the minimal I value. =head2 CMYK is an extension of CMY with a fourth value named B (also 0 .. 1), which is basically the amount of black mixed into the CMY color. =head2 HSL has three integer values: B (0 .. 359), B (0 .. 100) and B (0 .. 100). Hue stands for a color on a rainbow: 0 = red, 15 approximates orange, 60 - yellow 120 - green, 180 - cyan, 240 - blue, 270 - violet, 300 - magenta, 330 - pink. 0 and 360 point to the same coordinate. This module only outputs 0, even if accepting 360 as input. I ranges from 0 = gray to 100 - clearest color set by hue. I ranges from 0 = black to 50 (hue or gray) to 100 = white. =head2 HSV Similar to HSL we have B and B, but the third value in named B. In HSL the color white is always achieved when I = 100. In HSV additionally I has to be zero to get white. When in HSV I is 100 and I is also 100, than we have the brightest clearest color of whatever I sets. =head2 HSB It is an alias to HSV, just value being renamed with B. =head2 HWB An inverted HSV, where the clean colors are inside of the cylinder. It still has the circular B dimension, as described in C. The other two, linear dimensions (also 0 .. 100 [percent]) are B and B, desribing how much white or black are mixed in. If both are zero, than we have a pure color. I of 100 always leads to pure white and I of 100 always leads to pure black. =head2 YIQ Has the linear dimensions I (sort of brightness, range 0..1), I (cyan - orange - balance, range -0.5959 .. 0.5959) and I (magenta - green - balance, range: -0.5227 .. 0.5227). =head1 FORMATS These formats are available in all color spaces. =head2 string 'RGB: 10, 20, 30' =head2 css_string 'rgb(10, 20, 30)' =head2 array [RGB, 10, 20, 30] =head2 hash { red => 10, green => 20, blue => 30 } =head2 char_hash { r => 10, g => 20, b => 30 } =head1 ROUTINES This package provides two sets of routines. Thes first is just a lookup of what color space objects are available. The second set consists of three pairs or routines about 3 essential operations of number values and their reversal. The full pipeline for the translation of color values is: 1. deformat (into a value list) 2. normalize (into 0..1 range) 3. convert/deconvert (into target color space) 4. denormalize (into target range) 5. format (into target format) =head2 space_names Returns a list of string values, which are the names of all available color space. See L. =head2 is_space Needs one argument, that supposed to be a color space name. If it is, the result is an 1, otherwise 0 (perlish pseudo boolean). =head2 get_space Needs one argument, that supposed to be a color space name. If it is, the result is the according color space object, otherwise undef. =head2 base_space Return the color space object of (currently) RGB name space. This name space is special since every color space object provides converters from and to RGB, but the RGB itself has no converter. =head2 normalize Normal in a mathematical sense means the range of acceptable values are between zero and one. Normalization means there for altering the values of numbers to fit in that range. For instance standard RGB values are integers between zero and 255. Normalizing them essentially means just dividing them with 255. my @rgb = Graphics::Toolkit::Color::Space::Hub::normalize( [0,10,255], 'RGB' ); It has one required and two optional arguments. The first is an ARRAY ref with the vector or values of a color. The seond argument is name of a color space. This is in most cases necessary, since all color space know their standard value ranges (being e.g. 3 x 0 .. 255 for RGB). If you want to normalize from special ranges like RGB16 you have use the third argument, which has to be a valid value range definition. my @rgb = Graphics::Toolkit::Color::Space::Hub::normalize( [0, 1000, 34000], 'RGB', 2**16 ); # which is the same as: my @rgb = Graphics::Toolkit::Color::Space::Hub::normalize( [0, 1000, 34000], 'RGB', [[0,65536].[0,65536].[0,65536]] ); =head2 denormalize Reverse function of I, taking the same arguments. If result has to be an integer (range maximum above 1), it will be rounded. my @rgb = Graphics::Toolkit::Color::Space::Hub::denormalize( [0,0.1,1], 'RGB' ); my @rgb = Graphics::Toolkit::Color::Space::Hub::denormalize( [0,0.1,1], 'RGB', 2**16 ); =head2 convert Converts a value vector (first argument) from base space (RGB) into any space mentioned space (second argument - see L). The values have to be normalized (inside 0..1). If there are outside the acceptable range, there will be clamped, so that the result will also normal. # convert from RGB to HSL my @hsl = Graphics::Toolkit::Color::Space::Hub::convert( [0.1, 0.5, .7], 'HSL' ); =head2 deconvert Converts a value tuple (vector - firs argument) of any color space (second argument) into the base space (RGB). # convert from HSL to RGB my @rgb = Graphics::Toolkit::Color::Space::Hub::deconvert( [0.9, 0.5, 0.5], 'HSL' ); =head2 format Putting a list of values (inside an ARRAY ref - first argument) from any supported color space (second argument) into another data format (third argument, see I). my $hex = Graphics::Toolkit::Color::Space::Hub::format( [255, 0, 10], 'hex' ); # 'ff00a0' my $string = Graphics::Toolkit::Color::Space::Hub::format( [255, 0, 10], 'string' ); # 'RGB: 255, 0, 10' =head2 deformat Reverse function of I, but also guesses the color space. That's why it takes only one argument, a scalar that can be a string, ARRAY ref or HASH ref. The result will be two values. The first is a ARRAY with all the unaltered, not clamped and not normalized values. The second is the name of the recognized color name space. my ($values, $space) = Graphics::Toolkit::Color::Space::Hub::deformat( 'ff00a0' ); # [255, 10 , 0], 'RGB' ($values, $space) = Graphics::Toolkit::Color::Space::Hub::deformat( [255, 10 , 0] ); # same result =head2 partial_hash_deformat This is a special case I routine for the I and I format (see I). It can tolerate missing values. The The result will also be a hash =head1 SEE ALSO =over 4 =item * L =back =head1 COPYRIGHT & LICENSE Copyright 2023 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. =head1 AUTHOR Herbert Breunung, =cut Util.pm100644001750001750 145514503102425 25553 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Spaceuse v5.12; use warnings; # utilities for any sub module of the distribution package Graphics::Toolkit::Color::Space::Util; use Exporter 'import'; our @EXPORT_OK = qw/round rmod close_enough min max/; our %EXPORT_TAGS = (all => [@EXPORT_OK]); my $half = 0.50000000000008; my $tolerance = 0.00000000000008; sub rgb_to_hue { my (@rgb) = @_; } sub max { my $v = shift; for (@_) { $v = $_ if $v < $_ } $v; } sub min { my $v = shift; for (@_) { $v = $_ if $v > $_ } $v; } sub round { $_[0] >= 0 ? int ($_[0] + $half) : int ($_[0] - $half) } # real value modulo sub rmod { return 0 unless defined $_[1] and $_[1]; $_[0] - (int($_[0] / $_[1]) * $_[1]); } sub close_enough { abs($_[0] - $_[1]) < 0.008 if defined $_[1]} 1; # min(floor(val*256),255) Basis.pm100644001750001750 1424114503102425 25714 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Spaceuse v5.12; use warnings; # logic of value hash keys for all color spacs package Graphics::Toolkit::Color::Space::Basis; sub new { my ($pkg, $axis_names, $name_shortcuts, $prefix) = @_; return unless ref $axis_names eq 'ARRAY'; return if defined $name_shortcuts and (ref $name_shortcuts ne 'ARRAY' or @$axis_names != @$name_shortcuts); my @keys = map {lc} @$axis_names; my @shortcuts = map { _color_key_shortcut($_) } (defined $name_shortcuts) ? @$name_shortcuts : @keys; return unless @keys > 0; my @iterator = 0 .. $#keys; my %key_order = map { $keys[$_] => $_ } @iterator; my %shortcut_order = map { $shortcuts[$_] => $_ } @iterator; bless { keys => [@keys], shortcuts => [@shortcuts], key_order => \%key_order, shortcut_order => \%shortcut_order, name => uc (join('', @shortcuts)), count => int @keys, iterator => \@iterator } } sub keys { @{$_[0]{'keys'}} } sub shortcuts{ @{$_[0]{'shortcuts'}} } sub iterator { @{$_[0]{'iterator'}} } sub count { $_[0]{'count'} } sub name { $_[0]{'name'} } sub key_pos { defined $_[1] ? $_[0]->{'key_order'}{ lc $_[1] } : undef} sub shortcut_pos { defined $_[1] ? $_[0]->{'shortcut_order'}{ lc $_[1] } : undef } sub is_key { (defined $_[1] and exists $_[0]->{'key_order'}{ lc $_[1] }) ? 1 : 0 } sub is_shortcut { (defined $_[1] and exists $_[0]->{'shortcut_order'}{ lc $_[1] }) ? 1 : 0 } sub is_key_or_shortcut { $_[0]->is_key($_[1]) or $_[0]->is_shortcut($_[1]) } sub is_string { my ($self, $string) = @_; return 0 unless defined $string and not ref $string; $string = lc $string; my $name = lc $self->name; return 0 unless index($string, $name.':') == 0; my $nr = '\s*-?\d+(?:\.\d+)?\s*'; my $nrs = join(',', ('\s*-?\d+(?:\.\d+)?\s*') x $self->count); ($string =~ /^$name:$nrs$/) ? 1 : 0; } sub is_css_string { my ($self, $string) = @_; return 0 unless defined $string and not ref $string; $string = lc $string; my $name = lc $self->name; return 0 unless index($string, $name.'(') == 0; my $nr = '\s*-?\d+(?:\.\d+)?\s*'; my $nrs = join(',', ('\s*-?\d+(?:\.\d+)?\s*') x $self->count); ($string =~ /^$name\($nrs\)$/) ? 1 : 0; } sub is_array { my ($self, $value_array) = @_; (ref $value_array eq 'ARRAY' and @$value_array == $self->{'count'}) ? 1 : 0; } sub is_named_array { my ($self, $value_array) = @_; (ref $value_array eq 'ARRAY' and @$value_array == ($self->{'count'}+1) and uc $value_array->[0] eq uc $self->name) ? 1 : 0; } sub is_hash { my ($self, $value_hash) = @_; return 0 unless ref $value_hash eq 'HASH' and CORE::keys %$value_hash == $self->{'count'}; for (CORE::keys %$value_hash) { return 0 unless $self->is_key_or_shortcut($_); } return 1; } sub is_partial_hash { my ($self, $value_hash) = @_; return 0 unless ref $value_hash eq 'HASH'; my $key_count = CORE::keys %$value_hash; return 0 unless $key_count and $key_count <= $self->{'count'}; for (CORE::keys %$value_hash) { return 0 unless $self->is_key_or_shortcut($_); } return 1; } ######################################################################## sub key_shortcut { my ($self, $key) = @_; return unless $self->is_key( $key ); ($self->shortcuts)[ $self->{'key_order'}{ lc $key } ]; } sub list_value_from_key { my ($self, $key, @values) = @_; $key = lc $key; return unless @values == $self->{'count'}; return unless exists $self->{'key_order'}{ $key }; return $values[ $self->{'key_order'}{ $key } ]; } sub list_value_from_shortcut { my ($self, $shortcut, @values) = @_; $shortcut = lc $shortcut; return unless @values == $self->{'count'}; return unless exists $self->{'shortcut_order'}{ $shortcut }; return $values[ $self->{'shortcut_order'}{ $shortcut } ]; } sub list_from_hash { my ($self, $value_hash) = @_; return undef unless ref $value_hash eq 'HASH' and CORE::keys %$value_hash == $self->{'count'}; my @values = (0) x $self->{'count'}; for my $value_key (CORE::keys %$value_hash) { if ($self->is_key( $value_key )) { $values[ $self->{'key_order'}{ lc $value_key } ] = $value_hash->{ $value_key } } elsif ($self->is_shortcut( $value_key )) { $values[ $self->{'shortcut_order'}{ lc $value_key } ] = $value_hash->{ $value_key } } else { return } } return @values; } sub deformat_partial_hash { my ($self, $value_hash) = @_; return unless ref $value_hash eq 'HASH'; my @keys_got = CORE::keys %$value_hash; return unless @keys_got and @keys_got <= $self->{'count'}; my $result = {}; for my $key (@keys_got) { if ($self->is_key( $key )) { $result->{ int $self->key_pos( $key ) } = $value_hash->{ $key } } elsif ($self->is_shortcut( $key )){ $result->{ int $self->shortcut_pos( $key ) } = $value_hash->{ $key } } else { return undef } } return $result; } sub list_from_string { my ($self, $string) = @_; my @parts = split(/:/, $string); return map {$_ + 0} split(/,/, $parts[1]); } sub list_from_css { my ($self, $string) = @_; 1 until chop($string) eq ')'; my @parts = split(/\(/, $string); return map {$_ + 0} split(/,/, $parts[1]); } sub key_hash_from_list { my ($self, @values) = @_; return unless @values == $self->{'count'}; return { map { $self->{'keys'}[$_] => $values[$_]} @{$self->{'iterator'}} }; } sub shortcut_hash_from_list { my ($self, @values) = @_; return unless @values == $self->{'count'}; return { map {$self->{'shortcuts'}[$_] => $values[$_]} @{$self->{'iterator'}} }; } sub named_array_from_list { my ($self, @values) = @_; return [lc $self->name, @values] if @values == $self->{'count'}; } sub named_string_from_list { my ($self, @values) = @_; return unless @values == $self->{'count'}; lc( $self->name).': '.join(', ', @values); } sub css_string_from_list { my ($self, @values) = @_; return unless @values == $self->{'count'}; lc( $self->name).'('.join(',', @values).')'; } sub _color_key_shortcut { lc substr($_[0], 0, 1) if defined $_[0] } 1; Shape.pm100644001750001750 1400314503102425 25707 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Spaceuse v5.12; use warnings; # logic of value hash keys for all color spacs package Graphics::Toolkit::Color::Space::Shape; use Graphics::Toolkit::Color::Space::Basis; use Graphics::Toolkit::Color::Space::Util ':all'; use Carp; sub new { my $pkg = shift; my ($basis, $range, $type) = @_; return unless ref $basis eq 'Graphics::Toolkit::Color::Space::Basis'; if (not defined $range or $range eq 'normal'){ # check range settings $range = [([0,1]) x $basis->count]; # default range = normal range } elsif (not ref $range and $range > 0) { # single int range def $range = int $range; $range = [([0, $range]) x $basis->count]; } elsif (ref $range eq 'ARRAY' and @$range == $basis->count ) { # full range def for my $i ($basis->iterator) { my $drange = $range->[$i]; # range def of this dimension if (not ref $drange and $drange > 0){ $drange = int $drange; $range->[$i] = [0, $drange]; } elsif (ref $drange eq 'ARRAY' and @$drange == 2 and defined $drange->[0] and defined $drange->[1] and $drange->[0] < $drange->[1]) { # full valid def } else { return } } } else { return } if (not defined $type){ $type = [ (1) x $basis->count ] } # default is all linear space elsif (ref $type eq 'ARRAY' and @$type == $basis->count ) { for my $i ($basis->iterator) { my $dtype = $type->[$i]; # type def of this dimension return unless defined $dtype; if ($dtype eq 'angle' or $dtype eq 'circular' or $dtype eq '0') { $type->[$i] = 0 } elsif ($dtype eq 'linear' or $dtype eq '1') { $type->[$i] = 1 } else { return } } } else { return } bless { basis => $basis, range => $range, type => $type } } sub basis { $_[0]{'basis'}} sub dimension_is_int { my ($self, $dnr, $range) = @_; $range //= $self->{'range'}; return undef unless ref $range eq 'ARRAY' and exists $range->[$dnr]; my $r = $range->[$dnr]; return 0 if $r->[0] == 0 and $r->[1] == 1; #normal return 0 if int($r->[0]) != $r->[0]; return 0 if int($r->[1]) != $r->[1]; 1; } sub _range { my ($self, $external_range) = @_; return $self->{'range'} unless defined $external_range; # check if range def is valid and eval (exapand) it $external_range = Graphics::Toolkit::Color::Space::Shape->new( $self->{'basis'}, $external_range, $self->{'type'}); return (ref $external_range) ? $external_range->{'range'} : undef ; } ######################################################################## sub delta { # values have to be normalized my ($self, $values1, $values2) = @_; return unless $self->basis->is_array( $values1 ) and $self->basis->is_array( $values2 ); my @delta = map {$values2->[$_] - $values1->[$_] } $self->basis->iterator; map { $self->{'type'}[$_] ? $delta[$_] : $delta[$_] < -0.5 ? ($delta[$_]+1) : $delta[$_] > 0.5 ? ($delta[$_]-1) : $delta[$_] } $self->basis->iterator; } sub check { my ($self, $values, $range) = @_; return carp 'color value vector in '.$self->basis->name.' needs '.$self->basis->count.' values' unless $self->basis->is_array( $values ); $range = $self->_range( $range ); return carp "bad range definition" unless ref $range; my @names = $self->basis->keys; for my $i ($self->basis->iterator){ return carp $names[$i]." value is below minimum of ".$range->[$i][0] if $values->[$i] < $range->[$i][0]; return carp $names[$i]." value is above maximum of ".$range->[$i][1] if $values->[$i] > $range->[$i][1]; return carp $names[$i]." value has to be an integer" if $self->dimension_is_int($i, $range) and int $values->[$i] != $values->[$i]; } return; } sub clamp { my ($self, $values, $range) = @_; $range = $self->_range( $range ); return undef, carp "bad range definition, need upper limit, 2 element ARRAY or ARRAY of 2 element ARRAYs" unless ref $range; $values = [] unless ref $values eq 'ARRAY'; push @$values, 0 while @$values < $self->basis->count; pop @$values while @$values > $self->basis->count; for my $i ($self->basis->iterator){ my $delta = $range->[$i][1] - $range->[$i][0]; if ($self->{'type'}[$i]){ $values->[$i] = $range->[$i][0] if $values->[$i] < $range->[$i][0]; $values->[$i] = $range->[$i][1] if $values->[$i] > $range->[$i][1]; } else { $values->[$i] += $delta while $values->[$i] < $range->[$i][0]; $values->[$i] -= $delta while $values->[$i] > $range->[$i][1]; $values->[$i] = $range->[$i][0] if $values->[$i] == $range->[$i][1]; } $values->[$i] = round($values->[$i]) if $self->dimension_is_int($i, $range); } return @$values; } ######################################################################## sub normalize { my ($self, $values, $range) = @_; return unless $self->basis->is_array( $values ); $range = $self->_range( $range ); return carp "bad range definition" unless ref $range; map { ($values->[$_] - $range->[$_][0]) / ($range->[$_][1]-$range->[$_][0]) } $self->basis->iterator; } sub denormalize { my ($self, $values, $range) = @_; return unless $self->basis->is_array( $values ); $range = $self->_range( $range ); return carp "bad range definition" unless ref $range; my @val = map { $values->[$_] * ($range->[$_][1]-$range->[$_][0]) + $range->[$_][0] } $self->basis->iterator; @val = map { $self->dimension_is_int($_, $range) ? round ($val[$_]) : $val[$_] } $self->basis->iterator; return @val; } sub denormalize_range { my ($self, $values, $range) = @_; return unless $self->basis->is_array( $values ); $range = $self->_range( $range ); return carp "bad range definition" unless ref $range; map { $values->[$_] * ($range->[$_][1]-$range->[$_][0]) } $self->basis->iterator; } 1; Name000755001750001750 014503102425 23760 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/ColorConstant.pm100644001750001750 15250014503102425 26312 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Nameuse v5.12; # named colors from X11, HTML (SVG) standard and Pantone report package Graphics::Toolkit::Color::Name::Constant; { # http://en.wikipedia.org/wiki/Web_colors#X11_color_names # 2.6 MB 'white' => [ 255, 255, 255, 0, 0, 100 ], 'black' => [ 0, 0, 0, 0, 0, 0 ], 'red' => [ 255, 0, 0, 0, 100, 50 ], 'green' => [ 0, 128, 0, 120, 100, 25 ], 'blue' => [ 0, 0, 255, 240, 100, 50 ], 'yellow' => [ 255, 255, 0, 60, 100, 50 ], 'purple' => [ 128, 0, 128, 300, 100, 25 ], 'pink' => [ 255, 192, 203, 350, 100, 88 ], 'peach' => [ 250, 125, 125, 0, 93, 74 ], 'plum' => [ 221, 160, 221, 300, 47, 75 ], 'mauve' => [ 200, 125, 125, 0, 41, 64 ], 'brown' => [ 165, 42, 42, 0, 59, 41 ], 'grey' => [ 225, 225, 225, 0, 0, 88 ], 'aliceblue' => [ 240, 248, 255, 208, 100, 97 ], 'antiquewhite' => [ 250, 235, 215, 34, 78, 91 ], 'antiquewhite1' => [ 255, 239, 219, 33, 100, 93 ], 'antiquewhite2' => [ 238, 223, 204, 34, 50, 87 ], 'antiquewhite3' => [ 205, 192, 176, 33, 22, 75 ], 'antiquewhite4' => [ 139, 131, 120, 35, 8, 51 ], 'aqua' => [ 0, 255, 255, 180, 100, 50 ], 'aquamarine' => [ 127, 255, 212, 160, 100, 75 ], 'aquamarine1' => [ 127, 255, 212, 160, 100, 75 ], 'aquamarine2' => [ 118, 238, 198, 160, 78, 70 ], 'aquamarine3' => [ 102, 205, 170, 160, 51, 60 ], # not in X11 'aquamarine4' => [ 69, 139, 116, 160, 34, 41 ], 'azure' => [ 240, 255, 255, 180, 100, 97 ], 'azure1' => [ 240, 255, 255, 180, 100, 97 ], 'azure2' => [ 224, 238, 238, 180, 29, 91 ], 'azure3' => [ 193, 205, 205, 180, 11, 78 ], 'azure4' => [ 131, 139, 139, 180, 3, 53 ], 'beige' => [ 245, 245, 220, 60, 56, 91 ], 'bisque' => [ 255, 228, 196, 33, 100, 88 ], 'bisque1' => [ 255, 228, 196, 33, 100, 88 ], 'bisque2' => [ 238, 213, 183, 33, 62, 83 ], 'bisque3' => [ 205, 183, 158, 32, 32, 71 ], 'bisque4' => [ 139, 125, 107, 34, 13, 48 ], 'blanchedalmond' => [ 255, 235, 205, 36, 100, 90 ], 'blue1' => [ 0, 0, 255, 240, 100, 50 ], 'blue2' => [ 0, 0, 238, 240, 100, 47 ], 'blue3' => [ 0, 0, 205, 240, 100, 40 ], 'blue4' => [ 0, 0, 139, 240, 100, 27 ], 'blueviolet' => [ 138, 43, 226, 271, 76, 53 ], 'brown1' => [ 255, 64, 64, 0, 100, 63 ], 'brown2' => [ 238, 59, 59, 0, 84, 58 ], 'brown3' => [ 205, 51, 51, 0, 61, 50 ], 'brown4' => [ 139, 35, 35, 0, 60, 34 ], 'burlywood' => [ 222, 184, 135, 34, 57, 70 ], 'burlywood1' => [ 255, 211, 155, 34, 100, 80 ], 'burlywood2' => [ 238, 197, 145, 34, 73, 75 ], 'burlywood3' => [ 205, 170, 125, 34, 44, 65 ], 'burlywood4' => [ 139, 115, 85, 33, 24, 44 ], 'cadetblue' => [ 95, 158, 160, 182, 25, 50 ], 'cadetblue1' => [ 152, 245, 255, 186, 100, 80 ], 'cadetblue2' => [ 142, 229, 238, 186, 74, 75 ], 'cadetblue3' => [ 122, 197, 205, 186, 45, 64 ], 'cadetblue4' => [ 83, 134, 139, 185, 25, 44 ], 'chartreuse' => [ 127, 255, 0, 90, 100, 50 ], 'chartreuse1' => [ 127, 255, 0, 90, 100, 50 ], 'chartreuse2' => [ 118, 238, 0, 90, 100, 47 ], 'chartreuse3' => [ 102, 205, 0, 90, 100, 40 ], 'chartreuse4' => [ 69, 139, 0, 90, 100, 27 ], 'chocolate' => [ 210, 105, 30, 25, 75, 47 ], 'chocolate1' => [ 255, 127, 36, 25, 100, 57 ], 'chocolate2' => [ 238, 118, 33, 25, 86, 53 ], 'chocolate3' => [ 205, 102, 29, 25, 75, 46 ], 'chocolate4' => [ 139, 69, 19, 25, 76, 31 ], 'coral' => [ 255, 127, 80, 16, 100, 66 ], 'coral1' => [ 255, 114, 86, 10, 100, 67 ], 'coral2' => [ 238, 106, 80, 10, 82, 62 ], 'coral3' => [ 205, 91, 69, 10, 58, 54 ], 'coral4' => [ 139, 62, 47, 10, 49, 36 ], 'cornflowerblue' => [ 100, 149, 237, 219, 79, 66 ], 'cornsilk' => [ 255, 248, 220, 48, 100, 93 ], 'cornsilk1' => [ 255, 248, 220, 48, 100, 93 ], 'cornsilk2' => [ 238, 232, 205, 49, 49, 87 ], 'cornsilk3' => [ 205, 200, 177, 49, 22, 75 ], 'cornsilk4' => [ 139, 136, 120, 51, 8, 51 ], 'crimson' => [ 220, 20, 60, 348, 83, 47 ], 'cyan' => [ 0, 255, 255, 180, 100, 50 ], 'cyan1' => [ 0, 255, 255, 180, 100, 50 ], 'cyan2' => [ 0, 238, 238, 180, 100, 47 ], 'cyan3' => [ 0, 205, 205, 180, 100, 40 ], 'cyan4' => [ 0, 139, 139, 180, 100, 27 ], 'darkblue' => [ 0, 0, 139, 240, 100, 27 ], 'darkcyan' => [ 0, 139, 139, 180, 100, 27 ], 'darkgoldenrod' => [ 184, 134, 11, 43, 89, 38 ], 'darkgoldenrod1' => [ 255, 185, 15, 43, 100, 53 ], 'darkgoldenrod2' => [ 238, 173, 14, 43, 89, 49 ], 'darkgoldenrod3' => [ 205, 149, 12, 43, 89, 43 ], 'darkgoldenrod4' => [ 139, 101, 8, 43, 89, 29 ], 'darkgray' => [ 169, 169, 169, 0, 0, 66 ], 'darkgreen' => [ 0, 100, 0, 120, 100, 20 ], 'darkkhaki' => [ 189, 183, 107, 56, 38, 58 ], 'darkmagenta' => [ 139, 0, 139, 300, 100, 27 ], 'darkolivegreen' => [ 85, 107, 47, 82, 39, 30 ], 'darkolivegreen1' => [ 202, 255, 112, 82, 100, 72 ], 'darkolivegreen2' => [ 188, 238, 104, 82, 80, 67 ], 'darkolivegreen3' => [ 162, 205, 90, 82, 53, 58 ], 'darkolivegreen4' => [ 110, 139, 61, 82, 39, 39 ], 'darkorange' => [ 255, 140, 0, 33, 100, 50 ], 'darkorange1' => [ 255, 127, 0, 30, 100, 50 ], 'darkorange2' => [ 238, 118, 0, 30, 100, 47 ], 'darkorange3' => [ 205, 102, 0, 30, 100, 40 ], 'darkorange4' => [ 139, 69, 0, 30, 100, 27 ], 'darkorchid' => [ 153, 50, 204, 280, 61, 50 ], 'darkorchid1' => [ 191, 62, 255, 280, 100, 62 ], 'darkorchid2' => [ 178, 58, 238, 280, 84, 58 ], 'darkorchid3' => [ 154, 50, 205, 280, 61, 50 ], 'darkorchid4' => [ 104, 34, 139, 280, 61, 34 ], 'darkred' => [ 139, 0, 0, 0, 100, 27 ], 'darksalmon' => [ 233, 150, 122, 15, 72, 70 ], 'darkseagreen' => [ 143, 188, 143, 120, 25, 65 ], 'darkseagreen1' => [ 193, 255, 193, 120, 100, 88 ], 'darkseagreen2' => [ 180, 238, 180, 120, 63, 82 ], 'darkseagreen3' => [ 155, 205, 155, 120, 33, 71 ], 'darkseagreen4' => [ 105, 139, 105, 120, 14, 48 ], 'darkslateblue' => [ 72, 61, 139, 248, 39, 39 ], 'darkslategray' => [ 47, 79, 79, 180, 25, 25 ], 'darkslategray1' => [ 151, 255, 255, 180, 100, 80 ], 'darkslategray2' => [ 141, 238, 238, 180, 74, 74 ], 'darkslategray3' => [ 121, 205, 205, 180, 46, 64 ], 'darkslategray4' => [ 82, 139, 139, 180, 26, 43 ], 'darkturquoise' => [ 0, 206, 209, 181, 100, 41 ], 'darkviolet' => [ 148, 0, 211, 282, 100, 41 ], 'deeppink' => [ 255, 20, 147, 328, 100, 54 ], 'deeppink1' => [ 255, 20, 147, 328, 100, 54 ], 'deeppink2' => [ 238, 18, 137, 328, 87, 50 ], 'deeppink3' => [ 205, 16, 118, 328, 86, 43 ], 'deeppink4' => [ 139, 10, 80, 327, 87, 29 ], 'deepskyblue' => [ 0, 191, 255, 195, 100, 50 ], 'deepskyblue1' => [ 0, 191, 255, 195, 100, 50 ], 'deepskyblue2' => [ 0, 178, 238, 195, 100, 47 ], 'deepskyblue3' => [ 0, 154, 205, 195, 100, 40 ], 'deepskyblue4' => [ 0, 104, 139, 195, 100, 27 ], 'dimgray' => [ 105, 105, 105, 0, 0, 41 ], 'dodgerblue' => [ 30, 144, 255, 210, 100, 56 ], 'dodgerblue1' => [ 30, 144, 255, 210, 100, 56 ], 'dodgerblue2' => [ 28, 134, 238, 210, 86, 52 ], 'dodgerblue3' => [ 24, 116, 205, 210, 79, 45 ], 'dodgerblue4' => [ 16, 78, 139, 210, 79, 30 ], 'firebrick' => [ 178, 34, 34, 0, 68, 42 ], 'firebrick1' => [ 255, 48, 48, 0, 100, 59 ], 'firebrick2' => [ 238, 44, 44, 0, 85, 55 ], 'firebrick3' => [ 205, 38, 38, 0, 69, 48 ], 'firebrick4' => [ 139, 26, 26, 0, 68, 32 ], 'floralwhite' => [ 255, 250, 240, 40, 100, 97 ], 'forestgreen' => [ 34, 139, 34, 120, 61, 34 ], 'fuchsia' => [ 255, 0, 255, 300, 100, 50 ], 'gainsboro' => [ 220, 220, 220, 0, 0, 86 ], 'ghostwhite' => [ 248, 248, 255, 240, 100, 99 ], 'gold' => [ 255, 215, 0, 51, 100, 50 ], 'gold1' => [ 255, 215, 0, 51, 100, 50 ], 'gold2' => [ 238, 201, 0, 51, 100, 47 ], 'gold3' => [ 205, 173, 0, 51, 100, 40 ], 'gold4' => [ 139, 117, 0, 51, 100, 27 ], 'goldenrod' => [ 218, 165, 32, 43, 74, 49 ], 'goldenrod1' => [ 255, 193, 37, 43, 100, 57 ], 'goldenrod2' => [ 238, 180, 34, 43, 86, 53 ], 'goldenrod3' => [ 205, 155, 29, 43, 75, 46 ], 'goldenrod4' => [ 139, 105, 20, 43, 75, 31 ], 'gray' => [ 128, 128, 128, 0, 0, 50 ], 'gray1' => [ 3, 3, 3, 0, 0, 1 ], 'gray2' => [ 5, 5, 5, 0, 0, 2 ], 'gray3' => [ 8, 8, 8, 0, 0, 3 ], 'gray4' => [ 10, 10, 10, 0, 0, 4 ], 'gray5' => [ 13, 13, 13, 0, 0, 5 ], 'gray6' => [ 15, 15, 15, 0, 0, 6 ], 'gray7' => [ 18, 18, 18, 0, 0, 7 ], 'gray8' => [ 20, 20, 20, 0, 0, 8 ], 'gray9' => [ 23, 23, 23, 0, 0, 9 ], 'gray10' => [ 26, 26, 26, 0, 0, 10 ], 'gray11' => [ 28, 28, 28, 0, 0, 11 ], 'gray12' => [ 31, 31, 31, 0, 0, 12 ], 'gray13' => [ 33, 33, 33, 0, 0, 13 ], 'gray14' => [ 36, 36, 36, 0, 0, 14 ], 'gray15' => [ 38, 38, 38, 0, 0, 15 ], 'gray16' => [ 41, 41, 41, 0, 0, 16 ], 'gray17' => [ 43, 43, 43, 0, 0, 17 ], 'gray18' => [ 46, 46, 46, 0, 0, 18 ], 'gray19' => [ 48, 48, 48, 0, 0, 19 ], 'gray20' => [ 51, 51, 51, 0, 0, 20 ], 'gray21' => [ 54, 54, 54, 0, 0, 21 ], 'gray22' => [ 56, 56, 56, 0, 0, 22 ], 'gray23' => [ 59, 59, 59, 0, 0, 23 ], 'gray24' => [ 61, 61, 61, 0, 0, 24 ], 'gray25' => [ 64, 64, 64, 0, 0, 25 ], 'gray26' => [ 66, 66, 66, 0, 0, 26 ], 'gray27' => [ 69, 69, 69, 0, 0, 27 ], 'gray28' => [ 71, 71, 71, 0, 0, 28 ], 'gray29' => [ 74, 74, 74, 0, 0, 29 ], 'gray30' => [ 77, 77, 77, 0, 0, 30 ], 'gray31' => [ 79, 79, 79, 0, 0, 31 ], 'gray32' => [ 82, 82, 82, 0, 0, 32 ], 'gray33' => [ 84, 84, 84, 0, 0, 33 ], 'gray34' => [ 87, 87, 87, 0, 0, 34 ], 'gray35' => [ 89, 89, 89, 0, 0, 35 ], 'gray36' => [ 92, 92, 92, 0, 0, 36 ], 'gray37' => [ 94, 94, 94, 0, 0, 37 ], 'gray38' => [ 97, 97, 97, 0, 0, 38 ], 'gray39' => [ 99, 99, 99, 0, 0, 39 ], 'gray40' => [ 102, 102, 102, 0, 0, 40 ], 'gray41' => [ 105, 105, 105, 0, 0, 41 ], 'gray42' => [ 107, 107, 107, 0, 0, 42 ], 'gray43' => [ 110, 110, 110, 0, 0, 43 ], 'gray44' => [ 112, 112, 112, 0, 0, 44 ], 'gray45' => [ 115, 115, 115, 0, 0, 45 ], 'gray46' => [ 117, 117, 117, 0, 0, 46 ], 'gray47' => [ 120, 120, 120, 0, 0, 47 ], 'gray48' => [ 122, 122, 122, 0, 0, 48 ], 'gray49' => [ 125, 125, 125, 0, 0, 49 ], 'gray50' => [ 127, 127, 127, 0, 0, 50 ], 'gray51' => [ 130, 130, 130, 0, 0, 51 ], 'gray52' => [ 133, 133, 133, 0, 0, 52 ], 'gray53' => [ 135, 135, 135, 0, 0, 53 ], 'gray54' => [ 138, 138, 138, 0, 0, 54 ], 'gray55' => [ 140, 140, 140, 0, 0, 55 ], 'gray56' => [ 143, 143, 143, 0, 0, 56 ], 'gray57' => [ 145, 145, 145, 0, 0, 57 ], 'gray58' => [ 148, 148, 148, 0, 0, 58 ], 'gray59' => [ 150, 150, 150, 0, 0, 59 ], 'gray60' => [ 153, 153, 153, 0, 0, 60 ], 'gray61' => [ 156, 156, 156, 0, 0, 61 ], 'gray62' => [ 158, 158, 158, 0, 0, 62 ], 'gray63' => [ 161, 161, 161, 0, 0, 63 ], 'gray64' => [ 163, 163, 163, 0, 0, 64 ], 'gray65' => [ 166, 166, 166, 0, 0, 65 ], 'gray66' => [ 168, 168, 168, 0, 0, 66 ], 'gray67' => [ 171, 171, 171, 0, 0, 67 ], 'gray68' => [ 173, 173, 173, 0, 0, 68 ], 'gray69' => [ 176, 176, 176, 0, 0, 69 ], 'gray70' => [ 179, 179, 179, 0, 0, 70 ], 'gray71' => [ 181, 181, 181, 0, 0, 71 ], 'gray72' => [ 184, 184, 184, 0, 0, 72 ], 'gray73' => [ 186, 186, 186, 0, 0, 73 ], 'gray74' => [ 189, 189, 189, 0, 0, 74 ], 'gray75' => [ 191, 191, 191, 0, 0, 75 ], 'gray76' => [ 194, 194, 194, 0, 0, 76 ], 'gray77' => [ 196, 196, 196, 0, 0, 77 ], 'gray78' => [ 199, 199, 199, 0, 0, 78 ], 'gray79' => [ 201, 201, 201, 0, 0, 79 ], 'gray80' => [ 204, 204, 204, 0, 0, 80 ], 'gray81' => [ 207, 207, 207, 0, 0, 81 ], 'gray82' => [ 209, 209, 209, 0, 0, 82 ], 'gray83' => [ 212, 212, 212, 0, 0, 83 ], 'gray84' => [ 214, 214, 214, 0, 0, 84 ], 'gray85' => [ 217, 217, 217, 0, 0, 85 ], 'gray86' => [ 219, 219, 219, 0, 0, 86 ], 'gray87' => [ 222, 222, 222, 0, 0, 87 ], 'gray88' => [ 224, 224, 224, 0, 0, 88 ], 'gray89' => [ 227, 227, 227, 0, 0, 89 ], 'gray90' => [ 229, 229, 229, 0, 0, 90 ], 'gray91' => [ 232, 232, 232, 0, 0, 91 ], 'gray92' => [ 235, 235, 235, 0, 0, 92 ], 'gray93' => [ 237, 237, 237, 0, 0, 93 ], 'gray94' => [ 240, 240, 240, 0, 0, 94 ], 'gray95' => [ 242, 242, 242, 0, 0, 95 ], 'gray97' => [ 247, 247, 247, 0, 0, 97 ], 'gray98' => [ 250, 250, 250, 0, 0, 98 ], 'gray99' => [ 252, 252, 252, 0, 0, 99 ], 'green1' => [ 0, 255, 0, 120, 100, 50 ], 'green2' => [ 0, 238, 0, 120, 100, 47 ], 'green3' => [ 0, 205, 0, 120, 100, 40 ], 'green4' => [ 0, 139, 0, 120, 100, 27 ], 'greenyellow' => [ 173, 255, 47, 84, 100, 59 ], 'grey1' => [ 3, 3, 3, 0, 0, 1 ], 'grey2' => [ 5, 5, 5, 0, 0, 2 ], 'grey3' => [ 8, 8, 8, 0, 0, 3 ], 'grey4' => [ 10, 10, 10, 0, 0, 4 ], 'honeydew' => [ 240, 255, 240, 120, 100, 97 ], 'honeydew1' => [ 240, 255, 240, 120, 100, 97 ], 'honeydew2' => [ 224, 238, 224, 120, 29, 91 ], 'honeydew3' => [ 193, 205, 193, 120, 11, 78 ], 'honeydew4' => [ 131, 139, 131, 120, 3, 53 ], 'hotpink' => [ 255, 105, 180, 330, 100, 71 ], 'hotpink1' => [ 255, 110, 180, 331, 100, 72 ], 'hotpink2' => [ 238, 106, 167, 332, 80, 67 ], 'hotpink3' => [ 205, 96, 144, 334, 52, 59 ], 'hotpink4' => [ 139, 58, 98, 330, 41, 39 ], 'indianred' => [ 205, 92, 92, 0, 53, 58 ], 'indianred1' => [ 255, 106, 106, 0, 100, 71 ], 'indianred2' => [ 238, 99, 99, 0, 80, 66 ], 'indianred3' => [ 205, 85, 85, 0, 55, 57 ], 'indianred4' => [ 139, 58, 58, 0, 41, 39 ], 'indigo' => [ 75, 0, 130, 275, 100, 25 ], 'ivory' => [ 255, 255, 240, 60, 100, 97 ], 'ivory1' => [ 255, 255, 240, 60, 100, 97 ], 'ivory2' => [ 238, 238, 224, 60, 29, 91 ], 'ivory3' => [ 205, 205, 193, 60, 11, 78 ], 'ivory4' => [ 139, 139, 131, 60, 3, 53 ], 'khaki' => [ 240, 230, 140, 54, 77, 75 ], 'khaki1' => [ 255, 246, 143, 55, 100, 78 ], 'khaki2' => [ 238, 230, 133, 55, 76, 73 ], 'khaki3' => [ 205, 198, 115, 55, 47, 63 ], 'khaki4' => [ 139, 134, 78, 55, 28, 43 ], 'lavender' => [ 230, 230, 250, 240, 67, 94 ], 'lavenderblush' => [ 255, 240, 245, 340, 100, 97 ], 'lavenderblush1' => [ 255, 240, 245, 340, 100, 97 ], 'lavenderblush2' => [ 238, 224, 229, 339, 29, 91 ], 'lavenderblush3' => [ 205, 193, 197, 340, 11, 78 ], 'lavenderblush4' => [ 139, 131, 134, 338, 3, 53 ], 'lawngreen' => [ 124, 252, 0, 90, 100, 49 ], 'lemonchiffon' => [ 255, 250, 205, 54, 100, 90 ], 'lemonchiffon1' => [ 255, 250, 205, 54, 100, 90 ], 'lemonchiffon2' => [ 238, 233, 191, 54, 58, 84 ], 'lemonchiffon3' => [ 205, 201, 165, 54, 29, 73 ], 'lemonchiffon4' => [ 139, 137, 112, 56, 11, 49 ], 'light' => [ 238, 221, 130, 51, 76, 72 ], 'lightblue' => [ 173, 216, 230, 195, 53, 79 ], 'lightblue1' => [ 191, 239, 255, 195, 100, 87 ], 'lightblue2' => [ 178, 223, 238, 195, 64, 82 ], 'lightblue3' => [ 154, 192, 205, 195, 34, 70 ], 'lightblue4' => [ 104, 131, 139, 194, 14, 48 ], 'lightcoral' => [ 240, 128, 128, 0, 79, 72 ], 'lightcyan' => [ 224, 255, 255, 180, 100, 94 ], 'lightcyan1' => [ 224, 255, 255, 180, 100, 94 ], 'lightcyan2' => [ 209, 238, 238, 180, 46, 88 ], 'lightcyan3' => [ 180, 205, 205, 180, 20, 75 ], 'lightcyan4' => [ 122, 139, 139, 180, 7, 51 ], 'lightgoldenrod' => [ 238, 221, 130, 51, 76, 72 ], 'lightgoldenrod1' => [ 255, 236, 139, 50, 100, 77 ], 'lightgoldenrod2' => [ 238, 220, 130, 50, 76, 72 ], 'lightgoldenrod3' => [ 205, 190, 112, 50, 48, 62 ], 'lightgoldenrod4' => [ 139, 129, 76, 50, 29, 42 ], 'lightgray' => [ 211, 211, 211, 0, 0, 83 ], 'lightgreen' => [ 144, 238, 144, 120, 73, 75 ], 'lightpink' => [ 255, 182, 193, 351, 100, 86 ], 'lightpink1' => [ 255, 174, 185, 352, 100, 84 ], 'lightpink2' => [ 238, 162, 173, 351, 69, 78 ], 'lightpink3' => [ 205, 140, 149, 352, 39, 68 ], 'lightpink4' => [ 139, 95, 101, 352, 19, 46 ], 'lightpurple' => [ 145, 0, 250, 275, 100, 49 ], # not in X11 'lightsalmon' => [ 255, 160, 122, 17, 100, 74 ], 'lightsalmon1' => [ 255, 160, 122, 17, 100, 74 ], 'lightsalmon2' => [ 238, 149, 114, 17, 78, 69 ], 'lightsalmon3' => [ 205, 129, 98, 17, 52, 59 ], 'lightsalmon4' => [ 139, 87, 66, 17, 36, 40 ], 'lightseagreen' => [ 32, 178, 170, 177, 70, 41 ], 'lightskyblue' => [ 135, 206, 250, 203, 92, 75 ], 'lightskyblue1' => [ 176, 226, 255, 202, 100, 85 ], 'lightskyblue2' => [ 164, 211, 238, 202, 69, 79 ], 'lightskyblue3' => [ 141, 182, 205, 202, 39, 68 ], 'lightskyblue4' => [ 96, 123, 139, 202, 18, 46 ], 'lightslateblue' => [ 132, 112, 255, 248, 100, 72 ], 'lightslategray' => [ 119, 136, 153, 210, 14, 53 ], 'lightsteelblue' => [ 176, 196, 222, 214, 41, 78 ], 'lightsteelblue1' => [ 202, 225, 255, 214, 100, 90 ], 'lightsteelblue2' => [ 188, 210, 238, 214, 60, 84 ], 'lightsteelblue3' => [ 162, 181, 205, 213, 30, 72 ], 'lightsteelblue4' => [ 110, 123, 139, 213, 12, 49 ], 'lightyellow' => [ 255, 255, 224, 60, 100, 94 ], 'lightyellow1' => [ 255, 255, 224, 60, 100, 94 ], 'lightyellow2' => [ 238, 238, 209, 60, 46, 88 ], 'lightyellow3' => [ 205, 205, 180, 60, 20, 75 ], 'lightyellow4' => [ 139, 139, 122, 60, 7, 51 ], 'lime' => [ 0, 255, 0, 120, 100, 50 ], 'limegreen' => [ 50, 205, 50, 120, 61, 50 ], 'linen' => [ 250, 240, 230, 30, 67, 94 ], 'magenta' => [ 255, 0, 255, 300, 100, 50 ], 'magenta1' => [ 255, 0, 255, 300, 100, 50 ], 'magenta2' => [ 238, 0, 238, 300, 100, 47 ], 'magenta3' => [ 205, 0, 205, 300, 100, 40 ], 'magenta4' => [ 139, 0, 139, 300, 100, 27 ], 'maroon' => [ 128, 0, 0, 0, 100, 25 ], 'maroon1' => [ 255, 52, 179, 322, 100, 60 ], 'maroon2' => [ 238, 48, 167, 322, 85, 56 ], 'maroon3' => [ 205, 41, 144, 322, 67, 48 ], 'maroon4' => [ 139, 28, 98, 322, 66, 33 ], 'medium' => [ 102, 205, 170, 160, 51, 60 ], 'mediumaquamarine' => [ 102, 205, 170, 160, 51, 60 ], 'mediumblue' => [ 0, 0, 205, 240, 100, 40 ], 'mediumorchid' => [ 186, 85, 211, 288, 59, 58 ], 'mediumorchid1' => [ 224, 102, 255, 288, 100, 70 ], 'mediumorchid2' => [ 209, 95, 238, 288, 81, 65 ], 'mediumorchid3' => [ 180, 82, 205, 288, 55, 56 ], 'mediumorchid4' => [ 122, 55, 139, 288, 43, 38 ], 'mediumpurple' => [ 147, 112, 219, 260, 60, 65 ], 'mediumpurple1' => [ 171, 130, 255, 260, 100, 75 ], 'mediumpurple2' => [ 159, 121, 238, 259, 77, 70 ], 'mediumpurple3' => [ 137, 104, 205, 260, 50, 61 ], 'mediumpurple4' => [ 93, 71, 139, 259, 32, 41 ], 'mediumseagreen' => [ 60, 179, 113, 147, 50, 47 ], 'mediumslateblue' => [ 123, 104, 238, 249, 80, 67 ], 'mediumspringgreen' => [ 0, 250, 154, 157, 100, 49 ], 'mediumturquoise' => [ 72, 209, 204, 178, 60, 55 ], 'mediumvioletred' => [ 199, 21, 133, 322, 81, 43 ], 'midnightblue' => [ 25, 25, 112, 240, 64, 27 ], 'mintcream' => [ 245, 255, 250, 150, 100, 98 ], 'mistyrose' => [ 255, 228, 225, 6, 100, 94 ], 'mistyrose1' => [ 255, 228, 225, 6, 100, 94 ], 'mistyrose2' => [ 238, 213, 210, 6, 45, 88 ], 'mistyrose3' => [ 205, 183, 181, 5, 19, 76 ], 'mistyrose4' => [ 139, 125, 123, 8, 6, 51 ], 'moccasin' => [ 255, 228, 181, 38, 100, 85 ], 'navajowhite' => [ 255, 222, 173, 36, 100, 84 ], 'navajowhite1' => [ 255, 222, 173, 36, 100, 84 ], 'navajowhite2' => [ 238, 207, 161, 36, 69, 78 ], 'navajowhite3' => [ 205, 179, 139, 36, 40, 67 ], 'navajowhite4' => [ 139, 121, 94, 36, 19, 46 ], 'navy' => [ 0, 0, 128, 240, 100, 25 ], 'navyblue' => [ 0, 0, 128, 240, 100, 25 ], 'oldlace' => [ 253, 245, 230, 39, 85, 95 ], 'olive' => [ 128, 128, 0, 60, 100, 25 ], 'olivedrab' => [ 107, 142, 35, 80, 60, 35 ], 'olivedrab1' => [ 192, 255, 62, 80, 100, 62 ], 'olivedrab2' => [ 179, 238, 58, 80, 84, 58 ], 'olivedrab3' => [ 154, 205, 50, 80, 61, 50 ], 'olivedrab4' => [ 105, 139, 34, 79, 61, 34 ], 'orange' => [ 255, 165, 0, 39, 100, 50 ], 'orange1' => [ 255, 165, 0, 39, 100, 50 ], 'orange2' => [ 238, 154, 0, 39, 100, 47 ], 'orange3' => [ 205, 133, 0, 39, 100, 40 ], 'orange4' => [ 139, 90, 0, 39, 100, 27 ], 'orangered' => [ 255, 69, 0, 16, 100, 50 ], 'orangered1' => [ 255, 69, 0, 16, 100, 50 ], 'orangered2' => [ 238, 64, 0, 16, 100, 47 ], 'orangered3' => [ 205, 55, 0, 16, 100, 40 ], 'orangered4' => [ 139, 37, 0, 16, 100, 27 ], 'orchid' => [ 218, 112, 214, 302, 59, 65 ], 'orchid1' => [ 255, 131, 250, 302, 100, 76 ], 'orchid2' => [ 238, 122, 233, 303, 77, 71 ], 'orchid3' => [ 205, 105, 201, 302, 50, 61 ], 'orchid4' => [ 139, 71, 137, 302, 32, 41 ], 'pale' => [ 219, 112, 147, 340, 60, 65 ], 'palegoldenrod' => [ 238, 232, 170, 55, 67, 80 ], 'palegreen' => [ 152, 251, 152, 120, 93, 79 ], 'palegreen1' => [ 154, 255, 154, 120, 100, 80 ], 'palegreen2' => [ 144, 238, 144, 120, 73, 75 ], 'palegreen3' => [ 124, 205, 124, 120, 45, 65 ], 'palegreen4' => [ 84, 139, 84, 120, 25, 44 ], 'paleturquoise' => [ 175, 238, 238, 180, 65, 81 ], 'paleturquoise1' => [ 187, 255, 255, 180, 100, 87 ], 'paleturquoise2' => [ 174, 238, 238, 180, 65, 81 ], 'paleturquoise3' => [ 150, 205, 205, 180, 35, 70 ], 'paleturquoise4' => [ 102, 139, 139, 180, 15, 47 ], 'palevioletred' => [ 219, 112, 147, 340, 60, 65 ], 'palevioletred1' => [ 255, 130, 171, 340, 100, 75 ], 'palevioletred2' => [ 238, 121, 159, 341, 77, 70 ], 'palevioletred3' => [ 205, 104, 137, 340, 50, 61 ], 'palevioletred4' => [ 139, 71, 93, 341, 32, 41 ], 'papayawhip' => [ 255, 239, 213, 37, 100, 92 ], 'peachpuff' => [ 255, 218, 185, 28, 100, 86 ], 'peachpuff1' => [ 255, 218, 185, 28, 100, 86 ], 'peachpuff2' => [ 238, 203, 173, 28, 66, 81 ], 'peachpuff3' => [ 205, 175, 149, 28, 36, 69 ], 'peachpuff4' => [ 139, 119, 101, 28, 16, 47 ], 'peru' => [ 205, 133, 63, 30, 59, 53 ], 'pink1' => [ 255, 181, 197, 347, 100, 85 ], 'pink2' => [ 238, 169, 184, 347, 67, 80 ], 'pink3' => [ 205, 145, 158, 347, 38, 69 ], 'pink4' => [ 139, 99, 108, 347, 17, 47 ], 'plum1' => [ 255, 187, 255, 300, 100, 87 ], 'plum2' => [ 238, 174, 238, 300, 65, 81 ], 'plum3' => [ 205, 150, 205, 300, 35, 70 ], 'plum4' => [ 139, 102, 139, 300, 15, 47 ], 'powderblue' => [ 176, 224, 230, 187, 52, 80 ], 'purple1' => [ 155, 48, 255, 271, 100, 59 ], 'purple2' => [ 145, 44, 238, 271, 85, 55 ], 'purple3' => [ 125, 38, 205, 271, 69, 48 ], 'purple4' => [ 85, 26, 139, 271, 68, 32 ], 'rebeccapurple' => [ 102, 51, 153, 270, 50, 40 ], 'red1' => [ 255, 0, 0, 0, 100, 50 ], 'red2' => [ 238, 0, 0, 0, 100, 47 ], 'red3' => [ 205, 0, 0, 0, 100, 40 ], 'red4' => [ 139, 0, 0, 0, 100, 27 ], 'rosybrown' => [ 188, 143, 143, 0, 25, 65 ], 'rosybrown1' => [ 255, 193, 193, 0, 100, 88 ], 'rosybrown2' => [ 238, 180, 180, 0, 63, 82 ], 'rosybrown3' => [ 205, 155, 155, 0, 33, 71 ], 'rosybrown4' => [ 139, 105, 105, 0, 14, 48 ], 'royalblue' => [ 65, 105, 225, 225, 73, 57 ], 'royalblue1' => [ 72, 118, 255, 225, 100, 64 ], 'royalblue2' => [ 67, 110, 238, 225, 83, 60 ], 'royalblue3' => [ 58, 95, 205, 225, 60, 52 ], 'royalblue4' => [ 39, 64, 139, 225, 56, 35 ], 'saddlebrown' => [ 139, 69, 19, 25, 76, 31 ], 'salmon' => [ 250, 128, 114, 6, 93, 71 ], 'salmon1' => [ 255, 140, 105, 14, 100, 71 ], 'salmon2' => [ 238, 130, 98, 14, 80, 66 ], 'salmon3' => [ 205, 112, 84, 14, 55, 57 ], 'salmon4' => [ 139, 76, 57, 14, 42, 38 ], 'sandybrown' => [ 244, 164, 96, 28, 87, 67 ], 'seagreen' => [ 46, 139, 87, 146, 50, 36 ], 'seagreen1' => [ 84, 255, 159, 146, 100, 66 ], 'seagreen2' => [ 78, 238, 148, 146, 82, 62 ], 'seagreen3' => [ 67, 205, 128, 147, 58, 53 ], 'seagreen4' => [ 46, 139, 87, 146, 50, 36 ], 'seashell' => [ 255, 245, 238, 25, 100, 97 ], 'seashell1' => [ 255, 245, 238, 25, 100, 97 ], 'seashell2' => [ 238, 229, 222, 26, 32, 90 ], 'seashell3' => [ 205, 197, 191, 26, 12, 78 ], 'seashell4' => [ 139, 134, 130, 27, 4, 53 ], 'sienna' => [ 160, 82, 45, 19, 56, 40 ], 'sienna1' => [ 255, 130, 71, 19, 100, 64 ], 'sienna2' => [ 238, 121, 66, 19, 83, 60 ], 'sienna3' => [ 205, 104, 57, 19, 60, 51 ], 'sienna4' => [ 139, 71, 38, 20, 57, 35 ], 'silver' => [ 192, 192, 192, 0, 0, 75 ], 'skyblue' => [ 135, 206, 235, 197, 71, 73 ], 'skyblue1' => [ 135, 206, 255, 205, 100, 76 ], 'skyblue2' => [ 126, 192, 238, 205, 77, 71 ], 'skyblue3' => [ 108, 166, 205, 204, 49, 61 ], 'skyblue4' => [ 74, 112, 139, 205, 31, 42 ], 'slateblue' => [ 106, 90, 205, 248, 53, 58 ], 'slateblue1' => [ 131, 111, 255, 248, 100, 72 ], 'slateblue2' => [ 122, 103, 238, 248, 80, 67 ], 'slateblue3' => [ 105, 89, 205, 248, 54, 58 ], 'slateblue4' => [ 71, 60, 139, 248, 40, 39 ], 'slategray' => [ 112, 128, 144, 210, 13, 50 ], 'slategray1' => [ 198, 226, 255, 211, 100, 89 ], 'slategray2' => [ 185, 211, 238, 211, 61, 83 ], 'slategray3' => [ 159, 182, 205, 210, 32, 71 ], 'slategray4' => [ 108, 123, 139, 211, 13, 48 ], 'snow' => [ 255, 250, 250, 0, 100, 99 ], 'snow1' => [ 255, 250, 250, 0, 100, 99 ], 'snow2' => [ 238, 233, 233, 0, 13, 92 ], 'snow3' => [ 205, 201, 201, 0, 4, 80 ], 'snow4' => [ 139, 137, 137, 0, 1, 54 ], 'springgreen' => [ 0, 255, 127, 150, 100, 50 ], 'springgreen1' => [ 0, 255, 127, 150, 100, 50 ], 'springgreen2' => [ 0, 238, 118, 150, 100, 47 ], 'springgreen3' => [ 0, 205, 102, 150, 100, 40 ], 'springgreen4' => [ 0, 139, 69, 150, 100, 27 ], 'steelblue' => [ 70, 130, 180, 207, 44, 49 ], 'steelblue1' => [ 99, 184, 255, 207, 100, 69 ], 'steelblue2' => [ 92, 172, 238, 207, 81, 65 ], 'steelblue3' => [ 79, 148, 205, 207, 56, 56 ], 'steelblue4' => [ 54, 100, 139, 208, 44, 38 ], 'tan' => [ 210, 180, 140, 34, 44, 69 ], 'tan1' => [ 255, 165, 79, 29, 100, 65 ], 'tan2' => [ 238, 154, 73, 29, 83, 61 ], 'tan3' => [ 205, 133, 63, 30, 59, 53 ], 'tan4' => [ 139, 90, 43, 29, 53, 36 ], 'teal' => [ 0, 128, 128, 180, 100, 25 ], 'thistle' => [ 216, 191, 216, 300, 24, 80 ], 'thistle1' => [ 255, 225, 255, 300, 100, 94 ], 'thistle2' => [ 238, 210, 238, 300, 45, 88 ], 'thistle3' => [ 205, 181, 205, 300, 19, 76 ], 'thistle4' => [ 139, 123, 139, 300, 6, 51 ], 'tomato' => [ 255, 99, 71, 9, 100, 64 ], 'tomato1' => [ 255, 99, 71, 9, 100, 64 ], 'tomato2' => [ 238, 92, 66, 9, 83, 60 ], 'tomato3' => [ 205, 79, 57, 9, 60, 51 ], 'tomato4' => [ 139, 54, 38, 10, 57, 35 ], 'turquoise' => [ 69, 184, 172, 174, 45, 50 ], 'turquoise1' => [ 0, 245, 255, 182, 100, 50 ], 'turquoise2' => [ 0, 229, 238, 182, 100, 47 ], 'turquoise3' => [ 0, 197, 205, 182, 100, 40 ], 'turquoise4' => [ 0, 134, 139, 182, 100, 27 ], 'violet' => [ 238, 130, 238, 300, 76, 72 ], 'violetred' => [ 208, 32, 144, 322, 73, 47 ], 'violetred1' => [ 255, 62, 150, 333, 100, 62 ], 'violetred2' => [ 238, 58, 140, 333, 84, 58 ], 'violetred3' => [ 205, 50, 120, 333, 61, 50 ], 'violetred4' => [ 139, 34, 82, 333, 61, 34 ], 'wheat' => [ 245, 222, 179, 39, 77, 83 ], 'wheat1' => [ 255, 231, 186, 39, 100, 86 ], 'wheat2' => [ 238, 216, 174, 39, 65, 81 ], 'wheat3' => [ 205, 186, 150, 39, 35, 70 ], 'wheat4' => [ 139, 126, 102, 39, 15, 47 ], 'whitesmoke' => [ 245, 245, 245, 0, 0, 96 ], 'yellow1' => [ 255, 255, 0, 60, 100, 50 ], 'yellow2' => [ 238, 238, 0, 60, 100, 47 ], 'yellow3' => [ 205, 205, 0, 60, 100, 40 ], 'yellow4' => [ 139, 139, 0, 60, 100, 27 ], 'yellowgreen' => [ 154, 205, 50, 80, 61, 50 ], # https://www.w3schools.com/colors/colors_trends.asp 'marsala' => [ 149, 82, 81, 1, 30, 45 ], # best 2015-2000 'radiandorchid' => [ 181, 101, 167, 311, 35, 55 ], 'emerald' => [ 0, 155, 119, 166, 100, 30 ], 'tangerinetango' => [ 221, 65, 36, 9, 73, 50 ], 'honeysucle' => [ 214, 80, 118, 343, 62, 58 ], 'turquoise' => [ 69, 184, 172, 174, 45, 50 ], 'mimosa' => [ 239, 192, 80, 42, 83, 63 ], 'blueizis' => [ 91, 94, 166, 238, 30, 50 ], 'chilipepper' => [ 155, 27, 48, 350, 70, 36 ], 'sanddollar' => [ 223, 207, 190, 31, 34, 81 ], 'blueturquoise' => [ 85, 180, 176, 177, 39, 52 ], 'tigerlily' => [ 225, 93, 68, 10, 72, 57 ], 'aquasky' => [ 127, 205, 205, 180, 44, 65 ], 'truered' => [ 188, 36, 60, 351, 68, 44 ], 'fuchsiarose' => [ 195, 68, 122, 334, 51, 52 ], 'ceruleanblue' => [ 152, 180, 212, 212, 41, 71 ], 'rosequartz' => [ 247, 202, 201, 1, 74, 88 ], # 2016 Spring 'peachecho' => [ 247, 120, 107, 6, 90, 69 ], 'serenity' => [ 145, 168, 208, 218, 40, 69 ], 'snorkelblue' => [ 3, 79, 132, 205, 96, 26 ], 'limpetshell' => [ 152, 221, 222, 181, 51, 73 ], 'lilacgrey' => [ 152, 221, 222, 181, 51, 73 ], 'icedcoffee' => [ 177, 143, 106, 31, 31, 55 ], 'fiesta' => [ 221, 65, 50, 5, 72, 53 ], 'buttercup' => [ 221, 65, 50, 5, 72, 53 ], 'greenflash' => [ 250, 224, 60, 52, 95, 61 ], 'riverside' => [ 76, 106, 146, 214, 32, 44 ], # Fall 'airyblue' => [ 146, 182, 213, 208, 44, 70 ], 'sharkskin' => [ 131, 132, 135, 225, 2, 52 ], 'aurorared' => [ 185, 58, 50, 4, 57, 46 ], 'warmtaupe' => [ 175, 148, 131, 23, 22, 60 ], 'dustycedar' => [ 173, 93, 93, 0, 33, 52 ], 'lushmeadow' => [ 0, 110, 81, 164, 100, 22 ], 'spicymustard' => [ 216, 174, 71, 43, 65, 56 ], 'pottersclay' => [ 158, 70, 36, 17, 63, 38 ], # Potter's Clay 'bodacious' => [ 183, 107, 163, 316, 35, 57 ], 'greenery' => [ 146, 181, 88, 83, 39, 53 ], # 2017 'niagara' => [ 87, 140, 169, 201, 32, 50 ], 'primroseyellow' => [ 246, 209, 85, 46, 90, 65 ], 'lapisblue' => [ 0, 75, 141, 208, 100, 28 ], 'flame' => [ 242, 85, 44, 12, 88, 56 ], 'islandparadise' => [ 149, 222, 227, 184, 58, 74 ], 'paledogwood' => [ 237, 205, 194, 15, 54, 85 ], 'pinkyarrow' => [ 206, 49, 117, 334, 62, 50 ], 'kale' => [ 90, 114, 71, 93, 23, 36 ], 'hazelnut' => [ 207, 176, 149, 28, 38, 70 ], 'grenadine' => [ 220, 76, 70, 2, 68, 57 ], 'balletslipper' => [ 243, 214, 228, 331, 55, 90 ], 'butterum' => [ 196, 143, 101, 27, 45, 58 ], 'navypeony' => [ 34, 58, 94, 216, 47, 25 ], 'neutralgray' => [ 137, 142, 140, 156, 2, 55 ], 'shadedspruce' => [ 0, 89, 96, 184, 100, 19 ], 'goldenlime' => [ 156, 154, 64, 59, 42, 43 ], 'marina' => [ 79, 132, 196, 213, 50, 54 ], 'autumnmaple' => [ 210, 105, 30, 25, 75, 47 ], 'meadowlark' => [ 236, 219, 84, 53, 80, 63 ], # 2018 'cherrytomato' => [ 233, 75, 60, 5, 80, 57 ], 'littleboyblue' => [ 111, 159, 216, 213, 57, 64 ], 'chilioil' => [ 148, 71, 67, 3, 38, 42 ], 'pinklavender' => [ 219, 177, 205, 320, 37, 78 ], 'bloomingdahlia' => [ 236, 151, 135, 10, 73, 73 ], 'arcadia' => [ 0, 165, 145, 173, 100, 32 ], 'ultraviolet' => [ 107, 91, 149, 257, 24, 47 ], 'emperador' => [ 108, 79, 61, 23, 28, 33 ], 'almostmauve' => [ 234, 222, 219, 12, 26, 89 ], 'springcrocus' => [ 188, 112, 164, 319, 36, 59 ], 'sailorblue' => [ 46, 74, 98, 208, 36, 28 ], 'harbormist' => [ 180, 183, 186, 210, 4, 72 ], 'warmsand' => [ 192, 171, 142, 35, 28, 65 ], 'coconutmilk' => [ 240, 237, 229, 44, 27, 92 ], 'redpear' => [ 127, 65, 69, 356, 32, 38 ], 'valiantpoppy' => [ 189, 61, 58, 1, 53, 48 ], 'nebulasblue' => [ 63, 105, 170, 216, 46, 46 ], 'ceylonyellow' => [ 213, 174, 65, 44, 64, 55 ], 'martiniolive' => [ 118, 111, 87, 46, 15, 40 ], 'russetorange' => [ 228, 122, 46, 25, 77, 54 ], 'crocuspetal' => [ 190, 158, 201, 285, 28, 70 ], 'limelight' => [ 241, 234, 127, 56, 80, 72 ], 'quetzalgreen' => [ 0, 110, 109, 179, 100, 22 ], 'sargassosea' => [ 72, 81, 103, 223, 18, 34 ], 'tofu' => [ 234, 230, 218, 45, 28, 89 ], 'almondbuff' => [ 209, 184, 148, 35, 40, 70 ], 'quietgray' => [ 188, 188, 190, 240, 2, 74 ], 'meerkat' => [ 169, 117, 79, 25, 36, 49 ], 'fiesta' => [ 221, 65, 50, 5, 72, 53 ], # 2019 'jesterred' => [ 158, 16, 48, 346, 82, 34 ], 'turmeric' => [ 254, 132, 14, 30, 99, 53 ], 'livingcoral' => [ 255, 111, 97, 5, 100, 69 ], 'pinkpeacock' => [ 198, 33, 104, 334, 71, 45 ], 'pepperstem' => [ 141, 148, 64, 65, 40, 42 ], 'aspengold' => [ 255, 214, 98, 44, 100, 69 ], 'princessblue' => [ 0, 83, 156, 208, 100, 31 ], 'toffee' => [ 117, 81, 57, 24, 34, 34 ], 'mangomojito' => [ 214, 156, 47, 39, 67, 51 ], 'terrariummoss' => [ 97, 98, 71, 62, 16, 33 ], 'sweetlilac' => [ 232, 181, 206, 331, 53, 81 ], 'soybean' => [ 210, 194, 157, 42, 37, 72 ], 'eclipse' => [ 52, 49, 72, 248, 19, 24 ], 'sweetcorn' => [ 240, 234, 214, 46, 46, 89 ], 'browngranite' => [ 97, 85, 80, 18, 10, 35 ], 'chilipepper' => [ 155, 27, 48, 350, 70, 36 ], 'bikingred' => [ 119, 33, 46, 351, 57, 30 ], 'peachpink' => [ 250, 154, 133, 11, 92, 75 ], 'rockyroad' => [ 90, 62, 54, 13, 25, 28 ], 'fruitdove' => [ 206, 91, 120, 345, 54, 58 ], 'sugaralmond' => [ 147, 85, 41, 25, 56, 37 ], 'darkcheddar' => [ 224, 129, 25, 31, 80, 49 ], 'galaxyblue' => [ 42, 75, 124, 216, 49, 33 ], 'bluestone' => [ 87, 114, 132, 204, 21, 43 ], 'orangetiger' => [ 249, 103, 20, 22, 95, 53 ], 'eden' => [ 38, 78, 54, 144, 34, 23 ], 'vanillacustard' => [ 243, 224, 190, 38, 69, 85 ], 'eveningblue' => [ 42, 41, 62, 243, 20, 20 ], 'paloma' => [ 159, 156, 153, 30, 3, 61 ], 'guacamole' => [ 121, 123, 58, 62, 36, 35 ], 'flamescarlet' => [ 205, 33, 42, 357, 72, 47 ], # 2020 'saffron' => [ 255, 165, 0, 39, 100, 50 ], 'biscaygreen' => [ 86, 198, 169, 164, 50, 56 ], 'chive' => [ 75, 83, 53, 76, 22, 27 ], 'fadeddenim' => [ 121, 142, 164, 211, 19, 56 ], 'orangepeel' => [ 250, 122, 53, 21, 95, 59 ], 'mosaicblue' => [ 0, 117, 143, 191, 100, 28 ], 'sunlight' => [ 237, 213, 158, 42, 69, 77 ], 'coralpink' => [ 232, 167, 152, 11, 63, 75 ], 'grapecompote' => [ 107, 88, 118, 278, 15, 40 ], 'lark' => [ 184, 155, 114, 35, 33, 58 ], 'navyblazer' => [ 40, 45, 60, 225, 20, 20 ], 'brilliantwhite' => [ 237, 241, 255, 227, 100, 96 ], 'ash' => [ 160, 153, 152, 8, 4, 61 ], 'amberglow' => [ 220, 121, 62, 22, 69, 55 ], 'samba' => [ 162, 36, 47, 355, 64, 39 ], 'sandstone' => [ 196, 138, 105, 22, 44, 59 ], 'classicblue' => [ 52, 86, 139, 217, 46, 37 ], 'greensheen' => [ 217, 206, 82, 55, 64, 59 ], 'rosetan' => [ 209, 156, 151, 5, 39, 71 ], 'ultramarinegreen' => [ 0, 107, 84, 167, 100, 21 ], 'firedbrick' => [ 106, 46, 42, 4, 43, 29 ], 'peachnougat' => [ 230, 175, 145, 21, 63, 74 ], 'magentapurple' => [ 108, 36, 76, 327, 50, 28 ], 'marigold' => [ 253, 172, 83, 31, 98, 66 ], # 2021 'cerulean' => [ 155, 183, 212, 211, 40, 72 ], 'rust' => [ 181, 90, 48, 19, 58, 45 ], 'illuminating' => [ 245, 223, 77, 52, 89, 63 ], 'frenchblue' => [ 0, 114, 181, 202, 100, 35 ], 'greenash' => [ 160, 218, 169, 129, 44, 74 ], 'burntcoral' => [ 233, 137, 126, 6, 71, 70 ], 'mint' => [ 0, 161, 112, 162, 100, 32 ], 'amethystorchid' => [ 146, 106, 166, 280, 25, 53 ], 'raspberrysorbet' => [ 210, 56, 108, 340, 63, 52 ], 'inkwell' => [ 54, 57, 69, 228, 12, 24 ], 'ultimategray' => [ 147, 149, 151, 210, 2, 58 ], 'buttercream' => [ 239, 225, 206, 35, 51, 87 ], 'desertmist' => [ 224, 181, 137, 30, 58, 71 ], 'willow' => [ 154, 139, 79, 48, 32, 46 ], }; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Name::Constant - store of color constants =head1 SYNOPSIS use Graphics::Toolkit::Color::Name::Constant; my %h = Graphics::Toolkit::Color::Name::Constant::rgbhsl_from_name(); =head1 DESCRIPTION RGB and HSL values of named colors from the X11, HTML(CSS), SVG standard and Pantone report. =head1 NAMES white, black, red, green, blue, yellow, purple, pink, peach, plum, mauve, brown, grey aliceblue, antiquewhite, antiquewhite1, antiquewhite2, antiquewhite3, antiquewhite4, aqua, aquamarine, aquamarine1, aquamarine2, aquamarine3, aquamarine4, azure, azure1, azure2, azure3, azure4, beige, bisque, bisque1, bisque2, bisque3, bisque4, blanchedalmond, blue1, blue2, blue3, blue4, blueviolet, brown1, brown2, brown3, brown4, burlywood, burlywood1, burlywood2, burlywood3, burlywood4, cadetblue, cadetblue1, cadetblue2, cadetblue3, cadetblue4, chartreuse, chartreuse1, chartreuse2, chartreuse3, chartreuse4, chocolate, chocolate1, chocolate2, chocolate3, chocolate4, coral, coral1, coral2, coral3, coral4, cornflowerblue, cornsilk, cornsilk1, cornsilk2, cornsilk3, cornsilk4, crimson, cyan, cyan1, cyan2, cyan3, cyan4, darkblue, darkcyan, darkgoldenrod, darkgoldenrod1, darkgoldenrod2, darkgoldenrod3, darkgoldenrod4, darkgray, darkgreen, darkkhaki, darkmagenta, darkolivegreen, darkolivegreen1, darkolivegreen2, darkolivegreen3, darkolivegreen4, darkorange, darkorange1, darkorange2, darkorange3, darkorange4, darkorchid, darkorchid1, darkorchid2, darkorchid3, darkorchid4, darkred, darksalmon, darkseagreen, darkseagreen1, darkseagreen2, darkseagreen3, darkseagreen4, darkslateblue, darkslategray, darkslategray1, darkslategray2, darkslategray3, darkslategray4, darkturquoise, darkviolet, deeppink, deeppink1, deeppink2, deeppink3, deeppink4, deepskyblue, deepskyblue1, deepskyblue2, deepskyblue3, deepskyblue4, dimgray, dodgerblue, dodgerblue1, dodgerblue2, dodgerblue3, dodgerblue4, firebrick, firebrick1, firebrick2, firebrick3, firebrick4, floralwhite, forestgreen, fuchsia, gainsboro, ghostwhite, gold, gold1, gold2, gold3, gold4, goldenrod, goldenrod1, goldenrod2, goldenrod3, goldenrod4, gray, gray1, gray2, gray3, gray4, gray5, gray6, gray7, gray8, gray9, gray10, gray11, gray12, gray13, gray14, gray15, gray16, gray17, gray18, gray19, gray20, gray21, gray22, gray23, gray24, gray25, gray26, gray27, gray28, gray29, gray30, gray31, gray32, gray33, gray34, gray35, gray36, gray37, gray38, gray39, gray40, gray41, gray42, gray43, gray44, gray45, gray46, gray47, gray48, gray49, gray50, gray51, gray52, gray53, gray54, gray55, gray56, gray57, gray58, gray59, gray60, gray61, gray62, gray63, gray64, gray65, gray66, gray67, gay68, gray69, gray70, gray71, gray72, gray73, gray74, gray75, gray76, gray77, gray78, gray79, gray80, gray81, gray82, gray83, gray84, gray85, gray86, gray87, gray88, gray89, gray90, gray91, gray92, gray93, gray94, gray95, gray97, gray98, gray99, green1, green2, green3, green4, greenyellow, grey1, grey2, grey3, grey4, honeydew, honeydew1, honeydew2, honeydew3, honeydew4, hotpink, hotpink1, hotpink2, hotpink3, hotpink4, indianred, indianred1, indianred2, indianred3, indianred4, indigo, ivory, ivory1, ivory2, ivory3, ivory4, khaki, khaki1, khaki2, khaki3, khaki4, lavender, lavenderblush, lavenderblush1, lavenderblush2, lavenderblush3, lavenderblush4, lawngreen, lemonchiffon, lemonchiffon1, lemonchiffon2, lemonchiffon3, lemonchiffon4, light, lightblue, lightblue1, lightblue2, lightblue3,lightblue4, lightcoral, lightcyan, lightcyan1, lightcyan2, lightcyan3, lightcyan4, lightgoldenrod, lightgoldenrod1, lightgoldenrod2, lightgoldenrod3, lightgoldenrod4, lightgray, lightgreen, lightpink, lightpink1, lightpink2, lightpink3, lightpink4, lightpurple, lightsalmon, lightsalmon1, lightsalmon2, lightsalmon3, lightsalmon4, lightseagreen, lightskyblue, lightskyblue1, lightskyblue2, lightskyblue3, lightskyblue4, lightslateblue, lightslategray, lightsteelblue, lightsteelblue1, lightsteelblue2, lightsteelblue3, lightsteelblue4, lightyellow, lightyellow1, lightyellow2, lightyellow3, lightyellow4, lime, limegreen, linen, magenta, magenta1, magenta2, magenta3, magenta4, maroon, maroon1, maroon2, maroon3, maroon4, medium, mediumaquamarine, mediumblue, mediumorchid, mediumorchid1, mediumorchid2, mediumorchid3, mediumorchid4, mediumpurple, mediumpurple1, mediumpurple2, mediumpurple3, mediumpurple4, mediumseagreen, mediumslateblue, mediumspringgreen, mediumturquoise, mediumvioletred, midnightblue, mintcream, mistyrose, mistyrose1, mistyrose2, mistyrose3, mistyrose4, moccasin, navajowhite, navajowhite1, navajowhite2, navajowhite3, navajowhite4, navy, navyblue, oldlace, olive, olivedrab, olivedrab1, olivedrab2, olivedrab3, olivedrab4, orange, orange1, orange2, orange3, orange4, orangered, orangered1, orangered2, orangered3, orangered4, orchid, orchid1, orchid2, orchid3, orchid4, pale, palegoldenrod, palegreen, palegreen1, palegreen2, palegreen3, palegreen4, paleturquoise, paleturquoise1, paleturquoise2, paleturquoise3, paleturquoise4, palevioletred, palevioletred1, palevioletred2, palevioletred3, palevioletred4, papayawhip, peachpuff, peachpuff1, peachpuff2, peachpuff3, peachpuff4, peru, pink1, pink2, pink3, pink4, plum1, plum2, plum3, plum4, powderblue, purple1, purple2, purple3, purple4, rebeccapurple, red1, red2, red3, red4, rosybrown, rosybrown1, rosybrown2, rosybrown3, rosybrown4, royalblue, royalblue1, royalblue2, royalblue3, royalblue4, saddlebrown, salmon, salmon1, salmon2, salmon3, salmon4, sandybrown, seagreen, seagreen1, seagreen2, seagreen3, seagreen4, seashell, seashell1, seashell2, seashell3, seashell4, sienna, sienna1, sienna2, sienna3, sienna4, silver, skyblue, skyblue1, skyblue2, skyblue3, skyblue4, slateblue, slateblue1, slateblue2, slateblue3, slateblue4, slategray, slategray1, slategray2, slategray3, slategray4, snow, snow1, snow2, snow3, snow4, springgreen, springgreen1, springgreen2, springgreen3, springgreen4, steelblue, steelblue1, steelblue2, steelblue3, steelblue4, tan, tan1, tan2, tan3, tan4, teal, thistle, thistle1, thistle2, thistle3, thistle4, tomato, tomato1, tomato2, tomato3, tomato4, turquoise, turquoise1, turquoise2, turquoise3, turquoise4, violet, violetred, violetred1, violetred2, violetred3, violetred4, wheat, wheat1, wheat2, wheat3, wheat4, whitesmoke, yellow1, yellow2, yellow3, yellow4, yellowgreen marsala, radiandorchid, emerald, tangerinetango, honeysucle, turquoise, mimosa, blueizis, chilipepper, sanddollar, blueturquoise, tigerlily, aquasky, truered, fuchsiarose, ceruleanblue, rosequartz, peachecho, serenity, snorkelblue, limpetshell, lilacgrey, icedcoffee, fiesta, buttercup, greenflash, riverside, airyblue, sharkskin, aurorared, warmtaupe, dustycedar, lushmeadow, spicymustard, pottersclay, bodacious, greenery, niagara, primroseyellow, lapisblue, flame, islandparadise, paledogwood, pinkyarrow, kale, hazelnut, grenadine, balletslipper, butterum, navypeony, neutralgray, shadedspruce, goldenlime, marina, autumnmaple, meadowlark, cherrytomato, littleboyblue, chilioil, pinklavender, bloomingdahlia, arcadia, ultraviolet, emperador, almostmauve, springcrocus, sailorblue, harbormist, warmsand, coconutmilk, redpear, valiantpoppy, nebulasblue, ceylonyellow, martiniolive, russetorange, crocuspetal, limelight, quetzalgreen, sargassosea, tofu, almondbuff, quietgray, meerkat, fiesta, jesterred, turmeric, livingcoral, pinkpeacock, pepperstem, aspengold, princessblue, toffee, mangomojito, terrariummoss, sweetlilac, soybean, eclipse, sweetcorn, browngranite, chilipepper, bikingred, peachpink, rockyroad, fruitdove, sugaralmond, darkcheddar, galaxyblue, bluestone, orangetiger, eden, vanillacustard, eveningblue, paloma, guacamole, flamescarlet, saffron, biscaygreen, chive, fadeddenim, orangepeel, mosaicblue, sunlight, coralpink, grapecompote, lark, navyblazer, brilliantwhite, ash, amberglow, samba, sandstone, classicblue, greensheen, rosetan, ultramarinegreen, firedbrick, peachnougat, magentapurple, marigold, cerulean, rust, illuminating, frenchblue, greenash, burntcoral, mint, amethystorchid, raspberrysorbet, inkwell, ultimategray, buttercream, desertmist, willow =for HTML

color table 1 color table 2 color table 3 color table 4

=head1 COPYRIGHT & LICENSE Copyright 2022-23 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under same terms as Perl itself. =head1 AUTHOR Herbert Breunung, Instance000755001750001750 014503102425 25677 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/SpaceCMY.pm100644001750001750 57514503102425 27014 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # CMY color space specific code package Graphics::Toolkit::Color::Space::Instance::CMY; use Graphics::Toolkit::Color::Space; my $cmy_def = Graphics::Toolkit::Color::Space->new( axis => [qw/cyan magenta yellow/] ); $cmy_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { map { 1 - $_} @_ } sub to_rgb { map { 1 - $_} @_ } $cmy_def; HSB.pm100644001750001750 261114503102425 27011 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # HSB color space specific code package Graphics::Toolkit::Color::Space::Instance::HSB; use Graphics::Toolkit::Color::Space::Util ':all'; use Graphics::Toolkit::Color::Space; my $hsb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation brightness/], range => [360, 100, 100], type => [qw/angle linear linear/]); $hsb_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $vmin = min($r, $g, $b); my $br = my $vmax = max($r, $g, $b); return (0, 0, $br) if $vmax == $vmin; my $d = $vmax - $vmin; my $s = $d / $vmax; my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) : ($vmax == $g) ? (($b - $r) / $d + 2) : (($r - $g) / $d + 4); return ($h/6, $s, $br); } sub to_rgb { my ($h, $s, $b) = @_; return ($b, $b, $b) if $s == 0; my $hi = int( $h * 6 ); my $f = ( $h * 6 ) - $hi; my $p = $b * (1 - $s ); my $q = $b * (1 - ($s * $f)); my $t = $b * (1 - ($s * (1 - $f))); my @rgb = ($hi == 1) ? ($q, $b, $p) : ($hi == 2) ? ($p, $b, $t) : ($hi == 3) ? ($p, $q, $b) : ($hi == 4) ? ($t, $p, $b) : ($hi == 5) ? ($b, $p, $q) : ($b, $t, $p); } $hsb_def; HSL.pm100644001750001750 271314503102425 27026 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # HSL color space specific code package Graphics::Toolkit::Color::Space::Instance::HSL; use Graphics::Toolkit::Color::Space::Util ':all'; use Graphics::Toolkit::Color::Space; my $hsl_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation lightness/], range => [ 360, 100, 100 ], type => [qw/angle linear linear/]); $hsl_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $vmax = max($r, $g, $b), my $vmin = min($r, $g, $b); my $l = ($vmax + $vmin) / 2; return (0, 0, $l) if $vmax == $vmin; my $d = $vmax - $vmin; my $s = ($l > 0.5) ? ($d / (2 - $vmax - $vmin)) : ($d / ($vmax + $vmin)); my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) : ($vmax == $g) ? (($b - $r) / $d + 2) : (($r - $g) / $d + 4); return ($h/6, $s, $l); } sub to_rgb { my ($h, $s, $l) = @_; $h *= 6; my $C = $s * (1 - abs($l * 2 - 1)); my $X = $C * (1 - abs( rmod($h, 2) - 1) ); my $m = $l - ($C / 2); return ($h < 1) ? ($C + $m, $X + $m, $m) : ($h < 2) ? ($X + $m, $C + $m, $m) : ($h < 3) ? ( $m, $C + $m, $X + $m) : ($h < 4) ? ( $m, $X + $m, $C + $m) : ($h < 5) ? ($X + $m, $m, $C + $m) : ($C + $m, $m, $X + $m); } $hsl_def; HSV.pm100644001750001750 260114503102425 27034 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # HSV color space specific code package Graphics::Toolkit::Color::Space::Instance::HSV; use Graphics::Toolkit::Color::Space::Util ':all'; use Graphics::Toolkit::Color::Space; my $hsv_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation value/], range => [360, 100, 100], type => [qw/angle linear linear/]); $hsv_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $vmin = min($r, $g, $b); my $v = my $vmax = max($r, $g, $b); return (0, 0, $v) if $vmax == $vmin; my $d = $vmax - $vmin; my $s = $d / $vmax; my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) : ($vmax == $g) ? (($b - $r) / $d + 2) : (($r - $g) / $d + 4); return ($h/6, $s, $v); } sub to_rgb { my ($h, $s, $v) = @_; return ($v, $v, $v) if $s == 0; my $hi = int( $h * 6 ); my $f = ( $h * 6 ) - $hi; my $p = $v * (1 - $s ); my $q = $v * (1 - ($s * $f)); my $t = $v * (1 - ($s * (1 - $f))); my @rgb = ($hi == 1) ? ($q, $v, $p) : ($hi == 2) ? ($p, $v, $t) : ($hi == 3) ? ($p, $q, $v) : ($hi == 4) ? ($t, $p, $v) : ($hi == 5) ? ($v, $p, $q) : ($v, $t, $p); } $hsv_def; HWB.pm100644001750001750 305514503102425 27020 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # HWB color space specific code package Graphics::Toolkit::Color::Space::Instance::HWB; use Graphics::Toolkit::Color::Space::Util ':all'; use Graphics::Toolkit::Color::Space; my $hwb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue whiteness blackness/], range => [360, 100, 100], type => [qw/angle linear linear/]); $hwb_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $vmax = max($r, $g, $b); my $white = my $vmin = min($r, $g, $b); my $black = 1 - ($vmax); my $d = $vmax - $vmin; my $s = $d / $vmax; my $h = ($d == 0) ? 0 : ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) : ($vmax == $g) ? (($b - $r) / $d + 2) : (($r - $g) / $d + 4); return ($h/6, $white, $black); } sub to_rgb { my ($h, $w, $b) = @_; return (0, 0, 0) if $b == 1; return (1, 1, 1) if $w == 1; my $v = 1 - $b; my $s = 1 - ($w / $v); $s = 0 if $s < 0; return ($v, $v, $v) if $s == 0; my $hi = int( $h * 6 ); my $f = ( $h * 6 ) - $hi; my $p = $v * (1 - $s ); my $q = $v * (1 - ($s * $f)); my $t = $v * (1 - ($s * (1 - $f))); my @rgb = ($hi == 1) ? ($q, $v, $p) : ($hi == 2) ? ($p, $v, $t) : ($hi == 3) ? ($p, $q, $v) : ($hi == 4) ? ($t, $p, $v) : ($hi == 5) ? ($v, $p, $q) : ($v, $t, $p); } $hwb_def; LAB.pm100644001750001750 236314503102425 26777 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # LAB color space specific code package Graphics::Toolkit::Color::Space::Instance::LAB; use Graphics::Toolkit::Color::Space; my ($i_max, $q_max) = (0.5959, 0.5227); my ($i_size, $q_size) = (2 * $i_max, 2 * $q_max); # cyan-orange balance, magenta-green balance my $yiq_def = Graphics::Toolkit::Color::Space->new( axis => [qw/L* a* b*/], prefix => 'CIE', range => [1, [-$i_max, $i_max], [-$q_max, $q_max]] ); $yiq_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $y = (0.299 * $r) + ( 0.587 * $g) + ( 0.114 * $b); my $i = ($i_max + (0.5959 * $r) + (-0.2746 * $g) + (-0.3213 * $b)) / $i_size; my $q = ($q_max + (0.2115 * $r) + (-0.5227 * $g) + ( 0.3112 * $b)) / $q_size; return ($y, $i, $q); } sub to_rgb { my ($y, $i, $q) = @_; $i = ($i * $i_size) - $i_max; $q = ($q * $q_size) - $q_max; my $r = $y + ( 0.956 * $i) + ( 0.619 * $q); my $g = $y + (-0.272 * $i) + (-0.647 * $q); my $b = $y + (-1.106 * $i) + ( 1.703 * $q); return ($r, $g, $b); } $yiq_def; RGB.pm100644001750001750 232514503102425 27011 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # RGB color space specific code package Graphics::Toolkit::Color::Space::Instance::RGB; use Graphics::Toolkit::Color::Space; use Graphics::Toolkit::Color::Space::Util ':all'; use Carp; my $rgb_def = Graphics::Toolkit::Color::Space->new( axis => [qw/red green blue/], range => 255 ); $rgb_def->add_formatter( 'hex', \&hex_from_rgb ); $rgb_def->add_deformatter( 'hex', sub { rgb_from_hex(@_) if is_hex(@_) } ); $rgb_def->add_deformatter( 'array', sub { @{$_[0]} if $rgb_def->is_array($_[0]) and $_[0][0] =~ /\d/} ); sub hex_from_rgb { return unless @_ == $rgb_def->dimensions; sprintf "#%02x%02x%02x", @_ } sub rgb_from_hex { # translate #000000 and #000 --> r, g, b my $hex = shift; return carp "hex color definition '$hex' has to start with # followed by 3 or 6 hex characters (0-9,a-f)" unless defined $hex and (length($hex) == 4 or length($hex) == 7) and $hex =~ /^#[\da-f]+$/i; $hex = substr $hex, 1; (length $hex == 3) ? (map { CORE::hex($_.$_) } unpack( "a1 a1 a1", $hex)) : (map { CORE::hex($_ ) } unpack( "a2 a2 a2", $hex)); } sub is_hex { defined $_[0] and ($_[0] =~ /^#[[:xdigit:]]{3}$/ or $_[0] =~ /^#[[:xdigit:]]{6}$/)} $rgb_def; XYZ.pm100644001750001750 226014503102425 27067 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # XYZ color space specific code package Graphics::Toolkit::Color::Space::Instance::XYZ; use Graphics::Toolkit::Color::Space; my ($i_max, $q_max) = (0.5959, 0.5227); my ($i_size, $q_size) = (2 * $i_max, 2 * $q_max); # cyan-orange balance, magenta-green balance my $yiq_def = Graphics::Toolkit::Color::Space->new( axis => [qw/X Y Z/], range => [0.95047, 1, 1.08883] ); $yiq_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $y = (0.299 * $r) + ( 0.587 * $g) + ( 0.114 * $b); my $i = ($i_max + (0.5959 * $r) + (-0.2746 * $g) + (-0.3213 * $b)) / $i_size; my $q = ($q_max + (0.2115 * $r) + (-0.5227 * $g) + ( 0.3112 * $b)) / $q_size; return ($y, $i, $q); } sub to_rgb { my ($y, $i, $q) = @_; $i = ($i * $i_size) - $i_max; $q = ($q * $q_size) - $q_max; my $r = $y + ( 0.956 * $i) + ( 0.619 * $q); my $g = $y + (-0.272 * $i) + (-0.647 * $q); my $b = $y + (-1.106 * $i) + ( 1.703 * $q); return ($r, $g, $b); } $yiq_def; # 0,95047 # 1 # 1,08883 YIQ.pm100644001750001750 241614503102425 27042 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # YIQ color space specific code package Graphics::Toolkit::Color::Space::Instance::YIQ; use Graphics::Toolkit::Color::Space; my ($i_max, $q_max) = (0.5959, 0.5227); my ($i_size, $q_size) = (2 * $i_max, 2 * $q_max); # cyan-orange balance, magenta-green balance my $yiq_def = Graphics::Toolkit::Color::Space->new( axis => [qw/luminance in-phase quadrature/], short => [qw/Y I Q/], range => [1, [-$i_max, $i_max], [-$q_max, $q_max]] ); $yiq_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; my $y = (0.299 * $r) + ( 0.587 * $g) + ( 0.114 * $b); my $i = ($i_max + (0.5959 * $r) + (-0.2746 * $g) + (-0.3213 * $b)) / $i_size; my $q = ($q_max + (0.2115 * $r) + (-0.5227 * $g) + ( 0.3112 * $b)) / $q_size; return ($y, $i, $q); } sub to_rgb { my ($y, $i, $q) = @_; $i = ($i * $i_size) - $i_max; $q = ($q * $q_size) - $q_max; my $r = $y + ( 0.956 * $i) + ( 0.619 * $q); my $g = $y + (-0.272 * $i) + (-0.647 * $q); my $b = $y + (-1.106 * $i) + ( 1.703 * $q); return ($r, $g, $b); } $yiq_def; CMYK.pm100644001750001750 142714503102425 27144 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.71/lib/Graphics/Toolkit/Color/Space/Instanceuse v5.12; use warnings; # CMYK color space specific code package Graphics::Toolkit::Color::Space::Instance::CMYK; use Graphics::Toolkit::Color::Space; use Graphics::Toolkit::Color::Space::Util ':all'; my $cmyk_def = Graphics::Toolkit::Color::Space->new( axis => [qw/cyan magenta yellow key/] ); $cmyk_def->add_converter('RGB', \&to_rgb, \&from_rgb ); sub from_rgb { my ($r, $g, $b) = @_; return unless defined $b; my $km = max($r, $g, $b); return (0,0,0,1) unless $km; # prevent / 0 return ( ($km - $r) / $km, ($km - $g) / $km, ($km - $b) / $km, 1 - $km ); } sub to_rgb { my ($c, $m, $y, $k) = @_; return ( (1-$c) * (1-$k) , (1-$m) * (1-$k) , (1-$y) * (1-$k) , ); } $cmyk_def;