[cells-cvs] CVS update: cell-cultures/cello/cello-ftgl.lisp cell-cultures/cello/cello.asd cell-cultures/cello/cello.lisp cell-cultures/cello/image.lisp cell-cultures/cello/ix-styled.lisp cell-cultures/cello/ix-text.lisp cell-cultures/cello/mg-geometry.lisp cell-cultures/cello/window.lisp
Kenny Tilton
ktilton at common-lisp.net
Thu Oct 28 00:09:03 UTC 2004
Update of /project/cells/cvsroot/cell-cultures/cello
In directory common-lisp.net:/tmp/cvs-serv27567/cello
Modified Files:
cello-ftgl.lisp cello.asd cello.lisp image.lisp ix-styled.lisp
ix-text.lisp mg-geometry.lisp window.lisp
Log Message:
Re-port to Lispworks/win32
Date: Thu Oct 28 02:08:56 2004
Author: ktilton
Index: cell-cultures/cello/cello-ftgl.lisp
diff -u cell-cultures/cello/cello-ftgl.lisp:1.4 cell-cultures/cello/cello-ftgl.lisp:1.5
--- cell-cultures/cello/cello-ftgl.lisp:1.4 Fri Oct 15 05:37:21 2004
+++ cell-cultures/cello/cello-ftgl.lisp Thu Oct 28 02:08:56 2004
@@ -20,9 +20,6 @@
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
;;; IN THE SOFTWARE.
-
-(defpackage #:cello (:use #:cl-ftgl))
-
(in-package :cello)
(defmethod font-height ((font ftgl))
Index: cell-cultures/cello/cello.asd
diff -u cell-cultures/cello/cello.asd:1.1 cell-cultures/cello/cello.asd:1.2
--- cell-cultures/cello/cello.asd:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/cello.asd Thu Oct 28 02:08:56 2004
@@ -15,8 +15,62 @@
:maintainer "Kenny Tilton <ktilton at nyc.rr.com>"
:licence "MIT"
:description "A Portable Common Lisp GUI"
- :long-description "The final pieces of a portable Common Lisp GUI (assumes cellocore)"
- :components ((:file "cello-ftgl")
+ :long-description "The final pieces of a portable Common Lisp GUI"
+
+ :depends-on (:cells :cl-opengl :cl-magick)
+ :components ((:file "cello")
+ (:file "datetime")
+ (:file "window-macros" :depends-on ("cello"))
+ (:file "clipping" :depends-on ("cello"))
+ (:file "mg-geometry" :depends-on ("cello"))
+ (:file "coordinate-xform" :depends-on ("mg-geometry"))
+ (:file "ix-geometry" :depends-on ("coordinate-xform"))
+ (:file "colors" :depends-on ("ix-geometry"))
+ (:file "rgb" :depends-on ("colors"))
+ (:file "frame" :depends-on ("rgb"))
+ (:file "application" :depends-on ("frame"))
+ (:file "image"
+ :depends-on ("application"
+ "window-macros" "clipping"
+ "mg-geometry"
+ "ix-geometry"))
+
+ (:file "ix-layer-expand" :depends-on ("cello" "image" "frame"))
+ (:file "ix-canvas" :depends-on ("ix-layer-expand"))
+ (:file "ix-family" :depends-on ("cello" "ix-canvas"))
+ (:file "font" :depends-on ("image"))
+ (:file "ix-inline" :depends-on ("ix-geometry" "ix-family"))
+ (:file "ix-grid" :depends-on ("ix-inline"))
+ (:file "mouse-click" :depends-on ("ix-grid"))
+ (:file "control" :depends-on ("mouse-click"))
+ (:file "focus" :depends-on ("ix-canvas"))
+ (:file "focus-navigation" :depends-on ("focus"))
+ (:file "focus-utilities" :depends-on ("focus-navigation"))
+ (:file "ix-styled" :depends-on ("ix-canvas" "font"))
+ (:file "ix-text" :depends-on ("ix-styled"))
+ (:file "lighting" :depends-on ("ix-inline"))
+ (:file "window" :depends-on ("image" "lighting"))
+ (:file "ctl-toggle" :depends-on ("control" "ix-text"))
+ (:file "ctl-markbox" :depends-on ("ctl-toggle"))
+ (:file "ctl-drag" :depends-on ("ctl-markbox"))
+ (:file "ctl-selectable" :depends-on ("ctl-drag"))
+ (:file "slider" :depends-on ("ctl-selectable"))
+ (:file "window-utilities" :depends-on ("window"))
+ (:file "window-render" :depends-on ("window-utilities"))
+ (:file "window-callbacks" :depends-on ("window-utilities"))
+ (:file "wm-mouse" :depends-on ("window-callbacks"))
+
+ (:file "pick" :depends-on ("wm-mouse"))
+ (:file "menu" :depends-on ("pick"))
+ (:file "ix-render" :depends-on ("window-render"))
+ (:file "ix-polygon" :depends-on ("ix-render"))
+ (:file "ct-scroll-pane" :depends-on ("ix-polygon"))
+ (:file "ct-scroll-bar" :depends-on ("ct-scroll-pane"))
+ (:file "cello-ftgl")
(:file "cello-openal")
(:file "cello-magick" :depends-on ("cello-ftgl"))
))
+
+
+
+
Index: cell-cultures/cello/cello.lisp
diff -u cell-cultures/cello/cello.lisp:1.2 cell-cultures/cello/cello.lisp:1.3
--- cell-cultures/cello/cello.lisp:1.2 Fri Oct 15 05:37:21 2004
+++ cell-cultures/cello/cello.lisp Thu Oct 28 02:08:56 2004
@@ -25,27 +25,11 @@
(:nicknames :clo)
(:use
#:common-lisp
- #-cormanlisp #:clos
+ #-(or cormanlisp mcl) #:clos
#:utils-kt
#:cells
#:ffx
#:cl-opengl
- )
- ;;; (:shadowing-import-from #:excl #:fasl-write #:fasl-read #:gc)
- )
+ #:cl-ftgl
+ #:cl-magick))
-
-(in-package :cello)
-
-(defparameter *cello-runtime-directory* :unconfigured)
-(defparameter *user-temp-directory* :unconfigured)
-
-(load (merge-pathnames "cellocore-config.lisp"
- cl-user::*cello-config-directory*))
-
-(defun cellocore-test ()
- "to be announced")
-
-(defun cello-runtime-file (file)
- (merge-pathnames file
- *cello-runtime-directory*))
\ No newline at end of file
Index: cell-cultures/cello/image.lisp
diff -u cell-cultures/cello/image.lisp:1.5 cell-cultures/cello/image.lisp:1.6
--- cell-cultures/cello/image.lisp:1.5 Fri Oct 15 05:37:21 2004
+++ cell-cultures/cello/image.lisp Thu Oct 28 02:08:56 2004
@@ -34,30 +34,60 @@
(declare (ignore self))
(assert (not *ogl-listing-p*)))
-(defvar *window-rendering*)
+(defvar *ogl-shared-resource-tender*)
+
+(defclass ogl-shared-resource-tender ()
+ ((display-lists :initform nil :accessor display-lists)
+ (quadrics :initform nil :accessor quadrics)
+ (textures :initform nil :accessor textures)))
+
+(defmethod not-to-be :before ((self ogl-shared-resource-tender))
+ (loop for (nil . dl) in (display-lists self)
+ do (gl-delete-lists dl 1)
+ finally (setf (display-lists self) nil))
+ (loop for (nil . q) in (quadrics self)
+ do (glu-delete-quadric q)))
+
+(defmethod ogl-shared-resource-tender ((self ogl-shared-resource-tender))
+ self)
+
+(defmethod ogl-shared-resource-tender (other)
+ (c-break "ogl-shared-resource-tender undefined for ~a" other))
+
+(defmethod ogl-node-window (other)
+ (c-break "ogl-node-window undefined for ~a" other))
(defmodel ogl-node ()
((dsp-list :initarg :dsp-list :accessor dsp-list
:initform (c-formula (:lazy :until-asked)
- (assert *w*)
- (assert (not *ogl-listing-p*))
- (ogl-dsp-list-prep self)
- (when (every 'dsp-list (kids self))
- (let ((display-list-name (or .cache (gl-gen-lists 1)))
- (*window-rendering* (nearest self window)))
- (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))))
+ (assert *w*)
+ (assert (not *ogl-listing-p*))
+ (ogl-dsp-list-prep self)
+ (when (every 'dsp-list (kids self))
+ (let ((display-list-name (or .cache (gl-gen-lists 1)))
+ (*ogl-shared-resource-tender*
+ (ogl-shared-resource-tender 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 (ogl-node-window self)) t)
+ display-list-name))))
(gl-name :initarg :gl-name :initform nil :accessor gl-name)
(renderer :initarg :renderer :initform nil :accessor renderer)))
+(defmethod not-to-be :after ((self ogl-node))
+ (bwhen (dl (^dsp-list))
+ (gl-delete-lists dl 1)))
+
+
+
+
;;;(defmethod ix-render-prep (self)
;;; (declare (ignore self)))
;;;
@@ -133,12 +163,19 @@
(assert (lr self))
(assert (lb self)))
+(defmethod ogl-shared-resource-tender ((self image))
+ .w.)
+
+(defmethod ogl-node-window ((self image))
+ .w.)
(defmethod ogl-dsp-list-prep progn ((self image))
(ogl-dsp-list-prep (skin self)))
(defmethod ogl-dsp-list-prep progn ((self wand-texture))
- (texture-name self))
+ (texture-name self))
+
+
;------------------------------
(def-c-output mouse-over-p ()
Index: cell-cultures/cello/ix-styled.lisp
diff -u cell-cultures/cello/ix-styled.lisp:1.3 cell-cultures/cello/ix-styled.lisp:1.4
--- cell-cultures/cello/ix-styled.lisp:1.3 Fri Oct 15 05:37:21 2004
+++ cell-cultures/cello/ix-styled.lisp Thu Oct 28 02:08:56 2004
@@ -109,16 +109,16 @@
(defmethod ix-find-style (self style-id)
(declare (ignore self style-id)))
+
(defmethod ogl-dsp-list-prep progn ((self ix-styled) &aux (font (text-font self)))
(assert (not *ogl-listing-p*))
(trc nil "ogl-dsp-list-prep sub-prepping font" font)
(typecase font
(ftgl-extruded
(unless (ftgl::ftgl-disp-ready-p font)
- (fgc-set-face-size (ftgl::ftgl-get-metrics-font font)
- (ftgl::ftgl-size font) (ftgl::ftgl-target-res font)))
- (ix-string-width self (^display-text$))))
- (ftgl::ftgl-get-display-font font))
+ (setf (ftgl::ftgl-disp-ready-p font) t)
+ (fgc-set-face-size (ftgl-ensure-ifont font)
+ (ftgl::ftgl-size font) (ftgl::ftgl-target-res font))))))
(defmethod make-style-font ((style gui-style-glut-stroke))
(make-font-glut-stroke
Index: cell-cultures/cello/ix-text.lisp
diff -u cell-cultures/cello/ix-text.lisp:1.3 cell-cultures/cello/ix-text.lisp:1.4
--- cell-cultures/cello/ix-text.lisp:1.3 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/ix-text.lisp Thu Oct 28 02:08:56 2004
@@ -69,6 +69,18 @@
(:default-initargs
:lighting :off))
+
+(defmethod ogl-dsp-list-prep progn ((self ix-text) &aux (font (text-font self)))
+ (assert (not *ogl-listing-p*))
+ (trc nil "ogl-dsp-list-prep sub-prepping font" font)
+ (typecase font
+ (ftgl-extruded
+ (unless (ftgl::ftgl-disp-ready-p font)
+ (setf (ftgl::ftgl-disp-ready-p font) t)
+ (fgc-set-face-size (ftgl-ensure-ifont font)
+ (ftgl::ftgl-size font) (ftgl::ftgl-target-res font)))
+ (ix-string-width self (^display-text$)))))
+
(defmacro alabel (text &rest key-arg-pairs)
`(cells::make-part (gensym "ALABEL") 'ix-text
, at key-arg-pairs
Index: cell-cultures/cello/mg-geometry.lisp
diff -u cell-cultures/cello/mg-geometry.lisp:1.1 cell-cultures/cello/mg-geometry.lisp:1.2
--- cell-cultures/cello/mg-geometry.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/mg-geometry.lisp Thu Oct 28 02:08:56 2004
@@ -38,7 +38,8 @@
(defun mkv2 (h v) (make-v2 :h h :v v))
(defun v2= (a b)
- (and (= (v2-h a)(v2-h b))
+ (and a b
+ (= (v2-h a)(v2-h b))
(= (v2-v a)(v2-v b))))
(defun v2-add (p1 p2)
Index: cell-cultures/cello/window.lisp
diff -u cell-cultures/cello/window.lisp:1.4 cell-cultures/cello/window.lisp:1.5
--- cell-cultures/cello/window.lisp:1.4 Fri Oct 15 05:37:21 2004
+++ cell-cultures/cello/window.lisp Thu Oct 28 02:08:56 2004
@@ -24,12 +24,10 @@
;------------- Window ---------------
;
-(defmodel window (focuser ix-lit-scene control)
+(defmodel window (focuser ix-lit-scene control ogl-shared-resource-tender)
(
(glutw :initarg :glutw :accessor glutw
:initform (c? (without-c-dependency (glutw-create self))))
- (display-lists :cell nil :initform nil :accessor display-lists)
- (quadrics :cell nil :initform nil :accessor quadrics)
(redisplayp :cell nil :initarg :redisplayp :initform nil :accessor redisplayp)
(glut-xy :initarg :glut-xy
:unchanged-if 'v2= :initform (mkv2 96 96) :accessor glut-xy)
@@ -114,6 +112,12 @@
(defmethod ogl-dsp-list-prep progn ((self window))
(glutw self))
+(defmethod ogl-node-window ((self window))
+ self)
+
+(defmethod ogl-shared-resource-tender ((self window))
+ self)
+
(defun window-menus-basic ()
(list
(list "File"
@@ -363,23 +367,7 @@
(when must-find-p
(c-break "no mgw matches glutw ~d" gw)))))))
-(defmethod ogl-list-cache ((self image))
- (display-lists .w.))
-
-(defmethod (setf ogl-list-cache) (new-value (self image))
- (setf (ogl-list-cache .w.) new-value))
-
-(defmethod ogl-list-cache ((self window))
- (display-lists self))
-
-(defmethod (setf ogl-list-cache) (new-value (self window))
- (setf (display-lists self) new-value))
-
(defmethod not-to-be :before ((self window))
- (loop for (nil . q) in (quadrics self)
- do
- (glu-delete-quadric q))
- (ogl-lists-delete self)
(when (upper self window) ;; better way to detect appropriateness?
(when (glutw self)
(glut-destroy-window (glutw self)))))
@@ -436,7 +424,7 @@
(flet ((projection ()
(gl-matrix-mode gl_projection)
(gl-load-identity)
- (trc "paint> 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*)
@@ -460,7 +448,7 @@
(with-metrics (nil nil "ix-paint window call next")
(call-next-method)))))
-(defun w-quadric-ensure (key)
- (or (cdr (assoc key (quadrics *window-rendering*)))
+(defun w-quadric-ensure (ogl-resource-tender key)
+ (or (cdr (assoc key (quadrics ogl-resource-tender)))
(cdar (push (cons key (glu-new-quadric))
- (quadrics *window-rendering*)))))
\ No newline at end of file
+ (quadrics ogl-resource-tender)))))
\ No newline at end of file
More information about the Cells-cvs
mailing list