Whiter Whites?

[korcuska@aristotle.ils.nwu.edu (Michael &)]

Perhaps this has been discussed before.  If so, sorry...

I was using the following code (sort of) the other day to draw white text over
a colored background:

(with-fore-color *white-color*
  (with-cstrs ((s "A String"))
    (#_TextBox s (length "A String") r #.#$teJustCenter))) ; where r is a Rect

Much to my suprise the text is not white if the monitor is set to 4 bits deep
or less.  Why? Well, from the AppleDoc for MCL:

   The Macintosh stores colors as 48-bit red-green-blue (RGB) values,
   with 16 bits each for the red, green, and blue components. Because 
   current hardware generally supports a maximum of 24 bits of color, 
   Macintosh Common Lisp encodes colors as fixnums with 8 bits each 
   for red, green, and blue (and 5 bits unused). Therefore, creating 
   a color encoding does not allocate memory... 
   Although they are stored as 8-bit values when encoded in a color, 
   decoded components are expressed as 16-bit values. This allows 
   compatibility with some Macintosh tools (such as the Color Picker). 
   Unfortunately, it also means that the low 8 bits of each color component 
   are lost when the color is encoded and decoded.

So:
? (color-values *white-color*)
65280
65280
65280
instead of 65535.  65280 is, incidently #xFF00 which is what you'd expect from
the docs.  In fact, because of the color encoding scheme, the following occurs:
? (color-values (make-color 65535 65535 65535))
65280
65280
65280

So if you need whiter whites (or more precise colors in general) you may find
the following two macros useful:

;; with macros for rgb colors.  Save the current rgb, execute
;; the body and restore.  Should be pretty obvious.
(defmacro with-fore-rgb ((red green blue) &body body)
  (let ((old-rgb_p (gensym))
        (new-rgb_p (gensym)))
    `(rlet ((,old-rgb_p :RGBColor)
            (,new-rgb_p :RGBColor :red ,red :green ,green :blue ,blue))
       (require-trap #_GetForeColor ,old-rgb_p)
       (unwind-protect
         (progn
           (require-trap #_RGBForeColor ,new-rgb_p)
           ,@body)
         (require-trap #_RGBForeColor ,old-rgb_p)))))

(defmacro with-back-rgb ((red green blue) &body body)
  (let ((old-rgb_p (gensym))
        (new-rgb_p (gensym)))
    `(rlet ((,old-rgb_p :RGBColor)
            (,new-rgb_p :RGBColor :red ,red :green ,green :blue ,blue))
       (require-trap #_GetBackColor ,old-rgb_p)
       (unwind-protect
         (progn
           (require-trap #_RGBBackColor ,new-rgb_p)
           ,@body)
         (require-trap #_RGBBackColor ,old-rgb_p)))))


Michael Korcuska
korcuska@ils.nwu.edu
The Institute for the Learning Sciences
Northwestern Universit