1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
\r
2 ;;;; *************************************************************************
\r
3 ;;;; FILE IDENTIFICATION
\r
5 ;;;; Name: color.lisp
\r
6 ;;;; Purpose: Functions for color
\r
7 ;;;; Programmer: Kevin M. Rosenberg
\r
8 ;;;; Date Started: Oct 2003
\r
12 ;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
\r
14 ;;;; KMRCL users are granted the rights to distribute and use this software
\r
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
\r
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
\r
17 ;;;; *************************************************************************
\r
21 ;; The HSV colour space has three coordinates: hue, saturation, and
\r
22 ;; value (sometimes called brighness) respectively. This colour system is
\r
23 ;; attributed to "Smith" around 1978 and used to be called the hexcone
\r
24 ;; colour model. The hue is an angle from 0 to 360 degrees, typically 0
\r
25 ;; is red, 60 degrees yellow, 120 degrees green, 180 degrees cyan, 240
\r
26 ;; degrees blue, and 300 degrees magenta. Saturation typically ranges
\r
27 ;; from 0 to 1 (sometimes 0 to 100%) and defines how grey the colour is,
\r
28 ;; 0 indicates grey and 1 is the pure primary colour. Value is similar to
\r
29 ;; luninance except it also varies the colour saturation. If the colour
\r
30 ;; space is represented by disks of varying lightness then the hue and
\r
31 ;; saturation are the equivalent to polar coordinates (r,theta) of any
\r
32 ;; point in the plane. The disks on the right show this for various
\r
35 (defun hsv->rgb (h s v)
\r
44 (setf r (/ (- 120 h) 60)
\r
50 b (/ (- h 120) 60)))
\r
52 (setf r (/ (- h 240) 60)
\r
54 b (/ (- 360 h) 60))))
\r
59 (values (* (+ 1 (* s r) (- s)) v)
\r
60 (* (+ 1 (* s g) (- s)) v)
\r
61 (* (+ 1 (* s b) (- s)) v))))
\r
64 (defun rgb->hsv (r g b)
\r
66 (let* ((min (min r g b))
\r
74 (setq s (/ delta max)))
\r
77 (when (and (= max r) (/= max g))
\r
78 (incf h (/ (- g b) delta)))
\r
79 (when (and (= max g) (/= max b))
\r
80 (incf h (+ 2 (/ (- b r) delta))))
\r
81 (when (and (= max b) (/= max r))
\r
82 (incf h (+ 4 (/ (- r g) delta))))
\r