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