From ktilton at common-lisp.net Mon Aug 21 04:28:27 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:27 -0400 (EDT) Subject: [cello-cvs] CVS cello/cffi-extender Message-ID: <20060821042827.86DA94C008@common-lisp.net> Update of /project/cello/cvsroot/cello/cffi-extender In directory clnet:/tmp/cvs-serv7862/cffi-extender Modified Files: cffi-extender.lpr Log Message: CVS sucks --- /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/07/03 00:35:12 1.3 +++ /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/08/21 04:28:27 1.4 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Aug 21 04:28:27 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:27 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060821042827.41A844B006@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv7862 Modified Files: cello-window.lisp cello.lpr image.lisp ix-opengl.lisp ix-paint.lisp ix-togl.lisp window-utilities.lisp Log Message: CVS sucks --- /project/cello/cvsroot/cello/cello-window.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/08/21 04:28:26 1.3 @@ -20,31 +20,8 @@ ; -(defmodel cello-window (celtk:window focuser) ;; control ogl-shared-resource-tender) +(defmodel cello-window (celtk:window focuser) ( -;;; (mouse-pos :initarg :mouse-pos :initform (c-in nil) :accessor mouse-pos) ;logical coords. Try to maintain for now. -;;; -;;; (mouse-view :initarg :mouse-view :accessor mouse-view -;;; :initform (c? (let ((mp (^mouse-pos))) -;;; (trc nil "mouseview sees pos" .w. mp) -;;; (when mp -;;; (eko (nil "mouseview >" self) -;;; (without-c-dependency -;;; (find-ix-under self mp))))))) -;;; -;;; (mouse-control :initarg :mouse-control :accessor mouse-control -;;; :initform (c? (bwhen (node (^mouse-view)) -;;; (eko (nil "possible mousecontrol" node) -;;; (fm-ascendant-if node #'fully-enabled))))) -;;; -;;; (mouse-cursor :initarg :mouse-cursor :initform nil :accessor mouse-cursor) -;;; -;;; (mouse-up-evt :cell :ephemeral :initarg :mouse-up-evt :initform (c-in nil) :accessor mouse-up-evt) -;;; (mouse-down-evt :cell :ephemeral :initarg :mouse-down-evt :initform (c-in nil) :accessor mouse-down-evt) -;;; (double-click? :initform (c-in nil) :accessor double-click?) -;;; -;;; (tick-count :initarg :tick-count :initform (c-in nil) :accessor tick-count) -;;; (tick-fine :initarg :tick-fine :initform (c-in nil) :accessor tick-fine) (gl-name-highest :cell nil :initarg :gl-name-highest :initform 0 :accessor gl-name-highest)) @@ -62,6 +39,10 @@ (defmethod path ((self cello-window)) ".") (defmethod parent-path ((self cello-window)) "") +(defmethod g-offset ((self cello-window) &optional (accum-h 0) (accum-v 0)) + (declare (ignorable self)) + (mkv2 accum-h accum-v)) + (defmethod cello-window-event-handler (self xe) (declare (ignorable self)) (TRC nil "cello-window-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) ) @@ -76,7 +57,7 @@ (:KeyRelease ) (:ButtonPress ) (:ButtonRelease ) - (:MotionNotify ) + (:MotionNotify (trc "we got motion!!!!")) (:EnterNotify ) (:LeaveNotify ) (:FocusIn ) --- /project/cello/cvsroot/cello/cello.lpr 2006/07/24 05:00:35 1.10 +++ /project/cello/cvsroot/cello/cello.lpr 2006/08/21 04:28:26 1.11 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 11, 2006 4:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/image.lisp 2006/07/06 22:09:10 1.9 +++ /project/cello/cvsroot/cello/image.lisp 2006/08/21 04:28:26 1.10 @@ -17,7 +17,7 @@ (in-package :cello) (eval-when (compile load eval) - (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy))) + (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy ^visible))) ; ------------------------------------------------------ (defmodel ogl-quadric-based (ogl-node) --- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/06 22:09:10 1.3 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/08/21 04:28:26 1.4 @@ -44,10 +44,14 @@ (defmethod ogl-node-window (other) (c-break "ogl-node-window undefined for ~a" other)) +(export! .og. .ogc.) + (define-symbol-macro .og. (or (ogl-context self) (setf (ogl-context self) (upper self ctk::togl)))) +(define-symbol-macro .ogc. (togl-ptr .og.)) + (defmodel ogl-node () ((ogl-context :cell nil :initform nil :accessor ogl-context) (dsp-list :initarg :dsp-list :accessor dsp-list --- /project/cello/cvsroot/cello/ix-paint.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/ix-paint.lisp 2006/08/21 04:28:26 1.3 @@ -17,22 +17,31 @@ (in-package :cello) (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))) - (trc nil "render kid pxy" k (px k)(py k) - :rpos-before (ogl-get-boolean gl_current_raster_position_valid) - (ogl-raster-pos-get)) - (c-assert (px k) () "pX is null in ~a" k) - (c-assert (py k) () "pY is null in ~a" k) + (let ((kids (kids self))) + (declare (ignorable kids)) + (block chk1 + (dolist (k kids) + (unless (find k (kids self)) + (trc "1. kid ~a amongst ~a, no longer amongst kids ~a" k kids (kids self)) + (break "1. kid ~a amongst ~a, no longer amongst kids ~a" k kids (kids self)) + (return-from chk1)))) + (dolist (k (kids self)) + (trc nil "ixr geo" k (list (px k)(py k)) (list (ll k)(lt k)(lr k)(lb k))) + (trc nil "render kid pxy" k (px k)(py k) + :rpos-before (ogl-get-boolean gl_current_raster_position_valid) + (ogl-raster-pos-get)) + (assert (find k (kids self))() "kid ~a no longer amongst kids ~a" k (kids self)) + (c-assert (px k) () "pX is null in ~a" k) + (c-assert (py k) () "pY is null in ~a" k) - (if (dsp-list k) - (progn - (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 + (if (dsp-list k) + (progn + (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)))) + (ix-paint k))))) (defun rpchk (id pfail psucc &optional self) (declare (ignorable pfail)) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/06 22:09:10 1.3 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/21 04:28:26 1.4 @@ -22,6 +22,8 @@ ;------------- Window --------------- ; +(export! mouse-view ^mouse-view mouse-pos ^mouse-pos mouse-control ^mouse-control) + (defmodel ix-togl ( #+not focuser ogl-lit-scene control ogl-shared-resource-tender togl ix-view) ( (redisplayp :cell nil :initarg :redisplayp :initform nil :accessor redisplayp) @@ -67,6 +69,9 @@ :event-handler 'ix-togl-event-handler )) +(export! .togl) +(define-symbol-macro .togl (nearest self ix-togl)) + (defmethod ctk::togl-display-using-class ((self ix-togl)) (unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox (c-stopped)) @@ -95,14 +100,16 @@ (:KeyPress ) (:KeyRelease ) (:ButtonPress - (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe))) ; trigger mouseview recalc + (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) + (- (ctk::xbe-y xe)))) ; trigger mouseview recalc (setf (mouse-down-evt self) (make-os-event :modifiers (keyboard-modifiers .tkw) :where (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe)) :realtime (now)))) (:ButtonRelease ) (:MotionNotify - (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe)))) + (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) + (- (ctk::xbe-y xe))))) (:EnterNotify ) (:LeaveNotify ) (:FocusIn ) @@ -223,7 +230,7 @@ (defparameter *mgw-far* -1500) (defmethod ctk:togl-create-using-class ((self ix-togl)) - (setf (gl-name self) (car (gl-gen-lists 1))) + (setf (gl-name self) (gl-gen-lists 1)) (cello-gl-init) ;; clear errors ;;; ;;; #+profile (macrolet ((glm (param num) --- /project/cello/cvsroot/cello/window-utilities.lisp 2006/06/26 17:05:20 1.6 +++ /project/cello/cvsroot/cello/window-utilities.lisp 2006/08/21 04:28:26 1.7 @@ -101,12 +101,13 @@ (defun find-ix-under (self os-pos &key (test #'true)) (when (and (visible self) (not (collapsed self))) + (trc nil "find-ix-under" self os-pos (screen-box self)) (let ((inself (point-in-box os-pos (screen-box self)))) (or (when (or inself (not (clipped self))) (trc nil "inside self sbox" self os-pos (screen-box self)) (dolistreversed (k (kids self)) ;; overlap goes to last kid displayed (unless (typep k 'window) - (trc nil "fixunder kid" k) + (trc nil "fixunder kid!!!!!!!!" k) (bwhen (ix (find-ix-under k os-pos :test test)) (return-from find-ix-under ix))))) From ktilton at common-lisp.net Mon Aug 21 04:28:28 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:28 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060821042828.052B04D00A@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv7862/cl-ftgl Modified Files: cl-ftgl.lisp cl-ftgl.lpr Log Message: CVS sucks --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/07/08 03:29:09 1.7 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/21 04:28:27 1.8 @@ -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.7 2006/07/08 03:29:09 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.8 2006/08/21 04:28:27 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -178,7 +178,8 @@ ifont) (defun ftgl-assert-opengl-context () - ;; use when debugging FTGL being hit before opengl context estanblished (assert *ftgl-ogl*) + ;; use when debugging FTGL being hit before opengl context estanblished + (assert *ftgl-ogl*) ) (defun ftgl-char-width (f c) @@ -253,10 +254,10 @@ (typecase font (ftgl-extruded #+nyet (let ((*ogl-listing-p* t)) - (ukt::trc nil "ftgl-get-display-font> building glyphs for" font) + (trc nil "ftgl-get-display-font> building glyphs for" font) (fgc-build-glyphs cf) - (ukt::trc nil "ftgl-get-display-font> glyphs built OK for" font))) + (trc nil "ftgl-get-display-font> glyphs built OK for" font))) (ftgl-texture #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))) (ftgl-pixmap --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/07/03 00:35:12 1.6 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/08/21 04:28:27 1.7 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Aug 21 04:28:28 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:28 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060821042828.A88F94E006@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv7862/cl-magick Modified Files: cl-magick.lpr magick-wand.lisp wand-image.lisp wand-pixels.lisp wand-texture.lisp Log Message: CVS sucks --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/07/06 22:09:11 1.5 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/08/21 04:28:28 1.6 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 5, 2006 12:21)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/06/03 12:05:55 1.2 +++ /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp 2006/08/21 04:28:28 1.3 @@ -49,7 +49,7 @@ ;;; ;;;extern WandExport char -(ffx::defun-ffx-multi (* :char) "imagick" +(ffx::defun-ffx-multi :string "imagick" "MagickDescribeImage" (:void *wand) ;;; *MagickGetConfigureInfo(:void *,const char *), ;;; *MagickGetException(const :void *,ExceptionType *), --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/07/07 14:09:15 1.3 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/21 04:28:28 1.4 @@ -100,6 +100,7 @@ (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) ;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) + (cells:trc "image format" wand (magick-get-image-format wand)) (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) #+testing (progn (incf testn) --- /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/07/03 00:35:13 1.2 +++ /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp 2006/08/21 04:28:28 1.3 @@ -40,12 +40,12 @@ (declare (ignorable right left)) (assert (pixels self)) - (ukt:trc nil "!!!! pixelrender entry rasterpos:" + (cells: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) - (ukt:trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) + (cells:trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) (if (ogl-get-boolean gl_current_raster_position_valid) (progn @@ -66,11 +66,13 @@ (gl-disable GL_cull_face) ;(gl-scalef 1000 1000 1000) ;(gl-disable gl_scissor_test) ;; debugging try - ;(gl-enable gl_blend) ;; debugging try - (gl-blend-func gl_src_alpha gl_one_minus_src_alpha) + (gl-enable gl_blend) ;; debugging try + (gl-blend-func gl_src_alpha gl_one) + (gl-blend-func gl_dst_alpha gl_one_minus_src_alpha) + ;;(cells:trc "drew pixels " gl_src_alpha gl_zero) (gl-polygon-mode gl_front_and_back gl_fill) - #+not (trc nil "wand-pixelling" (ogl-raster-pos-get)) - (gl-pixel-storei gl_unpack_alignment 1 ) + #+not (cells:trc nil "wand-pixelling" (ogl-raster-pos-get)) + (gl-pixel-storei gl_unpack_alignment 1) (gl-draw-pixels (+ (car sz) 0) (cdr sz) gl_rgb gl_unsigned_byte (pixels self)) --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/06/26 17:05:22 1.3 +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/21 04:28:28 1.4 @@ -72,7 +72,7 @@ (cdr (image-size self))))) ;; (assert (not *ogl-listing-p*)) (assert (plusp tx)) - ;; (trc "!!!!wand-image-to-texture genning new tx: ~a" tx) + ;; (cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) (gl-bind-texture gl_texture_2d tx) (progn ;; useless?? @@ -96,7 +96,7 @@ (defmethod wand-render ((self wand-texture) left top right bottom &aux (sz (image-size self))) - #+not (trc nil "wand-render tex-name:" (texture-name self) (tile-p self) self + #+not (cells:trc nil "wand-render tex-name:" (texture-name self) (tile-p self) self :size sz :bbox (list left top right bottom)) (with-attrib (gl_texture_bit);; gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit) From ktilton at common-lisp.net Mon Aug 21 04:28:29 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:29 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060821042829.A9ACB56165@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv7862/cl-openal Modified Files: cl-openal.lpr Log Message: CVS sucks --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/07/03 00:35:13 1.6 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/21 04:28:28 1.7 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Mon Aug 21 04:28:31 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:28:31 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060821042831.17C6B61025@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv7862/kt-opengl Modified Files: gl-functions.lisp kt-opengl.lpr ogl-macros.lisp ogl-utils.lisp Log Message: CVS sucks --- /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/07/03 00:35:16 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/08/21 04:28:29 1.3 @@ -343,7 +343,7 @@ (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))) + (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/kt-opengl.lpr 2006/07/03 00:35:16 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/08/21 04:28:29 1.4 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/07/06 22:09:11 1.5 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/21 04:28:29 1.6 @@ -48,7 +48,7 @@ (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (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) + (cells:wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) (gl-push-matrix) (unwind-protect (progn @@ -60,7 +60,7 @@ (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))) + (cells: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" @@ -80,8 +80,7 @@ (prog1 (funcall attrib-fn) (glec :with-attrib)) - (gl-pop-attrib) - )) + (gl-pop-attrib))) (defmacro with-client-attrib ((&rest attribs) &body body) `(call-with-client-attrib @@ -95,8 +94,7 @@ (prog1 (funcall attrib-fn) (glec :with-client-attrib)) - (gl-pop-client-attrib) - )) + (gl-pop-client-attrib))) (defvar *gl-begun*) (defvar *gl-stop*) @@ -147,14 +145,14 @@ (defun glec (&optional (id :anon)) (if (and (boundp '*gl-begun*) *gl-begun*) - (progn #+shhh (ukt:trc "not checking error inside gl-begin" id)) + (progn #+shhh (cells: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))) (if (boundp '*gl-stop*) - (ukt:trc "error but *gl-stop* already bound" e id) + (cells:trc "error but *gl-stop* already bound" e id) (progn (setf *gl-stop* t) (format t "~&~%OGL error ~a at ID ~a" e id) --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/07/06 22:09:12 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/21 04:28:29 1.4 @@ -49,7 +49,7 @@ (let (gl-s-plane gl-t-plane gl-r-plane gl-q-plane) (defun ogl-tex-gen-setup (mode tex-env tex-wrap scale &rest planes) - ;;(ukt::trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + ;;(trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) (gl-tex-envf gl_texture_env gl_texture_env_mode tex-env) (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear ) @@ -199,7 +199,7 @@ (ogl-pen-move (- (car ,xy)) (- (cdr ,xy))))))) (defun ogl-pen-move (x y) - ;;(ukt::trc "ogl-pen-moving" x y) + ;;(trc "ogl-pen-moving" x y) (gl-bitmap 0 0 0 0 x y (cffi-uffi-compat:make-null-pointer :void))) (defclass ogl-texture () From ktilton at common-lisp.net Mon Aug 21 04:31:01 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 21 Aug 2006 00:31:01 -0400 (EDT) Subject: [cello-cvs] CVS hello-cffi Message-ID: <20060821043101.DC48010C7@common-lisp.net> Update of /project/cello/cvsroot/hello-cffi In directory clnet:/tmp/cvs-serv9908 Modified Files: arrays.lisp callbacks.lisp definers.lisp my-uffi-compat.lisp Log Message: --- /project/cello/cvsroot/hello-cffi/arrays.lisp 2006/05/17 04:29:42 1.1 +++ /project/cello/cvsroot/hello-cffi/arrays.lisp 2006/08/21 04:31:01 1.2 @@ -188,7 +188,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/hello-cffi/callbacks.lisp 2006/06/29 09:55:58 1.2 +++ /project/cello/cvsroot/hello-cffi/callbacks.lisp 2006/08/21 04:31:01 1.3 @@ -56,7 +56,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/hello-cffi/definers.lisp 2006/05/17 04:29:42 1.1 +++ /project/cello/cvsroot/hello-cffi/definers.lisp 2006/08/21 04:31:01 1.2 @@ -20,11 +20,11 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;; $Header: /project/cello/cvsroot/hello-cffi/definers.lisp,v 1.1 2006/05/17 04:29:42 ktilton Exp $ +;; $Header: /project/cello/cvsroot/hello-cffi/definers.lisp,v 1.2 2006/08/21 04:31:01 ktilton Exp $ (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/hello-cffi/my-uffi-compat.lisp 2006/05/17 04:29:42 1.1 +++ /project/cello/cvsroot/hello-cffi/my-uffi-compat.lisp 2006/08/21 04:31:01 1.2 @@ -1,6 +1,6 @@ (in-package :cffi) -(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 Tue Aug 22 16:12:35 2006 From: ktilton at common-lisp.net (ktilton) Date: Tue, 22 Aug 2006 12:12:35 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060822161235.84D636200F@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv13054/cl-magick Modified Files: cl-magick.lisp wand-image.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/07/06 22:09:11 1.5 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/22 16:12:35 1.6 @@ -20,6 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. + (defpackage :cl-magick (:nicknames :mgk) (:use --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/21 04:28:28 1.4 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/22 16:12:35 1.5 @@ -100,7 +100,7 @@ (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) ;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) - (cells:trc "image format" wand (magick-get-image-format wand)) + (cells:trc nil "image format" wand (magick-get-image-format wand)) (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) #+testing (progn (incf testn) From ktilton at common-lisp.net Tue Aug 22 16:12:35 2006 From: ktilton at common-lisp.net (ktilton) Date: Tue, 22 Aug 2006 12:12:35 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060822161235.3C9426200D@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv13054 Modified Files: cello-window.lisp ix-togl.lisp Log Message: --- /project/cello/cvsroot/cello/cello-window.lisp 2006/08/21 04:28:26 1.3 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/08/22 16:12:34 1.4 @@ -30,7 +30,7 @@ ;;:gl-name (c-in nil) ;;:focus (c-in nil) :ll 0 :lt 0 - :lr (c-in (scr2log 1100)) + :lr (c-in (scr2log 1400)) :lb (c-in (scr2log -800)) ;; :tick-count (c-in (os-tickcount)) :event-handler 'cello-window-event-handler --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/21 04:28:26 1.4 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/22 16:12:34 1.5 @@ -59,7 +59,7 @@ :clear-rgba (list 0 0 0 1) :ll 0 :lt 0 - :lr (c-in (scr2log 1100)) + :lr (c-in (scr2log 1400)) :lb (c-in (scr2log -800)) ;;:cursor (c? (context-cursor (^mouse-control) (^keyboard-modifiers))) From fgoenninger at common-lisp.net Wed Aug 23 10:27:34 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 06:27:34 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060823102734.203B69@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv23004 Modified Files: cello.lisp Log Message: Added: Id line for CVS version info in header Added: ASDF loading of packages Cello depends on Added: Some beautifying of the code (section headers) --- /project/cello/cvsroot/cello/cello.lisp 2006/07/06 22:09:10 1.7 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/23 10:27:33 1.8 @@ -14,6 +14,31 @@ |# +;;; $Id: cello.lisp,v 1.8 2006/08/23 10:27:33 fgoenninger Exp $ + +;;; ============================================================================ +;;; PACKAGES CELLO DEPENDS ON +;;; ============================================================================ + +;;; Note: Order matters! + +#+asdf +(eval-when (:load-toplevel :execute) + (asdf:operate 'asdf:load-op 'utils-kt) + (asdf:operate 'asdf:load-op 'cells) + (asdf:operate 'asdf:load-op 'gui-geometry) + (asdf:operate 'asdf:load-op 'cffi) + (asdf:operate 'asdf:load-op 'cffi-extender) + (asdf:operate 'asdf:load-op 'kt-opengl) + (asdf:operate 'asdf:load-op 'Celtk) + (asdf:operate 'asdf:load-op 'cl-openal) + (asdf:operate 'asdf:load-op 'cl-ftgl) + (asdf:operate 'asdf:load-op 'cl-magick)) + +;;; ============================================================================ +;;; PACKAGE DEFINITION +;;; ============================================================================ + (defpackage :cello (:nicknames :clo) (:use @@ -22,7 +47,8 @@ #:utils-kt #:cells #:gui-geometry - #:ffx + #:cffi + #:cffi-extender #:celtk #:kt-opengl #:cl-openal @@ -30,10 +56,9 @@ #:cl-magick) (:export #:cello-window-event-handler #:with-layers #:visible #:ix-togl)) -;;; in step one we will just have Celtk playing the part of Freeglut -;;; -;;; #:celtk) -;;; (:shadowing-import-from #:celtk #:window)) +;;; ============================================================================ +;;; MISC +;;; ============================================================================ (in-package :cello) From fgoenninger at common-lisp.net Wed Aug 23 14:34:35 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 10:34:35 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl/ftgl-int Message-ID: <20060823143435.B7DCD19005@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv32373 Added Files: Makefile Log Message: Makefile for libFTGLint.dylib (Mac OS X supported only) --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 14:34:35 NONE +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 14:34:35 1.1 # ============================================================================= # MAKEFILE for libFTGLinterface # ============================================================================= # $Id: Makefile,v 1.1 2006/08/23 14:34:35 fgoenninger Exp $ # by Frank Goenninger, Bempflingen, Germany # August 2006 # ============================================================================= # MAKEFILE for libFTGLinterface # ============================================================================= SRCS = FTGLFromC.cpp OBJS = FTGLFromC.o INCLUDEDIRS = -I/usr/local/include/freetype2 -I/usr/local/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include TARGET = libFTGLint.dylib DEPLIBS = /opt/ftgl/src/FTGL/build/libFTGL.a CC = gcc -O FTGLFromC.o: $(SRCS) $(CC) $(INCLUDEDIRS) -o FTGLFromC.o -c FTGLFromC.cpp all: $(OBJS) $(CC) -o $(TARGET) -undefined suppress -dynamiclib -flat_namespace $(DEPLIBS) FTGLFromC.o clean: rm -f $(OBJS) $(TARGET) From fgoenninger at common-lisp.net Wed Aug 23 20:07:32 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:07:32 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl/ftgl-int Message-ID: <20060823200732.5CA6F1C00A@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv27488 Modified Files: Makefile Log Message: Changed: Frameworks etc for correct dylib building added to DEPLIBS --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 14:34:35 1.1 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 20:07:32 1.2 @@ -2,7 +2,7 @@ # MAKEFILE for libFTGLinterface # ============================================================================= -# $Id: Makefile,v 1.1 2006/08/23 14:34:35 fgoenninger Exp $ +# $Id: Makefile,v 1.2 2006/08/23 20:07:32 fgoenninger Exp $ # by Frank Goenninger, Bempflingen, Germany # August 2006 @@ -17,15 +17,17 @@ INCLUDEDIRS = -I/usr/local/include/freetype2 -I/usr/local/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include TARGET = libFTGLint.dylib -DEPLIBS = /opt/ftgl/src/FTGL/build/libFTGL.a +DEPLIBS = -framework Carbon -framework OpenGL -framework GLUT /usr/local/lib/libfreetype.dylib /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a -CC = gcc -O +CC = g++ -O +CCFLAGS = -dynamic +LDFLAGS = -dynamiclib -flat_namespace FTGLFromC.o: $(SRCS) - $(CC) $(INCLUDEDIRS) -o FTGLFromC.o -c FTGLFromC.cpp + $(CC) $(CCFLAGS) $(INCLUDEDIRS) -o FTGLFromC.o -c FTGLFromC.cpp all: $(OBJS) - $(CC) -o $(TARGET) -undefined suppress -dynamiclib -flat_namespace $(DEPLIBS) FTGLFromC.o + $(CC) $(LDFLAGS) -o $(TARGET) $(DEPLIBS) FTGLFromC.o clean: - rm -f $(OBJS) $(TARGET) \ No newline at end of file + rm -f $(OBJS) $(TARGET) From fgoenninger at common-lisp.net Wed Aug 23 20:08:43 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:08:43 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl/ftgl-int Message-ID: <20060823200843.A33E71C00C@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv27566 Modified Files: FTGLFromC.cpp Log Message: Changed: Some of the functions seem to be referencing deleted functions in FTGL (2.1.2). --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/05/17 16:14:29 1.1 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/08/23 20:08:43 1.2 @@ -1,4 +1,3 @@ -#include /* ;;; ;;; Copyright ? 2004 by Kenneth William Tilton. @@ -21,6 +20,15 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. */ + +/* $Id */ + +/* ========================================================================== */ +/* INCLUDES */ +/* ========================================================================== */ + +#include + #include "FTGLBitmapFont.h" #include "FTBitmapGlyph.h" @@ -36,45 +44,60 @@ #include "FTGLPolygonFont.h" #include "FTPolyGlyph.h" -#include "FTGLOutlineFont.h" -#include "FTOutlineGlyph.h" +#include "FTGLOutlineFont.h" +#include "FTOutlineGlyph.h" -#include "FTGLExtrdFont.h" -#include "FTExtrdGlyph.h" +#include "FTGLExtrdFont.h" +#include "FTExtrdGlyph.h" +/* We only need __stdcall for Windows */ +#if !defined(WINDOWS) +#define __stdcall +#endif + +/* ========================================================================== */ +/* INTERFACE FUNCTIONS */ +/* ========================================================================== */ extern "C" { - void __stdcall fgcBuildGlyphs( FTFont* f ) - { - f->BuildGlyphs(); - } - - bool __stdcall fgcSetFaceSize( FTFont* f - , unsigned int faceSize - , unsigned int res ) - { - return f->FaceSize( faceSize, res ); - } +/* void __stdcall fgcBuildGlyphs( FTFont* f ) +{ + f->BuildGlyphs(); +} +*/ +bool __stdcall fgcSetFaceSize( FTFont* f, + unsigned int faceSize, + unsigned int res ) +{ + return f->FaceSize( faceSize, res ); +} -float __stdcall fgcAscender( FTFont* f ) { - return f->Ascender( ); +float __stdcall fgcAscender( FTFont* f ) +{ + return f->Ascender(); } -float __stdcall fgcDescender( FTFont* f ) { - return f->Descender( ); +float __stdcall fgcDescender( FTFont* f ) +{ + return f->Descender(); } -float __stdcall fgcStringAdvance( FTFont* f, const char* string ) { - return f->Advance( string ); +float __stdcall fgcStringAdvance( FTFont* f, const char* string ) +{ + return f->Advance( string ); } -int __stdcall fgcCharTexture( FTFont* f, int chr ) { - return ((FTGlyph *) f->FontGlyph( chr ))->glRendering(); - //return f->GlyphRendering( chr ); +/* +int __stdcall fgcCharTexture( FTFont* f, int chr ) +{ + return ((FTGlyph *) f->BuildGlyph( chr ))->glRendering(); + //return f->GlyphRendering( chr ); } +*/ + /* void FTFont::DoRender( const unsigned int chr, const unsigned int nextChr) { @@ -88,64 +111,72 @@ -float __stdcall fgcStringX( FTFont* f, const char* string ) { - float llx,lly,llz,urx,ury,urz; +float __stdcall fgcStringX( FTFont* f, const char* string ) +{ + float llx,lly,llz,urx,ury,urz; - f->BBox( string, llx, lly, llz, urx, ury, urz ); - return llx; + f->BBox( string, llx, lly, llz, urx, ury, urz ); + return llx; } -void __stdcall fgcRender( FTFont* f, const char *string ) { - f->Render( string ); +void __stdcall fgcRender( FTFont* f, const char *string ) +{ + f->Render( string ); } -void __stdcall fgcFree( FTFont* f ) { - delete f; +void __stdcall fgcFree( FTFont* f ) +{ + delete f; } //--------- Bitmap ---------------------------------------------- -FTGLBitmapFont* __stdcall fgcBitmapMake( const char* fontname ) { - return new FTGLBitmapFont( fontname ); +FTGLBitmapFont* __stdcall fgcBitmapMake( const char* fontname ) +{ + return new FTGLBitmapFont( fontname ); } //--------- Pixmap ---------------------------------------------- -FTGLPixmapFont* __stdcall fgcPixmapMake( const char* fontname ) { - return new FTGLPixmapFont( fontname ); +FTGLPixmapFont* __stdcall fgcPixmapMake( const char* fontname ) +{ + return new FTGLPixmapFont( fontname ); } //--------- Texture ---------------------------------------------- -FTGLTextureFont* __stdcall fgcTextureMake( const char* fontname ) { - return new FTGLTextureFont( fontname ); +FTGLTextureFont* __stdcall fgcTextureMake( const char* fontname ) +{ + return new FTGLTextureFont( fontname ); } //--------- Polygon ---------------------------------------------- -FTGLPolygonFont* __stdcall fgcPolygonMake( const char* fontname ) { - return new FTGLPolygonFont( fontname ); +FTGLPolygonFont* __stdcall fgcPolygonMake( const char* fontname ) +{ + return new FTGLPolygonFont( fontname ); } //--------- Outline ---------------------------------------------- -FTGLOutlineFont* __stdcall fgcOutlineMake( const char* fontname ) { - return new FTGLOutlineFont( fontname ); +FTGLOutlineFont* __stdcall fgcOutlineMake( const char* fontname ) +{ + return new FTGLOutlineFont( fontname ); } //--------- Extruded Polygon ------------------------------------- -FTGLExtrdFont* __stdcall fgcExtrudedMake( const char* fontname ) { - return new FTGLExtrdFont( fontname ); -} - - -bool __stdcall fgcSetFaceDepth( FTGLExtrdFont* f - , float depth ) { - f->Depth( depth ); - return true; +FTGLExtrdFont* __stdcall fgcExtrudedMake( const char* fontname ) +{ + return new FTGLExtrdFont( fontname ); } +bool __stdcall fgcSetFaceDepth( FTGLExtrdFont* f, float depth ) +{ + f->Depth( depth ); + return true; } +} // extern "C" + From fgoenninger at common-lisp.net Wed Aug 23 20:11:18 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:11:18 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060823201118.A89512606A@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv27734 Modified Files: cl-ftgl.lisp Log Message: Changed: CFFI definition of libFTGLint.dylib (OS X only) Changed: +macosx instead of +darwin for OS X code used. --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/21 04:28:27 1.8 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/23 20:11:18 1.9 @@ -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.8 2006/08/21 04:28:27 ktilton Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.9 2006/08/23 20:11:18 fgoenninger Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -51,7 +51,7 @@ (in-package :cl-ftgl) (define-foreign-library FTGL - (:darwin (:or (:framework "FTGL") "libftgl.dylib")) + (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) (use-foreign-library FTGL) @@ -119,8 +119,10 @@ '(:absolute "windows" "fonts") #+linux '(:absolute "usr" "share" "fonts" "truetype") - #+darwin - '(:absolute "Library" "Fonts"))) + #+macosx + '(:absolute "Library" "Fonts") + )) + ;; ---------------------------------------------------------------------------- ;; FUNCTIONS/METHODS ;; ---------------------------------------------------------------------------- From fgoenninger at common-lisp.net Wed Aug 23 20:17:30 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:17:30 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060823201730.B2A8C3A00C@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv29468 Modified Files: cl-magick.lisp Log Message: Changed: +macosx instead of +darwin Added: libWand.dylib for OS X needed Changed: libMagick.dylib and libWand.dylib path defaults to /usr/local/lib on OS X now. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/22 16:12:35 1.6 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/23 20:17:30 1.7 @@ -20,6 +20,12 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. +#+asdf +(eval-when (:load-toplevel :compile-toplevel) + (asdf:operate 'asdf:load-op 'cffi) + (asdf:operate 'asdf:load-op 'cffi-extender) + (asdf:operate 'asdf:load-op 'kt-opengl) + (asdf:operate 'asdf:load-op 'gui-geometry)) (defpackage :cl-magick (:nicknames :mgk) @@ -59,12 +65,21 @@ (defparameter *mgk-version* (fgn-alloc :unsigned-long 1)) (cffi:define-foreign-library Magick - (:darwin (:or (:framework "GraphicsMagick") "libGraphicsMagick.dylib")) + (:darwin (:or "/usr/local/lib/libMagick.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"))) -(eval-when (load eval) - (cffi:use-foreign-library magick)) +(cffi:define-foreign-library Wand + (:darwin (:or "/usr/local/lib/libWand.dylib"))) + +;; Order matters! First, load Wand then Magick on Darwin +#+macosx +(eval-when (:load-toplevel :execute) + (cffi:use-foreign-library Wand)) + +(eval-when (:load-toplevel :execute) + (cffi:use-foreign-library Magick)) + ;------------------------------------------------------------------- @@ -85,7 +100,8 @@ (cl-magick-init) (defun wands-loaded () *wands-loaded*) -(DEFUN (setf wands-loaded) (new-value) + +(defun (setf wands-loaded) (new-value) (setf *wands-loaded* new-value)) (defun wands-clear () From fgoenninger at common-lisp.net Wed Aug 23 20:20:27 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:20:27 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060823202027.8C8483A00C@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv30632 Modified Files: wand-texture.lisp Log Message: Changed: Removed enclosing progn from file. All code was inside this progn. Why ? --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/21 04:28:28 1.4 +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/23 20:20:27 1.5 @@ -22,114 +22,111 @@ (in-package :cl-magick) +(defclass wand-texture (wand-image ogl-texture)()) -(progn +(defmethod wand-release :after ((wand wand-texture)) + (when (slot-value wand 'texture-name) + (ogl-texture-delete (slot-value wand 'texture-name)))) + +(defun best-fit-cons (c1 c2 c3) + (flet ((bfit (a b c) + (if (> (/ c b)(/ b a)) + a c))) + (cons (bfit (car c1)(car c2)(car c3)) + (bfit (cdr c1)(cdr c2)(cdr c3))))) - (defclass wand-texture (wand-image ogl-texture)()) - - (defmethod wand-release :after ((wand wand-texture)) - (when (slot-value wand 'texture-name) - (ogl-texture-delete (slot-value wand 'texture-name)))) - - (defun best-fit-cons (c1 c2 c3) - (flet ((bfit (a b c) - (if (> (/ c b)(/ b a)) - a c))) - (cons (bfit (car c1)(car c2)(car c3)) - (bfit (cdr c1)(cdr c2)(cdr c3))))) - - (defmethod texture-name :around ((self wand-texture)) - (or (call-next-method) +(defmethod texture-name :around ((self wand-texture)) + (or (call-next-method) (let* ((trunc-sz (cons (expt 2 (floor (log (car (image-size self)) 2))) - (expt 2 (floor (log (cdr (image-size self)) 2))))) + (expt 2 (floor (log (cdr (image-size self)) 2))))) (grow-sz (cons (expt 2 (ceiling (log (car (image-size self)) 2))) - (expt 2 (ceiling (log (cdr (image-size self)) 2))))) + (expt 2 (ceiling (log (cdr (image-size self)) 2))))) (best-fit-sz (best-fit-cons trunc-sz (image-size self) grow-sz))) - #+shh (print `(texture-name> gennning texture ,self)) + #+shh (print `(texture-name> gennning texture ,self)) (unless (equal (image-size self) best-fit-sz) #+shhh (print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) (magick-scale-image (mgk-wand self) (car best-fit-sz) (cdr best-fit-sz)) - ;;; gaussian-filter 0) +;;; gaussian-filter 0) (setf (image-size self) best-fit-sz)) #+shhh (print `(texture-name> new image size , self ,(image-size self))) (let ((tx (wand-image-to-texture self))) (if (plusp tx) (setf (texture-name self) tx) - (break "bad tx name ~a for ~a" tx self)))))) + (break "bad tx name ~a for ~a" tx self)))))) - (defun wand-texture-activate (wand) - ;(print `(wand-texture-activate ,(texture-name wand))) - (ogl-tex-activate (texture-name wand))) - - (defparameter *textures-1* (fgn-alloc 'kt-opengl::gluint 1 :ignore)) - (defun wand-image-to-texture (self) - (let ((tx (ogl-texture-gen) #+not (progn (gl-gen-textures 1 *textures-1*) - (ff-elt *textures-1* gluint 0))) - (pixels (wand-get-image-pixels (mgk-wand self) 0 0 - (car (image-size self)) - (cdr (image-size self))))) - ;; (assert (not *ogl-listing-p*)) - (assert (plusp tx)) - ;; (cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) - (gl-bind-texture gl_texture_2d tx) +(defun wand-texture-activate (wand) + ;(print `(wand-texture-activate ,(texture-name wand))) + (ogl-tex-activate (texture-name wand))) + +(defparameter *textures-1* (fgn-alloc 'kt-opengl::gluint 1 :ignore)) +(defun wand-image-to-texture (self) + (let ((tx (ogl-texture-gen) #+not (progn (gl-gen-textures 1 *textures-1*) + (ff-elt *textures-1* gluint 0))) + (pixels (wand-get-image-pixels (mgk-wand self) 0 0 + (car (image-size self)) + (cdr (image-size self))))) + ;; (assert (not *ogl-listing-p*)) + (assert (plusp tx)) + ;; (cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) + (gl-bind-texture gl_texture_2d tx) - (progn ;; useless?? - (gl-tex-parameteri gl_texture_2d gl_texture_wrap_s gl_repeat) - (gl-tex-parameteri gl_texture_2d gl_texture_wrap_t gl_repeat) ;-- + (progn ;; useless?? + (gl-tex-parameteri gl_texture_2d gl_texture_wrap_s gl_repeat) + (gl-tex-parameteri gl_texture_2d gl_texture_wrap_t gl_repeat) ;-- - (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) - (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear )) + (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) + (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear )) - (gl-pixel-storei gl_pack_alignment 1 ) - (gl-pixel-storei gl_unpack_alignment 1 ) + (gl-pixel-storei gl_pack_alignment 1 ) + (gl-pixel-storei gl_unpack_alignment 1 ) - (gllog :texture tx (* 3 (car (image-size self)) (cdr (image-size self))) :wim2tex) - (gl-tex-image2d gl_texture_2d 0 3 (car (image-size self)) (cdr (image-size self)) - 0 gl_rgb gl_unsigned_byte pixels) - (kt-opengl::glec :tex-image) - ;;(print `(wand-image-to-texture loaded texture sized ,(image-size self))) + (gllog :texture tx (* 3 (car (image-size self)) (cdr (image-size self))) :wim2tex) + (gl-tex-image2d gl_texture_2d 0 3 (car (image-size self)) (cdr (image-size self)) + 0 gl_rgb gl_unsigned_byte pixels) + (kt-opengl::glec :tex-image) + ;;(print `(wand-image-to-texture loaded texture sized ,(image-size self))) - (fgn-free pixels) - tx)) + (fgn-free pixels) + tx)) - (defmethod wand-render ((self wand-texture) left top right bottom - &aux (sz (image-size self))) - #+not (cells:trc nil "wand-render tex-name:" (texture-name self) (tile-p self) self - :size sz :bbox (list left top right bottom)) +(defmethod wand-render ((self wand-texture) left top right bottom + &aux (sz (image-size self))) + #+not (cells:trc nil "wand-render tex-name:" (texture-name self) (tile-p self) self + :size sz :bbox (list left top right bottom)) - (with-attrib (gl_texture_bit);; gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit) - (wand-texture-activate self) - #+slower - (ogl-tex-gen-setup gl_object_linear gl_modulate - (if (tile-p self) gl_repeat gl_clamp) - (/ 1 (max (car sz)(cdr sz))) - :s :tee :r) + (with-attrib (gl_texture_bit) ;; gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit) + (wand-texture-activate self) + #+slower + (ogl-tex-gen-setup gl_object_linear gl_modulate + (if (tile-p self) gl_repeat gl_clamp) + (/ 1 (max (car sz)(cdr sz))) + :s :tee :r) - (if (tile-p self) - (with-gl-begun (gl_quads) - (loop for y from top above bottom by (cdr sz) - for y-rem = (- bottom y) + (if (tile-p self) + (with-gl-begun (gl_quads) + (loop for y from top above bottom by (cdr sz) + for y-rem = (- bottom y) - do (loop for x from left below right by (car sz) - for x-rem = (- right x) - do ;; (print `(tex tiling ,x ,y)) + do (loop for x from left below right by (car sz) + for x-rem = (- right x) + do ;; (print `(tex tiling ,x ,y)) - (flet ((vxy (tx ty) - (let ((x-fraction (min tx (/ x-rem (car sz)))) - (y-fraction (min ty (abs (/ y-rem (cdr sz)))))) - (gl-tex-coord2f x-fraction y-fraction) - (gl-vertex3f (+ x (* x-fraction (car sz))) - (+ y (downs (* y-fraction (cdr sz)))) 0)))) - (vxy 0 0)(vxy 1 0)(vxy 1 1)(vxy 0 1))))) + (flet ((vxy (tx ty) + (let ((x-fraction (min tx (/ x-rem (car sz)))) + (y-fraction (min ty (abs (/ y-rem (cdr sz)))))) + (gl-tex-coord2f x-fraction y-fraction) + (gl-vertex3f (+ x (* x-fraction (car sz))) + (+ y (downs (* y-fraction (cdr sz)))) 0)))) + (vxy 0 0)(vxy 1 0)(vxy 1 1)(vxy 0 1))))) (flet ((vxy (tx ty) (let ((abs-x (+ left (* tx (- right left)))) (abs-y (+ top (downs (* ty (abs (- top bottom))))))) - ;(print `(tex full,(cons tx ty) to-vertex ,(cons abs-x abs-y))) + ;(print `(tex full,(cons tx ty) to-vertex ,(cons abs-x abs-y))) (gl-tex-coord2f tx ty) (gl-vertex3f abs-x abs-y 0)))) (with-gl-begun (gl_quads) (vxy 0 0)(vxy 0 1)(vxy 1 1)(vxy 1 0))) - )))) \ No newline at end of file + ))) \ No newline at end of file From fgoenninger at common-lisp.net Wed Aug 23 20:21:59 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 16:21:59 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060823202159.9FB877E022@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv30981 Modified Files: ix-togl.lisp Log Message: Changed: togl-post-redisplay and togl-ptr are not exported in package Celtk. So we have to :: them. --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/22 16:12:34 1.5 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/23 20:21:59 1.6 @@ -88,7 +88,7 @@ (with-metrics (nil nil "ctk::togl-display-using-class") (when (display-continuous self) (trc nil "window-display > continuous specified so posting redisplay" self) - (ctk:togl-post-redisplay (ctk:togl-ptr self)))))) + (ctk::togl-post-redisplay (ctk::togl-ptr self)))))) From fgoenninger at common-lisp.net Wed Aug 23 21:10:32 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 17:10:32 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060823211032.0E9285E0C7@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv6824 Modified Files: cl-magick.lisp Log Message: Added: fn set-wand-template-path, special var *wand-template*: Used to customize the path to wand template file. Changed: fn magick-wand-template: use *wand-template* if not Nil. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/23 20:17:30 1.7 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/23 21:10:31 1.8 @@ -52,12 +52,21 @@ (in-package :cl-magick) +(defvar *wand-template* + nil + "Path to wand graphics/templates") + +(defun set-wand-template-path (wand-template-pathname) + (setf *wand-template* + wand-template-pathname)) + (defun magick-wand-template () (path-to-wand - (make-pathname - :directory '(:absolute "0dev" "user" - "graphics" "templates") - :name "metal" :type "gif"))) + (or *wand-template* + (make-pathname + :directory '(:absolute "0dev" "user" + "graphics" "templates") + :name "metal" :type "gif")))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) From fgoenninger at common-lisp.net Wed Aug 23 21:13:49 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Wed, 23 Aug 2006 17:13:49 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060823211349.C4C3A6303D@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv7237 Modified Files: cello.lisp Log Message: Changed: Removed the loading of utils-kt. This is done in Cells already. --- /project/cello/cvsroot/cello/cello.lisp 2006/08/23 10:27:33 1.8 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/23 21:13:49 1.9 @@ -14,7 +14,7 @@ |# -;;; $Id: cello.lisp,v 1.8 2006/08/23 10:27:33 fgoenninger Exp $ +;;; $Id: cello.lisp,v 1.9 2006/08/23 21:13:49 fgoenninger Exp $ ;;; ============================================================================ ;;; PACKAGES CELLO DEPENDS ON @@ -23,13 +23,12 @@ ;;; Note: Order matters! #+asdf -(eval-when (:load-toplevel :execute) - (asdf:operate 'asdf:load-op 'utils-kt) +(eval-when (:load-toplevel :compile-toplevel :execute) (asdf:operate 'asdf:load-op 'cells) - (asdf:operate 'asdf:load-op 'gui-geometry) (asdf:operate 'asdf:load-op 'cffi) (asdf:operate 'asdf:load-op 'cffi-extender) (asdf:operate 'asdf:load-op 'kt-opengl) + (asdf:operate 'asdf:load-op 'gui-geometry) (asdf:operate 'asdf:load-op 'Celtk) (asdf:operate 'asdf:load-op 'cl-openal) (asdf:operate 'asdf:load-op 'cl-ftgl) From fgoenninger at common-lisp.net Thu Aug 24 07:54:23 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Thu, 24 Aug 2006 03:54:23 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060824075423.EFAA8722A9@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv3439 Modified Files: cl-openal-init.lisp Log Message: Changed: fn xoa is leading to malfunction on OS X (can't unload dylibs) --- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/06/03 12:06:00 1.5 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/08/24 07:54:23 1.6 @@ -31,11 +31,12 @@ (when *openal-initialized-p* (return-from cl-openal-init t)) - (xoa) +#-macosx (xoa) (assert (use-foreign-library OpenAL) () "Failed to load OpenAL dynamic lib") - + +#-macosx (assert (use-foreign-library ALut) () "Failed to load alut dynamic lib") @@ -94,4 +95,3 @@ (progn #+shh (print (list "al-chk OK:" error$))) (break "~&Error< ~d > on ~a" status error$)))) - From fgoenninger at common-lisp.net Thu Aug 24 07:55:07 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Thu, 24 Aug 2006 03:55:07 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060824075507.3FDB11202D@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv3606 Modified Files: cl-openal.lisp Log Message: Changed: ALUT not needed on OS X (is in OpenAL framework already). --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/05/27 06:01:38 1.3 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lisp 2006/08/24 07:55:07 1.4 @@ -22,6 +22,8 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. +;;; $Id: cl-openal.lisp,v 1.4 2006/08/24 07:55:07 fgoenninger Exp $ + (pushnew :cl-openal *features*) (defpackage #:cl-openal @@ -45,8 +47,8 @@ (:darwin (:framework "OpenAL")) (:windows (:or "/windows/system32/openal32.dll"))) +;; OpenAL 1.0: No separate ALUT for OS X (define-foreign-library ALut - (:darwin (:framework "ALut")) (:windows (:or "/windows/system32/alut.dll"))) (defparameter *audio-files* From fgoenninger at common-lisp.net Thu Aug 24 09:33:46 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Thu, 24 Aug 2006 05:33:46 -0400 (EDT) Subject: [cello-cvs] CVS cello/cellodemo Message-ID: <20060824093346.79FED48148@common-lisp.net> Update of /project/cello/cvsroot/cello/cellodemo In directory clnet:/tmp/cvs-serv18679 Modified Files: demo-window.lisp Log Message: Changed: commented out any error-causing line... --- /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/06/26 17:05:20 1.5 +++ /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/08/24 09:33:46 1.6 @@ -30,12 +30,9 @@ tu-geo ;;ftgl-test #+no demo-scroller) - ;;'tu-geo 'tu-geo :skin (c? (wand-ensure-typed 'wand-texture (car (md-value (fm-other :texture-picker))))) - :display-continuous (c-in t) - :clear-rgba (list 0 0 0 1) :lb (c-in (downs 1000))))) (defun demo-scroller () @@ -77,7 +74,6 @@ (declare (ignorable start-at)) (run-window (apply 'make-instance 'demo-window :md-value (c-in (list start-at)) - ;:idler 'mg-glut-idle :content demo-names iargs) (lambda () @@ -121,17 +117,18 @@ (al-chk "openal test GAIN set")))))) (:keydown . "key-down") (:close . "close-window")) - :idler nil :ll 0 :lt 0 :lr (c-in (scr2log 1000)) :lb (c-in (scr2log -1500)) - :fixed-lighting (list (make-instance 'light - :id gl_light6 - :enabled t - :pos (make-ff-array :float 200 (downs 300) (farther 500) 1) - :ambient *dusk* - :diffuse *dim* - :specular *bright*)) + +;; :fixed-lighting (list (make-instance 'light +;; :id gl_light6 +;; :enabled t +;; :pos (make-ff-array :float 200 (downs 300) (farther 500) 1) +;; :ambient *dusk* +;; :diffuse *dim* +;; :specular *bright*)) + :recording nil #+(or) (c? (when (md-value (fm-other :record)) (make-recording :wand (magick-wand-template) @@ -140,14 +137,14 @@ (make-pathname :name "bingo" :type "mpg") cl-user::*user-output-directory*)))) - :display-continuous nil +;; :display-continuous nil :md-name :demo-w :title$ "Hello, world" :skin nil :lighting :on - :clear-rgba (list 0 0 0 1) - :light-model (c? (bwhen (lm (fm-other? :light-model)) - (list (md-value lm)))) +;; :clear-rgba (list 0 0 0 1) +;; :light-model (c? (bwhen (lm (fm-other? :light-model)) +;; (list (md-value lm)))) :snapshot-pathnamer (lambda (self) (make-pathname From fgoenninger at common-lisp.net Thu Aug 24 09:35:39 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Thu, 24 Aug 2006 05:35:39 -0400 (EDT) Subject: [cello-cvs] CVS cello/cellodemo Message-ID: <20060824093539.CED665E0F4@common-lisp.net> Update of /project/cello/cvsroot/cello/cellodemo In directory clnet:/tmp/cvs-serv18844 Modified Files: cellodemo.asd Log Message: Changed: removed reference to cellocore Changed: removed reference to cl-opengl --- /project/cello/cvsroot/cello/cellodemo/cellodemo.asd 2005/07/05 17:00:29 1.1 +++ /project/cello/cvsroot/cello/cellodemo/cellodemo.asd 2006/08/24 09:35:39 1.2 @@ -6,8 +6,6 @@ (in-package :asdf) -#+(and cl-opengl (or allegro lispworks cmu mcl cormanlisp sbcl scl)) - (defsystem cellodemo :name "cellodemo" :author "Kenny Tilton " @@ -26,11 +24,9 @@ (:file "slot-inspector" :depends-on ("outline")) (:file "structure-view" :depends-on ("slot-inspector")))) - #+cellocore (:file "tutor-geometry") (:file "cellodemo") (:file "demo-window") - (:file "tutor-geometry") - + (:file "tutor-geometry") (:file "light-panel") (:file "hedron-render") (:file "hedron-decoration"))) From ktilton at common-lisp.net Thu Aug 24 17:35:08 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 24 Aug 2006 13:35:08 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060824173508.9A8AA77004@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv2556/cl-openal Modified Files: cl-openal.lpr Log Message: --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/21 04:28:28 1.7 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/24 17:35:08 1.8 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Thu Aug 24 17:35:08 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 24 Aug 2006 13:35:08 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060824173508.CEBE616033@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv2556/kt-opengl Modified Files: ogl-utils.lisp Log Message: --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/21 04:28:29 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/24 17:35:08 1.5 @@ -81,6 +81,12 @@ (gl-get-integerv gl_scissor_box box) box)) +(ukt::export! ogl-current-color) +(defun ogl-current-color () + (let ((rgba (fgn-alloc 'glint 4 :ogl-current-color))) + (gl-get-integerv gl_current_color rgba) + rgba)) + (defun ogl-bounds (ff-box) (loop for n below 4 collecting (eltgli ff-box n))) From fgoenninger at common-lisp.net Fri Aug 25 08:28:16 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Fri, 25 Aug 2006 04:28:16 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060825082816.D820A6A008@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv32313 Modified Files: cl-ftgl.lisp Log Message: Changed: Loading of dynamic lib not done on toplevel anymore. Now only in function cl-ftgl-init. Changed: #+test: Use font ArialHB instead of Sylfaen (Sylfaen does not exist on OS X by default). Added: New function cl-ftgl-test. --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/23 20:11:18 1.9 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/25 08:28:16 1.10 @@ -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.9 2006/08/23 20:11:18 fgoenninger Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.10 2006/08/25 08:28:16 fgoenninger Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -54,7 +54,8 @@ (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) -(use-foreign-library FTGL) +;;(use-foreign-library FTGL) - frgo: This leads to problems on OS X !!! +;; -> Use function cl-ftgl-init ! (defparameter *gui-style-default-face* 'sylfaen) (defparameter *gui-style-button-face* 'sylfaen) @@ -137,13 +138,23 @@ #+test (progn (cl-ftgl-init) - (let ((sylfaen (ftgl-font-ensure :texture "Sylfaen" 24 96))) - (print (list "sylfaen ascender" (ftgl-get-ascender sylfaen))) - (print (list "sylfaen descender" (ftgl-get-descender sylfaen))) - (print (list "sylfaen hello world length" (ftgl-string-length sylfaen "Hello world"))) - (print (list "sylfaen disp font" (ftgl-get-display-font sylfaen))) + (let ((sylfaen (ftgl-font-ensure :texture |ArialHB| 24 96))) + (print (list "ArialHB ascender" (ftgl-get-ascender sylfaen))) + (print (list "ArialHB descender" (ftgl-get-descender sylfaen))) + (print (list "ArialHB hello world length" (ftgl-string-length sylfaen "Hello world"))) + (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))) )) +#+frgo +(defun cl-ftgl-test () + (setf *ftgl-ogl* t) + (cl-ftgl-init) + (let ((sylfaen (ftgl-font-ensure :texture "ArialHB" 24 96))) + (print (list "ArialHB ascender" (ftgl-get-ascender sylfaen))) + (print (list "ArialHB descender" (ftgl-get-descender sylfaen))) + (print (list "ArialHB hello world length" (ftgl-string-length sylfaen "Hello world"))) + (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))))) + (defun cl-ftgl-init () (unless *ftgl-loaded-p* (assert (setq *ftgl-loaded-p* (use-foreign-library ftgl))))) @@ -336,4 +347,3 @@ (defmethod font-bearing-x (font &optional text) (declare (ignorable font text)) 0) - From fgoenninger at common-lisp.net Fri Aug 25 08:31:57 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Fri, 25 Aug 2006 04:31:57 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060825083157.6962312@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv1598 Modified Files: cello.lisp Log Message: Deleted: Removed ASDF load of dependent packages. --- /project/cello/cvsroot/cello/cello.lisp 2006/08/23 21:13:49 1.9 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/25 08:31:57 1.10 @@ -14,25 +14,7 @@ |# -;;; $Id: cello.lisp,v 1.9 2006/08/23 21:13:49 fgoenninger Exp $ - -;;; ============================================================================ -;;; PACKAGES CELLO DEPENDS ON -;;; ============================================================================ - -;;; Note: Order matters! - -#+asdf -(eval-when (:load-toplevel :compile-toplevel :execute) - (asdf:operate 'asdf:load-op 'cells) - (asdf:operate 'asdf:load-op 'cffi) - (asdf:operate 'asdf:load-op 'cffi-extender) - (asdf:operate 'asdf:load-op 'kt-opengl) - (asdf:operate 'asdf:load-op 'gui-geometry) - (asdf:operate 'asdf:load-op 'Celtk) - (asdf:operate 'asdf:load-op 'cl-openal) - (asdf:operate 'asdf:load-op 'cl-ftgl) - (asdf:operate 'asdf:load-op 'cl-magick)) +;;; $Id: cello.lisp,v 1.10 2006/08/25 08:31:57 fgoenninger Exp $ ;;; ============================================================================ ;;; PACKAGE DEFINITION From fgoenninger at common-lisp.net Fri Aug 25 08:36:12 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Fri, 25 Aug 2006 04:36:12 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060825083612.5F7013007@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv1838 Modified Files: coordinate-xform.lisp Log Message: Added: Id string for CVS info. --- /project/cello/cvsroot/cello/coordinate-xform.lisp 2005/05/31 14:39:44 1.1 +++ /project/cello/cvsroot/cello/coordinate-xform.lisp 2006/08/25 08:36:12 1.2 @@ -20,6 +20,8 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. +;;; $Id: coordinate-xform.lisp,v 1.2 2006/08/25 08:36:12 fgoenninger Exp $ + (in-package :cello) (defconstant *reference-dpi* 1440) From fgoenninger at common-lisp.net Fri Aug 25 08:39:26 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Fri, 25 Aug 2006 04:39:26 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060825083926.EEF2479000@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv2105 Modified Files: kt-opengl.lisp Log Message: Added: Id string for CVS info. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/06/05 01:47:50 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/25 08:39:26 1.4 @@ -21,6 +21,8 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. +;;; $Id: kt-opengl.lisp,v 1.4 2006/08/25 08:39:26 fgoenninger Exp $ + (pushnew :kt-opengl *features*) (defpackage #:kt-opengl From fgoenninger at common-lisp.net Sat Aug 26 16:03:57 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 12:03:57 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060826160357.BD5453A008@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv3716 Added Files: kt-opengl-gears.lisp Log Message: Non-working (!!!) first Commit to CVS. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl-gears.lisp 2006/08/26 16:03:57 NONE +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl-gears.lisp 2006/08/26 16:03:57 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- ;;; gears.lisp --- Celtk/Togl version of cl-opengl Lisp version of gears.c (GLUT Mesa demos). ;;; ;;; Simple program with rotating 3-D gear wheels. (defpackage :gears (:use :common-lisp :clos :utils-kt :cells :celtk :cello)) (in-package :gears) (defvar *startx*) (defvar *starty*) (defvar *xangle0*) (defvar *yangle0*) (defvar *xangle*) (defvar *yangle*) (defparameter *vTime* 100) (defun gears () ;; ACL project manager needs a zero-argument function, in project package (let ((*startx* nil) (*starty* nil) (*xangle0* nil) (*yangle0* nil) (*xangle* 0.2) (*yangle* 0.0)) (test-window 'gears-demo))) (defmodel gears-demo (window) ((gear-ct :cell t :initform (c-in 1) :accessor gear-ct :initarg :gear-ct) (scale :cell t :initform (c-in 1) :accessor scale :initarg :scale)) (:default-initargs :title$ "Rotating Gear Widget Test" :kids (c? (the-kids (mk-stack (:packing (c?pack-self "-side left -fill both")) (mk-label :text "Click and drag to rotate image") (mk-row () (mk-label :text "Spin delay (ms):") (mk-entry :id :vtime :md-value (c-in "10")) (mk-button-ex (" Quit " (tk-eval "destroy .")))) (make-instance 'gears :fm-parent *parent* :width 400 :height 400 :timer-interval (c? (let ((n$ (md-value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" :event-handler (c? (lambda (self xe) (case (tk-event-type (xsv type xe)) (:virtualevent (trc "canvas virtual" (xsv name xe))) (:buttonpress (RotStart self (xsv x-root xe) (xsv y-root xe))) (:motionnotify (RotMove self (xsv x-root xe) (xsv y-root xe))) (:buttonrelease (setf *startx* nil))))))))))) (defun RotStart (self x y) (setf *startx* x) (setf *starty* y) (setf *xangle0* (rotx self)) (setf *yangle0* (roty self))) (defun RotMove (self x y) (when *startx* (setf *xangle* (+ *xangle0* (- x *startx*))) (setf *yangle* (+ *yangle0* (- y *starty*))) (setf (rotx self) *xangle*) (setf (roty self) *yangle*))) (defconstant +pif+ (coerce pi 'single-float)) (defmodel gears (togl) ((rotx :initform (c-in 40) :accessor rotx :initarg :rotx) (roty :initform (c-in 25) :accessor roty :initarg :roty) (rotz :initform (c-in 10) :accessor rotz :initarg :rotz) (gear1 :initarg :gear1 :accessor gear1 :initform (c_? (trc "making list!!!!! 1") (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.8 0.1 0.0 1.0)) (draw-gear 1.0 4.0 1.0 20 0.7)) dl))) (gear2 :initarg :gear2 :accessor gear2 :initform (c_? (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.0 0.8 0.2 1.0)) (draw-gear 0.5 2.0 2.0 10 0.7)) dl))) (gear3 :initarg :gear3 :accessor gear3 :initform (c_? (let ((dl (gl:gen-lists 1))) (gl:with-new-list (dl :compile) (gl:material :front :ambient-and-diffuse #(0.2 0.2 1.0 1.0)) (draw-gear 1.3 2.0 0.5 10 0.7)) dl))) (angle :initform (c-in 0.0) :accessor angle :initarg :angle) (frame-count :cell nil :initform 0 :accessor frame-count) (t0 :cell nil :initform 0 :accessor t0) ; (width :initarg :wdith :initform 400 :accessor width) (height :initarg :wdith :initform 400 :accessor height))) (defmethod togl-timer-using-class ((self gears)) (trc nil "enter gear timer" self (togl-ptr self) (get-internal-real-time)) (incf (^angle) 5.0) (Togl_PostRedisplay (togl-ptr self)) ;(loop until (zerop (ctk::Tcl_DoOneEvent 2))) ) (defmethod togl-create-using-class ((self gears)) (gl:light :light0 :position #(5.0 5.0 10.0 0.0)) (gl:enable :cull-face :lighting :light0 :depth-test) (gl:material :front :ambient-and-diffuse #(0.8 0.1 0.0 1.0)) (gl:enable :normalize) (truc self)) (defmethod togl-reshape-using-class ((self gears)) (trc "reshape") (truc self t) ) (defun truc (self &optional truly) (let ((width (Togl_width (togl-ptr self))) (height (Togl_height (togl-ptr self)))) (trc "enter gear reshape" self width (width self)) (gl:viewport 0 (- height (height self)) (width self) (height self)) (unless truly (gl:matrix-mode :projection) (gl:load-identity) (let ((h (/ height width))) (gl:frustum -1 1 (- h) h 5 60))) (progn (gl:matrix-mode :modelview) (gl:load-identity) (gl:translate 0 0 -30)))) (defmethod togl-display-using-class ((self gears) &aux (scale (scale (upper self gears-demo)))) (declare (ignorable scale)) (gl:clear-color 0 0 0 1) (gl:clear :color-buffer-bit :depth-buffer-bit) (gl:with-pushed-matrix (gl:rotate (^rotx) 1 0 0) (gl:rotate (^roty) 0 1 0) (gl:rotate (^rotz) 0 0 1) (gl:with-pushed-matrix (gl:translate -3 -2 0) (gl:rotate (^angle) 0 0 1) (gl:call-list (^gear1))) (gl:with-pushed-matrix (gl:translate 3.1 -2 0) (gl:rotate (- (* -2 (^angle)) 9) 0 0 1) (gl:call-list (^gear2))) (gl:with-pushed-matrix ; gear3 (gl:translate -3.1 4.2 0.0) (gl:rotate (- (* -2 (^angle)) 25) 0 0 1) (gl:call-list (^gear3)))) (Togl_SwapBuffers (togl-ptr self)) #+shhh (print-frame-rate self)) (defun draw-gear (inner-radius outer-radius width n-teeth tooth-depth) "Draw a gear." (declare (single-float inner-radius outer-radius width tooth-depth) (fixnum n-teeth)) (let ((r0 inner-radius) (r1 (- outer-radius (/ tooth-depth 2.0))) (r2 (+ outer-radius (/ tooth-depth 2.0))) (da (/ (* 2.0 +pif+) n-teeth 4.0))) (gl:shade-model :flat) (gl:normal 0 0 1) ;; Draw front face. (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5))))) ;; Draw front sides of teeth. (gl:with-primitives :quads (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5))))) (gl:normal 0 0 -1) ;; Draw back face. (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width -0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width -0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5))))) ;; Draw back sides of teeth. (gl:with-primitives :quads (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* (- width) 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* (- width) 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* (- width) 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* (- width) 0.5))))) ;; Draw outward faces of teeth. (gl:with-primitives :quad-strip (dotimes (i n-teeth) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5)) (gl:vertex (* r1 (cos angle)) (* r1 (sin angle)) (* (- width) 0.5)) (let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle)))) (v (- (* r2 (sin (+ angle da))) (* r1 (sin angle)))) (len (sqrt (+ (* u u) (* v v))))) (setq u (/ u len)) (setq v (/ u len)) (gl:normal v (- u) 0.0) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* (- width) 0.5)) (gl:normal (cos angle) (sin angle) 0.0) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5)) (gl:vertex (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* (- width) 0.5)) (setq u (- (* r1 (cos (+ angle (* 3 da)))) (* r2 (cos (+ angle (* 2 da)))))) (setq v (- (* r1 (sin (+ angle (* 3 da)))) (* r2 (sin (+ angle (* 2 da)))))) (gl:normal v (- u) 0.0) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5)) (gl:vertex (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* (- width) 0.5)) (gl:normal (cos angle) (sin angle) 0.0)))) (gl:vertex (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5)) (gl:vertex (* r1 (cos 0)) (* r1 (sin 0)) (* (- width) 0.5))) ;; Draw inside radius cylinder. (gl:shade-model :smooth) (gl:with-primitives :quad-strip (dotimes (i (1+ n-teeth)) (let ((angle (/ (* i 2.0 +pif+) n-teeth))) (gl:normal (- (cos angle)) (- (sin angle)) 0.0) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* (- width) 0.5)) (gl:vertex (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5))))))) (defun print-frame-rate (window) (with-slots (frame-count t0) window (incf frame-count) (let ((time (get-internal-real-time))) (when (= t0 0) (setq t0 time)) (when (>= (- time t0) (* 5 internal-time-units-per-second)) (let* ((seconds (/ (- time t0) internal-time-units-per-second)) (fps (/ frame-count seconds))) (declare (ignorable fps)) #+shh (format *terminal-io* "~D frames in ~3,1F seconds = ~6,3F FPS~%" frame-count seconds fps)) (setq t0 time) (setq frame-count 0))))) From fgoenninger at common-lisp.net Sat Aug 26 16:04:46 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 12:04:46 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060826160446.2D3273E002@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv3756 Modified Files: cello.asd Log Message: Nothing really changed. --- /project/cello/cvsroot/cello/cello.asd 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/cello.asd 2006/08/26 16:04:46 1.5 @@ -3,7 +3,6 @@ ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) - (in-package :asdf) #+(or allegro lispworks cmu mcl cormanlisp sbcl scl) From fgoenninger at common-lisp.net Sat Aug 26 16:07:35 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 12:07:35 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060826160735.6201E3E001@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv3905 Modified Files: cl-ftgl.lisp Log Message: Changed: Use new scheme to locate fonts. Needed on *nixes where fonts are in several locations. --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/25 08:28:16 1.10 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/26 16:07:35 1.11 @@ -1,4 +1,4 @@ -;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- +;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-ftgl; -*- ;;; ;;; Copyright ? 2004 by Kenneth William Tilton. ;;;;; @@ -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.10 2006/08/25 08:28:16 fgoenninger Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.11 2006/08/26 16:07:35 fgoenninger Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -51,8 +51,8 @@ (in-package :cl-ftgl) (define-foreign-library FTGL - (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) - (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) + (:darwin (:or "/opt/common-lisp/cello/cl-ftgl/ftgl-int/libFTGLint.dylib")) + (:windows (:or "/0dev/user/dynlib/ftgl_dynamic_MTD_d.dll"))) ;;(use-foreign-library FTGL) - frgo: This leads to problems on OS X !!! ;; -> Use function cl-ftgl-init ! @@ -63,6 +63,60 @@ (defparameter *ftgl-fonts-loaded* nil) (defparameter *ftgl-ogl* nil) +(defparameter *ftgl-font-pathnames-list* + + #+(or win32 windows) + (list + (make-pathname + :directory + '(:absolute "Windows" "fonts"))) + + #+linux + (list + (make-pathname + :directory + '(:absolute "usr" "share" "truetype"))) + + #+macosx + (list + (make-pathname + :directory + '(:absolute "System" "Library" "Fonts")) + (make-pathname + :directory + '(:absolute "Library" "Fonts")) + (make-pathname + :directory + '(:relative "~" "Library" "Fonts"))) +) + +(defparameter *ftgl-font-types-list* ;; list of font types + ;; (font filename endings) + #+(or win32 windows) + '("ttf") + + #+linux + '("ttf") + + #+macosx + '("dfont" "ttf") +) + + +(defun find-font-file (font) + (loop named pn-loop for pathname in *ftgl-font-pathnames-list* + do + (loop for ending in *ftgl-font-types-list* + do + (let ((pn (merge-pathnames (make-pathname + :name (string (ftgl-face font)) + :type ending) + pathname))) + (if (probe-file pn) + (progn + (format t "~%*** FIND-FONT-FILE: Result = ~A~%" pn) + (return-from pn-loop pn))))))) + ;; ---------------------------------------------------------------------------- ;; FOREIGN FUNCTION INTERFACE ;; ---------------------------------------------------------------------------- @@ -70,8 +124,8 @@ (defcfun ("fgcSetFaceSize" fgc-set-face-size) :unsigned-char (f :pointer)(size :int)(res :int)) -(defcfun ("fgcCharTexture" fgc-char-texture) :int - (f :pointer)(charCode :int)) +;; (defcfun ("fgcCharTexture" fgc-char-texture) :int +;; (f :pointer)(charCode :int)) (defcfun ("fgcAscender" fgc-ascender) :float (font :pointer)) @@ -88,8 +142,8 @@ (defcfun ("fgcRender" fgc-render) :void (font :pointer)(text :string)) -(defcfun ("fgcBuildGlyphs" fgc-build-glyphs) :void - (font :pointer)) +;; (defcfun ("fgcBuildGlyphs" fgc-build-glyphs) :void +;; (font :pointer)) (defcfun ("fgcFree" fgc-free) :void (font :pointer)) @@ -113,28 +167,16 @@ (defun fgc-set-face-depth (font depth) (fgcSetFaceDepth font (coerce depth 'float))) -(defparameter *font-directory-path* - (make-pathname - :directory - #+(or win32 mswindows) - '(:absolute "windows" "fonts") - #+linux - '(:absolute "usr" "share" "fonts" "truetype") - #+macosx - '(:absolute "Library" "Fonts") - )) - ;; ---------------------------------------------------------------------------- ;; FUNCTIONS/METHODS ;; ---------------------------------------------------------------------------- (defun cl-ftgl-reset () -#-mcl +#-(or mcl macosx) (setq *ftgl-loaded-p* nil) (setq *ftgl-fonts-loaded* nil)) - #+test (progn (cl-ftgl-init) @@ -145,19 +187,11 @@ (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))) )) -#+frgo -(defun cl-ftgl-test () - (setf *ftgl-ogl* t) - (cl-ftgl-init) - (let ((sylfaen (ftgl-font-ensure :texture "ArialHB" 24 96))) - (print (list "ArialHB ascender" (ftgl-get-ascender sylfaen))) - (print (list "ArialHB descender" (ftgl-get-descender sylfaen))) - (print (list "ArialHB hello world length" (ftgl-string-length sylfaen "Hello world"))) - (print (list "ArialHB disp font" (ftgl-get-display-font sylfaen))))) - (defun cl-ftgl-init () - (unless *ftgl-loaded-p* - (assert (setq *ftgl-loaded-p* (use-foreign-library ftgl))))) + (unless *ftgl-loaded-p* + (assert (setq *ftgl-loaded-p* (use-foreign-library FTGL)))) + (format *debug-io* "~%*** CL-FTGL-INIT: Loaded: ~S~%" + *ftgl-loaded-p*)) ;; frgo: Debug ... (defun ftgl-font-ensure (type face size target-res &optional (depth 0)) (let ((fspec (list type face size target-res depth))) @@ -167,7 +201,7 @@ f)))) (defun ftgl-make (type face size target-res &optional (depth 0)) - ;; (print (list "ftgl-make entry" type face size)) + (print (list "ftgl-make entry" type face size)) (funcall (ecase type (:bitmap 'make-ftgl-bitmap) (:pixmap 'make-ftgl-pixmap) @@ -222,7 +256,6 @@ (declare (ignore new-value font))) (defmethod ftgl-ready ((font ftgl-disp)) - ;(print (list "A cheerful HELLO from ftgl-ready: " font)) (ftgl-disp-ready-p font)) @@ -286,20 +319,17 @@ )) (defun ftgl-font-make (font) - ;; (print (list "ftgl-font-make: entry" font)) - (let ((path (merge-pathnames - (make-pathname :name (string (ftgl-face font)) :type "ttf") - *font-directory-path*))) - (if (probe-file path) + (let ((path (find-font-file font))) + (if path (let* ((fpath (namestring path)) (f (fgc-font-make font fpath))) (if f (progn - ;;(ogl::dump-lists 1 10000) (fgc-set-face-size f (ftgl-size font) (ftgl-target-res font)) +;; (setf (ftgl-ifont font) f) f) - (error "cannot load ~a font ~a" (type-of font) fpath))) - (error "Font not found: ~a" path)))) + (error "cannot load ~a font ~a" (type-of font) fpath))) + (error "Font not found: ~a" path)))) (defmethod ftgl-render (font s) (assert font) @@ -327,6 +357,7 @@ (fgc-bitmap-make fpath)) (defmethod fgc-font-make ((font ftgl-texture) fpath) + (format t "~%*** FGC-FONT-MAKE: fpath = ~A~%" fpath) (fgc-texture-make fpath)) (defmethod fgc-font-make ((font ftgl-extruded) fpath) @@ -341,7 +372,6 @@ (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) From fgoenninger at common-lisp.net Sat Aug 26 16:08:27 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 12:08:27 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl/ftgl-int Message-ID: <20060826160827.76FC13E001@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv3955 Modified Files: Makefile Log Message: Changed: Minor changes, more flexibility for Compile and Link phases through separate commands. --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/23 20:07:32 1.2 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/Makefile 2006/08/26 16:08:27 1.3 @@ -2,7 +2,7 @@ # MAKEFILE for libFTGLinterface # ============================================================================= -# $Id: Makefile,v 1.2 2006/08/23 20:07:32 fgoenninger Exp $ +# $Id: Makefile,v 1.3 2006/08/26 16:08:27 fgoenninger Exp $ # by Frank Goenninger, Bempflingen, Germany # August 2006 @@ -14,20 +14,26 @@ SRCS = FTGLFromC.cpp OBJS = FTGLFromC.o -INCLUDEDIRS = -I/usr/local/include/freetype2 -I/usr/local/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include +INCLUDEDIRS = -I/usr/X11R6/include/freetype2 -I/usr/X11R6/include/freetype2/freetype -I/opt/ftgl/src/FTGL/include TARGET = libFTGLint.dylib -DEPLIBS = -framework Carbon -framework OpenGL -framework GLUT /usr/local/lib/libfreetype.dylib /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a +DEPLIBS = -framework Carbon -framework OpenGL /usr/X11R6/lib/libfreetype.a /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a + +# DEPLIBS = -framework Carbon -framework OpenGL -framework GLUT /usr/X11R6/lib/libfreetype.a /opt/ftgl/src/FTGL/mac/build/Development/libftgl.a + + +CC = gcc -O +LD = g++ -O -CC = g++ -O CCFLAGS = -dynamic -LDFLAGS = -dynamiclib -flat_namespace +# LDFLAGS = -dynamiclib -flat_namespace +LDFLAGS = -dynamiclib FTGLFromC.o: $(SRCS) $(CC) $(CCFLAGS) $(INCLUDEDIRS) -o FTGLFromC.o -c FTGLFromC.cpp all: $(OBJS) - $(CC) $(LDFLAGS) -o $(TARGET) $(DEPLIBS) FTGLFromC.o + $(LD) $(LDFLAGS) -o $(TARGET) $(DEPLIBS) FTGLFromC.o clean: rm -f $(OBJS) $(TARGET) From fgoenninger at common-lisp.net Sat Aug 26 16:09:36 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 12:09:36 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl/ftgl-int Message-ID: <20060826160936.F118546126@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl/ftgl-int In directory clnet:/tmp/cvs-serv3998 Modified Files: FTGLFromC.cpp Log Message: Changed: BuildGlyph no more part of FTGL (version 2.1.2). Tried to use MakeGlyph instead... --- /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/08/23 20:08:43 1.2 +++ /project/cello/cvsroot/cello/cl-ftgl/ftgl-int/FTGLFromC.cpp 2006/08/26 16:09:36 1.3 @@ -62,11 +62,12 @@ extern "C" { -/* void __stdcall fgcBuildGlyphs( FTFont* f ) + /* +void __stdcall fgcBuildGlyphs( FTFont* f ) { f->BuildGlyphs(); } -*/ + */ bool __stdcall fgcSetFaceSize( FTFont* f, unsigned int faceSize, @@ -90,13 +91,14 @@ return f->Advance( string ); } -/* + + /* int __stdcall fgcCharTexture( FTFont* f, int chr ) { - return ((FTGlyph *) f->BuildGlyph( chr ))->glRendering(); + return ((FTGlyph *) f->MakeGlyph( chr ))->glRendering(); //return f->GlyphRendering( chr ); } -*/ + */ /* void FTFont::DoRender( const unsigned int chr, const unsigned int nextChr) From fgoenninger at common-lisp.net Sat Aug 26 21:43:36 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 17:43:36 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060826214336.72CA846125@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv27087 Modified Files: cello-window.lisp Log Message: Added: export #:cello-window --- /project/cello/cvsroot/cello/cello-window.lisp 2006/08/22 16:12:34 1.4 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/08/26 21:43:36 1.5 @@ -19,7 +19,6 @@ ;------------- Window --------------- ; - (defmodel cello-window (celtk:window focuser) ( (gl-name-highest :cell nil :initarg :gl-name-highest From fgoenninger at common-lisp.net Sat Aug 26 21:44:03 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 17:44:03 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060826214403.849E055338@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv27147 Modified Files: cello.lisp Log Message: Added: Export #:cello-window --- /project/cello/cvsroot/cello/cello.lisp 2006/08/25 08:31:57 1.10 +++ /project/cello/cvsroot/cello/cello.lisp 2006/08/26 21:44:03 1.11 @@ -14,7 +14,7 @@ |# -;;; $Id: cello.lisp,v 1.10 2006/08/25 08:31:57 fgoenninger Exp $ +;;; $Id: cello.lisp,v 1.11 2006/08/26 21:44:03 fgoenninger Exp $ ;;; ============================================================================ ;;; PACKAGE DEFINITION @@ -23,19 +23,24 @@ (defpackage :cello (:nicknames :clo) (:use - #:common-lisp - #-(or ccl cormanlisp sbcl) #:clos - #:utils-kt - #:cells - #:gui-geometry - #:cffi - #:cffi-extender - #:celtk - #:kt-opengl - #:cl-openal - #:cl-ftgl - #:cl-magick) - (:export #:cello-window-event-handler #:with-layers #:visible #:ix-togl)) + #:common-lisp + #-(or ccl cormanlisp sbcl) #:clos + #:utils-kt + #:cells + #:gui-geometry + #:cffi + #:cffi-extender + #:celtk + #:kt-opengl + #:cl-openal + #:cl-ftgl + #:cl-magick) + (:export + #:cello-window + #:cello-window-event-handler + #:with-layers + #:visible + #:ix-togl)) ;;; ============================================================================ ;;; MISC From fgoenninger at common-lisp.net Sat Aug 26 21:45:23 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 17:45:23 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060826214523.15F025831A@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv28788 Modified Files: cl-magick.asd Log Message: Changed: Depends-on extended. Now loads dependencies also. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/07/06 22:09:11 1.2 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd 2006/08/26 21:45:22 1.3 @@ -16,12 +16,12 @@ :licence "MIT" :description "Bindings for ImageMagick" :long-description "Poorly implemented bindings to half of ImageMagick" - :depends-on (gui-geometry) + :depends-on (:cffi :cffi-extender :utils-kt :gui-geometry :kt-opengl) :components ((:file "cl-magick") - (:file "magick-wand" :depends-on ("cl-magick")) + (:file "magick-wand" :depends-on ("cl-magick")) (:file "drawing-wand" :depends-on ("magick-wand")) - (:file "pixel-wand" :depends-on ("drawing-wand")) - (:file "mgk-utils" :depends-on ("pixel-wand")) - (:file "wand-image" :depends-on ("mgk-utils")) + (:file "pixel-wand" :depends-on ("drawing-wand")) + (: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 "wand-pixels" :depends-on ("wand-texture")))) From fgoenninger at common-lisp.net Sat Aug 26 21:46:21 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Sat, 26 Aug 2006 17:46:21 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060826214621.D0AF759086@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv28823 Modified Files: cl-magick.lisp Log Message: Changed: Loading of dynamic libs now safe also on OS X. --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/23 21:10:31 1.8 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/26 21:46:21 1.9 @@ -20,12 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -#+asdf -(eval-when (:load-toplevel :compile-toplevel) - (asdf:operate 'asdf:load-op 'cffi) - (asdf:operate 'asdf:load-op 'cffi-extender) - (asdf:operate 'asdf:load-op 'kt-opengl) - (asdf:operate 'asdf:load-op 'gui-geometry)) +;;; $Id: cl-magick.lisp,v 1.9 2006/08/26 21:46:21 fgoenninger Exp $ (defpackage :cl-magick (:nicknames :mgk) @@ -64,9 +59,9 @@ (path-to-wand (or *wand-template* (make-pathname - :directory '(:absolute "0dev" "user" - "graphics" "templates") - :name "metal" :type "gif")))) +#-macosx :directory '(:absolute "0dev" "user" "graphics" "templates") +#+macosx :directory '(:absolute "Users" "frgo" "Pictures") + :name "metal003" :type "gif")))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) @@ -81,15 +76,6 @@ (cffi:define-foreign-library Wand (:darwin (:or "/usr/local/lib/libWand.dylib"))) -;; Order matters! First, load Wand then Magick on Darwin -#+macosx -(eval-when (:load-toplevel :execute) - (cffi:use-foreign-library Wand)) - -(eval-when (:load-toplevel :execute) - (cffi:use-foreign-library Magick)) - - ;------------------------------------------------------------------- (defun cl-magick-init () @@ -97,9 +83,13 @@ (progn ;(print "clearing magick wands") ;(wands-clear) + + ;; Order matters! First, load Wand then Magick on Darwin + #+macosx + (cffi:use-foreign-library Wand) - (assert (setq *imagick-dll-loaded* t - #+not (cffi:use-foreign-library magick)) + (assert (setq *imagick-dll-loaded* + (cffi:use-foreign-library Magick)) () "Unable to load imagick" ) (print `(magick-copyright ,(magick-get-copyright))) (print `(magick-version ,(magick-get-version *mgk-version*))) @@ -142,4 +132,3 @@ (print `(unloading foreign library ,dll)) (setf *imagick-dll-loaded* nil) (ff:unload-foreign-library dll)))) - From fgoenninger at common-lisp.net Mon Aug 28 18:36:41 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Mon, 28 Aug 2006 14:36:41 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060828183641.404BE50013@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20116 Modified Files: ogl-utils.lisp Log Message: Added: Id for CVS info Changed: Done some code "beautifying" for myself being able to understand this better... --- /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/24 17:35:08 1.5 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-utils.lisp 2006/08/28 18:36:40 1.6 @@ -22,17 +22,16 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. - +;;; $Id: ogl-utils.lisp,v 1.6 2006/08/28 18:36:40 fgoenninger Exp $ (in-package :kt-opengl) (defun ogl-tex-activate (tex-name) (assert tex-name) ;;(print `(ogl-tex-activate doing ,tex-name)) - (gl-bind-texture gl_texture_2d tex-name) (gl-enable gl_texture_2d) - (gl-polygon-mode gl_front_and_back gl_fill) ;; just front? - ) + (gl-bind-texture gl_texture_2d tex-name) + (gl-polygon-mode gl_front_and_back gl_fill)) ;; just front ? (defparameter *textures-1* (fgn-alloc 'gluint 1 :ignore)) @@ -47,9 +46,15 @@ (glec :ogl-texture-gen) (ff-elt *textures-1* gluint 0)) -(let (gl-s-plane gl-t-plane gl-r-plane gl-q-plane) +(let ((gl-s-plane nil) + (gl-t-plane nil) + (gl-r-plane nil) + (gl-q-plane nil)) + (defun ogl-tex-gen-setup (mode tex-env tex-wrap scale &rest planes) - ;;(trc nil "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + + ;;(trc "ogl-tex-gen-setup:" mode tex-env tex-wrap scale planes) + (gl-tex-envf gl_texture_env gl_texture_env_mode tex-env) (gl-tex-parameterf gl_texture_2d gl_texture_min_filter gl_linear ) (gl-tex-parameterf gl_texture_2d gl_texture_mag_filter gl_linear ) @@ -58,23 +63,23 @@ (gl-tex-parameteri gl_texture_2d gl_texture_wrap_t tex-wrap) ;-- (loop for plane in planes - do (ecase plane - (:s (gl-tex-geni gl_s gl_texture_gen_mode mode) - (gl-tex-genfv gl_s gl_object_plane - (ff-floatv-ensure gl-s-plane scale 0 0 0)) - (gl-enable gl_texture_gen_s)) - (:tee (gl-tex-geni gl_t gl_texture_gen_mode mode) - (gl-tex-genfv gl_t gl_object_plane - (ff-floatv-ensure gl-t-plane 0 scale 0 0)) - (gl-enable gl_texture_gen_t)) - (:r (gl-tex-geni gl_r gl_texture_gen_mode mode) - (gl-tex-genfv gl_r gl_object_plane - (ff-floatv-ensure gl-r-plane 0 0 scale 0)) - (gl-enable gl_texture_gen_r)) - (:q (gl-tex-geni gl_q gl_texture_gen_mode mode) - (gl-tex-genfv gl_q gl_object_plane - (ff-floatv-ensure gl-q-plane 0 0 scale 0)) - (gl-enable gl_texture_gen_q)))))) + do (ecase plane + (:s (gl-tex-geni gl_s gl_texture_gen_mode mode) + (gl-tex-genfv gl_s gl_object_plane + (ff-floatv-ensure gl-s-plane scale 0 0 0)) + (gl-enable gl_texture_gen_s)) + (:tee (gl-tex-geni gl_t gl_texture_gen_mode mode) + (gl-tex-genfv gl_t gl_object_plane + (ff-floatv-ensure gl-t-plane 0 scale 0 0)) + (gl-enable gl_texture_gen_t)) + (:r (gl-tex-geni gl_r gl_texture_gen_mode mode) + (gl-tex-genfv gl_r gl_object_plane + (ff-floatv-ensure gl-r-plane 0 0 scale 0)) + (gl-enable gl_texture_gen_r)) + (:q (gl-tex-geni gl_q gl_texture_gen_mode mode) + (gl-tex-genfv gl_q gl_object_plane + (ff-floatv-ensure gl-q-plane 0 0 scale 0)) + (gl-enable gl_texture_gen_q)))))) (defun ogl-scissor-box () (let ((box (fgn-alloc 'glint 4 :scissor))) From fgoenninger at common-lisp.net Mon Aug 28 18:37:22 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Mon, 28 Aug 2006 14:37:22 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060828183722.9C61750014@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20456 Modified Files: ogl-macros.lisp Log Message: Changed: Now using CFFI scheme for defining and using foreign libs. --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/21 04:28:29 1.6 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 18:37:22 1.7 @@ -33,7 +33,6 @@ (defmacro with-matrix ((&optional load-identity-p) &body body) `(call-with-matrix ,load-identity-p (lambda () , at body) ',body)) - (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (declare (ignorable matrix-code)) (gl-push-matrix) @@ -98,6 +97,7 @@ (defvar *gl-begun*) (defvar *gl-stop*) + (defmacro with-gl-begun ((what) &body body) `(progn (when (boundp '*gl-begun*) @@ -123,24 +123,19 @@ (gl-translatef (- ,dx)(- ,dy)(- ,dz)))))) (defun kt-opengl-init () - (declare (ignorable load-oglfont-p)) (unless *opengl-dll* - #-mcl (progn - (print "loading open GL/GLU") - (cffi-uffi-compat:load-foreign-library - *gl-dynamic-lib* - :module "open-gl")) - #+mcl - (format t "~&We're on Darwin, so we do not load the OpenGL dynlib explicitely~%.") - #-mcl - (setf *opengl-dll* (cffi-uffi-compat:load-foreign-library *glu-dynamic-lib* - :module "gl-util")) - #+mcl - (setf *opengl-dll* t) - )) + (let ((opengl-loaded-p + (use-foreign-library OpenGL)) + (glu-loaded-p + #+macosx + t ;; on Mac OS X, no explicit loading of GLU needed. + #-macosx + (use-foreign-library GLU))) + (assert (and opengl-loaded-p glu-loaded-p)) + (setf *opengl-dll* t))))) -(eval-when (load eval) +(eval-when (:load-toplevel :execute) (kt-opengl-init)) (defun glec (&optional (id :anon)) From fgoenninger at common-lisp.net Mon Aug 28 18:38:04 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Mon, 28 Aug 2006 14:38:04 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060828183804.8700D50014@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv20733 Modified Files: kt-opengl.lisp Log Message: Changed: Use CFFI scheme to define and use foreign libs. --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/25 08:39:26 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 18:38:03 1.5 @@ -21,7 +21,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: kt-opengl.lisp,v 1.4 2006/08/25 08:39:26 fgoenninger Exp $ +;;; $Id: kt-opengl.lisp,v 1.5 2006/08/28 18:38:03 fgoenninger Exp $ (pushnew :kt-opengl *features*) @@ -80,21 +80,22 @@ (defvar *selecting*) -(defparameter *gl-dynamic-lib* - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "opengl32" - :type "dll")) - -(defparameter *glu-dynamic-lib* - (make-pathname - ;;#+lispworks :host #-lispworks :device "c" - :directory '(:absolute "windows" "system32") - :name "glu32" - :type "dll")) - -(defparameter *glut-dynamic-lib* :unconfigured) +(define-foreign-library OpenGL + (:windows (:or (namestring + (make-pathname + ;;#+lispworks :host #-lispworks :device "c" + :directory '(:absolute "windows" "system32") + :name "opengl32" + :type "dll")))) + (:darwin (:or (:framework "OpenGL")))) + +(define-foreign-library GLU + (:windows (:or (namestring + (make-pathname + ;;#+lispworks :host #-lispworks :device "c" + :directory '(:absolute "windows" "system32") + :name "opengl32" + :type "dll"))))) (defparameter *opengl-dll* nil) From fgoenninger at common-lisp.net Mon Aug 28 18:41:19 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Mon, 28 Aug 2006 14:41:19 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060828184119.E11275200B@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv21072 Modified Files: wand-texture.lisp Log Message: Changed: Added some (now inactive) print statements for debugging only. --- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/23 20:20:27 1.5 +++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp 2006/08/28 18:41:19 1.6 @@ -42,14 +42,14 @@ (grow-sz (cons (expt 2 (ceiling (log (car (image-size self)) 2))) (expt 2 (ceiling (log (cdr (image-size self)) 2))))) (best-fit-sz (best-fit-cons trunc-sz (image-size self) grow-sz))) - #+shh (print `(texture-name> gennning texture ,self)) + ;;(print `(texture-name> gennning texture ,self)) ;; frgo: debug... (unless (equal (image-size self) best-fit-sz) - #+shhh (print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) + ;;(print `(texture-name> tex-refit ,(image-size self) to ,best-fit-sz)) ;; frgo: debug... (magick-scale-image (mgk-wand self) (car best-fit-sz) (cdr best-fit-sz)) ;;; gaussian-filter 0) (setf (image-size self) best-fit-sz)) - #+shhh (print `(texture-name> new image size , self ,(image-size self))) + ;; (print `(texture-name> new image size , self ,(image-size self))) ;; frgo: debug... (let ((tx (wand-image-to-texture self))) (if (plusp tx) (setf (texture-name self) tx) @@ -57,19 +57,20 @@ (defun wand-texture-activate (wand) - ;(print `(wand-texture-activate ,(texture-name wand))) + ;;(print `(wand-texture-activate ,(texture-name wand))) (ogl-tex-activate (texture-name wand))) (defparameter *textures-1* (fgn-alloc 'kt-opengl::gluint 1 :ignore)) + (defun wand-image-to-texture (self) (let ((tx (ogl-texture-gen) #+not (progn (gl-gen-textures 1 *textures-1*) (ff-elt *textures-1* gluint 0))) (pixels (wand-get-image-pixels (mgk-wand self) 0 0 (car (image-size self)) (cdr (image-size self))))) - ;; (assert (not *ogl-listing-p*)) + ;;(assert (not *ogl-listing-p*)) (assert (plusp tx)) - ;; (cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) + ;;(cells:trc "!!!!wand-image-to-texture genning new tx: ~a" tx) ;; frgo: debug... (gl-bind-texture gl_texture_2d tx) (progn ;; useless?? @@ -86,7 +87,7 @@ (gl-tex-image2d gl_texture_2d 0 3 (car (image-size self)) (cdr (image-size self)) 0 gl_rgb gl_unsigned_byte pixels) (kt-opengl::glec :tex-image) - ;;(print `(wand-image-to-texture loaded texture sized ,(image-size self))) + (print `(wand-image-to-texture loaded texture sized ,(image-size self))) ;; frgo: debug... (fgn-free pixels) tx)) From fgoenninger at common-lisp.net Mon Aug 28 18:42:26 2006 From: fgoenninger at common-lisp.net (fgoenninger) Date: Mon, 28 Aug 2006 14:42:26 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060828184226.551FA53011@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv21180 Modified Files: wand-image.lisp Log Message: Changed: Re-arranged class definition code (beautifying only). --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/22 16:12:35 1.5 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/28 18:42:26 1.6 @@ -23,12 +23,11 @@ (in-package :cl-magick) (defclass wand-image () - ((direction :initarg :direction :initform :input :accessor direction) - (file-path$ :initarg :file-path$ :accessor file-path$ :initform nil) - (mgk-wand :initarg :mgk-wand :accessor mgk-wand :initform nil) - (image-size :initarg :image-size :accessor image-size :initform nil) - (tile-p :initarg :tile-p :accessor tile-p :initform t) - )) + ((direction :initarg :direction :initform :input :accessor direction) + (file-path$ :initarg :file-path$ :initform nil :accessor file-path$) + (mgk-wand :initarg :mgk-wand :initform nil :accessor mgk-wand) + (image-size :initarg :image-size :initform nil :accessor image-size) + (tile-p :initarg :tile-p :initform t :accessor tile-p))) (defmethod initialize-instance :after ((self wand-image) &key) (ecase (direction self) @@ -47,7 +46,7 @@ "Image file ~a not found initializing wand" (file-path$ self)) (assert (not (mgk-wand self))) ;; make sure not leaking (setf (mgk-wand self) (path-to-wand (file-path$ self))) - ;(mgk-wand-dump (mgk-wand self) (file-path$ self)) + ;;(mgk-wand-dump (mgk-wand self) (file-path$ self)) (when (and (mgk-wand self) (not (image-size self))) (setf (image-size self) (cons (magick-get-image-width (mgk-wand self)) @@ -79,9 +78,11 @@ (fgn-alloc :unsigned-long 1 :ignore)) (defun wand-image-size (wand) - (magick-get-size wand *mgk-columns* *mgk-rows*) + (magick-get-size wand + *mgk-columns* + *mgk-rows*) (cons (ff-elt *mgk-columns* :unsigned-long 0) - (ff-elt *mgk-rows* :unsigned-long 0))) + (ff-elt *mgk-rows* :unsigned-long 0))) (defun wand-get-image-pixels (wand &optional (first-col 0) (first-row 0) @@ -99,15 +100,10 @@ (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)) - (cells:trc nil "image format" wand (magick-get-image-format wand)) + ;;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) ;; frgo: debug ... + ;;(cells:trc "image format" wand (magick-get-image-format wand)) ;; frgo:debug... (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) - #+testing (progn - (incf testn) - (print `(writeimage ,(magick-write-image wand (format nil "C:\\TEST~a.JPG" testn)))) - (print `(writeimage ,(magick-write-image wand (format nil "C:\\TEST~a.GIF" testn)))) - #+not (print `(writeimage ,(magick-write-image wand "C:\\TEST.BMP")))) - + ;;(print `(writeimage ,(magick-write-image wand "/tmp/wand-image-test.jpg"))) #+jesfoolinaround(loop for row below 16 do (loop for col below 16 by 1 for offset = (+ (* row columns 3) (* col 3)) From ktilton at common-lisp.net Mon Aug 28 21:45:24 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 28 Aug 2006 17:45:24 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060828214524.7595C62057@common-lisp.net> 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) From ktilton at common-lisp.net Mon Aug 28 21:45:25 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 28 Aug 2006 17:45:25 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-ftgl Message-ID: <20060828214525.1784F6303D@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-ftgl In directory clnet:/tmp/cvs-serv27660/cl-ftgl Modified Files: cl-ftgl.lisp cl-ftgl.lpr Log Message: --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/26 16:07:35 1.11 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp 2006/08/28 21:45:24 1.12 @@ -20,7 +20,10 @@ ;;; 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.11 2006/08/26 16:07:35 fgoenninger Exp $ +;;; $Header: /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lisp,v 1.12 2006/08/28 21:45:24 ktilton Exp $ + +(eval-when (:compile-toplevel :load-toplevel) + (pushnew :cl-ftgl *features*)) (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -65,7 +68,7 @@ (defparameter *ftgl-font-pathnames-list* - #+(or win32 windows) + #+(or win32 windows mswindows) (list (make-pathname :directory @@ -87,12 +90,12 @@ '(:absolute "Library" "Fonts")) (make-pathname :directory - '(:relative "~" "Library" "Fonts"))) -) + '(:relative "~" "Library" "Fonts"))) + ) (defparameter *ftgl-font-types-list* ;; list of font types ;; (font filename endings) - #+(or win32 windows) + #+(or win32 windows mswindows) '("ttf") #+linux @@ -114,7 +117,7 @@ pathname))) (if (probe-file pn) (progn - (format t "~%*** FIND-FONT-FILE: Result = ~A~%" pn) + ;;(format t "~%*** FIND-FONT-FILE: Result = ~A~%" pn) (return-from pn-loop pn))))))) ;; ---------------------------------------------------------------------------- @@ -174,9 +177,28 @@ (defun cl-ftgl-reset () #-(or mcl macosx) (setq *ftgl-loaded-p* nil) - + (cells::trc "nailing fonts loaded!!!!!!!!!!!!!") (setq *ftgl-fonts-loaded* nil)) +(defmacro dbgftgl (tag &body body) + (declare (ignorable tag)) + `(progn + #+nahhh (unless (boundp '*gl-begun*) + (assert (zerop (glgeterror)))) + #+nahhh (loop for (key . fonts) in (mathx::mp-fonts mathx::*font-node*) + when (eq key 'mathx::mathvar) + do (loop for font across fonts + when (or (eql 12 (ftgl-size font))(ftgl-ifont font)) + do (cells::trc nil "dbgftgl sees ifont" ,tag (ftgl-face font)(ftgl-size font)(ftgl-ifont font)))) + (progn ;; cells:wtrc (0 100 "dbgftgl" ,tag) + (ftgl-assert-opengl-context) + (unless (boundp '*gl-begun*) (glec :dbgftgl-entry)) + (prog1 + (progn , at body) + (unless (boundp '*gl-begun*) + (progn + (glec :dbgftgl-post-body))))))) + #+test (progn (cl-ftgl-init) @@ -189,19 +211,24 @@ (defun cl-ftgl-init () (unless *ftgl-loaded-p* - (assert (setq *ftgl-loaded-p* (use-foreign-library FTGL)))) - (format *debug-io* "~%*** CL-FTGL-INIT: Loaded: ~S~%" - *ftgl-loaded-p*)) ;; frgo: Debug ... + (assert (setq *ftgl-loaded-p* (use-foreign-library FTGL))) + (format *debug-io* "~%*** CL-FTGL-INIT: Loaded: ~S~%" + *ftgl-loaded-p*))) (defun ftgl-font-ensure (type face size target-res &optional (depth 0)) - (let ((fspec (list type face size target-res depth))) - (or (cdr (assoc fspec *ftgl-fonts-loaded* :test 'equal)) + (let* ((fspec (list type face size target-res depth)) + (match (cdr (assoc fspec *ftgl-fonts-loaded* :test 'equal)))) + #+shh (if match + (cells:trc "ftgl-font-ensure finds match" fspec (ftgl-ifont match)) + (cells:trc "ftgl-font-ensure NO match" fspec )) + (or match (let ((f (apply 'ftgl-make fspec))) (push (cons fspec f) *ftgl-fonts-loaded*) + (cells:trc nil "ftgl-font-ensure new font spec ifont" fspec (ftgl-ifont f)) f)))) (defun ftgl-make (type face size target-res &optional (depth 0)) - (print (list "ftgl-make entry" type face size)) + ;;(print (list "ftgl-make entry" type face size)) (funcall (ecase type (:bitmap 'make-ftgl-bitmap) (:pixmap 'make-ftgl-pixmap) @@ -217,12 +244,24 @@ ;; --------- ftgl structure ----------------- + (defstruct ftgl + dbg face size target-res depth descender ascender (widths (make-array 256 :initial-element nil)) ft-metrics - ifont) + (ifont nil)) + +(defun dbgfont (font calltag) + (declare (ignore font calltag)) +;;; (cells::trc "dbgfont" calltag (ftgl-dbg font) (ftgl-face font)(ftgl-size font)(ftgl-ifont font)) +;;; (unless (find font mathx::*font-node-all*) +;;; (cells::trc "dbgfont unknown!!!!! " calltag ) +;;; (dolist (f mathx::*font-node-all*) +;;; (cells::trc "known" (ftgl-dbg f)(ftgl-face f)(ftgl-size f))) +;;; (break "odd font")) + ) (defun ftgl-assert-opengl-context () ;; use when debugging FTGL being hit before opengl context estanblished @@ -230,10 +269,11 @@ ) (defun ftgl-char-width (f c) - (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))))) + (assert (zerop (glgeterror))) + (dbgftgl :ftgl-char-width + (or (aref (ftgl-widths f) (char-code c)) + (setf (aref (ftgl-widths f) (char-code c)) + (ftgl-string-length f (string c)))))) (defstruct (ftgl-disp (:include ftgl)) ready-p) @@ -271,52 +311,54 @@ (xftgl) (defun ftgl-get-ascender (font) - (ftgl-assert-opengl-context) - (or (ftgl-ascender font) - (setf (ftgl-ascender font) - (fgc-ascender (ftgl-get-metrics-font font))))) + (cells:trc nil "ftgl-get-ascender" (ftgl-ifont font)) + (dbgftgl :ftgl-get-ascender + (or (ftgl-ascender font) + (setf (ftgl-ascender font) + (fgc-ascender (ftgl-get-metrics-font font)))))) (defun ftgl-get-descender (font) - (ftgl-assert-opengl-context) - (or (ftgl-descender font) - (setf (ftgl-descender font) - (fgc-descender (ftgl-get-metrics-font font))))) + (cells:trc nil "ftgl-get-descender" (ftgl-ifont font)) + (dbgftgl :ftgl-get-descender + (or (ftgl-descender font) + (setf (ftgl-descender font) + (fgc-descender (ftgl-get-metrics-font font)))))) (defun ftgl-height (f) - (ftgl-assert-opengl-context) - (- (ftgl-get-ascender f) - (ftgl-get-descender f))) + (cells:trc nil "ftgl-height" (ftgl-ifont f)) + (dbgftgl :ftgl-height + (- (ftgl-get-ascender f) + (ftgl-get-descender f)))) (defun ftgl-get-display-font (font) - (let ((cf (ftgl-get-metrics-font font))) - (assert cf) - ; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-disp-ready-p font))) - ;; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-ready font))) - - (Unless (ftgl-ready font) - ; (when *ogl-listing-p* - ; (cells::c-break "bad time #1 for sizing? ~a ~a" *ogl-listing-p* font)) - (setf (ftgl-ready font) t) - (typecase font - (ftgl-extruded - #+nyet (let ((*ogl-listing-p* t)) - (trc nil "ftgl-get-display-font> building glyphs for" font) - - (fgc-build-glyphs cf) - (trc nil "ftgl-get-display-font> glyphs built OK for" font))) - (ftgl-texture - #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))) - (ftgl-pixmap - #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))))) - cf)) + (cells:trc nil "ftgl-get-display-font" (ftgl-ifont font)) + (dbgftgl :ftgl-get-display-font + (let ((cf (ftgl-get-metrics-font font))) + (assert cf) + ; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-disp-ready-p font))) + ;; (print (list "FTGL-GET-DISPLAY-FONT sees" (ftgl-ready font))) + + (Unless (ftgl-ready font) + ; (when *ogl-listing-p* + ; (cells::c-break "bad time #1 for sizing? ~a ~a" *ogl-listing-p* font)) + (setf (ftgl-ready font) t) + (typecase font + (ftgl-extruded + #+nyet (let ((*ogl-listing-p* t)) + (cells:trc nil "ftgl-get-display-font> building glyphs for" font) + + (fgc-build-glyphs cf) + (cells:trc nil "ftgl-get-display-font> glyphs built OK for" font))) + (ftgl-texture + #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))) + (ftgl-pixmap + #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))))) + (glec :ftgl-get-display-font) + cf))) (defun ftgl-get-metrics-font (font) - (prog1 - (or (ftgl-ifont font) - (setf (ftgl-ifont font) (ftgl-font-make font))) - - ;; (print (list "ftgl-get-metrics-font: exit" font)) ; frgo, ADDED: debug... - )) + (or (ftgl-ifont font) + (setf (ftgl-ifont font) (ftgl-font-make font)))) (defun ftgl-font-make (font) (let ((path (find-font-file font))) @@ -326,7 +368,6 @@ (if f (progn (fgc-set-face-size f (ftgl-size font) (ftgl-target-res font)) -;; (setf (ftgl-ifont font) f) f) (error "cannot load ~a font ~a" (type-of font) fpath))) (error "Font not found: ~a" path)))) @@ -334,17 +375,23 @@ (defmethod ftgl-render (font s) (assert font) (assert (stringp s)) - (when font - (let ((df (ftgl-get-display-font font))) - (if df - (fgc-render df s) - (break "whoa, no display font for ~a" font))))) + (dbgfont font :ftgl-render) + (dbgftgl :ftgl-render + (when font + (let ((df (ftgl-get-display-font font))) + (ukt:trc nil "ftgl-render ing" df s (ftgl-face font) (ftgl-size font)) + (if df + (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)) + (dbgfont font :ftgl-render-before) + + (dbgftgl :ftgl-render + (gl-enable gl_texture_2d) + (gl-enable gl_blend) + (gl-disable gl_lighting))) (defmethod fgc-font-make :before (font fpath) (declare (ignore font fpath)) @@ -357,7 +404,7 @@ (fgc-bitmap-make fpath)) (defmethod fgc-font-make ((font ftgl-texture) fpath) - (format t "~%*** FGC-FONT-MAKE: fpath = ~A~%" fpath) + ;;(format t "~%*** FGC-FONT-MAKE: fpath = ~A~%" fpath) (fgc-texture-make fpath)) (defmethod fgc-font-make ((font ftgl-extruded) fpath) --- /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/08/21 04:28:27 1.7 +++ /project/cello/cvsroot/cello/cl-ftgl/cl-ftgl.lpr 2006/08/28 21:45:24 1.8 @@ -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) From ktilton at common-lisp.net Mon Aug 28 21:45:27 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 28 Aug 2006 17:45:27 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060828214527.BD874671A8@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv27660/cl-magick Modified Files: cl-magick.lisp Log Message: --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/26 21:46:21 1.9 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/28 21:45:25 1.10 @@ -20,7 +20,8 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: cl-magick.lisp,v 1.9 2006/08/26 21:46:21 fgoenninger Exp $ +;;; $Id: cl-magick.lisp,v 1.10 2006/08/28 21:45:25 ktilton Exp $ + (defpackage :cl-magick (:nicknames :mgk) From ktilton at common-lisp.net Mon Aug 28 21:45:32 2006 From: ktilton at common-lisp.net (ktilton) Date: Mon, 28 Aug 2006 17:45:32 -0400 (EDT) Subject: [cello-cvs] CVS cello/kt-opengl Message-ID: <20060828214532.4005175097@common-lisp.net> Update of /project/cello/cvsroot/cello/kt-opengl In directory clnet:/tmp/cvs-serv27660/kt-opengl Modified Files: gl-def.lisp gl-functions.lisp glu-functions.lisp kt-opengl.lisp kt-opengl.lpr ogl-macros.lisp Log Message: --- /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/07/03 00:35:16 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/gl-def.lisp 2006/08/28 21:45:27 1.3 @@ -27,7 +27,7 @@ (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$))))) + #+nogoodinsideglbegin (glec ',(intern name$))))) (defun aforef (o n) (cffi-uffi-compat:deref-array o '(:array :int) n)) --- /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/08/21 04:28:29 1.3 +++ /project/cello/cvsroot/cello/kt-opengl/gl-functions.lisp 2006/08/28 21:45:27 1.4 @@ -24,6 +24,7 @@ (defparameter *ogl-listing-p* nil) + (defun-ogl :void "open-gl" "glFlush" ()) (defun-ogl :void "open-gl" "glMaterialfv" (glenum face glenum pname glfloat *params)) @@ -32,12 +33,14 @@ (defun-ogl :void "open-gl" "glBegin" (glenum mode )) (defun-ogl :void "open-gl" "glEnd" ( )) + (defun-ogl :void "open-gl" "glVertex2d" (gldouble x gldouble y )) (defun-ogl :void "open-gl" "glVertex2f" (glfloat x glfloat y )) (defun-ogl :void "open-gl" "glVertex2i" (glint x glint y )) (defun-ogl :void "open-gl" "glVertex2s" (glshort x glshort y )) (defun-ogl :void "open-gl" "glVertex3d" (gldouble x gldouble y gldouble z )) (defun-ogl :void "open-gl" "glVertex3f" (glfloat x glfloat y glfloat z )) + (defun-ogl :void "open-gl" "glVertex3i" (glint x glint y glint z )) (defun-ogl :void "open-gl" "glVertex3s" (glshort x glshort y glshort z )) (defun-ogl :void "open-gl" "glVertex4d" (gldouble x gldouble y gldouble z gldouble w )) --- /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/07/03 00:35:16 1.2 +++ /project/cello/cvsroot/cello/kt-opengl/glu-functions.lisp 2006/08/28 21:45:27 1.3 @@ -130,6 +130,7 @@ (dfc GLU_U_STEP 100206) (dfc GLU_V_STEP 100207) + ;;; NurbsSampling */ (dfc GLU_PATH_LENGTH 100215) (dfc GLU_PARAMETRIC_ERROR 100216) --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 18:38:03 1.5 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lisp 2006/08/28 21:45:27 1.6 @@ -21,7 +21,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: kt-opengl.lisp,v 1.5 2006/08/28 18:38:03 fgoenninger Exp $ +;;; $Id: kt-opengl.lisp,v 1.6 2006/08/28 21:45:27 ktilton Exp $ (pushnew :kt-opengl *features*) @@ -62,7 +62,7 @@ #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get #:ogl-pen-move #:with-bitmap-shifted #:texture-name #:ogl-list-cache #:ogl-lists-delete - #:eltgli #:ogl-tex-activate #:gl-name + #:eltgli #:ogl-tex-activate #:gl-name #:glec #:gl-get-integers #:gl-get-floats @@ -80,25 +80,45 @@ (defvar *selecting*) -(define-foreign-library OpenGL - (:windows (:or (namestring +(defparameter *win32-opengl-loc* (namestring (make-pathname ;;#+lispworks :host #-lispworks :device "c" :directory '(:absolute "windows" "system32") :name "opengl32" - :type "dll")))) - (:darwin (:or (:framework "OpenGL")))) + :type "dll"))) -(define-foreign-library GLU - (:windows (:or (namestring +(defparameter *win32-glu-loc* (namestring (make-pathname ;;#+lispworks :host #-lispworks :device "c" :directory '(:absolute "windows" "system32") :name "opengl32" - :type "dll"))))) + :type "dll"))) + +(define-foreign-library OpenGL + (:windows (:or "/windows/system32/opengl32.dll")) + (:darwin (:or (:framework "OpenGL")))) + +(define-foreign-library GLU + (:windows (:or "/windows/system32/glu32.dll"))) (defparameter *opengl-dll* nil) +(defun kt-opengl-init () + (unless *opengl-dll* + (progn + (let ((opengl-loaded-p + (use-foreign-library OpenGL)) + (glu-loaded-p + #+macosx + t ;; on Mac OS X, no explicit loading of GLU needed. + #-macosx + (use-foreign-library GLU))) + (assert (and opengl-loaded-p glu-loaded-p)) + (setf *opengl-dll* t))))) + +(eval-when (:load-toplevel :execute) + (kt-opengl-init)) + (defun gl-boolean-test (value) #+allegro (not (eql value #\null)) #-allegro (not (zerop value))) --- /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/08/21 04:28:29 1.4 +++ /project/cello/cvsroot/cello/kt-opengl/kt-opengl.lpr 2006/08/28 21:45:28 1.5 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 18:37:22 1.7 +++ /project/cello/cvsroot/cello/kt-opengl/ogl-macros.lisp 2006/08/28 21:45:28 1.8 @@ -47,7 +47,7 @@ (defun call-with-matrix (load-identity-p matrix-fn matrix-code) (let* ((mm-pushed (get-matrix-mode)) (sd-pushed (get-stack-depth mm-pushed))) - (cells:wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) + (progn ;; cells:wtrc (0 100 "with-matrix starts with mode" (matrix-mode-symbol mm-pushed) :depth sd-pushed) (gl-push-matrix) (unwind-protect (progn @@ -59,7 +59,7 @@ (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) - (cells:trc "poppping matrix!!!!!" (matrix-mode-symbol (get-matrix-mode)) :from-depth (get-stack-depth (get-matrix-mode))) + (cells:trc nil "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" @@ -93,21 +93,26 @@ (prog1 (funcall attrib-fn) (glec :with-client-attrib)) - (gl-pop-client-attrib))) + (gl-pop-client-attrib) + (glec :with-client-attrib-pop))) (defvar *gl-begun*) (defvar *gl-stop*) (defmacro with-gl-begun ((what) &body body) - `(progn - (when (boundp '*gl-begun*) - (setf *gl-stop* t) - (break ":nestedbegin")) - (let ((*gl-begun* t)) - (gl-begin ,what) - , at body - (gl-end) - (glec :with-gl-begun)))) + `(call-with-gl-begun ,what (lambda () , at body))) + +(defun call-with-gl-begun (what begun-fn) + (when (boundp '*gl-begun*) + (setf *gl-stop* t) + (break ":nestedbegin")) + (progn + (glec :with-gl-begun-BEFORE) + (let ((*gl-begun* t)) + (gl-begin what) + (funcall begun-fn) + (gl-end)) + (glec :with-gl-begun-exit))) (defmacro with-gensyms ((&rest syms) &body body) `(let ,(loop for sym in syms @@ -122,29 +127,22 @@ , at body (gl-translatef (- ,dx)(- ,dy)(- ,dz)))))) -(defun kt-opengl-init () - (unless *opengl-dll* - (progn - (let ((opengl-loaded-p - (use-foreign-library OpenGL)) - (glu-loaded-p - #+macosx - t ;; on Mac OS X, no explicit loading of GLU needed. - #-macosx - (use-foreign-library GLU))) - (assert (and opengl-loaded-p glu-loaded-p)) - (setf *opengl-dll* t))))) -(eval-when (:load-toplevel :execute) - (kt-opengl-init)) -(defun glec (&optional (id :anon)) +(defun kt-opengl-reset () + (loop for ec = (glgeterror) + for n below 10 + when (zerop ec) do (cells::trc "kt-opengl-reset sees zero error code") + (loop-finish) + do (cells::trc "kt-opengl-init sees error" ec))) + +(defun glec (&optional (id :anon) announce-success) (if (and (boundp '*gl-begun*) *gl-begun*) - (progn #+shhh (cells:trc "not checking error inside gl-begin" id)) + (progn (cells:trc nil "not checking error inside gl.begin" id)) (let ((e (glgeterror))) (if (zerop e) - (unless t ;; (find id '(glutcheckloop glutgetwindow)) - (print `(cool ,id))) + (when announce-success + (print `(OpenGL cool ,id))) (if t ;; (null (find id '(glutInitDisplayMode glutInitWindowSize))) (if (boundp '*gl-stop*) (cells:trc "error but *gl-stop* already bound" e id) From ktilton at common-lisp.net Thu Aug 31 17:34:47 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 31 Aug 2006 13:34:47 -0400 (EDT) Subject: [cello-cvs] CVS cello Message-ID: <20060831173447.A75B854070@common-lisp.net> Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv29491 Modified Files: nehe-06.lisp window-utilities.lisp Log Message: important fixes to cl-magick and cello demo nehe-06 --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/24 05:00:35 1.8 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/08/31 17:34:47 1.9 @@ -23,7 +23,11 @@ (defparameter zrot 0.0f0) (defparameter *skin6* nil) +(defvar *jmc-font* ) + (defun nehe-06 () ;; ACL project manager needs a zero-argument function, in project package + (setf *jmc-font* (ftgl-make :texture 'sylfaen 48 96 18)) + (cl-magick-reset) (test-window 'nehe-06-demo)) (defmodel nehe-06-demo (window) @@ -79,7 +83,7 @@ (gl-load-identity)))) -(defparameter *jmc-font* (ftgl-make :texture 'sylfaen 48 96 18)) + (defmethod togl-display-using-class ((self nehe06)) (gl-load-identity) --- /project/cello/cvsroot/cello/window-utilities.lisp 2006/08/21 04:28:26 1.7 +++ /project/cello/cvsroot/cello/window-utilities.lisp 2006/08/31 17:34:47 1.8 @@ -98,6 +98,8 @@ (let ((,item-var (elt ,list (- ,len ,times-var 1)))) , at body))))) +(export! find-ix-under) + (defun find-ix-under (self os-pos &key (test #'true)) (when (and (visible self) (not (collapsed self))) From ktilton at common-lisp.net Thu Aug 31 17:34:48 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 31 Aug 2006 13:34:48 -0400 (EDT) Subject: [cello-cvs] CVS cello/cffi-extender Message-ID: <20060831173448.290375C173@common-lisp.net> Update of /project/cello/cvsroot/cello/cffi-extender In directory clnet:/tmp/cvs-serv29491/cffi-extender Modified Files: arrays.lisp cffi-extender.lpr Log Message: important fixes to cl-magick and cello demo nehe-06 --- /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/07/06 22:09:10 1.2 +++ /project/cello/cvsroot/cello/cffi-extender/arrays.lisp 2006/08/31 17:34:47 1.3 @@ -80,6 +80,14 @@ :ptr ptr) *fgn-mem*)))) +(defun fgn-free-all () + (loop for f in *fgn-mem* do + (foreign-free (fgn-ptr f)) + finally (setf *fgn-mem* nil))) + +#+go +(fgn-free-all) + (defun fgn-free (&rest fgn-ptrs) ;; (print `(fgn-free freeing , at fgn-ptrs)) (let ((start (copy-list fgn-ptrs))) --- /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/08/21 04:28:27 1.4 +++ /project/cello/cvsroot/cello/cffi-extender/cffi-extender.lpr 2006/08/31 17:34:47 1.5 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*- (in-package :cg-user) From ktilton at common-lisp.net Thu Aug 31 17:34:48 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 31 Aug 2006 13:34:48 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-magick Message-ID: <20060831173448.E50605C173@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-magick In directory clnet:/tmp/cvs-serv29491/cl-magick Modified Files: cl-magick.lisp cl-magick.lpr wand-image.lisp Log Message: important fixes to cl-magick and cello demo nehe-06 --- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/28 21:45:25 1.10 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp 2006/08/31 17:34:48 1.11 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Id: cl-magick.lisp,v 1.10 2006/08/28 21:45:25 ktilton Exp $ +;;; $Id: cl-magick.lisp,v 1.11 2006/08/31 17:34:48 ktilton Exp $ (defpackage :cl-magick @@ -34,7 +34,7 @@ #+kt-opengl #:kt-opengl ;; wands as opengl textures ) - (:export #:wand-manager #:wand-ensure-typed + (:export #:cl-magick-init #:cl-magick-reset #:wand-manager #:wand-ensure-typed #:wands-clear #:wand-pixels #:wand-texture #:wand-render #:image-size #:wand-texture-activate #:xim @@ -77,27 +77,23 @@ (cffi:define-foreign-library Wand (:darwin (:or "/usr/local/lib/libWand.dylib"))) -;------------------------------------------------------------------- +;; Order matters! First, load Wand then Magick on Darwin -(defun cl-magick-init () - (or *imagick-dll-loaded* - (progn - ;(print "clearing magick wands") - ;(wands-clear) - - ;; Order matters! First, load Wand then Magick on Darwin - #+macosx - (cffi:use-foreign-library Wand) +#+macosx +(cffi:use-foreign-library Wand) - (assert (setq *imagick-dll-loaded* - (cffi:use-foreign-library Magick)) - () "Unable to load imagick" ) - (print `(magick-copyright ,(magick-get-copyright))) - (print `(magick-version ,(magick-get-version *mgk-version*))) - *imagick-dll-loaded*))) +(cffi:use-foreign-library Magick) + +;------------------------------------------------------------------- -#+test -(cl-magick-init) +(defun cl-magick-init ()) ;; vestigial + +(defun cl-magick-reset () + (wands-clear) + #+shhh (progn + (print `(magick-copyright ,(magick-get-copyright))) + (print `(magick-version ,(magick-get-version *mgk-version*)))) + ) (defun wands-loaded () *wands-loaded*) @@ -113,14 +109,14 @@ (when file-path$ (cl-magick-init) (let ((key (list* wand-type (namestring file-path$) iargs))) - (or (let ((old nil #+nope (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test - (when old + (or (let ((old (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test + #+shhhh (when old (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$))) old) (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/08/21 04:28:28 1.6 +++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr 2006/08/31 17:34:48 1.7 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/28 18:42:26 1.6 +++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp 2006/08/31 17:34:48 1.7 @@ -99,7 +99,7 @@ (let* ((columns (- last-col first-col)) (rows (- last-row first-row)) (pixels (fgn-alloc :unsigned-char (* 3 columns rows) :wand-image))) - + (assert (not (zerop pixels))() "wand-get-image-pixels > fgn-alloc of ~a bytes failed" (* 3 columns rows)) ;;(print (list "wand-get-image-pixels got" wand (* 3 columns rows) pixels)) ;; frgo: debug ... ;;(cells:trc "image format" wand (magick-get-image-format wand)) ;; frgo:debug... (magick-get-image-pixels wand first-col first-row columns rows "RGB" 0 pixels ) From ktilton at common-lisp.net Thu Aug 31 17:34:50 2006 From: ktilton at common-lisp.net (ktilton) Date: Thu, 31 Aug 2006 13:34:50 -0400 (EDT) Subject: [cello-cvs] CVS cello/cl-openal Message-ID: <20060831173450.4D93D5C17E@common-lisp.net> Update of /project/cello/cvsroot/cello/cl-openal In directory clnet:/tmp/cvs-serv29491/cl-openal Modified Files: cl-openal-init.lisp cl-openal.lpr Log Message: important fixes to cl-magick and cello demo nehe-06 --- /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/08/24 07:54:23 1.6 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal-init.lisp 2006/08/31 17:34:49 1.7 @@ -63,7 +63,7 @@ (format t "~&clear AL error code ~a" (al-get-error)) - (let ((l-zip (make-ff-array al-float 0 0 0)) + (let ((l-zip (make-ff-array al-float 10 0 0)) (l-ori (make-ff-array al-float 0 0 -1 0 1 0))) (al-listenerfv al_position l-zip) --- /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/24 17:35:08 1.8 +++ /project/cello/cvsroot/cello/cl-openal/cl-openal.lpr 2006/08/31 17:34:49 1.9 @@ -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)