[cello-cvs] CVS cello

ktilton ktilton at common-lisp.net
Mon Aug 28 21:45:24 UTC 2006


Update of /project/cello/cvsroot/cello
In directory clnet:/tmp/cvs-serv27660

Modified Files:
	application.lisp cello-ftgl.lisp cello.lisp cello.lpr 
	image.lisp ix-opengl.lisp ix-paint.lisp ix-togl.lisp 
Log Message:


--- /project/cello/cvsroot/cello/application.lisp	2006/07/03 00:35:12	1.5
+++ /project/cello/cvsroot/cello/application.lisp	2006/08/28 21:45:22	1.6
@@ -24,10 +24,13 @@
   (ffx-reset)
   (cells-reset 'tk-user-queue-handler)
   (makunbound 'ogl::*gl-stop*)
+  ;(xftgl)
+  ;(cl-ftgl-reset) ;; new 2006-08-28 in face of weird OGL 1282 when new chars hit in ratios
   (when system-type
     (setf *sys* (make-instance system-type :md-name 'mgsys)))
   (values))
 
+
 (defmodel mg-system (family)
    (
     (main-window :initarg :main-window :initform (c-in nil) :accessor main-window)
--- /project/cello/cvsroot/cello/cello-ftgl.lisp	2006/06/11 13:32:24	1.5
+++ /project/cello/cvsroot/cello/cello-ftgl.lisp	2006/08/28 21:45:22	1.6
@@ -39,6 +39,7 @@
              string)))
 
 (defun font-ftgl-ensure (mode face size) ;; ///sorry about the silly naming
+  (trc "font-ftgl-ensure requesting" mode face size)
   (ftgl-font-ensure mode face size (cs-target-res)))
 
 (defmodel font-id (ct-toggle ix-text)
--- /project/cello/cvsroot/cello/cello.lisp	2006/08/26 21:44:03	1.11
+++ /project/cello/cvsroot/cello/cello.lisp	2006/08/28 21:45:22	1.12
@@ -14,7 +14,9 @@
 
 |#
 
-;;; $Id: cello.lisp,v 1.11 2006/08/26 21:44:03 fgoenninger Exp $
+
+;;; $Id: cello.lisp,v 1.12 2006/08/28 21:45:22 ktilton Exp $
+
 
 ;;; ============================================================================
 ;;; PACKAGE DEFINITION
--- /project/cello/cvsroot/cello/cello.lpr	2006/08/21 04:28:26	1.11
+++ /project/cello/cvsroot/cello/cello.lpr	2006/08/28 21:45:22	1.12
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*-
 
 (in-package :cg-user)
 
--- /project/cello/cvsroot/cello/image.lisp	2006/08/21 04:28:26	1.10
+++ /project/cello/cvsroot/cello/image.lisp	2006/08/28 21:45:22	1.11
@@ -105,13 +105,13 @@
       :orientation :horizontal))
 
 (defmacro a-stack ((&rest stack-args) &body dd-kids)
-  `(mk-part ,(copy-symbol 'stk) (ix-stack)
+  `(mk-part ,(gensym "STAK") (ix-stack)
       , at stack-args
      :fm-parent *parent*
      :kids (c? (the-kids , at dd-kids))))
 
 (defmacro a-stack-lazy ((&rest stack-args) &body dd-kids)
-  `(mk-part ,(copy-symbol 'stk) (ix-stack-lazy)
+  `(mk-part ,(gensym "STAK") (ix-stack-lazy)
       , at stack-args
      :fm-parent *parent*
      :kids (c? (the-kids , at dd-kids))))
--- /project/cello/cvsroot/cello/ix-opengl.lisp	2006/08/21 04:28:26	1.4
+++ /project/cello/cvsroot/cello/ix-opengl.lisp	2006/08/28 21:45:22	1.5
@@ -81,6 +81,7 @@
 
 (defun render (self)
   (let (*selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*)
+    (assert (zerop (glgeterror)))
     (with-metrics (nil nil "ix-paint" self)
       (trc nil "render" self (^height))
       (ix-paint self))))
--- /project/cello/cvsroot/cello/ix-paint.lisp	2006/08/21 04:28:26	1.3
+++ /project/cello/cvsroot/cello/ix-paint.lisp	2006/08/28 21:45:22	1.4
@@ -65,7 +65,7 @@
     (with-bitmap-shifted ((px self)(py self))
       (gl-translatef (px self) (py self) 0)
       
-      
+      (assert (zerop (glgeterror)))
       (when n
         (trc "pushing gl-name" self n)
         (gl-push-name n))
@@ -90,6 +90,7 @@
                     (:off (gl-disable gl_lighting)))
                 
                 (gl-enable gl_color_material)
+                (assert (zerop (glgeterror)))
                 (bif (pre-layer (pre-layer self))
                   (progn
                     (assert (functionp pre-layer))
@@ -161,6 +162,7 @@
   (declare (ignore g-box))
   (count-it :render-layer)
   (count-it :render-layer (type-of key))
+  (assert (zerop (glgeterror)))
   (call-next-method))
 
 
--- /project/cello/cvsroot/cello/ix-togl.lisp	2006/08/23 20:21:59	1.6
+++ /project/cello/cvsroot/cello/ix-togl.lisp	2006/08/28 21:45:22	1.7
@@ -231,25 +231,7 @@
 
 (defmethod ctk:togl-create-using-class ((self ix-togl))    
   (setf (gl-name self) (gl-gen-lists 1))
-  (cello-gl-init) ;; clear errors
-;;;      
-;;;      #+profile (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 )
-;;;        )
-;;;      
+  (cello-gl-init)
   (gl-disable gl_texture_2d)
   (gl-shade-model gl_smooth)     ;; Enable Smooth Shading
   (gl-clear-depth 1.0f0)     ;; Depth Buffer Setup
@@ -263,7 +245,23 @@
         until (zerop (glGetError))
         when (> ct 10) 
         do #-lispworks (c-break "gl-init")
-        #+lispworks (return-from cello-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 )))
 
 (defmethod ix-selectable ((self ix-togl)) t)
 




More information about the Cello-cvs mailing list