[cells-cvs] CVS update: cell-cultures/cello/cello-ftgl.lisp cell-cultures/cello/cello-magick.lisp cell-cultures/cello/image.lisp cell-cultures/cello/ix-render.lisp cell-cultures/cello/ix-text.lisp cell-cultures/cello/window-callbacks.lisp cell-cultures/cello/window.lisp
Kenny Tilton
ktilton at common-lisp.net
Fri Oct 1 04:01:10 UTC 2004
Update of /project/cells/cvsroot/cell-cultures/cello
In directory common-lisp.net:/tmp/cvs-serv2293/cello
Modified Files:
cello-ftgl.lisp cello-magick.lisp image.lisp ix-render.lisp
ix-text.lisp window-callbacks.lisp window.lisp
Log Message:
A couple of simple fixes to get the pixel and texture wands (GraphicksMagic stuff) working again and now Cello is pretty much back in business.
Date: Fri Oct 1 06:01:06 2004
Author: ktilton
Index: cell-cultures/cello/cello-ftgl.lisp
diff -u cell-cultures/cello/cello-ftgl.lisp:1.2 cell-cultures/cello/cello-ftgl.lisp:1.3
--- cell-cultures/cello/cello-ftgl.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/cello-ftgl.lisp Fri Oct 1 06:01:05 2004
@@ -247,7 +247,7 @@
(trc nil "ix-render-in-font ftgl-texture" :pxy (pxy self) (l-rect self) t$)
(gl-enable gl_texture_2d)
- (trc "(gl-is-enabled gl_texture_2d)!!!!!!!" (gl-is-enabled gl_texture_2d)
+ (trc nil "(gl-is-enabled gl_texture_2d)!!!!!!!" (gl-is-enabled gl_texture_2d)
(ogl-get-boolean gl_texture_2d))
;;(assert (ogl-get-boolean gl_texture_2d))
(gl-disable gl_lighting)
Index: cell-cultures/cello/cello-magick.lisp
diff -u cell-cultures/cello/cello-magick.lisp:1.1 cell-cultures/cello/cello-magick.lisp:1.2
--- cell-cultures/cello/cello-magick.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/cello-magick.lisp Fri Oct 1 06:01:05 2004
@@ -81,8 +81,9 @@
(defparameter *mapping-textures* nil)
(defun ix-render-wand (wand l-box)
- (when wand
- (apply 'wand-render wand (r-bounds l-box))))
+ (if wand
+ (apply 'wand-render wand (r-bounds l-box))
+ (trc "ix-render-wand sees no wand" l-box)))
;;;(defun wand-centered-bounds (wand size)
;;; (let* ((raw-w (magick-get-image-width (^mgk-wand)))
Index: cell-cultures/cello/image.lisp
diff -u cell-cultures/cello/image.lisp:1.3 cell-cultures/cello/image.lisp:1.4
--- cell-cultures/cello/image.lisp:1.3 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/image.lisp Fri Oct 1 06:01:05 2004
@@ -48,11 +48,12 @@
(trc nil "display-list-name" display-list-name self)
(gl-new-list display-list-name gl_compile)
-
+ (trc nil "starting display list" display-list-name self)
(let ((*ogl-listing-p* self)
*selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*)
(with-metrics (nil nil "(funcall renderer)" self)
(ix-paint self)))
+ (trc nil "finished display list" display-list-name self)
(gl-end-list)
(setf (redisplayp *window-rendering*) t)
display-list-name))))
Index: cell-cultures/cello/ix-render.lisp
diff -u cell-cultures/cello/ix-render.lisp:1.2 cell-cultures/cello/ix-render.lisp:1.3
--- cell-cultures/cello/ix-render.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/ix-render.lisp Fri Oct 1 06:01:05 2004
@@ -81,47 +81,46 @@
(let ((ixr-box (mkr 0 0 0 0)))
(defmethod ix-paint :around ((self image) &aux (n (gl-name self)))
- (gl-translatef (px self) (py self) 0)
- (ogl-pen-move (px self) (py self)) ; /// combine former in here?
-
- (when n
- (trc nil "gl-name" self n)
- (gl-push-name n))
-
- (rpchk 'ix-paint t nil self)
- (when (and (not (c-stopped))
- (or (not *selecting*)
- (ix-selectable self))
- (visible self)
- (not (collapsed self)))
- (with-clipping (self)
- (progn ;; with-attrib (gl_lighting_bit gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit)
- (count-it :ix-render)
- #+not (count-it :ix-render (type-of self))
- #+not (unless (kids self)
- (count-it :ix-render-atom))
- (trc nil "ix painting" self)
- (trc nil "ix-render around rendering" self)
- (with-matrix ()
- (with-ogl-isolation
- (case (lighting self) ;; default is "same as parent"
- (:on (gl-enable gl_lighting))
- (:off (gl-disable gl_lighting)))
-
- (gl-enable gl_color_material)
-
- (bif (pre-layer (pre-layer self))
- (progn
- (assert (functionp pre-layer))
- (count-it :pre-layer)
- (nr-make ixr-box (ll self) (lt self) (lr self) (lb self))
- (funcall pre-layer self ixr-box :before)
- (call-next-method self)
- (funcall pre-layer self ixr-box :after))
- (call-next-method self)))))))
- (gl-translatef (- (px self)) (- (py self)) 0)
- (ogl-pen-move (- (px self)) (- (py self)))
-
+ (with-bitmap-shifted ((px self)(py self))
+ (gl-translatef (px self) (py self) 0)
+
+
+ (when n
+ (trc nil "gl-name" self n)
+ (gl-push-name n))
+
+ (rpchk 'ix-paint t nil self)
+ (when (and (not (c-stopped))
+ (or (not *selecting*)
+ (ix-selectable self))
+ (visible self)
+ (not (collapsed self)))
+ (with-clipping (self)
+ (progn ;; with-attrib (gl_lighting_bit gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit)
+ (count-it :ix-render)
+ #+not (count-it :ix-render (type-of self))
+ #+not (unless (kids self)
+ (count-it :ix-render-atom))
+ (trc nil "ix painting" self)
+ (with-matrix ()
+ (with-ogl-isolation
+ (case (lighting self) ;; default is "same as parent"
+ (:on (gl-enable gl_lighting))
+ (:off (gl-disable gl_lighting)))
+
+ (gl-enable gl_color_material)
+
+ (bif (pre-layer (pre-layer self))
+ (progn
+ (assert (functionp pre-layer))
+ (count-it :pre-layer)
+ (nr-make ixr-box (ll self) (lt self) (lr self) (lb self))
+ (funcall pre-layer self ixr-box :before)
+ (call-next-method self)
+ (funcall pre-layer self ixr-box :after))
+ (call-next-method self)))))))
+ (gl-translatef (- (px self)) (- (py self)) 0))
+
(when n
(gl-pop-name))))
Index: cell-cultures/cello/ix-text.lisp
diff -u cell-cultures/cello/ix-text.lisp:1.2 cell-cultures/cello/ix-text.lisp:1.3
--- cell-cultures/cello/ix-text.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/ix-text.lisp Fri Oct 1 06:01:05 2004
@@ -112,15 +112,13 @@
(ty (+ (lb self) (v2-v (inset self))
(round (glut-bitmap-y-orig (font-ffi-glut-id font))))))
- (ogl-pen-move tx ty)
+ (with-bitmap-shifted (tx ty)
- #+shh (if (ogl-get-boolean gl_current_raster_position_valid)
- (trc "rasterpos ok" self :g-offset (g-offset self))
- (trc "rasterpos offscreen" self :g-offset (g-offset self)))
- (trc nil "raster pos valid?" (ogl-get-boolean gl_current_raster_position_valid))
- (glut-bitmap-string (font-ffi-glut-id font) t$)
- (ogl-pen-move (- tx) (- ty))
- )))
+ #+shh (if (ogl-get-boolean gl_current_raster_position_valid)
+ (trc "rasterpos ok" self :g-offset (g-offset self))
+ (trc "rasterpos offscreen" self :g-offset (g-offset self)))
+ (trc nil "raster pos valid?" (ogl-get-boolean gl_current_raster_position_valid))
+ (glut-bitmap-string (font-ffi-glut-id font) t$)))))
(defmethod ix-render-in-font ((font font-glut-stroke) self)
(bwhen (t$ (^display-text$))
Index: cell-cultures/cello/window-callbacks.lisp
diff -u cell-cultures/cello/window-callbacks.lisp:1.2 cell-cultures/cello/window-callbacks.lisp:1.3
--- cell-cultures/cello/window-callbacks.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/window-callbacks.lisp Fri Oct 1 06:01:05 2004
@@ -102,7 +102,11 @@
(window-display *w*))))
(defmethod window-display ((self window))
- (ix-paint self) ;; (gl-call-list (dsp-list self))
+
+ (bif (dl (dsp-list self))
+ (gl-call-list (dsp-list self))
+ (ix-paint self))
+
(glut-swap-buffers)
(incf (frame-ct self))
Index: cell-cultures/cello/window.lisp
diff -u cell-cultures/cello/window.lisp:1.2 cell-cultures/cello/window.lisp:1.3
--- cell-cultures/cello/window.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/window.lisp Fri Oct 1 06:01:05 2004
@@ -294,7 +294,7 @@
(glm gl_max_viewport_dims #x3386 )
)
- (trc nil "glutw-create'd window XY" (glut-get-window) self :from (glut-xy self) :to
+ (trc "glutw-create'd window XY" (glut-get-window) self :from (glut-xy self) :to
(list (glut-get glut_window_x)(glut-get glut_window_y)
(glut-get glut_window_width)(glut-get glut_window_height)))
@@ -437,15 +437,13 @@
(progn ;; with-render-lock ((glut-get-window))
(glutmainloopevent)
)
- (sleep 0.1)
- ))))
+ (sleep 0.1)))))
-
-(defmethod ix-paint ((self window))
+(defmethod ix-paint :around ((self window))
(flet ((projection ()
(gl-matrix-mode gl_projection)
(gl-load-identity)
- (trc nil "win ortho! l r b t n f:"
+ (trc nil "paint> win ortho! l r b t n f:"
(ll self)(lr self)
(lb self)(lt self)
*mgw-near* *mgw-far*)
@@ -459,18 +457,15 @@
(gl-matrix-mode gl_model-view)
(gl-load-identity)
(gl-light-modeli gl_light_model_two_side 0)
- (ogl-pen-init)
- (ogl-pen-move 0 (ups (l-height self)))
-
- (when (clear-rgba self)
- (apply #'gl-clear-color (clear-rgba self)))
-
- (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit))
- (with-metrics (nil nil "ix-paint window call next")
- (call-next-method))
- (ogl-pen-move 0 (downs (l-height self)))
- ))
+ (with-bitmap-shifted (0 (ups (l-height self)))
+ (trc nil "with initial window shift, rasterpos now" (ogl-raster-pos-get))
+ (when (clear-rgba self)
+ (apply #'gl-clear-color (clear-rgba self)))
+
+ (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit))
+ (with-metrics (nil nil "ix-paint window call next")
+ (call-next-method)))))
(defun w-quadric-ensure (key)
(or (cdr (assoc key (quadrics *window-rendering*)))
More information about the Cells-cvs
mailing list