basis/colors/xyz/xyz.factor

   1 ! Copyright (C) 2014 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors colors kernel math math.functions
   5 math.order ;
   6
   7 IN: colors.xyz
   8
   9 TUPLE: xyza x y z alpha ;
  10
  11 C: <xyza> xyza
  12
  13 INSTANCE: xyza color
  14
  15 <PRIVATE
  16
  17 CONSTANT: xyz_epsilon 216/24389
  18 CONSTANT: xyz_kappa 24389/27
  19
  20 CONSTANT: wp_x 0.95047
  21 CONSTANT: wp_y 1.00000
  22 CONSTANT: wp_z 1.08883
  23
  24 : srgb-compand ( v -- v' )
  25     dup 0.0031308 <= [ 12.92 * ] [ 2.4 recip ^ 1.055 * 0.055 - ] if ;
  26
  27 PRIVATE>
  28
  29 M: xyza >rgba
  30     [
  31         [let
  32             [ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
  33             x 3.2404542 * y -1.5371385 * z -0.4985314 * + +
  34             x -0.9692660 * y 1.8760108 * z 0.0415560 * + +
  35             x 0.0556434 * y -0.2040259 * z 1.0572252 * + +
  36             [ srgb-compand 0.0 1.0 clamp ] tri@
  37         ]
  38     ] [ alpha>> ] bi <rgba> ;
  39
  40 GENERIC: >xyza ( color -- xyza )
  41
  42 M: object >xyza >rgba >xyza ;
  43
  44 M: xyza >xyza ; inline
  45
  46 <PRIVATE
  47
  48 : invert-rgb-compand ( v -- v' )
  49     dup 0.04045 <= [ 12.92 / ] [ 0.055 + 1.055 / 2.4 ^ ] if ;
  50
  51 PRIVATE>
  52
  53 M: rgba >xyza
  54     [
  55         [let
  56             [ red>> ] [ green>> ] [ blue>> ] tri
  57             [ invert-rgb-compand ] tri@ :> ( r g b )
  58             r 0.4124564 * g 0.3575761 * b 0.1804375 * + +
  59             r 0.2126729 * g 0.7151522 * b 0.0721750 * + +
  60             r 0.0193339 * g 0.1191920 * b 0.9503041 * + +
  61         ]
  62     ] [ alpha>> ] bi <xyza> ;