From ktilton at common-lisp.net Mon Jul 3 00:35:12 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:12 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060703003512.7F0642E1AB@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv10432 Modified Files: application.lisp cello-window.lisp cello.lpr ctl-toggle.lisp image.lisp ix-opengl.lisp ix-paint.lisp ix-text.lisp ix-togl.lisp nehe-06.lisp Log Message: --- /project/cello/cvsroot/cello/application.lisp 2006/06/05 01:47:49 1.4 +++ /project/cello/cvsroot/cello/application.lisp 2006/07/03 00:35:12 1.5 @@ -22,7 +22,8 @@ (defun cello-reset (&optional (system-type 'mg-system)) (ffx-reset) - (cells-reset 'tk-client-queue-handler) + (cells-reset 'tk-user-queue-handler) + (makunbound 'ogl::*gl-stop*) (when system-type (setf *sys* (make-instance system-type :md-name 'mgsys))) (values)) --- /project/cello/cvsroot/cello/cello-window.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/07/03 00:35:12 1.2 @@ -72,7 +72,7 @@ ; (case (ctk::tk-event-type (ctk::xsv type xe)) (:virtualevent ) - (:KeyPress ) + (:KeyPress ) ;; this and next handled as app virtual events because Tcl events useless (:KeyRelease ) (:ButtonPress ) (:ButtonRelease ) --- /project/cello/cvsroot/cello/cello.lpr 2006/06/26 17:05:20 1.7 +++ /project/cello/cvsroot/cello/cello.lpr 2006/07/03 00:35:12 1.8 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) @@ -26,7 +26,6 @@ (make-instance 'module :name "ix-styled.lisp") (make-instance 'module :name "ix-text.lisp") (make-instance 'module :name "ix-togl.lisp") - (make-instance 'module :name "window-callbacks.lisp") (make-instance 'module :name "lighting.lisp") (make-instance 'module :name "ctl-toggle.lisp") (make-instance 'module :name "ctl-markbox.lisp") --- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/06/05 01:47:49 1.2 +++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/07/03 00:35:12 1.3 @@ -111,6 +111,7 @@ )) :ll 0 :lt 0 :lr (u96ths 15) :lb (downs (u96ths 15)))) + (defmacro mk-twisted (twisted-name (label-class &rest label-args) (twisted-class &rest twisted-args)) `(mk-part :twisted-group (ix-zero-tl) --- /project/cello/cvsroot/cello/image.lisp 2006/06/26 17:05:20 1.7 +++ /project/cello/cvsroot/cello/image.lisp 2006/07/03 00:35:12 1.8 @@ -17,7 +17,7 @@ (in-package :cello) (eval-when (compile load eval) - (export '(ix-view))) + (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy))) ; ------------------------------------------------------ (defmodel ogl-quadric-based (ogl-node) @@ -69,8 +69,7 @@ ;;------- IXFamily ----------------------------- ;; (defmodel ix-family (ix-view family) - ( - (styles :initform nil :reader styles :initarg :styles) + ((styles :initform nil :reader styles :initarg :styles) (effective-styles :reader effective-styles :initarg :effective-styles :initform nil #+(or) (ix-family-effective-styles)) @@ -80,33 +79,55 @@ (kids-ever-shown :initarg :kids-ever-shown :initform (c? (or .cache (^showkids))) - :reader kids-ever-shown) - )) + :reader kids-ever-shown))) (defmodel ix-inline (geo-inline ix-view)()) +(defmodel ix-inline-lazy (geo-inline-lazy ix-view)()) (defmodel ix-stack (ix-inline) () (:default-initargs :orientation :vertical)) +(defmodel ix-stack-lazy (ix-inline-lazy) + () + (:default-initargs + :orientation :vertical)) + (defmodel ix-row (ix-inline) () (:default-initargs :orientation :horizontal)) +(defmodel ix-row-lazy (ix-inline-lazy) + () + (:default-initargs + :orientation :horizontal)) + (defmacro a-stack ((&rest stack-args) &body dd-kids) `(mk-part ,(copy-symbol 'stk) (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) + , at stack-args + :fm-parent *parent* + :kids (c? (the-kids , at dd-kids)))) + (defmacro a-row ((&rest stack-args) &body dd-kids) `(mk-part ,(copy-symbol 'row) (ix-row) , at stack-args :fm-parent *parent* :kids (c? (the-kids , at dd-kids)))) +(defmacro a-row-lazy ((&rest stack-args) &body dd-kids) + `(mk-part ,(copy-symbol 'row) (ix-row-lazy) + , at stack-args + :fm-parent *parent* + :kids (c? (the-kids , at dd-kids)))) + (defmethod focus-starting ((self ix-family)) (some #'focus-find-first (kids self))) @@ -115,13 +136,7 @@ `(let* ((,kid ,self)) (find-prior ,kid (kids (fm-parent ,kid)))))) -(defmethod md-awaken :after ((self ix-view)) - (assert (px self)) - (assert (py self)) - (assert (ll self)) - (assert (lt self)) - (assert (lr self)) - (assert (lb self))) + (defmethod ogl-shared-resource-tender ((self ix-view)) .w.) @@ -164,6 +179,7 @@ (v2 (v2-h v)) (ix-view (inset-h (inset v))))) + (defun inset-v (v) (etypecase v (number v) @@ -190,7 +206,7 @@ (g-offset (fm-parent self) oh ov)))) (defun w-bottom-left (self) - (v2-move (g-offset self) + (v2-add (g-offset self) (ll self) (+ (lb self) (l-height .w.)))) --- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/03 00:35:12 1.2 @@ -55,7 +55,7 @@ (defmodel ogl-node () ((ogl-context :cell nil :initform nil :accessor ogl-context) (dsp-list :initarg :dsp-list :accessor dsp-list - :initform (c-formula (:lazy :until-asked) + :initform nil #+not (c-formula (:lazy :until-asked) (assert (not *ogl-listing-p*)) (progn (ogl-dsp-list-prep self) @@ -66,12 +66,12 @@ (*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) + (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 "ix-paint" self) (ix-paint self))) - (trc nil "finished display list" display-list-name self) + (trc nil "---------------finished display list" display-list-name self) (gl-end-list) (setf (redisplayp .og.) t) display-list-name))))) --- /project/cello/cvsroot/cello/ix-paint.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-paint.lisp 2006/07/03 00:35:12 1.2 @@ -25,11 +25,13 @@ (c-assert (px k) () "pX is null in ~a" k) (c-assert (py k) () "pY is null in ~a" k) - (count-it :call-list) + (if (dsp-list k) (progn - (trc nil "ix-paint calling list" (dsp-list k)) - (gl-call-list (dsp-list k))) + (count-it :call-list) + (trc "ix-paint calling list" (dsp-list k)) + (gl-call-list (dsp-list k))) ; 06/0629 edit caret presences causes INVALID_OP on + ; first run only in a session; just continue from (ix-paint k)))) (defun rpchk (id pfail psucc &optional self) @@ -50,6 +52,7 @@ (let ((ixr-box (mkr 0 0 0 0))) (defmethod ix-paint :around ((self ix-view) &aux (n (gl-name self))) (trc nil "painting, shifting bitmap" self n (^px)(^py) (pre-layer self)) + (with-bitmap-shifted ((px self)(py self)) (gl-translatef (px self) (py self) 0) @@ -69,6 +72,55 @@ (count-it :ix-render) #+(or) (count-it :ix-paint (type-of self)) #+(or) (unless (kids self) + (count-it :ix-render-atom)) + (trc nil "ix painting" self (^px)(^py)(l-box 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))))))) + (when n + (gl-pop-name)) + (gl-translatef (- (px self)) (- (py self)) 0)) + + )) + +#+new +(let ((ixr-box (mkr 0 0 0 0))) + (defmethod ix-paint :around ((self ix-view) &aux (n (gl-name self))) + (trc nil "painting, shifting bitmap" self n (^px)(^py) (pre-layer self)) + (when (or (c-stopped) + (not (^visible)) + (collapsed self)) + (return-from ix-paint)) + + (with-bitmap-shifted ((px self)(py self)) + (gl-translatef (px self) (py self) 0) + + + (when n + (trc "pushing gl-name" self n) + (gl-push-name n)) + + (rpchk 'ix-paint t nil self) + (when (or (not *selecting*)(ix-selectable 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-paint (type-of self)) + #+(or) (unless (kids self) (count-it :ix-render-atom)) (trc nil "ix painting" self (lighting self)) (with-matrix () --- /project/cello/cvsroot/cello/ix-text.lisp 2006/06/26 17:05:20 1.6 +++ /project/cello/cvsroot/cello/ix-text.lisp 2006/07/03 00:35:12 1.7 @@ -19,7 +19,7 @@ ;=========================================================== (eval-when (compile load eval) - (export '(ix-paint))) + (export '(ix-paint inset))) (defmodel ix-text (ix-styled ix-view) ( @@ -51,7 +51,8 @@ (inset :cell nil :initarg :inset :unchanged-if 'v2= - :initform (mkv2 0 0)) + :initform (mkv2 0 0) + :accessor inset) (ll :initform (c? (- (inset-h self)))) (lt :initform (c? (ups 0 (font-ascent (text-font self)) (inset-v self)))) (lr :initform (c? (^lr-width (+ (cond --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/03 00:35:12 1.2 @@ -85,6 +85,8 @@ (trc nil "window-display > continuous specified so posting redisplay" self) (ctk:togl-post-redisplay (ctk:togl-ptr self)))))) + + (defmethod ix-togl-event-handler (self xe) "Tk does not go inside Togl OpenGL-land, so Cello Classic effectively begins here" (TRC nil "ix-togl-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) ) --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/06/26 17:05:20 1.5 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/03 00:35:12 1.6 @@ -142,7 +142,7 @@ (gl-tex-coord2f 1 1) (v3f -1 1 1) (gl-tex-coord2f 0 1) (v3f -1 1 -1) )) - #+ifuwanttoseepixmap + ;;#+ifuwanttoseepixmap (wand-render *grace* 0 0 1 -1) (progn @@ -171,7 +171,7 @@ (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (test-image "turing" "gif")))) + (test-image "grace" "jpg")))) ; "turing" "gif")))) (defun print-frame-rate (window) (with-slots (frame-count t0) window @@ -188,8 +188,8 @@ (setq t0 time) (setq frame-count 0))))) -(defun test-image (filename filetype) +(defun test-image (filename filetype &optional (subdir "shapers")) (make-pathname - :directory '(:absolute "0dev" "user" "graphics" "shapers") + :directory `(:absolute "0dev" "user" "graphics" ,subdir) :name (string filename) :type (string filetype))) From ktilton at common-lisp.net Mon Jul 3 00:35:12 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:12 -0400 (EDT) Subject: [cello-cvs] CVS cello/cffi-extender Message-ID: <20060703003512.B1F632E1AD@common-lisp.net> Update of /project/cello/cvsroot/cello/cffi-extender In directory clnet:/tmp/cvs-serv10432/cffi-extender Modified Files: cffi-extender.lpr Log Message: --- /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/06/26 17:05:21 1.2 +++ /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/07/03 00:35:12 1.3 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Jul 3 00:35:12 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:12 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060703003512.EE0782E1AB@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv10432/cl-ftgl Modified Files: cl-ftgl.lisp cl-ftgl.lpr Log Message: --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/06/26 17:05:21 1.4 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/03 00:35:12 1.5 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.4 2006/06/26 17:05:21 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.5 2006/07/03 00:35:12 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -60,6 +60,7 @@ (defparameter *gui-style-button-face* 'sylfaen) (defparameter *ftgl-loaded-p* nil) (defparameter *ftgl-fonts-loaded* nil) +(defparameter *ftgl-ogl* nil) ;; ---------------------------------------------------------------------------- ;; FOREIGN FUNCTION INTERFACE @@ -177,6 +178,7 @@ ifont) (defun ftgl-char-width (f c) + (assert *ftgl-ogl*) (or (aref (ftgl-widths f) (char-code c)) (setf (aref (ftgl-widths f) (char-code c)) (ftgl-string-length f (string c))))) @@ -218,17 +220,20 @@ (xftgl) (defun ftgl-get-ascender (font) + (assert *ftgl-ogl*) (or (ftgl-ascender font) (setf (ftgl-ascender font) (fgc-ascender (ftgl-get-metrics-font font))))) (defun ftgl-get-descender (font) + (assert *ftgl-ogl*) (or (ftgl-descender font) (setf (ftgl-descender font) (fgc-descender (ftgl-get-metrics-font font))))) (defun ftgl-height (f) - (+ (ftgl-get-ascender f) + (assert *ftgl-ogl*) + (- (ftgl-get-ascender f) (ftgl-get-descender f))) (defun ftgl-get-display-font (font) @@ -278,7 +283,7 @@ (error "cannot load ~a font ~a" (type-of font) fpath))) (error "Font not found: ~a" path)))) -(defun ftgl-render (font s) +(defmethod ftgl-render (font s) (assert font) (assert (stringp s)) (when font @@ -287,6 +292,12 @@ (fgc-render df s) (break "whoa, no display font for ~a" font))))) +(defmethod ftgl-render :before ((font ftgl-texture) s) + (declare (ignorable s)) + (gl-enable gl_texture_2d) + (gl-enable gl_blend) + (gl-disable gl_lighting)) + (defmethod fgc-font-make :before (font fpath) (declare (ignore font fpath)) (cl-ftgl-init)) @@ -312,6 +323,7 @@ (fgc-polygon-make fpath)) (defun ftgl-string-length (font cs) + ;;(trc "ftgl-string-length" (ftgl-get-metrics-font font) cs) (fgc-string-advance (ftgl-get-metrics-font font) cs)) (defmethod font-bearing-x (font &optional text) --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/06/26 17:05:21 1.5 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/07/03 00:35:12 1.6 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Jul 3 00:35:13 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:13 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060703003513.3219E2E1AB@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv10432/cl-magick Modified Files: cl-magick.lpr wand-pixels.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/06/26 17:05:22 1.3 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/07/03 00:35:13 1.4 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/07/03 00:35:13 1.2 @@ -39,16 +39,17 @@ "only works in ortho mode I think; abstract out raster-pos for perspective" (declare (ignorable right left)) (assert (pixels self)) - #+not (trc nil "!!!! pixelrender entry rasterpos:" + + (ukt:trc nil "!!!! pixelrender entry rasterpos:" (ogl-raster-pos-get) :lrtb (list left right top bottom) :image-sz sz) (let ((y-move (downs (+ 0 (abs (- top bottom)))))) (with-bitmap-shifted (0 y-move) - ;; (trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) - #+hush + (ukt:trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) + (if (ogl-get-boolean gl_current_raster_position_valid) (progn - (format t "~&rasterpos ~a OK: ~a" + #+shh (format t "~&rasterpos ~a OK: ~a" (ogl-raster-pos-get) (list left right top bottom) )) (format t "~&in wand-render rasterpos ~a invalid, goffset is ???" (ogl-raster-pos-get) self )) @@ -69,7 +70,8 @@ (gl-blend-func gl_src_alpha gl_one_minus_src_alpha) (gl-polygon-mode gl_front_and_back gl_fill) #+not (trc nil "wand-pixelling" (ogl-raster-pos-get)) - - (gl-draw-pixels (car sz) (cdr sz) + (gl-pixel-storei gl_unpack_alignment 1 ) + + (gl-draw-pixels (+ (car sz) 0) (cdr sz) gl_rgb gl_unsigned_byte (pixels self)) (ogl::glec :draw-pixels)))) \ No newline at end of file From ktilton at common-lisp.net Mon Jul 3 00:35:15 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:15 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060703003515.E0A8D2F03B@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv10432/cl-openal Modified Files: cl-openal.lpr Log Message: --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/06/26 17:05:33 1.5 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/07/03 00:35:13 1.6 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Jul 3 00:35:16 2006 From: ktilton at common-lisp.net (ktilton) Date: Sun, 2 Jul 2006 20:35:16 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060703003516.4F0B73000F@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv10432/kt-opengl Modified Files: gl-constants.lisp gl-def.lisp gl-functions.lisp glu-functions.lisp kt-opengl.lpr ogl-macros.lisp Log Message: --- /project/cello/cvsroot/cello/kt-opengl/gl-constants.lisp 2006/05/27 06:01:38 1.1 +++ /project/cello/cvsroot/cello/kt-opengl/gl-constants.lisp 2006/07/03 00:35:15 1.2 @@ -174,6 +174,15 @@ (dfc gl_t2f_c4f_n3f_v3f #x2a2c) (dfc gl_t4f_c4f_n3f_v4f #x2a2d) +(defun matrix-mode-symbol (n) + (ecase n + (#x1700 'gl_modelview) + (#x1701 'gl_projection) + (#x1702 'gl_texture))) + +#+test +(assert (eq 'gl_modelview (matrix-mode-symbol #x1700))) + #| matrix mode |# (dfc gl_modelview #x1700) (dfc gl_projection #x1701) --- /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/05/27 06:01:38 1.1 +++ /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/07/03 00:35:16 1.2 @@ -26,6 +26,7 @@ `(defun-ffx ,rtn ,module$ ,name$ (, at type-args) (progn ;;(cells::count-it ,(intern (string-upcase name$) :keyword)) + ;;(format t "~&~(~a~) ~{ ~a~}" ,name$ (list ,@(loop for (nil arg) on type-args by #'cddr collecting arg))) (glec ',(intern name$))))) (defun aforef (o n) --- /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/05/27 06:01:38 1.1 +++ /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/07/03 00:35:16 1.2 @@ -22,7 +22,6 @@ (in-package #:kt-opengl) - (defparameter *ogl-listing-p* nil) (defun-ogl :void "open-gl" "glFlush" ()) @@ -342,7 +341,9 @@ (defun-ogl :void "open-gl" "glScalef" (glfloat x glfloat y glfloat z )) (defun-ogl :void "open-gl" "glTranslated" (gldouble x gldouble y gldouble z )) (defun-ogl :void "open-gl" "glTranslatef" (glfloat x glfloat y glfloat z )) - +#+diehard (DEFUN-FFX :VOID "open-gl" "glTranslatef" (GLFLOAT X GLFLOAT Y GLFLOAT Z) + (PROGN (GLEC '|glTranslatef|) + (ukt:trc (or (not (zerop x))(not (zerop y))) "TRANSLATED" x y z))) (defun-ogl :void "open-gl" "glBitmap" (glsizei width glsizei height glfloat xorig glfloat yorig glfloat xmove glfloat ymove --- /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/05/27 06:01:38 1.1 +++ /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/07/03 00:35:16 1.2 @@ -118,7 +118,6 @@ (dfc GLU_TESS_COORD_TOO_LARGE GLU_TESS_ERROR5) (dfc GLU_TESS_NEED_COMBINE_CALLBACK GLU_TESS_ERROR6) - ;;; **** NURBS constants ****/ ;;; NurbsProperty */ @@ -136,7 +135,6 @@ (dfc GLU_PARAMETRIC_ERROR 100216) (dfc GLU_DOMAIN_DISTANCE 100217) - ;;; NurbsTrim */ (dfc GLU_MAP1_TRIM_2 100210) (dfc GLU_MAP1_TRIM_3 100211) @@ -153,7 +151,6 @@ (dfc GLU_NURBS_ERROR1 100251) (dfc GLU_NURBS_ERROR37 100287) - (defun-ogl (* glubyte) "gl-util" "gluErrorString" (glenum error)) ;;;(defun-ogl GLubyte *"gl-util" "gluGetString" (GLenum name)) ;;;(defun-ogl void "gl-util" "gluLoadSamplingMatrices" (GLUnurbs *nurb GLfloat *model GLfloat *perspective GLint *view)) --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/06/26 17:05:33 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/07/03 00:35:16 1.3 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/06/26 17:05:33 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/07/03 00:35:16 1.4 @@ -24,6 +24,9 @@ (in-package :kt-opengl) +(eval-when (compile load eval) + (export '(with-gl-translation))) + (defvar *stack-depth* (fgn-alloc :int 1 :ignore)) @@ -41,34 +44,42 @@ (funcall matrix-fn)) (gl-pop-matrix))) +(defun get-stack-depth (mm) + (gl-get-integerv + (ecase (matrix-mode-symbol mm) + (gl_modelview gl_modelview_stack_depth) + (gl_projection gl_projection_stack_depth) + (gl_texture gl_texture_stack_depth)) + *stack-depth*) + (aforef *stack-depth* 0)) + +(defun get-matrix-mode () + (gl-get-integerv gl_matrix_mode *ogl-int*) + (eltgli *ogl-int* 0)) + #+debugversion (defun call-with-matrix (load-identity-p matrix-fn matrix-code) - (let ((mm-pushed (ogl::get-matrix-mode)) - (sd-pushed (ogl::get-stack-depth))) - - (gl-push-matrix) - (glec :with-matrix-push) - (unwind-protect - (progn - (when (eql gl_modelview_matrix mm-pushed) - (gl-get-integerv gl_modelview_stack_depth *stack-depth*) - (glec :get-stack-depth) - (print `(with-matrix model matrix stack ,(aforef *stack-depth* 0)))) - - (when load-identity-p - (gl-load-identity)) - (prog1 - (funcall matrix-fn) - (glec :with-matrix))) - (assert (eql mm-pushed (ogl::get-matrix-mode))() - "matrix-mode left as ~a instead of ~a by form ~a" - (ogl::get-matrix-mode) mm-pushed matrix-code) - (gl-pop-matrix) - (assert (eql sd-pushed (ogl::get-stack-depth))() - "matrix depth deviated ~d during ~a" - (- sd-pushed (ogl::get-stack-depth)) - matrix-code) - (glec :exit-with-stack)))) + (let* ((mm-pushed (get-matrix-mode)) + (sd-pushed (get-stack-depth mm-pushed))) + (ukt::wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) + (gl-push-matrix) + (unwind-protect + (progn + (when load-identity-p + (gl-load-identity)) + (prog1 + (funcall matrix-fn) + (glec :with-matrix-body))) + (assert (eql mm-pushed (get-matrix-mode))() + "matrix-mode left as ~a instead of ~a by form ~a" + (ogl::get-matrix-mode) mm-pushed matrix-code) + (ukt:trc "poppping matrix!!!!!" (matrix-mode-symbol (get-matrix-mode)) :from-depth (get-stack-depth (get-matrix-mode))) + (gl-pop-matrix) + (assert (eql sd-pushed (get-stack-depth mm-pushed))() + "matrix depth deviated ~d during ~a" + (- sd-pushed (get-stack-depth mm-pushed)) + matrix-code) + (glec :exit-with-stack))))) (defmacro with-attrib ((&rest attribs) &body body) `(call-with-attrib @@ -148,16 +159,19 @@ (kt-opengl-init)) (defun glec (&optional (id :anon)) - (unless (and (boundp '*gl-begun*) *gl-begun*) + (if (and (boundp '*gl-begun*) *gl-begun*) + (progn #+shhh (ukt:trc "not checking error inside gl-begin" id)) (let ((e (glgeterror))) (if (zerop e) (unless t ;; (find id '(glutcheckloop glutgetwindow)) (print `(cool ,id))) (if t ;; (null (find id '(glutInitDisplayMode glutInitWindowSize))) - (unless (boundp '*gl-stop*) - (setf *gl-stop* t) - (format t "~&~%OGL error ~a at ID ~a" e id) - ;(break "OGL error ~a at ID ~a" e id) - ) + (if (boundp '*gl-stop*) + (ukt:trc "error but *gl-stop* already bound" e id) + (progn + (setf *gl-stop* t) + (format t "~&~%OGL error ~a at ID ~a" e id) + (break "OGL error ~a at ID ~a" e id) + )) #+sigh (print `("OGL error ~a at ID ~a" ,e ,id))))))) From ktilton at common-lisp.net Thu Jul 6 22:09:10 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:10 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060706220910.AF55E3000F@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv9972 Modified Files: cello-magick.lisp cello-openal.lisp cello.asd cello.lisp cello.lpr colors.lisp ctl-markbox.lisp focus.lisp image.lisp ix-canvas.lisp ix-family.lisp ix-layer-expand.lisp ix-opengl.lisp ix-text.lisp ix-togl.lisp nehe-06.lisp Log Message: --- /project/cello/cvsroot/cello/cello-magick.lisp 2006/06/26 17:05:20 1.4 +++ /project/cello/cvsroot/cello/cello-magick.lisp 2006/07/06 22:09:10 1.5 @@ -16,8 +16,6 @@ (in-package :cello) -(defpackage :cello (:use #:cl-magick)) - (eval-when (compile load eval) (defmethod ix-layer-expand ((key (eql :wand)) &rest args) `(let ((wand ,(car args))) --- /project/cello/cvsroot/cello/cello-openal.lisp 2006/06/26 17:05:20 1.3 +++ /project/cello/cvsroot/cello/cello-openal.lisp 2006/07/06 22:09:10 1.4 @@ -14,8 +14,6 @@ |# -(defpackage #:cello (:use #:cl-openal)) - (in-package :cello) (defstruct sound paths (gain 1) callback loopingp start (source :default) buffer sources) --- /project/cello/cvsroot/cello/cello.asd 2006/06/05 01:47:49 1.3 +++ /project/cello/cvsroot/cello/cello.asd 2006/07/06 22:09:10 1.4 @@ -17,48 +17,47 @@ :description "A Portable Common Lisp GUI" :long-description "The final pieces of a portable Common Lisp GUI" - :depends-on (:cells :gui-geometry :cl-opengl :cl-magick) - :components ((:file "cello") - (:file "window-macros" :depends-on ("cello")) - (:file "clipping" :depends-on ("cello")) - (:file "colors" :depends-on ("clipping")) - (:file "frame" :depends-on ("colors")) - (:file "application" :depends-on ("frame")) - (:file "image" - :depends-on ("application" - "window-macros" "clipping")) - (:file "ix-layer-expand" :depends-on ("cello" "image" "frame")) - (:file "ix-opengl" :depends-on ("image")) - (:file "ix-canvas" :depends-on ("ix-layer-expand")) - (:file "ix-family" :depends-on ("cello" "ix-canvas")) - (:file "font" :depends-on ("image")) - (: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 "ix-togl" :depends-on ("ix-text")) - (:file "lighting" :depends-on ("ix-inline")) - (:file "cello-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 ("cello-window")) - (:file "window-callbacks" :depends-on ("window-utilities")) - (:file "wm-mouse" :depends-on ("window-callbacks")) - (:file "pick" :depends-on ("wm-mouse")) - (:file "ix-render" :depends-on ("pick")) - (:file "ix-polygon" :depends-on ("ix-render")) - (:file "cello-ftgl") - (:file "cello-openal") - (:file "cello-magick" :depends-on ("cello-ftgl")) - (:file "nehe-06" :depends-on ("cello-magick")) - )) + :depends-on (:cells :gui-geometry :kt-opengl :cffi-extender :cl-magick + :celtk :cl-openal) + :serial t + :components + ((:file "cello") + (:file "window-macros") + (:file "clipping") + (:file "colors") + (:file "ix-layer-expand") + (:file "frame") + (:file "application") + (:file "image") + (:file "ix-opengl") + (:file "ix-canvas") + (:file "ix-family") + (:file "font") + (:file "ix-grid") + (:file "mouse-click") + (:file "control") + (:file "focus") + (:file "focus-navigation") + (:file "focus-utilities") + (:file "ix-styled") + (:file "ix-text") + (:file "ix-togl") + (:file "lighting") + (:file "ctl-toggle") + (:file "ctl-markbox") + (:file "ctl-drag") + (:file "ctl-selectable") + (:file "slider") + (:file "cello-window") + (:file "window-utilities") + (:file "wm-mouse") + (:file "pick") + (:file "ix-paint") + (:file "ix-polygon") + (:file "cello-ftgl") + (:file "cello-magick") + (:file "cello-openal") + (:file "nehe-06"))) --- /project/cello/cvsroot/cello/cello.lisp 2006/06/26 17:05:20 1.6 +++ /project/cello/cvsroot/cello/cello.lisp 2006/07/06 22:09:10 1.7 @@ -18,7 +18,7 @@ (:nicknames :clo) (:use #:common-lisp - #-(or ccl cormanlisp) #:clos + #-(or ccl cormanlisp sbcl) #:clos #:utils-kt #:cells #:gui-geometry @@ -41,4 +41,4 @@ () (:default-initargs :ll 0 :lt 0 :lr (u96ths 48) - :lb (u96ths 24))) \ No newline at end of file + :lb (u96ths 24))) --- /project/cello/cvsroot/cello/cello.lpr 2006/07/03 00:35:12 1.8 +++ /project/cello/cvsroot/cello/cello.lpr 2006/07/06 22:09:10 1.9 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 5, 2006 12:21)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/colors.lisp 2006/06/05 01:47:49 1.3 +++ /project/cello/cvsroot/cello/colors.lisp 2006/07/06 22:09:10 1.4 @@ -70,7 +70,7 @@ (cffi:mem-aref co :float 2) (cffi:mem-aref co :float 3))) -(eval-when (compile load execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(+white+ +red+ +dark-green+ +green+ +turqoise+ +dk-blue+ +blue+ +lt-blue+ +black+ +yellow+ +lt-yellow+ +purple+ +gray+ +lt-gray+ +dk-gray+))) --- /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/06/26 17:05:20 1.5 +++ /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/07/06 22:09:10 1.6 @@ -18,7 +18,7 @@ (defparameter *mark-box-size* (u96ths 9)) -(eval-when (compile load eval) +(eval-now! (defmethod ix-layer-expand ((self (eql :x-mark)) &rest args) `(ix-render-x-mark ,(car args) l-box))) --- /project/cello/cvsroot/cello/focus.lisp 2006/06/26 17:05:20 1.3 +++ /project/cello/cvsroot/cello/focus.lisp 2006/07/06 22:09:10 1.4 @@ -34,7 +34,7 @@ it without it being a kid there |# -(eval-when (compile load eval) +(eval-now! (export '(^focus focus))) (defmodel focuser (ix-canvas) --- /project/cello/cvsroot/cello/image.lisp 2006/07/03 00:35:12 1.8 +++ /project/cello/cvsroot/cello/image.lisp 2006/07/06 22:09:10 1.9 @@ -147,6 +147,10 @@ (defmethod path ((self ix-view)) (path (fm-parent self))) +(defgeneric ogl-dsp-list-prep (self) + (:method-combination progn) + (:documentation "Do stuff needed before render but not needed/wanted in display list")) + (defmethod ogl-dsp-list-prep progn ((self ix-view)) (ogl-dsp-list-prep (skin self))) --- /project/cello/cvsroot/cello/ix-canvas.lisp 2006/06/05 01:47:49 1.3 +++ /project/cello/cvsroot/cello/ix-canvas.lisp 2006/07/06 22:09:10 1.4 @@ -156,7 +156,7 @@ (target-res self) (cs-logical-screen-resolution)))) -(eval-when (compile load eval) +(eval-now! (export '(ix-canvas target-res))) --- /project/cello/cvsroot/cello/ix-family.lisp 2006/06/05 01:47:49 1.3 +++ /project/cello/cvsroot/cello/ix-family.lisp 2006/07/06 22:09:10 1.4 @@ -16,7 +16,7 @@ (in-package :cello) -(eval-when (compile load eval) +(eval-now! (export '(a-stack a-row))) --- /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/06/11 13:32:24 1.5 +++ /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/07/06 22:09:10 1.6 @@ -253,8 +253,8 @@ ;;for dbg = (and (eql dx 1)(eql dy 1)(not no-turn-p)) do (destructuring-bind (xyn0 ix0 iy0 ox0 oy0) (cons (+ (if oc (/ theta 2) 0) - (case dx (1 (case dy (1 0)(-1 (/ pi -2)))) - (-1 (case dy (1 (/ pi 2))(-1 pi))))) + (ecase dx (1 (ecase dy (1 0)(-1 (/ pi -2)))) + (-1 (ecase dy (1 (/ pi 2))(-1 pi))))) (if oc (case (* dx dy) (1 (list (* dx ix)(* dy by)(* dx ox)(* dy by))) --- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/06 22:09:10 1.3 @@ -17,10 +17,6 @@ (in-package :cello) -(defgeneric ogl-dsp-list-prep (self) - (:method-combination progn) - (:documentation "Do stuff needed before render but not needed/wanted in display list")) - (defmethod ogl-dsp-list-prep progn (self) (declare (ignore self)) (assert (not *ogl-listing-p*))) --- /project/cello/cvsroot/cello/ix-text.lisp 2006/07/03 00:35:12 1.7 +++ /project/cello/cvsroot/cello/ix-text.lisp 2006/07/06 22:09:10 1.8 @@ -58,7 +58,8 @@ (lr :initform (c? (^lr-width (+ (cond ((char-mask self) (ix-string-width self (char-mask self))) ((^text-width)) - ((ix-string-width self (char-mask self)))) + ((^maxcharwidth)) + (t (error "Please specify a font or :lr ."))) (* 2 (inset-h self)))))) (lb :initform (c? (downs 0 (font-descent (text-font self)) (inset-v self)))) ) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/06 22:09:10 1.3 @@ -16,7 +16,7 @@ (in-package :cello) -(eval-when (compile load eval) +(eval-now! (export '(ix-togl-event-handler))) ;------------- Window --------------- --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/03 00:35:12 1.6 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/06 22:09:10 1.7 @@ -171,7 +171,7 @@ (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (test-image "grace" "jpg")))) ; "turing" "gif")))) + (test-image "graceblue" "jpg")))) ; "turing" "gif")))) (defun print-frame-rate (window) (with-slots (frame-count t0) window From ktilton at common-lisp.net Thu Jul 6 22:09:10 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:10 -0400 (EDT) Subject: [cello-cvs] CVS cello/cffi-extender Message-ID: <20060706220910.EEF913000F@common-lisp.net> Update of /project/cello/cvsroot/cello/cffi-extender In directory clnet:/tmp/cvs-serv9972/cffi-extender Modified Files: arrays.lisp callbacks.lisp definers.lisp my-uffi-compat.lisp Log Message: --- /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/06/04 00:09:53 1.1 +++ /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/07/06 22:09:10 1.2 @@ -185,7 +185,7 @@ (defmacro fgn-pa (pa n) `(mem-aref ,pa :pointer ,n)) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(ffx-reset ff-elt ff-list eltf eltd elti fgn-pa --- /project/cello/cvsroot/cello/cffi-extender/callbacks.lisp 2006/06/04 00:09:53 1.1 +++ /project/cello/cvsroot/cello/cffi-extender/callbacks.lisp 2006/07/06 22:09:10 1.2 @@ -67,7 +67,7 @@ -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(ff-register-callable ff-defun-callable ff-pointer-address))) \ No newline at end of file --- /project/cello/cvsroot/cello/cffi-extender/definers.lisp 2006/06/04 00:09:53 1.1 +++ /project/cello/cvsroot/cello/cffi-extender/definers.lisp 2006/07/06 22:09:10 1.2 @@ -22,7 +22,7 @@ (in-package :ffx) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '( defun-ffx defun-ffx-multi dffr --- /project/cello/cvsroot/cello/cffi-extender/my-uffi-compat.lisp 2006/06/04 00:09:53 1.1 +++ /project/cello/cvsroot/cello/cffi-extender/my-uffi-compat.lisp 2006/07/06 22:09:10 1.2 @@ -1,6 +1,6 @@ (in-package :ffx) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(falloc))) ;;;(defun deref-array (array type position) From ktilton at common-lisp.net Thu Jul 6 22:09:11 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:11 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060706220911.3A4A430010@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv9972/cl-ftgl Modified Files: cl-ftgl.lisp Log Message: --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/03 00:35:12 1.5 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/06 22:09:11 1.6 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.5 2006/07/03 00:35:12 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.6 2006/07/06 22:09:11 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -51,7 +51,7 @@ (in-package :cl-ftgl) (define-foreign-library FTGL - (:darwin (:framework "FTGL")) + (:darwin (:or (:framework "FTGL") "libftgl.dylib")) (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) (use-foreign-library FTGL) @@ -177,8 +177,12 @@ ft-metrics ifont) +(defun ftgl-assert-opengl-context () + ;; use when debugging FTGL being hit before opengl context estanblished (assert *ftgl-ogl*) + ) + (defun ftgl-char-width (f c) - (assert *ftgl-ogl*) + (ftgl-assert-opengl-context) (or (aref (ftgl-widths f) (char-code c)) (setf (aref (ftgl-widths f) (char-code c)) (ftgl-string-length f (string c))))) @@ -220,19 +224,19 @@ (xftgl) (defun ftgl-get-ascender (font) - (assert *ftgl-ogl*) + (ftgl-assert-opengl-context) (or (ftgl-ascender font) (setf (ftgl-ascender font) (fgc-ascender (ftgl-get-metrics-font font))))) (defun ftgl-get-descender (font) - (assert *ftgl-ogl*) + (ftgl-assert-opengl-context) (or (ftgl-descender font) (setf (ftgl-descender font) (fgc-descender (ftgl-get-metrics-font font))))) (defun ftgl-height (f) - (assert *ftgl-ogl*) + (ftgl-assert-opengl-context) (- (ftgl-get-ascender f) (ftgl-get-descender f))) From ktilton at common-lisp.net Thu Jul 6 22:09:11 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:11 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060706220911.8EFD130010@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv9972/cl-magick Modified Files: cl-magick.asd cl-magick.lisp cl-magick.lpr mgk-utils.lisp wand-image.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/07/06 22:09:11 1.2 @@ -16,6 +16,7 @@ :licence "MIT" :description "Bindings for ImageMagick" :long-description "Poorly implemented bindings to half of ImageMagick" + :depends-on (gui-geometry) :components ((:file "cl-magick") (:file "magick-wand" :depends-on ("cl-magick")) (:file "drawing-wand" :depends-on ("magick-wand")) @@ -23,5 +24,4 @@ (:file "mgk-utils" :depends-on ("pixel-wand")) (:file "wand-image" :depends-on ("mgk-utils")) (:file "wand-texture" :depends-on ("wand-image")) - (:file "wand-pixels" :depends-on ("wand-texture")) - (:file "mgk-test" :depends-on ("wand-pixels")))) + (:file "wand-pixels" :depends-on ("wand-texture")))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/06/26 17:05:22 1.4 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/07/06 22:09:11 1.5 @@ -25,7 +25,7 @@ (:use #:common-lisp #:gui-geometry - #-(or cormanlisp ccl) #:clos + #-(or cormanlisp ccl sbcl) #:clos #:cffi #:cffi-extender #+kt-opengl @@ -58,7 +58,7 @@ (defparameter *mgk-version* (fgn-alloc :unsigned-long 1)) (cffi:define-foreign-library Magick - (:darwin (:framework "GraphicsMagick")) + (:darwin (:or (:framework "GraphicsMagick") "libGraphicsMagick.dylib")) (:windows (:or #+not "C:\\Program Files\\ImageMagick-6.2.7-Q8\\CORE_RL_wand_.dll" "C:\\Program Files\\GraphicsMagick-1.1.7-Q8\\CORE_RL_wand_.dll"))) @@ -103,7 +103,7 @@ (let ((wi (apply 'make-instance wand-type :file-path$ file-path$ iargs))) - (print `(wand-ensure-typed forced to load ,wand-type ,file-path$)) + ;;(print `(wand-ensure-typed forced to load ,wand-type ,file-path$)) (push (cons key wi) (wands-loaded)) wi) (error "Unable to load image file ~a" file-path$))))) --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/07/03 00:35:13 1.4 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/07/06 22:09:11 1.5 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 5, 2006 12:21)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp 2006/07/06 22:09:11 1.2 @@ -22,7 +22,7 @@ (in-package :cl-magick) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(pixels-to-file wand-image-pixels-set make-recording record-frame recording-write recording-destroy))) --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/07/06 22:09:11 1.2 @@ -69,7 +69,7 @@ (let ((stat (magick-read-image wand p))) (if (zerop stat) (format t "~&magick-read jpeg failed on ~a" p) - (format t "~&magick-read-OK ~a" p))) + #+shhh (format t "~&magick-read-OK ~a" p))) wand)) (defparameter *mgk-columns* @@ -90,7 +90,7 @@ (if (zerop (* last-col last-row)) (let* ((columns 64)(rows 64) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) - (print "wand-get-image-pixels > wand has zero pixels; did the load fail?") + ;(print "wand-get-image-pixels > wand has zero pixels; did the load fail?") (dotimes (pn (* columns rows)) (setf (elti pixels pn) -1)) (values pixels columns rows)) @@ -98,7 +98,9 @@ (let* ((columns (- last-col first-col)) (rows (- last-row first-row)) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) - (print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) + (ukt:trc "wand pixels has colrowa" columns rows) + + ;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) #+testing (progn (incf testn) @@ -106,5 +108,11 @@ (print `(writeimage ,(magick-write-image wand (format nil "C:\\TEST~a.GIF" testn)))) #+not (print `(writeimage ,(magick-write-image wand "C:\\TEST.BMP")))) + (loop for row below 16 do + (loop for col below 16 by 1 + for offset = (+ (* row columns 3) (* col 3)) + do (print (loop for bn below 3 + collecting (setf (elti pixels (+ offset bn)) 0))))) + (values pixels columns rows)))) From ktilton at common-lisp.net Thu Jul 6 22:09:11 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:11 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060706220911.C3ABC3000F@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv9972/cl-openal Modified Files: cl-openal.asd Log Message: --- /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.asd 2006/07/06 22:09:11 1.2 @@ -16,6 +16,7 @@ :licence "MIT" :description "Partial OpenAL Bindings" :long-description "Poorly implemented bindings to half of OpenAL" + :depends-on (cffi cffi-extender) :perform (load-op :after (op cl-openal) (pushnew :cl-openal cl:*features*)) :components ((:file "cl-openal") @@ -28,4 +29,4 @@ (:file "cl-openal-init" :depends-on ("alut")) (:file "wav-handling" :depends-on ("cl-openal-init")) - (:file "cl-openal-demo" :depends-on ("wav-handling")))) \ No newline at end of file + (:file "cl-openal-demo" :depends-on ("wav-handling")))) From ktilton at common-lisp.net Thu Jul 6 22:09:14 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 18:09:14 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060706220914.0AF353602A@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv9972/kt-opengl Modified Files: kt-opengl.asd ogl-macros.lisp ogl-utils.lisp Log Message: --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/05/27 06:01:38 1.1 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.asd 2006/07/06 22:09:11 1.2 @@ -13,7 +13,7 @@ :licence "MIT" :description "Partial OpenGL Bindings" :long-description "Poorly implemented bindings to half of OpenGL" - :depends-on (:cffi-extender) + :depends-on (:cffi-extender :cells) :serial t :components ((:file "kt-opengl") (:file "gl-def") --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/07/03 00:35:16 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/07/06 22:09:11 1.5 @@ -24,7 +24,7 @@ (in-package :kt-opengl) -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(with-gl-translation))) (defvar *stack-depth* @@ -44,19 +44,6 @@ (funcall matrix-fn)) (gl-pop-matrix))) -(defun get-stack-depth (mm) - (gl-get-integerv - (ecase (matrix-mode-symbol mm) - (gl_modelview gl_modelview_stack_depth) - (gl_projection gl_projection_stack_depth) - (gl_texture gl_texture_stack_depth)) - *stack-depth*) - (aforef *stack-depth* 0)) - -(defun get-matrix-mode () - (gl-get-integerv gl_matrix_mode *ogl-int*) - (eltgli *ogl-int* 0)) - #+debugversion (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (let* ((mm-pushed (get-matrix-mode)) --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/06/05 01:47:50 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/07/06 22:09:12 1.3 @@ -177,6 +177,19 @@ (defun ogl-raster-pos-get () (gl-get-ints-4 gl_current_raster_position)) +(defun get-stack-depth (mm) + (gl-get-integerv + (ecase (matrix-mode-symbol mm) + (gl_modelview gl_modelview_stack_depth) + (gl_projection gl_projection_stack_depth) + (gl_texture gl_texture_stack_depth)) + *stack-depth*) + (aforef *stack-depth* 0)) + +(defun get-matrix-mode () + (gl-get-integerv gl_matrix_mode *ogl-int*) + (eltgli *ogl-int* 0)) + (defmacro with-bitmap-shifted ((x y) &body body) (let ((xy (gensym))) `(let ((,xy (cons ,x ,y))) From ktilton at common-lisp.net Fri Jul 7 01:14:21 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 6 Jul 2006 21:14:21 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060707011421.ACB5E2B149@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv3104/cl-ftgl Added Files: cl-ftgl.asd Log Message: --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.asd 2006/07/07 01:14:21 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.asd 2006/07/07 01:14:21 1.1 (asdf:defsystem :cl-ftgl :depends-on (:cffi :kt-opengl :cells) :serial t :components ((:file "cl-ftgl"))) From ktilton at common-lisp.net Fri Jul 7 14:09:16 2006 From: ktilton at common-lisp.net (ktilton) Date: Fri, 7 Jul 2006 10:09:16 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060707140916.0D8AF70210@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv22894/cl-magick Modified Files: wand-image.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/07/06 22:09:11 1.2 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/07/07 14:09:15 1.3 @@ -98,7 +98,6 @@ (let* ((columns (- last-col first-col)) (rows (- last-row first-row)) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) - (ukt:trc "wand pixels has colrowa" columns rows) ;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) @@ -108,7 +107,7 @@ (print `(writeimage ,(magick-write-image wand (format nil "C:\\TEST~a.GIF" testn)))) #+not (print `(writeimage ,(magick-write-image wand "C:\\TEST.BMP")))) - (loop for row below 16 do + #+jesfoolinaround(loop for row below 16 do (loop for col below 16 by 1 for offset = (+ (* row columns 3) (* col 3)) do (print (loop for bn below 3 From ktilton at common-lisp.net Sat Jul 8 03:29:09 2006 From: ktilton at common-lisp.net (ktilton) Date: Fri, 7 Jul 2006 23:29:09 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060708032909.EEA411800B@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv5453/cl-ftgl Modified Files: cl-ftgl.lisp Log Message: Initialize array element to nil, critical to algorithm --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/06 22:09:11 1.6 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/08 03:29:09 1.7 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.6 2006/07/06 22:09:11 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.7 2006/07/08 03:29:09 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -173,7 +173,7 @@ (defstruct ftgl face size target-res depth descender ascender - (widths (make-array 256)) + (widths (make-array 256 :initial-element nil)) ft-metrics ifont) From ktilton at common-lisp.net Mon Jul 24 05:00:35 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 24 Jul 2006 01:00:35 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060724050035.9417C17038@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv25558 Modified Files: cello.lpr colors.lisp ix-layer-expand.lisp nehe-06.lisp Log Message: --- /project/cello/cvsroot/cello/cello.lpr 2006/07/06 22:09:10 1.9 +++ /project/cello/cvsroot/cello/cello.lpr 2006/07/24 05:00:35 1.10 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 5, 2006 12:21)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 11, 2006 4:27)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/colors.lisp 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/colors.lisp 2006/07/24 05:00:35 1.5 @@ -71,7 +71,7 @@ (cffi:mem-aref co :float 3))) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(+white+ +red+ +dark-green+ +green+ +turqoise+ +dk-blue+ + (export '(+white+ +red+ +dark-green+ +green+ +turquoise+ +dk-blue+ +blue+ +lt-blue+ +black+ +yellow+ +lt-yellow+ +purple+ +gray+ +lt-gray+ +dk-gray+))) @@ -79,7 +79,7 @@ (defparameter +red+ (mk-rgba 255 0 0 255)) (defparameter +dark-green+ (mk-rgba 0 128 0 255)) (defparameter +green+ (mk-rgba 0 255 0 255)) -(defparameter +turqoise+ (mk-rgba 0 255 255 255)) +(defparameter +turquoise+ (mk-rgba 0 255 255 255)) (defparameter +dk-blue+ (mk-rgba 0 0 64 50)) (defparameter +blue+ (mk-rgba 0 0 255 255)) (defparameter +lt-blue+ (mk-rgba 127 127 255 255)) --- /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/07/06 22:09:10 1.6 +++ /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/07/24 05:00:35 1.7 @@ -34,7 +34,7 @@ (def-layer-expansion +red+) (def-layer-expansion +dark-green+) (def-layer-expansion +green+) -(def-layer-expansion +turqoise+) +(def-layer-expansion +turquoise+) (def-layer-expansion +dk-blue+) (def-layer-expansion +blue+) (def-layer-expansion +lt-blue+) --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/06 22:09:10 1.7 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/24 05:00:35 1.8 @@ -143,7 +143,7 @@ (gl-tex-coord2f 0 1) (v3f -1 1 -1) )) ;;#+ifuwanttoseepixmap - (wand-render *grace* 0 0 1 -1) + ;;(wand-render *grace* 0 0 1 -1) (progn (gl-scalef 0.006 0.006 0.0)