[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