PreviousUpNext

15.4.1443  src/lib/x-kit/xclient/pkg/color/hue-saturation-value.pkg

## hue-saturation-value.pkg
#
# HSV color representation.
#
# See also:
#     src/lib/x-kit/xclient/pkg/color/rgb.pkg
#     src/lib/x-kit/xclient/pkg/color/rgb8.pkg

# Compiled by:
#     src/lib/x-kit/xclient/xclient-internals.sublib



###         "I have never known any distress that an
###          hour's reading did not relieve."
###
###                             -- Charles Louis de Secondat,
###                                Baron de la Brede et de Montesquieu 



stipulate
    include rw_float_vector;                                                    # Enable   vec[i]   and   vec[i] := f   notations.
    #
    package f8b =  eight_byte_float;                                            # eight_byte_float              is from   src/lib/std/eight-byte-float.pkg
    package fv  =  rw_float_vector;                                             # rw_float_vector               is from   src/lib/std/rw-float-vector.pkg
herein


    package   hue_saturation_value
    :         Hue_Saturation_Value                                              # Hue_Saturation_Value          is from   src/lib/x-kit/xclient/pkg/color/hue-saturation-value.api
    {
        # We represent an HSV color value by a
        # packed 3-vector of 64-bit floats holding
        # hue, saturation, value in that order:
        # 
        Hsv = fv::Rw_Vector;                    # This should really be a read-only floatvector, but currently they are not actually a packed type -- See src/lib/std/src/vector-of-eight-byte-floats.pkg XXX BUGGO FIXME.
            #                                   # Since we export Hsv as an opaque type, the difference is not critical.
            # The above type was originally
            #
            #   Hsv = HSV { hue:          Float,
            #               saturation:   Float,
            #               value:        Float
            #             };
            #
            # which is fine when we are mainly
            # interested in thinking of the color
            # as a bag of components and are not
            # doing anything particularly compute-
            # intensive, but I'm interested in
            # treating colors as conceptually
            # atomic values used in ray-tracing
            # and similar compute-intensive
            # applications.
            #     In this context, a 3-vector of
            # floats is more time and space efficient:
            # we replace a root record plus three
            # boxed floats by a single vector record.
            #     This is also more compatible with
            # the OpenGL view of the world, which
            # is built around float vectors rather
            # than ML records.

        fun to_floats hsv
            =
            {   hue        = hsv[0];                                                    # Eventually we'll probably want to suppress index checking here for speed, using unsafe:: operations or whatever. XXX BUGGO FIXME.
                saturation = hsv[1];
                value      = hsv[2];

                { hue, saturation, value };
            };

        fun from_floats { hue, saturation, value }                                      # Should do some sort of validation (restriction to [0,1) interval). What exception should we throw? Or should we silently truncate?  XXX BUGGO FIXME.
            =
            {   hsv = fv::make_rw_vector (3, 0.0);

                hsv[0] := hue;                                                          # Eventually we'll probably want to suppress index checking here for speed, using unsafe:: operations or whatever. XXX BUGGO FIXME.
                hsv[1] := saturation;
                hsv[2] := value;

                hsv;
            };

        fun max (a:  Float, b) = if (a >= b) a; else b; fi;
        fun min (a:  Float, b) = if (a <= b) a; else b; fi;

        fun from_rgb rgb
            =
            {   (rgb::rgb_to_floats rgb)
                    ->
                    (realr, realg, realb);

                max_v = max (realr, max (realg, realb));
                min_v = min (realr, min (realg, realb));

                delta = max_v - min_v;

                if (f8b::(====) (delta, 0.0))
                    #                
                    from_floats { hue=>0.0, saturation=>0.0, value=>max_v };
                else 
                    saturation = delta // max_v;

                    rc = (max_v - realr)//delta;
                    gc = (max_v - realg)//delta;
                    bc = (max_v - realb)//delta;

                    h1 = if   (f8b::(====) (realr, max_v))         bc - gc;
                         elif (f8b::(====) (realg, max_v))   2.0 + rc - bc;
                         else 4.0 + gc - rc;
                         fi;
                    h2 = 60.0 * h1;                    #   Convert to degrees 

                    hue = if (h2 < 0.0)  h2 + 360.0; #  make nonnegative 
                          else           h2;
                          fi;

                    from_floats { hue, saturation, value=>max_v };
                fi;
            };

        fun to_rgb  hsv
            =
            {   (to_floats hsv)
                    ->
                    { hue, saturation, value };

                if (f8b::(====) (saturation, 0.0))
                    #
                    rgb::rgb_from_floats (value, value, value);
                else
                    h = if (f8b::(====) (hue, 360.0))  0.0;
                        else                           hue//60.0;
                        fi;

                    i = floor h;

                    ri = real i;
                    f = h - ri;

                    p = value*(1.0 -  saturation);
                    q = value*(1.0 - (saturation*f));
                    t = value*(1.0 - (saturation*(1.0 - f)));


                    case i
                        #
                        0 =>  rgb::rgb_from_floats (value, t, p);
                        1 =>  rgb::rgb_from_floats (q, value, p);
                        2 =>  rgb::rgb_from_floats (p, value, t);
                        3 =>  rgb::rgb_from_floats (p, q, value);
                        4 =>  rgb::rgb_from_floats (t, p, value);
                        _ =>  rgb::rgb_from_floats (value, p, q);
                    esac;
                fi;
            };

        fun from_name  colorname
            =
            from_rgb  (rgb::rgb_from_floats  (x11_color_name::to_floats  colorname));
    };
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext