Re: How to convert in-memory DIB to image in LWW?
On Sun, Aug 15, 2010 at 3:06 PM, Paul Tarvydas <tarvydas@allstream.net> wrote:
> I don't know for certain, but I note that the file
> examples/capi/buttons/buttons.lisp contains code that creates an
> gp:external-image from an constant array of bytes. With some FLI magic, you
> might be able to derive an array that could be used as :data for the
> make-instance 'gp:external-image. ??
>
> There is also the tantalizing statement on pg. 139 of the CAPI User Guide
> that BMPs and DIBs are read by LW code, so maybe some finger-poking might
> turn up an entry point for a conversion routine that accepts a stream
> (sufficiently FLI'ed) ...
The :data slot in external images contains the data as read from a BMP
file which means it contains the BMP header followed by the DIB data.
(BMP and DIB are the same except for this header.)
FWIW, here's the code I'm using now which worked for me in a few test
cases. If it breaks, you can keep both parts:
;; see <http://en.wikipedia.org/wiki/BMP_file_format>
(fli:define-c-struct bitmap-info-header
(size :unsigned-long)
(width :long)
(height :long)
(planes :unsigned-short)
(bit-count :unsigned-short)
(compression :unsigned-long)
(size-image :unsigned-long)
(x-pixels-per-meter :long)
(y-pixels-per-meter :long)
(colors-used :unsigned-long)
(colors-important :unsigned-long))
(defun compute-dib-size (bitmap)
"Given a Lisp number BITMAP representing the address of a DIB in
memory, computes and returns as two values the size of the DIB in
octets and the number of colors in the palette of the DIB."
;; convert number to an FLI address
(setq bitmap (fli:make-pointer :address bitmap :type 'bitmap-info-header))
(fli:with-foreign-slots (bit-count colors-used compression width
height size-image)
bitmap
(let ((number-of-colors colors-used))
(when (and (zerop number-of-colors)
(<= bit-count 8))
;; if the number of colors is zero, that means we have to
;; compute the default value 2^n; however, if the bit depth is
;; eight or higher, there is no palette
(setq number-of-colors (ash 1 bit-count)))
(when (zerop compression)
;; if there's no compression, we have to compute the size -
;; each row is padded so that its length in octets can be
;; divided by four
(let ((octets-per-row (* 4 (ceiling (* width bit-count) 32))))
(setq size-image (* octets-per-row height))))
(when (zerop size-image)
;; this should not happen, as the image was compressed
(error "Image size of DIB is zero."))
(values size-image number-of-colors))))
(defun image-data-from-dib (bitmap)
"Given a Lisp number BITMAP representing the address of a DIB in
memory, returns a Lisp array of octets representing the contents of a
BMP file corresponding to the DIB."
(multiple-value-bind (dib-size number-of-colors)
(compute-dib-size bitmap)
;; the size of the DIB header is 40 octets, the size of the BMP
;; header is 14 octets, the color palette immediately follows the
;; headers with four octets per entry
(let* ((offset (+ 14 40 (* 4 number-of-colors)))
(bmp-size (+ offset dib-size))
(data (make-array bmp-size :element-type '(unsigned-byte 8))))
;; copy the whole DIB into the Lisp array
(fli:replace-foreign-array data
(fli:make-pointer :address bitmap
:type `(:c-array
(:unsigned :byte) ,(- bmp-size 14)))
:start1 14)
;; prepend the BMP header, start with the "magic number"
(setf (aref data 0) (char-code #\B)
(aref data 1) (char-code #\M)
;; the size of the file, all values are little endian
(aref data 2) (ldb (byte 8 0) bmp-size)
(aref data 3) (ldb (byte 8 8) bmp-size)
(aref data 4) (ldb (byte 8 16) bmp-size)
(aref data 5) (ldb (byte 8 24) bmp-size)
;; reserved and not used by us
(aref data 6) 0
(aref data 7) 0
(aref data 8) 0
(aref data 9) 0
;; the offset computed above, i.e. where the palette ends
;; and the image data begins
(aref data 10) (ldb (byte 8 0) offset)
(aref data 11) (ldb (byte 8 8) offset)
(aref data 12) (ldb (byte 8 16) offset)
(aref data 13) (ldb (byte 8 24) offset))
data)))
(defun show-image (data)
"Test function to display the data returned by IMAGE-DATA-FROM-DIB."
(capi:contain (make-instance 'capi:image-pinboard-object
:image (make-instance 'gp:external-image
:data data))))