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