[cells-cvs] CVS update: cell-cultures/cl-magick/cl-magick.lisp cell-cultures/cl-magick/mgk-test.lisp cell-cultures/cl-magick/wand-pixels.lisp cell-cultures/cl-magick/wand-texture.lisp

Kenny Tilton ktilton at common-lisp.net
Thu Oct 28 00:09:25 UTC 2004


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))))





More information about the Cells-cvs mailing list