Update of /project/mcclim/cvsroot/mcclim/Extensions In directory clnet:/tmp/cvs-serv16520/Extensions
Modified Files: rgb-image.lisp Log Message: - added jpeg.lisp by Eric Marsden and Troels Henriksen - changed rgb-image-design to invalidate the medium-specific cache automatically instead of being bound to one medium - added output recording for draw-design of an rgb-image-design
--- /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2007/04/01 17:24:04 1.2 +++ /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2008/01/06 16:05:46 1.3 @@ -43,14 +43,12 @@ ;;; medium, so that mediums can put their own data into them.
(defclass rgb-image-design (design) - ((medium :initarg :medium) + ((medium :initform nil :initarg :medium) (image :initarg :image) (medium-data :initform nil)))
-(defun make-rgb-image-design (medium image) - (make-instance 'rgb-image-design - :medium medium - :image image)) +(defun make-rgb-image-design (image) + (make-instance 'rgb-image-design :image image))
;;; Protocol to free cached data @@ -65,8 +63,13 @@
(defgeneric medium-draw-image-design* (medium design x y))
-(defmethod medium-draw-image-design* :before (medium design x y) - (assert (eq medium (slot-value design 'medium)))) +(defmethod medium-draw-image-design* :before (current-medium design x y) + (with-slots (medium medium-data) design + (unless (eq medium current-medium) + (when medium + (medium-free-image-design medium design)) + (setf medium current-medium) + (setf medium-data nil))))
;;; Fetching protocol @@ -88,3 +91,17 @@ :alphap alphap))))
(defgeneric sheet-rgb-data (port sheet &key x y width height)) + + +;;; Output recording + +(defun draw-image-design* + (medium design &rest options &key x y &allow-other-keys) + (unless (and x y) + (setf (values x y) (clim:stream-cursor-position medium))) + (climi::with-medium-options (medium options) + (medium-draw-image-design* (sheet-medium medium) design x y))) + +(defmethod draw-design + (medium (design rgb-image-design) &rest options &key &allow-other-keys) + (apply #'draw-image-design* medium design options))