Re: MCL and Handles/Ptrs

[bill@cambridge.apple.com (Bill St. Clair)]

>I've been through the MCL documentation, but it is a little less than clear
>when it comes to interfacing with the Mac toolbox directly.  Here is my
>problem,
>best illustrated by a concrete example:
>
>I want to walk through a list of handles (in this case the GDevice List).  It
>each
>case I want to check if the handle is nil (i.e. I've reached the end of my
>list).
>I am using the "rlet" macro to create a temporary gdHandle as follows
>
[...]

Here's some code from the MCL sources. These functions are
not documented, but they probably should be. They are defined in
the file "MCL 2.0 CD:Additional MCL Source Code:lib:color.lisp".
The DO-SCREENS macro does what you want to do.

--------------------------------------------------------------------

(in-package :ccl)

(defun screen-attribute (screen attribute)
  (#_TestDeviceAttribute screen attribute))

(defun screen-active-p (screen)
  (and (screen-attribute screen #$screenDevice)
       (screen-attribute screen #$screenActive)))

(defun screen-color-p (screen)
  (screen-attribute screen #$gdDevType))

(defun screen-bits (screen)
  (rref (rref screen :GDevice.gdPMap) :PixMap.PixelSize))

(defun screen-position (screen)
  (rref screen :GDevice.gdRect.topleft))

(defun screen-size (screen)
  (subtract-points
   (rref screen :GDevice.gdRect.bottomright)
   (screen-position screen)))

(defmacro do-screens ((s &optional (active-only? t)) &body body)
  `(with-macptrs ((,s (require-trap #_GetDeviceList)))
     (loop
       (if (%null-ptr-p ,s) (return))
       (when ,(if active-only? `(screen-active-p ,s) t)
         ,@body)
       (%setf-macptr ,s (require-trap #_GetNextDevice ,s)))))

; [...]

(defun find-screen (point &optional return-screen)
  (when return-screen
    (%setf-macptr return-screen (%null-ptr)))
  (if *color-available*
    (do-screens (screen)
      (let* ((pos (screen-position screen))
             (pos-h (point-h pos))
             (pos-v (point-v pos))
             (size (screen-size screen))
             (h (point-h point))
             (v (point-v point)))
        (declare (fixnum pos-h pos-v h v))
        (when
          (and (<= pos-h h)
               (<= h (the fixnum (+ pos-h (the fixnum (point-h size)))))
               (<= pos-v v)
               (<= v (the fixnum (+ pos-v (the fixnum (point-v size))))))
          (when return-screen (%setf-macptr return-screen screen))
          (return (values pos size)))))
    (let ((size (make-point *screen-width* *screen-height*)))
      (and (point<= #@(0 0) point size)
           (values #@(0 0) size)))))