[mcclim-cvs] CVS mcclim/Extensions

[dlichteblau]

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))))