[cello-cvs] CVS cello

fgoenninger fgoenninger at common-lisp.net
Tue Sep 19 11:25:52 UTC 2006


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




More information about the Cello-cvs mailing list