[cello-cvs] CVS cello/cl-magick

[ktilton]

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)