Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv31609
Modified Files: cello-ftgl.lisp cello.lpr image.lisp ix-togl.lisp nehe-06.lisp Log Message:
--- /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/08/28 21:45:22 1.6 +++ /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/09/05 18:43:56 1.7 @@ -138,6 +138,7 @@ #+(or) (ftgl-test)
+#+vestigial? (defun ftgl-test () (cl-ftgl-init) (let ((fns (mapcar (lambda (p) --- /project/cello/cvsroot/cello/cello.lpr 2006/08/28 21:45:22 1.12 +++ /project/cello/cvsroot/cello/cello.lpr 2006/09/05 18:43:56 1.13 @@ -43,21 +43,23 @@ (make-instance 'module :name "cello-openal.lisp") (make-instance 'module :name "nehe-06.lisp")) :projects (list (make-instance 'project-module :name - "..\Celtk\CELTK") - (make-instance 'project-module :name - "..\Cells\gui-geometry\gui-geometry") + "..\Cells\cells") (make-instance 'project-module :name "cffi-extender\cffi-extender") (make-instance 'project-module :name "kt-opengl\kt-opengl") (make-instance 'project-module :name - "cl-magick\cl-magick") + "cl-freetype\cl-freetype") (make-instance 'project-module :name "cl-ftgl\cl-ftgl") (make-instance 'project-module :name "cl-openal\cl-openal") (make-instance 'project-module :name - "cl-freetype\cl-freetype")) + "..\Cells\gui-geometry\gui-geometry") + (make-instance 'project-module :name + "cl-magick\cl-magick") + (make-instance 'project-module :name + "..\Celtk\CELTK")) :libraries nil :distributed-files nil :internally-loaded-files nil --- /project/cello/cvsroot/cello/image.lisp 2006/08/28 21:45:22 1.11 +++ /project/cello/cvsroot/cello/image.lisp 2006/09/05 18:43:56 1.12 @@ -17,7 +17,7 @@ (in-package :cello)
(eval-when (compile load eval) - (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy ^visible))) + (export '(mouse-over-p ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy ^visible))) ; ------------------------------------------------------
(defmodel ogl-quadric-based (ogl-node) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/28 21:45:22 1.7 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/09/05 18:43:56 1.8 @@ -108,8 +108,9 @@ :realtime (now)))) (:ButtonRelease ) (:MotionNotify + (trc nil "setting mouse pos!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" (ctk::xbe-x xe) (- (ctk::xbe-y xe))) (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) - (- (ctk::xbe-y xe))))) + (- (ctk::xbe-y xe))))) (:EnterNotify ) (:LeaveNotify ) (:FocusIn ) @@ -240,28 +241,29 @@ (gl-hint gl_perspective_correction_hint gl_nicest))
(defun cello-gl-init () - (trc nil "clearing gl errors....") + (trc "clearing gl errors....") (loop for ct upfrom 0 - until (zerop (glGetError)) - when (> ct 10) - do #-lispworks (c-break "gl-init") + until (zerop (eko ("cleared gl errorr") + (glGetError))) + when (> ct 10) + do #-lispworks (c-break "gl-init") #+lispworks (return-from cello-gl-init)) - - (macrolet ((glm (param num) - (declare (ignore num)) - `(trc ,(symbol-name param) (ogl-get-int ,param)))) - (glm gl_max_list_nesting 0) - (glm gl_max_eval_order #X0000) - (glm gl_max_lights #x3377 ) - (glm gl_max_clip_planes #x3378 ) - (glm gl_max_texture_size #x3379 ) - (glm gl_max_pixel_map_table #x3380 ) - (glm gl_max_attrib_stack_depth #x3381 ) - (glm gl_max_model-view_stack_depth #x3382 ) - (glm gl_max_name_stack_depth #x3383 ) - (glm gl_max_projection_stack_depth #x3384 ) - (glm gl_max_texture_stack_depth #x3385 ) - (glm gl_max_viewport_dims #x3386 ))) + + (macrolet ((glm (param num) + (declare (ignore num)) + `(trc ,(symbol-name param) (ogl-get-int ,param)))) + (glm gl_max_list_nesting 0) + (glm gl_max_eval_order #X0000) + (glm gl_max_lights #x3377 ) + (glm gl_max_clip_planes #x3378 ) + (glm gl_max_texture_size #x3379 ) + (glm gl_max_pixel_map_table #x3380 ) + (glm gl_max_attrib_stack_depth #x3381 ) + (glm gl_max_model-view_stack_depth #x3382 ) + (glm gl_max_name_stack_depth #x3383 ) + (glm gl_max_projection_stack_depth #x3384 ) + (glm gl_max_texture_stack_depth #x3385 ) + (glm gl_max_viewport_dims #x3386 )))
(defmethod ix-selectable ((self ix-togl)) t)
--- /project/cello/cvsroot/cello/nehe-06.lisp 2006/08/31 17:34:47 1.9 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/09/05 18:43:56 1.10 @@ -26,7 +26,6 @@ (defvar *jmc-font* )
(defun nehe-06 () ;; ACL project manager needs a zero-argument function, in project package - (setf *jmc-font* (ftgl-make :texture 'sylfaen 48 96 18)) (cl-magick-reset) (test-window 'nehe-06-demo))
@@ -165,6 +164,7 @@ #+shhh (print-frame-rate self))
(defmethod togl-create-using-class ((self nehe06)) + (cello-gl-init) (gl-enable gl_texture_2d) (gl-shade-model gl_smooth) (gl-clear-color 0 0 0 1) @@ -172,6 +172,7 @@ (gl-enable gl_depth_test) (gl-depth-func gl_lequal) (gl-hint gl_perspective_correction_hint gl_nicest) + (setf *jmc-font* (ftgl-make :texture 'sylfaen 48 96 18)) (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels
-
ktilton