Saving screen pixels maps (color/monochrome)

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

I need help using color graf ports. My application needs to save and 
restore pixels in a rectangle possibly outside the current focused view. 

The test-bit-map procedure 
  1.  saves a picture corresponding to a bit/pixmap of 60 x 60 pixels
      centered at the view-position of the view.
  2.  blacks out the area
  3.  waits one second
  4.  restores the pixels
  5.  kills the picture

The test-bit-map procedure works when the grafport is 1 bit monochrome.
With cgrafports, the result is to create black pixels where the pixels
were not white and white pixels for all other pixels.


;; code follows
(require 'traps)
(require 'quickdraw)

;; new records for pointers to grafPorts and cGrafPorts
(defrecord graf-ptr (grafPort (:pointer grafport)))

(defrecord cGraf-ptr (cGrafPort (:pointer cgrafport)))

(defun port-color-p (the-port)
  "Is the port a color port?"
  (and *color-available*
       (not (zerop (rref the-port :grafPort.colrbit)))))

;; macro from the oodles-of-utils package
(defmacro with-clip-rgn (clip-rgn &body body)
    (let ((old-clip (gensym)))
      `(with-macptrs ((,old-clip (require-trap #_NewRgn)))
         (unwind-protect
           (progn
             (require-trap #_GetClip ,old-clip)
             (require-trap #_SetClip ,clip-rgn)
             ,@body)
           (require-trap #_SetClip ,old-clip)
           (require-trap #_DisposeRgn ,old-clip)))))

(defmacro with-wmgr-port (wmgr-port &rest body)
  "Executes the body with the symbol corresponding to the first
argument bound to the window manager port, which may be
either a grafport (monochrome) or a cGrafPort"
  (let ((sym (gensym)))
    `(rlet ((,sym :graf-ptr))
       (unwind-protect
         (let (,wmgr-port)
           (#_getwmgrport ,sym)
           (setq ,wmgr-port
                 (if (port-color-p ,sym)
                   (rref ,sym :cgraf-ptr.cgrafPort)
                   (rref ,sym :graf-ptr.grafPort)))
           (with-port ,wmgr-port
             (with-clip-rgn (rref ,wmgr-port :grafPort.clipRgn)
               (with-clip-rect (rref ,wmgr-port :grafPort.portRect)
                 ,@body
                 ))))))))

(defmethod test-bit-map ((self view))
  (let (saved-bit-map
        (view-position (view-position self)))
    (rlet ((rectangle :rect :topLeft (subtract-points view-position #@(30 30))
                      :bottomRight (add-points view-position #@(30 30))))
      (with-focused-view self
        (with-wmgr-port the-port the-port
          (setq saved-bit-map (save-bit-map self the-port rectangle))
          (#_paintrect rectangle)
          (sleep 1)
          (restore-bit-map self the-port saved-bit-map rectangle)
          (kill-picture saved-bit-map))))))

(defmethod save-bit-map ((self view) the-port rect)
  ;; returns the bit map corresponding to the offset menu-rect
  (with-clip-rect rect
    (let* ((pict (#_OpenPicture :ptr rect :ptr))
           (bits (if (port-color-p the-port)
                   (rref the-port :cGrafPort.portPixMap)
                   (rref the-port :grafPort.portbits))))
      (#_CopyBits :ptr bits :ptr bits :ptr rect :ptr rect :word 0:ptr (%null-ptr))
      (#_ClosePicture)
      pict)))

(defmethod restore-bit-map ((self view) the-port saved-bit-map rect)
  ;; restores the bit map corresponding to the offset menu-rect
  (declare (ignore the-port))
  (when (and (handlep saved-bit-map))
    (#_DrawPicture saved-bit-map rect)))

;; Create a window
(setq that (make-instance 'window :view-position #@(30 30)))

;; Test the procedure
(test-bit-map that)
;;  End of Code


Thanks,

Mark Tapia