[cello-cvs] CVS cello/kt-opengl
fgoenninger
fgoenninger at common-lisp.net
Sun Sep 17 20:06:54 UTC 2006
Update of /project/cello/cvsroot/cello/kt-opengl
In directory clnet:/tmp/cvs-serv26718
Modified Files:
colors.lisp
Log Message:
Added: More than 30 RGBA definitions for PANTONE colors
Added: Macro with-color
--- /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/16 19:16:51 1.1
+++ /project/cello/cvsroot/cello/kt-opengl/colors.lisp 2006/09/17 20:06:54 1.2
@@ -20,11 +20,17 @@
;;; 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 $
+;;; $Id: colors.lisp,v 1.2 2006/09/17 20:06:54 fgoenninger Exp $
(in-package #:kt-opengl)
;;; ===========================================================================
+;;; Data Definitions
+;;; ===========================================================================
+
+(defstruct rgba-color r g b a)
+
+;;; ===========================================================================
;;; Utilities / Helper functions and macros
;;; ===========================================================================
@@ -34,10 +40,11 @@
;;; Status: RELEASED
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun rgb-2-ogl-color3fv (r g b)
- (vector (coerce (/ r 255) 'float)
+ (defun rgba-2-ogl-color4f (r g b a)
+ (values (coerce (/ r 255) 'float)
(coerce (/ g 255) 'float)
- (coerce (/ b 255) 'float))))
+ (coerce (/ b 255) 'float)
+ (coerce (/ a 255) 'float))))
;;; ---------------------------------------------------------------------------
;;; DEFINE-OGL-RGB-COLOR MACRO
@@ -48,89 +55,69 @@
;;;
;;; 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)))
+(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)))
;;; ---------------------------------------------------------------------------
;;; SET-COLOR FUNCTION
;;; ---------------------------------------------------------------------------
;;;
-;;; Takes a color defined by define-ogl-rgb-color and calls gl-color3fv to
+;;; Takes a color defined by define-ogl-rgba-color and calls gl-color4f to
;;; set the color.
;;;
;;; Status: RELEASED
-(defun set-color (color-as-foreign-vector)
- (gl-color3fv color-as-foreign-vector))
+(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))
+ )
;;; ---------------------------------------------------------------------------
-;;; 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
+;;; SET-CLEAR-COLOR FUNCTION
;;; ---------------------------------------------------------------------------
;;;
-;;; Return the ALPHA color float value of a color defined by
-;;; define-ogl-rgb-color.
+;;; Set the clear color, taking a color defined by define-ogl-rgba-color as
+;;; parameter.
;;;
;;; Status: RELEASED
-(defun ogl-rgb-color-2-rgba-alpha (color-as-foreign-vector)
- (declare (ignore color-as-foreign-vector))
- 0.0f0)
+(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)))
;;; ---------------------------------------------------------------------------
-;;; SET-CLEAR-COLOR FUNCTION
+;;; WITH-COLOR MACRO
;;; ---------------------------------------------------------------------------
;;;
-;;; Set the clear color, taking a color defined by define-ogl-rgb-color as
-;;; parameter.
+;;; Execute body after setting a color and restore previuously set color as
+;;; has been set before executing body.
;;;
;;; 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)))
+(defmacro with-color (rgba-color &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)
+ , at body)
+ (glcolor4i (mem-aref ,ptr 'glint 0)
+ (mem-aref ,ptr 'glint 1)
+ (mem-aref ,ptr 'glint 2)
+ (mem-aref ,ptr 'glint 3))))))
;;; ---------------------------------------------------------------------------
;;; EXPORT SYMBOLS
@@ -139,96 +126,197 @@
(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)
+ define-ogl-rgba-color
+ rgba-color
+ with-color)
;;; ===========================================================================
;;; Color definitions
;;; ===========================================================================
-;;; RGB simple colors
+;;; RGBA 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)
+(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)
;;; 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)
+(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)
+
;;; 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)
+(define-ogl-rgba-color PANTONE-YELLOW-U 255 230 0 1)
+(define-ogl-rgba-color PANTONE-YELLOW-012-U 255 218 0 1)
+(define-ogl-rgba-color PANTONE-ORANGE-021-U 255 115 12 1)
+(define-ogl-rgba-color PANTONE-WARM-RED-U 254 97 92 1)
+(define-ogl-rgba-color PANTONE-RED-032-U 243 85 98 1)
+(define-ogl-rgba-color PANTONE-RUBIN-RED-U 212 72 126 1)
+(define-ogl-rgba-color PANTONE-RHODAMINE-RED-U 227 81 162 1)
+(define-ogl-rgba-color PANTONE-PURPLE-U 189 85 187 1)
+(define-ogl-rgba-color PANTONE-VIOLET-U 117 87 177 1)
+(define-ogl-rgba-color PANTONE-BLUE-072-U 57 69 166 1)
+(define-ogl-rgba-color PANTONE-REFLEX-BLUE-U 53 71 147 1)
+(define-ogl-rgba-color PANTONE-PROCESS-BLUE-U 0 131 197 1)
+(define-ogl-rgba-color PANTONE-GREEN-U 0 170 135 1)
+(define-ogl-rgba-color PANTONE-BLACK-U 96 91 85 1)
+
+(define-ogl-rgba-color PANTONE-PROCESS-YELLOW-U 250 230 35 1)
+(define-ogl-rgba-color PANTONE-PROCESS-MAGENTA-U 215 77 132 1)
+(define-ogl-rgba-color PANTONE-PROCESS-CYAN-U 0 159 214 1)
+(define-ogl-rgba-color PANTONE-PROCESS-BLACK-U 85 81 80 1)
+
+(define-ogl-rgba-color PANTONE-HEXACHROME-YELLOW-U 255 226 16 1)
+(define-ogl-rgba-color PANTONE-HEXACHROME-ORANGE-U 255 126 56 1)
+(define-ogl-rgba-color PANTONE-HEXACHROME-MAGENTA-U 223 62 145 1)
+(define-ogl-rgba-color PANTONE-HEXACHROME-CYAN-U 0 151 209 1)
+(define-ogl-rgba-color PANTONE-HEXACHROME-GREEN-U 0 177 102 1)
+(define-ogl-rgba-color PANTONE-HEXACHROME-BLACK-U 82 79 77 1)
+
+(define-ogl-rgba-color PANTONE-100-U 250 239 119 1)
+(define-ogl-rgba-color PANTONE-101-U 253 239 103 1)
+(define-ogl-rgba-color PANTONE-102-U 255 235 51 1)
+(define-ogl-rgba-color PANTONE-103-U 184 163 42 1)
+(define-ogl-rgba-color PANTONE-104-U 153 139 57 1)
+(define-ogl-rgba-color PANTONE-105-U 129 122 73 1)
+(define-ogl-rgba-color PANTONE-106-U 255 234 100 1)
+(define-ogl-rgba-color PANTONE-107-U 255 229 82 1)
+
+(define-ogl-rgba-color PANTONE-400-U 197 191 182 1)
+(define-ogl-rgba-color PANTONE-401-U 180 174 166 1)
+(define-ogl-rgba-color PANTONE-402-U 160 154 147 1)
+(define-ogl-rgba-color PANTONE-403-U 148 142 136 1)
+(define-ogl-rgba-color PANTONE-404-U 133 127 121 1)
+(define-ogl-rgba-color PANTONE-405-U 114 108 103 1)
+(define-ogl-rgba-color PANTONE-406-U 195 184 177 1)
+(define-ogl-rgba-color PANTONE-407-U 171 161 155 1)
+(define-ogl-rgba-color PANTONE-408-U 153 143 138 1)
+(define-ogl-rgba-color PANTONE-409-U 141 132 129 1)
+(define-ogl-rgba-color PANTONE-410-U 133 124 121 1)
+
+(define-ogl-rgba-color PANTONE-WARM-GRAY-1-U 229 224 217 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-2-U 215 209 201 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-3-U 195 188 180 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-4-U 181 173 166 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-5-U 168 161 155 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-6-U 158 151 145 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-7-U 149 142 137 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-8-U 141 134 130 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-9-U 135 128 124 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-10-U 126 119 116 1)
+(define-ogl-rgba-color PANTONE-WARM-GRAY-11-U 120 113 110 1)
+
+(define-ogl-rgba-color PANTONE-COOL-GRAY-1-U 226 225 220 1)
+(define-ogl-rgba-color PANTONE-COOL-GRAY-2-U 212 212 208 1)
+(define-ogl-rgba-color PANTONE-COOL-GRAY-3-U 197 198 196 1)
[39 lines skipped]
More information about the Cello-cvs
mailing list