[closure-cvs] CVS closure/src/imagelib
dlichteblau
dlichteblau at common-lisp.net
Sun Jan 7 19:33:02 UTC 2007
Update of /project/closure/cvsroot/closure/src/imagelib
In directory clnet:/tmp/cvs-serv18168/src/imagelib
Modified Files:
basic.lisp gif.lisp
Log Message:
Moved AIMAGE drawing routines into McCLIM.
--- /project/closure/cvsroot/closure/src/imagelib/basic.lisp 2007/01/03 15:39:29 1.4
+++ /project/closure/cvsroot/closure/src/imagelib/basic.lisp 2007/01/07 19:33:02 1.5
@@ -1,4 +1,4 @@
-;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RENDERER; -*-
+;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*-
;;; ---------------------------------------------------------------------------
;;; Title: General image routines
;;; Created: 1998-11-11
@@ -38,18 +38,28 @@
(in-package :imagelib)
-(defstruct (aimage
- (:constructor make-aimage/low)
- (:copier nil)
- (:print-function print-aimage))
- (width 0 :type fixnum)
- (height 0 :type fixnum)
- (data nil :type (or null (simple-array (unsigned-byte 32) (* *))))
- alpha-p
- plist)
+;;; AIMAGE has been moved into McCLIM under the name RGB-IMAGE, but
+;;; without a plist and with different slot accessors. Here's a wrapper
+;;; class for now:
+(defclass aimage ()
+ ((rgb-image :initarg :rgb-image :accessor aimage-rgb-image)
+ (plist :initarg :plist :accessor aimage-plist)))
+
+(defun aimage-width (ai) (climi::image-width (aimage-rgb-image ai)))
+(defun aimage-height (ai) (climi::image-height (aimage-rgb-image ai)))
+(defun aimage-data (ai) (climi::image-data (aimage-rgb-image ai)))
+(defun aimage-alpha-p (ai) (climi::image-alpha-p (aimage-rgb-image ai)))
+
+(defun make-aimage/low (&key width height data alphap plist)
+ (make-instance 'aimage
+ :rgb-image (make-instance 'climi::rgb-image
+ :width width
+ :height height
+ :data data
+ :alphap alphap)
+ :plist plist))
-(defun print-aimage (self sink depth)
- (declare (ignore depth))
+(defmethod print-object ((self aimage) sink)
(format sink "<~S ~D x ~D from ~S>" 'aimage
(aimage-width self) (aimage-height self)
(getf (aimage-plist self) :url)))
@@ -59,7 +69,7 @@
:height height
:data (make-array (list height width)
:element-type '(unsigned-byte 32))
- :alpha-p alpha-p))
+ :alphap alpha-p))
(defun scale-aimage (source new-width new-height)
(when (or (zerop new-width) (zerop new-height))
--- /project/closure/cvsroot/closure/src/imagelib/gif.lisp 2007/01/03 16:41:15 1.2
+++ /project/closure/cvsroot/closure/src/imagelib/gif.lisp 2007/01/07 19:33:02 1.3
@@ -57,7 +57,7 @@
(skippy:color-rgb
(skippy:color-table-entry gif-color-table color-index))))
(setf (aref aimage-data y x)
- (dpb r (byte 8 0)
+9D (dpb r (byte 8 0)
(dpb g (byte 8 8)
(dpb b (byte 8 16)
(dpb (or a 0) (byte 8 24) 0))))))))
More information about the Closure-cvs
mailing list