CMC-l:c ( color1 color2 -- distance )

Vocabulary

colors.distances

Inputs

color1	an object
color2	an object

Outputs

distance

an object

Definition

USING: accessors colors.distances.private colors.lab colors.lch
kernel math math.functions math.order ;

IN: colors.distances

:: CMC-l:c ( color1 color2 -- distance )
    color1 >laba :> lab1 color2 >laba :> lab2 lab1 lab2
    [ a>> ] bi@ :> ( a1 a2 ) lab1 lab2 [ b>> ] bi@
    :> ( b1 b2 ) color1 >LCHab :> lch1 color2 >LCHab :> lch2
    lch1 lch2 [ l>> ] bi@ :> ( l1 l2 ) lch1 lch2 [ c>> ] bi@
    :> ( c1 c2 ) lch1 lch2 [ h>> ] bi@ :> ( h1 h2 ) a2 a1 -
    :> da b2 b1 - :> db c2 c1 - :> dc l2 l1 -
    :> dl da sq db sq + dc sq - sqrt :> dh l1 16 <
    [ 0.511 ] [ l1 [ 0.040975 * ] [ 0.01765 * 1 + ] bi / ] if
    :> sl c1 [ 0.0638 * ] [ 0.0131 * 1 + ] bi / 0.638 +
    :> sc c1 4 ^ dup 1900 + / sqrt :> F h1 164 345 between?
    [ h1 168 + cosd 0.2 * abs 0.56 + ]
    [ h1 35 + cosd 0.4 * abs 0.36 + ] if :> T F T * 1 ~29 more~
    ;