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