Update of /project/mcclim/cvsroot/mcclim/Extensions In directory clnet:/tmp/cvs-serv18071/Extensions
Added Files: rgb-image.lisp Log Message:
Add a new class RGB-IMAGE (renamed from closure's IMAGELIB:AIMAGE) and RGB-IMAGE-DESIGN (used to implement CLOSURE/CLIM-DEVICE::RO/IMG).
Drawing code implemented only in CLIM-CLX, and only for true color visuals.
* Examples/rgb-image.lisp: New file, from closure/src/imagelib/basic.lisp. * Backends/CLX/medium.lisp (MEDIUM-DRAW-IMAGE-DESIGN*, MEDIUM-FREE-IMAGE-DESIGN, COMPUTE-RGB-IMAGE-PIXMAP, COMPUTE-RGB-IMAGE-MASK, IMAGE-TO-XIMAGE-FOR-DRAWABLE, IMAGE-TO-XIMAGE, MASK->BYTE, PIXEL-TRANSLATOR): Methods and functions, renamed from original closure code.
--- /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2007/01/07 19:32:29 NONE +++ /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2007/01/07 19:32:29 1.1 ;;; (c) copyright 1998 by Gilbert Baumann ;;; ;;; Permission is hereby granted, free of charge, to any person obtaining ;;; a copy of this software and associated documentation files (the ;;; "Software"), to deal in the Software without restriction, including ;;; without limitation the rights to use, copy, modify, merge, publish, ;;; distribute, sublicense, and/or sell copies of the Software, and to ;;; permit persons to whom the Software is furnished to do so, subject to ;;; the following conditions: ;;; ;;; The above copyright notice and this permission notice shall be ;;; included in all copies or substantial portions of the Software. ;;; ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. ;;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY ;;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, ;;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;;; ;;; (Hacked for inclusion into McCLIM by David Lichteblau.)
(in-package :climi)
;;; ARGB image data represented as an (unsigned-byte 32) array
(defclass rgb-image () ((width :initarg :width :accessor image-width) (height :initarg :height :accessor image-height) (data :initarg :data :accessor image-data :type (or null (simple-array (unsigned-byte 32) (* *)))) (alphap :initarg :alphap :initform nil :accessor image-alpha-p)))
;;; Applications (closure in particular) might want to cache any ;;; backend-specific data required to draw an RGB-IMAGE. ;;; ;;; To implement this caching, designs must be created separately for each ;;; medium, so that mediums can put their own data into them.
(defclass rgb-image-design (design) ((medium :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))
;;; Protocol to free cached data
(defgeneric medium-free-image-design (medium design))
(defun free-image-design (design) (medium-free-image-design (slot-value design 'medium) design))
;;; Drawing protocol
(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))))