File Coverage

blib/lib/PDL/Transform/Color.pm
Criterion Covered Total %
statement 299 473 63.2
branch 75 198 37.8
condition 16 88 18.1
subroutine 43 53 81.1
pod 18 20 90.0
total 451 832 54.2


line stmt bran cond sub pod time code
1             =encoding utf8
2              
3             =head1 NAME
4              
5             PDL::Transform::Color - Useful color system conversions for PDL
6              
7             =head1 SYNOPSIS
8              
9             ### Shrink an RGB image with proper linear interpolation:
10             ### DEcode the sRGB image values, then interpolate, then ENcode sRGB
11             $im = rpic("big_colorimage.jpg");
12             $im2 = $im->invert(t_srgb())->match([500,500],{m=>'g'})->apply(t_srgb());
13              
14             =head1 DESCRIPTION
15              
16             PDL::Transform::Color includes a variety of useful color conversion
17             transformations. It can be used for simple hacks on machine-native
18             color representations (RGB <-> HSV, etc.), for simple
19             encoding/decoding of machine-native color representations such as
20             sRGB, or for more sophisticated manipulation of absolute color
21             standards including large-gamut or perceptual systems.
22              
23             The color transforms in this module can be used for converting between
24             proper color systems, for gamma-converting pixel values, or for
25             generating pseudocolor from one or two input parameters. In addition
26             to transforming color data between different representations, Several
27             named "color maps" (also called "color tables") are provided.
28              
29             The module uses linearized sRGB (lsRGB) as a fundamental color basis.
30             sRGB is the standard color system used by most consumer- to mid-grade
31             computer equipment, so casual users can use this color representation
32             without much regard for gamuts, colorimetric standards, etc.
33              
34             Most of the transform generators convert from lsRGB to various
35             other systems. Notable simple ones are HSV (Hue, Saturation, Value),
36             HSL (Hue, Saturation, Lightness), and CMYK (Cyan, Magenta, Yellow,
37             blacK).
38              
39             If you aren't familiar with PDL::Transform, you should read that POD
40             now, as this is a subclass of PDL::Transform. Transforms represent
41             and encapsulate vector transformations -- one- or two-way vector
42             functions that may be applied, composed, or (if possible) inverted.
43             They are created through constructor methods that often allow
44             parametric adjustment at creation time.
45              
46             If you just want to "manipulate some RGB images" and not learn about
47             the esoterica of color representations, you can treat all the routines
48             as working "from RGB" on the interval [0,1], and use C to
49             import/export color images from/to "24-bit color" that your computer
50             probably expects. If you care about the esoterica, read on.
51              
52             The output transfer function for sRGB is nonlinear -- the luminance of
53             a pixel on-screen varies somewhat faster than the square of the input
54             value -- which is inconvenient for blending, merging, and manipulating
55             color. Many common operations work best with a linear photometric
56             representation. PDL::Transform::Color works with an internal model
57             that is a floating-point linear system representing pixels as
58             3-vectors whose components are proportional to photometric brightness
59             in the sRGB primary colors. This system is called "lsRGB" within the
60             module.
61              
62             Note that, in general, RGB representations are limited to a particular
63             narrow gamut of physically accessible values. While the human eye has
64             three dominant colorimetric input channels and hence color can be
65             represented as a 3-vector, the human eye does not cleanly separate the
66             spectra responsible for red, green, and blue stimuli. As a result, no
67             trio of physical primary colors (which must have positive-definite
68             spectra and positive-definite overall intensities) can represent every
69             perceivable color -- even though they form a basis of color space.
70              
71             But in digital representation, there is no hard limit on the values
72             of the RGB vectors -- they can be negative or arbitrarily large. This
73             permits representation of out-of-gamut values using negative or
74             over-unity intensities. So floating-point lsRGB allows you to
75             represent literally any color value that the human eye can perceive,
76             and many that it can't. This is useful even though many such colors
77             can't be rendered on a monitor. For example, you can change between
78             several color representations and not be limited by the formal gamut
79             of each representation -- only by the final export standard.
80              
81             Three major output formats are supported: sRGB (standard "24-bit
82             color" with the industry standard transfer function); bRGB (bytescaled
83             RGB with a controllable gamma function (default 2.2, matching the
84             average gamma value of most CRTs and calibrated flat monitors); or
85             CMYK (direct linear inversion of the RGB values, with byte
86             scaling). These are created by applying the transforms C,
87             C, and C, respectively, to an lsRGB color triplet.
88              
89             The C export routine will translate represented colors in
90             floating-point lsRGB to byte-encoded sRGB (or, if inverted, vice
91             versa), using the correct (slightly more complicated than gamma
92             functions) nonlinear scaling. In general, you can use C to
93             import existing images you may have found lying around the net;
94             manipulate their hue, etc.; and re-export with C.
95              
96             If you prefer to work with direct gamma functions or straight
97             scaling, you can import/export from/to byte values with C
98             instead. For example, to export a color in the CIE RGB system
99             (different primaries than sRGB), use C.
100              
101             There are also some pseudocolor transformations, which convert a
102             single data value to normalized RGB. These transformations are
103             C for photometric (typical scientific) values and C for
104             perceptual (typical consumer camera) values. They are described
105             below, along with a collection of named pseudocolor maps that are
106             supplied with the module.
107              
108             =head1 OVERVIEW OF COLOR THEORY
109              
110             Because of the biophysics of the human eye, color is well represented
111             as a 3-vector of red, green, and blue brightness values representing
112             brightness in the long, middle, and short portions of the visible
113             spectrum. However, the absorption/sensitivity bands overlap
114             significantly, therefore no physical light (of any wavelength) can
115             form a proper "primary color" (orthonormal basis element) of this
116             space. While any vector in color space can be represented as a linear
117             sum of three independent basis vectors ("primary colors"), there is no
118             such thing as a negative intensity and therefore any tricolor
119             representation of the color space is limited to a "gamut" that can be
120             formed by I linear combinations of the selected primary colors.
121              
122             Some professional color representations (e.g. 5- and 7-color dye
123             processes) expand this gamut to better match the overall spectral
124             response of the human eye, at the cost of over-determining color
125             values in what is fundamentally a 3-space.
126              
127             RGB color representations require the specification of particular
128             primary colors that represent particular spectral profiles. The
129             choice of primaries depends on the technical solution being used for
130             I/O. The most universal "standard" representation is the CIE RGB
131             standard developed in 1931 by the Commission Internationale de
132             l'Eclairage (CIE; International Commission on Illumination). The 1931
133             CIE RGB system is also called simply CIERGB by many sources. It uses
134             primary wavelengths of 700nm (red), 546.1 nm (green), and 435.8 nm
135             (blue).
136              
137             The most universal "computer" representation is the sRGB standard
138             defined by Anderson et al. (1996), which uses on slightly different
139             primary colors than does the 1931 CIE RGB standard. This is because
140             sRGB is based on the colorimetric output of color television phosphors
141             in CRTs, while CIE RGB was developed based on easily lab-reproducible
142             spectra.
143              
144             The C transformations are all relative to the
145             sRGB color basis. Negative values are permitted, allowing
146             representation of all colors -- possible or impossible.
147              
148             CIE defined several other important color systems: first, an XYZ
149             system based on nonphysical primaries X, Y, and Z that correspond to
150             red, green, and blue, respectively. The XYZ system can represent all
151             colors detectable to the human eye with positive-definite intensities
152             of the "primaries": the necessary negative intensities are hidden in
153             the formal spectrum of each of the primaries. The Y primary of this
154             system corresponds closely to green, and is used by CIE as a proxy for
155             overall luminance.
156              
157             The CIE also separated "chrominance" and "luminance" signals, in a
158             separate system called "xyY", which represents color as sum-normalized
159             vectors "x=X/(X+Y+Z), "y=Y/(X+Y+Z)", and "z=Z/(X+Y+Z)". By construction,
160             x+y+z=1, so "x" and "y" alone describe the color range of the system, and
161             "Y" stands in for overall luminance.
162              
163             A linear RGB system is specified exactly by the chrominance (CIE XYZ
164             or xyY) coordinates of the three primaries, and a white point
165             chrominance. The white point chrominance sets the relative scaling
166             between the brightnesses of the primaries to achieve a color-free
167             ("white") luminance. Different systems with the same R, G, B primary
168             vectors can have different gains between those colors, yielding a
169             slightly different shade of color at the R=G=B line. This "white"
170             reference chrominance varies across systems, with the most common
171             "white" standard being CIE's D65 spectrum based on a 6500K black body
172             -- but CIE, in particular, specifies a large number of white
173             standards, and some systems use none of those but instead specify CIE
174             XYZ values for the white point.
175              
176             Similarly, real RGB systems typically use dynamic range compression
177             via a nonlinear transfer function which is most typically a "gamma
178             function". A built-in database tracks about 15 standard named
179             systems, so you can convert color values between them. Or you can
180             specify your own system with a standard hash format (see C).
181              
182             Provision exists for converting between different RGB systems with
183             different primaries and different white points, by linearizing and
184             then scaling. The most straightforward way to use this module to
185             convert between two RGB systems (neither of which is lsRGB) is to
186             inverse-transform one to lsRGB, then transform forward to the other.
187             This is accomplished with the C transform.
188              
189             Many other representations than RGB exist to separate chromatic
190             value from brightness. In general, these can be divided into polar
191             coordinates that represent hue as a single value divorced from the rgb
192             basis, and those that represent it as a combination of two values like
193             the 'x' and 'y' of the CIE xyY space. These are all based on the
194             Munsell and Ostwald color systems, which were worked out at about the
195             same time as the CIE system. Both Ostwald and Munsell worked around
196             the start of the 20th century pioneered colorimetric classification.
197              
198             Ostwald worked with quasi-linear representations of chromaticity as a
199             2-vector independent of brightness; these representations relate to
200             CIERGB, CIEXYZ, and related systems via simple geometric projection;
201             the CIE xyY space is an example. The most commonly used variant of
202             xyY is CIELAB, a perceptual color space that separates color into a
203             perceived lightness parameter L, and separate chromaticities 'a' and
204             'b'. CIELAB is commonly used by graphic artists and related
205             professions, because it is an absolute space like XYZ (so that each
206             LAB value corresponds to a particular perceivable color), and because
207             the Cartesian norm between vectors in LAB space is approximately
208             proportional to perceived difference between the corresponding colors.
209             The system is thus useful for communicating color values precisely
210             across different groups or for developing perceptually-uniform display
211             maps for generated data. The L, A, and B coordinates are highly
212             nonlinear to approximately match the typical human visual system.
213              
214             Other related systems include YUV, YPbPr, and YCbCr -- which are used
215             for representing color for digital cinema and for video transmission.
216              
217             Munsell developed a color system based on separating the "hue" of a
218             color into a single value separate from both its brightness and
219             saturation level. This system is closely related to cylindrical polar
220             coordinates in an RGB space, with the center of the cylinder on top of
221             the line of values corresponding to neutral shades from "black"
222             through "grey" to "white".
223              
224             Two simple Munsell-like representations that work within the gamut of
225             a particular RGB basis are HSL and HSV. Both of these systems are
226             loose representations that are best defined relative to a particular
227             RGB system. They are both designed specifically to represent an entire
228             RGB gamut with a quasi-polar coordinate system, and are based on
229             hexagonal angle -- i.e. they are not exactly polar in nature.
230              
231             HSL separates "Hue" and "Saturation" from "Lightness". Hue represents
232             the spectral shade of the color as a direction from the central white
233             reference line through RGB space: the R=G=B line. Saturation is a
234             normalized chromaticity measuring fraction of the distance from the
235             white locus to the nearest edge of the RGB gamut at a particular hue
236             and lightness. Lightness is an approximately hue- independent measure
237             of total intensity. Deeply objectively "saturated" colors are only
238             accessible at L=0.5; the L=0.5 surface includes all the additive and
239             subtractive primary colors of the RGB system. Darker colors are
240             less-saturated shades, while brighter colors fade to pastels.
241              
242             HSV is similar to HSL, but tracks only the brightest component among
243             the RGB triplet as "Value" rather than the derived "Lightness". As a
244             result, highly saturated HSV values have lower overall luminance than
245             unsaturated HSV values with the same V, and the V=1 surface includes
246             all the primary and secondary colors of the parent RGB system. This system takes
247             advantage of the of the "Helmholtz-Kolhrausch effect" that
248             I brightness increases with saturation, so V better
249             approximates perceived brightness at a given hue and saturation, than
250             does L.
251              
252             Modern display devices generally produce physical brightnesses that
253             are proportional not to their input signal, but to a nonlinear
254             function of the input signal. The most common nonlinear function is a
255             simple power law ("gamma function"): output is approximately
256             proportional to the "gamma" power of the input. Raising a signal
257             value to the power "1/gamma" is C it, and raising it
258             to the power "gamma" is C it.
259              
260             The sRGB 24-bit color standard specifies a slightly more complicated
261             transfer curve, that consists of a linear segment spliced onto a
262             horizontally-offset power law with gamma=2.4. This reduces
263             quantization noise for very dark pxels, but approximates an overall
264             power law with gamma=2.2. Hence, C (which supports general
265             power law transfer functions) defaults to an output gamma of 2.2, but
266             C yields a more accurate export transfer in typical use. The
267             gamma value of 2.2 was selected in the early days of the television
268             era, to approximately match the perceptual response of the human eye,
269             and for nearly 50 years cathode-ray-tube (CRT) displays were
270             specifically designed for a transfer gamma of 2.2 between applied
271             voltage at the electron gun input stage and luminance (luminous energy
272             flux) at the display screen.
273              
274             Incidentally, some now-obsolete display systems (early MacOS systems
275             and Silcon Graphics displays) operated with a gamma factor of 1.8,
276             slightly less nonlinear than the standard. This derives from early
277             use of checkerboard (and similar) pixelwise dithering to achieve a
278             higher-bit-depth color palette than was otherwise possible, with early
279             equipment. The display gamma of 2.2 interacted with direct dithering
280             of digital values in the nonlinear space, to produce an effective gamma
281             closer to 1.8 than 2.2.
282              
283              
284             =head1 STANDARD OPTIONS
285              
286             =over 3
287              
288             =item gamma
289              
290             This is a gamma correction exponent used to get physical luminance
291             values from the represented RGB values in the source RGB space. Most
292             color manipulation is performed in linear (gamma=1) representation --
293             i.e. if you specify a gamma to a conversion transform, the normalized
294             RGB values are B to linear physical values before processing
295             in the forward direction, or B after processing in the
296             reverse direction.
297              
298             For example, to square the normalized floating-point lsRGB values
299             before conversion to bRGB, use C2)>. The "gamma"
300             option specifies that the desired brightness of the output device
301             varies as the square of the pixel value in the stored data.
302              
303             Since lsRGB is the default working space for most transforms, you
304             don't normally need to specify C -- the default value of 1.0
305             is correct.
306              
307             Contrariwise, the C export transform has a C option
308             that specifies the gamma function for the output bytes. Therefore,
309             C<< t_brgb(display_gamma=>2) >> square-roots the data before export (so that
310             squaring them would yield numbers proportional to the desired luminance
311             of a display device).
312              
313             The C option is kept for completeness, but unless you know it's
314             what you really want, you probably don't actually want it: instead,
315             you should consider working in a linear space and decoding/encoding
316             the gamma of your import/export color space only as you read in or write
317             out values. For example, generic images found on the internet are
318             typically in the sRGB system, and can be imported to lsRGB via the
319             C transform or exported with C -- or other
320             gamma-corrected 24-bit color systems can be handled directly with
321             C and its C option.
322              
323             =back
324              
325             =head1 FUNCTIONS
326              
327             =cut
328              
329             package PDL::Transform::Color;
330              
331 1     1   239051 use strict;
  1         2  
  1         29  
332 1     1   4 use warnings;
  1         1  
  1         59  
333 1     1   5 use base 'Exporter';
  1         2  
  1         172  
334 1     1   8 use PDL::LiteF;
  1         2  
  1         10  
335 1     1   1439 use PDL::Transform;
  1         1  
  1         4  
336 1     1   123 use PDL::Math;
  1         2  
  1         6  
337 1     1   198 use PDL::Options;
  1         1  
  1         52  
338 1     1   643 use PDL::Graphics::ColorSpace;
  1         73913  
  1         15  
339 1     1   317 use Carp;
  1         3  
  1         13579  
340              
341             our @ISA = ( 'Exporter', 'PDL::Transform' );
342             our $VERSION = '1.010';
343             $VERSION =~ tr/_//d;
344              
345             our @EXPORT_OK = qw/ t_gamma t_brgb t_srgb t_shift_illuminant t_shift_rgb t_cmyk t_rgi t_cieXYZ t_xyz t_xyY t_xyy t_lab t_xyz2lab t_hsl t_hsv t_pc t_pcp/;
346             our @EXPORT = @EXPORT_OK;
347             our %EXPORT_TAGS = (Func=>\@EXPORT_OK);
348              
349             our $PI = 3.141592653589793238462643383279502;
350              
351             our $srgb2cxyz_inv = $PDL::Graphics::ColorSpace::RGBSpace::RGB_SPACE->{sRGB}{mstar}->transpose;
352             our $srgb2cxyz_mat = $PDL::Graphics::ColorSpace::RGBSpace::RGB_SPACE->{sRGB}{m}->transpose;
353              
354 29     29   102 sub _new { __PACKAGE__->new(@_) }
355              
356             sub new {
357 29     29 0 98 my $me = shift->SUPER::new;
358 29         283 my $parse = pop;
359 29         124 $me->{name} = pop;
360 29         79 @$me{qw(u_opt idim odim)} = ({@_}, 3, 3);
361 29         84 $me->{params} = {parse($parse, $me->{u_opt})};
362 29         6822 return $me;
363             }
364              
365             ## Compose with gamma correction if necessary
366             sub gammify {
367 17     17 0 38 my $me = shift;
368 17 100 50     171 return $me if ($me->{params}{gamma} // 1) == 1;
369             # Decode gamma from source
370 1         4 return ( $me x t_gamma($me->{params}{gamma}) );
371             }
372              
373             ##############################
374              
375             =head2 t_gamma
376              
377             =for usage
378              
379             $t = t_gamma($gamma);
380              
381             =for ref
382              
383             This is an internal generator that is used to implement the standard
384             C parameter for all color transforms. It is exported as well
385             because many casual users just want to apply a gamma curve to existing
386             data rather than doing anything more rigorous.
387              
388             In the forward direction, C applies/decodes the gamma correction
389             indicated -- e.g. if the C<$gamma> parameter at generation time is 2,
390             then the forward direction squares its input, and the inverse direction
391             takes the square root (encodes the gamma correction).
392              
393             Gamma correction is implemented using a sign-tolerant approach:
394             all values have their magnitude scaled with the power law, regardless
395             of the sign of the value.
396              
397             =cut
398              
399             sub t_gamma {
400 2     2 1 283592 my $gamma = shift;
401 2         7 my ($me) = _new("gamma",{});
402              
403 2         7 $me->{params} = {gamma=>$gamma};
404 2         13 $me->{name} .= sprintf("=%g",$gamma);
405 2         4 $me->{idim} = 3;
406 2         2 $me->{odim} = 3;
407              
408             $me->{func} = sub {
409 3     3   677 my ($in, $opt) = @_;
410 3         11 my $out = $in->new_or_inplace;
411 3 50       83 if($opt->{gamma} != 1) {
412 3         9 $out *= ($in->abs + ($in==0)) ** ($opt->{gamma}-1);
413             }
414 3         383 $out;
415 2         9 };
416              
417             $me->{inv} = sub {
418 2     2   1379 my ($in, $opt) = @_;
419 2         7 my $out = $in->new_or_inplace;
420 2 50       47 if($opt->{gamma} != 1) {
421 2         7 $out *= ($in->abs + ($in==0)) ** (1.0/$opt->{gamma} - 1);
422             }
423 2         166 $out;
424 2         7 };
425              
426 2         7 $me;
427             }
428              
429             ##############################
430              
431             =head2 t_brgb
432              
433             =for usage
434              
435             $t = t_brgb();
436              
437             =for ref
438              
439             Convert lsRGB (normalized to [0,1]) to byte-scaled RGB ( [0,255] ).
440             By default, C prepares byte values tuned for a display gamma
441             of 2.2, which approximates sRGB (the standard output color coding for
442             most computer displays). The difference between C and
443             C in this usage is that C uses the actual
444             spliced-curve approximation specified in the sRGB standard, while
445             C uses a simple gamma law for export.
446              
447             C accepts the following options, all of which may be abbreviated:
448              
449             =over 3
450              
451             =item gamma (default 1)
452              
453             If set, this is a gamma-encoding value for the original lsRGB, which
454             is decoded before the transform.
455              
456             =item display_gamma (default 2.2)
457              
458             If set, this is the gamma of the display for which the output is
459             intended. The default compresses the brightness vector before output
460             (taking approximately the square root). This matches the "standard
461             gamma" applied by MacOS and Microsoft Windows displays, and approximates
462             the sRGB standard. See also C.
463              
464             =item clip (default 1)
465              
466             If set, the output is clipped to [0,256) in the forward direction and
467             to [0,1] in the reverse direction.
468              
469             =item byte (default 1)
470              
471             If set, the output is converted to byte type in the forward direction.
472             This is a non-reversible operation, because precision is lost in the
473             conversion to bytes. (The reverse transform always creates a floating
474             point value, since lsRGB exists on the interval [0,1] and an integer
475             type would be useless.)
476              
477             =back
478              
479             =cut
480              
481             sub t_brgb {
482 4     4 1 1802 my($me) = _new(@_,'encode bytescaled RGB',
483             {clip=>1,
484             byte=>1,
485             gamma=>1.0,
486             display_gamma=>2.2,
487             }
488             );
489              
490             $me->{func} = sub {
491 4     4   80 my($in, $opt) = @_;
492 4         11 my $out = $in->new_or_inplace;
493             $out->inplace->clip(0,1)
494 4 50 66     111 if $opt->{display_gamma} != 1 or $opt->{byte} or $opt->{clip};
      33        
495 4 100       190 if($opt->{display_gamma} != 1) {
496 1         5 $out **= (1.0/$opt->{display_gamma});
497             }
498 4         31 $out *= 255.0;
499 4 50       154 return byte($out->rint) if $opt->{byte};
500 0         0 $out;
501 4         20 };
502              
503             $me->{inv} = sub {
504 2     2   926 my($in,$opt) = @_;
505 2         8 my $out = $in / 255.0;
506 2 50       52 $out **= $opt->{display_gamma} if $opt->{display_gamma} != 1;
507 2 50       13 $out->inplace->clip(0,1) if $opt->{clip};
508 2         51 $out;
509 4         10 };
510              
511 4         9 gammify($me);
512             }
513              
514             =head2 t_srgb
515              
516             =for ref
517              
518             Converts lsRGB (the internal floating-point base representation) to
519             sRGB - the typical RGB encoding used by most computing devices. Since
520             most computer terminals use sRGB, the representation's gamut is well
521             matched to most computer monitors.
522              
523             sRGB is a spliced standard, rather than having a direct gamma
524             correction. Hence there is no way to adjust the output gamma. If you
525             want to do that, use C instead.
526              
527             C accepts the following options, all of which may be abbreviated:
528              
529             =over 3
530              
531             =item gamma (default 1)
532              
533             If set, this is a gamma-encoding value for the original lsRGB, which
534             is decoded before the transform.
535              
536             =item byte (default 1)
537              
538             If set, this causes the output to be clipped to the range [0,255] and rounded
539             to a byte type PDL ("24-bit color"). (The reverse transform always creates
540             a floating point value, since lsRGB exists on the interval [0,1] and an integer
541             type would be useless.)
542              
543             =item clip (default 0)
544              
545             If set, this causes output to be clipped to the range [0,255] even if the
546             C option is not set.
547              
548             =back
549              
550             =cut
551              
552             sub t_srgb {
553 5     5 1 711 my($me) = _new(@_,'encode 24-bit sRGB',
554             {clip=>0,
555             byte=>1,
556             gamma=>1.0
557             }
558             );
559             $me->{func} = sub {
560 5     5   41 my($in,$opt) = @_;
561             # Convert from CIE RGB to sRGB primaries
562 5         17 my($rgb) = $in->new_or_inplace();
563 5         232 rgb_from_linear($rgb->inplace, -1);
564 5         17 $rgb->set_inplace(0); # needed as bug in PDL <2.082
565 5         7 my $out;
566 5         18 $rgb *= 255;
567 5 50       94 if($opt->{byte}) {
    0          
568 5         90 $out = byte( $rgb->rint->clip(0,255) );
569             } elsif($opt->{clip}) {
570 0         0 $out = $rgb->clip(0,255.49999);
571             } else {
572 0         0 $out = $rgb;
573             }
574 5         400 $out;
575 5         26 };
576              
577             $me->{inv} = sub {
578 4     4   1392 my($in,$opt) = @_;
579 4         11 my $rgb = $in / pdl(255.0);
580 4         488 rgb_to_linear($rgb->inplace, -1);
581 4         15 $rgb->set_inplace(0); # needed as bug in PDL <2.082
582 4         13 $rgb;
583 5         29 };
584              
585 5         11 return gammify($me);
586             }
587              
588              
589             ######################################################################
590             ######################################################################
591              
592             =head2 t_pc and t_pcp
593              
594             =for ref
595              
596             These two transforms implement a general purpose pseudocolor
597             transformation. You input a monochromatic value (zero active dims)
598             and get out an RGB value (one active dim, size 3). Because the most
599             common use case is to generate sRGB values, the default output is sRGB
600             -- you have to set a flag for lsRGB output, for example if you want to
601             produce output in some other system by composing t_pc with a color
602             transformation.
603              
604             C generates pseudocolor transforms ("color maps") with
605             a photometric interpretation of the input: the input data are
606             considered to be proportional to some kind of measured luminance
607             or similar physical parameter. This produces "correct" renderings
608             of scenes captured by scientific cameras and similar instrumentation.
609              
610             C generates pseudocolor transforms ("color maps") with a
611             perceptual interpretation of the input: the input data are considered
612             to be proportional to the *perceptual* variation desired across the
613             display. This produces "correct" renderings of many non-luminant
614             types of data, such as temperature, Doppler shift, frequency plots,
615             etc.
616              
617             Both C and C generate transforms based on a collection
618             of named transformations stored in an internal database (the global
619             hash ref C<$PDL::Transform::Color::pc_tab>). The transformations
620             come in two basic sorts: quasi-photometric transformations,
621             which use luminance as the dominant varying parameter; and non-
622             photometric transformations, which use hue or saturation as the
623             dominant varying parameter. Only the photometric transformations
624             get modified by C vs C -- for example, C
625             will yield the same transform as C.
626              
627             Some of the color transformations are "split" and intended for display of signed
628             data -- for example, the C transformation fades red-to-white-to-blue and
629             is intended for display of Doppler or similar signals.
630              
631             NOTE: C and C work BACKWARDS from most of the
632             transformations in this package: they convert FROM a data value TO sRGB
633             or lsRGB.
634              
635             There are options to adjust input gamma and the domain of the
636             transformation (e.g. if your input data are on [0,1000] instead of
637             [0,1]).
638              
639             If you feed in no arguments at all, either C or C will
640             list a collection of named pseudocolor transformations that work, on
641             the standard output.
642              
643             Options accepted are:
644              
645             =over 3
646              
647             =item gamma (default 1) - presumed encoding gamma of the input
648              
649             The input is *decoded* from this gamma value. 1 treats it as linear
650             in luminance.
651              
652             =item lsRGB (default 0) - produce lsRGB output instead of sRGB.
653              
654             (this may be abbreviated "l" for "linear")
655              
656             =item domain - domain of the input; synonym for irange.
657              
658             =item irange (default [0,1]) - input range of the data
659              
660             Input data are by default clipped to [0,1] before application of the
661             color map. Specifying an undefined value causes the color map to be
662             autoscaled to the input data, e.g. C[0,undef]> causes the color map
663             to be scaled from 0 to the maximum value of the input. For full
664             autoscaling, use C[]>.
665              
666             =item combination (default 0) - recombine r,g,b post facto
667              
668             This option allows you to perturb maps you like by mixing up r, g, and
669             b after all the other calculations are done. You feed in a number
670             from 0 to 5. If it's nonzero, you get a different combination of the
671             three primaries. You can mock this up more compactly by appending
672             C<-Cn> to the (possibly abbreviated) name of the table. (Replace
673             the 'n' with a number).
674              
675             For example, if you specify the color table C or C you'll
676             get the sepiatone color table. If you specify C you'll get
677             almost the exact same color table as C.
678              
679             =back
680              
681             You can abbreviate color table names with unique abbreviations.
682             Tables currently accepted, and their intended uses are:
683              
684             =over 3
685              
686             =item QUASI-PHOTOMETRIC PSEUDOCOLOR MAPS FOR NORMAL USE
687              
688             =over 3
689              
690             =item grey, gray, or mono (photometric)
691              
692             Simple monochrome.
693              
694             =item sepia, blepia, grepia, vepia, ryg - sepiatone and variants
695              
696             These use color scaling to enhance contrast in a simple luminance
697             transfer. C is a black-brown-white curve reminiscent of sepia
698             ink. The others are similar, but emphasize different primary colors.
699             The 'ryg' duplicates sepiatone, but with green highlights to increase
700             contrast in near-saturated parts of an image.
701              
702             =item heat
703              
704             This black-red-yellow-white is reminiscent of blackbody curves
705             (but does not match them rigorously).
706              
707             =item pm3d, voy
708              
709             "pm3d" is the default color table for Gnuplot. It's a colorblind-friendly,
710             highly saturated table with horrible aesthetics but good contrast throughout.
711             "voy" is violet-orange-yellow. It's a more aesthetically pleasing colorblind-
712             friendly map with a ton of contrast throughout the range.
713              
714             =item ocean
715              
716             deep green through blue to white
717              
718             =item spring, summer, autumn, winter
719              
720             These are reminiscent of the "seasonal" colors provided by MatLab. The
721             "spring" is horrendous but may be useful for certain aesthetic presentations.
722             Summer and Winter are similar to the sepia-like tables, but with different
723             color paths. Autumn is similar to heat, but less garish.
724              
725             =back
726              
727             =item SPLIT PSEUDOCOLOR MAPS FOR SIGNED QUANTITIES
728              
729             =over 3
730              
731             =item dop, dop1, dop2, dop3
732              
733             These are various presentations of signed information, originally
734             intended to display Doppler shift. They are all quasi-photometric
735             and split.
736              
737             =item vbg
738              
739             This is a violet-black-green signed fade useful for non-Doppler
740             signed quantities. Quasi-photometric and split.
741              
742             =back
743              
744             =item NON-PHOTOMETRIC PSEUDOCOLOR MAPS
745              
746             =over 3
747              
748              
749             =item rainbow
750              
751             Colors of the rainbow, red through "violet" (magenta)
752              
753             =item wheel
754              
755             The full "color wheel", including the controversial magenta-to-red segment
756              
757             =back
758              
759             =back
760              
761              
762             =cut
763              
764              
765             ## pc_tab defines transformation subs for R, G, B from the grayscale.
766             ## The initial few are translated direct from the C<$palettesTab> in
767             ## C; others follow. Input is on the domain
768             ## [0,1]. Output is clipped to [0,1] post facto.
769             ##
770             ## names should be lowercase.
771             ##
772             ## Meaning of fields:
773              
774             ## type Color system being used ('rgb' or 'hsv' at present)
775             ## subs List ref containing three subs that accept scaled input [0,1] and
776             ## return each color coordinate value (e.g. r, g, b)
777             ## doc Short one-line string describing the pseudocolor map
778             ## igamma Scaled input is *decoded* from this gamma (raised to this power) if present
779             ## ogamma Output is *encoded to this gamma (rooted by this power) if present
780             ## phot Flag: if set, this pseudocolor map is approximately photometric and can be
781             ## scaled differently by the direct and perceptual color table methods
782             ## split This is the "zero point" on [0-1] of the color map. Default is 0. Useful
783             ## for gamma scaling etc; primarily used by doppler and other signed tables.
784             ## (Note that it's the user's responsibility to make sure the irange places
785             ## the zero here, since the subs accept pre-scaled input on [0,1]
786              
787             our $pc_tab = {
788             gray => { type=>'rgb', subs=> [ sub{$_[0]}, sub{$_[0]}, sub{$_[0]} ],
789             doc=>"greyscale", phot=>1 },
790              
791             grey => { type=>'rgb', subs=> [ sub{$_[0]}, sub{$_[0]}, sub{$_[0]} ],
792             doc=>"greyscale", phot=>1 },
793              
794             blepia => { type=>'rgb', subs=> [ sub{$_[0]**2}, sub{$_[0]}, sub{sqrt($_[0])} ],
795             doc=>"a simple sepiatone, in blue" , phot=>1, igamma=>0.75 },
796              
797             dop => { type=>'rgb', subs=> [ sub{2-2*$_[0]}, sub{1-abs($_[0]-0.5)*2}, sub{2*$_[0]} ],
798             doc=>"red-white-blue fade", ogamma=>1.5, igamma=>0.6, phot=>1, split=>.5},
799              
800             dop1 => { type=>'rgb', subs=> [ sub{2-2*$_[0]}, sub{1-abs($_[0]-0.5)*2}, sub{2*$_[0]} ],
801             doc=>"dop synonym", ogamma=>1.5, igamma=>0.6, phot=>1, split=>.5},
802              
803             dop2 => { type=>'rgb', subs=> [ sub{(1-2*$_[0])}, sub{(($_[0]-0.5)->abs->clip(0,0.5))**2}, sub{(-1+2*$_[0])} ],
804             doc=>'red-black-blue fade (mostly saturated)', ogamma=>1.5, igamma=>0.5, phot=>1, split=>0.5 },
805              
806             dop3 => { type=>'rgb', subs=> [ sub{1-$_[0]*2}, sub{(0.1+abs($_[0]-0.5))**2}, sub{-1+$_[0]*2} ],
807             doc=>'orange-black-lightblue fade (lightly saturated)', ogamma=>1.5, igamma=>0.5, phot=>1, split=>0.5 },
808              
809             vbg => { type=>'rgb', subs=> [ sub{1 - (2*$_[0])}, sub{abs($_[0]-0.5)*1.5}, sub{1 - 2*$_[0]} ],
810             doc=>'violet-black-green signed fade', ogamma=>1.5, igamma=>0.5, phot=>1, split=>0.5 },
811              
812              
813              
814             grepia => { type=>'rgb', subs=> [ sub{$_[0]}, sub{sqrt($_[0])}, sub{$_[0]**2} ],
815             doc=>"a simple sepiatone, in green", igamma=>0.9, phot=>1 },
816              
817             heat => { type=>'rgb', subs=> [ sub{2*$_[0]}, sub{2*$_[0]-0.5}, sub{2*$_[0]-1} ],
818             doc=>"heat-map (AFM): black-red-yellow-white", phot=>1, igamma=>0.667 },
819              
820             pm3d => { type=>'rgb', subs=> [ sub{sqrt($_[0])}, sub{$_[0]**3}, sub{sin($_[0]*2*$PI)} ],
821             doc=>"duplicates the PM3d colortable in gnuplot (RG colorblind)", phot=>1},
822              
823             grv => { type=>'rgb', subs=> [ sub{sqrt($_[0]*0.5)}, sub{1-2*$_[0]}, sub{$_[0]**3.5} ],
824             doc=>"green-red-violet", igamma=>0.75, phot=>1 },
825              
826             mono => { type=>'rgb', subs=> [ sub{$_[0]}, sub{$_[0]}, sub{$_[0]} ],
827             doc=>"synonym for grey"},
828              
829             ocean => { type=>'rgb', subs=> [ sub{(3*$_[0]-2)->clip(0) ** 2}, sub{$_[0]}, sub{$_[0]**0.33*0.5+$_[0]*0.5} ],
830             doc=>"green-blue-white", phot=>1, igamma=>0.8},
831              
832             rainbow => { type=>'hsv', subs=> [ sub{$_[0]*0.82}, sub{pdl(1)}, sub{pdl(1)} ],
833             doc=>"rainbow red-yellow-green-blue-violet"},
834              
835             rgb => { type=>'rgb', subs=> [ sub{cos($_[0]*$PI/2)}, sub{sin($_[0]*$PI)}, sub{sin($_[0]*$PI/2)} ],
836             doc=>"red-green-blue fade", phot=>1 },
837              
838             sepia => { type=>'rgb', subs=> [ sub{sqrt($_[0])}, sub{$_[0]}, sub{$_[0]**2} ],
839             doc=>"a simple sepiatone", phot=>1 },
840              
841             vepia => { type=>'rgb', subs=> [ sub{$_[0]}, sub{$_[0]**2}, sub{sqrt($_[0])} ],
842             doc=>"a simple sepiatone, in violet", phot=>1, ogamma=>0.9 },
843              
844             wheel => { type=>'hsv', subs=> [ sub{$_[0]}, sub{pdl(1)}, sub{pdl(1)} ],
845             doc=>"full color wheel red-yellow-green-blue-violet-red" },
846              
847             ryg => { type=>'hsv', subs=> [ sub{ (0.5*($_[0]-0.333/2))%1 }, sub{0.8+0.2*$_[0]}, sub{$_[0]} ],
848             doc=>"A quasi-sepiatone (R/Y) with green highlights",phot=>1, igamma=>0.7 },
849              
850             extra => { type=>'hsv', subs=>[ sub{ (0.85*($_[0]**0.75-0.333/2))%1}, sub{0.8+0.2*$_[0]-0.8*$_[0]**6},
851             sub { 1 - exp(-$_[0]/0.15) - 0.08 }],
852             doc=>"Extra-broad photometric; also try -c1 etc.",phot=>1,igamma=>0.55 },
853              
854             voy => { type=>'rgb', subs=> [ sub{pdl(1)*$_[0]}, sub{$_[0]**2*$_[0]}, sub{(1-$_[0])**4 * $_[0]}],
855             doc=>"A colorblind-friendly map with lots of contrast", phot=>1, igamma=>0.7},
856              
857             ### Seasons: these are sort of like the Matlab colortables of the same names...
858              
859             spring => { type=>'rgb', subs=> [ sub{pdl(1)}, sub{$_[0]**2}, sub{(1-$_[0])**4}],
860             doc=>"Springy colors fading from magenta to yellow", phot=>1, igamma=>0.45},
861              
862             summer => { type=>'hsv', subs=> [ sub{ 0.333*(1- $_[0]/2) }, sub{0.7+0.1*$_[0]}, sub{0.01+0.99*$_[0]} ],
863             doc=>"Summery colors fading from dark green to light yellow",phot=>1, igamma=>0.8 },
864              
865             autumn => { type=>'hsv', subs=> [ sub { $_[0] * 0.333/2 }, sub{pdl(1)}, sub{0.01+0.99*$_[0]} ],
866             doc=>"Autumnal colors fading from dark red through orange to light yellow",phot=>1,igamma=>0.7},
867              
868             winter => { type=>'hsv', subs=> [ sub { 0.667-0.333*$_[0] }, sub{1.0-sin($PI/2*$_[0])**2*0.2}, sub{$_[0]}],
869             doc=>"Wintery colors fading from dark blue through lightish green",phot=>1,igamma=>0.5},
870              
871             };
872              
873             # Generate the abbrevs table: find minimal substrings that match only one result.
874             our $pc_tab_abbrevs = {};
875             {
876             my $pc_tab_foo = {};
877             for my $k(keys %$pc_tab) {
878             for my $i(0..length($k)){
879             my $s = substr($k,0,$i);
880             if($pc_tab_foo->{$s} and length($s)
881             # collision with earlier string -- if that's a real abbreviation, zap it.
882             delete($pc_tab_abbrevs->{$s})
883             unless( length($pc_tab_abbrevs->{$s}||'') == length($s) );
884             } else {
885             # no collision -- figure it's a valid abbreviation.
886             $pc_tab_abbrevs->{$s} = $k;
887             }
888             $pc_tab_foo->{$s}++;
889             }
890             }
891             }
892             # Hand-code some abbreviations..
893             $pc_tab_abbrevs->{g} = "grey";
894             for(qw/m monoc monoch monochr monochro monochrom monochrome/) {$pc_tab_abbrevs->{_} = "mono";}
895              
896              
897             ### t_pcp - t_pc, but perceptual flag defaults to 1
898             sub t_pcp {
899 0 0   0 1 0 my $name = (0+@_ % 2) ? shift : undef;
900 0 0       0 return t_pc(defined($name) ? $name : (), @_, perceptual => 1);
901             }
902              
903             our @_t_pc_combinatorics =(
904             [0,1,2],[1,2,0],[2,0,1],[0,2,1],[2,1,0],[1,0,2]
905             );
906              
907             sub t_pc {
908             # No arguments
909 2 100   2 1 1017 unless(0+@_){
910 1         2 my $s = "Usage: 't_pc(\$colortab_name, %opt)'. Named pseudocolor mappings available:\n";
911 1         3 $s .= " (tables marked 'phot' are luminance based. Use t_pc for photometric data, or\n t_pcp for near-constant perceptual shift per input value.\n Add '-c' suffix (n in [0..5]) for RGB combinatoric variations.)\n";
912 1         1 our $pc_tab;
913 1         2 for my $k(sort keys %{$pc_tab}) {
  1         14  
914 26 100       94 $s .= sprintf(" %8s - %s%s\n",$k,$pc_tab->{$k}->{doc},($pc_tab->{$k}->{phot}?" (phot)":""));
915             }
916 1         12 die $s."\n";
917             }
918              
919              
920             # Parse the color table name.
921             # Odd number of params -- expect a table name and options.
922             # even number of params -- just options.
923 1 50       4 my $lut_name = ((0+@_) % 2) ? shift() : "monochrome";
924              
925              
926             ###
927             # Table names can have combinatoric modifiers. Parse those out.
928 1         2 my $mod_combo = undef;
929 1 50       4 if( $lut_name =~ s/\-C([0-5])$//i ) {
930             # got a combinatoric modifier
931 0         0 $mod_combo = $1;
932             }
933              
934             ## Look up the table by name
935 1         4 $lut_name = $pc_tab_abbrevs->{lc($lut_name)};
936 1 50       2 unless($lut_name) {
937 0         0 t_pc(); # generate usage message
938             }
939              
940              
941             # Generate the object
942 1         9 my($me) = _new(@_, "pseudocolor sRGB encoding ($lut_name)",
943             {
944             clip=>1,
945             byte=>1,
946             gamma=>1.0,
947             lsRGB=>0,
948             domain=>undef,
949             irange=>[0,1],
950             perceptual=>0,
951             combination=>0
952             }
953             );
954              
955 1         3 $me->{params}->{lut_name} = $lut_name;
956 1         3 $me->{params}->{lut} = $pc_tab->{$lut_name};
957 1 50       3 unless(defined($pc_tab->{$lut_name})){
958 0         0 die "t_pc: internal error (name $lut_name resolves but points to nothing)";
959             }
960              
961             # Handle domain-irange synonym
962 1 50       3 $me->{params}->{irange} = $me->{params}->{domain} if(defined($me->{params}->{domain}));
963              
964             # Check that range is correct
965 1 50       3 $me->{params}->{irange} = [] unless(defined($me->{params}->{irange}));
966 1 50       7 unless( ref($me->{params}->{irange}) eq 'ARRAY'
967             ){
968 0         0 die "t_pc: 'domain' or 'irange' parameter must be an array ref ";
969             }
970 1 0 0     4 if($me->{params}->{irange}->[0] == $me->{params}->{irange}->[1] and
      33        
971             (defined($me->{params}->{irange}->[0]) && defined($me->{params}->{irange}->[1]))) {
972 0         0 die "t_pc: 'domain' or 'irange' parameter must specify a nonempty range";
973             }
974              
975              
976             # Check the RGB recombination parameter
977 1 50       3 if($mod_combo) {
978 0 0       0 die "t_pc / t_pcp: can't specify RGB combinatorics in both parameters and table\n suffix at the same time" if( $me->{params}->{combination} );
979 0         0 $me->{params}->{combination} = $mod_combo;
980             }
981              
982              
983 1 50 33     6 if($me->{params}->{combination} < 0 || $me->{params}->{combination} > 5) {
984 0         0 die "t_pc/t_pcp: 'combination' parameter must be between 0 and 5 inclusive";
985             }
986              
987             # Copy the conversion subs from the map table entry to the object, with combinatorics as
988             # needed.
989              
990 1 50       4 if($me->{params}->{lut}->{type} eq 'hsv') {
991              
992             # hsv - copy subs in from table, and implement combinatorics with a hue transform
993              
994 0         0 $me->{params}->{subs} = [ @{$me->{params}->{lut}->{subs}} ]; # copy the subs for the map
  0         0  
995 0 0       0 if($me->{params}->{combination}) {
996 0         0 my $s0 = $me->{params}->{subs}->[0];
997             $me->{params}->{subs}->[0] =
998             sub {
999 0     0   0 my $a = &$s0(@_);
1000 0         0 $a += 0.33 * $me->{params}->{combination};
1001 0 0       0 $a *= -1 if($me->{params}->{combination} > 2);
1002 0         0 $a .= $a % 1;
1003 0         0 return $a;
1004 0         0 };
1005             } # end of 'combination' handler for hsv
1006             } else {
1007              
1008             # rgb - do any combinatorics as needed
1009 1         2 $me->{params}->{subs} = [ @{$me->{params}->{lut}->{subs}}[ (@{ $_t_pc_combinatorics[$me->{params}->{combination}] }) ] ];
  1         4  
  1         3  
1010              
1011             }
1012              
1013             # Generate the forward transform
1014             $me->{func} = sub {
1015 1     1   21 my($in,$opt) = @_;
1016              
1017 1         3 my $in2 = $in->new_or_inplace;
1018              
1019 1         25 my ($min,$max) = @{$opt->{irange}};
  1         3  
1020              
1021 1 50 33     6 unless(defined($min) || defined($max)) {
    50 50        
1022 0         0 ($min,$max) = $in->minmax;
1023 0         0 } elsif( !defined($min) ){
1024 0         0 $min = $in->min;
1025             } elsif( !defined($max) ) {
1026             $max = $in->max;
1027             }
1028              
1029 1 50 33     44 if($min==$max || !isfinite($min) || !isfinite($max)) {
      33        
1030 0         0 die "t_pc transformation: range is zero or infinite ($min to $max)! Giving up!";
1031             }
1032              
1033             # Translate to (0,1)
1034 1         178 $in2 -= $min;
1035 1         25 $in2 /= $max;
1036              
1037 1         13 my $split = 0;
1038             # Deal with split color tables
1039 1 50       4 if($opt->{lut}->{split}) {
1040 0         0 $split = $opt->{lut}->{split};
1041 0         0 $in2 -= $split;
1042 0 0       0 if($split==0.5) {
1043 0         0 $in2 *= 2;
1044             } else {
1045 0         0 $in2->where($in2<0) /= $split;
1046 0         0 $in2->where($in2>0) /= (1.0-$split);
1047             }
1048             }
1049              
1050             # Default to sRGB coding for perceptual curves
1051 1 50 33     5 if($opt->{lut}->{phot} && $opt->{perceptual}) {
1052 0         0 rgb_to_linear($in2->inplace, -1);
1053 0         0 $in2->set_inplace(0); # needed as bug in PDL <2.082
1054             }
1055              
1056 1 50       3 if($opt->{clip}) {
1057 1 50       3 if($split) {
1058 0         0 $in2->inplace->clip( -1,1 );
1059             } else {
1060 1         5 $in2->inplace->clip(0,1);
1061             }
1062             }
1063              
1064 1 50       22 if(defined($opt->{lut}->{igamma})) {
1065 0         0 $in2 *= ($in2->abs+1e-10) ** ($opt->{lut}->{igamma} - 1);
1066             }
1067              
1068 1 50       3 if($split) {
1069 0 0       0 if($split==0.5) {
1070 0         0 $in2 /=2;
1071             } else {
1072 0         0 $in2->where($in2<0) *= $split;
1073 0         0 $in2->where($in2>0) *= (1.0-$split);
1074 0         0 $in2 += $split;
1075             }
1076 0         0 $in2 += $split;
1077              
1078 0 0       0 if($opt->{clip}) {
1079 0         0 $in2->clip(0,1);
1080             }
1081             }
1082              
1083             # apply the transform
1084 1         4 my $out = zeroes(3,$in2->dims);
1085              
1086             ## These are the actual transforms. They're figured by the constructor,
1087             ## which does any combinatorics in setting up the subs.
1088 1         12 $out->slice('(0)') .= $opt->{subs}->[0]->($in2)->clip(0,1);
1089 1         54 $out->slice('(1)') .= $opt->{subs}->[1]->($in2)->clip(0,1);
1090 1         32 $out->slice('(2)') .= $opt->{subs}->[2]->($in2)->clip(0,1);
1091              
1092 1 50       56 if(defined($opt->{lut}->{ogamma})) {
1093 0         0 $out *= ($out->abs) ** ($opt->{lut}->{ogamma}-1);
1094             }
1095 1         5 return $out;
1096 1         5 };
1097              
1098 1         2 my $out = $me;
1099              
1100 1 50       3 if($me->{params}->{lut}->{type} eq 'hsv') {
1101 0         0 $out = (!t_hsv()) x $out;
1102             }
1103              
1104 1 50       5 if(abs($me->{params}->{gamma}-1.0) > 1e-5) {
1105 0         0 $out = $out x t_gamma($me->{params}->{gamma});
1106             }
1107              
1108 1 50       2 unless($me->{params}->{lsRGB}) {
1109 1         3 $out = t_srgb(clip=>$me->{params}->{clip}, byte=>$me->{params}->{byte}) x $out;
1110             }
1111              
1112 1         108 return $out;
1113             }
1114              
1115             ################################################################################
1116             ################################################################################
1117              
1118              
1119              
1120             ##############################
1121              
1122             =head2 t_cieXYZ, t_xyz
1123              
1124             =for ref
1125              
1126             The C transform (also C, which is a synonym)
1127             converts the module-native lsRGB to the CIE XYZ representation. CIE
1128             XYZ is a nonphysical RGB-style system that minimally represents every
1129             physical color it is possible for humans to perceive in steady
1130             illumination. It is related to sRGB by a linear transformation
1131             (i.e. matrix multiplication) and forms the basis of many other color
1132             systems (such as CIE xyY).
1133              
1134             CIE XYZ values are defined in such a way that they are positive
1135             definite for all human-perceptible colors, at the cost that the
1136             primaries are nonphysical (they correspond to no possible spectral
1137             color)
1138              
1139             C accepts the following options:
1140              
1141             =over 3
1142              
1143             =item gamma (default 1)
1144              
1145             This is taken to be a coded gamma value in the original lsRGB, which
1146             is decoded before conversion to the CIE XYZ system.
1147              
1148             =item rgb_system (default undef)
1149              
1150             If present, this must be either the name of an RGB system or an RGB system
1151             descriptor hash as described in C. If none is specified, then
1152             the standard linearized sRGB used by the rest of the module is assumed.
1153              
1154             =item use_system_gamma (default 0)
1155              
1156             If this flag is set, and C is set also, then the RGB side
1157             of the transform is taken to be gamma-encoded with the default value for
1158             that RGB system. Unless you explicitly specify an RGB system (with a name
1159             or a hash), this flag is ignored.
1160              
1161             =back
1162              
1163             =cut
1164              
1165              
1166             *t_cieXYZ = \&t_xyz;
1167              
1168             sub _M_relativise {
1169 1     1   164 my ($M, $w) = @_;
1170 1         6 my $Minv = $M->inv;
1171 1         2265 my $XYZw = xyY_to_xyz($w);
1172 1         3 my $Srgb = ($Minv x $XYZw->slice('*1'))->slice('(0)'); # row vector
1173 1         120 $M * $Srgb;
1174             }
1175              
1176             sub t_xyz {
1177 5     5 1 466 my ($me) = _new(@_, 'CIE XYZ',
1178             {gamma=>1,
1179             rgb_system=>undef,
1180             use_system_gamma=>0
1181             }
1182             );
1183              
1184             # shortcut the common case
1185 5 100       15 unless(defined($me->{params}->{rgb_system})) {
1186              
1187 4         11 $me->{params}->{mat} = $srgb2cxyz_mat;
1188 4         7 $me->{params}->{inv} = $srgb2cxyz_inv;
1189              
1190             } else {
1191 1         4 my $rgb = get_rgb($me->{params}{rgb_system});
1192 1         7 my $M = _M_relativise(xyY_to_xyz(pdl(@$rgb{qw(r g b)}))->transpose, $rgb->{w});
1193 1         18 @{$me->{params}}{qw(mat inv)} = ($M, $M->inv);
  1         2089  
1194 1 50       4 $me->{params}{gamma} = $rgb->{gamma} if $me->{params}{use_system_gamma};
1195             }
1196              
1197             # func and inv get linearized versions (gamma handled below)
1198             $me->{func} = sub {
1199 5     5   544 my($in, $opt) = @_;
1200              
1201 5         20 my $out = ( $opt->{mat} x $in->slice('*1') )->slice('(0)')->sever;
1202              
1203 5 50       425 if($in->is_inplace) {
1204 0         0 $in .= $out;
1205 0         0 $out = $in;
1206             }
1207 5         17 return $out;
1208 5         27 };
1209              
1210             $me->{inv} = sub {
1211 5     5   1900 my($in, $opt) = @_;
1212 5         20 my $out = ( $opt->{inv} x $in->slice('*1') )->slice('(0)')->sever;
1213              
1214 5 50       425 if($in->is_inplace) {
1215 0         0 $in .= $out;
1216 0         0 $out = $in;
1217             }
1218 5         17 return $out;
1219 5         16 };
1220              
1221 5         13 return gammify($me);
1222             }
1223              
1224              
1225              
1226             =head2 t_rgi
1227              
1228             =for ref
1229              
1230             Convert RGB to RG chroma with a separate intensity channel.
1231              
1232             Note that intensity is just the average of the R, G, and B values.
1233             If you want perceptible luminance, use t_rgl or t_ycbcr instead.
1234              
1235             =cut
1236              
1237             sub t_rgi {
1238 1     1 1 667 my($me) = _new(@_, 'RGI',
1239             {gamma=>1,
1240             }
1241             );
1242              
1243             $me->{func} = sub {
1244 1     1   10 my($in,$opt) = @_;
1245 1         14 my $i = $in->sumover->slice('*1');
1246 1         19 my $out = zeroes($in);
1247 1         149 $out->slice('0:1') .= $in->slice('0:1') / ($i+($i==0));
1248 1         97 $out->slice('2') .= $i/3;
1249 1 50       34 if($in->is_inplace) {
1250 0         0 $in .= $out;
1251 0         0 return $in;
1252             }
1253 1         4 return $out;
1254 1         6 };
1255             $me->{inv} = sub {
1256 0     0   0 my($in,$opt) = @_;
1257 0         0 my $out = zeroes($in);
1258 0         0 $out->slice('0:1') .= $in->slice('0:1');
1259 0         0 $out->slice('(2)') .= 1 - $in->slice('0:1')->sumover;
1260 0         0 $out *= $in->slice('2') * 3;
1261 0 0       0 if($in->is_inplace) {
1262 0         0 $in .= $out;
1263 0         0 return $in;
1264             }
1265 0         0 return $out;
1266 1         4 };
1267              
1268 1         4 return $me;
1269             }
1270              
1271              
1272              
1273             =head2 t_xyy and t_xyY
1274              
1275             =for ref
1276              
1277             Convert from sRGB to CIE xyY. The C system is part of the CIE
1278             1931 color specification. Luminance is in the 2 coordinate, and
1279             chrominance x and y are in the 0 and 1 coordinates.
1280              
1281             This is the coordinate system in which "chromaticity diagrams" are
1282             plotted. It is capable of representing every illuminant color that
1283             can be perceived by the typical human eye, and also many that can't,
1284             with positive-definite coordinates.
1285              
1286             Most of the domain space (which runs over [0-1] in all three dimensions)
1287             is inaccessible to most displays, because RGB gamuts are generally
1288             smaller than the actual visual gamut, which in turn is a subset of the
1289             actual xyY data space.
1290              
1291             =cut
1292              
1293             *t_xyY = \&t_xyy;
1294              
1295             sub t_xyy {
1296 0     0 1 0 my ($me) = _new(@_, 'CIE xyY',
1297             {gamma=>1,
1298             }
1299             );
1300              
1301             $me->{func} = sub {
1302 0     0   0 my($XYZ, $opt) = @_;
1303 0         0 my $out = $XYZ/$XYZ->sumover->slice('*1');
1304 0         0 $out->slice('(2)') .= $XYZ->slice('(1)');
1305 0 0       0 if($XYZ->is_inplace) {
1306 0         0 $XYZ .= $out;
1307 0         0 $out = $XYZ;
1308             }
1309 0         0 return $out;
1310 0         0 };
1311              
1312             $me->{inv} = sub {
1313 0     0   0 my($in,$opt) = @_;
1314             # make xYy
1315 0         0 my $XYZ = zeroes($in);
1316              
1317             # stuff X and Z in there.
1318 0         0 my $in1 = $in->slice('(1)')+($in->slice('(1)')==0);
1319 0         0 $XYZ->slice('(0)') .= $in->slice('(0)') * $in->slice('(2)') / $in1;
1320 0         0 $XYZ->slice('(1)') .= $in->slice('(2)');
1321 0         0 $XYZ->slice('(2)') .= $in->slice('(2)') * (1 - $in->slice('(0)') - $in->slice('(1)')) / $in1;
1322              
1323 0 0       0 if($in->is_inplace) {
1324 0         0 $in .= $XYZ;
1325 0         0 $XYZ = $in;
1326             }
1327 0         0 return $XYZ;
1328 0         0 };
1329 0         0 return gammify( $me x t_xyz() );
1330             }
1331              
1332              
1333             ######################################################################
1334              
1335             =head2 t_cielab or t_lab
1336              
1337             =for usage
1338              
1339             $t = t_cielab();
1340              
1341             =for ref
1342              
1343             Convert RGB to CIE Lab colors. C stands for Lightness,
1344             "a", and "b", representing the overall luminance detection and
1345             two opponent systems (a: red/green, and b:yellow/blue) in the human
1346             eye. Lab colors are approximately perceptually uniform: they're
1347             mapped using a nonlinear transformation involving cube roots. Lab
1348             has the property that Euclidean distances of equal size in the space
1349             yield approximately equal perceptual shifts in the represented color.
1350              
1351             Lightness runs 0-100, and the a and b opponent systems run -100 to +100.
1352              
1353             The Lab space includes the entire CIE XYZ gamut and many "impossible colors".
1354             that cannot be represented directly with physical light. Many of these
1355             "impossible colors" (also "chimeric colors") can be experienced directly
1356             using visual fatigue effects, and can be classified using Lab.
1357              
1358             Lab is easiest to convert directly from XYZ space, so the C constructor
1359             returns a compound transform of C and C.
1360              
1361             =head2 t_xyz2lab
1362              
1363             =for usage
1364              
1365             $t = t_xyz2lab();
1366              
1367             =for ref
1368              
1369             Converts CIE XYZ to CIE Lab.
1370              
1371             =cut
1372              
1373             sub t_xyz2lab {
1374              
1375 4     4 1 1047 my ($me) = _new(@_,'XYZ->Lab',
1376             {
1377             white=>"D65",
1378             }
1379             );
1380              
1381             # get and store illuminant XYZ
1382 4         36 my $wp_xyy = xyy_from_illuminant($me->{params}{white});
1383 4         634 $me->{params}{wp_xy} = $wp_xyy->slice('0:1')->sever;
1384             # input is XYZ by the time it gets here
1385             $me->{func} = sub {
1386 4     4   31 my($in,$opt) = @_;
1387 4         21 my $out = xyz_to_lab($in, {white_point=>$me->{params}{wp_xy}});
1388 4 50       134 if($in->is_inplace) {
1389 0         0 $in .= $out;
1390 0         0 $out = $in;
1391             }
1392 4         15 return $out;
1393 4         111 };
1394              
1395             $me->{inv} = sub {
1396 3     3   107 my($in,$opt) = @_;
1397 3         33 my $out = lab_to_xyz($in, {white_point=>$me->{params}{wp_xy}});
1398 3 50       109 if($in->is_inplace) {
1399 0         0 $in .= $out;
1400 0         0 $out = $in;
1401             }
1402 3         8 return $out;
1403 4         12 };
1404              
1405 4         22 return $me;
1406             }
1407              
1408              
1409              
1410             sub t_lab {
1411 3     3 1 1982 my ($me) = _new(@_, 'Lab',
1412             {
1413             gamma => 1.0,
1414             white=>'D65',
1415             }
1416             );
1417             return (
1418             t_xyz2lab(white=>$me->{params}->{white} ) x
1419             t_xyz( gamma=>$me->{params}->{gamma})
1420 3         46 );
1421             }
1422              
1423              
1424             =head2 t_cmyk
1425              
1426             converts rgb to cmyk in the most straightforward way (by subtracting
1427             RGB values from unity).
1428              
1429             CMYK and other process spaces are very complicated; this transform
1430             presents only a relatively simple conversion that does not take into
1431             account ink gamut variation or many other effects.
1432              
1433             There *is* a provision for halftone gamma correction: "htgamma", which
1434             works exactly like the rgb gamma correction but is applied to the CMYK
1435             output.
1436              
1437             Options:
1438              
1439             =over 3
1440              
1441             =item gamma (default 1)
1442              
1443             The standard gamma affecting the RGB cube
1444              
1445             =item htgamma (default 1)
1446              
1447             A "halftone gamma" that is suitable for non-wash output processes
1448             such as halftoning. it acts on the CMYK values themselves.
1449              
1450             =item byte (default 0)
1451              
1452             If present, the CMYK side is scaled to 0-255 and converted to a byte type.
1453              
1454             =back
1455              
1456             =cut
1457             ;
1458             sub t_cmyk {
1459 1     1 1 443 my($me) = _new(@_, "CMYK",
1460             {gamma=>1,
1461             pigment=>0,
1462             density=>2,
1463             htgamma=>1,
1464             clip=>0,
1465             byte=>0
1466             }
1467             );
1468 1         3 $me->{idim} = 3;
1469 1         2 $me->{odim} = 4;
1470              
1471             $me->{func} = sub {
1472 2     2   496 my($in,$opt) = @_;
1473 2         10 my $out = zeroes( 4, $in->slice('(0)')->dims );
1474              
1475 2         85 my $Kp = $in->maximum->slice('*1');
1476 2         26 (my $K = $out->slice('3')) .= 1 - $Kp;
1477 2         108 $out->slice('0:2') .= ($Kp - $in->slice('0:2')) / $Kp;
1478 2         93 $out->slice('(3)')->where($Kp==0) .= 1;
1479 2         328 $out->slice('0:2')->mv(0,-1)->where($Kp==0) .= 0;
1480              
1481 2 50 33     235 if(defined($opt->{htgamma}) && $opt->{htgamma} != 1) {
1482 0         0 $out *= ($out->abs) ** ($opt->{htgamma} - 1);
1483             }
1484              
1485 2 50       6 if($opt->{clip}) {
1486 0         0 $out->inplace->clip(0,1);
1487             }
1488              
1489 2 50       4 if($opt->{byte}) {
1490 0         0 $out = (256*$out)->clip(0,255.99999);
1491             }
1492 2         11 return $out;
1493 1         5 };
1494              
1495             $me->{inv} = sub {
1496 2     2   1074 my($in,$opt) = @_;
1497 2         9 my $out = zeroes( 3, $in->slice('(0)')->dims );
1498              
1499 2         58 $in = $in->new_or_inplace;
1500              
1501 2 50       39 if($opt->{byte}) {
1502 0         0 $in = $in / pdl(256); # makes copy
1503             }
1504              
1505 2 50 33     8 if(defined($opt->{htgamma}) && $opt->{htgamma} != 1) {
1506 0         0 $in *= ($in->abs) ** (1.0/$opt->{htgamma} - 1);
1507             }
1508 2         4 my $Kp = 1.0 - $in->slice('3');
1509 2         79 $out .= $Kp * ( 1 - $in->slice('0:2') );
1510 2         89 return $out;
1511 1         5 };
1512              
1513 1         17 return gammify($me);
1514              
1515             }
1516              
1517             =head2 t_hsl and t_hsv
1518              
1519             =for usage
1520              
1521             $rgb = $hsl->invert($t_hsl());
1522              
1523             =for ref
1524              
1525             HSL stands for Hue, Saturation, Lightness. It's not an absolute
1526             color space, simply derived from each RGB (by default, linearized
1527             sRGB). it has the same gamut as the host RGB system. The coordinates
1528             are hexagonal on the (RYGCBM) hexagon, following the nearest face of
1529             the (diagonally sliced) RGB cube.
1530              
1531             HSL is a double-cone system, so iso-L surfaces are close to the plane
1532             perpendicular to the double-diagonal white/illuminant line R=G=B.
1533             This has the effect of reducing saturation at high lightness levels,
1534             but maintains luminosity independent of saturation. Maximum
1535             saturation occurs when S=1 and L=0.5; at higher values of L, colors
1536             grow less saturated and more pastel, so that L follows total
1537             luminosity of the output.
1538              
1539             HSV is a stacked-cone system: iso-V surfaces are parallel to the
1540             bright faces of the RGB cube, so maximal bright saturation occurs when
1541             S=1 and V=1. This means that output luminosity drops with saturation,
1542             but due to Helmholtz-Kolrausch effect (linking saturation to apparent
1543             brightness) the I brightness is less S-dependent: V follows
1544             total I of the output, though output luminosity
1545             drops with S.
1546              
1547             You can represent out-of-gamut values in either system, by using
1548             S values greater than unity, or "illegal" V or L values.
1549              
1550             Hue, Saturation, and (Lightness or Value) each run from 0 to 1.
1551              
1552             By default, the hue value follows a sin**4 scaling along each side of
1553             the RYGCBM hexagon. This softens the boundaries near the edges of the
1554             RGB cube, giving a better peceptual "color-wheel" transition between
1555             hues. There is a flag to switch to the linear behavior described in,
1556             e.g., the Wikipedia article on the HSV system.
1557              
1558             You can encode the Lightness or Value with a gamma value ("lgamma") if
1559             desired.
1560              
1561             Options:
1562              
1563             =over 3
1564              
1565             =item gamma (default 1)
1566              
1567             Treat the base RGB as gamma-encoded (default 1 is linear)
1568              
1569             =item lgamma (default 1)
1570              
1571             Treat the L coordinate as gamma-encoded (default 1 is linear).
1572              
1573             =item hsv (default 0 if called as "t_hsl", 1 if called as "t_hsv")
1574              
1575             Sets which of the HSL/HSV transform is to be used.
1576              
1577             =item hue_linear (default 0)
1578              
1579             This flag determines how the hue ("angle") is calculated. By default,
1580             a sin**4 scaling is used along each branch of the RYGCBM hexagon,
1581             to soften the perceptual effects at the corners. If you set this flag,
1582             then the calculated "hue" is linear along each branch of the hexagon,
1583             to match (e.g.) the Wikipedia definition.
1584              
1585             =back
1586              
1587             =cut
1588              
1589             sub t_hsl {
1590 2     2 1 593 my($me) = _new(@_,"HSL",
1591             {gamma=>1,
1592             lgamma=>1,
1593             hue_linear=>0,
1594             hsv=>0
1595             }
1596             );
1597              
1598 2 100       8 $me->{name} = "HSV" if($me->{params}->{hsv});
1599              
1600             $me->{func} = sub {
1601 2     2   25 my($in, $opt) = @_;
1602 2         6 my $out = zeroes($in);
1603              
1604 2         298 my $Cmax = $in->maximum;
1605 2         38 my $Cmin = $in->minimum;
1606 2         73 my $maxdex = $in->qsorti->slice('(2)')->sever;
1607 2         50 my $Delta = ( $Cmax - $Cmin );
1608              
1609 2         27 my $dexes = ($maxdex->slice('*1') + pdl(0,1,2)) % 3;
1610              
1611 2         257 my $H = $out->slice('(0)');
1612              
1613 2 50       29 if($opt->{hue_linear}) {
1614             ## Old linear method
1615 0         0 $H .= (
1616             (($in->index1d($dexes->slice('1')) - $in->index1d($dexes->slice('2')))->slice('(0)')/($Delta+($Delta==0)))
1617             + 2 * $dexes->slice('(0)') ) ;
1618              
1619 0         0 $H += 6*($H<0);
1620 0         0 $H /= 6;
1621             } else {
1622             ## New hotness: smooth transitions at corners
1623 2         6 my $Hint = 2*$dexes->slice('(0)');
1624 2         52 my $Hfrac = (($in->index1d($dexes->slice('1')) - $in->index1d($dexes->slice('2')))->slice('(0)')/($Delta+($Delta==0)));
1625 2         229 my $Hfs = -1*($Hfrac<0) + ($Hfrac >= 0);
1626 2         107 $Hfrac .= $Hfs * ( asin( ($Hfrac->abs) ** 0.25 ) * 2/$PI );
1627 2         229 $H .= $Hint + $Hfrac;
1628 2         35 $H /= 6;
1629             }
1630              
1631 2         29 $H += ($H<0);
1632              
1633             # Lightness and Saturation
1634 2         44 my $L = $out->slice('(2)');
1635 2 100       31 if($opt->{hsv}) {
1636 1         2 $L .= $Cmax;
1637 1         9 $out->slice('(1)') .= $Delta / ($L + ($L==0));
1638             } else {
1639 1         12 $L .= ($Cmax + $Cmin)/2;
1640 1         30 $out->slice('(1)') .= $Delta / (1 - (2*$L-1)->abs + (($L==0) | ($L==1)));
1641             }
1642              
1643              
1644 2 50       222 if( $opt->{lgamma} != 1 ){
1645 0         0 $L .= $L * (($L->abs + ($L==0)) ** (1.0/$opt->{lgamma} - 1));
1646             }
1647              
1648 2 50       7 if($in->is_inplace) {
1649 0         0 $in .= $out;
1650 0         0 $out = $in;
1651             }
1652 2         14 return $out;
1653 2         13 };
1654              
1655             $me->{inv} = sub {
1656 2     2   1120 my($in,$opt) = @_;
1657              
1658 2         8 my $H = $in->slice('(0)')*6;
1659 2         75 my $S = $in->slice('(1)');
1660 2         23 my $L = $in->slice('(2)');
1661              
1662 2 50       20 if($opt->{lgamma} != 1) {
1663 0         0 $L = $L * (($L->abs + ($L==0)) ** ($opt->{lgamma}-1));
1664             }
1665              
1666 2         6 my $ZCX = zeroes($in);
1667 2         313 my $C = $ZCX->slice('(1)');
1668 2         23 my $m;
1669 2 100       6 if($opt->{hsv}) {
1670 1         3 $C .= $L * $S;
1671 1         24 $m = $L - $C;
1672             } else {
1673 1         2 $C .= (1 - (2*$L - 1)->abs) * $S;
1674 1         81 $m = $L - $C/2;
1675             }
1676              
1677 2 50       31 if($opt->{hue_linear}){
1678             ## Old linear method
1679 0         0 $ZCX->slice('(2)') .= $C * (1 - ($H % 2 - 1)->abs);
1680             } else {
1681             ## New hotness: smooth transitions at corners.
1682 2         19 $ZCX->slice('(2)') .= $C * sin($PI/2 * (1 - ($H % 2 - 1)->abs))**4;
1683             }
1684              
1685 2         305 my $dexes = pdl( [1,2,0], [2,1,0], [0,1,2], [0,2,1], [2,0,1], [1,0,2] )->mv(1,0)->sever;
1686 2         316 my $dex = $dexes->index1d($H->floor->slice('*1,*1') % 6)->slice('(0)')->sever; # 3x(threads)
1687 2         120 my $out = $ZCX->index1d($dex)->sever + $m->slice('*1');
1688              
1689 2 50       46 if($in->is_inplace) {
1690 0         0 $in .= $out;
1691 0         0 $out = $in;
1692             }
1693              
1694 2         17 return $out;
1695 2         8 };
1696              
1697 2         5 return gammify($me);
1698             }
1699              
1700              
1701             sub t_hsv {
1702 1     1 1 400 my($me) = _new(@_,"HSL",
1703             {gamma=>1,
1704             lgamma=>1,
1705             hsv=>1
1706             }
1707             );
1708 1         2 return t_hsl(%{$me->{params}});
  1         5  
1709             }
1710              
1711              
1712              
1713             =head2 t_shift_illuminant
1714              
1715             =for ref
1716              
1717             C shifts a color from an old RGB system to a new one
1718             with a different white point. It accepts either a PDL containing a
1719             CIE xyY representation of the new illuminant, or a name of the new illuminant,
1720             and some options.
1721              
1722             Because this is shifting RGB to RGB in the same representation, gamma
1723             transformations get re-encoded afterward: if you use, for example,
1724             C<< gamma=>2 >>, then the RGB values are squared, then transformed, then
1725             square-rooted.
1726              
1727             Options are:
1728              
1729             =over 3
1730              
1731             =item gamma (default=1)
1732              
1733             If present, this is the gamma coefficient for the representation of
1734             both the source and destination RGB spaces.
1735              
1736             =item from (default="D65")
1737              
1738             If present, this is the xyY or name of the OLD illuminant. The default
1739             is D65, the illuminant for sRGB (and therefore lsRGB as well).
1740              
1741             =item basis (default="sRGB")
1742              
1743             If present, this needs to be either "sRGB" or "XYZ" (case insensitive).
1744             If it's sRGB, the input and output are treated as standard lsRGB coordinates.
1745             If it's XYZ, then the input and output are in CIE XYZ coordinates.
1746              
1747             =item method (default="Bradford")
1748              
1749             This can be "Bradford", "Von Kries", "XYZ", or a 3x3 matrix Ma (see
1750             C)
1751              
1752             =back
1753              
1754             =cut
1755              
1756             sub t_shift_illuminant {
1757 0     0 1 0 my $new_illuminant = shift;
1758 0         0 my($me) = _new(@_, 'New illuminant',
1759             {gamma =>1,
1760             from => "D65",
1761             basis => 'rgb',
1762             method=>"Bradford"
1763             }
1764             );
1765              
1766 0 0       0 unless(UNIVERSAL::isa($new_illuminant, 'PDL')) {
1767 0         0 $new_illuminant = xyy_from_illuminant($new_illuminant);
1768             }
1769 0 0       0 unless(UNIVERSAL::isa($me->{params}->{from}, 'PDL')) {
1770 0         0 $me->{params}->{from} = xyy_from_illuminant($me->{params}->{from});
1771             }
1772 0         0 $me->{params}->{to} = $new_illuminant;
1773              
1774 0 0 0     0 if(UNIVERSAL::isa($me->{params}->{method},"PDL")) {
    0          
    0          
    0          
1775 0 0 0     0 if($me->{params}->{method}->ndims==2 &&
      0        
1776             $me->{params}->{method}->dim(0)==3 &&
1777             $me->{params}->{method}->dim(1)==3) {
1778 0         0 $me->{params}->{Ma} = $me->{params}->{method}->copy;
1779             } else {
1780 0         0 die "t_new_illuminant: method must be a 3x3 matrix or {Bradford|Von Kries|XYZ}";
1781             }
1782             } elsif( $me->{params}->{method} =~ m/^B/i || length($me->{params}->{method})==0) {
1783             # Bradford
1784 0         0 $me->{params}->{Ma} = pdl( [ 0.8951000, 0.2664000, -0.1614000 ],
1785             [ -0.7502000, 1.7135000, 0.0367000 ],
1786             [ 0.0389000, -0.0685000, 1.0296000 ]
1787             );
1788             } elsif($me->{params}->{method} =~ m/^[VK]/i) {
1789             # von Kries or Kries
1790 0         0 $me->{params}->{Ma} = pdl( [ 0.4002400, 0.7076000, -0.0808100 ],
1791             [ -0.2263000, 1.1653200, 0.0457000 ],
1792             [ 0.0000000, 0.0000000, 0.9182200 ]
1793             );
1794             } elsif($me->{params}->{method} =~ m/^[XC]/i) {
1795             # XYZ or CIE
1796 0         0 $me->{params}->{Ma} = pdl( [1, 0, 0], [0, 1, 0], [0, 0, 1] );
1797             } else {
1798 0         0 print "Unknown method '$me->{params}->{method}'\n";
1799             }
1800              
1801 0         0 $me->{params}->{Ma_inv} = $me->{params}->{Ma}->inv;
1802              
1803             $me->{func} = sub {
1804 0     0   0 my($in, $opt) = @_;
1805 0         0 my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->slice('*1') )->slice('(0)')->sever;
1806 0         0 my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->slice('*1') )->slice('(0)')->sever;
1807 0         0 my $M = $opt->{Ma_inv} x ( ( $rhgabe_to / $rhgabe_fr )->slice('*1') * $opt->{Ma} );
1808              
1809 0 0       0 if($opt->{basis} =~ m/^X/i) {
1810 0         0 return (( $M x $in->slice('*1') )->slice('(0)')->sever);
1811             } else {
1812 0         0 return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->slice('*1') )->slice('(0)')->sever);
1813             }
1814              
1815 0         0 };
1816              
1817             $me->{inv} = sub {
1818 0     0   0 my($in, $opt) = @_;
1819 0         0 my $rhgabe_fr = ( $opt->{Ma} x $opt->{from}->slice('*1') )->slice('(0)')->sever;
1820 0         0 my $rhgabe_to = ( $opt->{Ma} x $opt->{to} ->slice('*1') )->slice('(0)')->sever;
1821 0         0 my $M = $opt->{Ma_inv} x ( ( $rhgabe_fr / $rhgabe_to )->slice('*1') * $opt->{Ma} );
1822              
1823 0 0       0 if($opt->{basis} =~ m/^X/i) {
1824 0         0 return (( $M x $in->slice('*1') )->slice('(0)')->sever);
1825             } else {
1826 0         0 return (( ( $srgb2cxyz_inv x $M x $srgb2cxyz_mat ) x $in->slice('*1') )->slice('(0)')->sever);
1827             }
1828 0         0 };
1829              
1830 0 0 0     0 return $me if ($me->{params}{gamma} // 1) == 1;
1831 0         0 return t_gamma(1.0/$me->{params}->{gamma}) x $me x t_gamma($me->{params}->{gamma});
1832             }
1833              
1834             =head2 t_shift_rgb
1835              
1836             =for usage
1837              
1838             $t = t_shift_rgb("NTSC",{from=>"sRGB"});
1839              
1840             =for ref
1841              
1842             Shifts the primary color basis of the lsrgb TO the destination system.
1843             Most named RGB systems have an associated preferred gamma, but that is
1844             ignored by default: the RGB values are treated as if they are all
1845             linear representations. You can specify EITHER the name of the system
1846             OR the specific RGB parameters for that system.
1847              
1848             The RGB parameters, if you specify them, need to be in the form of a
1849             hash ref. The hash keys should be the same as would be returned by
1850             C. All the keys must be present,
1851             except for gamma (which is ignored).
1852              
1853             Alternatively, you can use the name of a known system. These are listed in the
1854             documentation for C.
1855              
1856             C takes several options.
1857              
1858             =over 3
1859              
1860             =item gamma (default 1)
1861              
1862             The input triplets are assumed to be encoded with this gamma function.
1863             The default assumes linear representation.
1864              
1865             =item ogamma (default gamma)
1866              
1867             The output triplets are assumed to need encoding with this gamma function.
1868              
1869             =item use_system_gammas (default 0)
1870              
1871             This overrides the settings of "gamma" and "ogamma", and
1872             encodes/decodes according to the original system.
1873              
1874             =item wp_method (default undef)
1875              
1876             This is the whitepoint shift method used to change illuminant value between
1877             systems with different whitepoints. See C for an
1878             explanation.
1879              
1880             =item from (default "sRGB")
1881              
1882             This is the RGB system to convert from, in the same format as the
1883             system to convert to (names or a hash ref as described).
1884              
1885             =back
1886              
1887             =cut
1888              
1889             sub t_shift_rgb {
1890 0     0 1 0 my $new_rgb = shift;
1891 0         0 my($me) = _new(@_, 'New RGB system',
1892             {gamma =>1,
1893             ogamma=>undef,
1894             use_system_gammas=>0,
1895             wp_method=>undef,
1896             from=>"sRGB"
1897             }
1898             );
1899              
1900              
1901 0         0 my $to_rgb = get_rgb($new_rgb);
1902 0         0 my $from_rgb = get_rgb($me->{params}->{from});
1903              
1904 0         0 my ($from_gamma, $to_gamma);
1905 0 0       0 if($me->{params}->{use_system_gammas}) {
1906 0         0 $from_gamma = $me->{params}->{from_rgb}->{gamma};
1907 0         0 $to_gamma = $me->{params}->{to_rgb}->{gamma};
1908             } else {
1909 0         0 $from_gamma = $me->{params}->{gamma};
1910 0         0 $to_gamma = $me->{params}->{ogamma};
1911 0 0       0 $to_gamma = $me->{params}->{gamma} if !defined $to_gamma;
1912             }
1913              
1914             my $out =
1915             !t_xyz(rgb_system=>$to_rgb, gamma=>$me->{params}->{gamma}, use_system_gamma=>$me->{params}->{use_system_gamma}) x
1916             t_shift_illuminant($to_rgb->{w},basis=>"XYZ",from=>$from_rgb->{w},method=>$me->{params}->{wp_method}) x
1917 0         0 t_xyz(rgb_system=>$from_rgb, gamma=>$me->{params}->{gamma}, use_system_gamma=>$me->{params}->{use_system_gamma});
1918              
1919 0         0 return $out;
1920              
1921             }
1922              
1923             ##############################
1924             # Reference illuminants
1925             # (aka "white points")
1926              
1927             =head2 PDL::Transform::Color::xyy_from_D
1928              
1929             =for usage
1930              
1931             $xyy = PDL::Transform::Color::xyy_from_D($D_value)
1932              
1933             =for ref
1934              
1935             This utility routine generates CIE xyY system colorimetric values for
1936             standard CIE D-class illuminants (e.g., D50 or D65). The illuminants are
1937             calculated from a standard formula and correspond to black body
1938             temperatures between 4,000K and 250,000K. The D value is the
1939             temperature in K divided by 100, e.g. broad daylight is D65,
1940             corresponding to 6500 Kelvin.
1941              
1942             This is used for calculating standard reference illuminants, to convert
1943             RGB values between illuminants.
1944              
1945             For example, sRGB uses a D65 illuminant, but many other color standards
1946             refer to a D50 illuminant.
1947              
1948             The colorimetric values are xy only; the Y coordinate can be specified via
1949             an option, or defaults to 0.5.
1950              
1951             This routine is mainly used by C, which handles most
1952             of the CIE-recognized standard illuminant sources including the D's.
1953              
1954             See C for a description of the CIE xyY absolute colorimetric system.
1955              
1956             C accepts the following options:
1957              
1958             =over 3
1959              
1960             =item Y - the Y value of the output xyY coordinate
1961              
1962             =back
1963              
1964             =cut
1965              
1966             sub xyy_from_D {
1967 22     22 1 74 my $D = pdl(shift);
1968 22   50     1298 my $u_opt = shift || {};
1969 22         88 my %opt = parse({
1970             Y=>1
1971             },
1972             $u_opt);
1973              
1974 22 50 33     5755 die "cie_xy_from_D: D must be between 40 and 250" if(any($D< 40) || any($D > 250));
1975 22         5318 my $T = $D*100 * 1.4388/1.438; # adjust for 6504K not 6500K
1976              
1977 22         1192 my $Xd;
1978 22         71 $Xd = ($D<=70) * ( 0.244063 + 0.09911e3/$T + 2.9678e6/$T/$T - 4.6070e9/$T/$T/$T ) +
1979             ($D> 70) * ( 0.237040 + 0.24748e3/$T + 1.9018e6/$T/$T - 2.0064e9/$T/$T/$T );
1980              
1981 22         6768 return pdl( $Xd, -3*$Xd*$Xd + 2.870*$Xd - 0.275, $opt{Y} )->mv(-1,0)->sever;
1982             }
1983              
1984             # xy data for FL3.x standards, from CIE "Colorimetry" 3rd edition Table T.8.2
1985             my $fl3tab = [
1986             [],
1987             [0.4407, 0.4033],
1988             [0.3808, 0.3734],
1989             [0.3153, 0.3439],
1990             [0.4429, 0.4043],
1991             [0.3749, 0.3672],
1992             [0.3488, 0.3600],
1993             [0.4384, 0.4045],
1994             [0.3820, 0.3832],
1995             [0.3499, 0.3591],
1996             [0.3455, 0.3460],
1997             [0.3245, 0.3434],
1998             [0.4377, 0.4037],
1999             [0.3830, 0.3724],
2000             [0.3447, 0.3609],
2001             [0.3127, 0.3288]
2002             ];
2003             # xy data for FLx standards, from CIE "Colorimetry" 3rd edition Table T.7
2004             my $fltab = [
2005             [],
2006             [0.3131, 0.3371],
2007             [0.3721, 0.3751],
2008             [0.4091, 0.3941],
2009             [0.4402, 0.4031],
2010             [0.3138, 0.3452],
2011             [0.3779, 0.3882],
2012             [0.3129, 0.3292],
2013             [0.3458, 0.3586],
2014             [0.3741, 0.3727],
2015             [0.3458, 0.3588],
2016             [0.3805, 0.3769],
2017             [0.4370, 0.4042]
2018             ];
2019             # xy data for HPx standards, from CIE "Colorimetry" 3rd edition table T.9
2020             my $hptab = [
2021             [],
2022             [0.5330, 0.4150],
2023             [0.4778, 0.4158],
2024             [0.4302, 0.4075],
2025             [0.3812, 0.3797],
2026             [0.3776, 0.3713]
2027             ];
2028              
2029              
2030              
2031             =head2 PDL::Transform::Color::xyy_from_illuminant
2032              
2033             =for usage
2034              
2035             $xyy = PDL::Transform::Color::xyy_from_illuminant($name)
2036              
2037             =for ref
2038              
2039             This utility routine generates CIE xyY system colorimetric values for
2040             all of the standard CIE illuminants. The illuminants are looked up in
2041             a table populated from the CIE publication I, 3rd
2042             edition.
2043              
2044             The illuminant of a system is equivalent to its white point -- it is
2045             the location in xyY absolute colorimetric space that corresponds to
2046             "white".
2047              
2048             CIE recognizes many standard illuminants, and (as of 2017) is in the
2049             process of creating a new set -- the "L" series illuminants -- that is
2050             meant to represent LED lighting.
2051              
2052             Proper treatment of an illuminant requires a full spectral representation,
2053             which the CIE specifies for each illuminant. Analysis of that spectrum is
2054             a major part of what CIE calls "Color rendering index (CRI)" for a particular
2055             light source. PDL::Transform::Color is a strictly tri-coordinate system
2056             and does not handle the nuances of spectral effects on CRI. In effect,
2057             all illuminants are treated as having a CRI of unity (perfect).
2058              
2059             Illuminants that are understood are:
2060              
2061             =over 3
2062              
2063             =item * a 3-PDL in CIE xyY coordinates
2064              
2065             =item * a CIE standard name
2066              
2067             =back
2068              
2069             The CIE names are:
2070              
2071             =over 3
2072              
2073             =item A - a gas-filled tungsten filament lamp at 2856K
2074              
2075             =item B - not supported (deprecated by CIE)
2076              
2077             =item C - early daylight simulant, replaced by the D[n] sources
2078              
2079             =item D[n] - Blackbody radiation at 100[n] Kelvin (e.g. D65)
2080              
2081             =item F[n] - Fluorescent lights of various types (n=1-12 or 3.1-3.15)
2082              
2083             =item HP[n] - High Pressure discharge lamps (n=1-5)
2084              
2085             =item L[n] - LED lighting (not yet supported)
2086              
2087             =back
2088              
2089             =cut
2090              
2091             sub xyy_from_illuminant {
2092 24     24 1 54 my $name = shift;
2093 24 50       148 if(UNIVERSAL::isa($name,"PDL")) {
2094 0 0 0     0 if(($name->nelem==2 || $name->nelem==3) && $name->dim(0)==$name->nelem) {
      0        
2095 0         0 return $name;
2096             } else {
2097 0         0 die "xyy_from_illuminant: PDL must be a 2-PDL or a 3-PDL";
2098             }
2099             }
2100 24   50     104 my $u_opt = shift || {};
2101 24         111 my %opt = parse({
2102             Y=>1
2103             }, $u_opt);
2104 24 50       6594 if($name =~ m/^A/i) {
    50          
    100          
    100          
    50          
    0          
    0          
    0          
2105 0         0 return pdl(0.44758, 0.40745, $opt{Y});
2106             } elsif($name =~ m/^B/) {
2107 0         0 die "Illuminant B is not supported (deprecated by CIE)";
2108             } elsif($name =~ m/^C/) {
2109 1         6 return pdl(0.31006, 0.31616, $opt{Y});
2110             } elsif( $name =~ m/^D(.*)$/i) {
2111 22         73 return xyy_from_D($1,$u_opt);
2112             } elsif( $name =~ m/^E/i) {
2113 1         21 return pdl(0.33333,0.33333,$opt{Y});
2114             } elsif( $name =~ m/^FL?([\d+])(\.[\d])?$/i) {
2115 0         0 my $flno = $1+0;
2116 0         0 my $flsubno = $2+0;
2117 0 0 0     0 die "Illuminant $name not recognized (FL1-FL12, or FL3.1-FL3.15)"
      0        
      0        
      0        
2118             if($flno < 1 || $flno > 12 ||
2119             ($flsubno && $flno != 3) ||
2120             ($flsubno > 15)
2121             );
2122              
2123 0 0 0     0 if($flno==3 && $flsubno) {
2124 0         0 return pdl(@{$fl3tab->[$flsubno]},$opt{Y});
  0         0  
2125             } else {
2126 0         0 return pdl(@{$fltab->[$flno]},$opt{Y});
  0         0  
2127             }
2128             } elsif( $name =~ m/^HP?(\d)/i ) {
2129 0         0 my $hpno = $1+0;
2130 0 0 0     0 die "Unknown HP illuminant no. $hpno" if($hpno<1 || $hpno > 5);
2131 0         0 return pdl(@{$hptab->[$hpno]}, $opt{Y});
  0         0  
2132             } elsif( $name =~ m/^L/i) {
2133 0         0 die "Illuminant L is not (yet) supported";
2134             } else {
2135 0         0 die "Unknown illuminant $name";
2136             }
2137             }
2138              
2139              
2140             ##############################
2141             # Database of standard RGB color systems from Bruce Lindbloom
2142             # Make a database of xyY values of primaries, illuminants, and standard gammas for common RGB systems
2143             # Also stash matrices for converting those systems to lsRGB.
2144             #
2145             # Columns: gamma, illuminant, xyY for R (3 cols), xyY for G (3 cols), xyY for B (3 cols), abbrev char count
2146             our $rgbtab_src = {
2147             "Adobe" => [2.2, "D65", 0.6400, 0.3300, 0.297361, 0.2100, 0.7100, 0.627355, 0.1500, 0.0600, 0.075285, 2],
2148             "Apple" => [1.8, "D65", 0.6250, 0.3400, 0.244634, 0.2800, 0.5950, 0.672034, 0.1550, 0.0700, 0.083332, 2],
2149             "Best" => [2.2, "D50", 0.7347, 0.2653, 0.228457, 0.2150, 0.7750, 0.737352, 0.1300, 0.0350, 0.034191, 3],
2150             "Beta" => [2.2, "D50", 0.6888, 0.3112, 0.303273, 0.1986, 0.7551, 0.663786, 0.1265, 0.0352, 0.032941, 3],
2151             "Bruce" => [2.2, "D65", 0.6400, 0.3300, 0.240995, 0.2800, 0.6500, 0.683554, 0.1500, 0.0600, 0.075452, 2],
2152             "BT 601" => [2.2, "D65", 0.6300, 0.3400, 0.299000, 0.3100, 0.5950, 0.587000, 0.1550, 0.0700, 0.114000, 3],
2153             "BT 709" => [2.2, "D65", 0.6300, 0.3400, 0.212600, 0.3100, 0.5950, 0.715200, 0.1550, 0.0700, 0.072200, 3],
2154             "CIE" => [2.2, "E", 0.7350, 0.2650, 0.176204, 0.2740, 0.7170, 0.812985, 0.1670, 0.0090, 0.010811, 2],
2155             "ColorMatch" => [1.8, "D50", 0.6300, 0.3400, 0.274884, 0.2950, 0.6050, 0.658132, 0.1500, 0.0750, 0.066985, 2],
2156             "Don 4" => [2.2, "D50", 0.6960, 0.3000, 0.278350, 0.2150, 0.7650, 0.687970, 0.1300, 0.0350, 0.033680, 1],
2157             "ECI v2" => [1.0, "D50", 0.6700, 0.3300, 0.320250, 0.2100, 0.7100, 0.602071, 0.1400, 0.0800, 0.077679, 2],
2158             "Ekta PS5" => [2.2, "D50", 0.6950, 0.3050, 0.260629, 0.2600, 0.7000, 0.734946, 0.1100, 0.0050, 0.004425, 2],
2159             "NTSC" => [2.2, "C", 0.6700, 0.3300, 0.298839, 0.2100, 0.7100, 0.586811, 0.1400, 0.0800, 0.114350, 1],
2160             "PAL" => [2.2, "D65", 0.6400, 0.3300, 0.222021, 0.2900, 0.6000, 0.706645, 0.1500, 0.0600, 0.071334, 2],
2161             "ProPhoto" => [1.8, "D50", 0.7347, 0.2653, 0.288040, 0.1596, 0.8404, 0.711874, 0.0366, 0.0001, 0.000086, 2],
2162             "SMPTE-C" => [2.2, "D65", 0.6300, 0.3400, 0.212395, 0.3100, 0.5950, 0.701049, 0.1550, 0.0700, 0.086556, 2],
2163             "sRGB" => [2.2, "D65", 0.6400, 0.3300, 0.212656, 0.3000, 0.6000, 0.715158, 0.1500, 0.0600, 0.072186, 2],
2164             "wgRGB" => [2.2, "D50", 0.7350, 0.2650, 0.258187, 0.1150, 0.8260, 0.724938, 0.1570, 0.0180, 0.016875, 1]
2165             };
2166             $rgbtab_src->{SECAM} = $rgbtab_src->{PAL};
2167             $rgbtab_src->{ROMM} = $rgbtab_src->{ProPhoto};
2168              
2169             ##############################
2170             # RGB color systems in more code-approachable form. Parse the table to create hash refs by name, and an
2171             # abbrev table that allows abbreviated naming
2172             #
2173             our $rgbtab = {};
2174             our $rgb_abbrevs = {};
2175             for my $k(keys %$rgbtab_src) {
2176             my $v = $rgbtab_src->{$k};
2177             my $spec = $rgbtab->{$k} = {
2178             gamma => $v->[0],
2179             w_name => $v->[1],
2180             w => xyy_from_illuminant($v->[1]),
2181             r => pdl(@$v[2..4]),
2182             g => pdl(@$v[5..7]),
2183             b => pdl(@$v[8..10])
2184             };
2185             $spec->{white_point} = $spec->{w}->slice('0:1'); # PGCS: xy only
2186             my $str = $k;
2187             $str =~ tr/A-Z/a-z/;
2188             $str =~ s/\s\-//g;
2189             for my $i($v->[11]..length($str)){
2190             $rgb_abbrevs->{substr($str,0,$i)} = $k;
2191             }
2192             }
2193              
2194             # Gets an rgb descriptor hash from an input that might be a hash or a name.
2195             # If it's a hash, check to make sure it's copacetic.
2196              
2197             =head2 PDL::Transform::Color::get_rgb
2198              
2199             =for usage
2200              
2201             my $rgb_hash = get_rgb( $name );
2202              
2203             =for ref
2204              
2205             C is an internal routine that retrieves a set of
2206             RGB primary colors from an internal database. There are several named RGB systems,
2207             with different primary colors for each. The primary colors are represented as
2208             CIE xyY values in a returned hash ref.
2209              
2210             The return value is a hash ref with the following fields:
2211              
2212             =over 3
2213              
2214             =item gamma - the specified gamma of that RGB system (or 2.2, for sRGB)
2215              
2216             =item w_name - the name of the illuminant / white-point for that system
2217              
2218             =item w - the xyY value of the illuminant / white-point for that system
2219              
2220             =item r - the xyY value of the red primary color at unit intensity
2221              
2222             =item g - the xyY value of the green primary color at unit intensity
2223              
2224             =item b - the xyY value of the blue primary color at unit intensity
2225              
2226             =back
2227              
2228             As of 1.007, because this module now uses L
2229             for some calculations, the hash ref will also include fields used by
2230             that module.
2231              
2232             Recognized RGB system names are:
2233              
2234             =over 3
2235              
2236             =item Adobe - Adobe's 1998 RGB, intended to encompass nearly all of the CMYK gamut (gamma=2.2, white=D65)
2237              
2238             =item Apple - Apple's display standard from c. 1990 - c. 2010 (gamma=1.8, white=D65)
2239              
2240             =item Best - Wide-gamut RGB developed by Don Hutcheson (L) (gamma=2.2, white=D50)
2241              
2242             =item Beta - Bruce Lindbloom's optimized ultra-wide-gamut RGB (gamma=2.2, white=D50)
2243              
2244             =item Bruce - Bruce Fraser's conservative-gamut RGB space for 8-bit editing (gamma=2.2, white=D65)
2245              
2246             =item BT 601 - ITU-R standard BT.601 (used for MPEG & SDTV) (gamma=2.2, white=D65)
2247              
2248             =item BT 709 - ITU-R standard BT.709 (used for HDTV) (gamma=2.2, white=D65)
2249              
2250             =item CIE - CIE 1931 calibrated color space (based on physical emission lines) (gamma=2.2, white=E)
2251              
2252             =item ColorMatch - quasi-standard from c.1990 -- matches Radius Pressview CRT monitors. (gamma=1.8, white=D50)
2253              
2254             =item Don 4 - wide-gamut D50 working space gets the Ektachrome color gamut (gamma=2.2, white=D50)
2255              
2256             =item ECI v2 - RGB standard from the European Color Initiative (gamma=1, white=D50)
2257              
2258             =item Ekta PS5 - developed by Joseph Holms (L) for scanned Ektachrome slides (gamma=2.2, white=D50)
2259              
2260             =item NTSC - National Television System Committee (U.S. analog TV standard) (gamma=2.2, white=C)
2261              
2262             =item PAL - Phase Alternating Line (U.K. analog TV standard) (gamma = 2.2, white=D65)
2263              
2264             =item ProPhoto - Wide gamut from Kodak, designed for photo output. (gamma=1.8, white=D60)
2265              
2266             =item ROMM - Synonym for ProPhoto (gamma=1.8, white=D60)
2267              
2268             =item SECAM - Séquentiel de Couleur À Mémoire (French analog TV standard) (gamma=2.2, white=D65)
2269              
2270             =item SMPTE-C - Soc. Motion Pict. & TV Engineers (current U.S. TV standard) (gamma=2.2, white=D65)
2271              
2272             =item sRGB - Standard for consumer computer monitors (gamma~2.2, white=D65)
2273              
2274             =item wgRGB - Wide Gamut RGB (gamma=2.2, white=D50)
2275              
2276             =back
2277              
2278             =cut
2279              
2280             sub get_rgb {
2281 1     1 1 2 my $new_rgb = shift;
2282 1 50       4 if (ref $new_rgb eq 'HASH') {
2283 0         0 for my $k (qw/w r g b/) {
2284 0 0 0     0 die "Incorrect RGB primaries hash -- see docs" unless( defined($new_rgb->{$k}) and UNIVERSAL::isa($new_rgb->{$k},"PDL") and $new_rgb->{$k}->nelem==3 and $new_rgb->{$k}->dim(0)==3);
      0        
      0        
2285             }
2286 0         0 $new_rgb = { gamma=>1, %$new_rgb };
2287             $new_rgb->{white_point} = $new_rgb->{w}->slice('0:1') # PGCS: xy only
2288 0 0       0 if !exists $new_rgb->{white_point};
2289 0         0 return $new_rgb;
2290             }
2291 1 50       3 die "bad RGB specification -- see docs" if ref $new_rgb;
2292 1         4 $new_rgb=~tr/A-Z/a-z/; $new_rgb =~ s/\s\-//g;
  1         3  
2293             die join "\n\t","Unknown RGB system '$new_rgb'\nKnown ones are:", (sort keys %$rgbtab),""
2294 1 50       6 if !($new_rgb = $rgbtab->{$rgb_abbrevs->{$new_rgb}});
2295 1         10 return $new_rgb;
2296             }
2297              
2298             =head1 AUTHOR
2299              
2300             Copyright 2017, Craig DeForest (deforest@boulder.swri.edu). This
2301             module may be modified and distributed under the same terms as PDL
2302             itself. The module comes with NO WARRANTY.
2303              
2304             =cut
2305              
2306             1;