[cl-sdl-help] color struct not passed by value in cl-sdl-ttf

[Tril <tr...@tu...>]

#|

ttf:render-glyph-blended and other similar functions (at least
ttf:render-glyph-shaded is affected as well) expect a sdl:color
structure to be passed by value.  However, the struct is actually
passed by address even though the function correctly requires an
argument of type (:struct sdl:color) and won't accept a pointer to one
(try passing the color to ttf:render-glyph-blended without using
sgum:deref-pointer on it first and get a type error).  The below code
shows that the address of the struct gets interpreted as an RGB value
and embedded into every pixel of the returned bitmap.

Usage: load the below code, then evaluate:
(test *white*) 
(test *black*) 
 
The test function calls ttf:render-glyph-blended to create a bitmap of
the capital letter 'A', then outputs the array of pixels returned
followed by the address of the color struct you passed in, all in hex.
 
The low order 24 bits of the address of the color struct (instead of
the correct contents of the color struct) will become the RGB portion
of the returned colors (in reverse order).  So for instance if
(sgum:address-of *white*) is #x818F770, then all the pixels returned
from ttf:render-glyph-blended will contain #x70, #xF7, and #x18 as
color information.  The alpha component will be correct.
  
I simply don't know enough UFFI or Lisp to easily fix this myself, but
I guess the bug is in cl-sdl-0.2.2/ffi/uffi.lisp, macro
def-foreign-routine or something called from there, possibly UFFI
itself.

For the record I am using Debian unstable with packages:
sbcl 0.9.11.0-1
cl-sdl 0.2.2-3
cl-sdl-ttf 0.2.2-3
cl-uffi 1.5.13-1

-Tril

|#

(require :sdl-ttf) 
(ttf:init) 
(defparameter *font* (ttf:open-font "VeraMono.ttf" 16)) 
 
(defparameter *white* (sgum:allocate-foreign-object sdl:color 1))  
(setf (sdl:color-r *white*) 255)  
(setf (sdl:color-g *white*) 255)  
(setf (sdl:color-b *white*) 255)  
 
(defparameter *black* (sgum:allocate-foreign-object sdl:color 1)) 
(setf (sdl:color-r *black*) 0) 
(setf (sdl:color-g *black*) 0) 
(setf (sdl:color-b *black*) 0) 
 
(defun test (color) 
  (let* ((a (ttf:render-glyph-blended *font* (char-code #\A) (sgum:deref-pointer color sdl:color))) 
         (pixel-values (loop for row from 0 to (- (sdl:surface-h a) 1) 
                        collect (loop for col from 0 to (- (sdl:surface-w a) 1) 
                                  collect (format nil "~X" (sdl:get-pixel a col row)))))) 
    (format t "~A~%~X" pixel-values (sgum:address-of color))))