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

Kenny Tilton ktilton at common-lisp.net
Fri Oct 15 03:37:55 UTC 2004


Update of /project/cells/cvsroot/cell-cultures/cl-magick
In directory common-lisp.net:/tmp/cvs-serv28025/cl-magick

Modified Files:
	cl-magick.lisp mgk-test.lisp wand-texture.lisp 
Log Message:
Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw.
Date: Fri Oct 15 05:37:46 2004
Author: ktilton

Index: cell-cultures/cl-magick/cl-magick.lisp
diff -u cell-cultures/cl-magick/cl-magick.lisp:1.1 cell-cultures/cl-magick/cl-magick.lisp:1.2
--- cell-cultures/cl-magick/cl-magick.lisp:1.1	Sat Jun 26 20:38:39 2004
+++ cell-cultures/cl-magick/cl-magick.lisp	Fri Oct 15 05:37:40 2004
@@ -93,15 +93,15 @@
     (cl-magick-init)
     (let ((key (list* wand-type (namestring file-path$) iargs)))
       (or (let ((old (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test
-            #+shh (when old
-              (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$)))
+            #+shhh (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)))
           #+shhh (print `(wand-ensure-typed forced to load ,wand-type ,file-path$))
-            (push (cons key wi) (wands-loaded))
-            wi)
+          (push (cons key wi) (wands-loaded))
+          wi)
         (error "Unable to load image file ~a" file-path$)))))
 
 #+allegro


Index: cell-cultures/cl-magick/mgk-test.lisp
diff -u cell-cultures/cl-magick/mgk-test.lisp:1.2 cell-cultures/cl-magick/mgk-test.lisp:1.3
--- cell-cultures/cl-magick/mgk-test.lisp:1.2	Fri Oct  1 06:01:19 2004
+++ cell-cultures/cl-magick/mgk-test.lisp	Fri Oct 15 05:37:40 2004
@@ -300,7 +300,7 @@
     (gl-matrix-mode gl_projection)
     (gl-load-identity)
     (glu-perspective 45 (/ width height) 0.1 100)
-    (gl-matrix-mode gl_model-view)
+    (gl-matrix-mode gl_modelview)
     (gl-load-identity)))
 
 (defun cl-magick-test ()


Index: cell-cultures/cl-magick/wand-texture.lisp
diff -u cell-cultures/cl-magick/wand-texture.lisp:1.3 cell-cultures/cl-magick/wand-texture.lisp:1.4
--- cell-cultures/cl-magick/wand-texture.lisp:1.3	Fri Oct  1 06:01:19 2004
+++ cell-cultures/cl-magick/wand-texture.lisp	Fri Oct 15 05:37:40 2004
@@ -28,8 +28,8 @@
   (defclass wand-texture (wand-image ogl-texture)())
   
   (defmethod wand-release :after ((wand wand-texture))
-    (when (texture-name wand)
-      (ogl-texture-delete (texture-name wand))))
+    (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)
@@ -45,13 +45,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))
         (unless (equal (image-size self) best-fit-sz)
-          ;;(print `(tex-refit ,(image-size self) to ,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)
           (setf (image-size self) best-fit-sz))
         
-        ;(print `(new image size ,(image-size self)))
+        #+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)
@@ -125,10 +126,10 @@
         (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)))
-        ))))R
\ No newline at end of file
+        ))))
\ No newline at end of file





More information about the Cells-cvs mailing list