;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:          color.lisp
;;;; Purpose:       Functions for color
;;;; Programmer:    Kevin M. Rosenberg
;;;; Date Started:  Oct 2003
;;;;
;;;; $Id$
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
;;;;
;;;; KMRCL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************

(in-package kmrcl)

;; The HSV colour space has three coordinates: hue, saturation, and
;; value (sometimes called brighness) respectively. This colour system is
;; attributed to "Smith" around 1978 and used to be called the hexcone
;; colour model. The hue is an angle from 0 to 360 degrees, typically 0
;; is red, 60 degrees yellow, 120 degrees green, 180 degrees cyan, 240
;; degrees blue, and 300 degrees magenta. Saturation typically ranges
;; from 0 to 1 (sometimes 0 to 100%) and defines how grey the colour is,
;; 0 indicates grey and 1 is the pure primary colour. Value is similar to
;; luninance except it also varies the colour saturation. If the colour
;; space is represented by disks of varying lightness then the hue and
;; saturation are the equivalent to polar coordinates (r,theta) of any
;; point in the plane. The disks on the right show this for various
;; values.

(defun hsv->rgb (h s v) 
  (while (minusp h)
         (incf h 360))
  (while (> h 360)
         (decf h 360))

  (let (r g b)
    (cond
     ((< h 120)
      (setf r (/ (- 120 h) 60)
            g (/ h 60)
            b 0))
     ((< h 240)
      (setf r 0
            g (/ (- 240 h) 60)
            b (/ (- h 120) 60)))
     (t
      (setf r (/ (- h 240) 60)
            g 0
            b (/ (- 360 h) 60))))
    (setf r (min r 1)
          g (min g 1)
          b (min b 1))

    (values (* (+ 1 (* s r) (- s)) v)
            (* (+ 1 (* s g) (- s)) v)
            (* (+ 1 (* s b) (- s)) v))))


(defun rgb->hsv (r g b)

  (let* ((min (min r g b))
         (max (max r g b))
         (delta (- max min))
         (v max)
         (s 0)
         (h 0))

    (when (plusp max)
      (setq s (/ delta max)))

    (when (plusp delta)
      (when (and (= max r) (/= max g))
        (incf h (/ (- g b) delta)))
      (when (and (= max g) (/= max b))
        (incf h (+ 2 (/ (- b r) delta))))
      (when (and (= max b) (/= max r))
        (incf h (+ 4 (/ (- r g) delta))))
      (setq h (* 60 h)))

    (values h s v)))