[cello-cvs] CVS cello/kt-opengl
fgoenninger
fgoenninger at common-lisp.net
Sat Sep 16 19:16:51 UTC 2006
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)
More information about the Cello-cvs
mailing list