[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