cello-cvs September 2006

cello-cvs@common-lisp.net

2 participants
12 discussions

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 19 Sep '06

19 Sep '06

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]

1 0

[cello-cvs] CVS cello
by fgoenninger 19 Sep '06

19 Sep '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv9100 Modified Files: colors.lisp Log Message: Changed: Color definitions and related functions moved to kt-opengl/colors.lisp --- /project/cello/cvsroot/cello/colors.lisp 2006/09/16 19:14:07 1.6 +++ /project/cello/cvsroot/cello/colors.lisp 2006/09/19 11:25:51 1.7 @@ -14,83 +14,12 @@ |# +;;; $Header: /project/cello/cvsroot/cello/colors.lisp,v 1.7 2006/09/19 11:25:51 fgoenninger Exp $ + (in-package :cello) -(defstruct rgb ;;/// just use ogl native struct? - (r 0 ) - (g 0 ) - (b 0 )) - -(defstruct rgba fo) - -(defun mk-rgba (r g b a) - (let* ((co (fgn-alloc :float 4 :mk-rgba)) - (c (make-rgba :fo co))) - (setf (cffi:mem-aref co :float 0) (/ r 255.0f0)) - (setf (cffi:mem-aref co :float 1) (/ g 255.0f0)) - (setf (cffi:mem-aref co :float 2) (/ b 255.0f0)) - (setf (cffi:mem-aref co :float 3) (/ a 255.0f0)) - c)) - -(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-r (rgba) - (c-assert (typep rgba 'rgba)) - (cffi:mem-aref (rgba-fo rgba) :float 0)) - -(defun rgba-g (rgba) - (c-assert (typep rgba 'rgba)) - (cffi:mem-aref (rgba-fo rgba) :float 1)) - -(defun rgba-b (rgba) - (c-assert (typep rgba 'rgba)) - (cffi:mem-aref (rgba-fo rgba) :float 2)) - -(defun rgba-a (rgba) - (c-assert (typep rgba 'rgba)) - (cffi:mem-aref (rgba-fo rgba) :float 3)) - -(defmethod print-object ((self rgba) s) - (format s "(r:~a g:~a b:~a a:~a)" (rgba-r self)(rgba-g self)(rgba-b self)(rgba-a self))) - -(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))) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (export '(+white+ +red+ +dark-green+ +green+ +turquoise+ +dk-blue+ - +blue+ +lt-blue+ +black+ +yellow+ +lt-yellow+ - +purple+ +gray+ +lt-gray+ +dk-gray+ - light))) - -(defparameter +white+ (mk-rgba 255 255 255 255)) -(defparameter +red+ (mk-rgba 255 0 0 255)) -(defparameter +dark-green+ (mk-rgba 0 128 0 255)) -(defparameter +green+ (mk-rgba 0 255 0 255)) -(defparameter +turquoise+ (mk-rgba 0 255 255 255)) -(defparameter +dk-blue+ (mk-rgba 0 0 64 50)) -(defparameter +blue+ (mk-rgba 0 0 255 255)) -(defparameter +lt-blue+ (mk-rgba 127 127 255 255)) -(defparameter +black+ (mk-rgba 0 0 0 255)) -(defparameter +yellow+ (mk-rgba 255 255 0 255)) -(defparameter +lt-yellow+ (mk-rgba 255 255 127 255)) -(defparameter +purple+ (mk-rgba 255 0 255 255)) -(defparameter +gray+ (mk-rgba 127 127 127 255)) -(defparameter +lt-gray+ (mk-rgba 192 192 192 255)) -(defparameter +dk-gray+ (mk-rgba 64 64 64 255)) +;;; -> ALL COLOR DEFINITIONS AND RELATED FUNCTIONS HAVE BEEN MOVED INTO +;;; FILE KT-OPENGL/COLORS.LISP ;;; --- Lights ------------ @@ -106,16 +35,15 @@ (defparameter *lightposl* (make-ff-array :float 0 -400 (nearer 50) 1)) (defmodel light () - ((id :cell nil :initarg :id :initform nil :accessor id) - (enabled :initarg :enabled :initform nil :accessor enabled) - (pos :initarg :pos :initform nil :accessor pos) - (ambient :initarg :ambient :initform nil :accessor ambient) - (diffuse :initarg :diffuse :initform nil :accessor diffuse) - (specular :initarg :specular :initform nil :accessor specular) - (cutoff :initarg :cutoff :initform 180 :accessor cutoff) - (spot-dir :initarg :spot-dir :initform (cons 0 0) :accessor spot-dir) - (spot-exp :initarg :spot-exp :initform 0 :accessor spot-exp) + ((id :cell nil :initarg :id :initform nil :accessor id) + (enabled :initarg :enabled :initform nil :accessor enabled) + (pos :initarg :pos :initform nil :accessor pos) + (ambient :initarg :ambient :initform nil :accessor ambient) + (diffuse :initarg :diffuse :initform nil :accessor diffuse) + (specular :initarg :specular :initform nil :accessor specular) + (cutoff :initarg :cutoff :initform 180 :accessor cutoff) + (spot-dir :initarg :spot-dir :initform (cons 0 0) :accessor spot-dir) + (spot-exp :initarg :spot-exp :initform 0 :accessor spot-exp) )) - - +(export! light) \ No newline at end of file

1 0

[cello-cvs] CVS cello/cl-ftgl
by fgoenninger 17 Sep '06

17 Sep '06

Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv12498 Modified Files: cl-ftgl.lisp Log Message: Added: function FTGL-FORMAT: FORMAT for FTGL strings --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/09/05 18:43:56 1.13 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/09/17 22:39:20 1.14 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.13 2006/09/05 18:43:56 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.14 2006/09/17 22:39:20 fgoenninger Exp $ (eval-when (:compile-toplevel :load-toplevel) (pushnew :cl-ftgl *features*)) @@ -46,7 +46,7 @@ #:xftgl #:ftgl-render #:ftgl-font-ensure - #:*ftgl-dynamic-lib-path* + #:ftgl-format #:*font-directory-path* #:*gui-style-default-face* #:*gui-style-button-face* @@ -121,6 +121,9 @@ ;;(format t "~%*** FIND-FONT-FILE: Result = ~A~%" pn) (return-from pn-loop pn))))))) +(defun ftgl-format (font control-string &rest args) + (ftgl-render font (apply 'format nil control-string args))) + ;; ---------------------------------------------------------------------------- ;; FOREIGN FUNCTION INTERFACE ;; ----------------------------------------------------------------------------

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 17 Sep '06

17 Sep '06

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) + ,@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]

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 16 Sep '06

16 Sep '06

Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv26719 Modified Files: kt-opengl.asd Log Message: Added: file colors.lisp --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/07/06 22:09:11 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/09/16 19:17:09 1.3 @@ -22,4 +22,5 @@ (:file "glu-functions") (:file "ogl-macros") (:file "ogl-utils") - (:file "move-to-gl"))) + (:file "move-to-gl") + (:file "colors")))

1 0

[cello-cvs] CVS cello/kt-opengl
by fgoenninger 16 Sep '06

16 Sep '06

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)

1 0

[cello-cvs] CVS cello
by fgoenninger 16 Sep '06

16 Sep '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv26222 Modified Files: colors.lisp Log Message: Defines colors and util functions for colors. --- /project/cello/cvsroot/cello/colors.lisp 2006/07/24 05:00:35 1.5 +++ /project/cello/cvsroot/cello/colors.lisp 2006/09/16 19:14:07 1.6 @@ -73,7 +73,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (export '(+white+ +red+ +dark-green+ +green+ +turquoise+ +dk-blue+ +blue+ +lt-blue+ +black+ +yellow+ +lt-yellow+ - +purple+ +gray+ +lt-gray+ +dk-gray+))) + +purple+ +gray+ +lt-gray+ +dk-gray+ + light))) (defparameter +white+ (mk-rgba 255 255 255 255)) (defparameter +red+ (mk-rgba 255 0 0 255))

1 0

[cello-cvs] CVS cello/cffi-extender
by ktilton 05 Sep '06

05 Sep '06

Update of /project/cello/cvsroot/cello/cffi-extender In directory clnet:/tmp/cvs-serv637/cffi-extender Modified Files: arrays.lisp Log Message: --- /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/08/31 17:34:47 1.3 +++ /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/09/05 23:05:36 1.4 @@ -169,9 +169,18 @@ (defun elti (v n) (ff-elt v :int n)) +(defun eltc (v n) + (ff-elt v :char n)) + (defun (setf elti) (value v n) (setf (ff-elt v :int n) (coerce value 'integer))) +(defun (setf eltuc) (value v n) + (setf (ff-elt v :unsigned-char n) value)) + +(defun eltuc (v n) + (ff-elt v :unsigned-char n)) + (defun eltf (v n) (ff-elt v :float n)) @@ -194,7 +203,7 @@ `(mem-aref ,pa :pointer ,n)) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(ffx-reset + (export '(ffx-reset eltc eltuc ff-elt ff-list eltf eltd elti fgn-pa with-ff-array-elements

1 0

[cello-cvs] CVS cello/cl-magick
by ktilton 05 Sep '06

05 Sep '06

Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv637/cl-magick Modified Files: cl-magick.lisp wand-image.lisp wand-texture.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/31 17:34:48 1.11 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/09/05 23:05:37 1.12 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: cl-magick.lisp,v 1.11 2006/08/31 17:34:48 ktilton Exp $ +;;; $Id: cl-magick.lisp,v 1.12 2006/09/05 23:05:37 ktilton Exp $ (defpackage :cl-magick @@ -90,9 +90,9 @@ (defun cl-magick-reset () (wands-clear) - #+shhh (progn - (print `(magick-copyright ,(magick-get-copyright))) - (print `(magick-version ,(magick-get-version *mgk-version*)))) + (progn + (print `(magick-copyright ,(magick-get-copyright))) + (print `(magick-version ,(magick-get-version *mgk-version*)))) ) (defun wands-loaded () *wands-loaded*) @@ -103,15 +103,15 @@ (defun wands-clear () (loop for wand in *wands-loaded* do (wand-release (cdr wand))) - (setf *wands-loaded* nil)) + (setf (wands-loaded) nil)) (defun wand-ensure-typed (wand-type file-path$ &rest iargs) (when file-path$ (cl-magick-init) (let ((key (list* wand-type (namestring file-path$) iargs))) - (or (let ((old (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test - #+shhhh (when old - (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) + (or (let ((old (cdr (assoc key (wands-loaded) :test 'equal)))) + (when old + (print `(wand-ensure-typed re-using-prior-load ,wand-type ,file-path$))) old) (let ((wi (apply 'make-instance wand-type :file-path$ file-path$ --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/31 17:34:48 1.7 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/09/05 23:05:37 1.8 @@ -91,7 +91,7 @@ (if (zerop (* last-col last-row)) (let* ((columns 64)(rows 64) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) - ;(print "wand-get-image-pixels > wand has zero pixels; did the load fail?") + (print "wand-get-image-pixels > wand has zero pixels; did the load fail?") (dotimes (pn (* columns rows)) (setf (elti pixels pn) -1)) (values pixels columns rows)) @@ -100,15 +100,37 @@ (rows (- last-row first-row)) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) (assert (not (zerop pixels))() "wand-get-image-pixels > fgn-alloc of ~a bytes failed" (* 3 columns rows)) - ;;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) ;; frgo: debug ... - ;;(cells:trc "image format" wand (magick-get-image-format wand)) ;; frgo:debug... + (print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) ;; frgo: debug ... + (cells:trc "image format" wand (magick-get-image-format wand)) ;; frgo:debug... + ; + ; these next two are quite slow thx to FFI I guess + ; + #+pretty! ;; random noise texture and pixmap + (dotimes (off (* 3 columns rows)) + (setf (eltuc pixels off) (random 256))) + + #+zerosowecanseewhatreallygetsread + (dotimes (off (* 3 columns rows)) + (setf (eltuc pixels off) 0)) + (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) ;;(print `(writeimage ,(magick-write-image wand "/tmp/wand-image-test.jpg"))) - #+jesfoolinaround(loop for row below 16 do - (loop for col below 16 by 1 - for offset = (+ (* row columns 3) (* col 3)) - do (print (loop for bn below 3 - collecting (setf (elti pixels (+ offset bn)) 0))))) + (progn + ; + ; look at a few pixels + ; + (print (list "a few pixels from" wand)) + (block sweet-16 + (loop for row below rows do + (loop with bytes + for bytecol below (* 3 columns) + for offset = (+ (* row columns 3) bytecol) + for char = (eltuc pixels offset) + until (> (length bytes) 15) + unless (zerop char) + do (pushnew char bytes) + finally (format t "~&sixteen bytes ~{~a ~}" bytes) + (return-from sweet-16))))) (values pixels columns rows)))) --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/28 18:41:19 1.6 +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/09/05 23:05:37 1.7 @@ -42,14 +42,14 @@ (grow-sz (cons (expt 2 (ceiling (log (car (image-size self)) 2))) (expt 2 (ceiling (log (cdr (image-size self)) 2))))) (best-fit-sz (best-fit-cons trunc-sz (image-size self) grow-sz))) - ;;(print `(texture-name> gennning texture ,self)) ;; frgo: debug... + (print `(texture-name> gennning texture ,self)) ;; frgo: debug... (unless (equal (image-size self) best-fit-sz) - ;;(print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) ;; frgo: debug... + (print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) ;; frgo: debug... (magick-scale-image (mgk-wand self) (car best-fit-sz) (cdr best-fit-sz)) ;;; gaussian-filter 0) (setf (image-size self) best-fit-sz)) - ;; (print `(texture-name> new image size , self ,(image-size self))) ;; frgo: debug... + (print `(texture-name> new image size , self ,(image-size self))) ;; frgo: debug... (let ((tx (wand-image-to-texture self))) (if (plusp tx) (setf (texture-name self) tx) @@ -70,7 +70,7 @@ (cdr (image-size self))))) ;;(assert (not *ogl-listing-p*)) (assert (plusp tx)) - ;;(cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) ;; frgo: debug... + (cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) ;; frgo: debug... (gl-bind-texture gl_texture_2d tx) (progn ;; useless??

1 0

[cello-cvs] CVS cello
by ktilton 05 Sep '06

05 Sep '06

Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv637 Modified Files: ix-togl.lisp nehe-06.lisp Log Message: --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/09/05 18:43:56 1.8 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/09/05 23:05:36 1.9 @@ -85,7 +85,7 @@ (defmethod ctk::togl-timer-using-class ((self ix-togl)) (unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox (c-stopped)) - (with-metrics (nil nil "ctk::togl-display-using-class") + (with-metrics (nil nil "ctk::ctk::togl-timer-using-class") (when (display-continuous self) (trc nil "window-display > continuous specified so posting redisplay" self) (ctk::togl-post-redisplay (ctk::togl-ptr self)))))) --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/09/05 18:43:56 1.10 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/09/05 23:05:36 1.11 @@ -146,7 +146,7 @@ (gl-tex-coord2f 0 1) (v3f -1 1 -1) )) ;;#+ifuwanttoseepixmap - ;;(wand-render *grace* 0 0 1 -1) + (wand-render *grace* 0 0 1 -1) (progn (gl-scalef 0.006 0.006 0.0) @@ -176,7 +176,7 @@ (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (test-image "graceblue" "jpg")))) ; "turing" "gif")))) + (test-image "grace" "jpg")))) ; "turing" "gif")))) (defun print-frame-rate (window) (with-slots (frame-count t0) window

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cello-cvs September 2006