[cello-cvs] CVS cello
ktilton
ktilton at common-lisp.net
Sun Jun 11 13:32:24 UTC 2006
Update of /project/cello/cvsroot/cello
In directory clnet:/tmp/cvs-serv31340
Modified Files:
cello-ftgl.lisp cello.lpr image.lisp ix-layer-expand.lisp
ix-render.lisp ix-text.lisp lighting.lisp mouse-click.lisp
nehe-06.lisp window-callbacks.lisp window-utilities.lisp
Log Message:
--- /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/06/11 13:32:24 1.5
@@ -67,7 +67,7 @@
(font-ftgl-ensure (mode style) (face style) (gui-style-size style)))
(defun ftgl-debug ()
- (let (*w*)
+ (let (*tkw*)
(with-styles (
(make-instance 'gui-style-ftgl
:id :button
--- /project/cello/cvsroot/cello/cello.lpr 2006/06/05 01:47:49 1.5
+++ /project/cello/cvsroot/cello/cello.lpr 2006/06/11 13:32:24 1.6
@@ -74,7 +74,7 @@
:old-space-size 256000
:new-space-size 6144
:runtime-build-option :standard
- :on-initialization 'nehe-06::nehe-06
+ :on-initialization 'cello::nehe-06
:on-restart 'do-default-restart)
;; End of Project Definition
--- /project/cello/cvsroot/cello/image.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/image.lisp 2006/06/11 13:32:24 1.5
@@ -16,8 +16,6 @@
(in-package :cello)
-(defparameter *w* nil)
-
; ------------------------------------------------------
--- /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/06/11 13:32:24 1.5
@@ -56,7 +56,9 @@
(gl-disable gl_blend)
(gl-disable gl_texture_2d)
(gl-normal3i 0 0 1)
- (gl-rectf (r-left l-box)(r-bottom l-box)(r-right l-box)(r-top l-box)))
+
+ (gl-rectf (r-left l-box) (r-top l-box) (r-right l-box)(r-bottom l-box))
+ )
(defmethod ix-layer-expand ((key (eql :normal-out)) &rest args)
(declare (ignore args))
--- /project/cello/cvsroot/cello/ix-render.lisp 2006/06/05 01:47:49 1.3
+++ /project/cello/cvsroot/cello/ix-render.lisp 2006/06/11 13:32:24 1.4
@@ -17,32 +17,6 @@
(in-package :cello)
-(defmethod ix-paint :before ((self ix-lit-scene))
- (gl-enable gl_color_material)
- (when (eql :on (lighting self))
- (trc nil "lighting on!" self)
- (gl-enable gl_lighting))
-
- (dolist (lm (light-model self))
- ;(trc "lighting model!" self lm)
- (gl-light-modelfv (car lm)(cdr lm)))
-
- (gl-enable gl_auto_normal)
- (gl-enable gl_normalize)
-
- (let (lights)
- ;; /// next bit should not descend into a nested lit scene
- (fm-traverse self (lambda (self)
- (when (typep self 'ix-light)
- (setf lights (or lights (^enabled)))
- (ix-render-light self))))
- (loop for light in (fixed-lighting self)
- do (ix-render-light light))
- (when (and (not lights) (emergency-lighting self))
- (trc nil "emergency lighting" self)
- (dolist (e-light (emergency-lighting self))
- (ix-render-light e-light)))))
-
(defmethod ix-paint :after ((self family))
(dolist (k (kids self))
(trc nil "ixr geo" k (list (px k)(py k)) (list (ll k)(lt k)(lr k)(lb k)))
@@ -66,7 +40,7 @@
(defmethod ix-paint (self)
(declare (ignorable self))
- (trc nil "ix-render fell through" self (class-of self)))
+ (trc "ix-render fell through" self (class-of self)))
(defmacro with-ogl-isolation (&body body)
`(with-attrib (gl_lighting_bit gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit)
@@ -74,13 +48,13 @@
(let ((ixr-box (mkr 0 0 0 0)))
(defmethod ix-paint :around ((self image) &aux (n (gl-name self)))
- (trc nil "painting" self (^px)(^py)(^lr))
+ (trc "painting, shifting bitmap" self n (^px)(^py))
(with-bitmap-shifted ((px self)(py self))
(gl-translatef (px self) (py self) 0)
(when n
- (trc nil "gl-name" self n)
+ (trc "pushing gl-name" self n)
(gl-push-name n))
(rpchk 'ix-paint t nil self)
@@ -89,13 +63,13 @@
(ix-selectable self))
(visible self)
(not (collapsed self)))
- (with-clipping (self)
+ (progn ;;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)
#+(or) (count-it :ix-render (type-of self))
#+(or) (unless (kids self)
(count-it :ix-render-atom))
- (trc nil "ix painting" self)
+ (trc "ix painting" self (lighting self))
(with-matrix ()
(with-ogl-isolation
(case (lighting self) ;; default is "same as parent"
--- /project/cello/cvsroot/cello/ix-text.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/ix-text.lisp 2006/06/11 13:32:24 1.5
@@ -18,6 +18,9 @@
;===========================================================
+(eval-when (compile load eval)
+ (export '(ix-paint)))
+
(defmodel ix-text (ix-styled image)
(
(text$ :initform nil :initarg :text$ :accessor text$)
--- /project/cello/cvsroot/cello/lighting.lisp 2006/06/05 01:47:49 1.3
+++ /project/cello/cvsroot/cello/lighting.lisp 2006/06/11 13:32:24 1.4
@@ -41,19 +41,13 @@
;;----------------------------------------------
-(defun make-lighting (md-name id pos)
- (make-instance 'ix-light
- :md-name md-name
- :id id
- :initial-pos pos))
-
-(defmodel ix-lit-scene (ix-family)
+(defmodel ix-lit-scene () ;; mix in with ix-family
(
(clear-rgba :cell nil :initarg :clear-rgba :initform nil :accessor clear-rgba)
(light-model :initarg :light-model :initform (list (cons gl_light_model_ambient *dim*))
:accessor light-model)
(lights :initarg :lights :accessor lights
- :initform (c? (without-c-dependency
+ :initform nil #+refactor (c? (without-c-dependency
(let (lights)
(fm-traverse self (lambda (self)
(when (typep self 'ix-light)
@@ -76,7 +70,32 @@
:diffuse *average*
:specular *bright*)))))
-
+(defmethod ix-paint :before ((self ix-lit-scene))
+ (gl-enable gl_color_material)
+ (when (eql :on (lighting self))
+ (trc nil "lighting on!" self)
+ (gl-enable gl_lighting))
+
+ (dolist (lm (light-model self))
+ ;(trc "lighting model!" self lm)
+ (gl-light-modelfv (car lm)(cdr lm)))
+
+ (gl-enable gl_auto_normal)
+ (gl-enable gl_normalize)
+
+ (let (lights)
+ ;; /// next bit should not descend into a nested lit scene
+ #+refactorifneeded
+ (fm-traverse self (lambda (self)
+ (when (typep self 'ix-light)
+ (setf lights (or lights (^enabled)))
+ (ix-render-light self))))
+ (loop for light in (fixed-lighting self)
+ do (ix-render-light light))
+ (when (and (not lights) (emergency-lighting self))
+ (trc nil "emergency lighting" self)
+ (dolist (e-light (emergency-lighting self))
+ (ix-render-light e-light)))))
(defun pct-xlate (pct v1 v2 expansion)
(let* ((dv (round (- v2 v1) 2))
--- /project/cello/cvsroot/cello/mouse-click.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/mouse-click.lisp 2006/06/11 13:32:24 1.5
@@ -77,11 +77,12 @@
(when (or (null new-click)
(if (typep self 'window)
(ctl-notify-mouse-click self self new-click)
- (ctl-notify-mouse-click (fm-parent self) self new-click)))
+ (ctl-notify-mouse-click (fm-parent self) self new-click)))
(call-next-method)))
(defmethod ctl-notify-mouse-click (self clickee click)
- (ctl-notify-mouse-click (fm-parent self) clickee click))
+ (when (fm-parent self)
+ (ctl-notify-mouse-click (fm-parent self) clickee click)))
; --------------------------------------------------------
--- /project/cello/cvsroot/cello/nehe-06.lisp 2006/06/05 01:47:49 1.3
+++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/06/11 13:32:24 1.4
@@ -3,10 +3,7 @@
;;; nehe lesson 06 spinning cube with texture
;;;
-(defpackage :nehe-06
- (:use :common-lisp :utils-kt :cells :celtk :kt-opengl :cl-magick :cl-ftgl))
-
-(in-package :nehe-06)
+(in-package :cello)
(defvar *startx*)
(defvar *starty*)
--- /project/cello/cvsroot/cello/window-callbacks.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/window-callbacks.lisp 2006/06/11 13:32:24 1.5
@@ -24,8 +24,7 @@
(progn
(trc nil "window using disp list")
(gl-call-list (dsp-list self)))
- (ix-paint self)))
- (incf (frame-ct self))))
+ (ix-paint self)))))
(defmethod ctk::togl-timer-using-class ((self ix-togl))
(unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox
--- /project/cello/cvsroot/cello/window-utilities.lisp 2006/06/05 01:47:49 1.4
+++ /project/cello/cvsroot/cello/window-utilities.lisp 2006/06/11 13:32:24 1.5
@@ -70,8 +70,7 @@
; --------------- geometry -------------------------------
-(defmethod g-offset ((self cello-window) &optional (accum-h 0) (accum-v 0))
- (mkv2 accum-h accum-v))
+
(defun point-in-box (pt box)
(and (<= (r-left box) (v2-h pt) (r-right box))
More information about the Cello-cvs
mailing list