Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv26676

Added Files: colors.lisp Log Message: 1st check-in.

--- /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/16 19:16:51 NONE +++ /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/16 19:16:51 1.1 ;;; -*- mode: Lisp; Syntax: Common-Lisp; Package: kt-opengl; -*- ;;; ;;; Copyright © 2006 by Frank Goenninger, Bempflingen, Germany ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a ;;; copy of this software and associated documentation files (the "Software"), ;;; to deal with the Software without restriction, including without limitation ;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, ;;; and/or sell copies of the Software, and to permit persons to whom the ;;; Software is furnished to do so, subject to the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be included in ;;; all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE. ;;; ;;; $Id: colors.lisp,v 1.1 2006/09/16 19:16:51 fgoenninger Exp $

(in-package #:kt-opengl)

;;; =========================================================================== ;;; Utilities / Helper functions and macros ;;; ===========================================================================

;;; --------------------------------------------------------------------------- ;;; RGB-2-OGL-COLOR3FV - Convert RGB values to float vector FUNCTION ;;; --------------------------------------------------------------------------- ;;; Status: RELEASED

(eval-when (:compile-toplevel :load-toplevel :execute) (defun rgb-2-ogl-color3fv (r g b) (vector (coerce (/ r 255) 'float) (coerce (/ g 255) 'float) (coerce (/ b 255) 'float))))

;;; --------------------------------------------------------------------------- ;;; DEFINE-OGL-RGB-COLOR MACRO ;;; --------------------------------------------------------------------------- ;;; ;;; Allocates foreign memory to hold a vector of 3 floats to accomodate ;;; the RGB values of the color. Exports the name of the color as symbol. ;;; ;;; Status: RELEASED

(defmacro define-ogl-rgb-color (color-name red green blue) `(progn (defparameter ,color-name (foreign-alloc :float :initial-contents (rgb-2-ogl-color3fv ,red ,green ,blue))) (utils-kt::export! ,color-name)))

;;; --------------------------------------------------------------------------- ;;; SET-COLOR FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Takes a color defined by define-ogl-rgb-color and calls gl-color3fv to ;;; set the color. ;;; ;;; Status: RELEASED

(defun set-color (color-as-foreign-vector) (gl-color3fv color-as-foreign-vector))

;;; --------------------------------------------------------------------------- ;;; OGL-RGB-COLOR-2-RGBA-RED FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Return the RED color float value of a color defined by ;;; define-ogl-rgb-color. ;;; ;;; Status: RELEASED

(defun ogl-rgb-color-2-rgba-red (color-as-foreign-vector) (mem-aref color-as-foreign-vector :float 0))

;;; --------------------------------------------------------------------------- ;;; OGL-RGB-COLOR-2-RGBA-GREEN FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Return the GREEN color float value of a color defined by ;;; define-ogl-rgb-color. ;;; ;;; Status: RELEASED

(defun ogl-rgb-color-2-rgba-green (color-as-foreign-vector) (mem-aref color-as-foreign-vector :float 1))

;;; --------------------------------------------------------------------------- ;;; OGL-RGB-COLOR-2-RGBA-BLUE FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Return the BLUE color float value of a color defined by ;;; define-ogl-rgb-color. ;;; ;;; Status: RELEASED

(defun ogl-rgb-color-2-rgba-blue (color-as-foreign-vector) (mem-aref color-as-foreign-vector :float 2))

;;; --------------------------------------------------------------------------- ;;; OGL-RGB-COLOR-2-RGBA-ALPHA FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Return the ALPHA color float value of a color defined by ;;; define-ogl-rgb-color. ;;; ;;; Status: RELEASED

(defun ogl-rgb-color-2-rgba-alpha (color-as-foreign-vector) (declare (ignore color-as-foreign-vector)) 0.0f0)

;;; --------------------------------------------------------------------------- ;;; SET-CLEAR-COLOR FUNCTION ;;; --------------------------------------------------------------------------- ;;; ;;; Set the clear color, taking a color defined by define-ogl-rgb-color as ;;; parameter. ;;; ;;; Status: RELEASED

(defun set-clear-color (color-as-foreign-vector) (gl-clear-color (ogl-rgb-color-2-rgba-red color-as-foreign-vector) (ogl-rgb-color-2-rgba-green color-as-foreign-vector) (ogl-rgb-color-2-rgba-blue color-as-foreign-vector) (ogl-rgb-color-2-rgba-alpha color-as-foreign-vector)))

;;; --------------------------------------------------------------------------- ;;; EXPORT SYMBOLS ;;; ---------------------------------------------------------------------------

(utils-kt::export! set-color set-clear-color ogl-rgb-color-2-rgba-red ogl-rgb-color-2-rgba-green ogl-rgb-color-2-rgba-blue ogl-rgb-color-2-rgba-alpha)

;;; =========================================================================== ;;; Color definitions ;;; ===========================================================================

;;; RGB simple colors

(define-ogl-rgb-color RED 255 0 0) (define-ogl-rgb-color GREEN 0 255 0) (define-ogl-rgb-color BLUE 0 0 255)

;;; PANTONE colors as defined by graphics design s/w Art Director's Toolkit V.5

;;; PANTONE SOLID COATED

(define-ogl-rgb-color PANTONE-YELLOW-C 254 223 0) (define-ogl-rgb-color PANTONE-YELLOW-012-C 255 213 0) (define-ogl-rgb-color PANTONE-ORANGE-021-C 255 88 0) (define-ogl-rgb-color PANTONE-WARM-RED-C 247 64 58) (define-ogl-rgb-color PANTONE-RED-032-C 237 41 57) (define-ogl-rgb-color PANTONE-RUBIN-RED-C 202 0 93) (define-ogl-rgb-color PANTONE-RHODAMINE-RED-C 224 17 157) (define-ogl-rgb-color PANTONE-PURPLE-C 182 52 187) (define-ogl-rgb-color PANTONE-VIOLET-C 75 8 161) (define-ogl-rgb-color PANTONE-BLUE-072-C 0 24 168) (define-ogl-rgb-color PANTONE-REFLEX-BLUE-C 0 35 149) (define-ogl-rgb-color PANTONE-PROCESS-BLUE-C 0 136 206) (define-ogl-rgb-color PANTONE-GREEN-C 0 173 131) (define-ogl-rgb-color PANTONE-BLACK-C 42 38 35)

(define-ogl-rgb-color PANTONE-PROCESS-YELLOW-C 249 227 0) (define-ogl-rgb-color PANTONE-PROCESS-MAGENTA-C 209 0 116) (define-ogl-rgb-color PANTONE-PROCESS-CYAN-C 0 159 218) (define-ogl-rgb-color PANTONE-PROCESS-BLACK-C 30 30 30)

(define-ogl-rgb-color PANTONE-HEXACHROME-YELLOW-C 255 224 0) (define-ogl-rgb-color PANTONE-HEXACHROME-ORANGE-C 255 124 0) (define-ogl-rgb-color PANTONE-HEXACHROME-MAGENTA-C 222 0 144) (define-ogl-rgb-color PANTONE-HEXACHROME-CYAN-C 0 143 208) (define-ogl-rgb-color PANTONE-HEXACHROME-GREEN-C 0 176 74) (define-ogl-rgb-color PANTONE-HEXACHROME-BLACK-C 32 33 33)

(define-ogl-rgb-color PANTONE-100-C 243 236 122) (define-ogl-rgb-color PANTONE-101-C 245 236 90) (define-ogl-rgb-color PANTONE-102-C 250 231 0) (define-ogl-rgb-color PANTONE-103-C 198 172 0) (define-ogl-rgb-color PANTONE-104-C 174 154 0) (define-ogl-rgb-color PANTONE-105-C 134 122 36)

;;; PANTONE SOLID UNCOATED

(define-ogl-rgb-color PANTONE-YELLOW-U 255 230 0) (define-ogl-rgb-color PANTONE-YELLOW-012-U 255 218 0) (define-ogl-rgb-color PANTONE-ORANGE-021-U 255 115 12) (define-ogl-rgb-color PANTONE-WARM-RED-U 254 97 92) (define-ogl-rgb-color PANTONE-RED-032-U 243 85 98) (define-ogl-rgb-color PANTONE-RUBIN-RED-U 212 72 126) (define-ogl-rgb-color PANTONE-RHODAMINE-RED-U 227 81 162) (define-ogl-rgb-color PANTONE-PURPLE-U 189 85 187) (define-ogl-rgb-color PANTONE-VIOLET-U 117 87 177) (define-ogl-rgb-color PANTONE-BLUE-072-U 57 69 166) (define-ogl-rgb-color PANTONE-REFLEX-BLUE-U 53 71 147) (define-ogl-rgb-color PANTONE-PROCESS-BLUE-U 0 131 197) (define-ogl-rgb-color PANTONE-GREEN-U 0 170 135) (define-ogl-rgb-color PANTONE-BLACK-U 96 91 85)

(define-ogl-rgb-color PANTONE-PROCESS-YELLOW-U 250 230 35) (define-ogl-rgb-color PANTONE-PROCESS-MAGENTA-U 215 77 132) (define-ogl-rgb-color PANTONE-PROCESS-CYAN-U 0 159 214) (define-ogl-rgb-color PANTONE-PROCESS-BLACK-U 85 81 80)

(define-ogl-rgb-color PANTONE-HEXACHROME-YELLOW-U 255 226 16) (define-ogl-rgb-color PANTONE-HEXACHROME-ORANGE-U 255 126 56) (define-ogl-rgb-color PANTONE-HEXACHROME-MAGENTA-U 223 62 145) (define-ogl-rgb-color PANTONE-HEXACHROME-CYAN-U 0 151 209) (define-ogl-rgb-color PANTONE-HEXACHROME-GREEN-U 0 177 102) (define-ogl-rgb-color PANTONE-HEXACHROME-BLACK-U 82 79 77)

(define-ogl-rgb-color PANTONE-100-U 250 239 119) (define-ogl-rgb-color PANTONE-101-U 253 239 103) (define-ogl-rgb-color PANTONE-102-U 255 235 51) (define-ogl-rgb-color PANTONE-103-U 184 163 42) (define-ogl-rgb-color PANTONE-104-U 153 139 57) (define-ogl-rgb-color PANTONE-105-U 129 122 73) (define-ogl-rgb-color PANTONE-106-U 255 234 100) (define-ogl-rgb-color PANTONE-107-U 255 229 82)