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