Graphics-Toolkit-Color-1.972000755001750001750 015055140237 16246 5ustar00herbertherbert000000000000README100644001750001750 6527215055140237 17243 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972NAME Graphics::Toolkit::Color - calculate color (sets), IO many spaces and formats SYNOPSIS use Graphics::Toolkit::Color qw/color/; my $red = Graphics::Toolkit::Color->new('red'); # create color object say $red->add_value( 'blue' => 255 )->name; # red + blue = 'magenta' my @blue = color( 0, 0, 255)->values('HSL'); # 240, 100, 50 = blue $red->mix( to => [HSL => 0,0,80], amount => 10); # mix red with a little grey $red->gradient( to => '#0000FF', steps => 10); # 10 colors from red to blue my @base_triadic = $red->complement( 3 ); # get fitting red green and blue my @reds = $red->cluster( radius => 4, distance => 1 ); DEPRECATION WARNING Methods of the old API ( *string*, *rgb*, *red*, *green*, *blue*, *rgb_hex*, *rgb_hash*, *hsl*, *hue*, *saturation*, *lightness*, *hsl_hash*, *add*, *set*, *blend*, *blend_with*, *gradient_to*, *rgb_gradient_to*, *hsl_gradient_to*, *complementary*) will be removed with release of version 2.0. DESCRIPTION Graphics::Toolkit::Color, for short GTC, is the top level API of this release and the only package a regular user should be concerned with. Its main purpose is the creation of related colors or sets of them, such as gradients, complements and others. But you can use it also to convert and/or reformat color definitions. GTC are read only, one color representing objects with no additional dependencies. Create them in many different ways (see "CONSTRUCTOR"). Access its values via methods from section "GETTER". Measure differences with the "distance" method. "SINGLE-COLOR" methods create one new object that is related to the current one and "COLOR-SETS" methods will create a group of colors, that are not only related to the current color but also have relations between each other. Error messages will appear as return values instead of the expected result. While this module can understand and output color values to many color spaces, 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 of those plus some color math and many formats should enable you to get the color palette you desire quickly. CONSTRUCTOR There are many options to create a color object. In short you can either use the name of a constant (see "name") or provide values, which are coordinates in one of several color spaces. The latter are also understood in many formats. From now on any input that the constructor method "new" accepts, is called a color definition. new({ r => $r, g => $g, b => $b }) Most clear, flexible and longest input format: a hash with long or short axis names as keys with fitting values. This can be "red", "green" and "blue" or "r", "g" and "b" or names from any other color space. Upper or lower case doesn't matter. 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( [$r, $g, $b] ) takes a triplet of integer *RGB* values (red, green and blue : 0 .. 255). They can, but don't have to be put into an ARRAY reference (square brackets). If you want to define a color by values from another color space, you have to prepend the values with the name of a supported color space. Out of range values will be corrected (clamped). 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 ARRAY syntax my $red = Graphics::Toolkit::Color->new( RGB => 255, 0, 0 ); # with fat comma my $red = Graphics::Toolkit::Color->new([ RGB => 255, 0, 0]); # and brackets my $red = Graphics::Toolkit::Color->new( RGB =>[255, 0, 0]); # separate name and values my $red = Graphics::Toolkit::Color->new( YUV =>.299,-0.168736, .5); # same color in YUV new('rgb($r,$g,$b)') String format that is supported by CSS (*css_string* format): it starts with the case insensitive color space name (lower case is default), followed by the (optionally with) comma separated values in round braces. The value suffixes that are defined by the color space (*'%'* in case of *HSV*) are optional. 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') String format *named_string* (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') Color definitions in hexadecimal format as widely used in the web, are also acceptable (*RGB* only). my $color = Graphics::Toolkit::Color->new('#FF0000'); my $color = Graphics::Toolkit::Color->new('#f00'); # short works too new('name') Get a color object by providing a name from the X11, HTML (CSS) or SVG scheme 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 here . 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 or with Bundle::Graphics::ColorNames. See all scheme names here . The color name will be normalized as above. my $color = Graphics::Toolkit::Color->new('SVG:green'); my @schemes = Graphics::ColorNames::all_schemes(); # look up the installed color If writing Graphics::Toolkit::Color->new( ...); is too much typing work for you or takes up to much space in the code file, import the subroutine "color", which accepts all the same arguments as "new". 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. values Returns the numeric values of the color, held by the object. The method accepts five optional, named arguments: "in" (color space), "as" (format), "range", "precision" and "suffix". In most cases, only the first one is needed. When given no arguments, the method returns a list with the integer values: "red", "green" and "blue" in 0 .. 255 range, since *RGB* is the default color space of this module. If one positional argument is provided, the values get converted into the color space of the given name. The same is done when using the named argument "in" (full explanation behind the link). The named argument "range" is also explained in its own section. Please note you have to use the "range" argument only, if you like to deviate from the value ranges defined by the chosen color space. The maybe most characteristic argument for this method is "as", which enables all the same formats the constructor method "new" accepts. *GTC* is built with the design principle of total serialisation. This means: every contructor input format can be reproduced by a getter method and vice versa. These formats are: "list" (default), "named_array", "hash", "char_hash", "named_string", "css_string", "array" (RGB only) and "hex_string" (RGB only). The remaining two. "name" and "full:name" are produce by the method "name". Format names are case insensitive. For more explanations, please see: formats section in GTC::Space::Hub. "precision" is more exotic argument, but sometimes you need to escape the numeric precision, set by a color spaces definition. For instance "LAB" values will have maximally three decimals, no matter how precise the input was. In case you prefer 4 decimals, just use "precision => 4". A zero means no decimals and -1 stands for maximal precision - which can spit out more decimals than you prefer. Different precisions per axis are possible via an ARRAY ref: "precision => [1,2,3]". In same way you can atach a little strings per value by ussing the "suffix" argument. Normally these are percentage signs but in some spaces, where they appear by default you can surpress them by adding "suffix => ''" $blue->values(); # 0, 0, 255 $blue->values( in => 'RGB', as => 'list'); # 0, 0, 255 # explicit arguments $blue->values( as => 'array'); # [0, 0, 255] - RGB only $blue->values( in => 'RGB', as => 'named_array'); # ['RGB', 0, 0, 255] $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 => 'named_string'); # 'rgb: 0, 0, 255' $blue->values( in => 'RGB', as => 'css_string'); # 'rgb( 0, 0, 255)' $blue->values( as => 'hex_string'); # '#0000ff' - RGB only $blue->values( range => 2**16 ); # 0, 0, 65536 $blue->values('HSL'); # 240, 100, 50 $blue->values( in => 'HSL',suffix => ['', '%','%']);# 240, '100%', '50%' $blue->values( in => 'HSB', as => 'hash')->{'hue'};# 240 ($blue->values( 'HSB'))[0]; # 240 $blue->values( in => 'XYZ', range => 1, precision => 2);# normalized, 2 decimals max. name Returns the normalized name string (lower case, without *'_'*) that represents the *RGB* values of this color in the default color scheme, which is *X11* + *HTML* (*SVG*) + *Pantone report* (see all names). These are the same which can be used with "new('name')". Alternatively you may provide named arguments or one positional argument, which is the same as the named argument "from". That required a name of a color schemes, as listed here. You also can submit a list thereof inside a ARRRAY ref which also dictates the order of resulting color names. Please note that all color schemes, except the default one, depend on external modules, which have to be installed separately or via Bundle::Graphics::ColorNames. If you try to use a scheme from a not installed module your will get an error message instead of a color name. You can also create your custom color naming scheme via Graphics::Toolkit::Color::Name::Scheme. The second named argument is "all", which needs to be a perly boolean. It defaults to false. But if set to 1, you will get a list of all names that are associated with the current values. There will be no duplicates, when several schemes are searched. A third named argument is "full" - also needing a perly boolean that defaults to false. When set "true" (1), the schema name becomes part of the returned color name as in 'SVG:red'. These full names are also accepted by the constructor. The fourth named argument is "distance", which means the same thing as in "distance" and it defaults to zero. It is most useful in combinataion with "all" to get all color names that are within a certain distance. $blue->name(); # 'blue' $blue->name('SVG'); # 'blue' $blue->name( from => [qw/CSS X/], all => 1); # 'blue', 'blue1' $blue->name( from => 'CSS', full => 1); # 'CSS:blue' $blue->name( distance => 3, all => 1) ; # all names within the distance closest_name Returns in scalar context a color name, which has the shortest "distance" in *RGB*nto the current color. In list context, you get additionally the just mentioned distance as a second return value. This method works almost identically as method "name", but guarantees a none empty result, unless invoking a unusually empty color scheme. All arguments work as mentioned above, only here is no "distance" argument. The only difference is (due to the second return value), multiple names (when requested) have to come in the form of an ARRAY as the first return value. my $name = $red_like->closest_name; # closest name in default scheme my $name = $red_like->closest_name('HTML'); # closest HTML constant ($red_name, $distance) = $red_like->closest_name( from => 'Pantone', all => 1 ); distance Is a floating point number that measures the Euclidean distance between two colors, which represent two points in a color space. One color is the calling object itself and the second one has to be provided as either the only argument or the named argument "to", which is the only required one. The "distance" is measured in *RGB* color space unless told otherwise by the argument "in". Please use the *OKLAB* or *CIELUV* space, if you are interested in getting a result that matches the human perception. The third argument is named "select". It's useful if you want to regard only certain dimensions (axis - long and short axis names are accepted). For instance if you want to know only the difference in brightness between two colors, you type "select => 'lightness'" or "select => 'l'". This naturally works only if you did also choose *HSL* as a color space or something similar that has a "lightness" axis like *LAB* or *OKLAB*. The "select" argument accepts a string or an ARRAY with several axis names, which can also repeat. For instance there is a formula to compute distances in RGB that weights the squared value delta's: "$distance = sqrt( 3 * delta_red**2 + 4 * delta_green**2 + 2 * delta_blue**2)". You can recreate that formula by typing "select => [qw/ r r r g g g g b b/]" The last argument is named "range", which can change the result drasticly. my $d = $blue->distance( 'lapisblue' ); # how close is blue to lapis? $d = $blue->distance( to => 'airyblue', select => 'b'); # have they the same amount of blue? $d = $color->distance( to => $c2, in => 'HSL', select => 'hue' ); # same hue? $d = $color->distance( to => $c2, range => 'normal' ); # distance with values in 0 .. 1 range $d = $color->distance( to => $c2, select => [qw/r g b b/]); # double the weight of blue value differences SINGLE COLOR These methods generate one new color object that is related to the calling object (invocant). You might expect that methods like "set_value" change the values of the invocant, but GTC objects are as mentioned in the "DESCRIPTION" read only. That supports a more functional programming style as well as method stacking like: $color->add_value( saturation => 5)->invert->mix( to => 'green'); set_value Creates a new GTC color object that shares some values with the current one, but differs in others. The altered values are provided as absoltue numbers. If the resulting color will be outside of the given color space, the values will be clamped so it will become a regular color of that space. The axis of all supported color spaces have long and short names. For instance *HSL* has *hue*, *sturation* and *lightness*. The short equivalents are *h*, *s* and *l*. This method accepts these axis names as named arguments and disregards if characters are written upper or lower case. This method can not work, if you mix axis names from different spaces or choose one axis more than once. One solvable issue is when axis in different spaces have the same name. For instance *HSL* and *HSV* have a *saturation* axis. To disambiguate you can add the named argument "in". my $blue = $black->set_value( blue => 255 ); # same as #0000ff my $pale_blue = $blue->set_value( saturation => 50 ); # ->( s => 50) works too my $color = $blue->set_value( saturation => 50, in => 'HSV' ); # previous was HSL add_value Creates a new GTC color object that shares some values with the current one, but differs in others. The altered values are provided relative to the current ones. The rest works as described in "set_value". This method was mainly created to get lighter, darker or more saturated colors by using it like: my $blue = Graphics::Toolkit::Color->new('blue'); my $darkblue = $blue->add_value( Lightness => -25 ); # get a darker tone my $blue2 = $blue->add_value( blue => 10 ); # bluer than blue ? my $blue3 = $blue->add_value( l => 10, in => 'LAB' ); # lighter color according CIELAB mix Create a new GTC object, that has the average values between the calling object and another color (or several colors). It accepts three named arguments: "to", "amount" and "in", but only the first one is required. "to" works like in other methods, with the exception that it also accepts an ARRAY ref (square brackets) with several color definitions. Per default *mix* computes a 50-50 (1:1) mix. In order to change that, employ the "amount" argument, which is the weight the mixed in color(s) get, counted in percentages. The remaining percentage to 100 is the weight of the color, held by the caller object. This would be naturally nothing, if the "amount" is greater than hundret, which is especially something to consider, if mixing more than two colors. Then both "to" and "amount" have to get an array of colors and respectively their amounts (same order). Obviously both arrays MUST have the same length. If the sum of amounts is greater than 100 the original color is ignored but the weight ratios will be kept. You may actually give "amount" a scalar value while mixing a list of colors. Then the amount is applied to every color mentioned under the "to" argument. In this case you go over the sum of 100% very quickly. $blue->mix( 'silver'); # 50% silver, 50% blue $blue->mix( to => 'silver', amount => 60 ); # 60% silver, 40% blue $blue->mix( to => [qw/silver green/], amount => [10, 20]); # 10% silver, 20% green, 70% blue $blue->mix( to => [qw/silver green/] ); # 50% silver, 50% green $blue->mix( to => {H => 240, S =>100, L => 50}, in => 'RGB' ); # teal invert Computes the a new color object, where all values are inverted according to the ranges of the chosen color space (see "in"). It takes only one optional, positional argument, a space name. my $black = $white->invert(); # to state the obvious my $blue = $yellow->invert( 'LUV' ); # invert in LUV space $yellow->invert( in => 'LUV' ); # would work too COLOR SETS construct several interrelated color objects at once. complement Creates a set of complementary colors (GTC objects), which will be computed in *HSL* color space. The method accepts three optional, named arguments: "steps" and "tilt" and "target". But if none are provided, THE (one) complementary color will be produced. One singular, positional argument defines the number of produced colors, same as the named argument "steps" would have. If you want to get 'triadic' colors, choose 3 as an argument for "steps" - 4 would get you the 'tetradic' colors, .... and so on. The given color is always the last in the row of produced complementary colors. If you need split-complementary colors, just use the "tilt" argument, which defaults to zero. Without any tilt, complementary colors are equally distanced dots on a horizontal circle around the vertical, central column in *HSL* space. In other words: complementary colors have all the same 'saturation' (distance from the column) and 'lightness' (height). They differ only in 'hue' (position on the circle). The given color and its (THE) complement sit on opposite sides of the circle. The greater the "tilt" amount, the more these colors (minus the given one) will move on the circle toward THE complement and vice versa. What is traditionally meant by split-complementary colors you will get here with a "tilt" factor of around 3.42 and three "steps" or a "tilt" of 1.585 and four "steps" (depending on if you need THE complement also in your set). To get an even greater variety of complementary colors, you can use "target" argument and move around THE complement and thus shape the circle in all three directions. "hue" (or "h") values move it circularly "saturation" (or "s") move it away or negative values toward the central column and "lightness" (or "l") move it up and down. my @colors = $c->complement( 4 ); # 'tetradic' colors my @colors = $c->complement( steps => 4, tilt => 4 ); # split-complementary colors my @colors = $c->complement( steps => 3, tilt => { move => 2, target => {l => -10}} ); my @colors = $c->complement( steps => 3, tilt => { move => 2, target => { h => 20, s=> -5, l => -10 } }); gradient Creates a gradient (a list of color objects that build a transition) between the current color held by the object and a second color, provided by the named argument "to", which is required. Optionally "to" accepts an ARRAY ref (square braces) with a list of colors in order to create the most fancy, custom and nonlinear gradients. Also required is the named argument "steps", which is the gradient length or count of colors, which are part of this gradient. Included in there are the start color (given by this object) and end color (given with "to"). The optional, floating point valued argument "tilt" makes the gradient skewed toward one or the other end. Default is zero, which results in a linear, uniform transition between start and stop. Greater values of the argument let the color change rate start small, steadily getting bigger. Negative values work vice versa. The bigger the absolute numeric value the bigger the effect. Please have in mind that values over 2 result is a very strong tilt. Optional is the named argument "in" (color space - details behind link). Tip: use "oklab" and "cieluv" spaces for visually smooth gradients. # we turn to grey my @colors = $c->gradient( to => $grey, steps => 5); # none linear gradient in HSL space : @colors = $c1->gradient( to =>[14,10,222], steps => 10, tilt => 1, in => 'HSL' ); @colors = $c1->gradient( to =>['blue', 'brown', {h => 30, s => 44, l => 50}] ); cluster Computes a set of colors that are all similar but not the same. The method accepts three named arguments: "radius", "distance" and "in", of which the first two are required. The produced colors form a ball or cuboid in a color space around the given color, depending on what the argument "radius" got. If it is a single number, it will be a ball with the given radius. If it is an ARRAY of values you get the a cuboid with the given dimensions. The minimal distance between any two colors of a cluster is set by the "minimal_distance" argument, which is computed the same way as the method "distance", in has a short alias "min_d". In a cuboid shaped cluster- the colors will form a cubic grid - inside the ball shaped cluster they form a cuboctahedral grid, which is packed tighter, but still obeys the minimal distance. my @blues = $blue->cluster( radius => 4, minimal_distance => 0.3 ); my @c = $color->cluster( r => [2,2,3], min_d => 0.4, in => YUV ); ARGUMENTS Some named arguments of the above listed methods reappear in several methods. Thus they are explained here once. Please note that you must NOT wrap the named args in curly braces (HASH ref). in The named argument *in* expects the name of a color space as listed here. The default color space in this module is *RGB*. Depending on the chosen space, the results of all methods can be very different, since colors are arranged there very differently and have different distances to each other. Some colors might not even exist in some spaces. range Every color space comes with range definitions for its values. For instance *red*, *green* and *blue* in *RGB* go usually from zero to 255 (0..255). In order to change that, many methods accept the named argument "range". When only one interger value provided, it changes the upper bound on all three axis and as lower bound is assumed zero. Let's say you need *RGB16* values with a range of 0 .. 65536, then you type "range => 65536" or "range => 2**16". If you provide an ARRAY ref you can change the upper bounds of all axis individually and in order to change even the lower boundaries, use ARRAY refs even inside that. For instance in "HSL" the "hue" is normally 0 .. 359 and the other two axis are 0 .. 100. In order to set "hue" to -100 .. 100 but keep the other two untouched you would have to insert: "range => [[-100,100],100,100]". to This argument receives a second or target color. It may come in form of another GTC object or a color definition that is acceptable to the constructor. But it has to be a scalar (string or (HASH) reference), not a value list or hash. SEE ALSO * Color::Scheme * Graphics::ColorUtils * Color::Fade * Graphics::Color * Graphics::ColorObject * Color::Calc * Convert::Color * Color::Similarity ACKNOWLEDGEMENT These people contributed by providing patches, bug reports and useful comments: * Petr Pisar (ppisar) * Slaven Rezic (srezic) * Gabor Szabo (szabgab) * Gene Boggs (GENE) * Stefan Reddig (sreagle) AUTHOR Herbert Breunung, COPYRIGHT Copyright 2022-2025 Herbert Breunung. LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Changes100644001750001750 1671615055140237 17655 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972 1.972 2025-09-31 lichtkind ------- * = small feature release = 2 fixes * ? POD fixed / rewrote for methods "values", "name", "closest_name", "distance" * ! public API cluster method test fix 1.971 2025-08-31 lichtkind ------- * = small fix release = 3 fixes * ? documented latest input format * ? typos in POD * ! more cluster method test fixes 1.97 2025-08-30 lichtkind ------- * = small feature release + 1 fix * + new input format: space_name => [ ....] * + method "name" can now return names from a radius * ~ renamed cluster argument: distance => minimal_distance * ~ cluster argument "minimal_distance" got alias: "min_d" * ~ cluster argument "radius" got alias: "r" * ? removed bad chars from POD * ? organize POD for color names better 1.961 2025-08-29 lichtkind ------- * = fix stupidity release * ? removed bad chars from POD 1.951 2025-08-29 lichtkind ------- * = tiny POD fix release * ? removed bad chars from POD 1.95 2025-08-29 lichtkind ------- * = mid sized feature release + 3 fixes * * added support of 3 color spaces: OKLAB, OKLCH, HunterLAB * + methods "name" and "closest_name" can now return multiple names and full names * ? rewrote some POD * ? POD example code fixes * ? fix POD links in GTC::Space::Hub lib * ! fixed too tight set calc tests: Issue Pause:169094 found by SlavenRezic++ * ! remove unused "use Benchmark;" fixed by ppisar++ 1.92 2025-08-20 lichtkind ------- * = mid sized feature release + 1 fix * + methods "name" and "closest_name" work on any scheme from Graphics::ColorNames * ~ extended "CSS_string" format, commas are now optional * ~ no space between axis value and suffix allowed * ~ color space "CIELCHuv" got alias name "LCHuv" * & converter value IO moved to standard tuple format * ? POD syntax fixes 1.91 2025-08-12 lichtkind ------- * = minor bug fix release * ~ added aliases for renamed methods "add_value" and "set_value" * ? POD syntax fixes * ? rewrote parts of ::Color::Space POD 1.9 2025-08-12 lichtkind ------- * = major feature release * * added "cluster" and "invert" calculation method * * added "closest_name" method * * added support of 5 color spaces: NCol YUV CIELUV CIELCHab CIELCHuv, rewrote CIEXYZ CIELAB * + extended range definitions with explicit type names * + color spaces can now define value precision, value suffix ('%') and value parsing regex * ? added documentation for color space object and missing formats * & moved code into Space::Format space attribute object class * & removed Carp and Test::Warn as dependencies * & moved color and color set calculators into own packages * ~ reworked all calculator methods * ~ renamed single color calculator method "blend" method to "mix" * ~ renamed method "add" and "set" to "add_value" and "set_value" * ~ renamed method "mix" argument "with" to "to" * ~ renamed method "gradient" argument "dynamic" to "tilt" * ~ default space of methods 'distance', 'mix' and 'gradient' went from HSL to RGB, consistent with defaults (complement has to be HSL) 1.71 2023-09-21 lichtkind ------- * = doc fixes * ? typos mispellings, broken sentences * ? 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 LICENSE100644001750001750 4656115055140237 17370 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972This software is copyright (c) 2022-2025 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-2025 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-2025 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 207015055140237 17772 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972name = 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-2025 [Prereqs] perl = v5.12.0 Exporter = 5 [Prereqs / RuntimeSuggests] Bundle::Graphics::ColorNames = 0 [Prereqs / TestRequires] Test::More = 1.3 [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 1057215055140237 17625 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972--- abstract: 'calculate color (sets), IO many spaces and formats' author: - 'Herbert Breunung ' build_requires: Test::More: '1.3' 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.972' Graphics::Toolkit::Color::Name: file: lib/Graphics/Toolkit/Color/Name.pm version: '1.972' Graphics::Toolkit::Color::Name::Constant: file: lib/Graphics/Toolkit/Color/Name/Constant.pm version: '1.972' Graphics::Toolkit::Color::Name::Scheme: file: lib/Graphics/Toolkit/Color/Name/Scheme.pm version: '1.972' Graphics::Toolkit::Color::SetCalculator: file: lib/Graphics/Toolkit/Color/SetCalculator.pm version: '1.972' Graphics::Toolkit::Color::Space: file: lib/Graphics/Toolkit/Color/Space.pm version: '1.972' Graphics::Toolkit::Color::Space::Basis: file: lib/Graphics/Toolkit/Color/Space/Basis.pm version: '1.972' Graphics::Toolkit::Color::Space::Format: file: lib/Graphics/Toolkit/Color/Space/Format.pm version: '1.972' Graphics::Toolkit::Color::Space::Hub: file: lib/Graphics/Toolkit/Color/Space/Hub.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CIELAB: file: lib/Graphics/Toolkit/Color/Space/Instance/CIELAB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CIELCHab: file: lib/Graphics/Toolkit/Color/Space/Instance/CIELCHab.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CIELCHuv: file: lib/Graphics/Toolkit/Color/Space/Instance/CIELCHuv.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CIELUV: file: lib/Graphics/Toolkit/Color/Space/Instance/CIELUV.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CIEXYZ: file: lib/Graphics/Toolkit/Color/Space/Instance/CIEXYZ.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CMY: file: lib/Graphics/Toolkit/Color/Space/Instance/CMY.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::CMYK: file: lib/Graphics/Toolkit/Color/Space/Instance/CMYK.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::HSB: file: lib/Graphics/Toolkit/Color/Space/Instance/HSB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::HSL: file: lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::HSV: file: lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::HWB: file: lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::HunterLAB: file: lib/Graphics/Toolkit/Color/Space/Instance/HunterLAB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::NCol: file: lib/Graphics/Toolkit/Color/Space/Instance/NCol.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::OKLAB: file: lib/Graphics/Toolkit/Color/Space/Instance/OKLAB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::OKLCH: file: lib/Graphics/Toolkit/Color/Space/Instance/OKLCH.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::RGB: file: lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::YIQ: file: lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm version: '1.972' Graphics::Toolkit::Color::Space::Instance::YUV: file: lib/Graphics/Toolkit/Color/Space/Instance/YUV.pm version: '1.972' Graphics::Toolkit::Color::Space::Shape: file: lib/Graphics/Toolkit/Color/Space/Shape.pm version: '1.972' Graphics::Toolkit::Color::Space::Util: file: lib/Graphics/Toolkit/Color/Space/Util.pm version: '1.972' Graphics::Toolkit::Color::Values: file: lib/Graphics/Toolkit/Color/Values.pm version: '1.972' requires: Exporter: '5' perl: v5.12.0 resources: repository: git://github.com/lichtkind/Graphics-Color-Toolkit.git version: '1.972' 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 437115055140237 17465 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972# 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/Name/Scheme.pm lib/Graphics/Toolkit/Color/SetCalculator.pm lib/Graphics/Toolkit/Color/Space.pm lib/Graphics/Toolkit/Color/Space/Basis.pm lib/Graphics/Toolkit/Color/Space/Format.pm lib/Graphics/Toolkit/Color/Space/Hub.pm lib/Graphics/Toolkit/Color/Space/Instance/CIELAB.pm lib/Graphics/Toolkit/Color/Space/Instance/CIELCHab.pm lib/Graphics/Toolkit/Color/Space/Instance/CIELCHuv.pm lib/Graphics/Toolkit/Color/Space/Instance/CIELUV.pm lib/Graphics/Toolkit/Color/Space/Instance/CIEXYZ.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/HunterLAB.pm lib/Graphics/Toolkit/Color/Space/Instance/NCol.pm lib/Graphics/Toolkit/Color/Space/Instance/OKLAB.pm lib/Graphics/Toolkit/Color/Space/Instance/OKLCH.pm lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm lib/Graphics/Toolkit/Color/Space/Instance/YUV.pm lib/Graphics/Toolkit/Color/Space/Shape.pm lib/Graphics/Toolkit/Color/Space/Util.pm lib/Graphics/Toolkit/Color/Values.pm t/01_space_util.t t/02_space_basis.t t/03_space_shape.t t/04_space_format.t t/05_space.t t/10_rgb_space.t t/11_cmy_space.t t/12_cmyk_space.t t/15_yiq_space.t t/16_yuv_space.t t/20_hsl_space.t t/21_hsv_space.t t/22_hsb_space.t t/23_hwb_space.t t/24_ncol_space.t t/40_ciexyz_space.t t/41_cielab_space.t t/42_cieluv_space.t t/43_cielchab_space.t t/44_cielchuv_space.t t/46_hunterlab_space.t t/50_oklab_space.t t/51_oklch_space.t t/60_space_hub.t t/61_space_hub_convert.t t/62_space_hub_format.t t/71_name_scheme.t t/72_name.t t/80_values.t t/81_values_types.t t/82_values_measure.t t/83_calc_single.t t/84_calc_set.t t/90_public_constructor.t t/91_public_getter.t t/92_public_calc_single.t t/93_public_calc_set.t xt/author/pod-syntax.t cpanfile100644001750001750 66515055140237 20022 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972# 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 "Exporter" => "5"; requires "perl" => "v5.12.0"; suggests "Bundle::Graphics::ColorNames" => "0"; on 'test' => sub { requires "Test::More" => "1.3"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Test::Pod" => "1.41"; }; META.json100644001750001750 1430515055140237 17773 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972{ "abstract" : "calculate color (sets), IO many spaces and formats", "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" : { "Exporter" : "5", "perl" : "v5.12.0" }, "suggests" : { "Bundle::Graphics::ColorNames" : "0" } }, "test" : { "requires" : { "Test::More" : "1.3" } } }, "provides" : { "Graphics::Toolkit::Color" : { "file" : "lib/Graphics/Toolkit/Color.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Name" : { "file" : "lib/Graphics/Toolkit/Color/Name.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Name::Constant" : { "file" : "lib/Graphics/Toolkit/Color/Name/Constant.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Name::Scheme" : { "file" : "lib/Graphics/Toolkit/Color/Name/Scheme.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::SetCalculator" : { "file" : "lib/Graphics/Toolkit/Color/SetCalculator.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space" : { "file" : "lib/Graphics/Toolkit/Color/Space.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Basis" : { "file" : "lib/Graphics/Toolkit/Color/Space/Basis.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Format" : { "file" : "lib/Graphics/Toolkit/Color/Space/Format.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Hub" : { "file" : "lib/Graphics/Toolkit/Color/Space/Hub.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CIELAB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CIELAB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CIELCHab" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CIELCHab.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CIELCHuv" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CIELCHuv.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CIELUV" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CIELUV.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CIEXYZ" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CIEXYZ.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CMY" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CMY.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::CMYK" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/CMYK.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::HSB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::HSL" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::HSV" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HSV.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::HWB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HWB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::HunterLAB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/HunterLAB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::NCol" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/NCol.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::OKLAB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/OKLAB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::OKLCH" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/OKLCH.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::RGB" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/RGB.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::YIQ" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/YIQ.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Instance::YUV" : { "file" : "lib/Graphics/Toolkit/Color/Space/Instance/YUV.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Shape" : { "file" : "lib/Graphics/Toolkit/Color/Space/Shape.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Space::Util" : { "file" : "lib/Graphics/Toolkit/Color/Space/Util.pm", "version" : "1.972" }, "Graphics::Toolkit::Color::Values" : { "file" : "lib/Graphics/Toolkit/Color/Values.pm", "version" : "1.972" } }, "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.972", "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 015055140237 16432 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.97272_name.t100644001750001750 1654015055140237 20235 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 69; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util ':all'; my $module = 'Graphics::Toolkit::Color::Name'; eval "use $module"; is( not($@), 1, 'could load the module'); my $get_values = \&Graphics::Toolkit::Color::Name::get_values; my $from_values = \&Graphics::Toolkit::Color::Name::from_values; my $closest_from_values = \&Graphics::Toolkit::Color::Name::closest_from_values; my $all = \&Graphics::Toolkit::Color::Name::all; my $try_get_scheme = \&Graphics::Toolkit::Color::Name::try_get_scheme; my $add_scheme = \&Graphics::Toolkit::Color::Name::add_scheme; my $scheme_ref = 'Graphics::Toolkit::Color::Name::Scheme'; my $default_scheme = $try_get_scheme->('default'); my (@names, $names, $values); is( ref $try_get_scheme->(), $scheme_ref, 'get default scheme when leaving out argument'); is( ref $default_scheme, $scheme_ref, 'get default scheme when requesting it'); is( $default_scheme, $try_get_scheme->(), 'both are the same'); is( $default_scheme->is_name_taken('red'), 1, '"red" is a known constant' ); is( $default_scheme->is_name_taken('RED'), 1, 'color constants are case insensitive' ); is( $default_scheme->is_name_taken("r_e'd"), 1, 'some special characters are also ignored' ); is( $default_scheme->is_name_taken('blue'), 1, '"blue" is a known constant' ); is( $default_scheme->is_name_taken('coconut'), 0, '"coconut" is not a known constant' ); @names = Graphics::Toolkit::Color::Name::all(); is( int @names, 716, 'all default consants are there' ); #$values = Graphics::Toolkit::Color::Name::get_values('SVG:red'); $values = $get_values->('red'); is( ref $values, 'ARRAY', 'got value tuple of color red' ); is( int @$values, 3, 'it has three values' ); is( $values->[0], 255, 'red value is correct' ); is( $values->[1], 0, 'green value is correct' ); is( $values->[2], 0, 'blue value is correct' ); @names = Graphics::Toolkit::Color::Name::from_values([255,0,0]); is( int @names, 1, 'no second arg, get only one name "from_values"'); is( $names[0], 'red', 'and its name is "red"'); @names = Graphics::Toolkit::Color::Name::from_values([255,0,0], undef, 'all' ); is( int @names, 2, 'all names were requested "from_values"' ); is( $names[0], 'red', 'it is also "red" on first position' ); is( $names[1], 'red1', 'it is "red1" on second position' ); @names = Graphics::Toolkit::Color::Name::from_values([255,0,0], undef, 'all', 'full' ); is( int @names, 2, 'names do not expand when in default scheme' ); is( $names[0], 'red', 'it is also "red" on first position' ); is( $names[1], 'red1', 'it is "red1" on second position' ); @names = Graphics::Toolkit::Color::Name::closest_from_values([255,0,0] ); is( int @names, 2, 'got names and distance from "closest_from_values"'); is( $names[0], 'red', 'and its name is "red"' ); is( $names[1], 0, 'has no distance' ); @names = Graphics::Toolkit::Color::Name::closest_from_values([255,0,0], undef, 'all' ); is( int @names, 2, 'got all names and distance from "closest_from_values"'); is( ref $names[0], 'ARRAY', 'names ARRAY on first position'); is( @{$names[0]}, 2, 'it has two names'); is( $names[0][0], 'red', 'first is "red"'); is( $names[0][1], 'red1', 'second is is "red1"'); is( $names[1], 0, 'has no distance'); @names = Graphics::Toolkit::Color::Name::closest_from_values([255,1,0] ); is( int @names, 2, 'this time there is a distance to red'); is( $names[0], 'red', 'and its name is "red"' ); is( $names[1], 1, 'has distance of one' ); @names = Graphics::Toolkit::Color::Name::closest_from_values([253, 2, 1], undef, 'all' ); is( int @names, 2, 'got all names and distance from color more far away'); is( ref $names[0], 'ARRAY', 'got names ARRAY for color away'); is( @{$names[0]}, 2, 'it has two names'); is( $names[0][0], 'red', 'first is "red"'); is( $names[0][1], 'red1', 'second is is "red1"'); is( $names[1], 3, 'has distance of 2'); my $scheme = Graphics::Toolkit::Color::Name::Scheme->new(); $scheme->add_color('steel',[253,253,253]); is( $default_scheme->is_name_taken('steel'), 0, '"steel" is an unknown color to default scheme' ); is( ref $try_get_scheme->('new'), '', '"new" scheme is unknown'); is( ref $add_scheme->($scheme, 'new'), $scheme_ref, 'could add the color scheme "new"'); is( ref $try_get_scheme->('new'), $scheme_ref, '"new" scheme is now known'); $values = $get_values->('steel'); is( ref $values, '', 'can not get "steel" color values if not call scheme' ); $values = $get_values->('steel', 'new'); is( ref $values, 'ARRAY', 'asking for "new" scheme, now I get it' ); is( int @$values, 3, 'tuple has three values' ); is( $values->[0], 253, 'red value is correct' ); is( $values->[1], 253, 'green value is correct' ); is( $values->[2], 253, 'blue value is correct' ); @names = Graphics::Toolkit::Color::Name::from_values([253,253,253], 'new'); is( int @names, 1, 'get a name from "new" scheme'); is( $names[0], 'steel', 'and its "steel"'); @names = Graphics::Toolkit::Color::Name::from_values([253,253,253]); is( int @names, 1, 'can not get steel from dfault scheme'); is( $names[0], '', 'name is empty'); @names = Graphics::Toolkit::Color::Name::from_values([253,253,253], ['new','default']); is( int @names, 1, 'multi scheme search is success'); is( $names[0], 'steel', 'right color name'); @names = Graphics::Toolkit::Color::Name::closest_from_values([254, 254, 254], ['new','default'] ); is( int @names, 2, 'multi search with first wins strategy'); is( $names[0], 'steel', 'got name from first scheme'); is( $names[1], round_decimals(sqrt 3, 5), 'distance is sqrt 3' ); @names = Graphics::Toolkit::Color::Name::closest_from_values([254, 254, 254], ['new','default'], 'all' ); is( int @names, 2, 'get multi scheme findings with same distance'); is( ref $names[0], 'ARRAY', 'got names ARRAY'); is( @{$names[0]}, 2, 'it has three names'); is( $names[0][0], 'steel', '"steel" is first due scheme "new" was named first'); is( $names[0][1], 'white', 'second is "white"'); is( $names[1], round_decimals(sqrt 3, 5), 'distance is sqrt 3' ); @names = Graphics::Toolkit::Color::Name::from_values([254, 254, 254], ['new','default'], 'all', 'full', 1.75 ); is( int @names, 2, 'get multi scheme findings with required distance'); is( $names[0], 'NEW:steel', '"steel" is first due scheme "new" was named first'); is( $names[1], 'white', 'default name space name does not get added to color name'); 1; Makefile.PL100644001750001750 210015055140237 20272 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972# 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" => "calculate color (sets), IO many spaces and formats", "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" => { "Exporter" => 5 }, "TEST_REQUIRES" => { "Test::More" => "1.3" }, "VERSION" => "1.972", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Exporter" => 5, "Test::More" => "1.3" ); 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 71315055140237 20142 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972 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 dev/TODO.txt first. 05_space.t100644001750001750 3126315055140237 20403 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 142; BEGIN { unshift @INC, 'lib', '../lib'} #### basic object construction ######################################### 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 axis names to create color space'); my $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/]); is( ref $space, $module, 'created color space just with axis names'); is( $space->name, 'ABCD', 'got space name from AXIS short names'); is( $space->alias, '', 'space name alias is empty'); is( $space->axis_count, 4, 'counted axis right'); #### invalid args ###################################################### is( $space->is_value_tuple([1,2,3,4]), 1, 'correct value tuple'); is( $space->is_value_tuple([1,2,3,4,5]), 0, 'too long value tuple'); is( $space->is_value_tuple([1,2,3,]), 0, 'too short value tuple'); is( $space->is_value_tuple({1=>1,2=>2,3=>3,4=>4,}), 0, 'wrong ref type for value tuple'); is( $space->is_value_tuple(''), 0, 'none ref type can not be value tuple'); is( $space->is_partial_hash(''), 0, 'need a hash ref to be a partial hash'); is( $space->is_partial_hash({}), 0, 'a partial hash needs to have at least one key'); is( $space->is_partial_hash({eta =>1}), 0, 'wrong key for partial hash'); is( $space->is_partial_hash({aaa =>1}), 1, 'right key for partial hash'); is( $space->is_partial_hash({aaa =>1,bbb=> 2}), 1, 'two right keys for partial hash'); is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3}), 1, 'three right keys for partial hash'); is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, ddd => 4}), 1, 'four right keys for partial hash'); is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, d => 4}), 1, 'can mix full names and shortcut names'); is( $space->is_partial_hash({aaa =>1,bbb=> 2, ccc=>3, z => 4}), 0, 'one bad key makes partial hash invalid'); is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object'); #### getter ############################################################ $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], name => 'name'); is( ref $space, $module, 'created color space just with axis names and space name'); is( $space->name, 'NAME', 'got given space name back'); is( $space->alias, '', 'no space anme alias this time'); is( $space->is_linear, 1, 'per default spaces are linear'); is( $space->is_name('name'), 1, 'can ask if given name is right'); is( $space->is_name('abcd'), 0, 'axis initials are not a space name'); is( $space->is_name(''), 0, 'empty string can never be a space name'); is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object'); $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], alias => 'alias'); is( $space->name, 'ABCD', 'got auto generated space name'); is( $space->alias, 'ALIAS', 'got user set space name alias'); is( $space->is_name('abcd'), 1, 'axis initials are a space name'); is( $space->is_name('alias'), 1, 'user set alias is name too'); is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object'); $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], name => 'Name'); is( $space->name, 'NAME', 'got space name with given prefix and given Name'); is( ref $space->basis, 'Graphics::Toolkit::Color::Space::Basis', 'have a valid space basis sub object'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); is( ref $space->form, 'Graphics::Toolkit::Color::Space::Format','have a valid format sub object'); is( ref $space->check_value_shape([0,1,0.5,0.001]), 'ARRAY', 'default to normal range'); is( ref $space->check_value_shape([1,1.1,1,1]), '', 'one value of tuple is out of range'); my $val = $space->clamp([-1,1.1,1]); is( ref $val, 'ARRAY', 'clamped value tuple is a tuple'); is( int @$val, 4, 'filled mising value in'); is( $val->[0], 0, 'clamped up first value'); is( $val->[1], 1, 'clamped down second value'); is( $val->[2], 1, 'passed through third value'); is( $val->[3], 0, 'zero is default value'); $space = Graphics::Toolkit::Color::Space->new(axis => [qw/AAA BBB CCC DDD/], range => [10,20,'normal', [-10,10]], name => 'name', alias => 'alias' ); is( $space->name, 'NAME', 'got back user set space name'); is( $space->alias, 'ALIAS', 'got back user set space name alias'); is( $space->is_name('name'), 1, 'axis initials are space name'); is( $space->is_name('alias'), 1, 'user set alias is a space name'); is( $space->is_name('abcd'), 0, 'axis initials are not a space name'); #### value shape ####################################################### is( ref $space, $module, 'created color space with axis names and ranges'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); is( ref $space->check_value_shape([10,10,1,10]), 'ARRAY', 'max values are in range'); is( ref $space->check_value_shape([0,0,0,-10]), 'ARRAY', 'min values are in range'); is( ref $space->check_value_shape([0,0,2,-10]), '', 'one value is ou of range'); $val = $space->clamp([-1,20.1,1]); is( ref $val, 'ARRAY', 'clamped value tuple is a tuple'); is( int @$val, 4, 'filled mising value in'); is( $val->[0], 0, 'clamped up first value'); is( $val->[1], 20, 'clamped down second value'); is( $val->[2], 1, 'passed through third value'); is( $val->[3], 0, 'zero is default value'); $val = $space->normalize([5,10,0.5,0]); is( ref $val, 'ARRAY', 'normalized value tuple is a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 0.5, 'first value correct'); is( $val->[1], 0.5, 'second value correct'); is( $val->[2], 0.5, 'third value correct'); is( $val->[3], 0.5, 'fourth value correct'); $val = $space->denormalize([ 0.5, 0.5, 0.5, 0.5]); is( ref $val, 'ARRAY', 'denormalized value tuple is a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 5, 'first value correct'); is( $val->[1], 10, 'second value correct'); is( $val->[2], 0.5, 'third value correct'); is( $val->[3], 0, 'fourth value correct'); $val = $space->denormalize_delta([ 0.5, 0.5, 0.5, 0.5]); is( ref $val, 'ARRAY', 'denormalized range value tuple is a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 5, 'first value correct'); is( $val->[1], 10, 'second value correct'); is( $val->[2], 0.5, 'third value correct'); is( $val->[3], 10, 'fourth value correct - range had none zero min'); $val = $space->delta([ 1, 1, 1, 1], [ 5, 20, 0, -1]); is( ref $val, 'ARRAY', 'delta between value tuples is a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 4, 'first value correct'); is( $val->[1], 19, 'second value correct'); is( $val->[2], -1, 'third value correct'); is( $val->[3], -2, 'fourth value correct - range had none zero min'); $space = Graphics::Toolkit::Color::Space->new( axis => [qw/AAA BBB CCC DDD/], range => 10, precision => [0,1,2,-1], ); is( ref $space, $module, 'created color space with axis names, ranges and precision'); is( ref $space->shape, 'Graphics::Toolkit::Color::Space::Shape', 'have a valid space shape sub object'); $val = $space->round([ 1.11111, 1.11111, 1.11111, 1.11111]); is( ref $val, 'ARRAY', 'rounded value tuple is a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 1, 'first value correct'); is( $val->[1], 1.1, 'second value correct'); is( $val->[2], 1.11, 'third value correct'); is( $val->[3], 1.11111, 'fourth value correct - range had none zero min'); $val = $space->clamp([ -0.1111, 1.1111, 200, 0.1111]); is( ref $val, 'ARRAY', 'clamped value tuple into a tuple'); is( int @$val, 4, 'right amount of values'); is( $val->[0], 0, 'clamped up to min'); is( $val->[1], 1.1111, 'second value correct'); is( $val->[2], 10, 'third value correct'); is( $val->[3], 0.1111, 'fourth value correct'); #### 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'), '', 'got no value by key name'); is( $space->format([1,2,3,4], 'AAA'), '', 'got no value by uc key name'); is( $space->format([1,2,3,4], 'c'), '', 'got no value by shortcut name'); is( $space->format([1,2,3,4], 'D'), '', 'got no value by uc shortcut name'); 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, undef, 'char hash with bad key got ignored'); $fval = $space->deformat({aaa => 1, bbb => 2, ccc => 3, dd => 4}); is( $fval, undef, 'char hash with bad key got ignored'); #### convert ########################################################### my @converter = $space->converter_names; is( $space->can_convert('RGB'), 0, 'converter not yet inserted'); is( int @converter, 0, 'no converter names known'); my $h = $space->add_converter('RGB', sub { [$_[0][0]+.1, $_[0][1]-.1, $_[0][2]+.1, $_[0][3]-.1 ]}, sub { [$_[0][0]-.1, $_[0][1]+.1, $_[0][2]-.1, $_[0][3]+.1 ]} ); is( ref $h, 'HASH', 'converter code accepted'); is( $space->can_convert('RGB'), 1, 'converter inserted'); @converter = $space->converter_names; is( int @converter, 1, 'one converter name is known'); is( $converter[0], 'RGB', 'correct converter name is known'); $val = $space->convert_to( 'RGB', [0,0.1,0.2,0.3]); is( ref $val, 'ARRAY', 'could convert to RGB'); is( int @$val, 4, 'right number of values'); is( $val->[0], 0.1, 'first value correctly converted'); is( $val->[1], 0, 'second value correctly converted'); is( $val->[2], 0.3, 'third value correctly converted'); is( $val->[3], 0.2, 'fourth value correctly converted'); $val = $space->convert_from('rgb', [0.1, 0, 0.3, .2]); is( ref $val, 'ARRAY', 'could deconvert to RGB, even if space spelled in lower case'); is( int @$val, 4, 'right number of values'); is( $val->[0], 0, 'first value correctly deconverted'); is( $val->[1], 0.1, 'second value correctly deconverted'); is( $val->[2], 0.2, 'third value correctly deconverted'); is( $val->[3], 0.3, 'fourth value correctly deconverted'); exit 0; 80_values.t100644001750001750 1525115055140237 20611 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 70; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Values'; eval "use $module"; is( not($@), 1, 'could load the module'); my (@values, $values); #### new_from_tuple #################################################### is( ref Graphics::Toolkit::Color::Values->new_from_tuple(), '', 'new need at least one argument'); my $fuchsia_rgb = Graphics::Toolkit::Color::Values->new_from_tuple([255,0,256], 'RGB'); is( ref $fuchsia_rgb, $module, 'created values object from normalized RGB values'); is( $fuchsia_rgb->{'source_values'}, '', 'object source are RGB values'); is( $fuchsia_rgb->{'source_space_name'}, '', 'not from any other space'); is( $fuchsia_rgb->name, 'magenta', 'color has name "magenta"'); is( ref $fuchsia_rgb->{'rgb'}, 'ARRAY', 'RGB tuple is an ARRAY'); is( @{$fuchsia_rgb->{'rgb'}}, 3, 'RGB tuple has three values'); is( $fuchsia_rgb->{'rgb'}[0], 1, 'violet has a maximal red color'); is( $fuchsia_rgb->{'rgb'}[1], 0, 'violet has a no green color'); is( $fuchsia_rgb->{'rgb'}[2], 1, 'violet has a maximal blue color, got clamped'); $values = $fuchsia_rgb->normalized(); is( ref $values, 'ARRAY', 'normalized value tuple is an ARRAY'); is( @$values, 3, 'and has three values'); is( $values->[0], 1, 'red value is as expected'); is( $values->[1], 0, 'green value is as expected'); is( $values->[2], 1, 'blue value is as expected'); is( $fuchsia_rgb->formatted('', 'named_string'), 'rgb: 255, 0, 255', 'got color formatted into named RGB string'); is( $fuchsia_rgb->formatted('CMY', 'CSS_string', undef, 10), 'cmy(0, 10, 0)', 'got color formatted into CMY CSS string'); $values = $fuchsia_rgb->formatted( '', 'ARRAY', undef, [20,30,40]); is( ref $values, 'ARRAY', 'RGB value ARRAY'); is( @$values, 3, 'has three values'); is( $values->[0], 20, 'red value is in hand crafted range'); is( $values->[1], 0, 'green value is as expected'); is( $values->[2], 40, 'blue value is in hand crafted range'); $values = $fuchsia_rgb->formatted( 'CMY', 'ARRAY', [20,30,40]); is( ref $values, '', 'ARRAY format is only for RGB'); my $fuchsia_cmy = Graphics::Toolkit::Color::Values->new_from_tuple([0,1,0], 'CMY'); is( ref $fuchsia_cmy, $module, 'value object from CMY values'); is( ref $fuchsia_cmy->{'source_values'}, 'ARRAY', 'found source values'); is( int @{$fuchsia_cmy->{'source_values'}}, 3, 'CMY has 3 axis'); is( $fuchsia_cmy->{'source_values'}[0], 0, 'cyan value is right'); is( $fuchsia_cmy->{'source_values'}[1], 1, 'magenta value is right'); is( $fuchsia_cmy->{'source_values'}[2], 0, 'yellow value is right'); is( $fuchsia_cmy->{'source_space_name'}, 'CMY', 'cource space is correct'); is( $fuchsia_cmy->name, 'magenta', 'color has name "magenta"'); is( $fuchsia_cmy->{'rgb'}[0], 1, 'violet(fuchsia) has a maximal red color'); is( $fuchsia_cmy->{'rgb'}[1], 0, 'violet(fuchsia) has a no green color'); is( $fuchsia_cmy->{'rgb'}[2], 1, 'violet(fuchsia) has a maximal blue color'); is( $fuchsia_cmy->formatted('RGB', 'hex_string'), '#FF00FF', 'got color formatted into RGB hex string'); is( $fuchsia_cmy->formatted('XYZ', 'hex_string'), '', 'HEX string is RGB only'); #### new_from_any_input ################################################ my $fuchsia_array = Graphics::Toolkit::Color::Values->new_from_any_input([255, 0, 256]); is( ref $fuchsia_array, $module, 'object from regular RGB tuple'); is( $fuchsia_array->{'source_values'}, '', 'object source are RGB values'); is( $fuchsia_array->{'source_space_name'}, '', 'not from any other space'); is( $fuchsia_array->name, 'magenta', 'color has name "magenta"'); is( $fuchsia_array->{'rgb'}[0], 1, 'violet has a maximal red color'); is( $fuchsia_array->{'rgb'}[1], 0, 'violet has a no green color'); is( $fuchsia_array->{'rgb'}[2], 1, 'violet has a maximal blue color, because it was clamped'); my $blue_hsl = Graphics::Toolkit::Color::Values->new_from_any_input({hue => 240, s => 100, l => 50}); is( ref $blue_hsl, $module, 'value object from HSL HASH'); is( ref $blue_hsl->{'source_values'}, 'ARRAY', 'found source values'); is( int @{$blue_hsl->{'source_values'}}, 3, 'HSL has 3 axis'); is( $blue_hsl->{'source_values'}[0], 2/3, 'hue value is right'); is( $blue_hsl->{'source_values'}[1], 1, 'sat value is right'); is( $blue_hsl->{'source_values'}[2], 0.5, 'light value is right'); is( $blue_hsl->{'source_space_name'}, 'HSL', 'cource space is correct'); is( $blue_hsl->name, 'blue', 'color has name "blue"'); is( @{$blue_hsl->{'rgb'}}, 3, 'RGB tuple has three values'); is( $blue_hsl->{'rgb'}[0], 0, 'blue has a no red vlaue'); is( $blue_hsl->{'rgb'}[1], 0, 'blue has a no green value'); is( $blue_hsl->{'rgb'}[2], 1, 'blue has a maximal blue value'); my $blue_hwb = Graphics::Toolkit::Color::Values->new_from_any_input('hwb( 240, 0%, 0% )'); is( ref $blue_hwb, $module, 'value object from HWB named string'); is( ref $blue_hwb->{'source_values'}, 'ARRAY', 'found source values'); is( int @{$blue_hwb->{'source_values'}}, 3, 'HSL has 3 axis'); is( $blue_hwb->{'source_values'}[0], 2/3, 'hue value is right'); is( $blue_hwb->{'source_values'}[1], 0, 'white value is right'); is( $blue_hwb->{'source_values'}[2], 0, 'black value is right'); is( $blue_hwb->{'source_space_name'}, 'HWB', 'cource space is correct'); is( $blue_hwb->name, 'blue', 'color has name "blue"'); is( @{$blue_hwb->{'rgb'}}, 3, 'RGB tuple has three values'); is( $blue_hwb->{'rgb'}[0], 0, 'blue has a no red vlaue'); is( $blue_hwb->{'rgb'}[1], 0, 'blue has a no green value'); is( $blue_hwb->{'rgb'}[2], 1, 'blue has a maximal blue value'); #### name ################ ############################################# my $black = Graphics::Toolkit::Color::Values->new_from_any_input('ciexyz( 0, 0, 0)'); is( $black->name, 'black', 'created black from CSS string in XYZ'); my $white = Graphics::Toolkit::Color::Values->new_from_any_input(['hsv', 0, 0, 100 ]); is( $white->name, 'white', 'created white from named ARRAY in HSV'); exit 0; 84_calc_set.t100644001750001750 3621715055140237 21100 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 150; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::SetCalculator'; my $value_ref = 'Graphics::Toolkit::Color::Values'; eval "use $module"; is( not($@), 1, 'could load the module'); my $RGB = Graphics::Toolkit::Color::Space::Hub::get_space('RGB'); my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space('HSL'); my $XYZ = Graphics::Toolkit::Color::Space::Hub::get_space('XYZ'); my $blue = Graphics::Toolkit::Color::Values->new_from_any_input('blue'); my $red = Graphics::Toolkit::Color::Values->new_from_any_input('red'); my $black = Graphics::Toolkit::Color::Values->new_from_any_input('black'); my $white = Graphics::Toolkit::Color::Values->new_from_any_input('white'); my $midblue = Graphics::Toolkit::Color::Values->new_from_any_input([43, 52, 242]); my (@colors, $values); #### complement ######################################################## # :base_color +steps +tilt %target_delta --> @:values my $complement = \&Graphics::Toolkit::Color::SetCalculator::complement; @colors = $complement->($blue, 1, 0, []); is( int @colors, 1, 'got only one complement'); is( ref $colors[0], $value_ref, 'but it is a value object'); is( $colors[0]->name, 'yellow', 'and has right values'); @colors = $complement->($blue, 2, 0, []); is( int @colors, 2, 'got 2 colors, complement and invocant'); is( ref $colors[0], $value_ref, 'first is a value object'); is( ref $colors[1], $value_ref, 'second is a value object'); is( $colors[0]->name, 'yellow', 'and has right values'); is( $colors[1], $blue, 'got invocant back as second color'); @colors = $complement->($blue, 3, 0, []); is( int @colors, 3, 'got 3 "triadic "colors'); is( ref $colors[0], $value_ref, 'first is a value object'); is( ref $colors[1], $value_ref, 'second is a value object'); is( ref $colors[2], $value_ref, 'third is a value object'); is( $colors[0]->name, 'red', 'first color is red'); is( $colors[1]->name, 'lime', 'second color is full green (lime)'); is( $colors[2], $blue, 'got invocant back as third color'); @colors = $complement->($blue, 4, 0, []); is( int @colors, 4, 'got 4 "tetradic "colors'); is( $colors[0]->name, '', 'first color has no name'); is( $colors[1]->name, 'yellow', 'second color is yellow'); is( $colors[2]->name, '', 'third color has no name'); is( $colors[3], $blue, 'got invocant back as last color'); $values = $colors[0]->shaped('HSL'); is( ref $values, 'ARRAY', 'RGB values of color 2'); is( int @$values, 3, 'are 3 values'); is( $values->[0], 330, 'hue is 90'); is( $values->[1], 100, 'saturation is 100'); is( $values->[2], 50, 'lightness is half'); $values = $colors[1]->shaped('HSL'); is( $values->[0], 60, 'hue of second color is 60'); $values = $colors[2]->shaped('HSL'); is( $values->[0], 150, 'hue of third color is 150'); $values = $colors[3]->shaped('HSL'); is( $values->[0], 240, 'hue of fourth color is 240'); @colors = $complement->($midblue, 5, 0, []); is( int @colors, 5, '4 complements from custom color'); is( $colors[4], $midblue, 'got invocant back as last color'); $values = $colors[0]->shaped('HSL'); is( ref $colors[0], $value_ref, 'first color is a value object'); is( $values->[0], 309, 'hue value from first color is 309'); is( $values->[1], 88, 'saturation is 88'); is( $values->[2], 56, 'lightness is 56 as start'); $values = $colors[1]->shaped('HSL'); is( $values->[0], 21, 'hue value from second color is 21'); is( $values->[1], 88, 'saturation is 88'); $values = $colors[2]->shaped('HSL'); is( $values->[0], 93, 'hue value from third color is 93'); is( $values->[2], 56, 'lightness is 56'); @colors = $complement->($blue, 3, 2, []); is( int @colors, 3, '3 complements with tilt'); $values = $colors[0]->shaped('HSL'); is( $values->[0], 7, 'hue is 7 = 240 + ((1-(2/3**3)) * 180)'); is( $values->[1], 100, 'full saturation'); is( $values->[2], 50, 'half lightness'); $values = $colors[1]->shaped('HSL'); is( $values->[0], 113, 'hue of second color is 113'); @colors = $complement->($blue, 4, 1.5, [10,-20,30]); is( int @colors, 4, '4 complements with tilt and moved target'); $values = $colors[0]->shaped('HSL'); is( $values->[0], 36, 'hue of first color is 36 = 240 + 0,823*190'); is( $values->[1], 84, 'saturation of first color is 84'); is( $values->[2], 75, 'lightness of first color is '); $values = $colors[1]->shaped('HSL'); is( $values->[0], 70, 'hue of target is right'); is( $values->[1], 80, 'saturation of target is right'); is( $values->[2], 80, 'lightness of target is right'); $values = $colors[2]->shaped('HSL'); is( $values->[0], 100, 'hue of third color is 100'); is( $values->[1], 84, 'saturation of third color is 84'); is( $values->[2], 75, 'lightness of third color is 75'); #### gradient ########################################################## # @:colors, +steps, +tilt, :space --> @:values my $gradient = \&Graphics::Toolkit::Color::SetCalculator::gradient; @colors = $gradient->([$black, $white], 2, 0, $RGB); is( int @colors, 2, 'gradient has length of two'); is( $colors[0]->name, 'black', 'first one is black'); is( $colors[1]->name, 'white', 'second one is white'); @colors = $gradient->([$black, $white], 3, 0, $RGB); is( int @colors, 3, 'gradient has length of three'); is( ref $colors[0], $value_ref, 'first color is a value obj'); is( ref $colors[1], $value_ref, 'second color is a value obj'); is( ref $colors[2], $value_ref, 'third color is value obj'); is( $colors[0]->name, 'black', 'first one is black'); is( $colors[1]->name, 'gray', 'second one is grey'); is( $colors[2]->name, 'white', 'third one is white'); @colors = $gradient->([$blue, $white], 4, 0, $RGB); is( int @colors, 4, '4 colors from blue to white'); is( ref $colors[0], $value_ref, 'first color is a value obj'); is( ref $colors[1], $value_ref, 'second color is a value obj'); is( ref $colors[2], $value_ref, 'third color is value obj'); is( ref $colors[3], $value_ref, 'fourth color is a value obj'); is( $colors[0]->name, 'blue', 'number 1 is blue'); is( $colors[3]->name, 'white', 'number 4 is white'); $values = $colors[1]->shaped(); is( ref $values, 'ARRAY', 'RGB values of color 2'); is( int @$values, 3, 'are 3 values'); is( $values->[0], 85, 'red value is right'); is( $values->[1], 85, 'green value is right'); is( $values->[2], 255, 'blue value is right'); $values = $colors[2]->shaped(); is( $values->[0], 170, 'red value of third color is right'); @colors = $gradient->([$red, $white], 3, 0, $HSL); is( int @colors, 3, 'got 3 color gradient in HSL'); $values = $colors[0]->shaped('HSL'); is( $values->[0], 0, 'hue of red is zero'); is( $values->[1], 100, 'full saturation of red in HSL'); is( $values->[2], 50, 'half lightness of red in HSL'); $values = $colors[1]->shaped('HSL'); is( $values->[0], 0, 'hue of rose is zero'); is( $values->[1], 50, 'full saturation of red in HSL'); is( $values->[2], 75, '3/4 lightness of red in HSL'); $values = $colors[2]->shaped('HSL'); is( $values->[0], 0, 'hue of white is zero'); is( $values->[1], 0, 'no saturation of white in HSL'); is( $values->[2], 100, 'full lightness of white in HSL'); @colors = $gradient->([$red, $white], 3, 1, $HSL); $values = $colors[1]->shaped('HSL'); is( $values->[0], 0, 'hue of rose is zero'); is( $values->[1], 75, 'due tilt middle color saturation is 3/4 red'); is( $values->[2], 63, 'due tilt middle color lightness is 3/4 red'); @colors = $gradient->([$red, $white], 3, -1, $HSL); $values = $colors[1]->shaped('HSL'); is( $values->[0], 0, 'hue of rose is zero'); is( $values->[1], 25, 'due reverse tilt middle color saturation is 1/4 red'); is( $values->[2], 88, 'due reverse tilt middle color lightness is 1/4 red'); @colors = $gradient->([$red, $white, $blue], 9, 0, $RGB); is( int @colors, 9, 'got 9 color gradient in RGB'); is( $colors[0]->name, 'red', 'starting with red'); is( $colors[4]->name, 'white', 'white is in the middle'); is( $colors[8]->name, 'blue', 'blue is at the end'); $values = $colors[5]->shaped('RGB'); is( ref $values, 'ARRAY', 'get RGB values inside multi segment gradient'); is( $values->[0], 191, 'red value is right'); is( $values->[1], 191, 'green value is right'); is( $values->[2], 255, 'blue value is right'); @colors = $gradient->([$red, $white, $blue], 5, 2, $HSL); $values = $colors[1]->shaped('HSL'); is( int @colors, 5, 'got 5 colors in complex and tiltet gradient in HSL'); is( $colors[4], $blue, 'last color is blue'); $values = $colors[1]->shaped('HSL'); is( $values->[0], 0, 'hue of rose is zero'); is( $values->[1], 97, 'saturation is 97 = (1-0.03125)*100'); is( $values->[2], 52, 'lightness is 52 = (1-0.03125)*50)+(0.03125*100)'); $values = $colors[3]->shaped('HSL'); is( $values->[0], 0, 'fourth color is still rose due strong tilt'); is( $values->[1], 16, 'saturation is 16 = (1 - ((3/4)**3)) * 100'); is( $values->[2], 92, 'lightness is 71 = ((1-((3/4)**3)) * 50) + ((3/4)**3 * 100)'); #### cluster ########################################################### # :values, +radius @+|+distance, :space --> @:values my $cluster = \&Graphics::Toolkit::Color::SetCalculator::cluster; @colors = $cluster->($midblue, [0,0,0], 1, $RGB); is( int @colors, 1, 'computed minimal cuboid cluster with 1 color'); $values = $colors[0]->shaped('RGB'); is( ref $values, 'ARRAY', 'got the mid blue values'); is( $values->[0], 43, 'red value is right'); is( $values->[1], 52, 'green value is right'); is( $values->[2], 242, 'blue value is right'); @colors = $cluster->($midblue, [0,1,0], 1, $RGB); is( int @colors, 3, 'computed tiny line shaped cluster with 3 colors'); $values = $colors[0]->shaped('RGB'); is( $values->[0], 43, 'red value of first color is right'); is( $values->[1], 51, 'green value of first color is right'); $values = $colors[1]->shaped('RGB'); is( $values->[1], 52, 'green value of second color is right'); is( $values->[2], 242, 'blue value of second color is right'); is( $colors[2]->shaped('RGB')->[1], 53, 'green value of third color is right'); @colors = $cluster->($midblue, [1,1,1], 1, $RGB); is( int @colors, 27, 'computed tiny cuboid cluster with 27 colors'); $values = $colors[0]->shaped('RGB'); is( ref $values, 'ARRAY', 'got first color in min corner'); is( $values->[0], 42, 'red value is right'); is( $values->[1], 51, 'green value is right'); is( $values->[2], 241, 'blue value is right'); $values = $colors[26]->shaped('RGB'); is( ref $values, 'ARRAY', 'got last color in max corner'); is( $values->[0], 44, 'red value is right'); is( $values->[1], 53, 'green value is right'); is( $values->[2], 243, 'blue value is right'); @colors = $cluster->($midblue, [1,2,3], 1, $RGB); is( int @colors, 105, 'computed cluster with 105 colors'); $values = $colors[0]->shaped('RGB'); is( ref $values, 'ARRAY', 'got first color in min corner'); is( $values->[0], 42, 'red value is right'); is( $values->[1], 50, 'green value is right'); is( $values->[2], 239, 'blue value is right'); @colors = $cluster->($white, [1.01,1.01,1.01], 1, $HSL); is( int @colors, 12, 'cluster edging on roof of HSL space'); @colors = $cluster->($midblue, 0, 1, $HSL); is( int @colors, 1, 'computed minmal ball shaped cluster with one color'); @colors = $cluster->($midblue, 2.01, 2, $RGB); is( int @colors, 13, 'computed smallest ball shaped cluster in RGB'); $values = $colors[1]->shaped('RGB'); is( ref $values, 'ARRAY', 'center color is on pos one'); is( $values->[0], 43, 'red value is right'); is( $values->[1], 52, 'green value is right'); is( $values->[2], 242, 'blue value is right'); $values = $colors[0]->shaped('RGB'); is( $values->[0], 41, 'first color has less red'); is( $values->[2], 242, 'blue is same as center'); $values = $colors[2]->shaped('RGB'); is( $values->[0], 45, 'third color has more red'); $values = $colors[12]->shaped('RGB'); is( $values->[0], 42, 'red value is right (was rounded up to same)'); is( $values->[1], 51, 'green value is right'); is( $values->[2], 241, 'blue value is right (1.4 less but rounded up)'); @colors = $cluster->($midblue, 2.01, 2, $HSL); is( int @colors, 13, 'same cuboctahedral packing in HSL'); @colors = $cluster->($midblue, 2, 1, $RGB); is( int @colors, 47, 'computed smallest ball shaped cluster in RGB'); @colors = $cluster->($white, 1.01, 1, $RGB); is( int @colors, 4, 'cluster edging on corner of RGB space'); exit 0; 10_rgb_space.t100644001750001750 1617615055140237 21237 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 95; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::RGB'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got right return value by loading module'); is( $space->name, 'RGB', 'color space has right name'); is( $space->is_name('rgb'), 1, 'asked for right space name'); is( $space->alias, '', 'color space has no alias name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape( [0,0,0]), 'ARRAY', 'check RGB values works on lower bound values'); is( ref $space->check_value_shape( [255,255,255]), 'ARRAY', 'check RGB values works on upper bound values'); is( ref $space->check_value_shape( [0,0]), '', "RGB got too few values"); is( ref $space->check_value_shape( [0, 0, 0, 0]), '', "RGB got too many values"); is( ref $space->check_value_shape( [-1, 0, 0]), '', "red value is too small"); is( ref $space->check_value_shape( [0.5, 0, 0]), '', "red value is not integer"); is( ref $space->check_value_shape( [256, 0, 0]), '', "red value is too big"); is( ref $space->check_value_shape( [0, -1, 0]), '', "green value is too small"); is( ref $space->check_value_shape( [0, 0.5, 0]), '', "green value is not integer"); is( ref $space->check_value_shape( [0, 256, 0]), '', "green value is too big"); is( ref $space->check_value_shape( [0, 0, -1 ] ), '', "blue value is too small"); is( ref $space->check_value_shape( [0, 0, 0.5] ), '', "blue value is not integer"); is( ref $space->check_value_shape( [0, 0, 256] ), '', "blue value is too big"); my $rgb = $space->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 = $space->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 = $space->clamp([1.1, 2, 3, 4]); is( int @$rgb, 3, 'left out the needless argument'); is( $rgb->[0], 1.1, 'not clamped badly rounded value (job of round)'); 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'); $rgb = $space->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( $space->format([0,0,0], 'hex_string'), '#000000', 'converted black from rgb to hex'); is( uc $space->format([255,255,255],'HEX_string'), '#FFFFFF', 'converted white from rgb to hex'); is( uc $space->format([ 10, 20, 30],'hex_strinG'), '#0A141E', 'converted random color from rgb to hex'); my ($vals, $name) = $space->deformat('#332200'); is( ref $vals, 'ARRAY', 'could deformat hex string'); is( $name, 'hex_string', 'could deformat hex string'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 51, 'red is correctly tranlated from hex'); is( $vals->[1], 34, 'green is correctly tranlated from hex'); is( $vals->[2], 0, 'blue is correctly tranlated from hex'); ($rgb, $name) = $space->deformat('#DEF'); is( ref $rgb, 'ARRAY', 'could deformat short hex string'); is( int @$rgb, 3, 'right amount of values'); is( $name, 'hex_string', 'could deformat 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, $name) = $space->deformat([ 33, 44, 55]); is( $name, 'array', 'could deformat ARRAY ref (RGB special)'); is( ref $rgb, 'ARRAY', 'got value tuple'); 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, $name) = $space->deformat([rgb => 11, 22, 256]); is( $name, 'named_array', 'could deformat named array'); is( ref $rgb, 'ARRAY', 'deformat lc named ARRAY'); is( int @$rgb, 3, '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 = $space->deformat(['CMY', 11, 22, 33]); is( $rgb->[0], undef, 'OO deformat reacts only to right name'); ($rgb, $name) = $space->deformat('RGB: -1, 256, 3.3 '); is( $name, 'named_string', 'could deformat named string'); 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, $name) = $space->deformat('rgb:0,1,2'); is( $name, 'named_string', 'could deformat named string without spaces'); 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 = $space->deformat('cmy: 1,2,3.3'); is( $rgb->[0], undef, 'OO deformat STRING reacts only to right space name'); is( $space->format([0,256,3.3], 'named_string'), 'rgb: 0, 256, 3.3', 'formated rgb triplet into value string'); ($rgb, $name) = $space->deformat('rgb( -1 , 2.3, 4444)'); is( $name, 'css_string', 'could deformat css string'); is( int @$rgb, 3, '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( $space->format([-1,2.3,4444], 'css_string'), 'rgb(-1, 2.3, 4444)', 'formated rgb triplet into css string'); $rgb = $space->format([0,256,3.3], 'named_array'); is( ref $rgb, 'ARRAY', 'formated into named 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( $space->format([10,20,30], 'hex_string'), '#0A141E', 'formated rgb triplet into hex string'); my $d = $space->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 = $space->denormalize( [0.3, 0.4, 0.5], 255, 0 ); is( int @$rgb, 3, 'denormalized triplet, got 3 values'); is( $rgb->[0], 76.5, 'right red value'); is( $rgb->[1], 102, 'right green value'); is( $rgb->[2], 127.5, 'right blue value'); exit 0; exit 0; 11_cmy_space.t100644001750001750 713515055140237 21231 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 47; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::CMY'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got space object by loading module'); is( $space->name, 'CMY', 'color space has right name'); is( $space->alias, '', 'color space has no alias name'); is( $space->axis_count, 3, 'CMY color space has 3 axis'); is( ref $space->check_value_shape( [0,0,0]), 'ARRAY', 'check CMY values works on lower bound values'); is( ref $space->check_value_shape( [1, 1, 1]), 'ARRAY', 'check CMY values works on upper bound values'); is( ref $space->check_value_shape( [0,0]), '', "CMY got too few values"); is( ref $space->check_value_shape( [0, 0, 0, 0]), '', "CMY got too many values"); is( ref $space->check_value_shape( [-1, 0, 0]), '', "cyan value is too small"); is( ref $space->check_value_shape( [2, 0, 0]), '', "cyan value is too big"); is( ref $space->check_value_shape( [0, -1, 0]), '', "magenta value is too small"); is( ref $space->check_value_shape( [0, 2, 0]), '', "magenta value is too big"); is( ref $space->check_value_shape( [0, 0, -1 ] ), '', "yellow value is too small"); is( ref $space->check_value_shape( [0, 0, 2] ), '', "yellow value is too big"); my $cmy = $space->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 = $space->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 = $space->clamp([-0.1, 2, 0.5, 0.4, 0.5]); is( ref $cmy, 'ARRAY', 'clamped tuple and got tuple back'); 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 = $space->convert_from( 'RGB', [0, 0.1, 1]); is( ref $cmy, 'ARRAY', 'converted RGB values tuple into CMY tuple'); 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, $name) = $space->deformat([ 33, 44, 55]); is( $rgb, undef, 'array format is RGB only'); $rgb = $space->convert_to( 'RGB', [1, 0.9, 0 ]); is( ref $rgb, 'ARRAY', 'converted CMY values tuple into RGB tuple'); 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 = $space->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 = $space->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; 15_yiq_space.t100644001750001750 1733615055140237 21273 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 88; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::YIQ'; my $space = eval "require $module"; use Graphics::Toolkit::Color::Space::Util 'round_decimals'; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'YIQ', 'color space has axis initials as name'); is( $space->alias, '', 'color space has no alias name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check neutral YIQ values are in bounds'); is( ref $space->check_value_shape([0, -0.5959, 0.5227]), 'ARRAY', 'check YIQ values works on lower bound values'); is( ref $space->check_value_shape([1, -0.5227, 0.5227]), 'ARRAY', 'check YIQ values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "YIQ got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "YIQ got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "luminance value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "luminance value is too big"); is( ref $space->check_value_shape([0, -0.6, 0]), '', "in_phase value is too small"); is( ref $space->check_value_shape([0, 0.6, 0]), '', "in_phase value is too big"); is( ref $space->check_value_shape([0, 0, .6 ] ), '', "quadrature value is too small"); is( ref $space->check_value_shape([0, 0, -.6] ), '', "quadrature value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'value vector has 3 elements'); is( $space->is_partial_hash({i => 1, Quadrature => 0}), 1, 'found hash with some keys'); is( $space->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $space->can_convert('yiq'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'yiq(0, 0, 0)', 'can format css string'); my $val = $space->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'); my $yiq = $space->convert_from( 'RGB', [ 0, 0, 0]); is( ref $yiq, 'ARRAY','reconverted black has to be a ARRAY reference'); is( int @$yiq, 3, 'reconverted black has three YIQ values'); is( $yiq->[0], 0, 'reconverted black has computed right luminance value'); is( $yiq->[1], 0.5, 'reconverted black has computed right in-phase'); is( $yiq->[2], 0.5, 'reconverted black has computed right quadrature'); $yiq = $space->denormalize( [0, 0.5, 0.5] ); is( ref $yiq, 'ARRAY','denormalized black has to be a ARRAY reference'); is( int @$yiq, 3, 'denormalized black has three YIQ values'); is( $yiq->[0], 0, 'denormalized black has computed right luminance value'); is( $yiq->[1], 0, 'denormalized black has computed right in-phase'); is( $yiq->[2], 0, 'denormalized black has computed right quadrature'); $yiq = $space->normalize( [0, 0, 0] ); is( ref $yiq, 'ARRAY','normalized black has to be a ARRAY reference'); is( int @$yiq, 3, 'normalized black has three YIQ values'); is( $yiq->[0], 0, 'normalized black has computed right luminance value'); is( $yiq->[1], 0.5, 'normalized black has computed right in-phase'); is( $yiq->[2], 0.5, 'normalized black has computed right quadrature'); my $rgb = $space->convert_to( 'RGB', [0, 0.5, 0.5]); is( int @$rgb, 3, 'converted black has three rgb values'); is( $rgb->[0], 0, 'converted black has right red value'); is( $rgb->[1], 0, 'converted black has right green value'); is( $rgb->[2], 0, 'converted black has right blue value'); $yiq = $space->convert_from( 'RGB', [ 1, 1, 1]); is( int @$yiq, 3, 'reconvert white from RGB to YIQ'); is( round_decimals($yiq->[0],4), 1, 'white has right luminance value'); is( round_decimals($yiq->[1],4), .5, 'white has right in-phase'); is( round_decimals($yiq->[2],4), .5, 'white has right quadrature'); $yiq = $space->denormalize( [1, 0.5, 0.5] ); is( int @$yiq, 3, 'denormalized white has three YIQ values'); is( $yiq->[0], 1, 'denormalized white has computed right luminance value'); is( $yiq->[1], 0, 'denormalized white has computed right in-phase'); is( $yiq->[2], 0, 'denormalized white has computed right quadrature'); $rgb = $space->convert_to( 'RGB', [1, .5, .5]); is( int @$rgb, 3, 'converted white has three rgb values'); is( $rgb->[0], 1, 'converted white has right red value'); is( $rgb->[1], 1, 'converted white has right green value'); is( $rgb->[2], 1, 'converted white has right blue value'); $yiq = $space->convert_from( 'RGB', [ .5, .5, .5]); is( int @$yiq, 3, 'converted gray from RGB to YIQ'); is( round_decimals($yiq->[0], 4), .5, 'gray has right luminance value'); is( round_decimals($yiq->[1], 4), .5, 'gray has right in-phase'); is( round_decimals($yiq->[2], 4), .5, 'gray has right quadrature'); $yiq = $space->denormalize( [0.5, 0.5, 0.5] ); is( int @$yiq, 3, 'denormalized gray has three YIQ values'); is( $yiq->[0], 0.5, 'denormalized gray has computed right luminance value'); is( $yiq->[1], 0, 'denormalized gray has computed right in-phase'); is( $yiq->[2], 0, 'denormalized gray has computed right quadrature'); $yiq = $space->normalize( [0.5, 0, 0] ); is( int @$yiq, 3, 'normalized gray has three YIQ values'); is( $yiq->[0], 0.5, 'normalized gray has computed right luminance value'); is( $yiq->[1], 0.5, 'normalized gray has computed right in-phase'); is( $yiq->[2], 0.5, 'normalized gray has computed right quadrature'); $rgb = $space->convert_to( 'RGB', [.5, .5, .5]); is( int @$rgb, 3, 'converted white has three rgb values'); is( $rgb->[0], .5, 'converted white has right red value'); is( $rgb->[1], .5, 'converted white has right green value'); is( $rgb->[2], .5, 'converted white has right blue value'); $yiq = $space->convert_from( 'RGB', [ 0.11, 0, 1]); is( int @$yiq, 3, 'converted nice blue from RGB to YIQ'); is( round_decimals( $yiq->[0], 5), 0.14689, 'reconverted nice blue has right luminance'); is( round_decimals( $yiq->[1], 5), 0.28541, 'reconverted nice blue has right in-phase'); is( round_decimals( $yiq->[2], 5), 0.81994, 'reconverted nice blue has right quadrature'); $yiq = $space->denormalize( [0.14689, 0.2854077865, 0.8199397359] ); is( int @$yiq, 3, 'denormalized gray has three YIQ values'); is( round_decimals( $yiq->[0], 5), 0.14689, 'denormalized nice blue has right luminance value'); is( round_decimals( $yiq->[1], 5),-0.25575, 'denormalized nice blue has right in-phase'); is( round_decimals( $yiq->[2], 5), 0.33446, 'denormalized nice blue has right quadrature'); $yiq = $space->normalize( [0.1433137, -0.255751, 0.334465] ); is( int @$yiq, 3, 'normalized nice blue has three YIQ values'); is( round_decimals( $yiq->[0], 6), 0.143314, 'normalized nice blue has right luminance value'); is( round_decimals( $yiq->[1], 6), 0.285408, 'normalized nice blue has right in-phase'); is( round_decimals( $yiq->[2], 6), 0.81994, 'normalized nice blue has right quadrature'); $rgb = $space->convert_to( 'RGB', [0.14689, 0.2854077865, 0.8199397359]); is( int @$rgb, 3, 'converted nice blue color, has three rgb values'); is( round_decimals( $rgb->[0], 5), .11, 'converted nice blue color, has right red value'); is( round_decimals( $rgb->[1], 5), 0, 'converted nice blue color, has right green value'); is( round_decimals( $rgb->[2], 5), 1, 'converted nice blue color, has right blue value'); exit 0; 16_yuv_space.t100644001750001750 2010415055140237 21300 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 93; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::YUV'; my $space = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'YUV', 'color space has initials as name'); is( $space->alias, 'YPBPR', 'color space has alias name YCbCr'); is( $space->is_name('YPbPr'), 1, 'color space name YCbCr is correct'); is( $space->is_name('YUV'), 1, 'color space name YUV is correct'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check neutral YUV values are in bounds'); is( ref $space->check_value_shape([0, -0.5, -0.5]), 'ARRAY', 'check YUV values works on lower bound values'); is( ref $space->check_value_shape([1, 0.5, 0.5]), 'ARRAY', 'check YUV values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "YUV got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "YUV got too many values"); is( ref $space->check_value_shape([-1, 0, 0]), '', "luma value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "luma value is too big"); is( ref $space->check_value_shape([0, -.51, 0]), '', "Cb value is too small"); is( ref $space->check_value_shape([0, .51, 0]), '', "Cb value is too big"); is( ref $space->check_value_shape([0, 0, -.51] ), '', "Cr value is too small"); is( ref $space->check_value_shape([0, 0, 0.51] ), '', "Cr value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'value vector has 3 elements'); is( $space->is_partial_hash({y => 1, Pb => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({Y => 1, U => 0, V => 0}), 1, 'found hash with some axis names'); is( $space->is_partial_hash({luma => 1, Pb => 0, Pr => 0}), 1, 'found hash with all axis names'); is( $space->is_partial_hash({a => 1, v => 0, l => 0}), 0, 'found hash with one wrong axis name'); is( $space->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $space->can_convert('yuv'), 0, 'can not convert to itself'); is( $space->format([0,1,2], 'css_string'), 'yuv(0, 1, 2)', 'can format css string'); my $val = $space->deformat(['yuv', 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'); my $yuv = $space->convert_from( 'RGB', [ 0, 0, 0]); is( ref $yuv, 'ARRAY','reconverted black has to be a ARRAY reference'); is( int @$yuv, 3, 'reconverted black has three YUV values'); is( $yuv->[0], 0, 'reconverted black has computed right luma value'); is( $yuv->[1], 0.5, 'reconverted black has computed right Pb'); is( $yuv->[2], 0.5, 'reconverted black has computed right Pr'); $yuv = $space->denormalize( [0, 0.5, 0.5] ); is( ref $yuv, 'ARRAY','denormalized black has to be a ARRAY reference'); is( int @$yuv, 3, 'denormalized black has three YUV values'); is( $yuv->[0], 0, 'denormalized black has computed right luma value'); is( $yuv->[1], 0, 'denormalized black has computed right Pb'); is( $yuv->[2], 0, 'denormalized black has computed right Pr'); $yuv = $space->normalize( [0, 0, 0] ); is( ref $yuv, 'ARRAY','normalized black has to be a ARRAY reference'); is( int @$yuv, 3, 'normalized black has three YUV values'); is( $yuv->[0], 0, 'normalized black has computed right luma value'); is( $yuv->[1], 0.5, 'normalized black has computed right Pb'); is( $yuv->[2], 0.5, 'normalized black has computed right Pr'); my $rgb = $space->convert_to( 'RGB', [0, 0.5, 0.5]); is( int @$rgb, 3, 'converted black has three rgb values'); is( $rgb->[0], 0, 'converted black has right red value'); is( $rgb->[1], 0, 'converted black has right green value'); is( $rgb->[2], 0, 'converted black has right blue value'); $yuv = $space->convert_from( 'RGB', [ 1, 1, 1]); is( int @$yuv, 3, 'reconverted black has three YUV values'); is( $yuv->[0], 1, 'reconverted black has computed right luma value'); is( $yuv->[1], .5, 'reconverted black has computed right Pb'); is( $yuv->[2], .5, 'reconverted black has computed right Pr'); $yuv = $space->denormalize( [1, 0.5, 0.5] ); is( int @$yuv, 3, 'denormalized white has three YUV values'); is( $yuv->[0], 1, 'denormalized white has computed right luma value'); is( $yuv->[1], 0, 'denormalized white has computed right Pb'); is( $yuv->[2], 0, 'denormalized white has computed right Pr'); $rgb = $space->convert_to( 'RGB', [1, .5, .5]); is( int @$rgb, 3, 'converted white has three rgb values'); is( $rgb->[0], 1, 'converted white has right red value'); is( $rgb->[1], 1, 'converted white has right green value'); is( $rgb->[2], 1, 'converted white has right blue value'); $yuv = $space->convert_from( 'RGB', [ .5, .5, .5]); is( int @$yuv, 3, 'reconverted gray has three YIQ values'); is( $yuv->[0], .5, 'reconverted gray has computed right luma value'); is( $yuv->[1], .5, 'reconverted gray has computed right Pb'); is( $yuv->[2], .5, 'reconverted gray has computed right Pr'); $yuv = $space->denormalize( [0.5, 0.5, 0.5] ); is( int @$yuv, 3, 'denormalized gray has three YUV values'); is( $yuv->[0], 0.5, 'denormalized gray has computed right luma value'); is( $yuv->[1], 0, 'denormalized gray has computed right Pb'); is( $yuv->[2], 0, 'denormalized gray has computed right Pr'); $yuv = $space->normalize( [0.5, 0, 0] ); is( int @$yuv, 3, 'normalized gray has three YUV values'); is( $yuv->[0], 0.5, 'normalized gray has computed right luma value'); is( $yuv->[1], 0.5, 'normalized gray has computed right Pb'); is( $yuv->[2], 0.5, 'normalized gray has computed right Pr'); $rgb = $space->convert_to( 'RGB', [.5, .5, .5]); is( int @$rgb, 3, 'converted white has three rgb values'); is( $rgb->[0], .5, 'converted white has right red value'); is( $rgb->[1], .5, 'converted white has right green value'); is( $rgb->[2], .5, 'converted white has right blue value'); $yuv = $space->convert_from( 'RGB', [ 0.11, 0, 1]); is( int @$yuv, 3, 'converted nice blue from RGB to YUV'); is( round_decimals( $yuv->[0],5), 0.14689, 'reconverted nice blue has computed right luma value'); is( round_decimals( $yuv->[1],5), 0.48144+0.5, 'reconverted nice blue has computed right Pb'); is( round_decimals( $yuv->[2],5), -0.02631+0.5, 'reconverted nice blue has computed right Pr'); $rgb = $space->convert_to( 'RGB', [0.14689, 0.48143904+0.5, -0.026312+0.5]); is( int @$rgb, 3, 'converted nice blue color, has three rgb values'); is( round_decimals( $rgb->[0],5), .11, 'converted nice blue color, has right red value'); is( round_decimals( $rgb->[1],5), 0, 'converted nice blue color, has right green value'); is( round_decimals( $rgb->[2],5), 1, 'converted nice blue color, has right blue value'); $yuv = $space->convert_from( 'RGB', [ 0.8156, 0.0470588, 0.137254]); is( int @$yuv, 3, 'reconverted nice red has three YUV values'); is( round_decimals( $yuv->[0],5), 0.28713, 'reconverted nice red has computed right luma value'); is( round_decimals( $yuv->[1],5), -0.08458+0.5, 'reconverted nice red has computed right Pb'); is( round_decimals( $yuv->[2],5), 0.37694+0.5, 'reconverted nice red has computed right Pr'); $rgb = $space->convert_to( 'RGB', [0.2871348716, -0.0845829679232+0.5, 0.3769366478976+0.5]); is( int @$rgb, 3, 'converted nice blue color, has three rgb values'); is( round_decimals( $rgb->[0],5), 0.8156, 'converted red blue color, has right red value'); is( round_decimals( $rgb->[1],5), 0.04706, 'converted red blue color, has right green value'); is( round_decimals( $rgb->[2],5), 0.13725, 'converted red blue color, has right blue value'); exit 0; 20_hsl_space.t100644001750001750 1177715055140237 21256 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 63; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSL'; my $space = eval "require $module"; use Graphics::Toolkit::Color::Space::Util 'round_decimals'; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'could load module'); is( $space->name, 'HSL', 'space has name from axis initials'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('Hsl'), 1, 'recognized name'); is( $space->is_name('HSV'), 0, 'ignored wrong name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape( [0, 0, 0]), 'ARRAY', 'check HSL values works on lower bound values'); is( ref $space->check_value_shape( [360,100,100]), 'ARRAY', 'check HSL values works on upper bound values'); is( ref $space->check_value_shape( [0,0]), '', "HSL got too few values"); is( ref $space->check_value_shape( [0, 0, 0, 0]), '', "HSL got too many values"); is( ref $space->check_value_shape( [-1, 0, 0]), '', "hue value is too small"); is( ref $space->check_value_shape( [1.1, 0, 0]), '', "hue is not integer"); is( ref $space->check_value_shape( [361, 0, 0]), '', "hue value is too big"); is( ref $space->check_value_shape( [0, -1, 0]), '', "saturation value is too small"); is( ref $space->check_value_shape( [0, 1.1, 0]), '', "saturation value is not integer"); is( ref $space->check_value_shape( [0, 101, 0]), '', "saturation value is too big"); is( ref $space->check_value_shape( [0, 0, -1 ] ), '', "lightness value is too small"); is( ref $space->check_value_shape( [0, 0, 1.1] ), '', "lightness value is not integer"); is( ref $space->check_value_shape( [0, 0, 101] ), '', "lightness value is too big"); my $hsl = $space->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 = $space->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 = $space->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 = $space->convert_from( 'RGB', [0, 0, 0]); is( ref $hsl, 'ARRAY', 'convert black from RGB to HSL'); is( int @$hsl, 3, 'tight amount of values'); is( round_decimals($hsl->[0], 5), 0, 'right hue'); is( round_decimals($hsl->[1], 5), 0, 'right saturation'); is( round_decimals($hsl->[2], 5), 0, 'right lightness'); my $rgb = $space->convert_to( 'RGB', [0, 0, 0]); is( int @$rgb, 3, 'convert black from HSL to RGB'); is( $rgb->[0], 0, 'right red value'); is( $rgb->[1], 0, 'right green value'); is( $rgb->[2], 0, 'right blue value'); $hsl = $space->convert_from( 'RGB', [0.5, 0.5, 0.5]); is( int @$hsl, 3, 'convert grey from RGB to HSL'); is( $hsl->[0], 0, 'right hue value'); is( $hsl->[1], 0, 'right saturation'); is( $hsl->[2], 0.5, 'right lightness'); $rgb = $space->convert_to( 'RGB', [0, 0, 0.5]); is( int @$rgb, 3, 'convert grey from HSL to RGB'); is( $rgb->[0], 0.5, 'right red value'); is( $rgb->[1], 0.5, 'right green value'); is( $rgb->[2], 0.5, 'right blue value'); $hsl = $space->convert_from( 'RGB', [0.00784, 0.7843, 0.0902]); is( int @$hsl, 3, 'convert nice green from RGB to HSL'); is( round_decimals($hsl->[0], 5), 0.35101, 'right hue value'); is( round_decimals($hsl->[1], 5), 0.98021, 'right saturation'); is( round_decimals($hsl->[2], 5), 0.39607, 'right lightness'); $rgb = $space->convert_to( 'RGB', [0.351011857232397, 0.980205519226399, 0.39607]); is( int @$rgb, 3, 'convert nice green from HSL to RGB'); is( round_decimals($rgb->[0], 5), 0.00784, 'right red value'); is( round_decimals($rgb->[1], 5), 0.7843, 'right green value'); is( round_decimals($rgb->[2], 5), 0.0902, 'right blue value'); my $d = $space->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 = $space->delta([0.9,0,0],[0.1,0,0]); is( $d->[0], .2, 'negative delta across the cylindrical border'); $d = $space->delta([0.3,0,0],[0.9,0,0]); is( $d->[0], -.4, 'negative delta because cylindrical quality of dimension'); exit 0; 21_hsv_space.t100644001750001750 1076515055140237 21265 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 56; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSV'; use Graphics::Toolkit::Color::Space::Util ':all'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'HSV', 'color space has initials as name'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('Hsv'), 1, 'recognized name'); is( $space->is_name('Hsl'), 0, 'ignored wrong name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check HSV values works on lower bound values'); is( ref $space->check_value_shape([360,100,100]), 'ARRAY', 'check HSV values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "HSV got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "HSV got too many values"); is( ref $space->check_value_shape([-1, 0, 0]), '', "hue value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "hue is not integer"); is( ref $space->check_value_shape([361, 0, 0]), '', "hue value is too big"); is( ref $space->check_value_shape([0, -1, 0]), '', "saturation value is too small"); is( ref $space->check_value_shape([0, 1.1, 0]), '', "saturation value is not integer"); is( ref $space->check_value_shape([0, 101, 0]), '', "saturation value is too big"); is( ref $space->check_value_shape([0, 0, -1 ] ), '', "value value is too small"); is( ref $space->check_value_shape([0, 0, 1.1] ), '', "value value is not integer"); is( ref $space->check_value_shape([0, 0, 101] ), '', "value value is too big"); my $hsv = $space->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 = $space->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 = $space->clamp([-1.1,-1,101,4]); is( int @$hsv, 3, 'removed superfluous value'); is( $hsv->[0], 358.9, '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 = $space->convert_from( 'RGB', [0.5, 0.5, 0.5]); is( int @$hsv, 3, 'convert grey from RGB to HSV'); is( $hsv->[0], 0, 'right hue value'); is( $hsv->[1], 0, 'right saturation'); is( $hsv->[2], 0.5, 'right value'); my $rgb = $space->convert_to( 'RGB', [0, 0, 0.5]); is( int @$rgb, 3, 'convert grey from HSV to RGB'); is( $rgb->[0], 0.5, 'right red value'); is( $rgb->[1], 0.5, 'right green value'); is( $rgb->[2], 0.5, 'right blue value'); $rgb = $space->convert_to( 'RGB', [0.972222222, 0.9, 0.78]); is( int @$rgb, 3, 'convert red from HSV into RGB'); is( $rgb->[0], 0.78, 'right red value'); is( $rgb->[1], 0.078, 'right green value'); is( round_decimals($rgb->[2], 5), 0.195, 'right blue value'); $hsv = $space->convert_from( 'RGB', [0.78, 0.078, 0.195000000023]); is( int @$hsv, 3, 'convert nice blue to HSV'); is( round_decimals($hsv->[0], 5), 0.97222, 'right hue value'); is( $hsv->[1], .9, 'right saturation'); is( $hsv->[2], .78, 'right value'); $rgb = $space->convert_to( 'RGB', [0.76666, .83, .24]); is( int @$rgb, 3, 'convert dark violet from HSV to RGB'); is( round_decimals($rgb->[0], 5), 0.16031, 'red value correct'); is( round_decimals($rgb->[1], 5), 0.0408, 'green value correct'); is( round_decimals($rgb->[2], 5), 0.24, 'blue value correct'); $hsv = $space->convert_from( 'RGB', [0.160312032, 0.0408, .24]); is( int @$hsv, 3, 'convert dark violet from RGB to HSV'); is( round_decimals($hsv->[0], 5),0.76666, 'right hue value'); is( round_decimals($hsv->[1], 5), .83, 'right saturation'); is( round_decimals($hsv->[2], 5), .24, 'right value'); exit 0; 22_hsb_space.t100644001750001750 1134215055140237 21232 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 58; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::HSB'; my $space = eval "require $module"; use Graphics::Toolkit::Color::Space::Util ':all'; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'HSB', 'color space has initials as name'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('HsB'), 1, 'recognized name'); is( $space->is_name('Hsl'), 0, 'ignored wrong name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check HSB values works on lower bound values'); is( ref $space->check_value_shape([360,100,100]), 'ARRAY', 'check HSB values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "HSB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "HSB got too many values"); is( ref $space->check_value_shape([-1, 0, 0]), '', "hue value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "hue is not integer"); is( ref $space->check_value_shape([361, 0, 0]), '', "hue value is too big"); is( ref $space->check_value_shape([0, -1, 0]), '', "saturation value is too small"); is( ref $space->check_value_shape([0, 1.1, 0]), '', "saturation value is not integer"); is( ref $space->check_value_shape([0, 101, 0]), '', "saturation value is too big"); is( ref $space->check_value_shape([0, 0, -1 ] ), '', "brightness value is too small"); is( ref $space->check_value_shape([0, 0, 1.1] ), '', "brightness value is not integer"); is( ref $space->check_value_shape([0, 0, 101] ), '', "brightness value is too big"); my $hsb = $space->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 = $space->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 = $space->clamp([-1.1,-1,101,4]); is( int @$hsb, 3, 'removed superfluous value'); is( $hsb->[0], 358.9, '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 = $space->convert_from( 'RGB', [0.5, 0.5, 0.5]); is( int @$hsb, 3, 'convert grey to HSB'); is( $hsb->[0], 0, 'right hue value'); is( $hsb->[1], 0, 'right saturation'); is( $hsb->[2], 0.5, 'right brightness'); my $rgb = $space->convert_to( 'RGB', [0, 0, 0.5]); is( int @$rgb, 3, 'converted grey from HSB to RGB'); is( $rgb->[0], 0.5, 'right red value'); is( $rgb->[1], 0.5, 'right green value'); is( $rgb->[2], 0.5, 'right blue value'); $rgb = $space->convert_to( 'RGB', [0.972222222, 0.9, 0.78]); is( int @$rgb, 3, 'convert red from HSB into RGB'); is( $rgb->[0], 0.78, 'right red value'); is( $rgb->[1], 0.078, 'right green value'); is( round_decimals($rgb->[2], 5), 0.195, 'right blue value'); $hsb = $space->convert_from( 'RGB', [0.78, 0.078, 0.195000000023]); is( int @$hsb, 3, 'convert nice blue to HSB'); is( round_decimals($hsb->[0], 5), 0.97222, 'right hue value'); is( $hsb->[1], .9, 'right saturation'); is( $hsb->[2], .78, 'right brightness'); $rgb = $space->convert_to( 'RGB', [0.76666, .83, .24]); is( int @$rgb, 3, 'convert dark vilet from HSB to RGB'); is( round_decimals($rgb->[0], 5), 0.16031, 'red value correct'); is( round_decimals($rgb->[1], 5), 0.0408, 'green value correct'); is( round_decimals($rgb->[2], 5), 0.24, 'blue value correct'); $hsb = $space->convert_from( 'RGB', [0.160312032, 0.0408, .24]); is( int @$hsb, 3, 'convert dark violet from RGB to HSB'); is( round_decimals($hsb->[0], 5),0.76666, 'right hue value'); is( round_decimals($hsb->[1], 5), .83, 'right saturation'); is( round_decimals($hsb->[2], 5), .24, 'right brightness'); is( $space->format([240, 88, 0], 'css_string'), 'hsb(240, 88%, 0%)', 'converted tuple into css string'); is( $space->format([240, 88, 0], 'css_string', ''), 'hsb(240, 88, 0)', 'converted tuple into css string without suffixes'); exit 0; 23_hwb_space.t100644001750001750 1256115055140237 21243 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 62; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::HWB'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'HWB', 'color space has axis initials as name'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('HwB'), 1, 'recognized name'); is( $space->is_name('Hsl'), 0, 'ignored wrong name'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check HWB values works on lower bound values'); is( ref $space->check_value_shape([360,100,100]), 'ARRAY', 'check HWB values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "HWB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "HWB got too many values"); is( ref $space->check_value_shape([-1, 0, 0]), '', "hue value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "hue is not integer"); is( ref $space->check_value_shape([361, 0, 0]), '', "hue value is too big"); is( ref $space->check_value_shape([0, -1, 0]), '', "whiteness value is too small"); is( ref $space->check_value_shape([0, 1.1, 0]), '', "whiteness value is not integer"); is( ref $space->check_value_shape([0, 101, 0]), '', "whiteness value is too big"); is( ref $space->check_value_shape([0, 0, -1 ] ), '', "blackness value is too small"); is( ref $space->check_value_shape([0, 0, 1.1] ), '', "blackness value is not integer"); is( ref $space->check_value_shape([0, 0, 101] ), '', "blackness value is too big"); my $val = $space->round([1,22.5, 11.111111]); is( ref $val, 'ARRAY', 'rounded value tuple int tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 1, 'first value kept'); is( $val->[1], 23, 'second value rounded up'); is( $val->[2], 11, 'third value rounded down'); my $rgb = $space->convert_to( 'RGB', [0.83333, 0, 1]); # 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'); my $hwb = $space->convert_from( 'RGB', [ .5, .5, .5]); 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'); $rgb = $space->convert_to( 'RGB', [0, 0.5, .5]); 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 = $space->convert_from( 'RGB', [210/255, 20/255, 70/255]); is( int @$hwb, 3, 'convert nice magenta from RGB to HWB'); is( round_decimals( $hwb->[0],5), 0.95614, 'right hue value'); is( round_decimals( $hwb->[1],5), 0.07843, 'right whiteness'); is( round_decimals( $hwb->[2],5), 0.17647, 'right blackness'); $rgb = $space->convert_to( 'RGB', [0.956140350877193, 0.0784313725490196, 0.176470588235294]); is( int @$rgb, 3, 'converted back nice magenta'); is( round_decimals( $rgb->[0], 5), 0.82353, 'right red value'); is( round_decimals( $rgb->[1], 5), 0.07843, 'right green value'); is( round_decimals( $rgb->[2], 5), round_decimals(70/255, 5), 'right blue value'); $val = $space->form->remove_suffix([qw/360 100% 100%/]); is( ref $val, 'ARRAY', 'value tuple without suffixes is a tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 360, 'first value is right'); is( $val->[1], 100, 'second value right'); is( $val->[2], 100, 'third value right'); $val = $space->deformat('hwb(240, 88%, 22%)'); is( ref $val, 'ARRAY', 'deformated CSS string into value tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 240, 'first value is right'); is( $val->[1], 88, 'second value right'); is( $val->[2], 22, 'third value right'); $val = $space->deformat('hwb(240, 88, 22)'); is( ref $val, 'ARRAY', 'deformated CSS string without suffix into value tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 240, 'first value is right'); is( $val->[1], 88, 'second value right'); is( $val->[2], 22, 'third value right'); is( $space->format([240, 88, 22], 'css_string'), 'hwb(240, 88%, 22%)', 'converted tuple into css string'); is( $space->format([240, 88, 22], 'css_string', ''), 'hwb(240, 88, 22)', 'converted tuple into css string without suffixes'); exit 0; 60_space_hub.t100644001750001750 536315055140237 21224 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 60; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Hub'; my $space_ref = 'Graphics::Toolkit::Color::Space'; eval "use $module"; is( not($@), 1, 'could load the module'); is( ref Graphics::Toolkit::Color::Space::Hub::get_space('RGB'), $space_ref, 'RGB is a color space'); is( Graphics::Toolkit::Color::Space::Hub::is_space_name($_), 1, "found $_ color space") for qw /RGB CMY CMYK HSL HSv HSB HWB NCol YIQ YUV CIEXYZ CIELAB CIELUV CIELCHab CIELCHuv OKLAB OKLCH HunterLAB/; my @names = Graphics::Toolkit::Color::Space::Hub::all_space_names(); is( int @names, 24, 'intalled 21 space names'); is( Graphics::Toolkit::Color::Space::Hub::is_space_name($_), 1, "$_ is a space name") for @names; my $Tspace = Graphics::Toolkit::Color::Space->new( axis => [qw/one two three/], range => 10 ); $Tspace->add_converter( 'RGB', \&p, \&p ); sub p { @{$_[0]} } my $ret = Graphics::Toolkit::Color::Space::Hub::add_space( $Tspace ); is( $ret, 1, "could add test color space"); is( Graphics::Toolkit::Color::Space::Hub::is_space_name('OTT'), 1, 'test space was installed'); is( Graphics::Toolkit::Color::Space::Hub::get_space('OTT'), $Tspace, 'got access to test space'); @names = Graphics::Toolkit::Color::Space::Hub::all_space_names(); is( int @names, 25, 'intalled 21st space name'); is( ref Graphics::Toolkit::Color::Space::Hub::remove_space('TTT'), '', 'try to delete unknown space'); is( ref Graphics::Toolkit::Color::Space::Hub::remove_space('OTT'), $space_ref, 'removed test space'); is( Graphics::Toolkit::Color::Space::Hub::is_space_name('OTT'), 0, 'test space is gone'); is( Graphics::Toolkit::Color::Space::Hub::get_space('OTT'), '', 'no access to test space'); is( ref Graphics::Toolkit::Color::Space::Hub::remove_space('OTT'), '', 'test space was already removed'); is( Graphics::Toolkit::Color::Space::Hub::is_space_name('OTT'), 0, 'test space is still gone'); @names = Graphics::Toolkit::Color::Space::Hub::all_space_names(); is( int @names, 24, 'intalled again only 20 space names'); my $rgb_name = Graphics::Toolkit::Color::Space::Hub::default_space_name(); is( Graphics::Toolkit::Color::Space::Hub::is_space_name($rgb_name), 1, 'default space name is valid'); is( ref Graphics::Toolkit::Color::Space::Hub::get_space($rgb_name), $space_ref, 'can get default space'); is( ref Graphics::Toolkit::Color::Space::Hub::default_space(), $space_ref, 'default space is a space'); my %sn = map {$_ => 1} @names; is( $sn{$rgb_name}, 1 , 'default space is among color spaces'); ######################################################################## exit 0; 01_space_util.t100644001750001750 1233415055140237 21432 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 61; 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_int; 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 below -0.5 gets also lowered'); is( $round->(-0.4999999), 0, 'everything upward from -0.5 gets increased'); is( $round->( 1.4999999), 1, 'positive rounding works above 1'); is( $round->(-1.4999999), -1, 'negative rounding works below 1'); my $rd = \&Graphics::Toolkit::Color::Space::Util::round_decimals; is( $rd->( 1.4999999), 1, 'positive rounding works above 1 with round 2'); is( $rd->(-1.4999999), -1, 'negative rounding works below 1 with round 2'); is( $rd->( 1.4999999, 0), 1, 'positive rounding with no decimals'); is( $rd->(-1.4999999, 0), -1, 'negative rounding with no decimals'); is( $rd->( 1.4999999, 1), 1.5, 'positive rounding with one decimal'); is( $rd->(-1.4999999, 1), -1.5, 'negative rounding with one decimal'); is( $rd->( 1.4999999, 2), 1.5, 'positive rounding with one decimal'); is( $rd->(-1.4999999, 2), -1.5, 'negative rounding with one decimal'); my $rmod = \&Graphics::Toolkit::Color::Space::Util::mod_real; 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( $rmod->(-3, 2), -1, 'int mod with negative dividend'); is( $rmod->(3, -2), 1, 'int mod with negative divisor'); is( $rmod->(-3, -2), -1, 'int mod with negative divisor'); my $min = \&Graphics::Toolkit::Color::Space::Util::min; is( $min->(), undef, 'undef is default for min'); is( $min->(1,2), 1, 'min works in trivial example'); is( $min->(2,1), 1, "element order doesn't matter"); is( $min->(1,1,1), 1, 'min selects from existing'); is( $min->(0,1,2), 0, 'no issues with zero'); is( $min->(-3,1,-1, 2,-1), -3, 'same vlues do not confuse'); is( $min->(-1.1,2,3), -1.1, 'negative minimum'); my $max = \&Graphics::Toolkit::Color::Space::Util::max; is( $max->(), undef, 'undef is default for max'); is( $max->(1,2), 2, 'min works in trivial example'); is( $max->(2,1), 2, "element order doesn't matter"); is( $max->(1,1,1), 1, 'min selects from existing'); is( $max->(-3,1,-1, 2,-1), 2, 'same vlues do not confuse'); is( $max->(-1,-10, 0, -2), 0, 'no issues with zero'); is( $max->(-1,2,10E3), 10000, 'any syntax maximum'); my $uniq = \&Graphics::Toolkit::Color::Space::Util::uniq; is( $uniq->(), undef, 'undef is default for uniq'); my @list = $uniq->(1,2,3,4); is( int @list, 4, 'passed normal lsit with uniq elements'); is( $list[0], 1, 'first element right'); is( $list[1], 2, 'second element right'); is( $list[2], 3, 'third element right'); is( $list[3], 4, 'uniq doesnt chang order'); @list = $uniq->(5,2,5,2,5); is( int @list, 2, 'deleted all none uniq elements'); is( $list[0], 5, 'first element right'); is( $list[1], 2, 'second element right'); @list = $uniq->(0,0,0,0); is( int @list, 1, 'dleted all none uniq elements'); is( $list[0], 0, 'no issues with zero'); my $MM = \&Graphics::Toolkit::Color::Space::Util::mult_matrix_vector_3; my @rv = $MM->([[1,2,3],[1,2,3],[1,2,3],], 0,0,0); is( int @rv, 3, 'result of matrix multiplication has length of 3'); is( $rv[0], 0, 'first value of matrix multiplication result is 0'); is( $rv[1], 0, 'second value of matrix multiplication result is 0'); is( $rv[2], 0, 'third value of matrix multiplication result is 0'); @rv = $MM->([[1,0,0],[0,1,0],[0,0,1],], 1.1,2.2,3.3); is( int @rv, 3, 'result of identitiy multiplication has length of 3'); is( $rv[0], 1.1, 'first value of identitiy multiplication result is 1.1'); is( $rv[1], 2.2, 'second value of identitiy multiplication result is 2.2'); is( $rv[2], 3.3, 'third value of identitiy multiplication result is 3.3'); @rv = $MM->([[1,2,3],[4,5,6],[7,8,9],], 0, 2, 1.1); is( int @rv, 3, 'result of full multiplication has length of 3'); is( $rv[0], 7.3, 'first value of full multiplication result is 7.3'); is( $rv[1], 16.6, 'second value of full multiplication result is 16.6'); is( $rv[2], 25.9, 'third value of full multiplication result is 25.9'); exit 0; 12_cmyk_space.t100644001750001750 1215415055140237 21422 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 66; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Instance::CMYK'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'CMYK', 'color space has right name'); is( $space->alias, '', 'color space has no alias name'); is( $space->axis_count, 4, 'color space has 4 axis'); is( ref $space->check_value_shape( [0,0,0, 0]), 'ARRAY', 'check CMYK values works on lower bound values'); is( ref $space->check_value_shape( [1, 1, 1, 1]), 'ARRAY', 'check CMYK values works on upper bound values'); is( ref $space->check_value_shape( [0,0,0]), '', "CMYK got too few values"); is( ref $space->check_value_shape( [0, 0, 0, 0, 0]), '', "CMYK got too many values"); is( ref $space->check_value_shape( [-1, 0, 0, 0]), '', "cyan value is too small"); is( ref $space->check_value_shape( [2, 0, 0, 0]), '', "cyan value is too big"); is( ref $space->check_value_shape( [0, -1, 0, 0]), '', "magenta value is too small"); is( ref $space->check_value_shape( [0, 2, 0, 0]), '', "magenta value is too big"); is( ref $space->check_value_shape( [0, 0, -1, 0 ] ), '', "yellow value is too small"); is( ref $space->check_value_shape( [0, 0, 2, 0] ), '', "yellow value is too big"); is( ref $space->check_value_shape( [0, 0, 0, -1] ), '', "key value is too small"); is( ref $space->check_value_shape( [0, 0, 0, 2] ), '', "key value is too big"); my $cmyk = $space->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 = $space->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 = $space->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 = $space->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 = $space->convert_from( 'RGB', [0.5, 0.5, 0.5]); 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 = $space->convert_to( 'RGB', [0, 0, 0, 0.5]); 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 = $space->convert_from( 'RGB', [0.3, 0.4, 0.5]); 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 = $space->convert_to( 'RGB', [0.4, 0.2, 0, 0.5]); 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 = $space->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 = $space->deformat(['CMYK', 11, 22, 33]); is( $cmyk, undef, 'OO deformat reacts only to right amount of values'); $cmyk = $space->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; 24_ncol_space.t100644001750001750 1477315055140237 21426 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 80; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::NCol'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'NCOL', 'color space has user set name'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('NCol'), 1, 'color space name NCol is correct'); is( $space->is_name('hwb'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'color space has 3 axis'); is( $space->is_value_tuple([0,0,0]), 1, 'value tuple has 3 elements'); is( $space->is_partial_hash({whiteness => 1, blackness => 0}), 1, 'found hash with some axis name'); is( $space->is_partial_hash({what => 1, blackness => 0}), 0, 'found hash with a bad axis name'); is( $space->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $space->can_convert('ncol'), 0, 'can not convert to itself'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check HWB values works on lower bound values'); is( ref $space->check_value_shape([600,100,100]), 'ARRAY', 'check HWB values works on upper bound values'); is( ref $space->check_value_shape([0,0]), '', "HWB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "HWB got too many values"); is( ref $space->check_value_shape([-1, 0, 0]), '', "hue value is too small"); is( ref $space->check_value_shape([1.1, 0, 0]), '', "hue is not integer"); is( ref $space->check_value_shape([601, 0, 0]), '', "hue value is too big"); is( ref $space->check_value_shape([0, -1, 0]), '', "whiteness value is too small"); is( ref $space->check_value_shape([0, 1.1, 0]), '', "whiteness value is not integer"); is( ref $space->check_value_shape([0, 101, 0]), '', "whiteness value is too big"); is( ref $space->check_value_shape([0, 0, -1 ] ), '', "blackness value is too small"); is( ref $space->check_value_shape([0, 0, 1.1] ), '', "blackness value is not integer"); is( ref $space->check_value_shape([0, 0, 101] ), '', "blackness value is too big"); is( $space->format([0,0,0], 'css_string'), 'ncol(R0, 0%, 0%)', 'can format css string with zeroes'); is( $space->format([212,34,56], 'css_string'), 'ncol(G12, 34%, 56%)', 'can format css string'); is( $space->format([600, 100, 0], 'css_string'), 'ncol(R0, 100%, 0%)', 'converted tuple into css string'); is( $space->format([600, 100, 0], 'css_string', ''), 'ncol(R0, 100, 0)', 'converted tuple into css string without suffixes'); my $val = $space->deformat('ncol(R00, 0%, 0%)'); is( ref $val, 'ARRAY', 'deformated CSS string into tuple (ARRAY)'); is( int @$val, 3, 'deformated value triplet (tuple)'); is( $val->[0], 0, 'first value good'); is( $val->[1], 0, 'second value good'); is( $val->[2], 0, 'third value good'); $val = $space->deformat('ncol(R0, 0%, 0%)'); is( int @$val, 3, 'one digit color values work too'); $val = $space->deformat('NCOL: G12, 34%, 56%'); is( ref $val, 'ARRAY', 'deformated CSS string into tuple (ARRAY)'); is( int @$val, 3, 'deformated value triplet (tuple)'); is( $val->[0], 212, 'first value good'); is( $val->[1], 34, 'second value good'); is( $val->[2], 56, 'third value good'); $val = $space->deformat('ncol(G12, 34%, 56.1%)'); is( ref $val, '', 'can not deformat with CSS string with ill formatted values'); $val = $space->deformat(['NCol', 'B20', '31%', '15']); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple (ARRAY)'); is( int @$val, 3, 'deformated into value triplet (tuple)'); is( $val->[0], 420, 'first value good'); is( $val->[1], 31, 'second value good'); is( $val->[2], 15, 'third value good'); $val = $space->clamp([700,1.1,-2]); is( ref $val, 'ARRAY', 'clampd value tuple into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 100, 'first value rotated in'); is( $val->[1], 1.1, 'second value rounded'); is( $val->[2], 0, 'third value clamped up'); $val = $space->round([1,22.5, 11.111111]); is( ref $val, 'ARRAY', 'rounded value tuple into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 1, 'first value kept'); is( $val->[1], 23, 'second value rounded up'); is( $val->[2], 11, 'third value rounded down'); my $rgb = $space->convert_to( 'RGB', [0.83333, 0, 1]); # should become black despite color value is( int @$rgb, 3, 'convert black from NCol to RGB'); is( $rgb->[0], 0, 'right red value'); is( $rgb->[1], 0, 'right green value'); is( $rgb->[2], 0, 'right blue value'); my $hwb = $space->convert_from( 'RGB', [ 0, 0, 0]); is( int @$hwb, 3, 'convert black from RGB to NCol'); is( $hwb->[0], 0, 'right hue value'); is( $hwb->[1], 0, 'right whiteness'); is( $hwb->[2], 1, 'right blackness'); $rgb = $space->convert_to( 'RGB', [0, 0.5, .5]); is( int @$rgb, 3, 'convert grey from NCol to RGB'); is( $rgb->[0], 0.5, 'right red value'); is( $rgb->[1], 0.5, 'right green value'); is( $rgb->[2], 0.5, 'right blue value'); $hwb = $space->convert_from( 'RGB', [ .5, .5, .5]); is( int @$hwb, 3, 'convert grey from RGB to NCol'); is( $hwb->[0], 0, 'right hue value'); is( $hwb->[1], .5, 'right whiteness'); is( $hwb->[2], .5, 'right blackness'); $hwb = $space->convert_from( 'RGB', [210/255, 20/255, 70/255]); is( int @$hwb, 3, 'convert nice magenta from RGB to NCol'); is( round_decimals( $hwb->[0], 5), 0.95614, 'right hue value'); is( round_decimals( $hwb->[1], 5), 0.07843, 'right whiteness'); is( round_decimals( $hwb->[2], 5), 0.17647, 'right blackness'); $rgb = $space->convert_to( 'RGB', [0.956140350877193, 0.0784313725490196, 0.176470588235294]); is( int @$rgb, 3, 'converted back nice magenta'); is( round_decimals( $rgb->[0],5), 0.82353, 'right red value'); is( round_decimals( $rgb->[1],5), 0.07843, 'right green value'); is( round_decimals( $rgb->[2],5), round_decimals(70/255, 5), 'right blue value'); exit 0; 02_space_basis.t100644001750001750 3577115055140237 21571 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 157; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Basis'; eval "use $module"; is( not($@), 1, 'could load the module'); #### basic construction ################################################ is( ref Graphics::Toolkit::Color::Space::Basis->new(), '', 'constructor needs arguments'); is( ref Graphics::Toolkit::Color::Space::Basis->new([1]), $module, 'one constructor argument is enough'); my $bad = Graphics::Toolkit::Color::Space::Basis->new(qw/Aleph beth gimel daleth he/); my $odd = Graphics::Toolkit::Color::Space::Basis->new([qw/Aleph beth gimel daleth he/], [qw/m n p q/]); 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/]); like( $bad, qr/first argument/, 'need axis name array as first argument'); like( $odd, qr/shortcut names/, 'need same amount axis names and shortcuts'); is( ref $s3d, $module, 'created 3d space'); is( ref $s5d, $module, 'created 5d space'); #### getter ############################################################ is( $s3d->axis_count, 3, 'did count three args'); is( $s5d->axis_count, 5, 'did count five args'); is( ($s3d->axis_iterator)[ 0], 0, 'correct first value of 0..2 iterator'); is( ($s3d->axis_iterator)[-1], 2, 'correct last value of 0..2 iterator'); is( ($s5d->axis_iterator)[ 0], 0, 'correct first value of 0..4 iterator'); is( ($s5d->axis_iterator)[-1], 4, 'correct last value of 0..4 iterator'); is( int($s3d->long_axis_names) == $s3d->axis_count, 1, 'right amount of long names in 3d color space'); is( int($s3d->short_axis_names) == $s3d->axis_count, 1, 'right amount of short names in 3d color space'); is( int($s5d->long_axis_names) == $s5d->axis_count, 1, 'right amount of long names for 5d'); is( int($s5d->short_axis_names) == $s5d->axis_count, 1, 'right amount of short names for 5d'); is( ($s3d->long_axis_names)[0], 'alpha', 'repeat first 3d key back'); is( ($s3d->long_axis_names)[-1], 'gamma', 'repeat last 5d key back'); is( ($s5d->long_axis_names)[0], 'aleph', 'repeat first 3d key back'); is( ($s5d->long_axis_names)[-1], 'he', 'repeat last 5d key shortcut back'); is( ($s3d->short_axis_names)[0], 'a', 'repeat first 3d key shortcut back'); is( ($s3d->short_axis_names)[-1], 'g', 'repeat last 5d key shortcut back'); is( ($s5d->short_axis_names)[0], 'm', 'repeat first 3d key shortcut back'); is( ($s5d->short_axis_names)[-1], 'q', 'repeat last 5d key shortcut back'); is( $s3d->space_name, 'ABG', 'correct name from 3 initials'); is( $s3d->alias_name, '', 'ABG space has no alias, because its not auto generated'); is( $s5d->space_name, 'MNOPQ', 'correct name from 5 initials'); is( $s3d->is_long_axis_name('Alpha'), 1, 'found key alpha'); is( $s3d->is_long_axis_name('zeta'), 0, 'not found made up key zeta'); is( $s5d->is_long_axis_name('gimel'), 1, 'found key gimel'); is( $s5d->is_long_axis_name('lamed'), 0, 'not found made up key lamed'); is( $s3d->is_short_axis_name('G'), 1, 'found key shortcut g'); is( $s3d->is_short_axis_name('e'), 0, 'not found made up key shortcut e'); is( $s5d->is_short_axis_name('P'), 1, 'found key shortcut H'); is( $s5d->is_short_axis_name('l'), 0, 'not found made up key shortcut l'); is( $s3d->is_axis_name('Alpha'), 1, 'alpha is a key'); is( $s3d->is_axis_name('A'), 1, 'a is a shortcut'); is( $s3d->is_axis_name('Cen'), 0, 'Cen is not a key'); is( $s3d->is_axis_name('C'), 0, 'c is not a shortcut'); is( $s3d->is_value_tuple({}), 0, 'HASH is not an ARRAY'); is( $s3d->is_value_tuple([]), 0, 'empty ARRAY has not enogh content'); is( $s3d->is_value_tuple([2,2]), 0, 'too small ARRAY'); is( $s3d->is_value_tuple([1,2,3,4]), 0, 'too large ARRAY'); is( $s3d->is_value_tuple([1,2,3]), 1, 'correctly sized value ARRAY'); is( $s3d->is_number_tuple([1,2,3]), 1, 'correct tuple of numbers only'); is( $s3d->is_number_tuple(['a',2,3]), 0, 'cought not a number on first position'); is( $s3d->is_number_tuple([1,'-',3]), 0, 'cought not a number on second position'); is( $s3d->is_number_tuple([1,2,'A']), 0, 'cought not a number on third position'); is( $s3d->pos_from_long_axis_name('alpha'), 0, 'alpha name of first axis'); is( $s3d->pos_from_long_axis_name('beta'), 1, 'beta is name of second axis'); is( $s3d->pos_from_long_axis_name('emma'), undef, 'emma is not an axis name'); is( $s5d->pos_from_long_axis_name('aleph'), 0, 'aleph is the first name'); is( $s5d->pos_from_long_axis_name('he'), 4, 'he is the fourth name'); is( $s5d->pos_from_long_axis_name('emma'), undef, 'emma is not an axis name'); is( $s3d->pos_from_short_axis_name('a'), 0, 'a is shortcut name of first axis'); is( $s3d->pos_from_short_axis_name('b'), 1, 'b is shortcut name of second axis'); is( $s3d->pos_from_short_axis_name('e'), undef, 'e is not an axis shortcut name'); is( $s5d->pos_from_short_axis_name('m'), 0, 'a is the first specially set shortcut name of 5d space'); is( $s5d->pos_from_short_axis_name('q'), 4, 'q is the fourth specially set shortcut name of 5d space'); is( $s5d->pos_from_short_axis_name('g'), undef, 'g is not an axis shortcut name of 5d space'); is( $s3d->short_axis_name_from_long('alpha'), 'a', 'a is short for alpha'); is( $s3d->short_axis_name_from_long('BETA'), 'b', 'upper case axis name recognized'); is( $s3d->short_axis_name_from_long('emma'), undef, 'emma is not a an axis name and there fore has no shortcut'); is( $s5d->short_axis_name_from_long('He'), 'q', 'custom shortcut provided'); is( $s3d->long_axis_name_from_short('a'), 'alpha', 'alpha is long axis name for shortcut a'); is( $s3d->long_axis_name_from_short('B'), 'beta', 'upper case shortcut recognized'); is( $s3d->long_axis_name_from_short('e'), undef, 'e is not a a shortcut axis name: there is no full name'); is( $s5d->long_axis_name_from_short('q'), 'he', 'long axis name from custom shortcut'); 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, B => 3 }), 0, 'value hash has same key twice'); is( $s3d->is_hash({a => 1, b => 1, g => 3, h => 4}), 0, 'value hash has too many keys key'); is( $s3d->is_hash({a => 1, b => 1, h => 4}), 0, 'value hash has one wrong key'); 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, 'string is not a partial hash'); is( $s5d->is_partial_hash([]), 0, 'array is not a partial hash'); is( $s5d->is_partial_hash({}), 0, 'empty hash is not a partial hash'); is( $s5d->is_partial_hash({gamma => 1}), 0, 'wrong key for 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( ref $s3d->short_name_hash_from_tuple([1,2,3]), 'HASH', 'HASH with given values and shortcut keys created'); is( ref $s3d->short_name_hash_from_tuple([1,2,3,4]), '', 'HASH not created because too many arguments'); is( ref $s3d->short_name_hash_from_tuple([1,2]), '', 'HASH not created because not enough arguments'); is( $s3d->short_name_hash_from_tuple([1,2,3])->{'a'}, 1, 'right value under "a" key in the converted hash'); is( $s3d->short_name_hash_from_tuple([1,2,3])->{'b'}, 2, 'right value under "b" key in the converted hash'); is( $s3d->short_name_hash_from_tuple([1,2,3])->{'g'}, 3, 'right value under "g" key in the converted hash'); is( int keys %{$s3d->short_name_hash_from_tuple([1,2,3])},3, 'right amount of shortcut keys'); is( ref $s5d->long_name_hash_from_tuple([1,2,3,4,5]),'HASH', 'HASH with given values and full name keys created'); is( ref $s5d->long_name_hash_from_tuple([1,2,3,4,5,6]), '', 'HASH not created because too many arguments'); is( ref $s5d->long_name_hash_from_tuple([1,2,3,4]), '', 'HASH not created because not enough arguments'); is( $s5d->long_name_hash_from_tuple([1,2,3,4,5])->{'aleph'}, 1, 'right value under "aleph" key in the converted hash'); is( $s5d->long_name_hash_from_tuple([1,2,3,4,5])->{'beth'}, 2, 'right value under "beta" key in the converted hash'); is( $s5d->long_name_hash_from_tuple([1,2,3,4,5])->{'gimel'}, 3, 'right value under "gimel" key in the converted hash'); is( $s5d->long_name_hash_from_tuple([1,2,3,4,5])->{'daleth'}, 4, 'right value under "daleth" key in the converted hash'); is( $s5d->long_name_hash_from_tuple([1,2,3,4,5])->{'he'}, 5, 'right value under "he" key in the converted hash'); is( int keys %{$s5d->long_name_hash_from_tuple([1,2,3,4,5])}, 5, 'right amount of shortcut keys'); my $tuple = $s5d->tuple_from_hash( {aleph => 1, beth => 2, gimel => 3, daleth => 4, he => 5} ); is( ref $tuple, 'ARRAY', 'got ARRAY ref from method tuple_from_hash'); is( int @$tuple, 5, 'right of values extracted keys'); is( $tuple->[0], 1, 'first extracted value is correct'); is( $tuple->[1], 2, 'second extracted value is correct'); is( $tuple->[2], 3, 'third extracted value is correct'); is( $tuple->[3], 4, 'fourth extracted value is correct'); is( $tuple->[4], 5, 'fifth extracted value is correct'); $tuple = $s5d->tuple_from_hash( {aleph => 1, beth => 2, O => 3, daleth => 4, y => 5} ); is( ref $tuple, '', 'no values extraced because one key was wrong'); is( $s3d->select_tuple_value_from_axis_name('alpha', [1,2,3]), 1, 'got correct first value from list by key'); is( $s3d->select_tuple_value_from_axis_name('beta', [1,2,3]), 2, 'got correct second value from list by key'); is( $s3d->select_tuple_value_from_axis_name('gamma', [1,2,3]), 3, 'got correct third value from list by key'); is( $s3d->select_tuple_value_from_axis_name('he', [1,2,3]), undef,'get undef when asking with unknown key'); is( $s3d->select_tuple_value_from_axis_name('alpha', [1,2 ]), undef,'get undef when giving not enough values'); is( $s3d->select_tuple_value_from_axis_name('a', [1,2,3]), 1, 'got correct first value from list by shortcut'); is( $s3d->select_tuple_value_from_axis_name('b', [1,2,3]), 2, 'got correct second value from list by shortcut'); is( $s3d->select_tuple_value_from_axis_name('g', [1,2,3]), 3, 'got correct third value from list by shortcut'); is( $s3d->select_tuple_value_from_axis_name('h', [1,2,3]), undef, 'get undef when asking with unknown key'); is( $s3d->select_tuple_value_from_axis_name('a ',[1,2 ]), undef, 'get undef when giving not enough values'); is( ref $s3d->tuple_from_partial_hash(), '', 'partial deformat needs an HASH'); is( $s3d->tuple_from_partial_hash({}), undef, 'partial deformat needs an not empty HASH'); is( $s3d->tuple_from_partial_hash({a=>1,b=>1,g=>1,k=>1}), undef, 'partial HASH is too long'); is( ref $s3d->tuple_from_partial_hash({a=>1,b=>2,g=>3}), 'ARRAY', 'partial HASH has all the keys'); my $ph = $s3d->tuple_from_partial_hash({Alpha=>1,b=>2,g=>3}); is( ref $ph, 'ARRAY', 'deparse all keys with mixed case and shortcut'); is( int @$ph, 3, 'right amount of values in deparsed hash'); 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'); $ph = $s3d->tuple_from_partial_hash({gamma => 3}); is( ref $ph, 'ARRAY', 'deparse just one key with mixed case and shortcut'); is( int @$ph, 3, 'right amount of values in deparsed hash'); is( $ph->[0], undef, 'first position in ARRAY is empty'); is( $ph->[0], undef, 'second position in ARRAY is empty'); is( $ph->[2], 3, 'third and only key has right value'); $ph = $s3d->tuple_from_partial_hash({alda => 3}); is( ref $ph, '', 'wrong keys to be partial hash'); $ph = $s5d->tuple_from_partial_hash({Aleph => 6, p => 5}); is( ref $ph, 'ARRAY', 'deparse just two keys with mixed case and shortcut'); is( int @$ph, 4, 'last filled position in ARRAY is Nr. 4'); is( $ph->[0], 6, 'first key aleph has right value'); is( $ph->[1], undef, 'second key was omitted'); is( $ph->[2], undef, 'third key was omitted'); is( $ph->[3], 5, 'fourth key was set by short axis name p'); is( $ph->[4], undef, 'fifth key was omitted'); my $p5d = Graphics::Toolkit::Color::Space::Basis->new([qw/Aleph beth gimel daleth he/], [qw/m n o p q/], 'name'); is( ref $p5d, $module, 'created space with user set name and user set axis short names'); is( $p5d->space_name, 'NAME', 'space name is user set'); is( $p5d->alias_name, '', 'space name kept empty'); is( $p5d->is_name('mnopq'), 0, 'initials are not an accepted space name'); is( $p5d->is_name('name'), 1, '"name" is an accepted space name'); my $p5p = Graphics::Toolkit::Color::Space::Basis->new([qw/Aleph beth gimel daleth he/], [qw/m n o p q/], undef, 'alias'); is( ref $p5p, $module, 'created space with name prefix and user set axis short names'); is( $p5p->space_name, 'MNOPQ', 'space name are initials'); is( $p5p->alias_name, 'ALIAS', 'space name alias is user set'); is( $p5p->is_name('mnopq'), 1, '"mnopq" is an accepted space name'); is( $p5p->is_name('alias'), 1, '"alias" is an accepted space name'); my $p5pn = Graphics::Toolkit::Color::Space::Basis->new([qw/Aleph beth gimel daleth he/], [qw/m n o p q/], 'name', 'alias'); is( $p5pn->space_name, 'NAME', 'got correct name with prefix'); is( $p5pn->alias_name, 'ALIAS', 'got user set alias name'); is( $p5pn->is_name('name'), 1, '"name" is an accepted space name'); is( $p5pn->is_name('alias'), 1, '"alias" is an accepted space name'); exit 0; 03_space_shape.t100644001750001750 4154215055140237 21562 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 183; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Shape'; eval "use $module"; is( not($@), 1, 'could load the module'); 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/] ); my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis); is( ref $shape, $module, 'created shape with default settings'); my $values; #### invalid args ###################################################### like( Graphics::Toolkit::Color::Space::Shape->new( $basis, {}), qr/invalid axis type/, 'type definition needs to be an ARRAY'); like( Graphics::Toolkit::Color::Space::Shape->new( $basis, []), qr/invalid axis type/, 'type definition needs to have same length'); like( Graphics::Toolkit::Color::Space::Shape->new( $basis, ['yes','no','maybe']), qr/invalid axis type/, 'undefined values'); like( Graphics::Toolkit::Color::Space::Shape->new( $basis, [1,2,3]), qr/invalid axis type/, 'undefined numeric values'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, ['linear','circular','no']), $module, 'valid type def'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, {}), '', 'range definition needs to be an ARRAY'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 1), $module, 'uniform scalar range'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 'normal'), $module, 'normal scalar range'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 'percent'), $module, 'percent scalar range'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, []), '', 'range definition ARRAY has to have same lngth'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [1,2,3]), $module, 'ARRAY range with right amount of ints'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2],[1,2]]), $module, 'full ARRAY range'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1.1,1.2],[1,2]]), $module, 'full ARRAY range with decimals'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2]]), '', 'not enough elements in range def'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2],[1,2],[1,2]]), '', 'too many elements in range def'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[2,1],[1,2]]), '', 'one range def element is backward'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1],[1,2]]), '', 'one range def element is too small'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,2,3],[1,2]]), '', 'one range def element is too big'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[1,2],[1,'-'],[1,2]]), '', 'one range def element has a none number'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, 0), $module, 'accepting third constructor arg - precision zero'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, 2), $module, 'precision 2'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, -1), $module, 'precision -1'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, [0,1,-1]), $module, 'full precision def'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, [1,2]), '', 'precision def too short'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, [1,2,3,-1]), '', 'precision def too long'); is( ref Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, undef, '%'), $module, 'accepting fourth constructor arg - a suffix for axis numbers'); #### arg eval + getter ################################################# $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, ['angular','linear','no']); is( ref $shape, $module, 'created shape with all axis types'); is( $shape->is_linear, 0, 'space has none linear axis'); is( $shape->is_int_valued, 0, 'per default space have full precision'); is( $shape->is_axis_numeric(0), 1, 'first dimension is numeric'); is( $shape->is_axis_numeric(1), 1, 'second dimension is numeric'); is( $shape->is_axis_numeric(2), 0, 'third dimension is not numeric'); is( $shape->is_axis_numeric(3), 0, 'there is no fourth dimension '); $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[0,1],[-1,1],[1,10]]); is( ref $shape, $module, 'created shape with most complex range definition'); is( $shape->is_linear, 1, 'per default spaces are linear'); is( $shape->is_int_valued, 0, 'per default space have full precision'); is( $shape->is_axis_numeric(0), 1, 'default to numeric axis on first dimension'); is( $shape->is_axis_numeric(1), 1, 'default to numeric axis on second dimension'); is( $shape->is_axis_numeric(2), 1, 'default to numeric axis on third dimension'); is( $shape->is_axis_numeric(3), 0, 'there is no fourth dimension'); is( $shape->axis_value_max(0), 1, 'max value of first dimension'); is( $shape->axis_value_max(1), 1, 'max value of second dimension'); is( $shape->axis_value_max(2), 10, 'max value of third dimension'); is( $shape->axis_value_max(3), undef, 'get undef when asking for max of none existing dimension'); is( $shape->axis_value_min(0), 0, 'min value of first dimension'); is( $shape->axis_value_min(1), -1, 'min value of second dimension'); is( $shape->axis_value_min(2), 1, 'min value of third dimension'); is( $shape->axis_value_min(3), undef, 'get undef when asking for min of none existing dimension'); $values = $shape->clamp([0, 1, 10, 1] ); is( ref $values, 'ARRAY', 'clamped in bound values after complex range def'); is( int @$values, 3, 'clamp down to correct tuple length = 3'); is( $values->[0], 0, 'value that touched on lower bound was not altered'); is( $values->[1], 1, 'value that touched on upper bound was not altered'); is( $values->[2], 10, 'value in middle of range was not altered'); $values = $shape->clamp([-.1,1.1] ); is( ref $values, 'ARRAY', 'clamp out of bounds values after complex range def'); is( int @$values, 3, 'filled to correct tuple length = 3'); is( $values->[0], 0, 'value below lower bound was clamped up'); is( $values->[1], 1, 'value above upper bound was clamped down'); is( $values->[2], 1, 'filled in missing value with lower bounds, since 0 is out of range'); $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, undef, [-1,0,1]); is( ref $shape, $module, 'created shape with complex precision definition'); is( $shape->axis_value_precision(0), -1, 'first dimension precision'); is( $shape->axis_value_precision(1), 0, 'second dimension precision'); is( $shape->axis_value_precision(2), 1, 'third dimension precision'); $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, ['angular','linear','no'], undef, [-1,0,1]); is( $shape->axis_value_precision(2), undef, 'third dimension precision does not count (not numeric)'); my $bshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, ['angular', 'circular', 0], [[-5,5],[0,5],[-5,0]], ); is( ref $bshape, $module, 'created 3D bowl shape with -5..5 range'); is( $bshape->axis_value_precision(0), -1, 'first dimension is int on default'); is( $bshape->axis_value_precision(1), -1, 'second dimension is int on default'); is( $bshape->axis_value_precision(2), -1, 'third dimension is int on default'); my $nshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, 'normal'); is( $nshape->axis_value_precision(0) < 0, 1, 'first normal dimension is real because normal'); is( $nshape->axis_value_precision(1) < 0, 1, 'second normal dimension is real because normal'); is( $nshape->axis_value_precision(2) < 0, 1, 'third normal dimension is real because normal'); my $mshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, ['normal', 100, 2], 2); is( $mshape->axis_value_precision(0), 2, 'expanded compact precision to first axis'); is( $mshape->axis_value_precision(1), 2, 'expanded compact precision to second axis'); is( $mshape->axis_value_precision(2), 2, 'expanded compact precision to third axis'); my $oshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[0, 10], [0, 10], [0, 10]], [2, 0, -1]); is( ref $oshape, $module, 'space shape with 0..10 axis and hand set precision'); is( $oshape->axis_value_precision(0), 2, 'first dimension has set precision'); is( $oshape->axis_value_precision(1), 0, 'second dimension has set precision'); is( $oshape->axis_value_precision(2), -1,'third dimension has set precision'); #### check value shape ################################################# is( ref $oshape->check_value_shape(1,2,3), '', 'need array ref, not list'); is( ref $oshape->check_value_shape({}), '', 'need array, not other ref'); is( ref $oshape->check_value_shape([1,2,3]), 'ARRAY', 'all values in range'); is( ref $oshape->check_value_shape([1,2]), '', "not enough values"); is( ref $oshape->check_value_shape([1,2,3,4]), '', "too many values"); is( ref $oshape->check_value_shape([1,22,3]), '', "too big second value"); is( ref $oshape->check_value_shape([1,22,-1]), '', "too small third value"); is( ref $oshape->check_value_shape([0,1.111,3.111]),'',"too many decimals in second value"); #### is_in_linear_bounds ############################################### is( $oshape->is_in_linear_bounds({}), 0, "bad format"); is( $oshape->is_in_linear_bounds([1,2]), 0, "not enough values"); is( $oshape->is_in_linear_bounds([1,2,3,4]), 0, "too many values"); is( $oshape->is_in_linear_bounds([0,10,3.111]), 1, "normal in range values"); is( $oshape->is_in_linear_bounds([-0.1,0,10]), 0, "first value too small"); is( $oshape->is_in_linear_bounds([0,10.1,10]), 0, "second value too large"); is( $oshape->is_in_linear_bounds([10,0,-100]), 0, "third value way too large"); is( $bshape->is_in_linear_bounds([-6,6,1]), 1, "angular dimension can be out out bounds"); is( $shape->is_in_linear_bounds([2,1,2]), 1, "only linear dimension is in bound"); is( $shape->is_in_linear_bounds([2,2,2]), 0, "now linear dimension is out of bound"); #### is_equal ########################################################## is( $shape->is_equal(), 0, 'is_equal needs arguments'); is( $shape->is_equal( 3, [1,2,3] ), 0, 'first tuple has wrong ref'); is( $shape->is_equal( [1,2,3,4], [1,2,3] ), 0, 'first tuple is out of shape'); is( $shape->is_equal( [1,2,3], {} ), 0, 'second tuple has the wrong ref'); is( $shape->is_equal( [1,2,3], [1,2] ), 0, 'second tuple is out of shape'); is( $shape->is_equal( [1,2,3], [1,2,3] ), 1, 'values are equal'); is( $shape->is_equal( [1.111,2,2.999], [1.112,2,3], 2), 1, 'precision definition is held up'); is( $shape->is_equal([1.111,2.13,2.9], [1.112,2.14,3],[2,1,0]), 1, 'complex precision definition is held up'); #### delta ############################################################# my $d = $bshape->delta(1, [1,5,4,5] ); is( ref $d, '', 'reject compute delta on none vector on first arg position'); $d = $shape->delta([1,5,4,5], 1 ); is( ref $d, '', 'reject compute delta on none vector on second arg position'); $d = $shape->delta([2,3,4,5], [1,5,4] ); is( ref $d, '', 'reject compute delta on too long first vector'); $d = $shape->delta([2,3], [1,5,1] ); is( ref $d, '', 'reject compute delta on too short first vector'); $d = $shape->delta([2,3,4], [5,1,4,5] ); is( ref $d, '', 'reject compute delta on too long second vector'); $d = $shape->delta([2,3,4], [5,1] ); is( ref $d, '', 'reject compute delta on too short second vector'); $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, undef, [[-5,5]]); $d = $shape->delta([2,3,4], [1,5,1.1] ); is( ref $d, 'ARRAY', 'copied 2 bounded axis range def to other axis'); 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'); #### clamp & round ##################################################### my $tr = $shape->clamp([-1.1, 0, 20.1, 21, 1] ); is( ref $tr, 'ARRAY', 'got back a value ARRAY (vector) from clamp'); is( int @$tr, 3, 'clamp down to correct vector length = 3'); is( $tr->[0], -1.1, 'clamp does not touch small negative value'); is( $tr->[1], 0, 'do not touch minimal value'); is( $tr->[2], 5, 'clamp too large nr into upper bound'); my $r = $shape->round([-1.0001, -0.009, 20.1], 0); is( ref $r,'ARRAY', 'got back a value ARRAY (tuple) from round'); is( int @$r, 3, 'rounded three values'); is( $r->[0], -1, 'rounded negative value'); is( $r->[1], 0, 'rounded zero'); is( $r->[2], 20, 'rounded too large value'); $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, [ 'circular', 'linear', 'linear'], [[-5,5],[-5,5],[-5,5]], [0,1,2] ); $tr = $shape->clamp( [-10, 20] ); is( int @$tr, 3, 'clamp added missing value'); is( $tr->[0], 0, 'rotates in circular value'); is( $tr->[1], 5, 'value was just max, clamped to min'); is( $tr->[2], 0, 'added a zero into missing value'); $tr = $shape->clamp( [6, -1, 11], [5,7,[-5, 10]] ); is( int @$tr, 3, 'clamp with special range def'); is( $tr->[0], 1, 'rotated larg value down'); is( $tr->[1], 0, 'too small value clamped up to min'); is( $tr->[2], 10, 'clamped down into special range'); $r = $shape->round([-1.0001, -0.2109, 20.333]); is( ref $r,'ARRAY', 'rounding with custom precision, different for each axis'); is( int @$r, 3, 'rounded three values'); is( $r->[0], -1, 'rounded to int'); is( $r->[1], -0.2, 'rounded with precision 1'); is( $r->[2], 20.33, 'rounded with precision 2'); $r = $shape->round([-1.0001, -0.2109, 20.333], [0,1,2]); is( ref $r,'ARRAY', 'rounding with insert precision different for each axis'); is( int @$r, 3, 'rounded three values'); is( $r->[0], -1, 'rounded to int'); is( $r->[1], -0.2, 'rounded with precision 1'); is( $r->[2], 20.33, 'rounded with precision 2'); $bshape = Graphics::Toolkit::Color::Space::Shape->new( $basis, ['angular', 'circular', 0], [[-5,5],[-5,5],[-5,5]], [0,1,-1]); $tr = $bshape->clamp( [-.1, 1.123, 2.54], ['normal',2,[-1,4]]); is( $bshape->is_int_valued, 0, 'not all axis are int valued'); is( int @$tr, 3, 'clamp kept right amount of values'); is( $tr->[0], 0.9, 'rotated value to int'); is( $tr->[1], 1.123, 'left second value untouched'); is( $tr->[2], 2.54, 'in range value is kept'); #### normalize ######################################################### my $norm = $shape->normalize([-5, 0, 5]); is( ref $norm, 'ARRAY', 'normalized values'); 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( @$norm, 3, 'denormalized 3 into 3 values'); is( $norm->[0], -5, 'denormalized min value'); is( $norm->[1], 0, 'denormalized second mid value'); is( $norm->[2], 5, 'denormalized third max value'); $norm = $bshape->normalize([-1, 0, 5]); is( @$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( @$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( @$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( @$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'); $norm = $shape->denormalize_delta([0, 0.5 , 1]); is( @$norm, 3, 'denormalized 3 into 3 values'); is( $norm->[0], 0, 'denormalized min delta'); is( $norm->[1], 5, 'denormalized second mid delta'); is( $norm->[2], 10, 'denormalized third max delta'); exit 0; 50_oklab_space.t100644001750001750 2026615055140237 21554 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 95; BEGIN { unshift @INC, 'lib', '../lib', 't/lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; # conversion precision could be better my $module = 'Graphics::Toolkit::Color::Space::Instance::OKLAB'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'OKLAB', 'color space name is OKLAB'); is( $space->alias, '', 'color space has no alias'); is( $space->is_name('lab'), 0, 'can not shorten the name to "LAB"'); is( $space->is_name('OKlab'), 1, 'can mix upper and lower case'); is( $space->is_name('xyz'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'oklab space has 3 axis'); is( ref $space->check_value_shape([0, -0.5, -0.5]),'ARRAY', 'check minimal OKLAB values are in bounds'); is( ref $space->check_value_shape([1, 0.5, 0.5]), 'ARRAY', 'check maximal OKLAB values'); is( ref $space->check_value_shape([0,0]), '', "OKLAB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "OKLAB got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([1.01, 0, 0]), '', "L value is too big"); is( ref $space->check_value_shape([0, -.51, 0]), '', "a value is too small"); is( ref $space->check_value_shape([0, .51, 0]), '', "a value is too big"); is( ref $space->check_value_shape([0, 0, -0.51]), '', "b value is too small"); is( ref $space->check_value_shape([0, 0, 0.52]), '', "b value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({'L' => 1, 'a' => 0, 'b' => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({l => 1, a => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({a => 1, b => 0}), 1, 'found hash with some other keys'); is( $space->is_partial_hash({a => 1, x => 0}), 0, 'partial hash with bad keys'); is( $space->can_convert('XYZ'), 1, 'do convert from and to xyz'); is( $space->can_convert('xyz'), 1, 'namespace can be written upper case'); is( $space->can_convert('CIELAB'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'oklab(0, 0, 0)', 'can format css string'); my $val = $space->deformat(['OKLAB', 0, -.1, 0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -.1, 'second value good'); is( $val->[2], 0.1, 'third value good'); is( $space->format([0.333, -0.1, 0], 'css_string'), 'oklab(0.333, -0.1, 0)', 'can format css string'); # black my $lab = $space->convert_from( 'XYZ', [ 0, 0, 0]); is( ref $lab, 'ARRAY', 'convert black from CIEXYZ to OKLAB'); is( int @$lab, 3, 'right amount of values'); is( round_decimals( $lab->[0], 3), 0, 'L value good'); is( round_decimals( $lab->[1], 3), 0.5, 'a value good'); is( round_decimals( $lab->[2], 3), 0.5, 'b value good'); my $xyz = $space->convert_to( 'XYZ', [ 0, 0.5, 0.5]); is( ref $xyz, 'ARRAY', 'converted black to from OKLAB to XYZ'); is( int @$xyz, 3, 'got 3 values'); is( round_decimals( $xyz->[0] , 3), 0, 'X value good'); is( round_decimals( $xyz->[1] , 3), 0, 'Y value good'); is( round_decimals( $xyz->[2] , 3), 0, 'Z value good'); $val = $space->denormalize( [0, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized deconverted tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b value of black good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a value good'); is( round_decimals( $val->[2] , 5), .5, 'b value good'); # white $lab = $space->convert_from( 'XYZ', [ 1, 1, 1,]); is( int @$lab, 3, 'deconverted white from CIEXYZ'); is( round_decimals( $lab->[0], 3), 1, 'L value of white good'); is( round_decimals( $lab->[1], 3), .5, 'a value of white good'); is( round_decimals( $lab->[2], 3), .5, 'b value of white good'); $xyz = $space->convert_to( 'XYZ', [ 1, 0.5, 0.5]); is( int @$xyz, 3, 'converted white to CIEXYZ'); is( round_decimals( $xyz->[0] , 3), 1, 'X value of white good'); is( round_decimals( $xyz->[1] , 3), 1, 'Y value of white good'); is( round_decimals( $xyz->[2] , 3), 1, 'Z value of white good'); $val = $space->denormalize( [1, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 1, 'L value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b value of black good'); $val = $space->normalize( [1, 0, 0] ); is( ref $val, 'ARRAY', 'normalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 1, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a value good'); is( round_decimals( $val->[2] , 5), .5, 'b value good'); # bluish $lab = $space->convert_from( 'XYZ', [ 0.153608214883163, 0.062, 0.691568013372152]); is( int @$lab, 3, 'deconverted a nice blue CIEXYZ'); is( round_decimals( $lab->[0], 3), .427, 'L value of nice blue good'); is( round_decimals( $lab->[1], 3), .474, 'a value of nice blue good'); is( round_decimals( $lab->[2], 3), .217, 'b value of nice blue good'); $xyz = $space->convert_to( 'XYZ', [ 0.426796987209832, 0.474256066756847, 0.217395419063849]); is( int @$xyz, 3, 'converted white to CIEXYZ'); is( round_decimals( $xyz->[0] , 3), 0.154, 'X value of nice blue good'); is( round_decimals( $xyz->[1] , 3), 0.062, 'Y value of nice blue good'); is( round_decimals( $xyz->[2] , 3), 0.692, 'Z value of nice blue good'); # light blue $lab = $space->convert_from( 'XYZ', [ 0.589912305, 0.6370801241100728, 0.773381978]); is( int @$lab, 3, 'deconverted a light blue CIEXYZ'); is( round_decimals( $lab->[0], 5), .85623, 'L value of light blue good'); is( round_decimals( $lab->[1], 4), .4623, 'a value of light blue good'); is( round_decimals( $lab->[2], 4), .4687, 'b value of light blue good'); $xyz = $space->convert_to( 'XYZ', [ 0.856232267, 0.462306544, 0.468657634]); is( int @$xyz, 3, 'converted light blue to CIEXYZ'); is( round_decimals( $xyz->[0] , 5), 0.58991, 'X value of light blue good'); is( round_decimals( $xyz->[1] , 5), 0.637080, 'Y value of light blue good'); is( round_decimals( $xyz->[2] , 5), 0.77338, 'Z value of light blue good'); # pink $lab = $space->convert_from( 'XYZ', [ 0.74559151, 0.6327286137205872, 0.596805462 ]); is( int @$lab, 3, 'deconverted pink from CIEXYZ'); is( round_decimals($lab->[0], 5), .86774, 'L value of pink good'); is( round_decimals($lab->[1], 3), .573 , 'a value of pink good'); is( round_decimals($lab->[2], 3), .509 , 'b value of pink good'); $xyz = $space->convert_to( 'XYZ', [ 0.867737127, 0.572958135, 0.508966821]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.74559, 'X value of pink good'); is( round_decimals( $xyz->[1], 5), 0.63273, 'Y value of pink good'); is( round_decimals( $xyz->[2], 5), 0.59680, 'Z value of pink good'); exit 0; 51_oklch_space.t100644001750001750 1771015055140237 21565 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 93; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::OKLCH'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'OKLCH', 'color space name is OKLCH'); is( $space->alias, '', 'color space has no alias name'); is( $space->is_name('OKlch'), 1, 'color space name OKlch is correct, lc chars at will!'); is( $space->is_name('LCH'), 0, 'color space name LCH is given to CIELCHab'); is( $space->axis_count, 3, 'color space has 3 dimensions'); is( ref $space->check_value_shape([0,0]), '', "OKLCH got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "OKLCH got too many values"); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check minimal OKLCH values are in bounds'); is( ref $space->check_value_shape([1, 0.5, 360]), 'ARRAY', 'check maximal OKLCH values are in bounds'); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([1.01, 0, 0]), '', 'L value is too big'); is( ref $space->check_value_shape([0, -0.51, 0]), '', "c value is too small"); is( ref $space->check_value_shape([0, 0.51, 0]), '', 'c value is too big'); is( ref $space->check_value_shape([0, 0, -0.1]), '', 'h value is too small'); is( ref $space->check_value_shape([0, 0, 360.2] ), '', "h value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({c => 1, h => 0}), 1, 'found hash with some axis names'); is( $space->is_partial_hash({l => 1, c => 0, h => 0}), 1, 'found hash with all short axis names'); is( $space->is_partial_hash({luminance => 1, chroma => 0, hue => 0}), 1, 'found hash with all long axis names'); is( $space->is_partial_hash({c => 1, 'h*' => 0, l => 0}), 0, 'found hash with one wrong axis name'); is( $space->can_convert( 'OKLAB'), 1, 'do only convert from and to OKLAB'); is( $space->can_convert( 'Lab'), 0, 'namespace can be written lower case'); is( $space->can_convert( 'CIELCHab'), 0, 'can not convert to itself'); is( $space->format([1.23,0,41], 'css_string'), 'oklch(1.23, 0, 41)', 'can format css string'); my $val = $space->deformat(['OKLCH', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -1, 'second value good'); is( $val->[2], -0.1, 'third value good'); $val = $space->deformat(['OKLCH', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'space name (short) was recognized in named ARRAY format'); is( $space->format([0,11,350], 'css_string'), 'oklch(0, 11, 350)', 'can format css string'); # black $val = $space->denormalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'denormalized black into zeros'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); my $lch = $space->convert_from( 'OKLAB', [ 0, 0.5, 0.5]); is( ref $lch, 'ARRAY', 'deconverted "black" from OKLAB'); is( int @$lch, 3, 'right amount of values'); is( round_decimals( $lch->[0], 5), 0, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); my $lab = $space->convert_to( 'OKLAB', [ 0, 0, 0 ]); is( ref $lab, 'ARRAY', 'converted "black" to OKLAB'); is( int @$lab, 3, 'right amount of values'); is( round_decimals( $lab->[0], 5), 0, 'L value is good'); is( round_decimals( $lab->[1], 5), 0.5, 'a value is good'); is( round_decimals( $lab->[2], 5), 0.5, 'b value is good'); # white $lch = $space->convert_from( 'OKLAB', [ 1, 0.5, 0.5]); is( int @$lch, 3, 'deconverted white from OKLAB'); is( round_decimals( $lch->[0], 5), 1, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $lab = $space->convert_to( 'OKLAB', [ 1, 0, 0 ]); is( int @$lab, 3, 'converted white to LAB'); is( round_decimals( $lab->[0], 5), 1, 'L value is good'); is( round_decimals( $lab->[1], 5), .5, 'u value is good'); is( round_decimals( $lab->[2], 5), .5, 'v value is good'); # gray $lch = $space->convert_from( 'OKLAB', [ 0.59987, .5, .5]); is( int @$lch, 3, 'deconverted gray from OKLAB'); is( round_decimals( $lch->[0], 5), 0.59987, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $lab = $space->convert_to( 'OKLAB', [ .53389, 0, 0 ]); is( int @$lab, 3, 'converted gray to OKLAB'); is( round_decimals( $lab->[0], 5), .53389, 'L value is good'); is( round_decimals( $lab->[1], 5), .5, 'u value is good'); is( round_decimals( $lab->[2], 5), .5, 'v value is good'); # red $lch = $space->convert_from( 'OKLAB', [ 0.6279553639214311, 0.7248630684262744, 0.625846277330585]); is( int @$lch, 3, 'deconverted red from OKLAB'); is( round_decimals( $lch->[0], 5), .62796, 'L value good'); is( round_decimals( $lch->[1], 5), .51537, 'C value good'); is( round_decimals( $lch->[2], 5), .08121, 'H value good'); $lab = $space->convert_to( 'OKLAB', [ .627955364, 0.515366608, .081205223]); is( int @$lab, 3, 'converted red to OKLAB'); is( round_decimals( $lab->[0], 5), .62796, 'L value good'); is( round_decimals( $lab->[1], 5), .72486, 'u value good'); is( round_decimals( $lab->[2], 5), .62585, 'v value good'); # blue $lch = $space->convert_from( 'OKLAB', [ 0.45201371817442365, 0.467543025, 0.188471834]); is( int @$lch, 3, 'deconverted blue from OKLAB'); is( round_decimals( $lch->[0], 5), .45201, 'L value good'); is( round_decimals( $lch->[1], 5), .62643, 'C value good'); is( round_decimals( $lch->[2], 5), .73348, 'H value good'); $lab = $space->convert_to( 'OKLAB', [ .45201371817442365, 0.626428778, .733477841 ]); is( int @$lab, 3, 'converted blue to OKLAB'); is( round_decimals( $lab->[0], 5), .45201, 'L value good'); is( round_decimals( $lab->[1], 5), .46754, 'u value good'); is( round_decimals( $lab->[2], 5), .18847, 'v value good'); # green $lch = $space->convert_from( 'OKLAB', [ 0.5197518313867289, 0.359697668398572, 0.60767587690661445]); is( int @$lch, 3, 'deconverted green from OKLAB'); is( round_decimals( $lch->[0], 5), .51975, 'L value good'); is( round_decimals( $lch->[1], 5), .35372, 'C value good'); is( round_decimals( $lch->[2], 5), .39582, 'H value good'); $lab = $space->convert_to( 'OKLAB', [ .5197518313867289, 0.353716489, .395820403 ]); is( int @$lab, 3, 'converted green to OKLAB'); is( round_decimals( $lab->[0], 5), .51975, 'L value good'); is( round_decimals( $lab->[1], 5), .3597, 'u value good'); is( round_decimals( $lab->[2], 5), .60768, 'v value good'); exit 0; 71_name_scheme.t100644001750001750 1333715055140237 21561 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 62; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util ':all'; my $module = 'Graphics::Toolkit::Color::Name::Scheme'; eval "use $module"; is( not($@), 1, 'could load the module'); my ($scheme, $names, @names, $values, $distance); $scheme = Graphics::Toolkit::Color::Name::Scheme->new(''); is( ref $scheme, $module, 'could create empty object'); @names = $scheme->all_names(); is( int @names, 0, 'empty object has no names stored'); is( $scheme->is_name_taken('white'), 0, 'color "white" is not part of scheme'); is( $scheme->is_name_taken('black'), 0, 'color "black" is not part of scheme'); is( $scheme->values_from_name('black'), '', 'can not get values of "black"'); is( $scheme->values_from_name('white'), '', 'can not get values of "white"'); is( $scheme->names_from_values([255,255,255]), '', 'can not get name "white" by values'); is( $scheme->closest_names_from_values([255,255,255]), '', 'can not get color name that is near "white" by values'); is( $scheme->names_from_values([ 0, 0, 0]), '', 'can not get name "black" by values'); is( $scheme->add_color('white',[255,255,255]), 1, 'added color "white"'); is( $scheme->add_color('black',[ 0, 0, 0]), 1, 'added color "black"'); is( $scheme->is_name_taken('white'), 1, '"white" is noe part of scheme'); is( $scheme->is_name_taken('black'), 1, '"black" is noe part of scheme'); $names = $scheme->names_from_values([255,255,255]); is( ref $names, 'ARRAY', 'get name "white" by values'); is( @$names, 1, 'no other color has same values'); is( $names->[0], 'white', 'the name is correct'); $names = $scheme->names_from_values([0,0,0]); is( ref $names, 'ARRAY', 'get names for "black" values'); is( @$names, 1, 'one color'); is( $names->[0], 'black', 'the name is correct'); $values = $scheme->values_from_name('white'); is( ref $values, 'ARRAY', 'got values from name "white"'); is( @$values, 3, 'RGB are 3 values'); is( $values->[0], 255, 'red value is right'); is( $values->[0], 255, 'green value is right'); is( $values->[0], 255, 'blue value is right'); $values = $scheme->values_from_name('black'); is( ref $values, 'ARRAY', 'got values from name "black"'); is( @$values, 3, 'RGB are 3 values'); is( $values->[0], 0, 'red value is right'); is( $values->[0], 0, 'green value is right'); is( $values->[0], 0, 'blue value is right'); ($names, $distance) = $scheme->closest_names_from_values( [1,0,0] ); is( ref $names, 'ARRAY', 'found colors near black'); is( @$names, 1, 'one color'); is( $names->[0], 'black', 'the name is correct'); is( $distance, 1, 'computed the right distance to black'); ($names, $distance) = $scheme->closest_names_from_values( [255,252,251] ); is( ref $names, 'ARRAY', 'found colors near white'); is( @$names, 1, 'one color'); is( $names->[0], 'white', 'the name is correct'); is( $distance, 5, 'computed the right distance to white'); is( $scheme->is_name_taken('snow'), 0, 'color "snow" is not part of scheme'); is( $scheme->add_color('snow',[255,255,255]), 1, 'added "white"'); is( $scheme->is_name_taken('snow'), 1, 'color "snow" is now part of scheme'); $values = $scheme->values_from_name('snow'); is( ref $values, 'ARRAY', 'got values from color name "snow"'); is( @$values, 3, 'RGB are 3 values'); is( $values->[0], 255, 'red value is right'); is( $values->[0], 255, 'green value is right'); is( $values->[0], 255, 'blue value is right'); $names = $scheme->names_from_values([255,255,255]); is( ref $names, 'ARRAY', 'get color names from 255, 255, 255'); is( @$names, 2, 'its two colors now'); is( $names->[0], 'white', 'first is "white"'); is( $names->[1], 'snow', 'the second is "snow"'); ($names, $distance) = $scheme->closest_names_from_values( [254, 253, 253] ); is( ref $names, 'ARRAY', 'found colors near "white"'); is( @$names, 2, 'two colors'); is( $names->[0], 'white', 'first is "white"'); is( $names->[1], 'snow', 'the second is "snow"'); is( $distance, 3, 'computed the right distance to black'); is( $scheme->add_color('steel',[253,253,253]), 1, 'added color "steel"'); ($names, $distance) = $scheme->closest_names_from_values( [254, 254, 254] ); $names = [sort @$names]; is( ref $names, 'ARRAY', 'found colors near "white" ish'); is( @$names, 3, 'two colors'); is( $names->[0], 'snow', 'first color name sorted is is "snow"'); is( $names->[1], 'steel', 'the second is "steel"'); is( $names->[2], 'white', 'third is "white"'); is( $distance, sqrt 3, 'computed the right distance to black'); exit 0; 83_calc_single.t100644001750001750 1301415055140237 21553 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 52; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; use Graphics::Toolkit::Color::Values; my $module = 'Graphics::Toolkit::Color::Values'; my $blue = Graphics::Toolkit::Color::Values->new_from_any_input('blue'); my $black = Graphics::Toolkit::Color::Values->new_from_any_input('black'); my $white = Graphics::Toolkit::Color::Values->new_from_any_input('white'); my $RGB = Graphics::Toolkit::Color::Space::Hub::get_space('RGB'); my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space('HSL'); my $HWB = Graphics::Toolkit::Color::Space::Hub::get_space('HWB'); my $LAB = Graphics::Toolkit::Color::Space::Hub::get_space('LAB'); #### set ############################################################### my $cyan = $blue->set( {green => 255} ); is( ref $cyan, $module, 'aqua (set green value to max) value object'); is( $cyan->name, 'cyan', 'color has the name "cyan" (blue + green)'); my $values = $cyan->normalized(); is( ref $values, 'ARRAY', 'RGB value ARRAY'); is( @$values, 3, 'has three values'); is( $values->[0], 0, 'red value is zero'); is( $values->[1], 1, 'green value is one (max)'); is( $values->[2], 1, 'blue value is one too'); is( ref $blue->set( {green => 256}, 'CMY' ), '', 'green is in RGB, not CMY'); is( ref $blue->set( {green => 256, yellow => 0}, ), '', 'green and yellow axis are from different spaces'); $cyan = $blue->set( {green => 256}, 'RGB' ); $values = $cyan->normalized(); is( ref $cyan, $module, 'green is in RGB, and set green over max, got clamped'); is( @$values, 3, 'has three values'); is( $values->[0], 0, 'red value is zero'); is( $values->[1], 1, 'green value is one (max)'); is( $values->[2], 1, 'blue value is one too'); #### add ############################################################### $cyan = $blue->add( {green => 255} ); is( ref $cyan, $module, 'aqua (add green value to max) value object'); is( $cyan->name, 'cyan', 'color has the name "cyan"'); $values = $cyan->normalized(); is( ref $values, 'ARRAY', 'RGB value ARRAY'); is( @$values, 3, 'has three values'); is( $values->[0], 0, 'red value is zero'); is( $values->[1], 1, 'green value is one (max)'); is( $values->[2], 1, 'blue value is one too'); is( ref $blue->add( {green => 256}, 'CMY' ), '', 'green is in RGB, not CMY'); is( ref $blue->add( {green => 256, yellow => 0}, ), '', 'green and yellow axis are from different spaces'); $cyan = $blue->add( {green => 256}, 'RGB' ); $values = $cyan->normalized(); is( ref $cyan, $module, 'green is in RGB, and set green over max, got clamped'); is( @$values, 3, 'has three values'); is( $values->[0], 0, 'red value is zero'); is( $values->[1], 1, 'green value is one (max)'); is( $values->[2], 1, 'blue value is one too'); #### mix ############################################################### my $grey = $white->mix([{color => $black, percent => 50}], $RGB); is( ref $grey, $module, 'created gray by mixing black and white'); $values = $grey->shaped(); is( @$values, 3, 'get RGB values of grey'); is( $values->[0], 128, 'red value of gray'); is( $values->[1], 128, 'green value of gray'); is( $values->[2], 128, 'blue value of gray'); is( $grey->name(), 'gray', 'created gray by mixing black and white'); my $lgrey = $white->mix([{color => $black, percent => 5}], $RGB); is( ref $lgrey, $module, 'created light gray'); $values = $lgrey->shaped(); is( @$values, 3, 'get RGB values of grey'); is( $values->[0], 242, 'red value of gray'); is( $values->[1], 242, 'green value of gray'); is( $values->[2], 242, 'blue value of gray'); is( $lgrey->name(), 'gray95', 'created gray by mixing black and white'); my $darkblue = $white->mix([{color => $blue, percent => 60},{color => $black, percent => 60},], $HSL); is( ref $darkblue, $module, 'mixed black and blue in HSL, recalculated percentages from sum of 120%'); $values = $darkblue->shaped('HSL'); is( @$values, 3, 'get 3 HSL values'); is( $values->[0], 120, 'hue value is right'); is( $values->[1], 50, 'sat value is right'); is( $values->[2], 25, 'light value is right'); #### invert ############################################################ is( $white->invert($RGB)->name, 'black', 'black is white inverted'); is( $black->invert($RGB)->name, 'white', 'white is black inverted'); is( $blue->invert($RGB)->name, 'yellow', 'yellow is blue inverted'); is( $blue->invert($HSL)->name, 'gray', 'in HSL is gray opposite to any color'); is( $blue->invert($LAB)->name, '', 'LAB is not symmetrical'); is( $white->invert($HSL)->name, 'black', 'primary contrast works in HSL'); is( $white->invert($HWB)->name, 'black', 'primary contrast works in HWB'); exit 0; 04_space_format.t100644001750001750 2737315055140237 21761 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 143; BEGIN { unshift @INC, 'lib', '../lib'} my $module = 'Graphics::Toolkit::Color::Space::Format'; eval "use $module"; is( not($@), 1, 'could load the module'); use Graphics::Toolkit::Color::Space::Basis; my $basis = Graphics::Toolkit::Color::Space::Basis->new([qw/alpha beta gamma/], undef, undef, 'alias'); my $form = Graphics::Toolkit::Color::Space::Format->new( ); like( $form, qr/First argument/, 'constructor needs basis as first argument'); $form = Graphics::Toolkit::Color::Space::Format->new( $basis ); is( ref $form, $module, 'one constructor argument is enough'); my $pform = Graphics::Toolkit::Color::Space::Format->new( $basis, undef, undef, '%' ); is( ref $pform, $module, 'used second argument: suffix'); my $ppobj = Graphics::Toolkit::Color::Space::Format->new( $basis, undef, undef, ['%','%','%','%'] ); is( ref $ppobj, '', 'too many elements in suffix definition'); my $vobj = Graphics::Toolkit::Color::Space::Format->new( $basis, '\d{2}', undef, '%' ); is( ref $pform, $module, 'used third argument argument: value format'); my $vvobj = Graphics::Toolkit::Color::Space::Format->new( $basis, [ '\d{2}','\d{2}','\d{2}','\d{2}' ], undef, '%' ); is( ref $vvobj, '', 'too many elements in value format definition'); my $cobj = Graphics::Toolkit::Color::Space::Format->new( $basis, [ '\d{1}','\d{2}','\d{3}' ], undef, ['$','@','%'] ); is( ref $cobj, $module, 'fully custom format definition'); my ($vals, $name) = $form->deformat('abg:0,2.2,-3'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 0, 'first value'); is( $vals->[1], 2.2, 'secong value'); is( $vals->[2], -3, 'third value'); is( $name, 'named_string', 'found right format name'); ($vals, $name) = $pform->deformat('abg:1%,2%,3%'); is( ref $vals, 'ARRAY', 'could deformat values with suffix'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); is( $name, 'named_string', 'found right format name'); ($vals, $name) = $pform->deformat(' alias:1,2,3'); is( ref $vals, 'ARRAY', 'could deformat values with space name alias and leading space'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); is( $name, 'named_string', 'found right format name'); ($vals, $name) = $pform->deformat(' abg: 1%, 2% , 3% '); is( ref $vals, 'ARRAY', 'ignored inserted spaces in named string'); is( $name, 'named_string', 'recognized named string format'); ($vals, $name) = $vobj->deformat(' abg: 1%, 2% , 3% '); is( ref $vals, '', 'values need to have two digits with custom value format'); ($vals, $name) = $vobj->deformat(' abg: 11 %, 22 % , 33% '); is( ref $vals, '', 'can not have spaces before suffix'); ($vals, $name) = $cobj->deformat(' abg: 1%, 2% , 3% '); is( ref $vals, '', 'ignored custom suffixed, brought wrong ones'); ($vals, $name) = $cobj->deformat(' abg: 1$, 22@ , 333% '); is( ref $vals, 'ARRAY', 'recognized custom format'); is( $name, 'named_string', 'found named string as custom format'); ($vals, $name) = $pform->deformat(' abg:.1% .22% 0.33% '); is( ref $vals, 'ARRAY', 'commas are optional'); is( @$vals, 3, 'got all values'); cmp_ok( $vals->[0], '==', .1, 'first value'); cmp_ok( $vals->[1], '==', .22, 'second value'); cmp_ok( $vals->[2], '==',0.33, 'third value'); is( $name, 'named_string', 'found named string as custom format'); ($vals, $name) = $pform->deformat(' abg( 1%, 2% ,3% ) '); is( ref $vals, 'ARRAY', 'ignored inserted spaces in css string'); is( $name, 'css_string', 'recognized CSS string format'); ($vals, $name) = $pform->deformat(' alias( 1%, 2% , 3% ) '); is( ref $vals, 'ARRAY', 'deformatted css string with space name alias'); is( $name, 'css_string', 'recognized CSS string format'); ($vals, $name) = $pform->deformat(' abg( 1 , 2 , 3 ) '); is( ref $vals, 'ARRAY', 'ignored missing suffixes'); is( $name, 'css_string', 'recognized CSS string format'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); ($vals, $name) = $pform->deformat(' abg( .1 1.2 3 ) '); is( ref $vals, 'ARRAY', 'commas in CSS string format are optional'); cmp_ok( $vals->[0], '==', .1, 'first value'); cmp_ok( $vals->[1], '==', 1.2, 'second value'); cmp_ok( $vals->[2], '==', 3, 'third value'); ($vals, $name) = $form->deformat( ['ABG',1,2,3] ); is( $name, 'named_array', 'recognized named array'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); ($vals, $name) = $form->deformat( ['ALIAs',1,2,3] ); is( $name, 'named_array', 'recognized named array with space name alias'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); ($vals, $name) = $form->deformat( ['ABG',' -1','2.2 ','.3'] ); is( $name, 'named_array', 'recognized named array with spaces'); is( ref $vals, 'ARRAY', 'got values in a vector'); is( @$vals, 3, 'right amount of values'); cmp_ok( $vals->[0], '==', -1, 'first value'); cmp_ok( $vals->[1], '==', 2.2, 'second value'); cmp_ok( $vals->[2], '==', .3, 'third value'); ($vals, $name) = $form->deformat( ['abg',1,2,3] ); is( $name, 'named_array', 'recognized named array with lc name'); ($vals, $name) = $form->deformat( [' abg',1,2,3] ); is( ref $vals, '', 'spaces in name are not acceptable'); ($vals, $name) = $pform->deformat( ['abg',1,2,3] ); is( $name, 'named_array', 'recognized named array with suffix missing'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); ($vals, $name) = $pform->deformat( ['abg',' 1%',' .2%','.3% '] ); is( $name, 'named_array', 'recognized named array with suffixes'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); cmp_ok( $vals->[0], '==', 1, 'first value'); cmp_ok( $vals->[1], '==', .2, 'second value'); cmp_ok( $vals->[2], '==', .3, 'third value'); ($vals, $name) = $form->deformat( {a=>1, b=>2, g=>3} ); is( $name, 'hash', 'recognized hash format'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 1, 'first value'); is( $vals->[1], 2, 'second value'); is( $vals->[2], 3, 'third value'); ($vals, $name) = $form->deformat( {ALPHA =>1, BETA =>2, GAMMA=>3} ); is( $name, 'hash', 'recognized hash format with full names'); ($vals, $name) = $pform->deformat( {ALPHA =>1, BETA =>2, GAMMA=>3} ); is( $name, 'hash', 'recognized hash even when left suffixes'); ($vals, $name) = $pform->deformat( {ALPHA =>'1%', BETA =>'2% ', GAMMA=>' 3%'} ); is( $name, 'hash', 'recognized hash with suffixes'); ($vals, $name) = $vobj->deformat( {ALPHA =>'1%', BETA =>'2% ', GAMMA=>' 3%'} ); is( $name, undef, 'values needed 2 digits in custom value format'); ($vals, $name) = $vobj->deformat( {ALPHA =>'21 %', BETA =>'92% ', GAMMA=>' 13%'} ); is( $name, undef, 'can not tolerate space before suffix'); ($vals, $name) = $vobj->deformat( {ALPHA =>'21%', BETA =>'92% ', GAMMA=>' 13%'} ); is( $name, 'hash', 'recognized hash with suffixes and custom value format'); my (@list) = $form->format( [0,2.2,-3], 'list'); is( @list, 3, 'got a list with right lengths'); is( $list[0], 0, 'first value'); is( $list[1], 2.2, 'second value'); is( $list[2], -3, 'third value'); my $hash = $form->format( [0,2.2,-3], 'hash'); is( ref $hash, 'HASH', 'could format into HASH'); is( int keys %$hash, 3, 'right amount of keys'); is( $hash->{'alpha'}, 0, 'first value'); is( $hash->{'beta'}, 2.2, 'second value'); is( $hash->{'gamma'}, -3, 'third value'); $hash = $form->format( [0,2.2,-3], 'char_hash'); is( ref $hash, 'HASH', 'could format into HASH with character keys'); is( int keys %$hash, 3, 'right amount of keys'); is( $hash->{'a'}, 0, 'first value'); is( $hash->{'b'}, 2.2, 'second value'); is( $hash->{'g'}, -3, 'third value'); my $array = $form->format( [0,2.2,-3], 'named_array'); is( ref $array, 'ARRAY', 'could format into HASH with character keys'); is( int@$array, 4, 'right amount of elements'); is( $array->[0], 'ABG', 'first value is color space name'); is( $array->[1], 0, 'first numerical value'); is( $array->[2], 2.2, 'second numerical value'); is( $array->[3], -3, 'third numerical value'); my $string = $form->format( [0,2.2,-3], 'named_string'); is( ref $string, '', 'could format into string'); is( $string, 'abg: 0, 2.2, -3', 'string syntax ist correct'); $string = $form->format( [0,2.2,-3], 'css_string'); is( ref $string, '', 'could format into CSS string'); is( $string, 'abg(0, 2.2, -3)', 'string syntax ist correct'); $string = $pform->format( [0,2.2,-3], 'css_string'); is( ref $string, '', 'could format into CSS string with suffixes'); is( $string, 'abg(0%, 2.2%, -3%)', 'string syntax ist correct'); $string = $form->format( [0,2.2,-3], 'pstring'); is( $string, '', 'no pstring format found by universal formatter'); is( $form->has_formatter('pstring'), 0, 'there is no pstring format'); my $fref = $form->add_formatter('pstring', sub {return '%'.join ',',@{$_[1]}} ); is( ref $fref, 'CODE', 'added formatter'); $string = $form->format( [0,2.2,-3], 'pstring'); is( $string, '%0,2.2,-3', 'formatted into pstring'); is( $form->has_formatter('pstring'), 1, 'there is now a pstring format'); ($vals, $name) = $form->deformat( '%0,2.2,-3' ); is( $name, undef, 'found no deformatter for pstring format'); is( $form->has_deformatter('pstring'), 0, 'there is no pstring deformatter'); my $dref = $form->add_deformatter('pstring', sub { [split(',', substr($_[1] , 1))] }); is( ref $dref, 'CODE', 'added deformatter'); is( $form->has_deformatter('pstring'), 1, 'there is now a pstring deformatter'); ($vals, $name) = $form->deformat( '%0,2.2,-3' ); is( $name, 'pstring', 'now found deformatter for pstring format'); is( ref $vals, 'ARRAY', 'could deformat values'); is( @$vals, 3, 'right amount of values'); is( $vals->[0], 0, 'first value'); is( $vals->[1], 2.2, 'second value'); is( $vals->[2], -3, 'third value'); is( $form->has_formatter('str'), 0, 'formatter not yet inserted'); is( $form->has_formatter('bbb'), 0, 'vector name is not a format'); is( $form->has_formatter('c'), 0, 'vector sigil is not a format'); is( $form->has_formatter('list'),1, 'list is a format'); is( $form->has_formatter('hash'),1, 'hash is a format'); is( $form->has_formatter('char_hash'),1, 'char_hash is a format'); exit 0; 40_ciexyz_space.t100644001750001750 1362415055140237 21776 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 70; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::CIEXYZ'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'XYZ', 'color space name is XYZ'); is( $space->alias, 'CIEXYZ', 'color space alias name is CIEXYZ'); is( $space->is_name('xyz'), 1, 'color space name NCol is correct'); is( $space->is_name('CIExyZ'), 1, 'axis initials do not equal space name this time'); is( $space->is_name('lab'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check minimal XYZ values are in bounds'); is( ref $space->check_value_shape([95.0, 100, 108.8]), 'ARRAY', 'check maximal XYZ values'); is( ref $space->check_value_shape([0,0]), '', "XYZ got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "XYZ got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "X value is too small"); is( ref $space->check_value_shape([96, 0, 0]), '', "X value is too big"); is( ref $space->check_value_shape([0, -0.1, 0]), '', "Y value is too small"); is( ref $space->check_value_shape([0, 100.1, 0]), '', "Y value is too big"); is( ref $space->check_value_shape([0, 0, -.1 ] ), '', "Z value is too small"); is( ref $space->check_value_shape([0, 0, 108.9] ), '', "Z value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'vector has 3 elements'); is( $space->can_convert('rgb'), 1, 'do only convert from and to rgb'); is( $space->can_convert('RGB'), 1, 'namespace can be written upper case'); is( $space->is_partial_hash({x => 1, y => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({x => 1, z => 0}), 1, 'found hash with some other keys'); is( $space->can_convert('yiq'), 0, 'can not convert to yiq'); my $val = $space->deformat(['CIEXYZ', 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'); is( $space->format([0,1,0], 'css_string'), 'xyz(0, 1, 0)', 'can format css string'); # black my $xyz = $space->convert_from( 'RGB', [ 0, 0, 0]); is( int @$xyz, 3, 'converted black from RGB to XYZ'); is( $xyz->[0], 0, 'right X value'); is( $xyz->[1], 0, 'right Y value'); is( $xyz->[2], 0, 'right Z value'); my $rgb = $space->convert_to( 'RGB', [0, 0, 0]); is( int @$rgb, 3, 'convert back from XYZ to RGB'); is( round_decimals($rgb->[0], 5), 0, 'right red value'); is( round_decimals($rgb->[1], 5), 0, 'right green value'); is( round_decimals($rgb->[2], 5), 0, 'right blue value'); # grey $xyz = $space->convert_from( 'RGB', [ 0.5, 0.5, 0.5]); is( ref $xyz, 'ARRAY', 'converted grey from RGB to XYZ'); is( int @$xyz, 3, 'got three values'); is( round_decimals($xyz->[0],5), 0.21404, 'right X value'); is( round_decimals($xyz->[1],5), 0.21404, 'right Y value'); is( round_decimals($xyz->[2],5), 0.21404, 'right Z value'); $rgb = $space->convert_to( 'RGB', [0.21404, 0.21404, 0.214037]); is( int @$rgb, 3, 'converted gray from XYZ to RGB'); is( round_decimals($rgb->[0],5 ), 0.5, 'right red value'); is( round_decimals($rgb->[1],5 ), 0.5, 'right green value'); is( round_decimals($rgb->[2],5 ), 0.5, 'right blue value'); # white $xyz = $space->convert_from( 'RGB', [1, 1, 1]); is( int @$xyz, 3, 'converted white from RGB to XYZ'); is( round_decimals($xyz->[0], 5), 1, 'right X value'); is( round_decimals($xyz->[1], 5), 1, 'right Y value'); is( round_decimals($xyz->[2], 5), 1, 'right Z value'); $rgb = $space->convert_to( 'RGB', [1, 1, 1]); is( int @$rgb, 3, 'converted back gray with 3 values'); is( round_decimals($rgb->[0], 5), 1, 'right red value'); is( round_decimals($rgb->[1], 5), 1, 'right green value'); is( round_decimals($rgb->[2], 5), 1, 'right blue value'); # pink $xyz = $space->convert_from( 'RGB', [1, 0, 0.5]); is( int @$xyz, 3, 'converted pink from RGB to XYZ'); is( round_decimals($xyz->[0], 5), 0.47458, 'right X value'); is( round_decimals($xyz->[1], 5), 0.22812, 'right Y value'); is( round_decimals($xyz->[2], 5), 0.20457, 'right Z value'); $rgb = $space->convert_to( 'RGB', [0.474583573181078, 0.228121319314305, 0.204566436987141]); is( int @$rgb, 3, 'converted gray from XYZ to RGB'); is( round_decimals($rgb->[0], 5), 1, 'right red value'); is( $rgb->[1] < 0.00005, 1, 'right green value'); is( round_decimals($rgb->[2], 5), 0.5, 'right blue value'); # mid blue $xyz = $space->convert_from( 'RGB', [.2, .2, .6]); is( int @$xyz, 3, 'convert mid blue from RGB to XYZ'); is( round_decimals($xyz->[0], 5), 0.08729, 'right X value'); is( round_decimals($xyz->[1], 5), 0.05371, 'right Y value'); is( round_decimals($xyz->[2], 5), 0.28223, 'right Z value'); $rgb = $space->convert_to( 'RGB', [0.0872931606914908, 0.0537065470652866, 0.282231548430505]); is( int @$rgb, 3, 'convert mid blue from XYZ to RGB'); is( round_decimals($rgb->[0], 5), .2 , 'right red value'); is( round_decimals($rgb->[1], 5), .2 , 'right green value'); is( round_decimals($rgb->[2], 5), .6 , 'right blue value'); exit 0; 41_cielab_space.t100644001750001750 2141015055140237 21673 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 103; BEGIN { unshift @INC, 'lib', '../lib', 't/lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::CIELAB'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'LAB', 'color space name is LAB'); is( $space->alias, 'CIELAB', 'color space alias name is CIELAB'); is( $space->is_name('lab'), 1, 'color space name "lab" is correct'); is( $space->is_name('CIElab'), 1, 'axis initials do not equal space name this time'); is( $space->is_name('xyz'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'color space has 3 axis'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check minimal CIELAB values are in bounds'); is( ref $space->check_value_shape([0.950, 1, 1.088]), 'ARRAY', 'check maximal CIELAB values'); is( ref $space->check_value_shape([0,0]), '', "CIELAB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "CIELAB got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([101, 0, 0]), '', "L value is too big"); is( ref $space->check_value_shape([0, -500.1, 0]), '', "a value is too small"); is( ref $space->check_value_shape([0, 500.1, 0]), '', "a value is too big"); is( ref $space->check_value_shape([0, 0, -200.1 ] ), '', "b value is too small"); is( ref $space->check_value_shape([0, 0, 200.2] ), '', "b value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({'L*' => 1, 'a*' => 0, 'b*' => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({l => 1, a => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({a => 1, b => 0}), 1, 'found hash with some other keys'); is( $space->is_partial_hash({a => 1, x => 0}), 0, 'partial hash with bad keys'); is( $space->can_convert('XYZ'), 1, 'do convert from and to xyz'); is( $space->can_convert('xyz'), 1, 'namespace can be written lower case'); is( $space->can_convert('CIELAB'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'lab(0, 0, 0)', 'can format css string'); my $val = $space->deformat(['CIELAB', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -1, 'second value good'); is( $val->[2], -0.1, 'third value good'); is( $space->format([0,1,0], 'css_string'), 'lab(0, 1, 0)', 'can format css string'); # black my $lab = $space->convert_from( 'XYZ', [ 0, 0, 0]); is( ref $lab, 'ARRAY', 'convert black from CIEXYZ to CIELAB'); is( int @$lab, 3, 'right amount of values'); is( round_decimals( $lab->[0], 5), 0 , 'L* value good'); is( round_decimals( $lab->[1], 5), 0.5, 'a* value good'); is( round_decimals( $lab->[2], 5), 0.5, 'b* value good'); my $xyz = $space->convert_to( 'XYZ', [ 0, 0.5, 0.5]); is( ref $xyz, 'ARRAY', 'converted black to from LAB to XYZ'); is( int @$xyz, 3, 'got 3 values'); is( round_decimals( $xyz->[0] , 5), 0, 'X value good'); is( round_decimals( $xyz->[1] , 5), 0, 'Y value good'); is( round_decimals( $xyz->[2] , 5), 0, 'Z value good'); $val = $space->denormalize( [0, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized deconverted tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L* value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a* value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b* value of black good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a* value good'); is( round_decimals( $val->[2] , 5), .5, 'b* value good'); # white $lab = $space->convert_from( 'XYZ', [ 1, 1, 1,]); is( int @$lab, 3, 'deconverted white from CIEXYZ'); is( round_decimals( $lab->[0], 5), 1, 'L* value of white good'); is( round_decimals( $lab->[1], 5), .5, 'a* value of white good'); is( round_decimals( $lab->[2], 5), .5, 'b* value of white good'); $xyz = $space->convert_to( 'XYZ', [ 1, 0.5, 0.5]); is( int @$xyz, 3, 'converted white to CIEXYZ'); is( round_decimals( $xyz->[0] , 1), 1, 'X value of white good'); is( round_decimals( $xyz->[1] , 1), 1, 'Y value of white good'); is( round_decimals( $xyz->[2] , 1), 1, 'Z value of white good'); $val = $space->denormalize( [1, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 100, 'L* value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a* value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b* value of black good'); $val = $space->normalize( [100, 0, 0] ); is( ref $val, 'ARRAY', 'normalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 1, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a* value good'); is( round_decimals( $val->[2] , 5), .5, 'b* value good'); # nice blue $lab = $space->convert_from( 'XYZ', [ 0.0872931606914908, 0.0537065470652866, 0.282231548430505]); is( int @$lab, 3, 'deconverted nice blue from CIEXYZ'); is( round_decimals($lab->[0], 5), 0.27766, 'L* value of nice blue good'); is( round_decimals($lab->[1], 5), 0.53316, 'a* value of nice blue good'); is( round_decimals($lab->[2], 5), 0.36067, 'b* value of nice blue good'); $xyz = $space->convert_to( 'XYZ', [ .277656852, 0.5331557592, 0.3606718]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.08729, 'X value of nice blue good'); is( round_decimals( $xyz->[1], 5), 0.05371, 'Y value of nice blue good'); is( round_decimals( $xyz->[2], 5), 0.28223, 'Z value of nice blue good'); $val = $space->denormalize( [0.277656852, 0.5331557592, 0.3606718] ); is( int @$val, 3, 'denormalized nice blue'); is( round_decimals( $val->[0], 5), 27.76569, 'L* value of nice blue good'); is( round_decimals( $val->[1], 5), 33.15576, 'a* value of nice blue good'); is( round_decimals( $val->[2], 5),-55.73128, 'b* value of nice blue good'); $val = $space->normalize( [27.7656852, 33.156, -55.731] ); is( int @$val, 3, 'normalized nice blue'); is( round_decimals( $val->[0], 5), 0.27766, 'L value good'); is( round_decimals( $val->[1], 5), 0.53316, 'a* value good'); is( round_decimals( $val->[2], 5), 0.36067, 'b* value good'); # pink $lab = $space->convert_from( 'XYZ', [0.487032731, 0.25180, 0.208186769 ]); is( int @$lab, 3, 'deconverted pink from CIEXYZ'); is( round_decimals($lab->[0], 5), 0.57250, 'L* value of pink good'); is( round_decimals($lab->[1], 5), 0.57766, 'a* value of pink good'); is( round_decimals($lab->[2], 5), 0.5194, 'b* value of pink good'); $xyz = $space->convert_to( 'XYZ', [ 0.572503826652422, 0.57765505274346, 0.519396157464772]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.48703, 'X value of pink good'); is( round_decimals( $xyz->[1], 5), 0.25180, 'Y value of pink good'); is( round_decimals( $xyz->[2], 5), 0.20819, 'Z value of pink good'); $val = $space->denormalize( [0.57250, 0.577658, 0.5193925] ); is( int @$val, 3, 'denormalized pink'); is( round_decimals( $val->[0], 5), 57.250, 'L* value of pink good'); is( round_decimals( $val->[1], 5), 77.658, 'a* value of pink good'); is( round_decimals( $val->[2], 5), 7.757, 'b* value of pink good'); $val = $space->normalize( [57.25, 77.658, 7.757] ); is( int @$val, 3, 'normalized pink'); is( round_decimals( $val->[0], 5), 0.57250, 'L value of pink good'); is( round_decimals( $val->[1], 5), 0.57766, 'a* value of pink good'); is( round_decimals( $val->[2], 5), 0.51939, 'b* value of pink good'); exit 0; 42_cieluv_space.t100644001750001750 3006615055140237 21753 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 143; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::CIELUV'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'LUV', 'color space name is CIELUV'); is( $space->alias, 'CIELUV', 'color space alias is LUV'); is( $space->is_name('cieLUV'), 1, 'full space name recognized'); is( $space->is_name('Luv'), 1, 'axis initials do qual space name'); is( $space->is_name('Lab'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'color space has 3 dimensions'); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check minimal CIELUV values are in bounds'); is( ref $space->check_value_shape([0.950, 1, 1.088]), 'ARRAY', 'check maximal CIELUV values'); is( ref $space->check_value_shape([0,0]), '', "CIELUV got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "CIELUV got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([100, 0, 0]), 'ARRAY', 'L value is maximal'); is( ref $space->check_value_shape([101, 0, 0]), '', "L value is too big"); is( ref $space->check_value_shape([0, -134, 0]), 'ARRAY', 'u value is minimal'); is( ref $space->check_value_shape([0, -134.1, 0]), '', "u value is too small"); is( ref $space->check_value_shape([0, 220, 0]), 'ARRAY', 'u value is maximal'); is( ref $space->check_value_shape([0, 220.1, 0]), '', "u value is too big"); is( ref $space->check_value_shape([0, 0, -140]), 'ARRAY', 'v value is minimal'); is( ref $space->check_value_shape([0, 0, -140.1 ] ), '', "v value is too small"); is( ref $space->check_value_shape([0, 0, 122]), 'ARRAY', 'v value is maximal'); is( ref $space->check_value_shape([0, 0, 122.2] ), '', "v value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({u => 1, v => 0}), 1, 'found hash with some axis names'); is( $space->is_partial_hash({u => 1, v => 0, l => 0}), 1, 'found hash with all axis names'); is( $space->is_partial_hash({'L*' => 1, 'u*' => 0, 'v*' => 0}), 1, 'found hash with all long axis names'); is( $space->is_partial_hash({a => 1, v => 0, l => 0}), 0, 'found hash with one wrong axis name'); is( $space->can_convert( 'XYZ'), 1, 'do only convert from and to rgb'); is( $space->can_convert( 'xyz'), 1, 'namespace can be written lower case'); is( $space->can_convert( 'CIEluv'), 0, 'can not convert to itself'); is( $space->can_convert( 'luv'), 0, 'can not convert to itself (alias)'); is( $space->format([0,0.234,120], 'css_string'), 'luv(0, 0.234, 120)', 'can format css string'); my $val = $space->deformat(['CIELUV', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -1, 'second value good'); is( $val->[2], -0.1, 'third value good'); is( $space->format([0,1,0], 'css_string'), 'luv(0, 1, 0)', 'can format css string'); # black $val = $space->denormalize( [0, .378531073, .534351145] ); is( ref $val, 'ARRAY', 'denormalized black into zeros'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L* value of black good'); is( round_decimals( $val->[1] , 5), 0, 'u* value of black good'); is( round_decimals( $val->[2] , 5), 0, 'v* value of black good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value good'); is( round_decimals( $val->[1] , 5), 0.37853, 'u* value good'); is( round_decimals( $val->[2] , 5), 0.53435, 'v* value good'); my $luv = $space->convert_from( 'XYZ', [ 0, 0, 0]); is( ref $luv, 'ARRAY', 'deconverted tuple of zeros (black) from XYZ'); is( int @$luv, 3, 'right amount of values'); is( round_decimals( $luv->[0] , 5), 0, 'first value good'); is( round_decimals( $luv->[1] , 5), 0.37853, 'second value good'); is( round_decimals( $luv->[2] , 5), 0.53435, 'third value good'); my $xyz = $space->convert_to( 'XYZ', [ 0, .378531073, .534351145 ]); is( ref $xyz, 'ARRAY', 'converted black to XYZ'); is( int @$xyz, 3, 'right amount of values'); is( round_decimals( $xyz->[0] , 5), 0, 'X value good'); is( round_decimals( $xyz->[1] , 5), 0, 'Y value good'); is( round_decimals( $xyz->[2] , 5), 0, 'Z value good'); # white $val = $space->denormalize( [1, .378531073, .534351145] ); is( ref $val, 'ARRAY', 'denormalized white into zeros'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 100, 'L* value of white good'); is( round_decimals( $val->[1] , 5), 0, 'u* value of white good'); is( round_decimals( $val->[2] , 5), 0, 'v* value of white good'); $val = $space->normalize( [100, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 1, 'L value good'); is( round_decimals( $val->[1] , 5), 0.37853, 'u* value good'); is( round_decimals( $val->[2] , 5), 0.53435, 'v* value good'); $luv = $space->convert_from( 'XYZ', [ 1, 1, 1]); is( ref $luv, 'ARRAY', 'converted white from XYZ to LUV'); is( int @$luv, 3, 'right amount of values'); is( round_decimals( $luv->[0] , 5), 1, 'first value good'); is( round_decimals( $luv->[1] , 5), 0.37853, 'second value good'); is( round_decimals( $luv->[2] , 5), 0.53435, 'third value good'); $xyz = $space->convert_to( 'XYZ', [ 1, .378531073, .534351145 ]); is( ref $xyz, 'ARRAY', 'converted white to CIEXYZ'); is( int @$xyz, 3, 'right amount of values'); is( round_decimals( $xyz->[0], 5), 1, 'X value good'); is( round_decimals( $xyz->[1], 5), 1, 'Y value good'); is( round_decimals( $xyz->[2], 5), 1, 'Z value good'); # red $val = $space->denormalize( [0.53241, .872923729, .678458015] ); is( int @$val, 3, 'denormalize red'); is( round_decimals( $val->[0], 5), 53.241, 'L* value of white good'); is( round_decimals( $val->[1], 5), 175.015, 'u* value of white good'); is( round_decimals( $val->[2], 5), 37.756, 'v* value of white good'); $val = $space->normalize( [53.241, 175.015, 37.756] ); is( int @$val, 3, 'normalize red'); is( round_decimals( $val->[0], 5), 0.53241, 'L value good'); is( round_decimals( $val->[1], 5), 0.87292, 'u* value good'); is( round_decimals( $val->[2], 5), 0.67846, 'v* value good'); $luv = $space->convert_from( 'XYZ', [ 0.433953728, 0.21267, 0.017753001]); is( int @$luv, 3, 'deconverted red from CIEXYZ'); is( round_decimals( $luv->[0], 5), 0.5324, 'first value good'); is( round_decimals( $luv->[1], 4), 0.8729, 'second value good'); is( round_decimals( $luv->[2], 5), 0.67846, 'third value good'); $xyz = $space->convert_to( 'XYZ', [ 0.53241, .872923729, .678458015 ]); is( int @$xyz, 3, 'converted red to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.43395, 'X value good'); is( round_decimals( $xyz->[1], 5), 0.21267, 'Y value good'); is( round_decimals( $xyz->[2], 5), 0.01776, 'Z value good'); # blue $val = $space->denormalize( [0.32297, .351963277, .036862595] ); is( int @$val, 3, 'denormalize blue'); is( round_decimals( $val->[0], 5), 32.297, 'L* value of white good'); is( round_decimals( $val->[1], 5), -9.405, 'u* value of white good'); is( round_decimals( $val->[2], 5), -130.342, 'v* value of white good'); $val = $space->normalize( [32.297, -9.405, -130.342] ); is( int @$val, 3, 'normalize blue'); is( round_decimals( $val->[0], 5), 0.32297, 'L value good'); is( round_decimals( $val->[1], 5), 0.35196, 'u* value good'); is( round_decimals( $val->[2], 5), 0.03686, 'v* value good'); $luv = $space->convert_from( 'XYZ', [ 0.1898429198, 0.07217, 0.872771690713886]); is( int @$luv, 3, 'deconverted blue from CIEXYZ'); is( round_decimals( $luv->[0], 5), 0.32296, 'first value good'); is( round_decimals( $luv->[1], 5), 0.35197, 'second value good'); is( round_decimals( $luv->[2], 5), 0.03687, 'third value good'); $xyz = $space->convert_to( 'XYZ', [ 0.322958956314709, 0.351970231199232, 0.0368661363328552 ]); is( int @$xyz, 3, 'converted blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.18984, 'X value good'); is( round_decimals( $xyz->[1], 5), 0.07217, 'Y value good'); is( round_decimals( $xyz->[2], 5), 0.87277, 'Z value good'); # gray $val = $space->denormalize( [0.53389, .378531073, .534351145] ); is( int @$val, 3, 'denormalize gray'); is( round_decimals( $val->[0], 5), 53.389, 'L* value of white good'); is( round_decimals( $val->[1], 5), 0, 'u* value of white good'); is( round_decimals( $val->[2], 5), 0, 'v* value of white good'); $val = $space->normalize( [53.389, 0, 0] ); is( int @$val, 3, 'normalize gray'); is( round_decimals( $val->[0], 5), 0.53389, 'L value good'); is( round_decimals( $val->[1], 5), 0.37853, 'u* value good'); is( round_decimals( $val->[2], 5), 0.53435, 'v* value good'); $luv = $space->convert_from( 'XYZ', [ .214041474 , .21404, 0.214037086]); is( int @$luv, 3, 'deconverted gray from XYZ'); is( round_decimals( $luv->[0], 5), 0.53389, 'first value good'); is( round_decimals( $luv->[1], 5), 0.37853, 'second value good'); is( round_decimals( $luv->[2], 5), 0.53435, 'third value good'); $xyz = $space->convert_to( 'XYZ', [ 0.53389, .378531073, .534351145 ]); is( int @$xyz, 3, 'converted gray to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.21404, 'X value good'); is( round_decimals( $xyz->[1], 5), 0.21404, 'Y value good'); is( round_decimals( $xyz->[2], 5), 0.21404, 'Z value good'); # nice blue $val = $space->denormalize( [0.24082, .352573446, .317049618] ); is( int @$val, 3, 'denormalize nice blue'); is( round_decimals( $val->[0], 5), 24.082, 'L* value of white good'); is( round_decimals( $val->[1], 5), -9.189, 'u* value of white good'); is( round_decimals( $val->[2], 5), -56.933, 'v* value of white good'); $val = $space->normalize( [24.082, -9.189, -56.933] ); is( int @$val, 3, 'normalize nice blue'); is( round_decimals( $val->[0], 5), 0.24082, 'L value good'); is( round_decimals( $val->[1], 5), 0.35257, 'u* value good'); is( round_decimals( $val->[2], 5), 0.31705, 'v* value good'); $luv = $space->convert_from( 'XYZ', [ 0.057434743, .04125, .190608268]); is( int @$luv, 3, 'deconverted nice blue from CIEXYZ'); is( round_decimals( $luv->[0], 5), 0.2408, 'first value good'); is( round_decimals( $luv->[1], 5), 0.35258, 'second value good'); is( round_decimals( $luv->[2], 5), 0.31705, 'third value good'); $xyz = $space->convert_to( 'XYZ', [ 0.240804547340649, 0.352579240249493, 0.317048140883067 ]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.05743, 'X value good'); is( round_decimals( $xyz->[1], 5), 0.04125, 'Y value good'); is( round_decimals( $xyz->[2], 5), 0.19061, 'Z value good'); exit 0; 81_values_types.t100644001750001750 1311715055140237 22035 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 76; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Values; my (@values, $values); my $fuchsia = Graphics::Toolkit::Color::Values->new_from_tuple([255,0,256], 'RGB'); my $blue_hsl = Graphics::Toolkit::Color::Values->new_from_any_input({hue => 240, s => 100, l => 50}); #### normalized ######################################################## $values = $fuchsia->normalized(); is( ref $values, 'ARRAY', 'get fuchsia value tuple'); is( @$values, 3, 'has 3 values'); is( $values->[0], 1, 'red value is right'); is( $values->[1], 0, 'green value is right'); is( $values->[2], 1, 'blue value is right'); $values = $fuchsia->normalized('RGB'); is( ref $values, 'ARRAY', 'RGB is default color, get same values'); is( @$values, 3, 'same 3 values'); is( $values->[0], 1, 'red value is right'); is( $values->[1], 0, 'green value is right'); is( $values->[2], 1, 'blue value is right'); $values = $fuchsia->normalized('CMYK'); is( ref $values, 'ARRAY', 'get CMYK values'); is( @$values, 4, 'all 4 values'); is( $values->[0], 0, 'cyan value is right'); is( $values->[1], 1, 'magenta value is right'); is( $values->[2], 0, 'yellow value is right'); is( $values->[3], 0, 'key value is right'); #### shaped ########################################################## $values = $fuchsia->shaped(); is( ref $values, 'ARRAY', 'get fuchsia RGB (default) values in ragular range'); is( @$values, 3, 'all 3 values'); is( $values->[0], 255, 'red value is right'); is( $values->[1], 0, 'green value is right'); is( $values->[2], 255, 'blue value is right'); $values = $fuchsia->shaped('CMYK', [[-10,5],10, [-1,5], 20]); is( ref $values, 'ARRAY', 'get CMYK values with custom ranges'); is( @$values, 4, '4 values'); is( $values->[0], -10, 'cyan value is right'); is( $values->[1], 10, 'magenta value is right'); is( $values->[2], -1, 'yellow value is right'); is( $values->[3], 0, 'key value is right'); $values = $fuchsia->shaped('XYZ', undef, [0, 1,2]); is( ref $values, 'ARRAY', 'get XYZ values with custom precision'); is( @$values, 3, '3 values'); is( $values->[0], 59, 'X value is right'); is( $values->[1], 28.5, 'Y value is right'); is( $values->[2], 96.96, 'Z value is right'); #### formatted ######################################################### #~space, @~|~format, @~|~range, @~|~suffix is( ref $fuchsia->formatted(), '', 'formatted needs arguments'); is( $fuchsia->formatted(undef, 'named_string'), 'rgb: 255, 0, 255', 'just format name is enough'); is( $fuchsia->formatted('CMY', 'named_string'), 'cmy: 0, 1, 0', 'understand color spaces'); is( $fuchsia->formatted('CMY', 'css_string', '+'), 'cmy(0+, 1+, 0+)', 'and value suffix'); is( $fuchsia->formatted('CMY', 'css_string', '+', [[-2,10]]), 'cmy(-2+, 10+, -2+)','and ranges'); is( $fuchsia->formatted('XYZ', 'css_string', undef, undef, [2,1,0]), 'xyz(59.29, 28.5, 97)','and precision'); is( $blue_hsl->formatted('HSL', 'css_string', '', 1, [2,0,1]), 'hsl(0.67, 1, 0.5)' ,'all arguments at once'); is( ref $fuchsia->formatted('CMY', 'array'), '', 'array format is RGB only'); is( ref $fuchsia->formatted('CMY', 'hex_string'), '', 'hex_string formatis RGB only'); is( $fuchsia->formatted('RGB', 'hex_string'), '#FF00FF', 'but works under RGB'); $values = $fuchsia->formatted('RGB', 'array'); is( ref $values, 'ARRAY', 'get fuchsia RGB values in array format'); is( @$values, 3, 'all 3 values'); is( $values->[0], 255, 'red value is right'); is( $values->[1], 0, 'green value is right'); is( $values->[2], 255, 'blue value is right'); $values = $fuchsia->formatted( undef, 'named_array'); is( ref $values, 'ARRAY', 'get fuchsia RGB values in named array format'); is( @$values, 4, 'all 4 values'); is( $values->[0], 'RGB', 'first value is space name'); is( $values->[1], 255, 'red value is right'); is( $values->[2], 0, 'green value is right'); is( $values->[3], 255, 'blue value is right'); $values = $fuchsia->formatted( 'CMYK', 'named_array',['','','-','+'], 10); is( ref $values, 'ARRAY', 'fuchsia CMYK values as named array with custom suffix and special range'); is( @$values, 5, 'all 5 values'); is( $values->[0], 'CMYK', 'first value is space name'); is( $values->[1], 0, 'red value is right'); is( $values->[2], 10, 'magenta value is right'); is( $values->[3], '0-', 'yellow value is right'); is( $values->[4], '0+', 'key value is right'); @values = $fuchsia->formatted('RGB', 'list'); is( @values, 3, 'got RGB tuple in list format'); is( $values[0], 255, 'red value is right'); is( $values[1], 0, 'green value is right'); is( $values[2], 255, 'blue value is right'); $values = $fuchsia->formatted( 'CMYK', 'hash'); is( ref $values, 'HASH', 'fuchsia CMYK values as hash'); is( int keys %$values, 4, 'has 4 keys'); is( $values->{'cyan'}, 0, 'cyan value is right'); is( $values->{'magenta'},1, 'magenta value is right'); is( $values->{'yellow'}, 0, 'yellow value is right'); is( $values->{'key'}, 0, 'key value is right'); $values = $fuchsia->formatted( 'CMYK', 'char_hash'); is( ref $values, 'HASH', 'fuchsia CMYK values as hash with character long keys'); is( int keys %$values, 4, 'has 4 keys'); is( $values->{'c'}, 0, 'cyan value is right'); is( $values->{'m'}, 1, 'magenta value is right'); is( $values->{'y'}, 0, 'yellow value is right'); is( $values->{'k'}, 0, 'key value is right'); exit 0; 91_public_getter.t100644001750001750 2040615055140237 22142 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 92; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; use Graphics::Toolkit::Color qw/color/; my $red = color(255,0,0); my $blue = color({r => 0, g => 0, b=>255}); my $purple = color({hue => 300, s => 100, l => 25}); my $black = color([0,0,0]); my $white = color('cmy',0,0,0); my @names; is( $red->name, 'red', 'color name "red" is correct'); is( $blue->name, 'blue', 'color name "blue" is correct'); is( $purple->name, 'purple', 'color name "purple" is correct'); is( $black->name, 'black', 'color name "black" is correct'); is( $white->name, 'white', 'color name "white" is correct'); is( $red->closest_name, 'red', 'color "red" is also closest name'); is( $blue->closest_name, 'blue', 'color "blue" is also closest name'); is( $purple->closest_name, 'purple', 'color "purple" is also closest name'); is( $black->closest_name, 'black', 'color "black" is also closest name'); is( $white->closest_name, 'white', 'color "white" is also closest name'); @names = $blue->name(all => 1, full => 1); is( int @names, 2, '"blue" has two names'); is( $names[0], 'blue', '"blue" is first, no default name space name in color name'); is( $names[1], 'blue1', '"blue1" is second"'); @names = sort $blue->name(all => 1, distance => 25); is( int @names, 3, 'around "blue" with distance 25 you get 3 colors'); is( $names[0], 'blue', '"blue" is first, no default name space name in color name'); is( $names[1], 'blue1', '"blue1" is second"'); is( $names[2], 'blue2', '"blue2" is third"'); my ($name, $d) = $red->closest_name; is( $name, 'red', 'color name is "red" also in array context'); is( $d, 0, 'and has no distance'); ($name, $d) = $blue->closest_name; is( $name, 'blue', 'color name is "blue" also in array context'); is( $d, 0, 'and has no distance'); ($name, $d) = $purple->closest_name; is( $name, 'purple', 'color name is "purple" also in array context'); is( $d, 0, 'and has no distance'); ($name, $d) = $black->closest_name; is( $name, 'black', 'color name is "black" also in array context'); is( $d, 0, 'and has no distance'); ($name, $d) = $white->closest_name; is( $name, 'white', 'color name is "white" also in array context'); is( $d, 0, 'and has no distance'); my $snow = color(['rgb', 254, 255, 255]); is( $snow->name, '', 'this color has no name in default constants'); ($name, $d) = $snow->closest_name; is( $name, 'white', 'color "white" is closest to snow'); is( $d, 1, 'and has a distance of 1'); is( round_decimals($snow->distance($white), 5), 1, 'distance method calculates (almost) the same'); is( round_decimals($snow->distance(to => $white), 5), 1, 'use named argument to calculate distance'); is( round_decimals($snow->distance(to => $white, range => 510), 3), 2, 'test reaction to the "range" argument'); is( round_decimals($snow->distance(to => $white, select => 'red'), 5), 1, 'test reaction to the "select" argument'); is( round_decimals($snow->distance(to => $white, select => 'blue'), 5), 0, 'select axis with no value difference'); is( round_decimals($snow->distance(to => $white, select => ['red','blue']), 5), 1, 'select axis with and without value difference'); is( round_decimals($snow->distance(to => $white, in => 'cmy', range => 255), 5), 1, 'test reaction to the "in" argument'); is( ref $snow->distance( to => $white, blub => '-'), '', 'false arguments get caught'); is( ref $snow->distance( in => 'LAB'), '', 'missing required argument gets caught'); my @values = $blue->values(); is( int @values, 3, 'default result for "values" are 3 numbers'); is( $values[0], 0, 'red value is correct'); is( $values[1], 0, 'green value is correct'); is( $values[2], 255, 'blue red value is correct'); @values = $blue->values(as => 'array'); is( int @values, 1, 'ordered one ARRAY ref'); is( ref $values[0], 'ARRAY', 'it is an ARRAY ref'); is( int @{$values[0]}, 3, 'has three values inside'); is( $values[0][0], 0, 'red value is correct'); is( $values[0][1], 0, 'green value is correct'); is( $values[0][2], 255, 'blue value is correct'); @values = $blue->values(as => 'named_array'); is( int @values, 1, 'named ARRAY ref'); is( ref $values[0], 'ARRAY', 'is an ARRAY ref'); is( int @{$values[0]}, 4, 'has four values inside'); is( $values[0][0], 'RGB', 'color space name is first'); is( $values[0][1], 0, 'red value is correct'); is( $values[0][2], 0, 'green value is correct'); is( $values[0][3], 255, 'blue value is correct'); is( ref $blue->values( in => 'LAB', as => 'array'), '', 'ARRAY ref format is RGB only'); is( ref $blue->values( in => 'LAB', as => 'hex_string'), '', 'hex_string format is RGB only'); is( ref $blue->values( in => 'LAB', was => 'array'), '', 'reject fantasy arguments'); is( ref $blue->values( in => 'LAB', suffix => {}), '', 'bad ref type for suffix def'); is( ref $blue->values( in => 'LAB', suffix => [1,2]), '', 'suffix def too short'); is( ref $blue->values( in => 'LAB', suffix => [1,2,3,4]), '', 'suffix def too long'); @values = $blue->values(in => 'CMYK'); is( int @values, 4, 'CMYK has 4 values'); is( $values[0], 1, 'cyan value is correct'); is( $values[1], 1, 'magenta value is correct'); is( $values[2], 0, 'yellow red value is correct'); is( $values[3], 0, '"key" value is correct'); is( $blue->values(as => 'css_string'), 'rgb(0, 0, 255)', 'blue in CSS string format'); is( $blue->values(as => 'named_string'), 'rgb: 0, 0, 255', 'blue in named string format'); is( $blue->values(as => 'hex_string'), '#0000FF', 'blue in hex string format'); is( $snow->values(as => 'css_string'), 'rgb(254, 255, 255)', 'blue in CSS string format'); is( $snow->values(as => 'named_string'), 'rgb: 254, 255, 255', 'blue in named string format'); is( $snow->values(as => 'hex_string'), '#FEFFFF', 'blue in hex string format'); is( $snow->values(as => 'HEX_string'), '#FEFFFF', 'format name is case insensitive'); is( $red->values(in => 'HWB', as => 'named_string'), 'hwb: 0, 0%, 0%', 'red as named string in HWB'); is( $red->values(in => 'HWB', as => 'named_string', suffix => ''), 'hwb: 0, 0, 0', 'without any suffix'); is( $red->values(in => 'RGB', as => 'css_string', suffix => ['-','/','']),'rgb(255-, 0/, 0)', 'RGB with taylor made suffix'); is( $red->values(in => 'XYZ', as => 'css_string' ), 'xyz(41.246, 21.267, 1.933)', 'XYZ red CSS string '); is( $red->values(in => 'XYZ', as => 'css_string', precision => 1 ), 'xyz(41.2, 21.3, 1.9)', 'XYZ red CSS string with reduced precision'); is( $red->values(in => 'XYZ', as => 'css_string', precision => [3,2,0] ),'xyz(41.246, 21.27, 2)', 'XYZ red CSS string with inidividual precision'); is( $blue->values(in => 'RGB', as => 'named_string', range => '10'), 'rgb: 0, 0, 10', 'RGB blue with custom ranges'); is( $blue->values(in => 'RGB', as => 'named_string', range => [[-1,1],[-2,2],1]), 'rgb: -1, -2, 1', 'RGB blue with with very custom ranges'); my $values = $blue->values( as => 'hash'); is( ref $values, 'HASH', 'got a value HASH ref'); is( keys %$values, 3, 'RGB has 3 keays'); is( $values->{'red'}, 0, '"red" value is correct'); is( $values->{'green'}, 0, '"green" value is correct'); is( $values->{'blue'}, 255, '"blue" value is correct'); $values = $blue->values( in => 'HSL', as => 'char_hash', suffix => ''); is( ref $values, 'HASH', 'got a value HASH ref'); is( keys %$values, 3, 'HSL has 3 keays'); is( $values->{'h'}, 240, '"hue" value is correct'); is( $values->{'s'}, 100, '"saturation" value is correct'); is( $values->{'l'}, 50, '"lightness" value is correct'); exit 0; 43_cielchab_space.t100644001750001750 2571615055140237 22225 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 134; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::CIELCHab'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'LCH', 'color space name is LCH'); is( $space->alias, 'CIELCHAB', 'color space name alias name is CIELCHab'); is( $space->is_name('CIELCHab'), 1, 'color space name CIELCHab is correct'); is( $space->is_name('LCH'), 1, 'color space name LCH is correct'); is( $space->is_name('hab'), 0, 'color space name LCH is correct'); is( $space->axis_count, 3, 'color space has 3 dimensions'); is( ref $space->check_value_shape([0,0]), '', "CIELCHab got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "CIELCHab got too many values"); is( ref $space->check_value_shape([0, 0, 0]), 'ARRAY', 'check minimal CIELCHab values are in bounds'); is( ref $space->check_value_shape([100, 539, 360]), 'ARRAY', 'check maximal CIELCHab values are in bounds'); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([100.01, 0, 0]), '', 'L value is too big'); is( ref $space->check_value_shape([0, -0.1, 0]), '', "c value is too small"); is( ref $space->check_value_shape([0, 539.1, 0]), '', 'c value is too big'); is( ref $space->check_value_shape([0, 0, -0.1]), '', 'h value is too small'); is( ref $space->check_value_shape([0, 0, 360.2] ), '', "h value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({c => 1, h => 0}), 1, 'found hash with some axis names'); is( $space->is_partial_hash({l => 1, c => 0, h => 0}), 1, 'found hash with all short axis names'); is( $space->is_partial_hash({luminance => 1, chroma => 0, hue => 0}), 1, 'found hash with all long axis names'); is( $space->is_partial_hash({c => 1, v => 0, l => 0}), 0, 'found hash with one wrong axis name'); is( $space->can_convert( 'LAB'), 1, 'do only convert from and to CIELAB'); is( $space->can_convert( 'Lab'), 1, 'namespace can be written lower case'); is( $space->can_convert( 'CIELCHab'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'lch(0, 0, 0)','can format css string'); my $val = $space->deformat(['CIELCHab', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -1, 'second value good'); is( $val->[2], -0.1, 'third value good'); $val = $space->deformat(['LCH', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'space name (short) was recognized in named ARRAY format'); is( $space->format([0,11,350], 'css_string'), 'lch(0, 11, 350)', 'can format css string'); # black $val = $space->denormalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'denormalized black into zeros'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); my $lch = $space->convert_from( 'LAB', [ 0, 0.5, 0.5]); is( ref $lch, 'ARRAY', 'deconverted black from LAB'); is( int @$lch, 3, 'right amount of values'); is( round_decimals( $lch->[0], 5), 0, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); my $lab = $space->convert_to( 'LAB', [ 0, 0, 0 ]); is( ref $lab, 'ARRAY', 'converted black to LAB'); is( int @$lab, 3, 'right amount of values'); is( round_decimals( $lab->[0], 5), 0, 'L* value is good'); is( round_decimals( $lab->[1], 5), .5, 'a* value is good'); is( round_decimals( $lab->[2], 5), .5, 'b* value is good'); # white $val = $space->denormalize( [1, 0, 0] ); is( int @$val, 3, 'denormalized white'); is( round_decimals( $val->[0], 5), 100, 'L value of white is good'); is( round_decimals( $val->[1], 5), 0, 'C value of white is good'); is( round_decimals( $val->[2], 5), 0, 'H value of white is good'); $val = $space->normalize( [100, 0, 0] ); is( int @$val, 3, 'normalized white'); is( round_decimals( $val->[0], 5), 1, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); $lch = $space->convert_from( 'LAB', [ 1, .5, .5]); is( int @$lch, 3, 'deconverted white from LAB'); is( round_decimals( $lch->[0], 5), 1, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $lab = $space->convert_to( 'LAB', [ 1, 0, 0 ]); is( int @$lab, 3, 'converted white to LAB'); is( round_decimals( $lab->[0], 5), 1, 'L value is good'); is( round_decimals( $lab->[1], 5), .5, 'u value is good'); is( round_decimals( $lab->[2], 5), .5, 'v value is good'); # gray $val = $space->denormalize( [.53389, 0, .686386111] ); is( int @$val, 3, 'denormalized gray'); is( round_decimals( $val->[0], 5), 53.389, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 247.099, 'H value is good'); $val = $space->normalize( [53.389, 0, 247.099] ); is( int @$val, 3, 'normalized gray'); is( round_decimals( $val->[0], 5), .53389, 'L value good'); is( round_decimals( $val->[1], 5), 0, 'C value good'); is( round_decimals( $val->[2], 5), 0.68639, 'H value good'); $lch = $space->convert_from( 'LAB', [ .53389, .5, .5]); is( int @$lch, 3, 'deconverted gray from LAB'); is( round_decimals( $lch->[0], 5), .53389, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $lab = $space->convert_to( 'LAB', [ .53389, 0, 0.686386111 ]); is( int @$lab, 3, 'converted gray to LAB'); is( round_decimals( $lab->[0], 5), .53389, 'L value is good'); is( round_decimals( $lab->[1], 5), .5, 'u value is good'); is( round_decimals( $lab->[2], 5), .5, 'v value is good'); # red $val = $space->denormalize( [.53389, 0.193974026, .111108333] ); is( int @$val, 3, 'denormalized red'); is( round_decimals( $val->[0], 5), 53.389, 'L value is good'); is( round_decimals( $val->[1], 5), 104.552, 'C value is good'); is( round_decimals( $val->[2], 5), 39.999, 'H value is good'); $val = $space->normalize( [53.389, 104.552, 39.999] ); is( int @$val, 3, 'normalized red'); is( round_decimals( $val->[0], 5), .53389, 'L value good'); is( round_decimals( $val->[1], 5), 0.19397, 'C value good'); is( round_decimals( $val->[2], 5), 0.11111, 'H value good'); $lch = $space->convert_from( 'LAB', [ .53389, .580092, .6680075]); is( int @$lch, 3, 'deconverted red from LAB'); is( round_decimals( $lch->[0], 5), .53389, 'L value good'); is( round_decimals( $lch->[1], 5), .19397, 'C value good'); is( round_decimals( $lch->[2], 5), .11111, 'H value good'); $lab = $space->convert_to( 'LAB', [ .53389, 0.193974026, .111108333 ]); is( int @$lab, 3, 'converted red to LAB'); is( round_decimals( $lab->[0], 5), .53389, 'L value good'); is( round_decimals( $lab->[1], 5), .58009, 'u value good'); is( round_decimals( $lab->[2], 5), .66801, 'v value good'); # blue $val = $space->denormalize( [.32297, 0.248252319, .850791667] ); is( int @$val, 3, 'denormalized blue'); is( round_decimals( $val->[0], 5), 32.297, 'L value is good'); is( round_decimals( $val->[1], 5), 133.808, 'C value is good'); is( round_decimals( $val->[2], 5), 306.285, 'H value is good'); $val = $space->normalize( [32.297, 133.808, 306.285] ); is( int @$val, 3, 'normalized blue'); is( round_decimals( $val->[0], 5), .32297, 'L value good'); is( round_decimals( $val->[1], 5), .24825, 'C value good'); is( round_decimals( $val->[2], 5), .85079, 'H value good'); $lch = $space->convert_from( 'LAB', [ .32297, .579188, .23035]); is( int @$lch, 3, 'deconverted blue from LAB'); is( round_decimals( $lch->[0], 5), .32297, 'L value good'); is( round_decimals( $lch->[1], 5), .24825, 'C value good'); is( round_decimals( $lch->[2], 5), .85079, 'H value good'); $lab = $space->convert_to( 'LAB', [ .32297, 0.248252319, .850791667 ]); is( int @$lab, 3, 'converted blue to LAB'); is( round_decimals( $lab->[0], 5), .32297, 'L value good'); is( round_decimals( $lab->[1], 5), .57919, 'u value good'); is( round_decimals( $lab->[2], 5), .23035, 'v value good'); # mid blue $val = $space->denormalize( [.37478, 0.220141002, .842422222] ); is( int @$val, 3, 'denormalized mid blue'); is( round_decimals( $val->[0], 5), 37.478, 'L value is good'); is( round_decimals( $val->[1], 5), 118.656, 'C value is good'); is( round_decimals( $val->[2], 5), 303.272, 'H value is good'); $val = $space->normalize( [37.478, 118.656, 303.272] ); is( int @$val, 3, 'normalized mid blue'); is( round_decimals( $val->[0], 5), .37478, 'L value good'); is( round_decimals( $val->[1], 5), .22014, 'C value good'); is( round_decimals( $val->[2], 5), .84242, 'H value good'); $lch = $space->convert_from( 'LAB', [ .37478, .565097, .2519875]); is( int @$lch, 3, 'deconverted mid blue from LAB'); is( round_decimals( $lch->[0], 5), .37478, 'L value good'); is( round_decimals( $lch->[1], 5), .22014, 'C value good'); is( round_decimals( $lch->[2], 5), .84242, 'H value good'); $lab = $space->convert_to( 'LAB', [ .37478, 0.220141002, .842422222 ]); is( int @$lab, 3, 'converted mid blue to LAB'); is( round_decimals( $lab->[0], 5), .37478, 'L value good'); is( round_decimals( $lab->[1], 4), .5651, 'u value good'); is( round_decimals( $lab->[2], 5), .25199, 'v value good'); exit 0; 44_cielchuv_space.t100644001750001750 2564515055140237 22277 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 133; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::CIELCHuv'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'CIELCHUV', 'color space name is CIELCHuv'); is( $space->alias, 'LCHUV', 'color space has alias name: LCHuv'); is( $space->is_name('CIELCHuv'), 1, 'color space name CIELCHuv is correct'); is( $space->is_name('LCHuv'), 1, 'color space name LCHuv is correct'); is( $space->is_name('LCH'), 0, 'LCH is given for another space'); is( $space->axis_count, 3, 'color space has 3 dimensions'); is( ref $space->check_value_shape( [0,0]), '', "CIELCHuv got too few values"); is( ref $space->check_value_shape( [0, 0, 0, 0]), '', "CIELCHuv got too many values"); is( ref $space->check_value_shape( [0, 0, 0]), 'ARRAY', 'check minimal CIELCHuv values are in bounds'); is( ref $space->check_value_shape( [100, 261, 360]), 'ARRAY', 'check maximal CIELCHuv values are in bounds'); is( ref $space->check_value_shape( [-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape( [100.01, 0, 0]), '', 'L value is too big'); is( ref $space->check_value_shape( [0, -0.1, 0]), '', "c value is too small"); is( ref $space->check_value_shape( [0, 261.1, 0]), '', 'c value is too big'); is( ref $space->check_value_shape( [0, 0, -0.1]), '', 'h value is too small'); is( ref $space->check_value_shape( [0, 0, 360.2] ), '', "h value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({c => 1, h => 0}), 1, 'found hash with some axis names'); is( $space->is_partial_hash({l => 1, c => 0, h => 0}), 1, 'found hash with all short axis names'); is( $space->is_partial_hash({luminance => 1, chroma => 0, hue => 0}), 1, 'found hash with all long axis names'); is( $space->is_partial_hash({c => 1, v => 0, l => 0}), 0, 'found hash with one wrong axis name'); is( $space->can_convert('LUV'), 1, 'do only convert from and to rgb'); is( $space->can_convert('Luv'), 1, 'namespace can be written lower case'); is( $space->can_convert('CIELCHuv'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'cielchuv(0, 0, 0)', 'can format css string'); my $val = $space->deformat(['CIELCHuv', 0, -1, -0.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 0, 'first value good'); is( $val->[1], -1, 'second value good'); is( $val->[2], -0.1, 'third value good'); is( $space->format([0,1,0], 'css_string'), 'cielchuv(0, 1, 0)', 'can format css string'); # black $val = $space->denormalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'denormalized black into zeros'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0], 5), 0, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); my $lch = $space->convert_from( 'LUV', [ 0, .378531073, .534351145]); is( ref $lch, 'ARRAY', 'deconverted black from LUV'); is( int @$lch, 3, 'right amount of values'); is( round_decimals( $lch->[0], 5), 0, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); my $luv = $space->convert_to( 'LUV', [ 0, 0, 0 ] ); is( ref $luv, 'ARRAY', 'converted black to LUV'); is( int @$luv, 3, 'right amount of values'); is( round_decimals( $luv->[0], 5), 0, 'L* value is good'); is( round_decimals( $luv->[1], 5), .37853, 'u* value is good'); is( round_decimals( $luv->[2], 5), .53435, 'v* value is good'); # white $val = $space->denormalize( [1, 0, 0] ); is( int @$val, 3, 'denormalized white'); is( round_decimals( $val->[0], 5), 100, 'L value of white is good'); is( round_decimals( $val->[1], 5), 0, 'C value of white is good'); is( round_decimals( $val->[2], 5), 0, 'H value of white is good'); $val = $space->normalize( [100, 0, 0] ); is( int @$val, 3, 'normalized white'); is( round_decimals( $val->[0], 5), 1, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 0, 'H value is good'); $lch = $space->convert_from( 'LUV', [ 1, .378531073, .534351145]); is( int @$lch, 3, 'deconverted white from LUV'); is( round_decimals( $lch->[0], 5), 1, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $luv = $space->convert_to( 'LUV', [ 1, 0, 0 ] ); is( int @$luv, 3, 'converted white to LUV'); is( round_decimals( $luv->[0], 5), 1, 'L value is good'); is( round_decimals( $luv->[1], 5), .37853, 'u value is good'); is( round_decimals( $luv->[2], 5), .53435, 'v value is good'); # gray $val = $space->denormalize( [.53389, 0, .686386111] ); is( int @$val, 3, 'denormalized gray'); is( round_decimals( $val->[0], 5), 53.389, 'L value is good'); is( round_decimals( $val->[1], 5), 0, 'C value is good'); is( round_decimals( $val->[2], 5), 247.099, 'H value is good'); $val = $space->normalize( [53.389, 0, 247.099] ); is( int @$val, 3, 'normalized gray'); is( round_decimals( $val->[0], 5), .53389, 'L value good'); is( round_decimals( $val->[1], 5), 0, 'C value good'); is( round_decimals( $val->[2], 5), 0.68639, 'H value good'); $lch = $space->convert_from( 'LUV', [ .53389, .378531073, .534351145] ); is( int @$lch, 3, 'deconverted gray from LUV'); is( round_decimals( $lch->[0], 5), .53389, 'L value is good'); is( round_decimals( $lch->[1], 5), 0, 'C value is good'); is( round_decimals( $lch->[2], 5), 0, 'H value is good'); $luv = $space->convert_to( 'LUV', [ .53389, 0, 0.686386111 ] ); is( int @$luv, 3, 'converted gray to LUV'); is( round_decimals( $luv->[0], 5), .53389, 'L value is good'); is( round_decimals( $luv->[1], 5), .37853, 'u value is good'); is( round_decimals( $luv->[2], 5), .53435, 'v value is good'); # red $val = $space->denormalize( [.53389, 0.685980843, .033816667] ); is( int @$val, 3, 'denormalized red'); is( round_decimals( $val->[0], 5), 53.389, 'L value is good'); is( round_decimals( $val->[1], 5), 179.041, 'C value is good'); is( round_decimals( $val->[2], 5), 12.174, 'H value is good'); $val = $space->normalize( [53.389, 179.041, 12.174] ); is( int @$val, 3, 'normalized red'); is( round_decimals( $val->[0], 5), .53389, 'L value good'); is( round_decimals( $val->[1], 5), .68598, 'C value good'); is( round_decimals( $val->[2], 5), .03382, 'H value good'); $lch = $space->convert_from( 'LUV', [ .53389, .872923729, .678458015] ); is( int @$lch, 3, 'deconverted red from LUV'); is( round_decimals( $lch->[0], 5), .53389, 'L value good'); is( round_decimals( $lch->[1], 5), .68598, 'C value good'); is( round_decimals( $lch->[2], 5), .03382, 'H value good'); $luv = $space->convert_to( 'LUV', [ .53389, 0.685980843, .033816667 ] ); is( int @$luv, 3, 'converted red to LUV'); is( round_decimals( $luv->[0], 5), .53389, 'L value good'); is( round_decimals( $luv->[1], 5), .87292, 'u value good'); is( round_decimals( $luv->[2], 5), .67846, 'v value good'); # blue $val = $space->denormalize( [.32297, 0.500693487, .738536111] ); is( int @$val, 3, 'denormalized blue'); is( round_decimals( $val->[0], 5), 32.297, 'L value is good'); is( round_decimals( $val->[1], 5), 130.681, 'C value is good'); is( round_decimals( $val->[2], 5), 265.873, 'H value is good'); $val = $space->normalize( [32.297, 130.681, 265.873] ); is( int @$val, 3, 'normalized blue'); is( round_decimals( $val->[0], 5), .32297, 'L value good'); is( round_decimals( $val->[1], 5), .50069, 'C value good'); is( round_decimals( $val->[2], 5), .73854, 'H value good'); $lch = $space->convert_from( 'LUV', [ .32297, .351963277, .036862595]); is( int @$lch, 3, 'deconverted blue from LUV'); is( round_decimals( $lch->[0], 5), .32297, 'L value good'); is( round_decimals( $lch->[1], 5), .50069, 'C value good'); is( round_decimals( $lch->[2], 5), .73854, 'H value good'); $luv = $space->convert_to( 'LUV', [ .32297, 0.500693487, .738536111 ]); is( int @$luv, 3, 'converted blue to LUV'); is( round_decimals( $luv->[0], 5), .32297, 'L value good'); is( round_decimals( $luv->[1], 5), .35196, 'u value good'); is( round_decimals( $luv->[2], 5), .03686, 'v value good'); # mid blue $val = $space->denormalize( [.24082, 0.220954023, .724533333] ); is( int @$val, 3, 'denormalized mid blue'); is( round_decimals( $val->[0], 5), 24.082, 'L value is good'); is( round_decimals( $val->[1], 5), 57.669, 'C value is good'); is( round_decimals( $val->[2], 5), 260.832, 'H value is good'); $val = $space->normalize( [24.082, 57.669, 260.832] ); is( int @$val, 3, 'normalized mid blue'); is( round_decimals( $val->[0], 5), .24082, 'L value good'); is( round_decimals( $val->[1], 5), .22095, 'C value good'); is( round_decimals( $val->[2], 5), .72453, 'H value good'); $lch = $space->convert_from( 'LUV', [ .24082, .352573446, .317049618] ); is( int @$lch, 3, 'deconverted mid blue from LUV'); is( round_decimals( $lch->[0], 5), .24082, 'L value good'); is( round_decimals( $lch->[1], 5), .22096, 'C value good'); is( round_decimals( $lch->[2], 5), .72453, 'H value good'); $luv = $space->convert_to( 'LUV', [ 0.24082, 0.220957034629279, 0.724531985277748 ] ); is( int @$luv, 3, 'converted mid blue to LUV'); is( round_decimals( $luv->[0], 5), .24082, 'L value good'); is( round_decimals( $luv->[1], 5), .35257, 'u value good'); is( round_decimals( $luv->[2], 5), .31705, 'v value good'); exit 0; 82_values_measure.t100644001750001750 624115055140237 22313 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 21; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Values; ######################################################################## my $darkblue = Graphics::Toolkit::Color::Values->new_from_any_input(['HSL', 240, 50, 25])->normalized; my $red = Graphics::Toolkit::Color::Values->new_from_any_input( ['HSL', 0, 50, 25])->normalized; my $light_red = Graphics::Toolkit::Color::Values->new_from_any_input( ['HSL', 0, 50, 75])->normalized; my $black = Graphics::Toolkit::Color::Values->new_from_any_input('black')->normalized; my $white = Graphics::Toolkit::Color::Values->new_from_any_input('white')->normalized; my $fuchsia = Graphics::Toolkit::Color::Values->new_from_any_input('fuchsia')->normalized; my $RGB = Graphics::Toolkit::Color::Space::Hub::get_space('RGB'); my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space('HSL'); my $distance = \&Graphics::Toolkit::Color::Space::Hub::distance; # @c1 @c2 -- ~space ~select @range --> + is( $distance->( $darkblue, $darkblue, $RGB ), 0, 'dark blue should have no distance to itself'); is( int $distance->( $black, $white, 'RGB' ), 441, 'black and white have maximal distance in RGB'); is( $distance->( $fuchsia, $black, $RGB, undef, 'normal' ), sqrt 2, 'measure distance between magenta and black in RGB'); is( $distance->( $fuchsia, $black, $RGB, 'red', 'normal' ), 1, 'measure only red component'); is( $distance->( $black, $fuchsia, $RGB, 'red', 'normal' ), 1, 'order of args does not matter'); is( $distance->( $fuchsia, $black, $RGB, 'green', 'normal' ), 0, 'measure only green component'); is( $distance->( $fuchsia, $black, $RGB, 'blue', 'normal' ), 1, 'measure only blue component'); is( $distance->( $fuchsia, $black, $RGB, 'blue', 'normal' ), 1, 'measure only blue component'); is( $distance->( $fuchsia, $black, $RGB, [qw/r g/], 'normal' ), 1, 'measurered red and green component'); is( $distance->( $fuchsia, $black, $RGB, [qw/r b/], 'normal' ), sqrt 2, 'measurered red and blue component'); is( $distance->( $fuchsia, $black, $RGB, 'blue', [8,9,10] ), 10, 'measure blue component woith custom scaling'); is( $distance->( $black, $white, $HSL ), 100, 'black and white have maximal distance in HSL'); is( $distance->( $black, $white, $HSL, 'l', ), 100, 'only on the lightness axis'); is( $distance->( $black, $white, $HSL, 'h', ), 0, 'not on the saturation axis'); is( $distance->( $black, $white, $HSL, 's', ), 0, 'or hue'); is( $distance->( $black, $white, $HSL, 'l', 'normal' ), 1, 'maximal distance in HSL, nrmalized'); is( $distance->( $darkblue, $red, $HSL, ), 120, 'properly handle zylindrical dimension "hue" in HSL'); is( $distance->( $darkblue, $red, $HSL, undef, [3,2,2]), 1, 'same with custom range'); is( $distance->( $darkblue, $light_red, $HSL, undef, [3,2,2]), sqrt 2, 'two dimensional distance in "HSL"'); is( $distance->( $darkblue, $light_red, $HSL, 'lightness', [3,2,2]), 1, '"lightness" part is one'); is( $distance->( $darkblue, $light_red, $HSL, ['h','l'], [3,2,2]), sqrt 2, 'select only axis that affect the difference'); exit 0; 46_hunterlab_space.t100644001750001750 2174515055140237 22460 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 104; BEGIN { unshift @INC, 'lib', '../lib', 't/lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; my $module = 'Graphics::Toolkit::Color::Space::Instance::HunterLAB'; my $space = eval "require $module"; is( not($@), 1, 'could load the module'); is( ref $space, 'Graphics::Toolkit::Color::Space', 'got tight return value by loading module'); is( $space->name, 'HUNTERLAB', 'color space official name is "HUNTERLAB"'); is( $space->alias, '', 'no color space alias name'); is( $space->is_name('HunterLAB'), 1, 'color space name HunterLAB is correct'); is( $space->is_name('CIElab'), 0, 'not to be confused with "CIELAB"'); is( $space->is_name('lab'), 0, 'axis initials do not equal space name this time'); is( $space->axis_count, 3, 'color space has 3 axis'); # K: 172,355206019 67,038696071 is( ref $space->check_value_shape([0, -172.30, -67.03]),'ARRAY', 'check minimal HunterLAB values are in bounds'); is( ref $space->check_value_shape([100, 172.30, 67.03]),'ARRAY', 'check maximal HunterLAB values'); is( ref $space->check_value_shape([0,0]), '', "HunterLAB got too few values"); is( ref $space->check_value_shape([0, 0, 0, 0]), '', "HunterLAB got too many values"); is( ref $space->check_value_shape([-0.1, 0, 0]), '', "L value is too small"); is( ref $space->check_value_shape([101, 0, 0]), '', "L value is too big"); is( ref $space->check_value_shape([1, -172.4, 0]), '', "a value is too small"); is( ref $space->check_value_shape([1, 172.4, 0]), '', "a value is too big"); is( ref $space->check_value_shape([0, 0, -67.21 ] ), '', "b value is too small"); is( ref $space->check_value_shape([0, 0, 67.21] ), '', "b value is too big"); is( $space->is_value_tuple([0,0,0]), 1, 'tuple has 3 elements'); is( $space->is_partial_hash({'L' => 1, 'a' => 0, 'b' => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({'L' => 1, 'a' => 0, 'b*' => 0}), 0, 'not confused with lab Hash'); is( $space->is_partial_hash({l => 1, a => 0}), 1, 'found hash with some keys'); is( $space->is_partial_hash({a => 1, b => 0}), 1, 'found hash with some other keys'); is( $space->is_partial_hash({a => 1, x => 0}), 0, 'partial hash with bad keys'); is( $space->can_convert('XYZ'), 1, 'do convert from and to xyz'); is( $space->can_convert('xyz'), 1, 'namespace can be written lower case'); is( $space->can_convert('HunterLAB'), 0, 'can not convert to itself'); is( $space->format([0,0,0], 'css_string'), 'hunterlab(0, 0, 0)', 'can format css string'); my $val = $space->deformat(['HunterLAB', 100, 0, -67.1]); is( ref $val, 'ARRAY', 'deformated named ARRAY into tuple'); is( int @$val, 3, 'right amount of values'); is( $val->[0], 100, 'first value good'); is( $val->[1], 0, 'second value good, zeros no issue'); is( $val->[2], -67.1, 'third value good'); is( $space->format([11.1, 5, 0], 'named_string'), 'hunterlab: 11.1, 5, 0', 'can format named string'); # black my $lab = $space->convert_from( 'XYZ', [ 0, 0, 0]); is( ref $lab, 'ARRAY', 'convert black from CIEXYZ to HunterLAB'); is( int @$lab, 3, 'right amount of values'); is( round_decimals( $lab->[0], 5), 0, 'L value good'); is( round_decimals( $lab->[1], 5), 0.5, 'a value good'); is( round_decimals( $lab->[2], 5), 0.5, 'b value good'); my $xyz = $space->convert_to( 'XYZ', [ 0, 0.5, 0.5]); is( ref $xyz, 'ARRAY', 'converted black to from HunterLAB to XYZ'); is( int @$xyz, 3, 'got 3 values'); is( round_decimals( $xyz->[0] , 5), 0, 'X value good'); is( round_decimals( $xyz->[1] , 5), 0, 'Y value good'); is( round_decimals( $xyz->[2] , 5), 0, 'Z value good'); $val = $space->denormalize( [0, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized deconverted tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b value of black good'); $val = $space->normalize( [0, 0, 0] ); is( ref $val, 'ARRAY', 'normalized tuple of zeros (black)'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 0, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a value good'); is( round_decimals( $val->[2] , 5), .5, 'b value good'); # white $lab = $space->convert_from( 'XYZ', [ 1, 1, 1,]); is( int @$lab, 3, 'deconverted white from CIEXYZ'); is( round_decimals( $lab->[0], 5), 1, 'L value of white good'); is( round_decimals( $lab->[1], 5), .5, 'a value of white good'); is( round_decimals( $lab->[2], 5), .5, 'b value of white good'); $xyz = $space->convert_to( 'XYZ', [ 1, 0.5, 0.5]); is( int @$xyz, 3, 'converted white to CIEXYZ'); is( round_decimals( $xyz->[0] , 1), 1, 'X value of white good'); is( round_decimals( $xyz->[1] , 1), 1, 'Y value of white good'); is( round_decimals( $xyz->[2] , 1), 1, 'Z value of white good'); $val = $space->denormalize( [1, .5, .5] ); is( ref $val, 'ARRAY', 'denormalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 100, 'L value of black good'); is( round_decimals( $val->[1] , 5), 0, 'a value of black good'); is( round_decimals( $val->[2] , 5), 0, 'b value of black good'); $val = $space->normalize( [100, 0, 0] ); is( ref $val, 'ARRAY', 'normalized white'); is( int @$val, 3, 'right amount of values'); is( round_decimals( $val->[0] , 5), 1, 'L value good'); is( round_decimals( $val->[1] , 5), .5, 'a value good'); is( round_decimals( $val->[2] , 5), .5, 'b value good'); # nice blue $lab = $space->convert_from( 'XYZ', [ 0.08729316023, 0.053706547, 0.28223099106]); is( int @$lab, 3, 'deconverted nice blue from CIEXYZ'); is( round_decimals($lab->[0], 5), .23175, 'L value of nice blue good'); is( round_decimals($lab->[1], 5), .57246, 'a value of nice blue good'); is( round_decimals($lab->[2], 5), .00695 , 'b value of nice blue good'); $xyz = $space->convert_to( 'XYZ', [ 0.231746730289771, 0.57246405, 0.006952172]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.08729, 'X value of nice blue good'); is( round_decimals( $xyz->[1], 5), 0.05371, 'Y value of nice blue good'); is( round_decimals( $xyz->[2], 5), 0.28223, 'Z value of nice blue good'); $val = $space->denormalize( [0.231746730289771, 0.57246405, 0.006952172] ); is( int @$val, 3, 'denormalized nice blue'); is( round_decimals( $val->[0], 5), 23.17467, 'L value of nice blue good'); is( round_decimals( $val->[1], 3), 24.979 , 'a value of nice blue good'); is( round_decimals( $val->[2], 3), -66.107 , 'b value of nice blue good'); $val = $space->normalize( [23.17467, 24.979, -66.107] ); is( int @$val, 3, 'normalized nice blue'); is( round_decimals( $val->[0], 5), 0.23175, 'L value good'); is( round_decimals( $val->[1], 5), 0.57246, 'a value good'); is( round_decimals( $val->[2], 5), 0.00695, 'b value good'); # pink $lab = $space->convert_from( 'XYZ', [0.487032731, 0.25180, 0.208186769 ]); is( int @$lab, 3, 'deconverted pink from CIEXYZ'); is( round_decimals($lab->[0], 5), .50180, 'L value of pink good'); is( round_decimals($lab->[1], 5), .73439, 'a value of pink good'); is( round_decimals($lab->[2], 5), .54346, 'b value of pink good'); $xyz = $space->convert_to( 'XYZ', [ 0.501796772, 0.734390439, 0.543457066]); is( int @$xyz, 3, 'converted nice blue to CIEXYZ'); is( round_decimals( $xyz->[0], 5), 0.48703, 'X value of pink good'); is( round_decimals( $xyz->[1], 5), 0.25180, 'Y value of pink good'); is( round_decimals( $xyz->[2], 5), 0.20819, 'Z value of pink good'); $val = $space->denormalize( [0.501796772, 0.734390439, 0.543457066] ); is( int @$val, 3, 'denormalized pink'); is( round_decimals( $val->[0], 3), 50.180, 'L value of pink good'); is( round_decimals( $val->[1], 3), 80.797, 'a value of pink good'); is( round_decimals( $val->[2], 3), 5.827, 'b value of pink good'); $val = $space->normalize( [50.180, 80.797, 5.827] ); is( int @$val, 3, 'normalized pink'); is( round_decimals( $val->[0], 5), 0.50180, 'L value of pink good'); is( round_decimals( $val->[1], 5), 0.73439, 'a value of pink good'); is( round_decimals( $val->[2], 5), 0.54346, 'b value of pink good'); exit 0; 93_public_calc_set.t100644001750001750 2407415055140237 22434 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 95; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color qw/color/; my $module = 'Graphics::Toolkit::Color'; my $red = color('#FF0000'); my $blue = color('#0000FF'); my $white = color('white'); my $black = color('black'); my $midblue = color(43, 52, 242); my @colors; my @values; #### complement ######################################################## unlike( $blue->complement(), qr/GTC method/, 'complement methods works without argument'); like( $blue->complement( heps => 3), qr/GTC method/, 'reject invented argument'); like( $blue->complement('der'), qr/GTC method/, 'only argument has to be numeric'); like( $blue->complement( steps =>'der'), qr/GTC method/, 'named argument "steps" still has to be numeric'); like( $blue->complement( steps =>2, tilt => '-'), qr/GTC method/, 'named argument "tilt" still has to be numeric'); like( $blue->complement( target => []), qr/GTC method/, 'named argument "target" got wrong reference type'); like( $blue->complement( target => {hue => 2, gamma => 2}), qr/GTC method/, 'named argument "target" got HASH ref with bad axis name'); @colors = $red->complement( ); is( int @colors, 1, 'default is THE complement'); is( $colors[0]->name, 'cyan', 'which got computed correctly'); @colors = $red->complement( steps => 1); is( int @colors, 1, 'same with named argument'); is( $colors[0]->name, 'cyan', 'result still good'); @colors = $red->complement( steps => 3); is( int @colors, 3, 'got triadic colors'); is( $colors[0]->name, 'lime', 'first is full green (lime)'); is(($colors[0]->values('HSL'))[0], 120, 'green has hue of 120'); is( $colors[1]->name, 'blue', 'second is blue'); is(($colors[1]->values('HSL'))[0], 240, 'blue has hue of 240'); is( $colors[2]->name, 'red', 'third is red'); is(($colors[2]->values('HSL'))[0], 0, 'red has hue of 0'); @colors = $red->complement( steps => 3, tilt => 1 ); is( int @colors, 3, 'got split complement'); @values = $colors[0]->values('HSL'); is( @values, 3, 'first color in HSL'); is( $values[0], 100, '0 + 1 - 4/9 of 180 hue degree'); is( $values[1], 100, 'full saturation'); is( $values[2], 50, 'half lightness'); @values = $colors[1]->values('HSL'); is( $values[0], 260, '0 + 1 - 4/9 of 180 hue degree'); @colors = $red->complement( steps => 4, tilt => 1.585, target => {h => -10, s => 20, l => 30} ); is( @colors, 4, 'computed 4 complements with a moved target and split comp tilt'); @values = $colors[3]->values('HSL'); is( $values[0], 0, 'fourth color is invocant, normal red'); is( $values[1], 100, 'full saturation'); is( $values[2], 50, 'half lightness'); @values = $colors[1]->values('HSL'); is( $values[0], 170, 'complement taret has user set values'); is( $values[1], 100, 'full saturation, was clamped'); is( $values[2], 80, 'half lightness, was added'); @values = $colors[0]->values('HSL'); is( $values[0], 142, 'hue of first color seem right'); is( $values[1], 100, 'saturation is constant'); is( $values[2], 75, 'lightness, in between on tilted circle'); @values = $colors[2]->values('HSL'); is( $values[0], 202, 'hue of third color seem right'); is( $values[1], 100, 'saturation is constant'); is( $values[2], 75, 'lightness, same as first'); #### gradient ########################################################## like( $white->gradient(), qr/GTC method/, 'gradient method needs arguments'); like( $white->gradient('s'), qr/GTC method/, 'only argument has to be a color'); unlike( $white->gradient('red'), qr/GTC method/, 'only argument works'); unlike( $white->gradient(to => 'red'), qr/GTC method/, 'as named also'); like( $white->gradient(to => ['red','no']), qr/GTC method/, 'ARRAY contained one bad color definition'); like( $white->gradient(to => 'red', der => 1), qr/GTC method/, 'reject invented args'); like( $white->gradient(to => 'red', in => 'house'), qr/GTC method/, 'reject invented name spaces'); like( $white->gradient(to => 'red', tilt => 'house'), qr/GTC method/, 'argument "tilt" has to be numeric'); like( $white->gradient(to => 'red', steps => 'house'), qr/GTC method/, 'argument "steps" has to be numeric'); @colors = $red->gradient( 'green'); is( int @colors, 10, 'default for steps is 10'); is( $colors[0]->name, 'red', 'first color is red'); is( $colors[9]->name, 'green', 'last color is green'); @colors = $red->gradient( to => 'green'); is( int @colors, 10, 'default for steps is 10'); is( $colors[0]->name, 'red', 'first color is red'); is( $colors[9]->name, 'green', 'last color is green'); @colors = $blue->gradient( to => 'red', steps => 3 ); is( int @colors, 3, 'argument steps works'); is( $colors[1]->name, 'purple', 'got mixed color in the middle'); @colors = $blue->gradient( to => ['white','red', 'blue'], steps => 7 ); is( $colors[5]->name, 'purple', 'got mixed inside cmlex rainbow'); @colors = $blue->gradient( to => 'red', steps => 3, tilt => 1 ); @values = $colors[1]->values(); is( @values, 3, 'center color in tilted gradient'); is( $values[0], 64, 'red value is right'); is( $values[1], 0, 'green value is right'); is( $values[2], 191, 'blue value is right'); #### cluster ########################################################### like( $white->cluster(), qr/GTC method/, 'cluster method needs arguments'); like( $white->cluster(1), qr/GTC method/, 'one is not enough'); like( $white->cluster(radius => 2), qr/GTC method/, 'only radius is not enough'); like( $white->cluster(distance => 2), qr/GTC method/, 'only distance is not enough'); unlike( $white->cluster(radius => 2, minimal_distance => 2), qr/GTC method/, 'need both r and min d argument'); like( $white->cluster(radius => 2, min_d => 2, in => 'CMA'), qr/GTC method/, 'need real space name'); like( $white->cluster(radius => 1, minimal_distance => '-'), qr/GTC method/, "distance has to be a number"); like( $white->cluster(radius => 'd', minimal_distance => 2), qr/GTC method/, "radius has to be a number"); like( $white->cluster(radius => [1,2,3], min_d => 2, in => 'CMYK'), qr/GTC method/, "radius tuple too short"); like( $white->cluster(r => ['e',1,2,3], min_d => 2, in => 'CMYK'), qr/GTC method/, "radius tuple has to be number only"); unlike( $white->cluster(r => [0,1,2,3], min_d => 2, in => 'CMYK'), qr/GTC method/, "radius tuple is long enough"); like( $white->cluster(r => 5, minimal_distance => 2, in => 'CMYK'), qr/GTC method/, "CMYK doesn't work with cuboctahedral packing"); like( $white->cluster(radius => 0, minimal_distance => 0), qr/GTC method/, "distance has to be positive"); like( $white->cluster(radius => 1, minimal_distance => 1, ar => 2), qr/GTC method/, "reject invented arguments"); like( $white->cluster(radius => 1, minimal_distance => 1, 'ar'), qr/GTC method/, "odd number of arguments"); @colors = $midblue->cluster( radius => 2.01, minimal_distance => 2 ); is( int @colors, 13, 'computed smallest ball shaped cluster in RGB'); @values = $colors[1]->values(); is( @values, 3, 'center color is on pos one'); is( $values[0], 43, 'red value is right'); is( $values[1], 52, 'green value is right'); is( $values[2], 242, 'blue value is right'); @values = $colors[0]->values(); is( $values[0], 41, 'first color has less red'); is( $values[2], 242, 'blue is same as center'); @values = $colors[2]->values(); is( $values[0], 45, 'third color has more red'); @values = $colors[12]->values(); is( $values[0], 42, 'red value is right (was rounded up to same)'); is( $values[1], 51, 'green value is right'); is( $values[2], 241, 'blue value is right (1.4 less but rounded up)'); @colors = $midblue->cluster( r => [1.01,1.01,1.01], minimal_distance => 1, in => 'RGB'); is( int @colors, 27, 'computed tiny cuboid cluster with 27 colors'); @values = $colors[0]->values(); is( int @values, 3, 'got first color in min corner'); is( $values[0], 42, 'red value is right'); is( $values[1], 51, 'green value is right'); is( $values[2], 241, 'blue value is right'); @values = $colors[26]->values(); is( int @values, 3, 'got last color in max corner'); is( $values[0], 44, 'red value is right'); is( $values[1], 53, 'green value is right'); is( $values[2], 243, 'blue value is right'); @colors = $white->cluster( r => [1.01,1.01,1.01], min_d => 1, in => 'HSL' ); is( int @colors, 12, 'cluster edging on roof of HSL space'); exit 0; author000755001750001750 015055140237 20124 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/xtpod-syntax.t100644001750001750 25215055140237 22536 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/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(); 62_space_hub_format.t100644001750001750 2077015055140237 22615 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 100; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; use Graphics::Toolkit::Color::Space::Hub; my $deformat = \&Graphics::Toolkit::Color::Space::Hub::deformat; my $dehash = \&Graphics::Toolkit::Color::Space::Hub::deformat_partial_hash; #### deformat ########################################################## my ($values, $space) = $deformat->([0, 255, 256]); is( $space, 'RGB', 'color triple can only be RGB'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'RGB has 3 axis'); is( round_decimals( $values->[0], 5), 0, 'red value is right'); is( round_decimals( $values->[1], 5), 255, 'green value is right'); is( round_decimals( $values->[2], 5), 256, 'blue value got not clamped yet'); ($values, $space) = $deformat->('#FF2200'); is( $space, 'RGB', 'RGB hex string'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'RGB has 3 axis'); is( round_decimals( $values->[0], 5), 255, 'red value is right'); is( round_decimals( $values->[1], 5), 34, 'green value is right'); is( round_decimals( $values->[2], 5), 0, 'blue value has right value'); ($values, $space) = $deformat->('#f20'); is( $space, 'RGB', 'short RGB hex string'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'RGB has 3 axis'); is( round_decimals( $values->[0], 5), 255, 'red value is right'); is( round_decimals( $values->[1], 5), 34, 'green value is right'); is( round_decimals( $values->[2], 5), 0, 'blue value has right value'); ($values, $space) = $deformat->('blue'); is( $space, undef, 'deformat is not for color names'); ($values, $space) = $deformat->('SVG:red'); is( $space, undef, 'deformat does not get confused by external color names'); ($values, $space) = $deformat->('cmy: 1,0.1, 0 '); is( $space, 'CMY', 'named string works even with lower case'); is( ref $values, 'ARRAY', 'got ARRAY tuple even spacing was weird'); is( int @$values, 3, 'CMY has 3 axis'); is( $values->[0], 1, 'cyan value is right'); is( $values->[1], 0.1, 'magenta value is right'); is( $values->[2], 0, 'yellow value has right value'); ($values, $space) = $deformat->('ncol: y10, 22%, 5.1% '); is( ref $values, '', 'wrong precision, NCol doesnt accept decimals'); ($values, $space) = $deformat->('ncol: y20, 22%, 5 '); is( $space, 'NCOL', 'color char can be lower case and percent is not mandatory'); is( ref $values, 'ARRAY', 'got ARRAY tuple even spacing was weird'); is( int @$values, 3, 'NCol has 3 axis'); is( $values->[0], 120, 'hue value is right'); is( $values->[1], 22, 'w value is right'); is( $values->[2], 5, 'b value is right'); ($values, $space) = $deformat->('lab(0, -500, 200)'); is( $space, 'LAB', 'got LAB css_string right'); is( ref $values,'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'CIELAB has 3 axis'); is( $values->[0], 0, 'L* value is right'); is( $values->[1], -500, 'a* value is right'); is( $values->[2], 200, 'b* value has right value'); ($values, $space) = $deformat->(['yuv', 0.4, -0.5, 0.5]); is( $space, 'YUV', 'found YUV named array'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'RGB has 3 axis'); is( $values->[0], 0.4, 'Y value is right'); is( $values->[1], -0.5, 'U value is right'); is( $values->[2], 0.5, 'V value got clamped to max'); ($values, $space) = $deformat->(['hunterLAB', 12, 2.5, 0.04]); is( $space, 'HUNTERLAB', 'found HUNTERLAB named array'); is( int @$values, 3, 'RGB has 3 axis'); is( $values->[0], 12, 'L value is right'); is( $values->[1], 2.5, 'a value is right'); is( $values->[2], 0.04, 'b value got clamped to max'); ($values, $space) = $deformat->({h => 360, s => 10, v => 100}); is( $space, 'HSV', 'found HSV short named hash'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'HSV has 3 axis'); is( $values->[0], 360, 'hue value got rotated in'); is( $values->[1], 10, 'saturation value is right'); is( $values->[2], 100, 'value (kinda lightness) value got clamped to max'); ($values, $space) = $deformat->({hue => 360, s => 10, v => 100}); is( $space, 'HSV', 'found HSV short and long named hash'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); ($values, $space) = $deformat->({hue => 360, s => 10}); is( $space, undef, 'not found HSV hash due lacking value'); ($values, $space) = $deformat->({h => 360, whiteness => 0, blackness => 20}); is( $space, 'HWB', 'found HWB short and long named hash'); is( ref $values, 'ARRAY', 'got ARRAY tuple'); is( int @$values, 3, 'HWB has 3 axis'); is( $values->[0], 360, 'hue value got rotated in'); is( $values->[1], 0, 'whiteness value is right'); is( $values->[2], 20, 'blackness value got clamped to max'); #### dehash ############################################################ my ($part_values, $space_name) = $dehash->( {hue => 20} ); is( $space_name, 'HSL', 'HSL is first of the cylindrical spaces'); is( ref $part_values, 'ARRAY', 'partial value array is an ARRAY'); is( int @$part_values, 1, 'value is on first position'); is( exists $part_values->[0], 1, 'and there is a value'); is( $part_values->[0], 20, 'and it is the right value'); ($part_values, $space_name) = $dehash->( {hUE => 20} ); is( $space_name, 'HSL', 'dehash ignores casing'); ($part_values, $space_name) = $dehash->( {hue => 19}, 'HSB' ); is( $space_name, 'HSB', 'did found hue in HSB space when forced to'); is( ref $part_values, 'ARRAY', 'partial value array is an ARRAY'); is( int @$part_values, 1, 'value is on first position'); is( exists $part_values->[0], 1, 'and there is a value'); is( $part_values->[0], 19, 'and it is the right value'); ($part_values, $space_name) = $dehash->( ); is( $part_values, undef, 'need a hash as input'); ($part_values, $space_name) = $dehash->( {hue => 20, h => 10} ); is( $part_values, undef, 'can not use axis name twice'); ($part_values, $space_name) = $dehash->( {hue => 20, green => 10} ); is( $space_name, undef, 'can not mix axis names from spaces'); ($part_values, $space_name) = $dehash->( {red => 20, green => 10, blue => 10, yellow => 20} ); is( $space_name, undef, 'can not use too my axis names'); ($part_values, $space_name) = $dehash->( {X => 20, y => 10, Z => 30} ); is( $space_name, 'XYZ', 'can mix upper and lower case axis names'); is( ref $part_values, 'ARRAY', 'partial value array is an ARRAY'); is( int @$part_values, 3, 'partial value tuple has three keys'); is( defined $part_values->[0], 1, 'one key is on pos zero'); is( $part_values->[0], 20, 'and it has right value'); is( defined $part_values->[1], 1, 'one key is on pos one'); is( $part_values->[1], 10, 'and it has right value'); is( defined $part_values->[2], 1, 'one key is on pos two'); is( $part_values->[2], 30, 'and it has right value'); ($part_values, $space_name) = $dehash->( {C => 1, M => 0.3, Y => 0.4, K => 0} ); is( $space_name, 'CMYK', 'works also with 4 element hashes'); is( ref $part_values, 'ARRAY', 'partial value array is an ARRAY'); is( int @$part_values, 4, 'partial value tuple has four keys'); is( defined $part_values->[0], 1, 'one key is zero'); is( $part_values->[0], 1, 'and it has right value'); is( defined $part_values->[1], 1, 'one key is on pos one'); is( $part_values->[1], 0.3, 'and it has right value'); is( defined $part_values->[2], 1, 'one key is on pos two'); is( $part_values->[2], 0.4, 'and it has right value'); is( defined $part_values->[3], 1, 'one key is on pos three'); is( $part_values->[3], 0, 'and it has right value'); exit 0; 61_space_hub_convert.t100644001750001750 1447415055140237 23010 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 79; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util 'round_decimals'; use Graphics::Toolkit::Color::Space::Hub; my $convert = \&Graphics::Toolkit::Color::Space::Hub::convert; my $deconvert = \&Graphics::Toolkit::Color::Space::Hub::deconvert; ######################################################################## is( ref $convert->(), '', 'convert needs at least one argument'); is( ref $convert->({r => 1,g => 1,b => 1}), '', 'convert only value ARRAY no HASH'); is( ref $convert->([0,0]), '', 'tuple has not enough values'); is( ref $convert->([0,0,0], 'Jou'), '', 'convert needs a valid target name space'); is( ref $deconvert->(), '', 'deconvert needs at least one argument'); is( ref $deconvert->('JAP'), '', 'deconvert needs a valid source space name name'); is( ref $deconvert->('RGB', {r => 1,g => 1,b => 1}), '', 'deconvert tule as ARRAY'); is( ref $deconvert->('JAP', [0,0,0]), '', 'space name bad but tuple good'); my $tuple = $convert->([0,1/255,1], 'RGB'); is( ref $tuple, 'ARRAY', 'did minimal none conversion'); is( int @$tuple, 3, 'RGB has 3 axis'); is( $tuple->[0], 0, 'red value is right'); is( $tuple->[1], 1, 'green value is right'); is( $tuple->[2], 255, 'blue value is right'); $tuple = $convert->([0,1/255,1], 'RGB', 'normal'); is( int @$tuple, 3, 'wanted normalized result'); is( $tuple->[0], 0, 'red value is right'); is( $tuple->[1], 1/255, 'green value is right'); is( $tuple->[2], 1, 'blue value is right'); $tuple = $convert->([.1, .2, .3], 'YUV', 1, 'YUV', [1, .1, 0]); is( int @$tuple, 3, 'take source values instead of convert RGB'); is( $tuple->[0], 1, 'Red value is right'); is( $tuple->[1], .1, 'green value is right'); is( $tuple->[2], 0, 'blue value is right'); $tuple = $convert->([.1, .2, .3], 'YUV', undef, 'YUV', [1, 0.1, 0]); is( int @$tuple, 3, 'get normalized source values'); is( $tuple->[0], 1, 'Red value is right'); is( $tuple->[1], -.4, 'green value is right'); is( $tuple->[2], -.5, 'blue value is right'); $tuple = $convert->([0, 0.1, 1], 'CMY'); is( int @$tuple, 3, 'invert values'); is( $tuple->[0], 1, 'cyan value is right'); is( $tuple->[1], 0.9, 'magenta value is right'); is( $tuple->[2], 0, 'yellow value is right'); $tuple = $convert->([0, 0, 0], 'LAB'); is( ref $tuple, 'ARRAY', 'convert black to LAB (2 hop conversion)'); is( int @$tuple, 3, 'convert black to LAB (2 hop conversion)'); is( round_decimals( $tuple->[0], 5), 0, 'L value is right'); is( round_decimals( $tuple->[1], 5), 0, 'a value is right'); is( round_decimals( $tuple->[2], 5), 0, 'b value is right'); $tuple = $convert->([0, 0, 0], 'LAB', 1); is( int @$tuple, 3, 'convert black to normal LAB'); is( round_decimals( $tuple->[0], 5), 0, 'L value is right'); is( round_decimals( $tuple->[1], 5), .5, 'a value is right'); is( round_decimals( $tuple->[2], 5), .5, 'b value is right'); $tuple = $convert->([1, 1/255, 0], 'LAB'); is( int @$tuple, 3, 'convert bright red to LAB'); is( round_decimals( $tuple->[0], 3), 53.264, 'L value is right'); is( round_decimals( $tuple->[1], 3), 80.024, 'a value is right'); is( round_decimals( $tuple->[2], 3), 67.211, 'b value is right'); $tuple = $convert->([1, 1/255, 0], 'LAB', 0 , 'XYZ', [0,0,0] ); is( int @$tuple, 3, 'convert to LAB with original source in XYZ'); is( round_decimals( $tuple->[0], 5), 0, 'L value is right'); is( round_decimals( $tuple->[1], 5), 0, 'a value is right'); is( round_decimals( $tuple->[2], 5), 0, 'b value is right'); $tuple = $convert->([1, 1/255, 0], 'CIELCHab'); is( int @$tuple, 3, 'convert bright red to LCH (3 hop conversion)'); is( round_decimals( $tuple->[0], 3), 53.264, 'L value is right'); is( round_decimals( $tuple->[1], 3), 104.505, 'C value is right'); is( round_decimals( $tuple->[2], 3), 40.026, 'H value is right'); $tuple = $convert->([1, 1/255, 0], 'CIELCHab', 1); is( int @$tuple, 3, 'convert bright red to normalized LCH'); is( round_decimals( $tuple->[0], 5), .53264, 'L value is right'); is( round_decimals( $tuple->[1], 5), .19389, 'C value is right'); is( round_decimals( $tuple->[2], 5), 0.11118, 'H value is right'); ######################################################################## $tuple = $deconvert->( 'RGB', [0,1/255,1], ); is( ref $tuple, 'ARRAY', 'did minimal none deconversion'); is( int @$tuple, 3, 'RGB has 3 axis'); is( $tuple->[0], 0, 'red value is right'); is( $tuple->[1], 1, 'green value is right'); is( $tuple->[2], 255, 'blue value is right'); $tuple = $deconvert->( 'RGB', [0,1/255,1], 'normal'); is( int @$tuple, 3, 'wanted normalized result'); is( $tuple->[0], 0, 'red value is right'); is( $tuple->[1], 1/255, 'green value is right'); is( $tuple->[2], 1, 'blue value is right'); $tuple = $deconvert->( 'CMY', [0, 0.1, 1] ); is( int @$tuple, 3, 'invert values from CMY'); is( $tuple->[0], 255, 'red value is right'); is( $tuple->[1], 230, 'green value is right'); is( $tuple->[2], 0, 'blue value is right'); $tuple = $deconvert->( 'CMY', [0, 0.1, 1], 'normal' ); is( int @$tuple, 3, 'invert values from CMY'); is( $tuple->[0], 1, 'red value is right'); is( $tuple->[1], 0.9, 'green value is right'); is( $tuple->[2], 0, 'blue value is right'); $tuple = $deconvert->('LAB', [0, 0.5, 0.5] ); is( int @$tuple, 3, 'convert black from LAB'); is( round_decimals( $tuple->[0], 5), 0, 'red value is right'); is( round_decimals( $tuple->[1], 5), 0, 'green value is right'); is( round_decimals( $tuple->[2], 5), 0, 'blue value is right'); $tuple = $deconvert->('LCH', [.53264, 104.505/539, 40.026/360], 1); is( int @$tuple, 3, 'convert bright red from LCH'); is( round_decimals( $tuple->[0], 5), 1, 'L value is right'); is( round_decimals( $tuple->[1], 4), 0.0039, 'C value is right'); is( round_decimals( $tuple->[2], 5), 0, 'H value is right'); ######################################################################## exit 0; 90_public_constructor.t100644001750001750 1716715055140237 23246 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 72; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color::Space::Util ':all'; my $module = 'Graphics::Toolkit::Color'; eval "use $module qw/color/"; is( not( $@), 1, 'could load the module'); is( ref Graphics::Toolkit::Color->new(), '', 'constructor need arguments'); is( ref Graphics::Toolkit::Color->new('red'), $module, 'constructor accepts color name'); is( ref Graphics::Toolkit::Color->new( 'red', 'green'), '', 'constructor needs only one color name'); #~ is( ref Graphics::Toolkit::Color->new('SVG::red'), $module, 'constructor accepts color name from a scheme'); #~ is( ref Graphics::Toolkit::Color->new('SVG::red'), $module, 'constructor accepts color name from a scheme'); is( ref Graphics::Toolkit::Color->new('#000'), $module, 'short hex string with min value'); is( ref Graphics::Toolkit::Color->new('#FFFFFF'), $module, 'long hex string with max value'); is( ref Graphics::Toolkit::Color->new('#1ab2cc'), $module, 'long hex string mixed lc vlaues'); is( ref Graphics::Toolkit::Color->new('#abj'), '', 'short hex string has typo'); is( ref Graphics::Toolkit::Color->new('#AABBGG'), '', 'long hex string has typo'); is( ref Graphics::Toolkit::Color->new('#AA'), '', 'short hex string is too short'); is( ref Graphics::Toolkit::Color->new('#AABF'), '', 'short hex string is too long'); is( ref Graphics::Toolkit::Color->new('#AABBF'), '', 'long hex string is too short'); is( ref Graphics::Toolkit::Color->new('#AABBFFF'), '', 'long hex string is too long'); is( ref Graphics::Toolkit::Color->new('rgb(0, 0, 0)'), $module, 'CSS string format'); is( ref Graphics::Toolkit::Color->new('lab( 12.3, 5.4, 1.2)'), $module, 'CSS string in LAB space'); is( ref Graphics::Toolkit::Color->new('lab( 12.3, 5.4, 1.2%)'), '', 'CSS string with bad suffix'); is( ref Graphics::Toolkit::Color->new('YIQ:5.22, 0, -10 '), $module, 'named string in YIQ space and additional spacing'); is( ref Graphics::Toolkit::Color->new('NCol: B10, 100, 0'), $module, 'named string in Ncol space with min and max values'); is( ref Graphics::Toolkit::Color->new( 4), '', 'constructor needs more than one number'); is( ref Graphics::Toolkit::Color->new( 4,5), '', 'constructor needs more than two numbers'); is( ref Graphics::Toolkit::Color->new( 4,5,6,7), '', 'constructor needs less than four numbers'); is( ref Graphics::Toolkit::Color->new( 1,2,3), $module, 'constructor got three RGB numbers'); is( ref Graphics::Toolkit::Color->new( 1,2,'e4'), '', 'third RGB value has to be number'); is( ref Graphics::Toolkit::Color->new( 1, '2a', 4), '', 'second RGB value has to be number'); is( ref Graphics::Toolkit::Color->new( '%', 2, 4), '', 'first RGB value has to be number'); is( ref Graphics::Toolkit::Color->new( [4,5]), '', 'constructor needs more than two numbers in an ARRAY'); is( ref Graphics::Toolkit::Color->new( [4,5,6,7]), '', 'constructor needs less than four numbers in an ARRAY'); is( ref Graphics::Toolkit::Color->new( [1,2,3]), $module, 'constructor got three RGB numbers in an ARRAY'); is( ref Graphics::Toolkit::Color->new( ['YUV',1,2,3]), $module, 'named ARRAY in YUV space'); is( ref Graphics::Toolkit::Color->new( ['YUV',1,2]), '', 'named ARRAY in YUV space got not enough values'); is( ref Graphics::Toolkit::Color->new( ['YUV',1,2,3,4]), '', 'named ARRAY in YUV space got too many values'); is( ref Graphics::Toolkit::Color->new( ['cmyk',1,0,0,0]), $module, 'named ARRAY in CMYK space'); is( ref Graphics::Toolkit::Color->new( ['cmyk',1,0,0]), '', 'CMYK ARRAY got not enough values'); is( ref Graphics::Toolkit::Color->new( ['cmyk',1,0,0,0,0]), '', 'CMYK ARRAY got too much values'); is( ref Graphics::Toolkit::Color->new( ['cmk', 0,0,0]), '', 'only known color space names are accepted '); is( ref Graphics::Toolkit::Color->new( ['CIELCHab', 0, 0, 0]), $module, 'long mixed case alias names work too'); is( ref Graphics::Toolkit::Color->new( ['hsb', 100.23, 0.173, .214]), $module, 'different number shapes'); is( ref Graphics::Toolkit::Color->new( ['NCol','B10','100%','0%']), $module, 'named ARRAY with values that need preprocessing'); is( ref Graphics::Toolkit::Color->new( ['ncol','B0','100','0']), $module, 'try single digit string value'); is( ref Graphics::Toolkit::Color->new( OKLAB => [0,0,0] ), $module, 'named ARRAY ref in uc oklab space'); is( ref Graphics::Toolkit::Color->new( 'hunterlab', [1,2,3] ), $module, 'named ARRAY ref in lc hunterlab space'); is( ref Graphics::Toolkit::Color->new( { }), '', 'HASH needs keys'); is( ref Graphics::Toolkit::Color->new( {r=> 1 }), '', 'HASH one key is not enough'); is( ref Graphics::Toolkit::Color->new( r=> 1 ), '', 'even without a HASH ref'); is( ref Graphics::Toolkit::Color->new( {r=> 1, g=>2 }), '', 'HASH two keys are not enough'); is( ref Graphics::Toolkit::Color->new( r=> 1, g=>2 ), '', 'also without a HASH ref'); is( ref Graphics::Toolkit::Color->new( { }), '', 'HASH needs keys'); is( ref Graphics::Toolkit::Color->new( {r => 0, g => 0, b => 0 }), $module, 'RGB short HASH'); is( ref Graphics::Toolkit::Color->new( r => 0, g => 0, b => 0 ), $module, 'RGB short HASH without ref'); is( ref Graphics::Toolkit::Color->new( red => 0, G => 0, b => 0 ), $module, 'can mix long and short, lc and uc axis names'); is( ref Graphics::Toolkit::Color->new( {r => 0, g => 0, b => 0, y=> 1 }), '', 'too many keys'); is( ref Graphics::Toolkit::Color->new( r => 0, g => 0, b => 0, y=> 1), '', 'also without ref'); is( ref Graphics::Toolkit::Color->new( c => 0, m => 0, k => 0, y=> 1), $module, 'CMYK hash'); is( ref Graphics::Toolkit::Color->new( c => 0, m => 0, kkey => 0, y=> 1), '', 'one key has typo'); is( ref Graphics::Toolkit::Color->new( c => 0, m => 0, k=> 1), '', 'one key is missing'); is( ref Graphics::Toolkit::Color->new( luma => 0, Pb => 0, Pr=> .5), $module, 'YPbPr hash'); is( ref Graphics::Toolkit::Color->new( 'L*' => 0, 'a*' => '100','b*'=> .5),$module, 'LAB hash'); is( ref Graphics::Toolkit::Color->new( 'L*' => 0, 'a*' => '10e0', 'b*' => .5), '', 'dont accept scientific notation'); is( ref Graphics::Toolkit::Color->new( l => 0, chroma => '0', hue => 0), $module, 'CIELCHuv hash'); is( ref Graphics::Toolkit::Color->new( l => "0%", c => '0', hue => 0), '', 'CIELCHuv has no value suffix'); is( ref Graphics::Toolkit::Color->new( h => "0", w => '0', b => 0), $module, 'HWB hash'); is( ref Graphics::Toolkit::Color->new( h=> "R100",w => '0%', b=> '100%'), $module, 'NCol hash'); is( ref Graphics::Toolkit::Color->new( Y => 0, U => 0, V => 100), $module, 'YPbPr short hash'); is( ref Graphics::Toolkit::Color->new( X => 0, Y => 0, Z => 0), $module, 'XYZ short hash (has no long names)'); is( ref color( Y => 0, U => 0, V => 100), $module, 'short named constructor method'); is( ref color( ), '', 'needs also args'); is( ref color( 1,1), '', 'two are not enough'); is( ref color( 1,1,1,1), '', 'four are too many'); is( ref color( '#0000ff' ), $module, 'can also recieve lc hex sting'); is( ref color( [1,2,3] ), $module, 'ARRAY ref'); is( ref color( {l => 50, c => 12.4, h => .6} ), $module, 'LCH short axis name HASH'); is( ref color( {hue => 0, whiteness => '0%', blackness => '100%'} ), $module, 'HWB long axis name HASH'); exit 0; 92_public_calc_single.t100644001750001750 2410515055140237 23114 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/t#!/usr/bin/perl use v5.12; use warnings; use Test::More tests => 93; BEGIN { unshift @INC, 'lib', '../lib'} use Graphics::Toolkit::Color qw/color/; my $module = 'Graphics::Toolkit::Color'; my $red = color('#FF0000'); my $blue = color('#0000FF'); my $white = color('white'); my $black = color('black'); #### invert ############################################################ is( ref $white->invert('-'), '', 'need a valid name space to invert'); is( ref $white->invert( at => 'RGB'), '', 'can not use invented arguments'); is( ref $white->invert(), $module, 'works without argument'); is( ref $white->invert(in => 'RGB'), $module, 'can use "in" argument'); is( $white->invert()->name, 'black', 'black is white inverted'); is( $white->invert('RGB')->name, 'black', 'explicit color space name works'); is( $white->invert(in => 'RGB')->name, 'black', 'named argument works'); is( $black->invert('RGB')->name, 'white', 'white is black inverted'); is( $blue->invert('RGB')->name, 'yellow', 'yellow is blue inverted'); is( $blue->invert('HSL')->name, 'gray', 'in HSL is gray opposite to any color'); is( $blue->invert('LAB')->name, '', 'LAB is not symmetrical'); is( $white->invert('HSL')->name, 'black', 'primary contrast works in HSL'); is( $white->invert('HWB')->name, 'black', 'primary contrast works in HWB'); #### set_value ######################################################### is( ref $white->set_value(), '', 'need some argument for "set_value"'); is( ref $white->set_value(ar => 3), '', 'reject invented axis names'); is( ref $white->set_value(r => 3, y => 1), '', 'reject mixing axis frm different spaces'); is( ref $white->set_value( red => 1), $module, 'accept real axis names'); is( ref $white->set_value( red => 1, in => 'RGB'), $module, 'accept mixed arguments, axis name and space name'); my @values = $white->set_value( red => 1 )->values(); is( int @values, 3, 'got 3 values'); is( $values[0], 1, 'red value has the set number'); is( $values[1], 255, 'green value has the old number'); is( $values[2], 255, 'blue value has also the old number'); @values = $white->set_value( red => 1, in => 'RGB')->values(); is( int @values, 3, 'same like before, but tied color space'); is( $values[0], 1, 'red value has the set number'); is( $values[1], 255, 'green value has the old number'); is( $values[2], 255, 'blue value has also the old number'); @values = $white->set_value( r => 0, g => 22, b => 256)->values(); is( int @values, 3, 'use short axis names'); is( $values[0], 0, 'red value has the set number, zero'); is( $values[1], 22, 'green value has the set number'); is( $values[2], 255, 'blue has the clamped number, was too big'); is( $white->set_value( lightness => 0)->name, 'black', 'dimming down to black'); is( $white->set_value( blackness => 100)->name, 'black', 'works in HWB too'); #### add_value ######################################################### is( ref $white->add_value(), '', 'need some argument for "add_value"'); is( ref $white->add_value( bu => 3), '', 'reject invented axis names'); is( ref $white->add_value( blue => 3, 'a*' => 1), '', 'reject mixing axis frm different spaces'); is( ref $white->add_value( blue => 3, in => 'LAB'), '', 'blue is no axis in CIELAB'); is( ref $white->add_value( BLUE => 1), $module, 'accept real axis names, even in upper case'); is( ref $white->add_value( Yellow => 1, in => 'CMY'), $module, 'accept mixed arguments, axis name and space name'); @values = $white->add_value( Yellow => 1)->values(); is( int @values, 3, 'added yellow by one'); is( $values[0], 255, 'red value has the old number'); is( $values[1], 255, 'green value has the old number'); is( $values[2], 0, 'blue value has the reduced number'); @values = $white->add_value( Yellow => 1, in => 'CMY')->values(); is( int @values, 3, 'named explicitly color space'); is( $values[0], 255, 'red value has the old number'); is( $values[1], 255, 'green value has the old number'); is( $values[2], 0, 'blue value has the reduced number'); @values = $white->add_value( Lightness => -1)->values(in => 'HSL'); is( int @values, 3, 'HSL has 3 values'); is( $values[0], 0, 'hue is zero'); is( $values[1], 0, 'saturation value is also zero'); is( $values[2], 99, 'lightness was reduced'); @values = $white->add_value( hue => 600, Lightness => +1)->values(in => 'HSL'); is( int @values, 3, 'changed two values at once'); is( $values[0], 240, 'hue was added and rotated into range'); is( $values[1], 0, 'saturation value is also zero'); is( $values[2], 100, 'lightness was raised and clamped back into range'); ######################################################################## is( ref $white->mix(), '', 'need some argument for "mix"'); is( ref $white->mix( 'ellow'), '', 'reject invented color name'); is( ref $white->mix( to => 'ellow'), '', 'reject invented color name as named argument'); is( ref $white->mix( to => 'blue', 'a*' => 1), '', 'reject invented argument names'); is( ref $white->mix( to => 'blue', 'in' => 'HS'), '', 'reject invented color space name'); is( ref $white->mix( to => 'blue', amount => []), '', 'amount arg is ARRAY and colors not'); is( ref $white->mix( to => ['blue'], amount => [1,2]), '', 'amount and to arg ARRAY have different length'); is( ref $white->mix( 'black'), $module, 'one argument mode'); is( ref $white->mix( ['black']), $module, 'one argument mode, but ARRAY'); is( ref $white->mix( ['black', $blue]), $module, 'one argument mode, but longer ARRAY'); is( ref $white->mix( to => 'black'), $module, 'one named argument mode'); is( ref $white->mix( to => ['black']), $module, 'one named argument as ARRAY'); is( ref $white->mix( to => ['black', 'blue']), $module, 'one named argument as longer ARRAY'); is($white->mix( $black)->name, 'gray', 'grey is the mix between black and white'); is($white->mix( to => 'black')->name, 'gray', 'use color constant and named argument'); is($white->mix( to => 'black', amount => 50)->name, 'gray', 'use also amount argument'); is($white->mix( to => 'black', amount => 20)->name,'gray80', 'use different amount'); @values = $white->mix( to => $blue, in => 'HSL')->values('HSL'); is( int @values, 3, 'HSL has three values'); is( $values[0], 120, 'hue is green (between white = red = 0 and blue)'); is( $values[1], 50, 'saturation is 50 since thite had none'); is( $values[2], 75, 'lightness is between 50 and 100'); @values = $white->mix( to => $blue, in => 'HSL', amount => 10)->values('HSL'); is( int @values, 3, 'only little blue this time'); is( $values[0], 24, 'hue redish'); is( $values[1], 10, 'saturation is 10 since thite had none'); is( $values[2], 95, 'lightness is from 100 - 10% toward 50'); @values = $white->mix( to => $blue, in => 'HSL', amount => 110)->values('HSL'); is( int @values, 3, 'using too much blue this time'); is( $values[0], 240, 'blue hue'); is( $values[1], 100, 'full saturation'); is( $values[2], 50, 'half lightness, like all fully saturated colors'); @values = $white->mix( to => [$blue, $black] )->values('RGB'); is( int @values, 3, 'mixing three colors, but actually only 2'); is( $values[0], 0, 'red is zero'); is( $values[1], 0, 'no green saturation'); is( $values[2], 128, 'half blue value'); @values = $white->mix( to => [$blue, $black], amount => [20, 10] )->values('RGB'); is( $values[0], 179, 'red value = 70% white'); is( $values[1], 179, 'green is same'); is( $values[2], 230, 'blue = 70% white + 20% blue'); @values = $white->mix( to => [$blue, $black], amount => [80, 20] )->values('RGB'); is( $values[0], 0, 'red value is zero = 80% blue + 20% black = 0 + 0'); is( $values[1], 0, 'green is same'); is( $values[2], 204, 'blue value is 80% blue + nothing from black'); exit 0; Toolkit000755001750001750 015055140237 22122 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/GraphicsColor.pm100644001750001750 13446615055140237 23754 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit # public user level API: docs, help and arg cleaning package Graphics::Toolkit::Color; our $VERSION = '1.972'; use v5.12; use warnings; use Exporter 'import'; use Graphics::Toolkit::Color::Space::Util qw/is_nr/; use Graphics::Toolkit::Color::SetCalculator; my $default_space_name = Graphics::Toolkit::Color::Space::Hub::default_space_name(); our @EXPORT_OK = qw/color/; ## constructor ######################################################### sub color { Graphics::Toolkit::Color->new ( @_ ) } sub new { my ($pkg, @args) = @_; my $help = < 255, g => 0, b => 0) or new({ hue => 0, saturation => 100, lightness => 50 }) EOH my $first_arg_is_color_space = Graphics::Toolkit::Color::Space::Hub::is_space_name( $args[0] ); @args = ([ $args[0], @{$args[1]} ]) if @args == 2 and $first_arg_is_color_space and ref $args[1] eq 'ARRAY'; @args = ([ @args ]) if @args == 3 or (@args > 3 and $first_arg_is_color_space); @args = ({ @args }) if @args == 6 or @args == 8; return $help unless @args == 1; my $self = _new_from_scalar_def( $args[0] ); return (ref $self) ? $self : $help; } sub _new_from_scalar_def { # color defs of method arguments my ($color_def) = shift; return $color_def if ref $color_def eq __PACKAGE__; return _new_from_value_obj( Graphics::Toolkit::Color::Values->new_from_any_input( $color_def ) ); } sub _new_from_value_obj { my ($value_obj) = @_; return $value_obj unless ref $value_obj eq 'Graphics::Toolkit::Color::Values'; return bless {values => $value_obj}; } ## deprecated methods - deleted with 2.0 sub string { $_[0]{'name'} || $_[0]->{'values'}->string } sub rgb { $_[0]->values( ) } sub red {($_[0]->values( ))[0] } sub green {($_[0]->values( ))[1] } sub blue {($_[0]->values( ))[2] } sub rgb_hex { $_[0]->values( as => 'hex') } sub rgb_hash { $_[0]->values( as => 'hash') } sub hsl { $_[0]->values( in => 'hsl') } sub hue {($_[0]->values( in => 'hsl'))[0] } sub set { shift->set_value( @_ ) } sub add { shift->add_value( @_ ) } sub saturation {($_[0]->values( in => 'hsl'))[1] } sub lightness {($_[0]->values( in => 'hsl'))[2] } sub hsl_hash { $_[0]->values( in => 'hsl', as => 'hash') } sub distance_to { distance(@_) } sub blend { mix( @_ ) } sub blend_with { $_[0]->mix( with => $_[1], amount => $_[2], in => 'HSL') } 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 complementary { complement(@_) } sub _split_named_args { my ($raw_args, $only_parameter, $required_parameter, $optional_parameter, $parameter_alias) = @_; @$raw_args = %{$raw_args->[0]} if @$raw_args == 1 and ref $raw_args->[0] eq 'HASH' and not (defined $only_parameter and $only_parameter eq 'to' and ref _new_from_scalar_def( $raw_args ) ); if (@$raw_args == 1 and defined $only_parameter and $only_parameter){ return "The one default argument can not cover multiple, required parameter !" if @$required_parameter > 1; return "The default argument does not cover the required argument!" if @$required_parameter and $required_parameter->[0] ne $only_parameter; my %defaults = %$optional_parameter; delete $defaults{$only_parameter}; return {$only_parameter => $raw_args->[0], %defaults}; } my %clean_arg; if (@$raw_args % 2) { return (defined $only_parameter and $only_parameter) ? "Got odd number of values, please use key value pairs as arguments or one default argument !\n" : "Got odd number of values, please use key value pairs as arguments !\n" } my %arg_hash = @$raw_args; for my $parameter_name (@$required_parameter){ if (ref $parameter_alias eq 'HASH' and exists $parameter_alias->{ $parameter_name } and exists $arg_hash{ $parameter_alias->{$parameter_name} }){ $arg_hash{ $parameter_name } = delete $arg_hash{ $parameter_alias->{$parameter_name} }; } return "Argument '$parameter_name' is missing\n" unless exists $arg_hash{$parameter_name}; $clean_arg{ $parameter_name } = delete $arg_hash{ $parameter_name }; } for my $parameter_name (keys %$optional_parameter){ if (ref $parameter_alias eq 'HASH' and exists $parameter_alias->{ $parameter_name } and exists $arg_hash{ $parameter_alias->{$parameter_name} }){ $arg_hash{ $parameter_name } = delete $arg_hash{ $parameter_alias->{$parameter_name} }; } $clean_arg{ $parameter_name } = exists $arg_hash{$parameter_name} ? delete $arg_hash{ $parameter_name } : $optional_parameter->{ $parameter_name }; } return "Inserted unknown argument(s): ".(join ',', keys %arg_hash)."\n" if %arg_hash; return \%clean_arg; } ## getter ############################################################## sub values { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'in', [], { in => $default_space_name, as => 'list', precision => undef, range => undef, suffix => undef } ); my $help = < 'HSL', # color space name, defaults to "$default_space_name" as => 'css_string', # output format name, default is "list" range => 1, # value range (SCALAR or ARRAY), default set by space def precision => 3, # value precision (SCALAR or ARRAY), default set by space suffix => '%', # value suffix (SCALAR or ARRAY), default set by color space EOH return $arg.$help unless ref $arg; $self->{'values'}->formatted( @$arg{qw/in as suffix range precision/} ); } sub name { my ($self, @args) = @_; return $self->{'values'}->name unless @args; my $arg = _split_named_args( \@args, 'from', [], {from => 'default', all => 0, full => 0, distance => 0}); my $help = < 'CSS' # same scheme (defaults to internal: X + CSS + PantoneReport) from => ['SVG', 'X'] # more color naming schemes at once, without duplicates all => 1 # returns list of all names with the object's RGB values (defaults 0) full => 1 # adds color scheme name to the color name. 'SVG:red' (defaults 0) distance => 3 # color names from within distance of 3 (defaults 0) EOH return Graphics::Toolkit::Color::Name::from_values( $self->{'values'}->shaped, @$arg{qw/from all full distance/}); } sub closest_name { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'from', [], {from => 'default', all => 0, full => 0}); my $help = < 'CSS' # same scheme (defaults to internal: X + CSS + PantoneReport) from => ['SVG', 'X'] # more color naming schemes at once, without duplicates all => 1 # returns list of all names with the object's RGB values (defaults 0) full => 1 # adds color scheme name to the color name. 'SVG:red' (defaults 0) EOH my ($name, $distance) = Graphics::Toolkit::Color::Name::closest_from_values( $self->{'values'}->shaped, @$arg{qw/from all full/}); return wantarray ? ($name, $distance) : $name; } sub distance { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'to', ['to'], {in => $default_space_name, select => undef, range => undef}); my $help = < 'green' # color object or color definition (required) in => 'HSL' # color space name, defaults to "$default_space_name" select => 'red' # axis name or names (ARRAY ref), default is none range => 2**16 # value range definition, defaults come from color space def EOH return $arg.$help unless ref $arg; my $target_color = _new_from_scalar_def( $arg->{'to'} ); return "target color definition: $arg->{to} is ill formed" unless ref $target_color; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $arg->{'in'} ); return "$color_space\n".$help unless ref $color_space; if (defined $arg->{'select'}){ if (not ref $arg->{'select'}){ return $arg->{'select'}." is not an axis name in color space: ".$color_space->name unless $color_space->is_axis_name( $arg->{'select'} ); } elsif (ref $arg->{'select'} eq 'ARRAY'){ for my $axis_name (@{$arg->{'select'}}) { return "$axis_name is not an axis name in color space: ".$color_space->name unless $color_space->is_axis_name( $axis_name ); } } else { return "The 'select' argument needs one axis name or an ARRAY with several axis names". " from the same color space!" } } my $range_def = $color_space->shape->try_check_range_definition( $arg->{'range'} ); return $range_def unless ref $range_def; Graphics::Toolkit::Color::Space::Hub::distance( $self->{'values'}->normalized, $target_color->{'values'}->normalized, $color_space->name ,$arg->{'select'}, $range_def ); } ## single color creation methods ####################################### sub set_value { my ($self, @args) = @_; @args = %{$args[0]} if @args == 1 and ref $args[0] eq 'HASH'; my $help = < 20 ) or set( g => 20 ) or set_value( hue => 240, in => 'HWB' ) EOH return $help if @args % 2 or not @args or @args > 10; my $partial_color = { @args }; my $space_name = delete $partial_color->{'in'}; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name ); return "$color_space\n".$help unless ref $color_space; _new_from_value_obj( $self->{'values'}->set( $partial_color, $space_name ) ); } sub add_value { my ($self, @args) = @_; @args = %{$args[0]} if @args == 1 and ref $args[0] eq 'HASH'; my $help = < -10 ) or set( b => -10 ) add_value( hue => 100 , in => 'HWB' ) EOH return $help if @args % 2 or not @args or @args > 10; my $partial_color = { @args }; my $space_name = delete $partial_color->{'in'}; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name ); return "$color_space\n".$help unless ref $color_space; _new_from_value_obj( $self->{'values'}->add( $partial_color, $space_name ) ); } sub mix { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'to', ['to'], {in => $default_space_name, amount => 50}); my $help = < ['HSL', 240, 100, 50] # scalar color definition or ARRAY ref thereof amount => 20 # percentage value or ARRAY ref thereof, default is 50 in => 'HSL' # color space name, defaults to "$default_space_name" Please note that either both or none of the first two arguments has to be an ARRAY. Both ARRAY have to have the same length. 'amount' refers to the color(s) picked with 'to'. EOH return $arg.$help unless ref $arg; my $recipe = _new_from_scalar_def( $arg->{'to'} ); if (ref $recipe){ $recipe = [{color => $recipe->{'values'}, percent => 50}]; return "Amount argument has to be a sacalar value if only one color is mixed !\n".$help if ref $arg->{'amount'}; $recipe->[0]{'percent'} = $arg->{'amount'} if defined $arg->{'amount'}; } else { if (ref $arg->{'to'} ne 'ARRAY'){ return "target color definition (argument 'to'): $arg->{to} is ill formed, has to be one color definition or an ARRAY of"; } else { $recipe = []; for my $color_def (@{$arg->{'to'}}){ my $color = _new_from_scalar_def( $color_def ); return "target color definition: '$color_def' is ill formed" unless ref $color; push @$recipe, { color => $color->{'values'}, percent => 50}; } return "Amount argument has to be an ARRAY of same length as argument 'to' (color definitions)!\n".$help if ref $arg->{'to'} eq 'ARRAY' and ref $arg->{'amount'} eq 'ARRAY' and @{$arg->{'amount'}} != @{$arg->{'to'}}; $arg->{'amount'} = [($arg->{'amount'}) x @{$arg->{'to'}}] if ref $arg->{'to'} and not ref $arg->{'amount'}; $recipe->[$_]{'percent'} = $arg->{'amount'}[$_] for 0 .. $#{$arg->{'amount'}}; } } my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( delete $arg->{'in'} ); return "$color_space\n".$help unless ref $color_space; _new_from_value_obj( $self->{'values'}->mix( $recipe, $color_space ) ); } sub invert { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'in', [], {in => $default_space_name}); my $help = < 'HSL' # color space name, defaults to "$default_space_name" EOH return $arg.$help unless ref $arg; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $arg->{'in'} ); return "$color_space\n".$help unless ref $color_space; _new_from_value_obj( $self->{'values'}->invert( $color_space ) ); } ## color set creation methods ########################################## sub complement { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'steps', [], {steps => 1, tilt => 0, target => {}}); my $help = < 20 # count of produced colors, default is 1 tilt => 10 # default is 0 target => {h => 10, s => 20, l => 3} # sub-keys are independent, default to 0 EOH return $arg.$help unless ref $arg; return "Optional argument 'steps' has to be a number !\n".$help unless is_nr($arg->{'steps'}); return "Optional argument 'steps' is zero, no complement colors will be computed !\n".$help unless $arg->{'steps'}; return "Optional argument 'tilt' has to be a number !\n".$help unless is_nr($arg->{'tilt'}); return "Optional argument 'target' has to be a HASH ref !\n".$help if ref $arg->{'target'} ne 'HASH'; my ($target_values, $space_name); if (keys %{$arg->{'target'}}){ ($target_values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat_partial_hash( $arg->{'target'}, 'HSL' ); return "Optional argument 'target' got HASH keys that do not fit HSL space (use 'h','s','l') !\n".$help unless ref $target_values; } else { $target_values = [] } map {_new_from_value_obj( $_ )} Graphics::Toolkit::Color::SetCalculator::complement( $self->{'values'}, @$arg{qw/steps tilt/}, $target_values ); } sub gradient { my ($self, @args) = @_; my $arg = _split_named_args( \@args, 'to', ['to'], {steps => 10, tilt => 0, in => $default_space_name}); my $help = < 'blue' # scalar color definition or ARRAY ref thereof steps => 20 # count of produced colors, defaults to 10 tilt => 1 # dynamics of color change, defaults to 0 in => 'HSL' # color space name, defaults to "$default_space_name" EOH return $arg.$help unless ref $arg; my @colors = ($self->{'values'}); my $target_color = _new_from_scalar_def( $arg->{'to'} ); if (ref $target_color) { push @colors, $target_color->{'values'} } else { return "Argument 'to' contains malformed color definition!\n".$help if ref $arg->{'to'} ne 'ARRAY' or not @{$arg->{'to'}}; for my $color_def (@{$arg->{'to'}}){ my $target_color = _new_from_scalar_def( $color_def ); return "Argument 'to' contains malformed color definition: $color_def !\n".$help unless ref $target_color; push @colors, $target_color->{'values'}; } } return "Argument 'steps' has to be a number greater zero !\n".$help unless is_nr($arg->{'steps'}) and $arg->{'steps'} > 0; $arg->{'steps'} = int $arg->{'steps'}; return "Argument 'tilt' has to be a number !\n".$help unless is_nr($arg->{'tilt'}); my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $arg->{'in'} ); return "$color_space\n".$help unless ref $color_space; map {_new_from_value_obj( $_ )} Graphics::Toolkit::Color::SetCalculator::gradient( \@colors, @$arg{qw/steps tilt/}, $color_space); } sub cluster { my ($self, @args) = @_; my $arg = _split_named_args( \@args, undef, ['radius', 'minimal_distance'], {in => $default_space_name}, {radius => 'r', minimal_distance => 'min_d'} ); my $help = < 3 # ball shaped cluster with cuboctahedral packing or r => [10, 5, 3] # cuboid shaped cluster with cubical packing minimal_distance => 0.5 # minimal distance between colors in cluster min_d => 0.5 # short alias for minimal distance in => 'HSL' # color space name, defaults to "$default_space_name" EOH return $arg.$help unless ref $arg; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $arg->{'in'} ); return "$color_space\n".$help unless ref $color_space; return "Argument 'radius' has to be a number or an ARRAY of numbers".$help unless is_nr($arg->{'radius'}) or $color_space->is_number_tuple( $arg->{'radius'} ); return "Argument 'distance' has to be a number greater zero !\n".$help unless is_nr($arg->{'minimal_distance'}) and $arg->{'minimal_distance'} > 0; return "Ball shaped cluster works only in spaces with three dimensions !\n".$help if $color_space->axis_count > 3 and not ref $arg->{'radius'}; map {_new_from_value_obj( $_ )} Graphics::Toolkit::Color::SetCalculator::cluster( $self->{'values'}, @$arg{qw/radius minimal_distance/}, $color_space); } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color - calculate color (sets), IO many spaces and formats =head1 SYNOPSIS use Graphics::Toolkit::Color qw/color/; my $red = Graphics::Toolkit::Color->new('red'); # create color object say $red->add_value( 'blue' => 255 )->name; # red + blue = 'magenta' my @blue = color( 0, 0, 255)->values('HSL'); # 240, 100, 50 = blue $red->mix( to => [HSL => 0,0,80], amount => 10); # mix red with a little grey $red->gradient( to => '#0000FF', steps => 10); # 10 colors from red to blue my @base_triadic = $red->complement( 3 ); # get fitting red green and blue my @reds = $red->cluster( radius => 4, distance => 1 ); =head1 DEPRECATION WARNING Methods of the old API ( I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I, I) will be removed with release of version 2.0. =head1 DESCRIPTION Graphics::Toolkit::Color, for short B, is the top level API of this release and the only package a regular user should be concerned with. Its main purpose is the creation of related colors or sets of them, such as gradients, complements and others. But you can use it also to convert and/or reformat color definitions. GTC are read only, one color representing objects with no additional dependencies. Create them in many different ways (see L). Access its values via methods from section L. Measure differences with the L method. L methods create one new object that is related to the current one and L methods will create a group of colors, that are not only related to the current color but also have relations between each other. Error messages will appear as return values instead of the expected result. While this module can understand and output color values to many L, L is the (internal) primal one, because GTC is about colors that can be shown on the screen, and these are usually encoded in I. Humans access colors on hardware level (eye) in I, on cognition level in I (brain) and on cultural level (language) with names. Having easy access to all of those plus some color math and many formats should enable you to get the color palette you desire quickly. =head1 CONSTRUCTOR There are many options to create a color object. In short you can either use the name of a constant (see L) or provide values, which are coordinates in one of several L. The latter are also understood in many L. From now on any input that the constructor method C accepts, is called a B. =head2 new({ r => $r, g => $g, b => $b }) Most clear, flexible and longest input format: a hash with long or short axis names as keys with fitting values. This can be C, C and C or C, C and C or names from any other color space. Upper or lower case doesn't matter. 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( [$r, $g, $b] ) takes a triplet of integer I values (red, green and blue : 0 .. 255). They can, but don't have to be put into an ARRAY reference (square brackets). If you want to define a color by values from another color space, you have to prepend the values with the name of a supported color space. Out of range values will be corrected (clamped). 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 ARRAY syntax my $red = Graphics::Toolkit::Color->new( RGB => 255, 0, 0 ); # with fat comma my $red = Graphics::Toolkit::Color->new([ RGB => 255, 0, 0]); # and brackets my $red = Graphics::Toolkit::Color->new( RGB =>[255, 0, 0]); # separate name and values my $red = Graphics::Toolkit::Color->new( YUV =>.299,-0.168736, .5); # same color in YUV =head2 new('rgb($r,$g,$b)') String format that is supported by CSS (I format): it starts with the case insensitive color space name (lower case is default), followed by the (optionally with) comma separated values in round braces. The value suffixes that are defined by the color space (I<'%'> in case of I) are optional. 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') String format I (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') Color definitions in hexadecimal format as widely used in the web, are also acceptable (I only). my $color = Graphics::Toolkit::Color->new('#FF0000'); my $color = Graphics::Toolkit::Color->new('#f00'); # short works too =head2 new('name') Get a color object by providing a name from the X11, HTML (CSS) or SVG scheme 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 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 or with L. See all scheme names L. The color name will be normalized as above. my $color = Graphics::Toolkit::Color->new('SVG:green'); my @schemes = Graphics::ColorNames::all_schemes(); # look up the installed =head2 color If writing Graphics::Toolkit::Color->new( ...); is too much typing work for you or takes up to much space in the code file, import the subroutine C, which accepts all the same arguments as C. 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 values Returns the numeric values of the color, held by the object. The method accepts five optional, named arguments: L (color space), C (format), L, C and C. In most cases, only the first one is needed. When given no arguments, the method returns a list with the integer values: C, C and C in 0 .. 255 range, since I is the default color space of this module. If one positional argument is provided, the values get converted into the color space of the given name. The same is done when using the named argument L (full explanation behind the link). The named argument L is also explained in its own section. Please note you have to use the C argument only, if you like to deviate from the value ranges defined by the chosen color space. The maybe most characteristic argument for this method is C, which enables all the same formats the constructor method C accepts. I is built with the design principle of total serialisation. This means: every contructor input format can be reproduced by a getter method and vice versa. These formats are: C (default), C, C, C, C, C, C (RGB only) and C (RGB only). The remaining two. C and C are produce by the method L. Format names are case insensitive. For more explanations, please see: L in GTC::Space::Hub. C is more exotic argument, but sometimes you need to escape the numeric precision, set by a color spaces definition. For instance C values will have maximally three decimals, no matter how precise the input was. In case you prefer 4 decimals, just use C<< precision => 4 >>. A zero means no decimals and -1 stands for maximal precision - which can spit out more decimals than you prefer. Different precisions per axis are possible via an ARRAY ref: C<< precision => [1,2,3] >>. In same way you can atach a little strings per value by ussing the C argument. Normally these are percentage signs but in some spaces, where they appear by default you can surpress them by adding C<< suffix => '' >> $blue->values(); # 0, 0, 255 $blue->values( in => 'RGB', as => 'list'); # 0, 0, 255 # explicit arguments $blue->values( as => 'array'); # [0, 0, 255] - RGB only $blue->values( in => 'RGB', as => 'named_array'); # ['RGB', 0, 0, 255] $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 => 'named_string'); # 'rgb: 0, 0, 255' $blue->values( in => 'RGB', as => 'css_string'); # 'rgb( 0, 0, 255)' $blue->values( as => 'hex_string'); # '#0000ff' - RGB only $blue->values( range => 2**16 ); # 0, 0, 65536 $blue->values('HSL'); # 240, 100, 50 $blue->values( in => 'HSL',suffix => ['', '%','%']);# 240, '100%', '50%' $blue->values( in => 'HSB', as => 'hash')->{'hue'};# 240 ($blue->values( 'HSB'))[0]; # 240 $blue->values( in => 'XYZ', range => 1, precision => 2);# normalized, 2 decimals max. =head2 name Returns the normalized name string (lower case, without I<'_'>) that represents the I values of this color in the default color scheme, which is I + I (I) + I (see L). These are the same which can be used with L. Alternatively you may provide named arguments or one positional argument, which is the same as the named argument C. That required a name of a color schemes, as listed L. You also can submit a list thereof inside a ARRRAY ref which also dictates the order of resulting color names. Please note that all color schemes, except the default one, depend on external modules, which have to be installed separately or via L. If you try to use a scheme from a not installed module your will get an error message instead of a color name. You can also create your custom color naming scheme via L. The second named argument is C, which needs to be a perly boolean. It defaults to false. But if set to 1, you will get a list of all names that are associated with the current values. There will be no duplicates, when several schemes are searched. A third named argument is C - also needing a perly boolean that defaults to false. When set C (1), the schema name becomes part of the returned color name as in C<'SVG:red'>. These full names are also accepted by the constructor. The fourth named argument is C, which means the same thing as in L and it defaults to zero. It is most useful in combinataion with C to get all color names that are within a certain distance. $blue->name(); # 'blue' $blue->name('SVG'); # 'blue' $blue->name( from => [qw/CSS X/], all => 1); # 'blue', 'blue1' $blue->name( from => 'CSS', full => 1); # 'CSS:blue' $blue->name( distance => 3, all => 1) ; # all names within the distance =head2 closest_name Returns in scalar context a color name, which has the shortest L in Into the current color. In list context, you get additionally the just mentioned distance as a second return value. This method works almost identically as method L, but guarantees a none empty result, unless invoking a unusually empty color scheme. All arguments work as mentioned above, only here is no C argument. The only difference is (due to the second return value), multiple names (when requested) have to come in the form of an ARRAY as the first return value. my $name = $red_like->closest_name; # closest name in default scheme my $name = $red_like->closest_name('HTML'); # closest HTML constant ($red_name, $distance) = $red_like->closest_name( from => 'Pantone', all => 1 ); =head2 distance Is a floating point number that measures the Euclidean distance between two colors, which represent two points in a color space. One color is the calling object itself and the second one has to be provided as either the only argument or the named argument L, which is the only required one. The C is measured in I color space unless told otherwise by the argument L. Please use the I or I space, if you are interested in getting a result that matches the human perception. The third argument is named C, which can change the result drasticly. my $d = $blue->distance( 'lapisblue' ); # how close is blue to lapis? $d = $blue->distance( to => 'airyblue', select => 'b'); # have they the same amount of blue? $d = $color->distance( to => $c2, in => 'HSL', select => 'hue' ); # same hue? $d = $color->distance( to => $c2, range => 'normal' ); # distance with values in 0 .. 1 range $d = $color->distance( to => $c2, select => [qw/r g b b/]); # double the weight of blue value differences =head1 SINGLE COLOR These methods generate one new color object that is related to the calling object (invocant). You might expect that methods like C change the values of the invocant, but GTC objects are as mentioned in the L read only. That supports a more functional programming style as well as method stacking like: $color->add_value( saturation => 5)->invert->mix( to => 'green'); =head2 set_value Creates a new GTC color object that shares some values with the current one, but differs in others. The altered values are provided as absoltue numbers. If the resulting color will be outside of the given color space, the values will be clamped so it will become a regular color of that space. The axis of L have long and short names. For instance I has I, I and I. The short equivalents are I, I and I. This method accepts these axis names as named arguments and disregards if characters are written upper or lower case. This method can not work, if you mix axis names from different spaces or choose one axis more than once. One solvable issue is when axis in different spaces have the same name. For instance I and I have a I axis. To disambiguate you can add the named argument L. my $blue = $black->set_value( blue => 255 ); # same as #0000ff my $pale_blue = $blue->set_value( saturation => 50 ); # ->( s => 50) works too my $color = $blue->set_value( saturation => 50, in => 'HSV' ); # previous was HSL =head2 add_value Creates a new GTC color object that shares some values with the current one, but differs in others. The altered values are provided relative to the current ones. The rest works as described in L. This method was mainly created to get lighter, darker or more saturated colors by using it like: my $blue = Graphics::Toolkit::Color->new('blue'); my $darkblue = $blue->add_value( Lightness => -25 ); # get a darker tone my $blue2 = $blue->add_value( blue => 10 ); # bluer than blue ? my $blue3 = $blue->add_value( l => 10, in => 'LAB' ); # lighter color according CIELAB =head2 mix Create a new GTC object, that has the average values between the calling object and another color (or several colors). It accepts three named arguments: L, C and L, but only the first one is required. L works like in other methods, with the exception that it also accepts an ARRAY ref (square brackets) with several color definitions. Per default I computes a 50-50 (1:1) mix. In order to change that, employ the C argument, which is the weight the mixed in color(s) get, counted in percentages. The remaining percentage to 100 is the weight of the color, held by the caller object. This would be naturally nothing, if the C is greater than hundret, which is especially something to consider, if mixing more than two colors. Then both C and C have to get an array of colors and respectively their amounts (same order). Obviously both arrays MUST have the same length. If the sum of amounts is greater than 100 the original color is ignored but the weight ratios will be kept. You may actually give C a scalar value while mixing a list of colors. Then the amount is applied to every color mentioned under the C argument. In this case you go over the sum of 100% very quickly. $blue->mix( 'silver'); # 50% silver, 50% blue $blue->mix( to => 'silver', amount => 60 ); # 60% silver, 40% blue $blue->mix( to => [qw/silver green/], amount => [10, 20]); # 10% silver, 20% green, 70% blue $blue->mix( to => [qw/silver green/] ); # 50% silver, 50% green $blue->mix( to => {H => 240, S =>100, L => 50}, in => 'RGB' ); # teal =head2 invert Computes the a new color object, where all values are inverted according to the ranges of the chosen color space (see L). It takes only one optional, positional argument, a space name. my $black = $white->invert(); # to state the obvious my $blue = $yellow->invert( 'LUV' ); # invert in LUV space $yellow->invert( in => 'LUV' ); # would work too =head1 COLOR SETS construct several interrelated color objects at once. =head2 complement Creates a set of complementary colors (GTC objects), which will be computed in I color space. The method accepts three optional, named arguments: C and C and C. But if none are provided, THE (one) complementary color will be produced. One singular, positional argument defines the number of produced colors, same as the named argument C would have. If you want to get 'triadic' colors, choose 3 as an argument for C - 4 would get you the 'tetradic' colors, .... and so on. The given color is always the last in the row of produced complementary colors. If you need split-complementary colors, just use the C argument, which defaults to zero. Without any tilt, complementary colors are equally distanced dots on a horizontal circle around the vertical, central column in I space. In other words: complementary colors have all the same 'saturation' (distance from the column) and 'lightness' (height). They differ only in 'hue' (position on the circle). The given color and its (THE) complement sit on opposite sides of the circle. The greater the C amount, the more these colors (minus the given one) will move on the circle toward THE complement and vice versa. What is traditionally meant by split-complementary colors you will get here with a C factor of around 3.42 and three C or a C of 1.585 and four C (depending on if you need THE complement also in your set). To get an even greater variety of complementary colors, you can use C argument and move around THE complement and thus shape the circle in all three directions. C (or C) values move it circularly C (or C) move it away or negative values toward the central column and C (or C) move it up and down. my @colors = $c->complement( 4 ); # 'tetradic' colors my @colors = $c->complement( steps => 4, tilt => 4 ); # split-complementary colors my @colors = $c->complement( steps => 3, tilt => { move => 2, target => {l => -10}} ); my @colors = $c->complement( steps => 3, tilt => { move => 2, target => { h => 20, s=> -5, l => -10 } }); =head2 gradient Creates a gradient (a list of color objects that build a transition) between the current color held by the object and a second color, provided by the named argument L, which is required. Optionally C accepts an ARRAY ref (square braces) with a list of colors in order to create the most fancy, custom and nonlinear gradients. Also required is the named argument C, which is the gradient length or count of colors, which are part of this gradient. Included in there are the start color (given by this object) and end color (given with C). The optional, floating point valued argument C makes the gradient skewed toward one or the other end. Default is zero, which results in a linear, uniform transition between start and stop. Greater values of the argument let the color change rate start small, steadily getting bigger. Negative values work vice versa. The bigger the absolute numeric value the bigger the effect. Please have in mind that values over 2 result is a very strong tilt. Optional is the named argument L (color space - details behind link). Tip: use C and C spaces for visually smooth gradients. # we turn to grey my @colors = $c->gradient( to => $grey, steps => 5); # none linear gradient in HSL space : @colors = $c1->gradient( to =>[14,10,222], steps => 10, tilt => 1, in => 'HSL' ); @colors = $c1->gradient( to =>['blue', 'brown', {h => 30, s => 44, l => 50}] ); =head2 cluster Computes a set of colors that are all similar but not the same. The method accepts three named arguments: C, C and L, of which the first two are required. The produced colors form a ball or cuboid in a color space around the given color, depending on what the argument C got. If it is a single number, it will be a ball with the given radius. If it is an ARRAY of values you get the a cuboid with the given dimensions. The minimal distance between any two colors of a cluster is set by the C argument, which is computed the same way as the method L, in has a short alias C. In a cuboid shaped cluster- the colors will form a cubic grid - inside the ball shaped cluster they form a cuboctahedral grid, which is packed tighter, but still obeys the minimal distance. my @blues = $blue->cluster( radius => 4, minimal_distance => 0.3 ); my @c = $color->cluster( r => [2,2,3], min_d => 0.4, in => YUV ); =head1 ARGUMENTS Some named arguments of the above listed methods reappear in several methods. Thus they are explained here once. Please note that you must NOT wrap the named args in curly braces (HASH ref). =head2 in The named argument I expects the name of a color space as L. The default color space in this module is I. Depending on the chosen space, the results of all methods can be very different, since colors are arranged there very differently and have different distances to each other. Some colors might not even exist in some spaces. =head2 range Every color space comes with range definitions for its values. For instance I, I and I in I go usually from zero to 255 (0..255). In order to change that, many methods accept the named argument C. When only one interger value provided, it changes the upper bound on all three axis and as lower bound is assumed zero. Let's say you need I values with a range of 0 .. 65536, then you type C<< range => 65536 >> or C<< range => 2**16 >>. If you provide an ARRAY ref you can change the upper bounds of all axis individually and in order to change even the lower boundaries, use ARRAY refs even inside that. For instance in C the C is normally 0 .. 359 and the other two axis are 0 .. 100. In order to set C to -100 .. 100 but keep the other two untouched you would have to insert: C<< range => [[-100,100],100,100] >>. =head2 to This argument receives a second or target color. It may come in form of another GTC object or a color definition that is acceptable to the constructor. But it has to be a scalar (string or (HASH) reference), not a value list or hash. =head1 SEE ALSO =over 4 =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back =head1 ACKNOWLEDGEMENT These people contributed by providing patches, bug reports and useful comments: =over 4 =item * Petr Pisar (ppisar) =item * Slaven Rezic (srezic) =item * Gabor Szabo (szabgab) =item * Gene Boggs (GENE) =item * Stefan Reddig (sreagle) =back =head1 AUTHOR Herbert Breunung, =head1 COPYRIGHT Copyright 2022-2025 Herbert Breunung. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Color000755001750001750 015055140237 23200 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/ToolkitName.pm100644001750001750 2053215055140237 24600 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color # translate color names to values and vice versa package Graphics::Toolkit::Color::Name; use v5.12; use warnings; use Graphics::Toolkit::Color::Name::Scheme; use Graphics::Toolkit::Color::Space::Util qw/uniq round_decimals/; #### public API ######################################################## sub all { my (@scheme_names) = @_; push @scheme_names, 'default' unless @scheme_names; my @names = (); for my $scheme_name (@scheme_names) { my $scheme = try_get_scheme( $scheme_name ); next unless ref $scheme; push @names, $scheme->all_names; } return uniq( @names ); } sub get_values { my ($color_name, $scheme_name) = @_; ($scheme_name, $color_name) = split(':', $color_name, 2) if index($color_name, ':') > -1; my $scheme = try_get_scheme( $scheme_name ); return $scheme unless ref $scheme; return $scheme->values_from_name( $color_name ); } sub from_values { my ($values, $scheme_name, $all_names, $full_name, $distance) = @_; my @return_names = (); my @scheme_names = (ref $scheme_name eq 'ARRAY') ? (@$scheme_name) : (defined $scheme_name) ? $scheme_name : 'DEFAULT'; for my $scheme_name (@scheme_names) { my $scheme = try_get_scheme( $scheme_name ); next unless ref $scheme; my $names = $distance ? $scheme->names_in_range( $values, $distance ) : $scheme->names_from_values( $values ); next unless ref $names; $names = [ map { uc($scheme_name).':'.$_} @$names] if $full_name and uc($scheme_name) ne 'DEFAULT'; push @return_names, @$names; } push @return_names, '' unless @return_names; @return_names = uniq( @return_names ); return (defined $all_names and $all_names) ? @return_names : $return_names[0]; } sub closest_from_values { my ($values, $scheme_name, $all_names, $full_name) = @_; # exact search first my @return_names = from_values( $values, $scheme_name, $all_names, $full_name ); return ((@return_names == 1) ? $return_names[0] : \@return_names, 0) unless @return_names == 1 and $return_names[0] eq ''; my @scheme_names = (ref $scheme_name eq 'ARRAY') ? (@$scheme_name) : (defined $scheme_name) ? $scheme_name : 'DEFAULT'; @return_names = (); my $distance = 'Inf'; for my $scheme_name (@scheme_names) { my $scheme = try_get_scheme( $scheme_name ); next unless ref $scheme; my ($names, $d) = $scheme->closest_names_from_values( $values ); $d = round_decimals($d, 5); next unless ref $names; next unless $d <= $distance; $distance = $d; $names = [ map { uc($scheme_name).':'.$_} @$names] if $full_name and uc($scheme_name) ne 'DEFAULT'; @return_names = ($distance == $d) ? (@return_names, @$names) : (@$names); } @return_names = uniq( @return_names ); my $name = (defined $all_names and $all_names) ? \@return_names : $return_names[0]; return ($name, $distance); } #### color scheme API ################################################## # load default scheme on RUNTIME my %color_scheme = (DEFAULT => Graphics::Toolkit::Color::Name::Scheme->new()); my $default_names = require Graphics::Toolkit::Color::Name::Constant; for my $color_block (@$default_names){ $color_scheme{'DEFAULT'}->add_color( $_, [ @{$color_block->{$_}}[0,1,2] ] ) for keys %$color_block; } sub try_get_scheme { # auto loader my $scheme_name = shift // 'DEFAULT'; $scheme_name = uc $scheme_name; unless (exists $color_scheme{ $scheme_name }){ my $module_base = 'Graphics::ColorNames'; # eval "use $module_base"; # return "$module_base is not installed, but it's needed to load external color schemes!" if $@; my $module = $module_base.'::'.$scheme_name; eval "use $module"; return "Perl module $module is not installed, but needed to load color scheme '$scheme_name'" if $@; my $palette = eval $module.'::NamesRgbTable();'; return "Could not use Perl module $module , it seems to be damaged!" if $@ or ref $palette ne 'HASH'; my $scheme = Graphics::Toolkit::Color::Name::Scheme->new(); $scheme->add_color( $_, from_hex_to_rgb_tuple( $palette->{$_} ) ) for keys %$palette; add_scheme( $scheme, $scheme_name ); } return $color_scheme{ $scheme_name }; } sub add_scheme { my ($scheme, $scheme_name) = @_; return if ref $scheme ne 'Graphics::Toolkit::Color::Name::Scheme' or not defined $scheme_name or exists $color_scheme{ $scheme_name }; $color_scheme{ uc $scheme_name } = $scheme; } my $rgb_max = 256; sub from_hex_to_rgb_tuple { my $hex = shift; my $rg = int $hex / $rgb_max; return [ int $rg / $rgb_max, $rg % $rgb_max, $hex % $rgb_max]; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Name - translate color names to values and vice versa =head1 SYNOPSIS use Graphics::Toolkit::Color::Name; my @names = Graphics::Toolkit::Color::Name::all('HTML', 'default'); my $values = Graphics::Toolkit::Color::Name::get_values('green'); my $values = Graphics::Toolkit::Color::Name::get_values('green', [qw/SVG X/]); my $name = Graphics::Toolkit::Color::Name::from_values([0, 128, 0]); my $name = Graphics::Toolkit::Color::Name::from_values([0, 128, 0], 'HTML'); my ($name, $distance) = Graphics::Toolkit::Color::Name::closest_from_values( [0, 128, 0], [qw/CSS Pantone/], 'all'); Graphics::Toolkit::Color::Name::add_scheme( $scheme, 'custom' ); =head1 DESCRIPTION This module autoloads and holds a set of L, where color names with associated RGB values are stored (color name spaces). There is a L and additional ones, fed Graphics::ColorNames::* Modules. which have to be installed separately. For your convenance I created L to install them all at once, which all also frees you from the search which module provides which space (some provide several). This module also provides methods that search in those schemes. Wherever a method accepts a color scheme name, it will default to the default name space, but also accepts an ARRAY with several scheme names. =head1 SCHEMES Acceptable scheme names are currently: I, I, I, I, I, I, I, I, I, I, I, I, I, I, I or I (X11). =head1 ROUTINES =head2 all Returns a list of color names constants of the default schema. All arguments are interpreted as scheme names. If provided, the method hows only the names from these schemes. =head2 get_values .. accepts two arguments. The first one is required and is a color name. The result will be the RGB value tuple (ARRAY) of this color. Optionally you may provide a second argument, which is a color scheme name - if none is provided, the default scheme is used. Please note this is the only routine in this lib where you can provide only one scheme. =head2 from_values This method works the other way around as the previous one. It takes am RGB value tuple and returns a color name if possible. If no stored color has the exact same values, an empty string is the result. The search is limited to the default color scheme, unless a name of another scheme or several of them in an ARRAY are provided as second argument. If the provided values belong to several color names only the first one is returned, which is in many cases the most popular. If you provide the third positional argument with a positive pseudo boolean, you will get all found color names. =head2 closest_from_values this method gets the same parameter and works almost the same way, as the previous method. The big difference: the search is not for an exact match but the closest one (Euclidean distance). This way you are guaranteed to get one or several names in return. These names have to be delivered inside a ARRAY ref, because there is a second return value, the distance between the provided values and the found color =head1 SEE ALSO L L =head1 COPYRIGHT & LICENSE Copyright 2025 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.pm��������������������������������������������������������������������������������������������100644��001750��001750�� 33373�15055140237� 24762� 0����������������������������������������������������������������������������������������������������ustar�00herbert�������������������������herbert�������������������������000000��000000��Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color���������������������������������������������������������������������������������������������������������������� # common code of Graphics::Toolkit::Color::Space::Instance::* packages package Graphics::Toolkit::Color::Space; use v5.12; use warnings; require Exporter; our @ISA = qw(Exporter); use Graphics::Toolkit::Color::Space::Basis; use Graphics::Toolkit::Color::Space::Shape; use Graphics::Toolkit::Color::Space::Format; use Graphics::Toolkit::Color::Space::Util qw/:all/; our @EXPORT_OK = qw/round_int round_decimals mod_real min max uniq mult_matrix_vector_3 is_nr/; our %EXPORT_TAGS = (all => [@EXPORT_OK]); ######################################################################## sub new { my $pkg = shift; return if @_ % 2; my %args = @_; my $basis = Graphics::Toolkit::Color::Space::Basis->new( $args{'axis'}, $args{'short'}, $args{'name'}, $args{'alias'}); return $basis unless ref $basis; my $shape = Graphics::Toolkit::Color::Space::Shape->new( $basis, $args{'type'}, $args{'range'}, $args{'precision'} ); return $shape unless ref $shape; my $format = Graphics::Toolkit::Color::Space::Format->new( $basis, $args{'value_form'}, $args{'prefix'}, $args{'suffix'} ); return $format unless ref $format; my $self = bless { basis => $basis, shape => $shape, format => $format, convert => {} }; if (ref $args{'format'} eq 'HASH'){ for my $format_name (keys %{$args{'format'}}){ my $formatter = $args{'format'}{$format_name}; next unless ref $formatter eq 'ARRAY' and @$formatter > 0; $format->add_formatter($format_name, $formatter->[0]) if exists $formatter->[0] and ref $formatter->[0] eq 'CODE'; $format->add_deformatter($format_name, $formatter->[1]) if exists $formatter->[1] and ref $formatter->[1] eq 'CODE'; } } if (ref $args{'convert'} eq 'HASH'){ for my $converter_target (keys %{$args{'convert'}}){ my $converter = $args{'convert'}{ $converter_target }; next unless ref $converter eq 'ARRAY' and @$converter > 1 and ref $converter->[0] eq 'CODE' and ref $converter->[1] eq 'CODE'; $self->add_converter( $converter_target, @$converter ); } } if (ref $args{'values'} eq 'HASH') { my $numifier = $args{'values'}; $format->set_value_numifier( $numifier->{'read'}, $numifier->{'write'} ) if ref $numifier->{'read'} eq 'CODE' and ref $numifier->{'write'} eq 'CODE'; } return $self; } ######################################################################## sub basis { $_[0]{'basis'} } sub name { shift->basis->space_name } # --> ~ sub alias { shift->basis->alias_name } # --> ~ sub is_name { shift->basis->is_name(@_) } # ~name --> ? sub axis_count { shift->basis->axis_count } # --> + sub is_axis_name { shift->basis->is_axis_name(@_) } # ~axis_name --> ? sub is_value_tuple { shift->basis->is_value_tuple(@_) } # @+values --> ? sub is_number_tuple { shift->basis->is_number_tuple(@_) } # @+values --> ? sub is_partial_hash { shift->basis->is_partial_hash(@_) } # %+values --> ? sub tuple_from_partial_hash { shift->basis->tuple_from_partial_hash(@_) } # %+values --> ? sub select_tuple_value_from_name { shift->basis->select_tuple_value_from_axis_name(@_) } # ~axis_name. %+values --> + ######################################################################## sub shape { $_[0]{'shape'} } sub is_linear { shift->shape->is_linear() } # --> ? sub is_in_linear_bounds{ shift->shape->is_in_linear_bounds(@_)}#@+values --> ? sub is_equal { shift->shape->is_equal( @_ ) } # @+val_a, @+val_b -- @+precision --> ? sub round { shift->shape->round( @_ ) } # @+values -- @+precision --> @+rvals # result values sub clamp { shift->shape->clamp( @_ ) } # @+values -- @+range --> @+rvals # result values sub check_value_shape { shift->shape->check_value_shape( @_)}# @+values -- @+range, @+precision --> @+values|!~ # errmsg sub normalize { shift->shape->normalize(@_)} # @+values -- @+range --> @+rvals|!~ sub denormalize { shift->shape->denormalize(@_)} # @+values -- @+range --> @+rvals|!~ sub denormalize_delta { shift->shape->denormalize_delta(@_)} # @+values -- @+range --> @+rvals|!~ sub delta { shift->shape->delta( @_ ) } # @+val_a, @+val_b --> @+rvals| # on normalized values sub add_constraint { shift->shape->add_constraint(@_)} # ~name, ~error, &checker, &remedy --> %constraint ######################################################################## sub form { $_[0]{'format'} } sub format { shift->form->format(@_) } # @+values, ~format_name -- @~suffix --> $*color sub deformat { shift->form->deformat(@_) } # $*color -- @~suffix --> @+values, ~format_name #### conversion ######################################################## sub converter_names { keys %{ $_[0]{'convert'} } } sub alias_converter_name { my ($self, $space_name, $name_alias) = @_; $self->{'convert'}{ uc $name_alias } = $self->{'convert'}{ uc $space_name }; } sub can_convert { (defined $_[1] and exists $_[0]{'convert'}{ uc $_[1] }) ? 1 : 0 } sub add_converter { my ($self, $space_name, $to_code, $from_code, $normal) = @_; 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 ); return 0 if defined $normal and ref $normal ne 'HASH'; $normal = { from => 1, to => 1, } unless ref $normal; # default is full normalisation $normal->{'from'} = {} if not exists $normal->{'from'} or (exists $normal->{'from'} and not $normal->{'from'}); $normal->{'from'} = {in => 1, out => 1} if not ref $normal->{'from'}; $normal->{'from'}{'in'} = 0 unless exists $normal->{'from'}{'in'}; $normal->{'from'}{'out'} = 0 unless exists $normal->{'from'}{'out'}; $normal->{'to'} = {} if not exists $normal->{'to'} or (exists $normal->{'to'} and not $normal->{'to'}); $normal->{'to'} = {in => 1, out => 1} if not ref $normal->{'to'}; $normal->{'to'}{'in'} = 0 unless exists $normal->{'to'}{'in'}; $normal->{'to'}{'out'} = 0 unless exists $normal->{'to'}{'out'}; $self->{'convert'}{ uc $space_name } = { from => $from_code, to => $to_code, normal => $normal }; } sub convert_to { # convert value tuple from this space into another my ($self, $space_name, $values) = @_; return unless $self->is_value_tuple( $values ) and defined $space_name and $self->can_convert( $space_name ); return $self->{'convert'}{ uc $space_name }{'to'}->( $values ); } sub convert_from { # convert value tuple from another space into this my ($self, $space_name, $values) = @_; return unless ref $values eq 'ARRAY' and defined $space_name and $self->can_convert( $space_name ); return $self->{'convert'}{ uc $space_name }{'from'}->( $values ); } sub converter_normal_states { my ($self, $direction, $space_name) = @_; return unless $self->can_convert( $space_name ) and defined $direction and ($direction eq 'from' or $direction eq 'to'); return @{$self->{'convert'}{ uc $space_name }{'normal'}{$direction}}{'in', 'out'}; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Space - base class of all color spaces =head1 SYNOPSIS This class is the low level API of this distribution. Every instance represent one color space, containing all specific informations about the names, shapes and sizes of the axis and all specific algorithms, such as converter and (de-) formatter. Because these are all instances of the same class, they can be treated the same from the outside. use Graphics::Toolkit::Color::Space; my $def = Graphics::Toolkit::Color::Space->new ( name => 'demo', # space name, defaults to axis initials alias => 'alias', # second space name axis => [qw/one two three/], # long axis names short => [qw/1 2 3/], # short names, defaults to first char of long type => [qw/linear circular angular/], # axis type range => [1, [-2, 2], [-3, 3]], # axis value range precision => [-1, 0, 1], # precision of value output suffix => ['', '', '%'], # suffix of value in output ); $def->add_converter( 'RGB', \&to_rgb, \&from_rgb ); $def->add_formatter( 'name', sub {...} ); $def->add_deformatter( 'name', sub {...} ); $def->add_constraint( 'name', 'error', sub {...}, sub {} ); $def->set_value_formatter( sub {...}, sub {...}, ) =head1 DESCRIPTION This package provides the API for constructing custom color spaces. Please name them L. These instances are supposed to be loaded by L. So if you are an author of your own color space, you have to call C<*::Hub::add_space> manually at runtime or submit you color space as merge request and I add your space into the list of automatically loaded spaces. =head1 METHODS =head2 new The constructor takes eight named arguments, of which only C is required. The values of these arguments have to be in most cases an ARRAY references, which have one element for each axis of this space. Sometimes are also strings acceptable, either because its about the name of the space or its a property that is the same for all axis (dimensions). The argument B defines the long names of all axis, which will set also the numbers of dimensions of this space. Each axis will have also a shortcut name, which is per default the first letter of the full name. If you prefer other shortcuts, define them via the B argument. The concatenation of the upper-cased long name initials (in the order given with the C argument) is the default name of this space. More simply: red, green blue becomes RGB. But you can override that by using the B argument or even use B if there is a secong longer name, under which the space is known. If no argument under the name B is provided, then all dimensions will be I (Euclidean). But you might want to change that for some axis to be I or it's alias I. This will influenc how the methods I ans I work. A third option for the I argument is I, which indicates that you can not treat the values of this dimension as numbers and they will be ignored for the most part. Under the argument B you can set the numeric limits of each dimension. If none are provided, normal ranges (0 .. 1) are assumed. One number is understood as the upper limit of all dimensions and the lower bound being zero. An ARRAY ref with two number set the lower and upper bound of each dimension, but you can also provide an ARRAY ref filled with numbers or ARRAY ref defining the bounds for each dimension. You can also use the string I<'normal'> to indicate normal ranges (0 .. 1) and the word I<'percent'> to indicate integer valued ranges of 0 .. 100. The argument B defines how many decimals a value of that dimension has to have. Zero makes the values practically an integer and negative values express the demand for the maximally available precision. The default precision is -1, except when min and max value of the range are int. Then the default precision will be zero as well - except for normal ranges. With them the default precision is again -1. The argument B is only interesting if color values has to have a suffix like I<'%'> in '63%'. Its defaults to the empty string. =head2 add_converter Takes three arguments: 1. A name of a space the values will be converter from and to (usually just 'RGB'). 2. & 3. Two CODE refs of the actual converter methods, which have to take the normalized values as a list and return normalized values as a list. The first CODE converts to the named (by first argument) space and the second from the named into the name space the objects implements. =head2 add_formatter Takes two arguments: name of the format and CODE ref that takes the denormalized values as a list and returns whatever the formatter wishes to provide, which then the GTC method I can provide. =head2 add_deformatter Same as I but the CODE does here the opposite transformation, providing a format reading ability for the GTC constructor. =head2 add_constraint This method enables you cut off corners from you color space. It has to get four arguments. 1 a constraint name. 2. an error message, that gets shown if a color has one of these illegal values that are inside the normal ranges but outside of this constraint. 3. a CODE ref of a routine that gets a tuple and gives a perly true if the constraint was violated. 4. another routine that can remedy violating values. =head2 set_value_formatter This method was introduced for the I space, where one value is partially represented by letters. When reading a I color definition from an input, this value has to be translated into a number, so it can be then processed as other numerical values. That will be done by the first routine, given by this method. The second routine does just the translation back, when the values has to become an output. =head1 AUTHOR Herbert Breunung, =head1 COPYRIGHT & LICENSE Copyright 2023-25 Herbert Breunung. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Values.pm�������������������������������������������������������������������������������������������100644��001750��001750�� 16206�15055140237� 25162� 0����������������������������������������������������������������������������������������������������ustar�00herbert�������������������������herbert�������������������������000000��000000��Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color���������������������������������������������������������������������������������������������������������������� # read only store a single color: name + values in default and original space package Graphics::Toolkit::Color::Values; use v5.12; use warnings; use Graphics::Toolkit::Color::Name; use Graphics::Toolkit::Color::Space::Hub; my $RGB = Graphics::Toolkit::Color::Space::Hub::default_space(); #### constructor ####################################################### sub new_from_any_input { # values => %space_name => tuple , ~origin_space, ~color_name my ($pkg, $color_def) = @_; return "Can not create color value object without color definition!" unless defined $color_def; if (not ref $color_def) { # try to resolve color name my $rgb = Graphics::Toolkit::Color::Name::get_values( $color_def ); if (ref $rgb){ $rgb = $RGB->clamp( $RGB->normalize( $rgb ), 'normal' ); return bless { name => $color_def, rgb => $rgb, source_values => '', source_space_name => ''}; } } my ($values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat( $color_def ); return "could not recognize color value format or color name: $color_def" unless ref $values; new_from_tuple( '', $values, $space_name); } sub new_from_tuple { # my ($pkg, $values, $space_name, $range_def) = @_; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name ); return $color_space unless ref $color_space; return "Need ARRAY of ".$color_space->axis_count." ".$color_space->name." values as first argument!" unless $color_space->is_value_tuple( $values ); $values = $color_space->clamp( $values, $range_def); $values = $color_space->normalize( $values, $range_def ); $values = $color_space->clamp( $values, 'normal'); _new_from_normal_tuple($values, $color_space); } sub _new_from_normal_tuple { # my ($values, $color_space) = @_; my $source_values = ''; my $source_space_name = ''; if ($color_space->name ne $RGB->name){ $source_values = $values; $source_space_name = $color_space->name; $values = Graphics::Toolkit::Color::Space::Hub::deconvert( $color_space->name, $values, 'normal' ); } $values = $RGB->clamp( $values, 'normal' ); my $name = Graphics::Toolkit::Color::Name::from_values( $RGB->round( $RGB->denormalize( $values ) ) ); bless { rgb => $values, source_values => $source_values, source_space_name => $source_space_name, name => $name }; } #### getter ############################################################ sub normalized { # normalized (0..1) value tuple in any color space my ($self, $space_name) = @_; Graphics::Toolkit::Color::Space::Hub::convert( $self->{'rgb'}, $space_name, 'normal', $self->{'source_space_name'}, $self->{'source_values'}, ); } sub shaped { # in any color space, range and precision my ($self, $space_name, $range_def, $precision_def) = @_; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name ); return $color_space unless ref $color_space; my $values = $self->normalized( $color_space->name ); return $values if not ref $values; $values = $color_space->denormalize( $values, $range_def ); $values = $color_space->clamp( $values, $range_def ); $values = $color_space->round( $values, $precision_def ); return $values; } sub formatted { # in shape values in any format # _ -- ~space, @~|~format, @~|~range, @~|~suffix my ($self, $space_name, $format_name, $suffix_def, $range_def, $precision_def) = @_; my $color_space = Graphics::Toolkit::Color::Space::Hub::try_get_space( $space_name ); return $color_space unless ref $color_space; my $values = $self->shaped( $color_space->name, $range_def, $precision_def ); return $values unless ref $values; return $color_space->format( $values, $format_name, $suffix_def ); } sub name { $_[0]->{'name'} } #### single color calculator ########################################### sub set { # .values, %newval -- ~space_name --> _ my ($self, $partial_hash, $preselected_space_name) = @_; my ($new_values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat_partial_hash( $partial_hash, $preselected_space_name ); unless (ref $new_values){ my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to '; return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!' : 'any supported color space!'; } my $values = $self->shaped( $space_name ); my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); for my $pos ($color_space->basis->axis_iterator) { $values->[$pos] = $new_values->[$pos] if defined $new_values->[$pos]; } $self->new_from_tuple( $values, $color_space->name ); } sub add { # .values, %newval -- ~space_name --> _ my ($self, $partial_hash, $preselected_space_name) = @_; my ($new_values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat_partial_hash( $partial_hash, $preselected_space_name ); unless (ref $new_values){ my $help_start = 'axis names: '.join(', ', keys %$partial_hash).' do not correlate to '; return (defined $preselected_space_name) ? $help_start.'the selected color space: '.$preselected_space_name.'!' : 'any supported color space!'; } my $values = $self->shaped( $space_name ); my $color_space = Graphics::Toolkit::Color::Space::Hub::get_space( $space_name ); for my $pos ($color_space->basis->axis_iterator) { $values->[$pos] += $new_values->[$pos] if defined $new_values->[$pos]; } $self->new_from_tuple( $values, $color_space->name ); } sub mix { # @%(+percent, _color) -- ~space_name --> _ my ($self, $recipe, $color_space ) = @_; return if ref $recipe ne 'ARRAY'; my $percentage_sum = 0; for my $ingredient (@{$recipe}){ return if ref $ingredient ne 'HASH' or not exists $ingredient->{'percent'}; return if ref $ingredient ne 'HASH' or not exists $ingredient->{'percent'} or not exists $ingredient->{'color'} or ref $ingredient->{'color'} ne __PACKAGE__; $percentage_sum += $ingredient->{'percent'}; } my $result_values = [(0) x $color_space->axis_count]; if ($percentage_sum < 100){ my $values = $self->shaped( $color_space->name ); my $mix_amount = (100 - $percentage_sum) / 100; $result_values->[$_] += $values->[$_] * $mix_amount for 0 .. $#$values; } else { $percentage_sum /= 100; $_->{'percent'} /= $percentage_sum for @{$recipe}; # sum of percentages has to be 100 } for my $ingredient (@$recipe){ my $values = $ingredient->{'color'}->shaped( $color_space->name ); $result_values->[$_] += $values->[$_] * $ingredient->{'percent'} / 100 for 0 .. $#$values; } $self->new_from_tuple( $result_values, $color_space->name ); } sub invert { my ($self, $color_space ) = @_; my $values = $self->normalized( $color_space->name ); $self->new_from_tuple( [ map {1 - $_} @$values ], $color_space->name, 'normal' ); } 1; ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Space�����������������������������������������������������������������������������������������������000755��001750��001750�� 0�15055140237� 24233� 5����������������������������������������������������������������������������������������������������ustar�00herbert�������������������������herbert�������������������������000000��000000��Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color����������������������������������������������������������������������������������������������������������������Hub.pm����������������������������������������������������������������������������������������������100644��001750��001750�� 63750�15055140237� 25502� 0����������������������������������������������������������������������������������������������������ustar�00herbert�������������������������herbert�������������������������000000��000000��Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space���������������������������������������������������������������������������������������������������������� # store all clolor space objects, to convert check, convert and measure color values package Graphics::Toolkit::Color::Space::Hub; use v5.12; use warnings; #### internal space loading ############################################ our $default_space_name = 'RGB'; my @search_order = ($default_space_name, qw/CMY CMYK HSL HSV HSB HWB NCol YIQ YUV/, qw/CIEXYZ CIELAB CIELUV CIELCHab CIELCHuv OKLAB OKLCH HunterLAB/); my %space_obj; add_space( require "Graphics/Toolkit/Color/Space/Instance/$_.pm" ) for @search_order; #### space API ######################################################### sub is_space_name { (ref get_space($_[0])) ? 1 : 0 } sub all_space_names { sort keys %space_obj } sub default_space_name { $default_space_name } sub default_space { get_space( $default_space_name ) } sub get_space { (defined $_[0] and exists $space_obj{ uc $_[0] }) ? $space_obj{ uc $_[0] } : '' } sub try_get_space { my $name = shift || $default_space_name; my $space = get_space( $name ); return $name if ref $name eq 'Graphics::Toolkit::Color::Space' and is_space_name( $name->name ); return (ref $space) ? $space : "$name is an unknown color space, try one of: ".(join ', ', all_space_names()); } sub add_space { my $space = shift; return 'got no Graphics::Toolkit::Color::Space object' if ref $space ne 'Graphics::Toolkit::Color::Space'; my $name = $space->name; return "space objct has no name" unless $name; return "color space name $name is already taken" if ref get_space( $name ); my @converter_target = $space->converter_names; return "can not add color space $name, it has no converter" unless @converter_target or $name eq $default_space_name; for my $converter_target (@converter_target){ my $target_space = get_space( $converter_target ); return "space object $name does convert into $converter_target, which is no known color space" unless $target_space; $space->alias_converter_name( $converter_target, $target_space->alias ) if $target_space->alias; } $space_obj{ uc $name } = $space; $space_obj{ uc $space->alias } = $space if $space->alias and not ref get_space( $space->alias ); return 1; } sub remove_space { my $name = shift; return "need name of color space as argument in order to remove the space" unless defined $name and $name; my $space = get_space( $name ); return "can not remove unknown color space: $name" unless ref $space; delete $space_obj{ uc $space->alias } if $space->alias; delete $space_obj{ uc $space->name }; } #### value API ######################################################### sub convert { # normalized RGB tuple, ~space_name --> ?normalized tuple in wanted space my ($values, $target_space_name, $want_result_normalized, $source_space_name, $source_values) = @_; my $target_space = try_get_space( $target_space_name ); my $source_space = try_get_space( $source_space_name ); $want_result_normalized //= 0; return "need an ARRAY ref with 3 RGB values as first argument in order to convert them" unless default_space()->is_value_tuple( $values ); return $target_space unless ref $target_space; return "arguments source_space_name and source_values have to be provided both or none." if defined $source_space_name xor defined $source_values; return "argument source_values has to be a tuple, if provided" if $source_values and not $source_space->is_value_tuple( $source_values ); # none conversion cases $values = $source_values if ref $source_values and $source_space eq $target_space; if ($target_space->name eq default_space()->name or $source_space eq $target_space) { return ($want_result_normalized) ? $values : $target_space->round($target_space->denormalize( $values )); } # find conversion chain my $current_space = $target_space; my @convert_chain = ($target_space->name); while ($current_space->name ne $default_space_name ){ my ($next_space_name, @next_options) = $current_space->converter_names; $next_space_name = shift @next_options while @next_options and $next_space_name ne $default_space_name; unshift @convert_chain, $next_space_name if $next_space_name ne $default_space_name; $current_space = get_space( $next_space_name ); } # actual conversion my $values_are_normal = 1; my $space_name_before = default_space_name(); for my $space_name (@convert_chain){ my $current_space = get_space( $space_name ); if ($current_space eq $source_space){ $values = $source_values; $values_are_normal = 1; } else { my @normal_in_out = $current_space->converter_normal_states( 'from', $space_name_before ); $values = $current_space->normalize( $values ) if not $values_are_normal and $normal_in_out[0]; $values = $current_space->denormalize( $values ) if $values_are_normal and not $normal_in_out[0]; $values = $current_space->convert_from( $space_name_before, $values); $values_are_normal = $normal_in_out[1]; } $space_name_before = $current_space->name; } $values = $target_space->normalize( $values ) if not $values_are_normal and $want_result_normalized; $values = $target_space->denormalize( $values ) if $values_are_normal and not $want_result_normalized; return $target_space->clamp( $values, ($want_result_normalized ? 'normal' : undef)); } sub deconvert { # normalizd value tuple --> RGB tuple my ($space_name, $values, $want_result_normalized) = @_; return "need a space name to convert to as first argument" unless defined $space_name; my $original_space = try_get_space( $space_name ); return $original_space unless ref $original_space; return "need an ARRAY ref with 3 or 4 values as first argument in order to deconvert them" unless ref $values eq 'ARRAY' and (@$values == 3 or @$values == 4); $want_result_normalized //= 0; if ($original_space->name eq $default_space_name) { # nothing to convert return ($want_result_normalized) ? $values : $original_space->round( $original_space->denormalize( $values )); } my $current_space = $original_space; my $values_are_normal = 1; while (uc $current_space->name ne $default_space_name){ my ($next_space_name, @next_options) = $current_space->converter_names; $next_space_name = shift @next_options while @next_options and $next_space_name ne $default_space_name; my @normal_in_out = $current_space->converter_normal_states( 'to', $next_space_name ); $values = $current_space->normalize( $values ) if not $values_are_normal and $normal_in_out[0]; $values = $current_space->denormalize( $values ) if $values_are_normal and not $normal_in_out[0]; $values = $current_space->convert_to( $next_space_name, $values); $values_are_normal = $normal_in_out[1]; $current_space = get_space( $next_space_name ); } return ($want_result_normalized) ? $values : $current_space->round( $current_space->denormalize( $values )); } sub deformat { # formatted color def --> normalized values my ($color_def, $ranges, $suffix) = @_; return 'got no color definition' unless defined $color_def; my ($values, $original_space, $format_name); for my $space_name (all_space_names()) { my $color_space = get_space( $space_name ); ($values, $format_name) = $color_space->deformat( $color_def ); if (defined $format_name){ $original_space = $color_space; last; } } return 'could not deformat color definition: "$color_def"' unless ref $original_space; return $values, $original_space->name, $format_name; } sub deformat_partial_hash { # convert partial hash into my ($value_hash, $space_name) = @_; return unless ref $value_hash eq 'HASH'; my $space = try_get_space( $space_name ); return $space unless ref $space; my @space_name_options = (defined $space_name and $space_name) ? ($space->name) : (@search_order); for my $space_name (@space_name_options) { my $color_space = get_space( $space_name ); my $values = $color_space->tuple_from_partial_hash( $value_hash ); next unless ref $values; return wantarray ? ($values, $color_space->name) : $values; } return undef; } sub distance { # @c1 @c2 -- ~space ~select @range --> + my ($values_a, $values_b, $space_name, $select_axis, $range) = @_; my $color_space = try_get_space( $space_name ); return $color_space unless ref $color_space; $values_a = convert( $values_a, $space_name, 'normal' ); $values_b = convert( $values_b, $space_name, 'normal' ); my $delta = $color_space->delta( $values_a, $values_b ); $delta = $color_space->denormalize_delta( $delta, $range ); if (defined $select_axis){ $select_axis = [$select_axis] unless ref $select_axis; my @selected_values = grep {defined $_} map {$color_space->select_tuple_value_from_name($_, $delta) } @$select_axis; $delta = \@selected_values; } my $d = 0; $d += $_ * $_ for @$delta; return sqrt $d; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Space::Hub - (de-)convert and deformat color value tuples =head1 SYNOPSIS Central store for all color space objects, which hold color space specific information and algorithms. Home to all methods that have to iterate over all color spaces. 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::default_space(); Graphics::Toolkit::Color::Space::Hub::space_names(); # all space names and aliases $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' # [0, 0, 255] , 'RGB' my ($values, $space_name) = Graphics::Toolkit::Color::Space::Hub::deformat( '#0000ff' ); =head1 DESCRIPTION This module is supposed to be used only internally and not directly by the user, unless he wants to add his own color space. Therefore it exports no symbols and the methods are much less DWIM then the main module. But lot of important documentation is still here. =head1 COLOR SPACES Up next, a listing of all supported color spaces. These are mathematical constructs that associate each color with a point inside this space. The numerical values of a color definition become coordinates along axis that express different properties. The closer two colors are along an axis the more similar are they in that property. All color spaces are finite and only certain value ranges along an axis are acceptable. Most spaces have 3 dimensions (axis) and are completely lineary like in Euclidean (everyday) geometry. A few spaces have more axis and some spaces are cylindrical. That means that some axis are not lines but circles and the associated value descibes an angle. Color definitions contain either the name of a space or the names of its axis (long or short). If the space name or its long alias is used, the values have to be provided in the same order as the axis described here. Color space or axis names may be written in any combination of upper and lower case characters, but I recommended to use the spelling presented here. Each axis has also two specific names, one long and one short, which are in rare cases equal. To define a color according a space you need to provide for each axis one value, that is inside the required value range and of a specificed type (int or real with amount of decimals). While I acknowledge that some of the spaces below should be called systems to be technically correct, they still will be called spaces here, because the main goal of this software is seamless interoperabilitiy between them. =head2 RGB ... is the default color space of this CPAN module. It is used by most computer hardware like monitors and follows the logic of additive color mixing as produced by an overlay of three colored light beams. The sum of all colors will be white, as in opposite to subtractive mixing. Its is a completely Cartesian (Euclidean) 3D space and thus a RGB tuple consists of three integer values: B (short B) range: 0 .. 255, B (short B) range: 0 .. 255 and B (short B) range: 0 .. 255. A higher value means a stronger beam of that base color flows into the mix above a black background, so that black is (0,0,0), white (255,255,255) and a pure red (fully saturated color) is (255, 0, 0). =head2 CMY is the opposite of L since it follows the logic of subtractive color mixing as used in printing. Think of it as the amount of colored ink on white paper, so that white is (0,0,0) and black (1,1,1). It uses normalized real value ranges: 0 .. 1. An CMY tuple has also three values: B (short B) is the inverse of I, B (short B ) is inverse to I and B (short B) is inverse of I. =head2 CMYK is an extension of L with a fourth value named B (short B), which is the amount of black ink mixed into the CMY color. It also has an normalized range of 0 .. 1. This should not bother you since you are free to change the range at you preference. =head2 HSL .. is a cylindrical space that orders colors along cognitive properties. The first dimension is the angular one and it rotates in 360 degrees around the rainbow of fully saturated colors: 0 = red, 15 approximates orange, 60 - yellow 120 - green, 180 - cyan, 240 - blue, 270 - violet, 300 - magenta, 330 - pink. 0 and 360 points to the same coordinate. This module only outputs 0, even if accepting 360 as input. Thes second, linear dimension (axis) measures the distance between a point the the center column of the cylinder at the same height, no matter in which direction. The center column has the value 0 (white .. gray .. black) and the outer mantle of the cylinder contains the most saturated, purest colors. The third, vertical axis reaches from bottom value 0 (always black no matter the other values) to 100 (always white no matter the other values). In summary: HSL needs three integer values: B (short B) (0 .. 359), B (short B) (0 .. 100) and B (short B) (0 .. 100). =head2 HSV ... is also cylindrical but can be shaped like a cone. Similar to HSL we have B and B, but the third axis is named B (short B). In L we always get white, when I is 100. In HSV additionally I has to be zero to get white. When I is 100 and I is 100 we have the purest, most sturated color of whatever I sets. So unlike in C, here every color has its unique coordinates. =head2 HSB Is an alias to L, just the I axis is renamed with B (B). =head2 HWB An inverted L, where the saturated, pure colors are on the center column of the cylinder. It still has the same circular B dimension with an integer range of 0 .. 360. The other two, linear dimensions (also 0 .. 100 inter range with optional suffix '%') are B (B) and B (B). They desribe how much white or black are mixed into the pure hue. If both are zero, than we have a pure color. I of 100 always leads to white and I of 100 always leads to black. The space is truncated as a cone so the sum of I and I can never be greater than 100. =head2 NCol Is a more human readable variant of the L space with an altered B values, that consists of a letter and two digits. The letter demarks one of the six areas around the rainbow. B is I, B (I), B (I), B (I), B (I), B (I). The two digits after this letter are an angular value, measuring the distance between the pure color (as stated by the letter) and the described color (toward the next color on the rainbow). The B and B axis have integer values with the suffix I<'%'>, since they are percentual values as well. =head2 YIQ Is a space developed for I to broadcast a colored television signal, which is still compatible with black and white TV. It achieves this by sending the B (short I) (sort of brightness with real range of 0 .. 1) in channel number one, which is all black and white TV needs. Additionally we have the axis of B (short B) (cyan - orange - balance, range -0.5959 .. 0.5959) and B (short B) (magenta - green - balance, range: -0.5227 .. 0.5227). =head2 YUV Is a slightly altered version of L for the I TV standard. We use a variant called B, which can also be used as space name. It has computation friendly value ranges and is still relevant in video and image formats and compression algorithms, but under the name I. The only difference is that I works with digital values but this module computes with real (analogue) value to enable any precision the user might prefer. To make this clear, this space holds the name B. It has three Cartesian axis: 1. B (short B) with a real value range of 0..1, 2. B (short I, -0.5 .. 0.5) and 3. C (short I, -0.5 .. 0.5). (see also L) =head2 CIEXYZ this space (alias B) has the axis B, B and B (long and short names are same this time), that refer to the red, green and blue receptors (cones) in the retina (on the back side of the eye). Because those cones measure a lot more left and right than just exactly those colors, they got these technical names. The values in that space tell you about the amount of chemical and neurological activity a color produces inside the eye. The values range of C, C and C go from zero to to 0.95047, 1 and 1.08883 respectively. These values are due to the use of the standard luminant I, which holds true for all CIE spaces in GTC. =head2 CIELAB (alias B) is a derivate of L that reorderes the colors along axis that reflect how the brain processes them. It uses three information channels. One named B (lightness) with a real value range of (0 .. 100). Second is channel (B, that reaches from red to green (-500 .. 500) and thirdly B from yellow to blue (-200 .. 200). Values will be displayed with three decimals. The long names of the axis names contain a '*' and are thus: B, B and B. The I and I axis reflect the opponent color theory. =head2 CIELUV (alias B) is a more perceptually uniform version of L and the axis I and I got renamed to I and I (see L) but did not change their meaning. It has also three Cartesian dimension named B, B and B, (short names have only the first letter of these names). Their have real valued ranges, which are 0 .. 100, -134 .. 220 and -140 .. 122. =head2 CIELCHab (alias B) is the cylindrical version of the L with the dimensions B, B and B - in short B, B and B. The real valued ranges are from zero to 100, 539 and 360 respectively. Like with the L and L, hue is the circular dimensions and its values are meant as degrees in a circle. For gray colors in the middle column the value I has no importance and will be in this implementation implementation alsway be zero. =head2 CIELCHuv (alias B) is the cylindrical version of the L and works similar to L except the real valued range of B is (0 .. 261) and the space has no alias name. =head2 OKLAB is a modern improvement of L by Bjoern Ottosson with no alias name and for nicer color transitions and better numeric behaviour. The axis long names are same as the same ones: B with values (0 .. 1), B and B with both (-0.5 .. 0.5). If you want to use it like in B, just add C<< range => [100, [-120,120], [-120,120]], suffix => '%' >>. =head2 OKLCH is the cylindrical variant of L just parallels L. The axis names are again: B, B and B - in short: B, B and B. Value ranges are similar as in C: I 0 .. 1 (normal), I 0 .. 0.5 I and are angles of 0 .. 360 degrees. Also if you prefer a B compatible format, use C<< range => [100, 120, 360] >> and a preferred suffix. =head2 HunterLAB predecessor of L by Richard S. Hunter with no alias name and slightly different color transitions on yellow-blue-direction. The axis have same long and short names: B with normal values (0 .. 1), B -172.30 .. 172.30 and B -67.20 .. 67.20. =head1 RANGES As pointed out in the previous paragraph, each dimension of color space has its default range. However, one can demand custom value ranges, if the method accepts a range decriptor as argument. If so, the following values are accepted: 'normal' real value range from 0 .. 1 (default) 'percent' real value range from 0 .. 100 number integer range from zero to that number [0 1] real number range from 0 to 1, same as 'normal' [min max] range from min .. max, int if both numbers are int [min max 'int'] integer range from min .. max [min max 'real'] real number range from min .. max The whole definition has to be an ARRAY ref. Each element is the range definition of one dimension. If the definition is not an ARRAY but a single value it is applied as definition of every dimension. =head1 FORMATS Unless stated otherwise, these formats are available in all color spaces. =head2 list A list of values, the first being the name of the color space. The name can be omitted, if it is the default color space (L). Default format of the output method "values". (10, 20, 30) ('XYZ', 15, 3.53, 37.1) =head2 named_array The same with squared brackets around. [RGB => 10, 20, 30] =head2 named_string Same inside a quotes. 'RGB: 10, 20, 30' =head2 css_string Strings for usage in CSS, SVG files and alike. Here are commas optional. There are to spots where space is not allowed: 1. Between the the space name and opening bracket and between axis value and value suffix (here '%'). 'rgb(10, 20, 30)' 'hsl(10 20% 30%)' =head2 hex_string String for websites and alike, RGB only. Long and short form can be read and output is long form only. '#1020FF' '#12F' =head2 hash Hash reference with long axis names. { red => 10, green => 20, blue => 30 } =head2 char_hash Hash reference with short axis names. { 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, what the names are and to retrieve a color space object. The second set consists of 4 routines that can handle a lot of unknowns. The are: 1. convert (RGB -> any) 2. deconvert (any -> RGB) 3. deformat (extract values) 3. deformat_partial_hash (deformat hashes with missing axis) =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 try_get_space Same thing but if nothing is provided it returns the default space. =head2 default_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 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. It the third argument is positive the output will also be normal. Arguments four and five are for internal use to omit rounding errors. Its the original values and their color space. So when during the conversion, the method tries to convert into the space of the original, it replaces the values with them. # convert from RGB to HSL my @hsl = Graphics::Toolkit::Color::Space::Hub::convert( [0.1, 0.5, .7], 'HSL' ); =head2 deconvert Converts the result of L into a RGB value tuple. # convert from HSL to RGB my @rgb = Graphics::Toolkit::Color::Space::Hub::deconvert( [0.9, 0.5, 0.5], 'HSL' ); =head2 deformat Extracts the values of a color definition in any space or I. That's why it takes only one argument, a scalar that can be a string, ARRAY ref or HASH ref. The result will be three values. The first is a ARRAY (tuple) with all the unaltered, not clamped and not rounded and not normalized values. The second is the name of the recognized color name space. Thirs is the format name. 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 deformat_partial_hash This is a special case of the I routine for the I and I format (see I). It can tolerate missing values. The result will also be a tuple (ARRAY) with missing values being undef. Since there is a given search order, a hash with only a I value will always assume a I space. To change that you can provide the space name as a second, optional argument. =head1 SEE ALSO =over 4 =item * L =back =head1 COPYRIGHT & LICENSE Copyright 2023-25 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, Util.pm100644001750001750 325315055140237 25651 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space # utilities for color value calculation package Graphics::Toolkit::Color::Space::Util; use v5.12; use warnings; use Exporter 'import'; our @EXPORT_OK = qw/round_int round_decimals mod_real min max uniq mult_matrix_vector_3 is_nr/; our %EXPORT_TAGS = (all => [@EXPORT_OK]); #### lists ############################################################# sub max { my $v = shift; for (@_) { next unless defined $_; $v = $_ if $v < $_ } return $v; } sub min { my $v = shift; for (@_) { next unless defined $_; $v = $_ if $v > $_ } return $v; } sub uniq { return undef unless @_; my %seen = (); grep {not $seen{$_}++} @_; } #### basic math ######################################################## my $half = 0.50000000000008; my $tolerance = 0.00000000000008; sub round_int { $_[0] >= 0 ? int ($_[0] + $half) : int ($_[0] - $half) } sub round_decimals { my ($nr, $precision) = @_; return round_int( $nr ) unless defined $precision and $precision; $precision = 10 ** $precision; return round_int( $nr * $precision ) / $precision; } sub mod_real { # real value modulo return 0 unless defined $_[1] and $_[1]; return $_[0] - (int($_[0] / $_[1]) * $_[1]); } sub is_nr { $_[0] =~ /^\-?\d+(\.\d+)?$/ } #### color computation ################################################# sub mult_matrix_vector_3 { my ($mat, $v1, $v2, $v3) = @_; return unless ref $mat eq 'ARRAY' and defined $v3; return ($v1 * $mat->[0][0] + $v2 * $mat->[0][1] + $v3 * $mat->[0][2]) , ($v1 * $mat->[1][0] + $v2 * $mat->[1][1] + $v3 * $mat->[1][2]) , ($v1 * $mat->[2][0] + $v2 * $mat->[2][1] + $v3 * $mat->[2][2]) ; } 1; Name000755001750001750 015055140237 24060 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/ColorScheme.pm100644001750001750 1350715055140237 26010 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Name # name space for color names, translate values > names & back, find closest name package Graphics::Toolkit::Color::Name::Scheme; use v5.12; use warnings; use Graphics::Toolkit::Color::Space::Hub; use Graphics::Toolkit::Color::Space::Util qw/round_int uniq/; my $RGB = Graphics::Toolkit::Color::Space::Hub::default_space_name(); #### constructor ####################################################### sub new { my $pkg = shift; bless { shaped => {name => [], values => {}}, normal => {} } } sub add_color { my ($self, $name, $values) = @_; return 0 if not defined $name or ref $values ne 'ARRAY' or @$values != 3 or $self->is_name_taken($name); $name = _clean_name( $name ); $self->{'shaped'}{'values'}{$name} = $values; $self->{'shaped'}{'name'}[$values->[0]][$values->[1]][$values->[2]] = (exists $self->{'shaped'}{'name'}[$values->[0]][$values->[1]][$values->[2]]) ? [@{$self->{'shaped'}{'name'}[$values->[0]][$values->[1]][$values->[2]]}, $name] : [$name]; 1; } #### exact getter ###################################################### sub all_names { keys %{$_[0]->{'shaped'}{'values'}} } sub is_name_taken { my ($self, $name) = @_; (exists $self->{'shaped'}{'values'}{_clean_name($name)}) ? 1 : 0; } sub values_from_name { my ($self, $name) = @_; return unless defined $name; $name = _clean_name($name); return $self->{'shaped'}{'values'}{$name} if exists $self->{'shaped'}{'values'}{$name}; } sub names_from_values { my ($self, $values) = @_; return '' unless ref $values eq 'ARRAY' and @$values == 3; return '' unless exists $self->{'shaped'}{'name'}[$values->[0]]; return '' unless exists $self->{'shaped'}{'name'}[$values->[0]][$values->[1]]; return '' unless exists $self->{'shaped'}{'name'}[$values->[0]][$values->[1]][$values->[2]]; return $self->{'shaped'}{'name'}[$values->[0]][$values->[1]][$values->[2]]; } #### nearness methods ################################################## sub closest_names_from_values { my ($self, $values) = @_; return '' unless ref $values eq 'ARRAY' and @$values == 3; my $names = names_from_values( $values ); return ($names, 0) if ref $names; my @names; my $sqr_min = 1 + 255**3; my $all_values = $self->{'shaped'}{'values'}; for my $index_name (keys %$all_values){ my $index_values = $all_values->{ $index_name }; my $temp_sqr_sum = ($index_values->[0] - $values->[0]) ** 2; next if $temp_sqr_sum > $sqr_min; $temp_sqr_sum += ($index_values->[1] - $values->[1]) ** 2; next if $temp_sqr_sum > $sqr_min; $temp_sqr_sum += ($index_values->[2] - $values->[2]) ** 2; next if $temp_sqr_sum > $sqr_min; @names = ($sqr_min == $temp_sqr_sum) ? (@names, $index_name) : $index_name; $sqr_min = $temp_sqr_sum; } return '' unless @names; # restore as much order as possible @names = map { @{$self->names_from_values( $self->values_from_name($_))} } @names; @names = uniq( @names ); return (\@names, sqrt($sqr_min)); } sub names_in_range { my ($self, $values, $range) = @_; my @names; my $sqr_max = $range ** 2; my $all_values = $self->{'shaped'}{'values'}; for my $index_name (keys %$all_values){ my $index_values = $all_values->{ $index_name }; my $temp_sqr_sum = ($index_values->[0] - $values->[0]) ** 2; next if $temp_sqr_sum > $sqr_max; $temp_sqr_sum += ($index_values->[1] - $values->[1]) ** 2; next if $temp_sqr_sum > $sqr_max; $temp_sqr_sum += ($index_values->[2] - $values->[2]) ** 2; next if $temp_sqr_sum > $sqr_max; push @names, $index_name; } return '' unless @names; # restore as much order as possible @names = map { @{$self->names_from_values( $self->values_from_name($_))} } @names; return [ uniq( @names ) ]; } #### util ############################################################## sub _clean_name { my $name = shift; $name =~ tr/_'//d; lc $name; } 1; __END__ =pod =head1 NAME Graphics::Toolkit::Color::Name::Scheme - a name space for color names =head1 SYNOPSIS use Graphics::Toolkit::Color::Name::Scheme; my $scheme = Graphics::Toolkit::Color::Name::Scheme->new(); $scheme->add_color( $_->{'name'}, $_->{'rgb_values'} ) for @colors; say for $scheme->all_names(); my $values = $scheme->values_from_name( 'blue' ); # tuple = 3 element ARRAY my $names = $scheme->names_from_values( $values ); # tuple -> ARRAY of names my ($names, $distance) = $scheme->closest_name( $values ); # tuple -> \@names, $distance =head1 DESCRIPTION This module is mainly for internal usage to model name spaces for HTML, SVG, Pantone ... colors. You may Use it to create your own set color names or to give color name constante slightly different values. =head1 ROUTINES =head2 new Needs no arguments. =head2 sub add_color takes two positional arguments, a color name a n ARRAY with three RGB values in range of 0 .. 255. =head2 all_names List of all names held by the scheme. =head2 is_name_taken Pseudo boolean tells you if given name is already held. =head2 values_from_name Returns the value tuple associated with the name. =head2 names_from_values Returns ARRAY ref with all names associated with these RGB values or an empty string if none. =head2 closest_names Returns ARRAY ref with all names associated with RGB values from this scheme that are the closest. Second return value is the distance between these closest names and the given value tuple (irst and only parameter). =head1 SEE ALSO L L =head1 COPYRIGHT & LICENSE Copyright 2025 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, Basis.pm100644001750001750 1456715055140237 26027 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space # count and names of color space axis (short and long), space name = usr | prefix + axis initials package Graphics::Toolkit::Color::Space::Basis; use v5.12; use warnings; use Graphics::Toolkit::Color::Space::Util qw/is_nr/; sub new { my ($pkg, $axis_long_names, $axis_short_names, $space_name, $alias_name) = @_; return 'first argument (axis names) has to be an ARRAY reference' unless ref $axis_long_names eq 'ARRAY'; return 'amount of shortcut names have to match that of full names' if defined $axis_short_names and (ref $axis_short_names ne 'ARRAY' or @$axis_long_names != @$axis_short_names); my @axis_long_name = map {lc} @$axis_long_names; my @axis_short_name = map { color_key_shortcut($_) } (defined $axis_short_names) ? @$axis_short_names : @axis_long_name; return 'need some axis names to create a color space' unless @axis_long_name > 0; return 'need same amount of axis short names and long names' unless @axis_long_name == @axis_short_name; my @iterator = 0 .. $#axis_long_name; my %long_name_order = map { $axis_long_name[$_] => $_ } @iterator; my %short_name_order = map { $axis_short_name[$_] => $_ } @iterator; my $axis_initials = uc join( '', @axis_short_name ); $space_name //= $axis_initials; $alias_name //= ''; bless { space_name => uc $space_name, alias_name => uc $alias_name, axis_long_name => \@axis_long_name, axis_short_name => \@axis_short_name, long_name_order => \%long_name_order, short_name_order => \%short_name_order, axis_iterator => \@iterator } } sub color_key_shortcut { lc substr($_[0], 0, 1) if defined $_[0] } #### getter ############################################################ sub space_name { $_[0]{'space_name'} } # color space name sub alias_name { $_[0]{'alias_name'} } # alternative space name sub long_axis_names { @{$_[0]{'axis_long_name'}} } # axis full names sub short_axis_names { @{$_[0]{'axis_short_name'}} } # axis short names sub axis_iterator { @{$_[0]{'axis_iterator'}} } # counting all axis 0 .. -1 sub axis_count { int @{$_[0]{'axis_iterator'}} } # amount of axis sub pos_from_long_axis_name { defined $_[1] ? $_[0]->{'long_name_order'}{ lc $_[1] } : undef } # ~long_name --> +pos sub pos_from_short_axis_name { defined $_[1] ? $_[0]->{'short_name_order'}{ lc $_[1] } : undef } # ~short_name --> +pos #### predicates ######################################################## sub is_name { return 0 if not defined $_[1]; return 1 if uc $_[1] eq $_[0]{'space_name'}; return 1 if $_[0]{'alias_name'} and uc $_[1] eq $_[0]{'alias_name'}; return 0; } sub is_long_axis_name { (defined $_[1] and exists $_[0]->{'long_name_order'}{ lc $_[1] }) ? 1 : 0 } # ~long_name --> ? sub is_short_axis_name { (defined $_[1] and exists $_[0]->{'short_name_order'}{ lc $_[1] }) ? 1 : 0 }# ~short_name --> ? sub is_axis_name { $_[0]->is_long_axis_name($_[1]) or $_[0]->is_short_axis_name($_[1]) } # ~name --> ? sub is_hash { # with all axis names as keys my ($self, $value_hash) = @_; $self->is_partial_hash( $value_hash ) and (keys %$value_hash == $self->axis_count); } sub is_partial_hash { # with some axis names as keys my ($self, $value_hash) = @_; return 0 unless ref $value_hash eq 'HASH'; my $key_count = keys %$value_hash; my @axis_visited; return 0 unless $key_count and $key_count <= $self->axis_count; for my $axis_name (keys %$value_hash) { return 0 unless $self->is_axis_name( $axis_name ); my $axis_pos = $self->pos_from_long_axis_name( $axis_name ); $axis_pos = $self->pos_from_short_axis_name( $axis_name ) unless defined $axis_pos; $axis_visited[ $axis_pos ]++; return 0 if $axis_visited[ $axis_pos ] > 1; } return 1; } sub is_value_tuple { (ref $_[1] eq 'ARRAY' and @{$_[1]} == $_[0]->axis_count) ? 1 : 0 } sub is_number_tuple { my ($self, $tuple) = @_; return 0 unless $self->is_value_tuple( $tuple ); map { return 0 unless is_nr( $tuple->[$_] ) } $self->axis_iterator; return 1; } #### converter ######################################################### sub short_axis_name_from_long { my ($self, $name) = @_; return unless $self->is_long_axis_name( $name ); ($self->short_axis_names)[ $self->pos_from_long_axis_name( $name ) ]; } sub long_axis_name_from_short { my ($self, $name) = @_; return unless $self->is_short_axis_name( $name ); ($self->long_axis_names)[ $self->pos_from_short_axis_name( $name ) ]; } sub long_name_hash_from_tuple { my ($self, $values) = @_; return unless $self->is_value_tuple( $values ); return { map { $self->{'axis_long_name'}[$_] => $values->[$_]} $self->axis_iterator }; } sub short_name_hash_from_tuple { my ($self, $values) = @_; return unless $self->is_value_tuple( $values ); return { map {$self->{'axis_short_name'}[$_] => $values->[$_]} $self->axis_iterator }; } sub tuple_from_hash { my ($self, $value_hash) = @_; return unless $self->is_hash( $value_hash ); my @values = (0) x $self->axis_count; for my $key (keys %$value_hash) { if ($self->is_long_axis_name( $key )) { $values[ $self->pos_from_long_axis_name($key) ] = $value_hash->{ $key } } elsif ($self->is_short_axis_name( $key )) { $values[ $self->pos_from_short_axis_name($key) ] = $value_hash->{ $key } } else { return "value of $key is missing" } } return \@values; } sub tuple_from_partial_hash { my ($self, $value_hash) = @_; return unless $self->is_partial_hash( $value_hash ); my $values = []; for my $key (keys %$value_hash) { if ( $self->is_long_axis_name( $key ) ) { $values->[$self->pos_from_long_axis_name($key) ] = $value_hash->{ $key } } elsif ( $self->is_short_axis_name( $key )) { $values->[$self->pos_from_short_axis_name($key)] = $value_hash->{ $key } } else { return "value of $key is missing" } } return $values; } sub select_tuple_value_from_axis_name { my ($self, $name, $values) = @_; $name = lc $name; return unless $self->is_value_tuple( $values ); return $values->[ $self->{'long_name_order'}{$name} ] if exists $self->{'long_name_order'}{$name}; return $values->[ $self->{'short_name_order'}{$name} ] if exists $self->{'short_name_order'}{$name}; undef; } 1; Shape.pm100644001750001750 3170515055140237 26017 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space # geometry of space: value range checks, normalisation and computing distance package Graphics::Toolkit::Color::Space::Shape; use v5.12; use warnings; use Graphics::Toolkit::Color::Space::Basis; use Graphics::Toolkit::Color::Space::Util qw/round_decimals is_nr/; #### constructor ####################################################### sub new { my $pkg = shift; my ($basis, $type, $range, $precision) = @_; return unless ref $basis eq 'Graphics::Toolkit::Color::Space::Basis'; # check axis type definition if (not defined $type){ $type = [ (1) x $basis->axis_count ] } # set all axis as linear per default elsif (ref $type eq 'ARRAY' and @$type == $basis->axis_count ) { for my $i ($basis->axis_iterator) { my $atype = $type->[$i]; # type def of this axis return unless defined $atype; if ($atype eq 'angular' or $atype eq 'circular' or $atype eq '0') { $type->[$i] = 0 } elsif ($atype eq 'linear' or $atype eq '1') { $type->[$i] = 1 } elsif ($atype eq 'no' or $atype eq '2') { $type->[$i] = 2 } else { return 'invalid axis type at element '.$i.'. It has to be "angular", "linear" or "no".' } } } else { return 'invalid axis type definition in color space '.$basis->space_name } $range = check_range_definition( $basis, $range ); return $range unless ref $range; $precision = check_precision_definition( $basis, $precision ); return $precision unless ref $precision; bless { basis => $basis, type => $type, range => $range, precision => $precision, constraint => {} } } sub check_range_definition { # check if range def is valid and eval (expand) it my ($basis, $range) = @_; $basis = $basis->{'basis'} if ref $basis eq __PACKAGE__; my $error_msg = 'Bad value range definition!'; $range = 1 if not defined $range or $range eq 'normal'; $range = 100 if $range eq 'percent'; return $error_msg." It has to be 'normal', 'percent', a number or ARRAY of numbers or ARRAY of ARRAY's with two number!" unless (not ref $range and is_nr( $range )) or (ref $range eq 'ARRAY') ; $range = [$range] unless ref $range; $range = [(@$range) x $basis->axis_count] if @$range == 1; return "Range definition needs inside an ARRAY either one definition for all axis or one definition". " for each axis!" if @$range != $basis->axis_count; for my $axis_index ($basis->axis_iterator) { my $axis_range = $range->[$axis_index]; if (not ref $axis_range){ if ($axis_range eq 'normal') {$range->[$axis_index] = [0, 1]} elsif ($axis_range eq 'percent') {$range->[$axis_index] = [0, 100]} else {$range->[$axis_index] = [0, $axis_range+0]} } elsif (ref $axis_range eq 'ARRAY') { return $error_msg.' Array at axis number '.$axis_index.' has to have two elements' unless @$axis_range == 2; return $error_msg.' None numeric value at lower bound for axis number '.$axis_index unless is_nr( $axis_range->[0] ); return $error_msg.' None numeric value at upper bound for axis number '.$axis_index unless is_nr( $axis_range->[1] ); return $error_msg.' Lower bound (first value) is >= than upper bound at axis number '.$axis_index if $axis_range->[0] >= $axis_range->[1]; } else { return "Range definitin for axis $axis_index was not an two element ARRAY!" } } return $range; } sub check_precision_definition { # check if precision def is valid and eval (exapand) it my ($basis, $precision) = @_; $basis = $basis->{'basis'} if ref $basis eq __PACKAGE__; $precision = -1 unless defined $precision; $precision = [($precision) x $basis->axis_count] unless ref $precision; return 'need an ARRAY as definition of axis value precision' unless ref $precision eq 'ARRAY'; return 'definition of axis value precision has to have same lengths as basis' unless @$precision == $basis->axis_count; return $precision; } sub add_constraint { my ($self, $name, $error_msg, $checker, $remedy) = @_; return unless defined $name and not exists $self->{'constraint'}{$name} and defined $error_msg and not ref $error_msg and length($error_msg) > 10 and ref $checker eq 'CODE' and ref $remedy eq 'CODE'; $self->{'constraint'}{$name} = {checker => $checker, remedy => $remedy, error => $error_msg}; } #### getter ############################################################ sub basis { $_[0]{'basis'}} sub is_linear { # overall linear space ? my ($self) = @_; map { return 0 if $self->{'type'}[$_] != 1 } $self->basis->axis_iterator; return 1; } sub is_int_valued { # all ranges int valued ? my ($self) = @_; map { return 0 if $self->{'precision'}[$_] != 0 } $self->basis->axis_iterator; return 1; } sub is_axis_numeric { my ($self, $axis_nr) = @_; return 0 if not defined $axis_nr or not exists $self->{'type'}[$axis_nr]; $self->{'type'}[$axis_nr] == 2 ? 0 : 1; } sub axis_value_max { # --> +value my ($self, $axis_nr, $range) = @_; $range = $self->try_check_range_definition( $range ); return undef unless ref $range; return undef unless $self->is_axis_numeric($axis_nr); return $range->[$axis_nr][1]; } sub axis_value_min { # --> +value my ($self, $axis_nr, $range) = @_; $range = $self->try_check_range_definition( $range ); return undef unless ref $range; return undef unless $self->is_axis_numeric($axis_nr); return $range->[$axis_nr][0]; } sub axis_value_precision { # --> +precision? my ($self, $axis_nr, $precision) = @_; return undef if not defined $axis_nr or not exists $self->{'type'}[$axis_nr]; return undef unless $self->is_axis_numeric($axis_nr); $precision //= $self->{'precision'}; return undef unless ref $precision eq 'ARRAY' and exists $precision->[$axis_nr]; $precision->[$axis_nr]; } #### data checker ###################################################### sub try_check_range_definition { # check if range def is valid and eval (expand) it my ($self, $range) = @_; return $self->{'range'} unless defined $range; return check_range_definition( $self->{'basis'}, $range ); } sub try_check_precision_definition { # check if range def is valid and eval (expand) it my ($self, $precision) = @_; return $self->{'precision'} unless defined $precision; return check_precision_definition( $self->{'basis'}, $precision ); } sub check_value_shape { # $vals -- $range, $precision --> $@vals | ~! my ($self, $values, $range, $precision) = @_; return 'color value tuple in '.$self->basis->space_name.' space needs to be ARRAY ref with '.$self->basis->axis_count.' elements' unless $self->basis->is_value_tuple( $values ); $range = $self->try_check_range_definition( $range ); return $range unless ref $range; $precision = $self->try_check_precision_definition( $precision ); return $precision unless ref $precision; my @names = $self->basis->long_axis_names; for my $axis_index ($self->basis->axis_iterator){ next unless $self->is_axis_numeric( $axis_index ); return $names[$axis_index]." value is below minimum of ".$range->[$axis_index][0] if $values->[$axis_index] < $range->[$axis_index][0]; return $names[$axis_index]." value is above maximum of ".$range->[$axis_index][1] if $values->[$axis_index] > $range->[$axis_index][1]; return $names[$axis_index]." value is not properly rounded " if $precision->[$axis_index] >= 0 and round_decimals($values->[$axis_index], $precision->[$axis_index]) != $values->[$axis_index]; } for my $constraint (values %{$self->{'constraint'}}){ return $constraint->{'error'} unless $constraint->{'checker'}->( $values ); } return $values; } sub is_in_linear_bounds { # :values --> ? my ($self, $values) = @_; return 0 unless $self->basis->is_number_tuple( $values ); for my $axis_nr ($self->basis->axis_iterator) { return 0 if $self->{'type'}[$axis_nr] == 1 and ( $values->[$axis_nr] < $self->{'range'}[$axis_nr][0] or $values->[$axis_nr] > $self->{'range'}[$axis_nr][1] ); } for my $constraint (values %{$self->{'constraint'}}){ return 0 unless $constraint->{'checker'}->( $values ); } return 1; } sub is_equal { my ($self, $values_a, $values_b, $precision) = @_; return 0 unless $self->basis->is_value_tuple( $values_a ) and $self->basis->is_value_tuple( $values_b ); $precision = $self->try_check_precision_definition( $precision ); for my $axis_nr ($self->basis->axis_iterator) { return 0 if round_decimals($values_a->[$axis_nr], $precision->[$axis_nr]) != round_decimals($values_b->[$axis_nr], $precision->[$axis_nr]); } return 1; } #### value shape ####################################################### sub clamp { # change values if outside of range to nearest boundary, angles get rotated into range my ($self, $values, $range) = @_; $range = $self->try_check_range_definition( $range ); return $range unless ref $range; $values = [] unless ref $values eq 'ARRAY'; pop @$values while @$values > $self->basis->axis_count; for my $axis_nr ($self->basis->axis_iterator){ next unless $self->is_axis_numeric( $axis_nr ); # touch only numeric values if (not defined $values->[$axis_nr]){ my $default_value = 0; $default_value = $range->[$axis_nr][0] if $default_value < $range->[$axis_nr][0] or $default_value > $range->[$axis_nr][1]; $values->[$axis_nr] = $default_value; next; } if ($self->{'type'}[$axis_nr]){ $values->[$axis_nr] = $range->[$axis_nr][0] if $values->[$axis_nr] < $range->[$axis_nr][0]; $values->[$axis_nr] = $range->[$axis_nr][1] if $values->[$axis_nr] > $range->[$axis_nr][1]; } else { my $delta = $range->[$axis_nr][1] - $range->[$axis_nr][0]; $values->[$axis_nr] += $delta while $values->[$axis_nr] < $range->[$axis_nr][0]; $values->[$axis_nr] -= $delta while $values->[$axis_nr] > $range->[$axis_nr][1]; $values->[$axis_nr] = $range->[$axis_nr][0] if $values->[$axis_nr] == $range->[$axis_nr][1]; } } for my $constraint (values %{$self->{'constraint'}}){ $values = $constraint->{'remedy'}->( $values ) unless $constraint->{'checker'}->( $values ); } return $values; } sub round { my ($self, $values, $precision) = @_; return unless $self->basis->is_value_tuple( $values ); $precision = $self->try_check_precision_definition( $precision ); return "round got bad precision definition" unless ref $precision; [ map { ($self->is_axis_numeric( $_ ) and $precision->[$_] >= 0) ? round_decimals ($values->[$_], $precision->[$_]) : $values->[$_] } $self->basis->axis_iterator ]; } #### normalisation ##################################################### sub normalize { my ($self, $values, $range) = @_; return unless $self->basis->is_value_tuple( $values ); $range = $self->try_check_range_definition( $range ); return $range unless ref $range; [ map { ($self->is_axis_numeric( $_ )) ? (($values->[$_] - $range->[$_][0]) / ($range->[$_][1]-$range->[$_][0])) : $values->[$_] } $self->basis->axis_iterator ]; } sub denormalize { my ($self, $values, $range) = @_; return unless $self->basis->is_value_tuple( $values ); $range = $self->try_check_range_definition( $range ); return $range unless ref $range; return [ map { ($self->is_axis_numeric( $_ )) ? ($values->[$_] * ($range->[$_][1]-$range->[$_][0]) + $range->[$_][0]) : $values->[$_] } $self->basis->axis_iterator ]; } sub denormalize_delta { my ($self, $delta_values, $range) = @_; return unless $self->basis->is_value_tuple( $delta_values ); $range = $self->try_check_range_definition( $range ); return $range unless ref $range; [ map { ($self->is_axis_numeric( $_ )) ? ($delta_values->[$_] * ($range->[$_][1]-$range->[$_][0])) : $delta_values->[$_] } $self->basis->axis_iterator ]; } sub delta { # values have to be normalized my ($self, $values1, $values2) = @_; return unless $self->basis->is_value_tuple( $values1 ) and $self->basis->is_value_tuple( $values2 ); # ignore none numeric dimensions my @delta = map { $self->is_axis_numeric($_) ? ($values2->[$_] - $values1->[$_]) : 0 } $self->basis->axis_iterator; [ map { $self->{'type'}[$_] ? $delta[$_] : # adapt to circular dimensions $delta[$_] < -0.5 ? ($delta[$_]+1) : $delta[$_] > 0.5 ? ($delta[$_]-1) : $delta[$_] } $self->basis->axis_iterator ]; } 1; Format.pm100644001750001750 2307515055140237 26210 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space # bidirectional conversion of value tuples (ARRAY) into different string and other formats # values themself can have space dependant extra shape, suffixes, etc. package Graphics::Toolkit::Color::Space::Format; use v5.12; use warnings; my $number_form = '-?(?:\d+|\d+\.\d+|\.\d+)'; #### constructor and name space API #################################### sub new { # -, $:Basis -- ~|@~val_form, , ~|@~suffix --> :_ my ($pkg, $basis, $value_form, $prefix, $suffix) = @_; return 'First argument has to be an Color::Space::Basis reference !' unless ref $basis eq 'Graphics::Toolkit::Color::Space::Basis'; my $count = $basis->axis_count; $value_form = $number_form unless defined $value_form; $value_form = [($value_form) x $count] unless ref $value_form; return "Definition of the value format has to be as ARRAY reference" if ref $value_form ne 'ARRAY'; $value_form = [ map {(defined $_ and $_) ? $_ : $number_form } @$value_form]; # fill missing defs with default return 'Need a value form definition for every axis!' unless @$value_form == $count; $suffix = create_suffix_list( $basis, $suffix ) ; return $suffix unless ref $suffix; # format --> tuple my %deformats = ( hash => sub { tuple_from_hash(@_) }, named_array => sub { tuple_from_named_array(@_) }, named_string => sub { tuple_from_named_string(@_) }, css_string => sub { tuple_from_css_string(@_) }, ); # tuple --> format my %formats = (list => sub { @{$_[1]} }, # 1, 2, 3 hash => sub { $basis->long_name_hash_from_tuple($_[1]) }, # { red => 1, green => 2, blue => 3 } char_hash => sub { $basis->short_name_hash_from_tuple($_[1]) }, # { r =>1, g => 2, b => 3 } named_array => sub { [$basis->space_name, @{$_[1]}] }, # ['rgb',1,2,3] named_string => sub { $_[0]->named_string_from_tuple($_[1]) }, # 'rgb: 1, 2, 3' css_string => sub { $_[0]->css_string_from_tuple($_[1]) }, # 'rgb(1,2,3)' ); bless { basis => $basis, deformatter => \%deformats, formatter => \%formats, value_form => $value_form, prefix => $prefix, suffix => $suffix, value_numifier => { into_numric => '', from_numeric => '' }, } } sub create_suffix_list { my ($basis, $suffix) = @_; my $count = $basis->axis_count; $suffix = [('') x $count] unless defined $suffix; $suffix = [($suffix) x $count] unless ref $suffix; return 'need an ARRAY as definition of axis value suffix' unless ref $suffix eq 'ARRAY'; return 'definition of axis value suffix has to have same lengths as basis' unless @$suffix == $count; return $suffix; } sub add_formatter { my ($self, $format, $code) = @_; return if not defined $format or ref $format or ref $code ne 'CODE'; return if $self->has_formatter( $format ); $self->{'formatter'}{ $format } = $code; } sub add_deformatter { my ($self, $format, $code) = @_; return if not defined $format or ref $format or ref $code ne 'CODE'; return if $self->has_deformatter( $format ); $self->{'deformatter'}{ lc $format } = $code; } sub set_value_numifier { my ($self, $pre_code, $post_code) = @_; return 0 if ref $pre_code ne 'CODE' or ref $post_code ne 'CODE'; $self->{'value_numifier'}{'into_numric'} = $pre_code; $self->{'value_numifier'}{'from_numeric'} = $post_code; } #### public API: formatting value tuples ############################### sub basis { $_[0]{'basis'}} sub has_formatter { (defined $_[1] and exists $_[0]{'formatter'}{ lc $_[1] }) ? 1 : 0 } sub has_deformatter { (defined $_[1] and exists $_[0]{'deformatter'}{ lc $_[1] }) ? 1 : 0 } sub get_suffix { my ($self, $suffix) = @_; return $self->{'suffix'} unless defined $suffix; create_suffix_list( $self->{'basis'}, $suffix ); } sub deformat { my ($self, $color, $suffix) = @_; return undef unless defined $color; $suffix = $self->get_suffix( $suffix ); return $suffix unless ref $suffix; for my $format_name (sort keys %{$self->{'deformatter'}}){ my $deformatter = $self->{'deformatter'}{$format_name}; my $values = $deformatter->( $self, $color ); next unless ref $values; $values = $self->check_raw_value_format( $values ); next unless ref $values; $values = $self->remove_suffix($values, $suffix); next unless ref $values; return wantarray ? ($values, $format_name) : $values; } return undef; } sub format { my ($self, $values, $format, $suffix, $prefix) = @_; return '' unless $self->basis->is_value_tuple( $values ); return '' unless $self->has_formatter( $format ); $suffix = $self->get_suffix( $suffix ); return $suffix unless ref $suffix; $values = $self->add_suffix( $values, $suffix ); $self->{'formatter'}{ lc $format }->($self, $values); } #### work methods ###################################################### sub remove_suffix { # and unnecessary white space my ($self, $values, $suffix) = @_; return unless $self->basis->is_value_tuple( $values ); $suffix = $self->get_suffix( $suffix ); return $suffix unless ref $suffix; $values = [@$values]; # loose ref and side effects if (ref $self->{'value_numifier'}{'into_numric'}){ $values = $self->{'value_numifier'}{'into_numric'}->($values); return unless $self->basis->is_value_tuple( $values ); } local $/ = ' '; chomp $values->[$_] for $self->basis->axis_iterator; for my $axis_index ($self->basis->axis_iterator){ next unless $suffix->[ $axis_index ]; my $val_length = length $values->[ $axis_index ]; my $suf_length = length $suffix->[ $axis_index ]; $values->[$axis_index] = substr($values->[$axis_index], 0, $val_length - $suf_length) if substr( $values->[$axis_index], - $suf_length) eq $suffix->[ $axis_index ] and substr( $values->[$axis_index], - ($suf_length+1),1) ne ' '; } return $values; } sub add_suffix { my ($self, $values, $suffix) = @_; return unless $self->basis->is_value_tuple( $values ); $suffix = $self->get_suffix( $suffix ); return $suffix unless ref $suffix; # has to be array or error message $values = [@$values]; # loose ref and side effects if (ref $self->{'value_numifier'}{'from_numeric'}){ $values = $self->{'value_numifier'}{'from_numeric'}->($values); return unless $self->basis->is_value_tuple( $values ); } local $/ = ' '; chomp $values->[$_] for $self->basis->axis_iterator; for my $axis_index ($self->basis->axis_iterator){ next unless $suffix->[ $axis_index ]; my $val_length = length $values->[ $axis_index ]; my $suf_length = length $suffix->[ $axis_index ]; $values->[$axis_index] .= $suffix->[ $axis_index ] if substr( $values->[$axis_index], - $suf_length) ne $suffix->[ $axis_index ]; } return $values; } sub check_raw_value_format { my ($self, $values) = @_; return 0 if ref $values ne 'ARRAY'; return 0 if @$values != $self->basis->axis_count; my @re = $self->get_value_regex(); for my $axis_index ($self->basis->axis_iterator){ return 0 unless $values->[$axis_index] =~ /^$re[$axis_index]$/; } return $values; } sub get_value_regex { my ($self) = @_; map {'\s*('.$self->{'value_form'}[$_].'(?:'.quotemeta($self->{'suffix'}[$_]).')?)\s*' } # quotemeta $self->basis->axis_iterator; } #### converter: format --> values ###################################### sub tuple_from_named_string { my ($self, $string) = @_; return 0 unless defined $string and not ref $string; my $name = $self->basis->space_name; $string =~ /^\s*$name:\s*(\s*[^:]+)\s*$/i; my $match = $1; unless ($match){ my $name = $self->basis->alias_name; return 0 unless $name; $string =~ /^\s*$name:\s*(\s*[^:]+)\s*$/i; $match = $1; } return 0 unless $match; local $/ = ' '; chomp $match; return [split(/\s*,\s*/, $match)] if index($match, ',') > -1; return [split(/\s+/, $match)]; } sub tuple_from_css_string { my ($self, $string) = @_; return 0 unless defined $string and not ref $string; my $name = $self->basis->space_name; $string =~ /^\s*$name\(\s*([^)]+)\s*\)\s*$/i; my $match = $1; unless ($match){ my $name = $self->basis->alias_name; return 0 unless $name; $string =~ /^\s*$name\(\s*([^)]+)\s*\)\s*$/i; $match = $1; } return 0 unless $match; local $/ = ' '; chomp $match; return [split(/\s*,\s*/, $match)] if index($match, ',') > -1; return [split(/\s+/, $match)]; } sub tuple_from_named_array { my ($self, $array) = @_; return 0 unless ref $array eq 'ARRAY'; return 0 unless @$array == $self->basis->axis_count+1; return 0 unless $self->basis->is_name( $array->[0] ); return [@{$array}[1 .. $#$array]]; } sub tuple_from_hash { my ($self, $hash) = @_; return 0 unless $self->basis->is_hash($hash); $self->basis->tuple_from_hash( $hash ); } #### converter: values --> format ###################################### sub named_array_from_tuple { my ($self, $values, $name) = @_; $name //= $self->basis->space_name; return [$name, @$values]; } sub named_string_from_tuple { my ($self, $values, $name) = @_; $name //= $self->basis->space_name; return lc( $name).': '.join(', ', @$values); } sub css_string_from_tuple { my ($self, $values, $name) = @_; $name //= $self->basis->space_name; return lc( $name).'('.join(', ', @$values).')'; } 1; Constant.pm100644001750001750 15254215055140237 26420 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Name # named colors from X11, HTML (SVG) standard and Pantone report package Graphics::Toolkit::Color::Name::Constant; use v5.12; use warnings; [{ # 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 ], 'lime' => [ 0, 255, 0, 120, 100, 50 ], 'green' => [ 0, 128, 0, 120, 100, 25 ], 'blue' => [ 0, 0, 255, 240, 100, 50 ], 'yellow' => [ 255, 255, 0, 60, 100, 50 ], 'cyan' => [ 0, 255, 255, 180, 100, 50 ], 'magenta' => [ 255, 0, 255, 300, 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 ], 'beige' => [ 245, 245, 220, 60, 56, 91 ], 'brown' => [ 165, 42, 42, 0, 59, 41 ], 'gray' => [ 128, 128, 128, 0, 0, 50 ], 'grey' => [ 225, 225, 225, 0, 0, 88 ], },{ 'aliceblue' => [ 240, 248, 255, 208, 100, 97 ], 'antiquewhite' => [ 250, 235, 215, 34, 78, 91 ], 'aqua' => [ 0, 255, 255, 180, 100, 50 ], 'aquamarine' => [ 127, 255, 212, 160, 100, 75 ], 'azure' => [ 240, 255, 255, 180, 100, 97 ], 'bisque' => [ 255, 228, 196, 33, 100, 88 ], 'blanchedalmond' => [ 255, 235, 205, 36, 100, 90 ], 'blueviolet' => [ 138, 43, 226, 271, 76, 53 ], 'burlywood' => [ 222, 184, 135, 34, 57, 70 ], 'cadetblue' => [ 95, 158, 160, 182, 25, 50 ], 'coral' => [ 255, 127, 80, 16, 100, 66 ], 'chartreuse' => [ 127, 255, 0, 90, 100, 50 ], 'chocolate' => [ 210, 105, 30, 25, 75, 47 ], 'cornflowerblue' => [ 100, 149, 237, 219, 79, 66 ], 'cornsilk' => [ 255, 248, 220, 48, 100, 93 ], 'crimson' => [ 220, 20, 60, 348, 83, 47 ], 'darkblue' => [ 0, 0, 139, 240, 100, 27 ], 'darkcyan' => [ 0, 139, 139, 180, 100, 27 ], 'darkgoldenrod' => [ 184, 134, 11, 43, 89, 38 ], '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 ], 'darkorange' => [ 255, 140, 0, 33, 100, 50 ], 'darkorchid' => [ 153, 50, 204, 280, 61, 50 ], 'darkolivegreen' => [ 85, 107, 47, 82, 39, 30 ], 'darkred' => [ 139, 0, 0, 0, 100, 27 ], 'darksalmon' => [ 233, 150, 122, 15, 72, 70 ], 'darkseagreen' => [ 143, 188, 143, 120, 25, 65 ], 'darkslateblue' => [ 72, 61, 139, 248, 39, 39 ], 'darkslategray' => [ 47, 79, 79, 180, 25, 25 ], 'darkturquoise' => [ 0, 206, 209, 181, 100, 41 ], 'darkviolet' => [ 148, 0, 211, 282, 100, 41 ], 'deeppink' => [ 255, 20, 147, 328, 100, 54 ], 'dimgray' => [ 105, 105, 105, 0, 0, 41 ], 'dodgerblue' => [ 30, 144, 255, 210, 100, 56 ], 'firebrick' => [ 178, 34, 34, 0, 68, 42 ], '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 ], 'goldenrod' => [ 218, 165, 32, 43, 74, 49 ], 'greenyellow' => [ 173, 255, 47, 84, 100, 59 ], 'honeydew' => [ 240, 255, 240, 120, 100, 97 ], 'hotpink' => [ 255, 105, 180, 330, 100, 71 ], 'indianred' => [ 205, 92, 92, 0, 53, 58 ], 'indigo' => [ 75, 0, 130, 275, 100, 25 ], 'ivory' => [ 255, 255, 240, 60, 100, 97 ], 'khaki' => [ 240, 230, 140, 54, 77, 75 ], 'lavender' => [ 230, 230, 250, 240, 67, 94 ], 'lavenderblush' => [ 255, 240, 245, 340, 100, 97 ], 'lawngreen' => [ 124, 252, 0, 90, 100, 49 ], 'lemonchiffon' => [ 255, 250, 205, 54, 100, 90 ], 'light' => [ 238, 221, 130, 51, 76, 72 ], 'lightblue' => [ 173, 216, 230, 195, 53, 79 ], 'lightcoral' => [ 240, 128, 128, 0, 79, 72 ], 'lightcyan' => [ 224, 255, 255, 180, 100, 94 ], 'lightgray' => [ 211, 211, 211, 0, 0, 83 ], 'lightgreen' => [ 144, 238, 144, 120, 73, 75 ], 'lightpink' => [ 255, 182, 193, 351, 100, 86 ], 'lightpurple' => [ 145, 0, 250, 275, 100, 49 ], # not in X11 'lightsalmon' => [ 255, 160, 122, 17, 100, 74 ], 'lightseagreen' => [ 32, 178, 170, 177, 70, 41 ], 'lightskyblue' => [ 135, 206, 250, 203, 92, 75 ], 'lightslateblue' => [ 132, 112, 255, 248, 100, 72 ], 'lightslategray' => [ 119, 136, 153, 210, 14, 53 ], 'lightsteelblue' => [ 176, 196, 222, 214, 41, 78 ], 'lightyellow' => [ 255, 255, 224, 60, 100, 94 ], 'limegreen' => [ 50, 205, 50, 120, 61, 50 ], 'linen' => [ 250, 240, 230, 30, 67, 94 ], 'maroon' => [ 128, 0, 0, 0, 100, 25 ], '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 ], 'mediumpurple' => [ 147, 112, 219, 260, 60, 65 ], '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 ], 'moccasin' => [ 255, 228, 181, 38, 100, 85 ], 'navajowhite' => [ 255, 222, 173, 36, 100, 84 ], '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 ], 'orange' => [ 255, 165, 0, 39, 100, 50 ], 'orangered' => [ 255, 69, 0, 16, 100, 50 ], 'orchid' => [ 218, 112, 214, 302, 59, 65 ], 'papayawhip' => [ 255, 239, 213, 37, 100, 92 ], 'pale' => [ 219, 112, 147, 340, 60, 65 ], 'palegoldenrod' => [ 238, 232, 170, 55, 67, 80 ], 'palegreen' => [ 152, 251, 152, 120, 93, 79 ], 'paleturquoise' => [ 175, 238, 238, 180, 65, 81 ], 'palevioletred' => [ 219, 112, 147, 340, 60, 65 ], 'peachpuff' => [ 255, 218, 185, 28, 100, 86 ], 'peru' => [ 205, 133, 63, 30, 59, 53 ], 'powderblue' => [ 176, 224, 230, 187, 52, 80 ], 'rebeccapurple' => [ 102, 51, 153, 270, 50, 40 ], 'rosybrown' => [ 188, 143, 143, 0, 25, 65 ], 'royalblue' => [ 65, 105, 225, 225, 73, 57 ], 'snow' => [ 255, 250, 250, 0, 100, 99 ], 'saddlebrown' => [ 139, 69, 19, 25, 76, 31 ], 'salmon' => [ 250, 128, 114, 6, 93, 71 ], 'sandybrown' => [ 244, 164, 96, 28, 87, 67 ], 'seagreen' => [ 46, 139, 87, 146, 50, 36 ], 'sienna' => [ 160, 82, 45, 19, 56, 40 ], 'slategray' => [ 112, 128, 144, 210, 13, 50 ], 'springgreen' => [ 0, 255, 127, 150, 100, 50 ], 'steelblue' => [ 70, 130, 180, 207, 44, 49 ], 'silver' => [ 192, 192, 192, 0, 0, 75 ], 'skyblue' => [ 135, 206, 235, 197, 71, 73 ], 'tan' => [ 210, 180, 140, 34, 44, 69 ], 'teal' => [ 0, 128, 128, 180, 100, 25 ], 'thistle' => [ 216, 191, 216, 300, 24, 80 ], 'tomato' => [ 255, 99, 71, 9, 100, 64 ], 'turquoise' => [ 69, 184, 172, 174, 45, 50 ], 'violet' => [ 238, 130, 238, 300, 76, 72 ], 'violetred' => [ 208, 32, 144, 322, 73, 47 ], 'wheat' => [ 245, 222, 179, 39, 77, 83 ], 'whitesmoke' => [ 245, 245, 245, 0, 0, 96 ], 'yellowgreen' => [ 154, 205, 50, 80, 61, 50 ], },{ '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], '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 ], },{ # 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-25 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, SetCalculator.pm100644001750001750 2037415055140237 26471 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color # color value operation generating color sets package Graphics::Toolkit::Color::SetCalculator; use v5.12; use warnings; use Graphics::Toolkit::Color::Values; my $HSL = Graphics::Toolkit::Color::Space::Hub::get_space('HSL'); my $half_hue_max = $HSL->shape->axis_value_max(0) / 2; ######################################################################## sub complement { # :base_color +steps +tilt %target_delta --> @:values my ($start_color, $steps, $tilt, $target_delta) = @_; my $start_values = $start_color->shaped( $HSL->name ); my $target_values = [@$start_values]; $target_values->[0] += $half_hue_max; for my $axis_index (0 .. 2) { $target_delta->[$axis_index] = 0 unless defined $target_delta->[$axis_index]; $target_values->[$axis_index] += $target_delta->[$axis_index]; } $target_values = $HSL->clamp( $target_values ); # bring back out of bound linear axis values $target_delta->[1] = $target_values->[1] - $start_values->[1]; $target_delta->[2] = $target_values->[2] - $start_values->[2]; my $result_count = int abs $steps; my $scaling_exponent = abs($tilt) + 1; my @hue_percent = map {($_ * 2 / $result_count) ** $scaling_exponent} 1 .. ($result_count - 1) / 2; @hue_percent = map {1 - $_} reverse @hue_percent if $tilt > 0; my $hue_delta = $half_hue_max + $target_delta->[0]; # real value size of half complement circle my @result = (); push( @result, Graphics::Toolkit::Color::Values->new_from_tuple( [$start_values->[0] + ($hue_delta * $_), $start_values->[1] + ($target_delta->[1] * $_), $start_values->[2] + ($target_delta->[2] * $_)], $HSL->name)) for @hue_percent; push @result, Graphics::Toolkit::Color::Values->new_from_tuple( $target_values, $HSL->name) if $result_count == 1 or not $result_count % 2; $hue_delta = $half_hue_max - $target_delta->[0]; @hue_percent = map {1 - $_} reverse @hue_percent; push( @result, Graphics::Toolkit::Color::Values->new_from_tuple( [$target_values->[0] + ($hue_delta * $_), $target_values->[1] - ($target_delta->[1] * $_), $target_values->[2] - ($target_delta->[2] * $_)], $HSL->name)) for @hue_percent; push @result, $start_color if $result_count > 1; return @result; } ######################################################################## sub gradient { # @:colors, +steps, +tilt, :space --> @:values my ($colors, $steps, $tilt, $color_space) = @_; my $scaling_exponent = abs($tilt) + 1; # tilt = exponential scaling my $segment_count = @$colors - 1; my @percent_in_gradient = map {(($_-1) / ($steps-1)) ** $scaling_exponent} 2 .. $steps - 1; @percent_in_gradient = map {1 - $_} reverse @percent_in_gradient if $tilt < 0; my @result = ($colors->[0]); for my $step_nr (2 .. $steps - 1){ my $percent_in_gradient = $percent_in_gradient[$step_nr-2]; my $current_segment_nr = int ($percent_in_gradient * $segment_count); my $percent_in_segment = 100 * $segment_count * ($percent_in_gradient - ($current_segment_nr / $segment_count)); push @result, $colors->[$current_segment_nr]->mix ( [{color => $colors->[$current_segment_nr+1], percent => $percent_in_segment}], $color_space ); } push @result, pop @$colors if $steps > 1; return @result; } ######################################################################## my $adj_len_at_45_deg = sqrt(2) / 2; sub cluster { # :values, +radius @+|+distance, :space --> @:values my ($center_color, $cluster_radius, $color_distance, $color_space) = @_; my $color_space_name = $color_space->name; my $center_values = $center_color->shaped( $color_space_name ); my $center_x = $center_values->[0]; my $center_y = $center_values->[1]; my $center_z = $center_values->[2]; my @result_values; if (ref $cluster_radius) { # cuboid shaped cluster my $colors_in_direction = int $cluster_radius->[0] / $color_distance; my $corner_value = $center_values->[0] - ($colors_in_direction * $color_distance); @result_values = map {[$corner_value + ($_ * $color_distance)]} 0 .. 2 * $colors_in_direction; for my $axis_index (1 .. $color_space->axis_count - 1){ my $colors_in_direction = int $cluster_radius->[$axis_index] / $color_distance; my $corner_value = $center_values->[$axis_index] - ($colors_in_direction * $color_distance); @result_values = map { my @good_values = @$_[0 .. $axis_index-1]; map {[@good_values, ($corner_value + ($_ * $color_distance))]} 0 .. 2 * $colors_in_direction; } @result_values; } } else { # ball shaped cluster (FCC) my $layer_distance = sqrt( 2 * $color_distance * $color_distance ) / 2; for my $layer_nr (0 .. $cluster_radius / $layer_distance){ my $layer_height = $layer_nr * $layer_distance; my $layer_z_up = $center_z + $layer_height; my $layer_z_dn = $center_z - $layer_height; my $layer_radius = sqrt( ($cluster_radius**2) - ($layer_height**2) ); my $radius_in_colors = $layer_radius / $color_distance; if ($layer_nr % 2){ # odd layer of cuboctahedral packing my $contour_cursor = int ($radius_in_colors - 0.5); my $grid_row_count = ($radius_in_colors * $adj_len_at_45_deg) - .5; next if $grid_row_count < 0; my @grid = (); for my $x_index (0 .. $grid_row_count){ $contour_cursor-- if sqrt( (($contour_cursor+.5)**2) + (($x_index+.5)**2) ) > $radius_in_colors; $grid[$x_index] = $contour_cursor; $grid[$contour_cursor] = $x_index; } for my $x_index (0 .. $#grid){ my $delta_x = (0.5 + $x_index) * $color_distance; my ($x1, $x2) = ($center_x + $delta_x, $center_x - $delta_x); for my $y_index (0 .. $grid[$x_index]){ my $delta_y = (0.5 + $y_index) * $color_distance; my ($y1, $y2) = ($center_y + $delta_y, $center_y - $delta_y); push @result_values, [$x1, $y1, $layer_z_up], [$x2, $y1, $layer_z_up], [$x1, $y2, $layer_z_up], [$x2, $y2, $layer_z_up], [$x1, $y1, $layer_z_dn], [$x2, $y1, $layer_z_dn], [$x1, $y2, $layer_z_dn], [$x2, $y2, $layer_z_dn]; } } } else { # even layer of cuboctahedral packing my $grid_row_count = int $radius_in_colors; my @grid = ($grid_row_count); $grid[$grid_row_count] = 0; my $contour_cursor = $grid_row_count; for my $x_index (1 .. $layer_radius * $adj_len_at_45_deg / $color_distance){ $contour_cursor-- if sqrt(($contour_cursor**2) + ($x_index**2)) > $radius_in_colors; $grid[$x_index] = $contour_cursor; $grid[$contour_cursor] = $x_index; } my @layer_values = map {[$center_x + ($_ * $color_distance), $center_y, $layer_z_up]} -$grid_row_count .. $grid_row_count; for my $y_index (1 .. $grid_row_count){ my $delta_y = $y_index * $color_distance; my ($y1, $y2) = ($center_y + $delta_y, $center_y - $delta_y); for my $x_index (-$grid[$y_index] .. $grid[$y_index]){ my $x = $center_x + ($x_index * $color_distance); push @layer_values, [$x, $y1, $layer_z_up], [$x, $y2, $layer_z_up]; } } if ($layer_nr > 0){ push @result_values, [$_->[0], $_->[1], $layer_z_dn] for @layer_values; } push @result_values, @layer_values; } } } # check for linear space borders and constraints return map { Graphics::Toolkit::Color::Values->new_from_tuple( $_, $color_space_name )} grep { $color_space->is_in_linear_bounds($_) } @result_values; } 1; Instance000755001750001750 015055140237 25777 5ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/SpaceCMY.pm100644001750001750 50615055140237 27106 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CMY color space specific code package Graphics::Toolkit::Color::Space::Instance::CMY; use v5.12; use warnings; use Graphics::Toolkit::Color::Space; sub invert { [ map {1 - $_} @{$_[0]} ] } Graphics::Toolkit::Color::Space->new ( axis => [qw/cyan magenta yellow/], convert => {RGB => [\&invert, \&invert]}, ); HSB.pm100644001750001750 254215055140237 27114 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # HSB color space specific code package Graphics::Toolkit::Color::Space::Instance::HSB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/min max/; sub from_rgb { my ($r, $g, $b) = @{$_[0]}; 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) = @{$_[0]}; 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); return \@rgb; } Graphics::Toolkit::Color::Space->new ( axis => [qw/hue saturation brightness/], range => [360, 100, 100], precision => 0, type => [qw/angular linear linear/], suffix => ['', '%', '%'], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); HSL.pm100644001750001750 270615055140237 27130 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # HSL color space specific code package Graphics::Toolkit::Color::Space::Instance::HSL; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/min max mod_real/; sub from_rgb { my ($r, $g, $b) = @{$_[0]}; 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) = @{$_[0]}; $h *= 6; my $C = $s * (1 - abs($l * 2 - 1)); my $X = $C * (1 - abs( mod_real($h, 2) - 1) ); my $m = $l - ($C / 2); my @rgb = ($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); return \@rgb; } Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation lightness/], range => [ 360, 100, 100 ], precision => 0, type => [qw/angular linear linear/], # suffix => ['', '%', '%'], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); HSV.pm100644001750001750 246715055140237 27146 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # HSV color space specific code package Graphics::Toolkit::Color::Space::Instance::HSV; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/min max/; sub from_rgb { my ($r, $g, $b) = @{$_[0]}; 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) = @{$_[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); return \@rgb; } Graphics::Toolkit::Color::Space->new ( axis => [qw/hue saturation value/], range => [360, 100, 100], precision => 0, type => [qw/angular linear linear/], # suffix => ['', '%', '%'], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); HWB.pm100644001750001750 316015055140237 27115 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # HWB color space specific code package Graphics::Toolkit::Color::Space::Instance::HWB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/min max/; # add constraint W + B <= 100 sub from_rgb { my ($r, $g, $b) = @{$_[0]}; my $vmax = max($r, $g, $b); my $white = my $vmin = min($r, $g, $b); return ([0,1,0]) if $white == 1; my $black = 1 - ($vmax); return ([0,0,1]) if $black == 1; 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) = @{$_[0]}; 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); return \@rgb; } Graphics::Toolkit::Color::Space->new( axis => [qw/hue whiteness blackness/], range => [360, 100, 100], precision => 0, type => [qw/angular linear linear/], suffix => ['', '%', '%'], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); RGB.pm100644001750001750 226015055140237 27107 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # sRGB color space IEC 61966-2-1 has two special formats package Graphics::Toolkit::Color::Space::Instance::RGB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space; sub hex_from_tuple { uc sprintf("#%02x%02x%02x", @{$_[1]} ) } # translate [ r, g, b ] --> #000000 sub tuple_from_hex { # translate #000000 or #000 --> [ r, g, b ] my ($self, $hex) = @_; return "hex color definition '$hex' has to start with # followed by 3 or 6 hex characters (0-9,a-f)" unless defined $hex and not ref $hex and (length($hex) == 4 or length($hex) == 7) and substr($hex, 0, 1) eq '#' and $hex =~ /^#[\da-f]+$/i; # ($_[0] =~ /^#[[:xdigit:]]{3}$/ or $_[0] =~ /^#[[:xdigit:]]{6}$/) $hex = substr $hex, 1; [(length $hex == 3) ? (map { hex($_.$_) } unpack( "a1 a1 a1", $hex)) : (map { hex($_ ) } unpack( "a2 a2 a2", $hex))]; } Graphics::Toolkit::Color::Space->new ( axis => [qw/red green blue/], range => 255, precision => 0, format => { 'hex_string' => [\&hex_from_tuple, \&tuple_from_hex], 'array' => [ sub { $_[1] }, sub { $_[1] } ] }, ); YIQ.pm100644001750001750 247715055140237 27151 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # YIQ color space specific code package Graphics::Toolkit::Color::Space::Instance::YIQ; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/mult_matrix_vector_3/; my ($i_max, $q_max) = (0.5959, 0.5227); my ($i_range_size, $q_range_size) = (2 * $i_max, 2 * $q_max); # cyan-orange balance, magenta-green balance sub from_rgb { my ($rgb) = shift; my ($y, $i, $q) = mult_matrix_vector_3([[0.299, 0.587, 0.114 ], [0.5959, -0.2746, -0.3213], [0.2115, -0.5227, 0.3112]], @$rgb); $i = ($i + $i_max) / $i_range_size; $q = ($q + $q_max) / $q_range_size; return [$y, $i, $q]; } sub to_rgb { my ($yiq) = shift; $yiq->[1] = $yiq->[1] * $i_range_size - $i_max; $yiq->[2] = $yiq->[2] * $q_range_size - $q_max; return [ mult_matrix_vector_3([[1, 0.95605, 0.620755], [1, -0.272052, -0.647206], [1, -1.1067, 1.70442 ]], @$yiq) ]; } 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]], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); YUV.pm100644001750001750 213115055140237 27155 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # YUV color space specific code as in BT.601 package Graphics::Toolkit::Color::Space::Instance::YUV; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/mult_matrix_vector_3/; sub from_rgb { my ($rgb) = shift; my (@yuv) = mult_matrix_vector_3([[ 0.299 , 0.587, 0.114 ], [-0.168736, -0.331264, 0.5 ], [ 0.5 , -0.418688, -0.081312 ]], @$rgb); $yuv[1] += 0.5; $yuv[2] += 0.5; return \@yuv; } sub to_rgb { my ($yuv) = shift; $yuv->[1] -= 0.5; $yuv->[2] -= 0.5; my (@rgb) = mult_matrix_vector_3([[ 1, 0 , 1.402 ], [ 1, -0.344136, -0.714136], [ 1, 1.772 , 0 ]], @$yuv); return \@rgb; } Graphics::Toolkit::Color::Space->new( alias => 'YPbPr', axis => [qw/luma Pb Pr/], # luma, cyan-orange balance, magenta-green balance short => [qw/Y U V/], range => [1, [-.5, .5], [-.5, .5],], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); CMYK.pm100644001750001750 130315055140237 27235 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CMYK color space specific code package Graphics::Toolkit::Color::Space::Instance::CMYK; use v5.12; use warnings; use Graphics::Toolkit::Color::Space 'max'; sub from_rgb { my ($r, $g, $b) = @{$_[0]}; 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) = @{$_[0]}; return ( [(1-$c) * (1-$k) , (1-$m) * (1-$k) , (1-$y) * (1-$k) ] ); } Graphics::Toolkit::Color::Space->new ( axis => [qw/cyan magenta yellow key/], convert => {RGB => [\&to_rgb, \&from_rgb]}, ); NCol.pm100644001750001750 445515055140237 27340 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # NCol color space (HWB with human readable hue values) / Karl Ewald Konstantin Hering (1834 - 1918) package Graphics::Toolkit::Color::Space::Instance::NCol; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/min max/; my @color_char = qw/R Y G C B M/; my %char_value = (map { $color_char[$_] => $_ } 0 .. $#color_char); sub read_values { my $val = shift; my $hue = $char_value{ uc substr($val->[0], 0, 1) } * 100 + substr($val->[0], 1); return [$hue, $val->[1], $val->[2]]; } sub write_values { my $val = shift; my $hue = ($val->[0] < 600) ? $val->[0] : 0; my $digit = int($hue / 100); my $hue_str = $color_char[ $digit ] . sprintf( "%u", ($hue - ($digit * 100))); return [$hue_str, $val->[1], $val->[2]]; } sub from_rgb { my ($r, $g, $b) = @{$_[0]}; my $vmax = max($r, $g, $b); my $white = my $vmin = min($r, $g, $b); return ([0,1,0]) if $white == 1; my $black = 1 - ($vmax); return ([0,0,1]) if $black == 1; 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) = @{$_[0]}; 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); return \@rgb; } Graphics::Toolkit::Color::Space->new( name => 'NCol', axis => [qw/hue whiteness blackness/], type => [qw/angular linear linear/], range => [600, 100, 100], precision => 0, value_form => ['[RYGCBMrygcbm]\d{1,3}','\d{1,3}','\d{1,3}'], suffix => ['', '%', '%'], convert => {RGB => [\&to_rgb, \&from_rgb]}, values => {read => \&read_values, write => \&write_values, } ); OKLAB.pm100644001750001750 362015055140237 27326 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # OK lab color space for Illuminant D65 and Observer 2 degree by Björn Ottosson 2020 package Graphics::Toolkit::Color::Space::Instance::OKLAB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/mult_matrix_vector_3/; my @D65 = (0.95047, 1, 1.08883); # illuminant sub from_xyz { my ($xyz) = shift; my @xyz = map {$xyz->[$_] * $D65[$_]} 0 .. 2; my @lms = mult_matrix_vector_3([[ 0.8189330101, 0.3618667424,-0.1288597137], [ 0.0329845436, 0.9293118715, 0.0361456387], [ 0.0482003018, 0.2643662691, 0.6338517070]], @xyz); @lms = map {$_ ** (1/3)} @lms; my @lab = mult_matrix_vector_3([[ 0.2104542553, 0.7936177850, -0.0040720468], [ 1.9779984951, -2.4285922050, 0.4505937099], [ 0.0259040371, 0.7827717662, -0.8086757660]], @lms); $lab[1] += .5; $lab[2] += .5; return \@lab; } sub to_xyz { my (@lab) = @{$_[0]}; $lab[1] -= .5; $lab[2] -= .5; my @lms = mult_matrix_vector_3([[ 1, 0.396338 , 0.215804 ], [ 1, -0.105561 , -0.0638542 ], [ 1, -0.0894842, -1.29149 ]], @lab); @lms = map {$_ ** 3} @lms; my @xyz = mult_matrix_vector_3([[ 1.22701 , -0.5578 , 0.281256 ], [-0.0405802, 1.11226 ,-0.0716767], [-0.0763813, -0.421482, 1.58616 ]], @lms); return [map {$xyz[$_] / $D65[$_]} 0 .. 2]; } Graphics::Toolkit::Color::Space->new( name => 'OKLAB', # no alias, short axis name eq long axis => [qw/L a b/], # lightness, cyan-orange balance, magenta-green balance range => [1, [-.5, .5], [-.5, .5]], precision => 3, convert => {XYZ => [\&to_xyz, \&from_xyz]}, #, {to => {in => 1, out => 1}, from => {in => 1, out => 1} } ); OKLCH.pm100644001750001750 173315055140237 27341 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # OK LCH cylindrical color space variant of OKLAB package Graphics::Toolkit::Color::Space::Instance::OKLCH; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/round_decimals/; my $TAU = 6.283185307; sub from_lab { my ($lab) = shift; my $a = $lab->[1] - .5; my $b = $lab->[2] - .5; $a = 0 if round_decimals($a, 5) == 0; $b = 0 if round_decimals($b, 5) == 0; my $c = sqrt( ($a**2) + ($b**2)); my $h = atan2($b, $a); $h += $TAU if $h < 0; return ([$lab->[0], $c * 2, $h / $TAU]); } sub to_lab { my ($lch) = shift; my $c = $lch->[1] / 2; my $a = $c * cos($lch->[2] * $TAU); my $b = $c * sin($lch->[2] * $TAU); return ([$lch->[0], $a + .5, $b + .5 ]); } Graphics::Toolkit::Color::Space->new( name => 'OKLCH', axis => [qw/luminance chroma hue/], type => [qw/linear linear angular/], range => [1, .5, 360], precision => [5,5,2], convert => { OKLAB => [\&to_lab, \&from_lab] }, ); CIELAB.pm100644001750001750 223015055140237 27411 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CIE LAB color space specific code based on XYZ for Illuminant D65 and Observer 2 degree package Graphics::Toolkit::Color::Space::Instance::CIELAB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space; my @D65 = (0.95047, 1, 1.08883); # illuminant my $eta = 0.008856 ; my $kappa = 903.3; sub from_xyz { my ($xyz) = shift; my @xyz = map {($_ > $eta) ? ($_ ** (1/3)) : ((($kappa * $_) + 16) / 116)} @$xyz; my $l = (1.16 * $xyz[1]) - 0.16; my $a = ($xyz[0] - $xyz[1] + 1) / 2; my $b = ($xyz[1] - $xyz[2] + 1) / 2; return ([$l, $a, $b]); } sub to_xyz { my ($lab) = shift; my $fy = ($lab->[0] + 0.16) / 1.16; my $fx = $fy - 1 + ($lab->[1] * 2); my $fz = $fy + 1 - ($lab->[2] * 2); my @xyz = map {my $f3 = $_** 3; ($f3 > $eta) ? $f3 : (( 116 * $_ - 16 ) / $kappa) } $fx, $fy, $fz; return \@xyz; } Graphics::Toolkit::Color::Space->new ( alias => 'CIELAB', # space name LAB axis => [qw/L* a* b*/], # short l a b - lightness, cyan-orange balance, magenta-green balance range => [100, [-500, 500], [-200, 200]], precision => 3, convert => {XYZ => [\&to_xyz, \&from_xyz]}, ); CIELUV.pm100644001750001750 375115055140237 27472 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CIE LUV color space specific code based on XYZ for Illuminant D65 and Observer 2 degree package Graphics::Toolkit::Color::Space::Instance::CIELUV; use v5.12; use warnings; use Graphics::Toolkit::Color::Space; my @D65 = (0.95047, 1, 1.08883); # illuminant my $eta = 0.008856 ; my $kappa = 903.3; sub from_xyz { my ($xyz) = shift; my @XYZ = map { $xyz->[$_] * $D65[$_] } 0 .. 2; my $color_mix = $XYZ[0] + (15 * $XYZ[1]) + (3 * $XYZ[2]); my $u_color = $color_mix ? (4 * $XYZ[0] / $color_mix) : 0; my $v_color = $color_mix ? (9 * $XYZ[1] / $color_mix) : 0; my $white_mix = $D65[0] + (15 * $D65[1]) + (3 * $D65[2]); # 19.21696 my $u_white = 0.197839825; # 4 * $D65[0] / $white_mix; # my $v_white = 0.468336303; # 9 * $D65[1] / $white_mix; # my $l = ($XYZ[1] > $eta) ? (($XYZ[1] ** (1/3)) * 116 - 16) : ($kappa * $XYZ[1]); my $u = 13 * $l * ($u_color - $u_white); my $v = 13 * $l * ($v_color - $v_white); return ([ $l / 100 , ($u+134) / 354, ($v+140) / 262 ]); } sub to_xyz { my ($luv) = shift; my $l = $luv->[0] * 100; my $u = $luv->[1] * 354 - 134; my $v = $luv->[2] * 262 - 140; my $white_mix = $D65[0] + (15 * $D65[1]) + (3 * $D65[2]); # 19.21696 my $u_white = 0.197839825; # 4 * $D65[0] / $white_mix; # my $v_white = 0.468336303; # 9 * $D65[1] / $white_mix; # my $u_color = $l ? (($u / 13 / $l) + $u_white) : 0; my $v_color = $l ? (($v / 13 / $l) + $v_white) : 0; my $y = ($l > $kappa * $eta) ? ((($l+16) / 116) ** 3) : ($l / $kappa); my $color_mix = $v_color ? (9 * $y / $v_color) : 0; my $x = $u_color * $color_mix / 4; my $z = ($color_mix - $x - (15 * $y)) / 3; my $XYZ = [$x, $y, $z]; return [ map { $XYZ->[$_] / $D65[$_] } 0 .. 2 ]; } Graphics::Toolkit::Color::Space->new( alias => 'CIELUV', # space name is LUV axis => [qw/L* u* v*/], # short l u v range => [100, [-134, 220], [-140, 122]], precision => 3, convert => {XYZ => [\&to_xyz, \&from_xyz]}, ); CIEXYZ.pm100644001750001750 256615055140237 27521 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CIEXYZ color space specific code for Illuminant D65 and Observer 2° package Graphics::Toolkit::Color::Space::Instance::CIEXYZ; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/mult_matrix_vector_3/; my @D65 = (0.95047, 1, 1.088830); # change normalized RGB values to and from standard observer 2° sub apply_observer { $_[0] > 0.04045 ? ((($_[0] + 0.055) / 1.055 ) ** 2.4) : ($_[0] / 12.92) } sub remove_observer { $_[0] > 0.003131 ? ((($_[0]**(1/2.4)) * 1.055) - 0.055) : ($_[0] * 12.92) } sub from_rgb { my ($rgb) = shift; my @rgb = map {apply_observer( $_ )} @$rgb; return [ mult_matrix_vector_3([[0.433949941, 0.37620977, 0.18984029], # conversion + normalisation [0.2126729, 0.7151522, 0.0721750], [0.017756583, 0.109467961, 0.872775456]], @rgb) ]; } sub to_rgb { my ($xyz) = shift; my @rgb = mult_matrix_vector_3([[ 3.07996, -1.53714 , -0.542816 ], [ -0.921259 , 1.87601 , 0.0452475], [ 0.0528874, -0.204026, 1.15114 ]], @$xyz); return [ map { remove_observer($_) } @rgb ]; } Graphics::Toolkit::Color::Space->new( alias => 'CIEXYZ', axis => [qw/X Y Z/], range => [map {$D65[$_] * 100} 0 .. 2], precision => 3, convert => {RGB => [\&to_rgb, \&from_rgb]}, ); CIELCHab.pm100644001750001750 204015055140237 27723 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CIE LCh(ab) cylindrical color space variant of CIELAB package Graphics::Toolkit::Color::Space::Instance::CIELCHab; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/round_decimals/; my $TAU = 6.283185307; sub from_lab { my ($lab) = shift; my $a = $lab->[1] * 1000 - 500; my $b = $lab->[2] * 400 - 200; $a = 0 if round_decimals($a, 5) == 0; $b = 0 if round_decimals($b, 5) == 0; my $c = sqrt( ($a**2) + ($b**2)); my $h = atan2($b, $a); $h += $TAU if $h < 0; return ([$lab->[0], $c / 539, $h / $TAU]); } sub to_lab { my ($lch) = shift; my $a = $lch->[1] * cos($lch->[2] * $TAU) * 539; my $b = $lch->[1] * sin($lch->[2] * $TAU) * 539; return ([$lch->[0], ($a+500) / 1000, ($b+200) / 400 ]); } Graphics::Toolkit::Color::Space->new( name => 'LCH', alias => 'CIELCHab', axis => [qw/luminance chroma hue/], type => [qw/linear linear angular/], range => [100, 539, 360], precision => 3, convert => { LAB => [\&to_lab, \&from_lab] }, ); CIELCHuv.pm100644001750001750 202115055140237 27772 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # CIE LCh(uv) cylindrical color space variant of CIELUV package Graphics::Toolkit::Color::Space::Instance::CIELCHuv; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/round_decimals/; my $TAU = 6.283185307; sub from_luv { my ($luv) = shift; my $u = $luv->[1] * 354 - 134; my $v = $luv->[2] * 262 - 140; $u = 0 if round_decimals($u, 5) == 0; $v = 0 if round_decimals($v, 5) == 0; my $c = sqrt( ($u**2) + ($v**2)); my $h = atan2($v, $u); $h += $TAU if $h < 0; return ([$luv->[0], $c / 261, $h / $TAU ]); } sub to_luv { my ($lch) = shift; my $u = $lch->[1] * cos($lch->[2] * $TAU) * 261; my $v = $lch->[1] * sin($lch->[2] * $TAU) * 261; return ([$lch->[0], ($u+134) / 354, ($v+140) / 262 ]); } Graphics::Toolkit::Color::Space->new( name => 'CIELCHuv', alias => 'LCHuv', axis => [qw/luminance chroma hue/], type => [qw/linear linear angular/], range => [100, 261, 360], precision => 3, convert => {LUV => [\&to_luv, \&from_luv]}, ); HunterLAB.pm100644001750001750 225515055140237 30265 0ustar00herbertherbert000000000000Graphics-Toolkit-Color-1.972/lib/Graphics/Toolkit/Color/Space/Instance # Hunter lab color space, pre CIELAB, for Illuminant D65 and Observer 2 degree package Graphics::Toolkit::Color::Space::Instance::HunterLAB; use v5.12; use warnings; use Graphics::Toolkit::Color::Space qw/round_decimals/; my @D65 = (0.95047, 1, 1.08883); # illuminant my %K = ( a => round_decimals(175.0 / 198.04 * ($D65[1] + $D65[0]) * 100, 5), b => round_decimals( 70.0 / 218.11 * ($D65[1] + $D65[2]) * 100, 5), ); sub from_xyz { my ($xyz) = shift; my $l = sqrt $xyz->[1]; my $a = $l ? (($xyz->[0] - $xyz->[1])/$l) : 0; my $b = $l ? (($xyz->[1] - $xyz->[2])/$l) : 0; $a = ($a / 2) + .5; $b = ($b / 2) + .5; return ([$l, $a, $b]); } sub to_xyz { my ($lab) = shift; my $l = $lab->[0]; my $a = ($lab->[1] - .5) * 2; my $b = ($lab->[2] - .5) * 2; my $y = $l ** 2; my $x = ($a * $l) + $y; my $z = $y - ($b * $l); return ([$x, $y, $z]); } Graphics::Toolkit::Color::Space->new( name => 'HunterLAB', axis => [qw/l a b/], # same as short range => [100, [-$K{'a'}, $K{'a'}], [-$K{'b'}, $K{'b'}]], # cyan-orange, magenta-green precision => 3, convert => {XYZ => [\&to_xyz, \&from_xyz]}, );