Update of /project/cells/cvsroot/cell-cultures/cl-magick In directory common-lisp.net:/tmp/cvs-serv27567/cl-magick Modified Files: cl-magick.lisp mgk-test.lisp wand-pixels.lisp wand-texture.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:22 2004 Author: ktilton Index: cell-cultures/cl-magick/cl-magick.lisp diff -u cell-cultures/cl-magick/cl-magick.lisp:1.2 cell-cultures/cl-magick/cl-magick.lisp:1.3 --- cell-cultures/cl-magick/cl-magick.lisp:1.2 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/cl-magick.lisp Thu Oct 28 02:09:21 2004 @@ -44,18 +44,18 @@ (in-package :cl-magick) (defparameter *magick-dynamic-lib* :unconfigured) -(defparameter *magick-wand-templates* :unconfigured) -(defparameter *cl-magick-source-directory* :unconfigured) (eval-when (:compile-toplevel :load-toplevel) - (load (merge-pathnames "cl-magick-config.lisp" - cl-user::*cello-config-directory*))) + (load (merge-pathnames "cl-magick-config" + cl-user::*cell-cultures-config*))) (defun magick-wand-template () (path-to-wand (merge-pathnames - (make-pathname :name "metal" :type "gif") - *magick-wand-templates*))) + (make-pathname + :directory '(:relative "templates") + :name "metal" :type "gif") + cl-user::*cell-cultures-graphics-directory*))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) Index: cell-cultures/cl-magick/mgk-test.lisp diff -u cell-cultures/cl-magick/mgk-test.lisp:1.3 cell-cultures/cl-magick/mgk-test.lisp:1.4 --- cell-cultures/cl-magick/mgk-test.lisp:1.3 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/mgk-test.lisp Thu Oct 28 02:09:21 2004 @@ -23,18 +23,13 @@ (in-package :cl-magick) -;;;(defun test-images (images-subdir) -;;; (mapcan (lambda (ftype) -;;; (directory (merge-pathnames (make-pathname :type ftype) -;;; images-subdir (string ftype)))) -;;; '(jpg bmp gif tif png))) - #+cello (defun mgk-wand-dump (w &rest info) - (clo::trc "mgk-wand-dump" w info) - (clo::trc "> width" (magick-get-image-width w)) - (clo::trc "> height" (magick-get-image-height w)) - (clo::trc "> description" (magick-describe-image w))) + (ukt::trc "mgk-wand-dump" w info) + ;; (ukt::trc "> width" (magick-get-image-width w)) + ;; (ukt::trc "> height" (magick-get-image-height w)) + ;; (ukt::trc "> description" (magick-describe-image w)) + ) (defconstant wcx 640) ;; Window Width (defconstant wcy 480) ;; Window Height @@ -268,11 +263,10 @@ (defun test-image (filename filetype) (merge-pathnames (make-pathname - :directory '(:relative "test") + :directory '(:relative "shapers") :name (string filename) :type (string filetype)) - *cl-magick-source-directory*)) - + cl-user::*cell-cultures-graphics-directory*)) (defun r6init() (gl-enable gl_texture_2d) @@ -283,9 +277,9 @@ (gl-depth-func gl_lequal) (gl-hint gl_perspective_correction_hint gl_nicest) (setf *skin6* (mgk:wand-ensure-typed 'wand-texture - (clo::demo-image-file 'shapers "jmcbw512.jpg"))) + (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (clo::demo-image-file 'shapers "grace.jpg")))) + (test-image "grace" "jpg")))) #+test Index: cell-cultures/cl-magick/wand-pixels.lisp diff -u cell-cultures/cl-magick/wand-pixels.lisp:1.2 cell-cultures/cl-magick/wand-pixels.lisp:1.3 --- cell-cultures/cl-magick/wand-pixels.lisp:1.2 Fri Oct 1 06:01:19 2004 +++ cell-cultures/cl-magick/wand-pixels.lisp Thu Oct 28 02:09:21 2004 @@ -44,7 +44,7 @@ :image-sz sz) (let ((y-move (downs (+ 0 (abs (- top bottom)))))) (with-bitmap-shifted (0 y-move) - (clo::trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) + ;;(ukt::trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) #+hush (if (ogl-get-boolean gl_current_raster_position_valid) (progn Index: cell-cultures/cl-magick/wand-texture.lisp diff -u cell-cultures/cl-magick/wand-texture.lisp:1.4 cell-cultures/cl-magick/wand-texture.lisp:1.5 --- cell-cultures/cl-magick/wand-texture.lisp:1.4 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/wand-texture.lisp Thu Oct 28 02:09:21 2004 @@ -26,7 +26,7 @@ (progn (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))))