[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