Re: of color monitors and triple-clicks

["Mark A. Tapia" <markt@dgp.toronto.edu>]

On  Mon Feb 14, Chris Crone asks:
  1)  How can you tell whether the monitor attached to the computer on which
  MCL is being run is color or not?  I know, for example, that MCL has access
  to *screen-height* and *screen-width*, but is there a screen-color-p
  somewhere? *color-available* only tells whether color quickdraw is
  around, I think, which is not the same.

You can use the utilities in my menu-enhancement package available by ftp
from cambridge.apple.com in pub/MCL2/contrib/menu-enhancements.sit.hqx.
Here's a shorter answer:

The short answer is to use the #_getdevicelist and #_getnextdevice traps.

Here is  code that will do what I think you want for all of the gdevices
on the device list. Right now it returns for each device the size, and the
the extent (upper-left and bottom-right corners). You can examine the
port-pixmap.  If you want to get the system color map (i.e. the color table
fro the main screen, examine the code for the with-saved-screen-map in
the file oou-utils.lisp in the contrib file. it defines a window manager
view wmgr-view for screen. I use the code to save and restore a rectangular
portion of the screen when using marking (pop-upp radial menus).

mark

(ccl::%require-interface 'quickdraw) 
(defun get-gdevice-attributes (screen-gdevice)
  ;; for a gdevice retrieves the following attributes
  ;; the underlying port-pixmap, and the two corners of
  ;; the port-rect
  (let ((screen-top (rref screen-gdevice :gdevice.gdrect.topLeft))
        (screen-bottom (rref screen-gdevice :gdevice.gdrect.bottomRight))
        (port-pmap (rref screen-gdevice :gdevice.gdpmap)))
    (values port-pmap               ; the screen pixmap
            screen-top              ; the top left corner of the gdevice port 
rect
            screen-bottom           ; the bottom right corner
            )))

(defun get-all-gdevice-attributes ()
  ;; loop through all of the gdevices on the device list
  ;; and print the size of the device 
  (loop with screen-gdevice = (#_getdevicelist) and device-no = 0
        until (ccl::%null-ptr-p screen-gdevice)
         do (multiple-value-bind (pixmap top bottom)
                                (get-gdevice-attributes screen-gdevice)
             (declare (ignore pixmap))
             
             (format t "~&Device ~d size= ~a [~a -> ~a]~%" 
                     device-no (point-string (subtract-points bottom top))
                     (point-string top) (point-string bottom)))
        do (setq screen-gdevice (#_getnextdevice screen-gdevice))
         do (incf device-no)))

? (get-all-gdevice-attributes)
Device 0 size= #@(640 480) [#@(0 0) -> #@(640 480)]
NIL