[cello-cvs] CVS cello

ktilton ktilton at common-lisp.net
Tue Sep 5 18:43:56 UTC 2006


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




More information about the Cello-cvs mailing list