Re: seedFill -- need example

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

I was working on this one at the same time as John. He beat me to it,
but here's my version anyway.

-Bill

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

; seed-fill-example.lisp
;
; An example of using the #_SeedFill trap.
; Note that #_SeedFill will not work in place the way that #_CopyBits does:
; you really need to use two different bitmaps or two disjoint sections
; of one bitmap. This doesn't really need to allocate two bitmaps.
; Instead it could #_SeedFill directly from the window's bitmap
; to a single off-screen bitmap. This version will work correctly
; on color windows however, while the single bitmap version won't.
; Note that this will not work correctly if any part of the image
; is obscured by another window. If you're writing a paint program,
; you'll need to store the image off-screen.

(require "QUICKDRAW")

(defun seed-fill-window (window h &optional v)
  "Flood the region at h,v with paint."
  (let ((size (view-size window))
        (wptr (wptr window))
        src-bitmap
        dst-bitmap)
    (rlet ((rect :rect :topleft #@(0 0) :botright size))
      (unwind-protect
        (with-focused-view window
          (setq src-bitmap (make-bitmap rect)
                dst-bitmap (make-bitmap rect))
          (copy-bits (pref wptr :windowRecord.port.portbits)
                     src-bitmap
                     rect
                     rect)
          (let* ((h (if v h (point-h h)))
                 (v (if v v (point-v h)))
                 (srcptr (pref src-bitmap :bitmap.baseaddr))
                 (dstptr (pref dst-bitmap :bitmap.baseaddr))
                 (srcrow (pref src-bitmap :bitmap.rowbytes))
                 (dstrow (pref dst-bitmap :bitmap.rowbytes))
                 (height (point-v size))
                 (words (ceiling (point-h size) 16)))
            (#_seedFill srcptr dstptr srcrow dstrow height words h v))
          (copy-bits dst-bitmap
                     (pref wptr :windowRecord.port.portbits)
                     rect
                     rect
                     #$srcor))
        (when src-bitmap
          (dispose-record src-bitmap))
        (when dst-bitmap
          (dispose-record dst-bitmap))))))

#|

(setq *w* (make-instance 'window))
(frame-rect *w* 20 20 100 100)
(seed-fill-window *w* 50 50)       ; flood the rectangle w/ paint
(invalidate-view *w* t)
(frame-oval *w* 20 20 100 100)
(seed-fill-window *w* 50 50)       ; flood the circle w/ paint

|#