basis/colors/xyy/xyy.factor

   1 ! Copyright (C) 2014 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors colors colors.xyz kernel math ;
   5
   6 IN: colors.xyy
   7
   8 TUPLE: xyYa x y Y alpha ;
   9
  10 C: <xyYa> xyYa
  11
  12 INSTANCE: xyYa color
  13
  14 M: xyYa >rgba
  15     >xyza >rgba ;
  16
  17 M: xyYa >xyza
  18     [
  19         [let
  20             [ x>> ] [ y>> ] [ Y>> ] tri :> ( x y Y )
  21             x y / Y *
  22             Y
  23             1 x - y - y / Y *
  24         ]
  25     ] [ alpha>> ] bi <xyza> ;
  26
  27 GENERIC: >xyYa ( color -- xyYa )
  28
  29 M: object >xyYa >xyza >xyYa ;
  30
  31 M: xyYa >xyYa ; inline
  32
  33 M: xyza >xyYa
  34     [
  35         [let
  36             [ x>> ] [ y>> ] [ z>> ] tri :> ( x y z )
  37             x y z + +
  38             [ x swap / ]
  39             [ y swap / ] bi
  40             y
  41         ]
  42     ] [ alpha>> ] bi <xyYa> ;