[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