Re: seedFill -- need example

[language@skdad.usask.ca]

;; SeedFill Example
;; 
;; Well,  here's an example of 'how to do the paint bucket thing' in lisp.
;; I hope the comments sufficient explanation, but if they aren't please
;; feel free to ask me to decrypt my code for you....
;;     - John Montbriand  language@skdad.usask.ca
;; Jan 18 1993
;; tested on a SE/30.
 
;; bits-addr-offset: calculate offset from baseAddr to
;; the start of the image--this value must be
;; word aligned
(defun bits-addr-offset (h v rowbytes)
  (+ (* v rowbytes) (* (truncate (/ (+ h 15) 16)) 2)))
 
 
;; window size--I made both windows the same size
(defparameter *size* #@(150 150))
 
;; horizontal seed ordinate
(defparameter *seed-h* 20)
 
;; vertical seed ordinate
(defparameter *seed-v* 22)
 
;; NOTE:  windows all share the same bitmap
;; SeedFill allows you to use two separate parts
;; of a single bitmap as the source and destination.
;; they should not overlap.  if you want the invisible
;; affect, allocate a bitmap in memory.
 
;; the source (part of the screen bitmap) window 
(defparameter *src* (make-instance 'window
                  :view-position #@(10 60)
                  :view-size *size*
                  :window-title "source"))
 
;; the destination (part of the screen bitmap) window 
(defparameter *dst* (make-instance 'window
                  :view-position #@(200 60)
                  :view-size *size*
                  :window-title "destination"))
  
;; do some hi-tech graphics in the source window
(frame-rect *src* 20 20 100 100)
(frame-oval *src* 25 25 95 95)
(frame-oval *src* 50 50 120 120)
 
 
(let* ((s-h (point-h (view-position *src*))) ; source horizontal pos
       (s-v (point-v (view-position *src*))) ; source vertical pos
       (d-h (point-h (view-position *dst*))) ; destination horizontal pos
       (d-v (point-v (view-position *dst*))) ; destination vertical pos
           ;; rowbytes is the same for both srcptr and dstptr since
           ;; they both refer to parts of the same bitmap
       (rowbytes (pref (wptr *src*) windowrecord.portbits.rowBytes))
           ;; srcPtr points to the start of the source window's data
       (srcPtr (%inc-ptr
                (pref (wptr *src*) windowrecord.portbits.baseAddr)
                (bits-addr-offset s-h s-v rowbytes)))
           ;; srcPtr points to the start of the destination window's data
       (dstPtr (%inc-ptr
                (pref (wptr *dst*) windowrecord.portbits.baseAddr)
                (bits-addr-offset d-h d-v rowbytes)))
           ;; both windows are the same width,  so the number of words
           ;; wide they are is the same:
       (words  (truncate (/ (- (point-h (view-size *src*)) 20) 16)))
           ;; height of the window
       (height (- (point-v (view-size *src*)) 20)))
 
      ;; create a mask in the destination window for the fill area
  (#_seedFill srcptr dstptr rowbytes rowbytes height words *seed-h* *seed-v*)
  
      ;; change the generated mask to some new pattern
  (set-pen-mode *dst* :patBic)
  (set-pen-pattern *dst* *gray-pattern*)
  (paint-rect *dst* 0 0 150 150)
  
      ;; or the mask with the original mask complete the paint bucket function
  (let ((target-rectangle (make-record rect)))
        ;; because of the word-alignment requirement for srcptr
        ;; and dstptr in the seedFill call,  the two windows are slightly 
        ;; misaligned (by 2 pixels).  here we calculate a target rectangle
        ;; to compensate in the copybits call
    (copy-record (pref (wptr *dst*) windowrecord.portrect)
                 rect target-rectangle)
    (offset-rect target-rectangle -2 0)
        ;; copy the mask back to the original bitmap
    (copy-bits (pref (wptr *dst*) windowrecord.portbits)
               (pref (wptr *src*) windowrecord.portbits)
               (pref (wptr *dst*) windowrecord.portrect)
               target-rectangle
               :patOr)))
 
;; end of file