Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9145
Modified Files: colors.lisp Log Message: Added: Color API moved from cello/colors.lisp to this file. So colors are now part of the kt-opengl package.
--- /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/17 20:06:54 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/19 11:27:07 1.3 @@ -1,6 +1,6 @@ ;;; -*- mode: Lisp; Syntax: Common-Lisp; Package: kt-opengl; -*- ;;; -;;; Copyright © 2006 by Frank Goenninger, Bempflingen, Germany +;;; Copyright © 2006 by Kenneth William Tilton ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining a ;;; copy of this software and associated documentation files (the "Software"), @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE. ;;; -;;; $Id: colors.lisp,v 1.2 2006/09/17 20:06:54 fgoenninger Exp $ +;;; $Id: colors.lisp,v 1.3 2006/09/19 11:27:07 fgoenninger Exp $
(in-package #:kt-opengl)
@@ -28,40 +28,108 @@ ;;; Data Definitions ;;; ===========================================================================
-(defstruct rgba-color r g b a) +(defstruct rgb ;;/// just use ogl native struct? + (r 0 ) + (g 0 ) + (b 0 )) + +(defstruct rgba (r 0.0f0) + (g 0.0f0) + (b 0.0f0) + (a 1.0f0) + (fo 0) ;; fo = foreign ptr address + (id nil)) + +(defparameter *known-colors* '() + "Known colors, safed as cons of color-name and rgba-color struct.")
;;; =========================================================================== ;;; Utilities / Helper functions and macros ;;; ===========================================================================
;;; --------------------------------------------------------------------------- -;;; RGB-2-OGL-COLOR3FV - Convert RGB values to float vector FUNCTION +;;; MK-RGBA FUNCTION ;;; --------------------------------------------------------------------------- +;;; +;;; Make up a struct to hold RGBA information. +;;; Allocates foreign memory to hold a vector of 4 floats to accomodate +;;; the RGBA values of the color. +;;; +;;; Status: RELEASED + +(defun mk-rgba (red green blue alpha &optional id) + (let* ((color-4fv-ptr (foreign-alloc :float :count 4)) + (color-rgba-struct (make-rgba + :r (/ red 255.0f0) + :g (/ green 255.0f0) + :b (/ blue 255.0f0) + :a (/ alpha 255.0f0) + :fo color-4fv-ptr))) + (setf (mem-aref color-4fv-ptr :float 0) + (rgba-r color-rgba-struct)) + (setf (mem-aref color-4fv-ptr :float 1) + (rgba-g color-rgba-struct)) + (setf (mem-aref color-4fv-ptr :float 2) + (rgba-b color-rgba-struct)) + (setf (mem-aref color-4fv-ptr :float 3) + (rgba-a color-rgba-struct)) + (when id + (setf (rgba-id color-rgba-struct) id)) + color-rgba-struct)) + +;;; --------------------------------------------------------------------------- +;;; DEFINE-OGL-RGBA-COLOR MACRO +;;; --------------------------------------------------------------------------- +;;; +;;; Define a constant that holds a RGBA struct with the color information. +;;; Also add the color to the list of known colors (special var *known- +;;; color*) and export the symbol. +;;; ;;; Status: RELEASED
-(eval-when (:compile-toplevel :load-toplevel :execute) - (defun rgba-2-ogl-color4f (r g b a) - (values (coerce (/ r 255) 'float) - (coerce (/ g 255) 'float) - (coerce (/ b 255) 'float) - (coerce (/ a 255) 'float)))) +(defmacro define-ogl-rgba-color (color-name red green blue alpha) + `(let ((rgba-color (mk-rgba ,red ,green ,blue ,alpha ',color-name))) + (prog1 + (defconstant ,color-name rgba-color) + (pushnew rgba-color *known-colors*) + (utils-kt::export! ,color-name))))
;;; --------------------------------------------------------------------------- -;;; DEFINE-OGL-RGB-COLOR MACRO +;;; PRINT-OBJECT for RGBA METHOD ;;; --------------------------------------------------------------------------- ;;; -;;; 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-rgba-color (color-name red green blue alpha) - `(prog1 - (defconstant ,color-name - (multiple-value-bind (r g b a) - (rgba-2-ogl-color4f ,red ,green ,blue ,alpha) - (make-rgba-color :r r :g g :b b :a a))) - (utils-kt::export! ,color-name))) +(defmethod print-object ((self rgba) stream) + (format stream + "#<RGBA-COLOR ~A * R: ~A G: ~A B: ~A A: ~A @ FGN-PTR-ADDR: 0x~X>" + (rgba-id self) + (rgba-r self) + (rgba-g self) + (rgba-b self) + (rgba-a self) + (rgba-fo self))) + +;;; Some helper functions + +(defun wrap-rgba (rgba-foreign) + (make-rgba :fo rgba-foreign)) + +(defun make-opengl-rgba (r g b a) + (let* ((co (fgn-alloc :float 4 :make-opengl-rgba)) + (c (make-rgba :fo co))) + (setf (cffi:mem-aref co :float 0) (* 1.0 r)) + (setf (cffi:mem-aref co :float 1) (* 1.0 g)) + (setf (cffi:mem-aref co :float 2) (* 1.0 b)) + (setf (cffi:mem-aref co :float 3) (* 1.0 a)) + c)) + +(defun rgba-clear-color (rgba &aux (co (rgba-fo rgba))) + (gl-clear-color + (cffi:mem-aref co :float 0) + (cffi:mem-aref co :float 1) + (cffi:mem-aref co :float 2) + (cffi:mem-aref co :float 3)))
;;; --------------------------------------------------------------------------- ;;; SET-COLOR FUNCTION @@ -72,14 +140,14 @@ ;;; ;;; Status: RELEASED
-(defun set-color (rgba-color) - #+doesnotwork (gl-color4f (rgba-color-r rgba-color) - (rgba-color-g rgba-color) - (rgba-color-b rgba-color) - (rgba-color-a rgba-color)) - (gl-color3f (rgba-color-r rgba-color) - (rgba-color-g rgba-color) - (rgba-color-b rgba-color)) +(defun set-color (rgba) + #+doesnotwork (gl-color4f (rgba-r rgba) + (rgba-g rgba) + (rgba-b rgba) + (rgba-a rgba)) + (gl-color3f (rgba-r rgba) + (rgba-g rgba) + (rgba-b rgba)) )
;;; --------------------------------------------------------------------------- @@ -91,11 +159,11 @@ ;;; ;;; Status: RELEASED
-(defun set-clear-color (rgba-color) - (gl-clear-color (rgba-color-r rgba-color) - (rgba-color-g rgba-color) - (rgba-color-b rgba-color) - (rgba-color-a rgba-color))) +(defun set-clear-color (rgba) + (gl-clear-color (rgba-r rgba) + (rgba-g rgba) + (rgba-b rgba) + (rgba-a rgba)))
;;; --------------------------------------------------------------------------- ;;; WITH-COLOR MACRO @@ -106,13 +174,13 @@ ;;; ;;; Status: RELEASED
-(defmacro with-color (rgba-color &body body) +(defmacro with-color (rgba &body body) (let ((ptr (gensym))) `(with-foreign-object (,ptr 'glint 4) (gl-get-integerv GL_CURRENT_COLOR ,ptr) (unwind-protect (progn - (set-color ,rgba-color) + (set-color ,rgba) ,@body) (glcolor4i (mem-aref ,ptr 'glint 0) (mem-aref ,ptr 'glint 1) @@ -127,8 +195,19 @@ set-color set-clear-color define-ogl-rgba-color - rgba-color - with-color) + rgba-r + rgba-g + rgba-g + rgba-a + rgba-id + rgba-fo + make-rgba + with-color + wrap-rgba + make-opengl-rgba + rgba-clear-color + *known-colors* + )
;;; =========================================================================== ;;; Color definitions @@ -136,193 +215,171 @@
;;; RGBA simple colors
-(define-ogl-rgba-color RED 255 0 0 1) -(define-ogl-rgba-color GREEN 0 255 0 1) -(define-ogl-rgba-color BLUE 0 0 255 1) -(define-ogl-rgba-color BLACK 0 0 0 1) +(define-ogl-rgba-color +RED+ 255 0 0 255) +(define-ogl-rgba-color +GREEN+ 0 255 0 255) +(define-ogl-rgba-color +BLUE+ 0 0 255 255) + +(define-ogl-rgba-color +WHITE+ 0 0 0 255) +(define-ogl-rgba-color +BLACK+ 0 0 0 255) +(define-ogl-rgba-color +GRAY+ 128 128 128 255) +(define-ogl-rgba-color +TURQUOISE+ 0 255 255 255) +(define-ogl-rgba-color +PURPLE+ 255 0 255 255) + +(define-ogl-rgba-color +DARK-GREEN+ 0 128 0 255) +(define-ogl-rgba-color +DARK-BLUE+ 0 0 64 50) +(define-ogl-rgba-color +DARK-GRAY+ 64 64 64 255) +(define-ogl-rgba-color +DK-GRAY+ 64 64 64 255) + +(define-ogl-rgba-color +LIGHT-BLUE+ 127 127 255 255) +(define-ogl-rgba-color +LIGHT-YELLOW+ 255 255 127 255) +(define-ogl-rgba-color +LIGHT-GRAY+ 192 192 192 255) +(define-ogl-rgba-color +LT-GRAY+ 192 192 192 255)
;;; PANTONE colors as defined by graphics design s/w Art Director's Toolkit V.5
;;; PANTONE SOLID COATED
-(define-ogl-rgba-color PANTONE-YELLOW-C 254 223 0 1) -(define-ogl-rgba-color PANTONE-YELLOW-012-C 255 213 0 1) -(define-ogl-rgba-color PANTONE-ORANGE-021-C 255 88 0 1) -(define-ogl-rgba-color PANTONE-WARM-RED-C 247 64 58 1) -(define-ogl-rgba-color PANTONE-RED-032-C 237 41 57 1) -(define-ogl-rgba-color PANTONE-RUBIN-RED-C 202 0 93 1) -(define-ogl-rgba-color PANTONE-RHODAMINE-RED-C 224 17 157 1) -(define-ogl-rgba-color PANTONE-PURPLE-C 182 52 187 1) -(define-ogl-rgba-color PANTONE-VIOLET-C 75 8 161 1) -(define-ogl-rgba-color PANTONE-BLUE-072-C 0 24 168 1) -(define-ogl-rgba-color PANTONE-REFLEX-BLUE-C 0 35 149 1) -(define-ogl-rgba-color PANTONE-PROCESS-BLUE-C 0 136 206 1) -(define-ogl-rgba-color PANTONE-GREEN-C 0 173 131 1) -(define-ogl-rgba-color PANTONE-BLACK-C 42 38 35 1) - -(define-ogl-rgba-color PANTONE-PROCESS-YELLOW-C 249 227 0 1) -(define-ogl-rgba-color PANTONE-PROCESS-MAGENTA-C 209 0 116 1) -(define-ogl-rgba-color PANTONE-PROCESS-CYAN-C 0 159 218 1) -(define-ogl-rgba-color PANTONE-PROCESS-BLACK-C 30 30 30 1) - -(define-ogl-rgba-color PANTONE-HEXACHROME-YELLOW-C 255 224 0 1) -(define-ogl-rgba-color PANTONE-HEXACHROME-ORANGE-C 255 124 0 1) -(define-ogl-rgba-color PANTONE-HEXACHROME-MAGENTA-C 222 0 144 1) -(define-ogl-rgba-color PANTONE-HEXACHROME-CYAN-C 0 143 208 1) -(define-ogl-rgba-color PANTONE-HEXACHROME-GREEN-C 0 176 74 1) -(define-ogl-rgba-color PANTONE-HEXACHROME-BLACK-C 32 33 33 1) - -(define-ogl-rgba-color PANTONE-100-C 243 236 122 1) -(define-ogl-rgba-color PANTONE-101-C 245 236 90 1) -(define-ogl-rgba-color PANTONE-102-C 250 231 0 1) -(define-ogl-rgba-color PANTONE-103-C 198 172 0 1) -(define-ogl-rgba-color PANTONE-104-C 174 154 0 1) -(define-ogl-rgba-color PANTONE-105-C 134 122 36 1) - -(define-ogl-rgba-color PANTONE-400-C 203 199 191 1) -(define-ogl-rgba-color PANTONE-401-C 182 177 169 1) -(define-ogl-rgba-color PANTONE-402-C 169 163 155 1) -(define-ogl-rgba-color PANTONE-403-C 146 139 129 1) -(define-ogl-rgba-color PANTONE-404-C 119 111 101 1) -(define-ogl-rgba-color PANTONE-405-C 95 87 79 1) -(define-ogl-rgba-color PANTONE-406-C 205 198 192 1) -(define-ogl-rgba-color PANTONE-407-C 181 172 166 1) -(define-ogl-rgba-color PANTONE-408-C 162 151 145 1) -(define-ogl-rgba-color PANTONE-409-C 141 129 123 1) -(define-ogl-rgba-color PANTONE-410-C 118 106 101 1) - -(define-ogl-rgba-color PANTONE-WARM-GRAY-1-C 224 222 216 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-2-C 213 210 202 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-3-C 199 194 186 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-4-C 183 177 169 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-5-C 174 167 159 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-6-C 165 157 149 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-7-C 152 143 134 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-8-C 139 129 120 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-9-C 130 120 111 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-10-C 118 106 98 1) -(define-ogl-rgba-color PANTONE-WARM-GRAY-11-C 103 92 83 1) - -(define-ogl-rgba-color PANTONE-COOL-GRAY-1-C 224 225 221 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-2-C 213 214 210 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-3-C 201 202 200 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-4-C 188 189 188 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-5-C 178 180 179 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-6-C 173 175 175 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-7-C 154 155 156 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-8-C 139 141 142 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-9-C 116 118 120 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-10-C 97 99 101 1) -(define-ogl-rgba-color PANTONE-COOL-GRAY-11-C 77 79 83 1) +(define-ogl-rgba-color +PANTONE-YELLOW-C+ 254 223 0 255) +(define-ogl-rgba-color +PANTONE-YELLOW-012-C+ 255 213 0 255) +(define-ogl-rgba-color +PANTONE-ORANGE-021-C+ 255 88 0 255) +(define-ogl-rgba-color +PANTONE-WARM-RED-C+ 247 64 58 255) +(define-ogl-rgba-color +PANTONE-RED-032-C+ 237 41 57 255) +(define-ogl-rgba-color +PANTONE-RUBIN-RED-C+ 202 0 93 255) +(define-ogl-rgba-color +PANTONE-RHODAMINE-RED-C+ 224 17 157 255) +(define-ogl-rgba-color +PANTONE-PURPLE-C+ 182 52 187 255) +(define-ogl-rgba-color +PANTONE-VIOLET-C+ 75 8 161 255) +(define-ogl-rgba-color +PANTONE-BLUE-072-C+ 0 24 168 255) +(define-ogl-rgba-color +PANTONE-REFLEX-BLUE-C+ 0 35 149 255) +(define-ogl-rgba-color +PANTONE-PROCESS-BLUE-C+ 0 136 206 255) +(define-ogl-rgba-color +PANTONE-GREEN-C+ 0 173 131 255) +(define-ogl-rgba-color +PANTONE-BLACK-C+ 42 38 35 255) + +(define-ogl-rgba-color +PANTONE-PROCESS-YELLOW-C+ 249 227 0 255) +(define-ogl-rgba-color +PANTONE-PROCESS-MAGENTA-C+ 209 0 116 255) +(define-ogl-rgba-color +PANTONE-PROCESS-CYAN-C+ 0 159 218 255) +(define-ogl-rgba-color +PANTONE-PROCESS-BLACK-C+ 30 30 30 255) + +(define-ogl-rgba-color +PANTONE-HEXACHROME-YELLOW-C+ 255 224 0 255) +(define-ogl-rgba-color +PANTONE-HEXACHROME-ORANGE-C+ 255 124 0 255) +(define-ogl-rgba-color +PANTONE-HEXACHROME-MAGENTA-C+ 222 0 144 255) +(define-ogl-rgba-color +PANTONE-HEXACHROME-CYAN-C+ 0 143 208 255) +(define-ogl-rgba-color +PANTONE-HEXACHROME-GREEN-C+ 0 176 74 255) +(define-ogl-rgba-color +PANTONE-HEXACHROME-BLACK-C+ 32 33 33 255) + +(define-ogl-rgba-color +PANTONE-100-C+ 243 236 122 255) +(define-ogl-rgba-color +PANTONE-101-C+ 245 236 90 255) +(define-ogl-rgba-color +PANTONE-102-C+ 250 231 0 255) +(define-ogl-rgba-color +PANTONE-103-C+ 198 172 0 255) +(define-ogl-rgba-color +PANTONE-104-C+ 174 154 0 255) +(define-ogl-rgba-color +PANTONE-105-C+ 134 122 36 255) + +(define-ogl-rgba-color +PANTONE-400-C+ 203 199 191 255) +(define-ogl-rgba-color +PANTONE-401-C+ 182 177 169 255) +(define-ogl-rgba-color +PANTONE-402-C+ 169 163 155 255) +(define-ogl-rgba-color +PANTONE-403-C+ 146 139 129 255) +(define-ogl-rgba-color +PANTONE-404-C+ 119 111 101 255) +(define-ogl-rgba-color +PANTONE-405-C+ 95 87 79 255) +(define-ogl-rgba-color +PANTONE-406-C+ 205 198 192 255) +(define-ogl-rgba-color +PANTONE-407-C+ 181 172 166 255) +(define-ogl-rgba-color +PANTONE-408-C+ 162 151 145 255) +(define-ogl-rgba-color +PANTONE-409-C+ 141 129 123 255) +(define-ogl-rgba-color +PANTONE-410-C+ 118 106 101 255) + +(define-ogl-rgba-color +PANTONE-WARM-GRAY-1-C+ 224 222 216 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-2-C+ 213 210 202 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-3-C+ 199 194 186 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-4-C+ 183 177 169 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-5-C+ 174 167 159 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-6-C+ 165 157 149 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-7-C+ 152 143 134 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-8-C+ 139 129 120 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-9-C+ 130 120 111 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-10-C+ 118 106 98 255) +(define-ogl-rgba-color +PANTONE-WARM-GRAY-11-C+ 103 92 83 255) + +(define-ogl-rgba-color +PANTONE-COOL-GRAY-1-C+ 224 225 221 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-2-C+ 213 214 210 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-3-C+ 201 202 200 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-4-C+ 188 189 188 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-5-C+ 178 180 179 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-6-C+ 173 175 175 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-7-C+ 154 155 156 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-8-C+ 139 141 142 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-9-C+ 116 118 120 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-10-C+ 97 99 101 255) +(define-ogl-rgba-color +PANTONE-COOL-GRAY-11-C+ 77 79 83 255)
;;; PANTONE SOLID UNCOATED
-(define-ogl-rgba-color PANTONE-YELLOW-U 255 230 0 1)
[178 lines skipped]