basis/colors/hwb/hwb.factor

   1 ! Copyright (C) 2022 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors colors colors.gray colors.hsl combinators
   5 kernel math math.order ;
   6
   7 IN: colors.hwb
   8
   9 TUPLE: hwba
  10 { hue read-only }
  11 { whiteness read-only }
  12 { blackness read-only }
  13 { alpha read-only } ;
  14
  15 C: <hwba> hwba
  16
  17 INSTANCE: hwba color
  18
  19 M: hwba >rgba
  20     [let
  21         {
  22             [ hue>> ] [ whiteness>> ] [ blackness>> ] [ alpha>> ]
  23         } cleave :> ( h w b a )
  24
  25         w b + :> w+b
  26
  27         w+b 1 >= [
  28             w w+b / a <gray>
  29         ] [
  30             h 1.0 0.5 a <hsla> >rgba-components
  31             [ [ 1 w+b - * w + ] tri@ ] dip <rgba>
  32         ] if
  33     ] ; inline
  34
  35 GENERIC: >hwba ( color -- hsla )
  36
  37 M: object >hwba >rgba >hwba ;
  38
  39 M: hwba >hwba ; inline
  40
  41 M: rgba >hwba
  42     [let
  43         >hsla [ hue>> ] [ >rgba-components ] bi :> ( h r g b a )
  44         r g b min min :> w
  45         r g b max max 1 swap - :> b
  46         h w b a <hwba>
  47     ] ;