[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