grow-icon on a windoid

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

At  1:57 PM 6/30/93 -0500, lynch@ils.nwu.edu wrote:
>Anybody got code to draw the 'official' grow-icon on a windoid?

Here's some code I wrote a while back that simply draws a square for
a grow icon.

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

; windoid-with-grow.lisp
;
; How to put a grow box on a windoid

(in-package :ccl)

(export '(windoid-with-grow))

(defclass windoid-with-grow (windoid) ())

(defmethod window-draw-grow-icon :after ((w windoid-with-grow))
  (multiple-value-bind (tl br) (grow-box-corners w)
    (rlet ((rect :rect :topleft tl :botright br))
      (#_FrameRect rect))))

(defmethod grow-box-corners ((w windoid-with-grow))
  (let* ((br (add-points (view-size w) #@(1 1)))
         (tl (subtract-points br #@(10 10))))
    (values tl br)))

(defmethod invalidate-grow-box ((w windoid-with-grow) &optional erase-p)
  (multiple-value-bind (tl br) (grow-box-corners w)
    (setq br (add-points br #@(1 1)))
    (invalidate-corners w tl br erase-p)))

(defmethod view-click-event-handler :around ((w windoid-with-grow) where)
  (multiple-value-bind (tl br) (grow-box-corners w)
    (if (point<= tl where br)
      (window-grow-event-handler w (add-points (view-position w) where))
      (call-next-method))))

(defmethod window-grow-event-handler ((w windoid-with-grow) where)
  (let* ((size (view-size w))
         (pos (view-position w))
         (wptr (wptr w))
         (content-pos (subtract-points
                       pos
                       (subtract-points
                        (href (pref wptr :windowRecord.contrgn)
                              :region.rgnbbox.topleft)
                        (href (pref wptr :windowRecord.strucrgn)
                              :region.rgnbbox.topleft))))
         (mouse-pos (view-mouse-position nil))
         (diff (subtract-points (add-points pos size) where))
         (min-mouse (subtract-points (add-points pos #@(20 20)) diff))
         (min-mouse-h (point-h min-mouse))
         (min-mouse-v (point-v min-mouse)))
    (flet ((draw-box ()
             (rlet ((rect :rect
                          :topleft content-pos
                          :botright (add-points mouse-pos diff)))
               (#_FrameRect rect))))
      (declare (dynamic-extent #'draw-box))
      (with-macptrs ((port (%get-ptr (%int-to-ptr #$wmgrport))))
        (with-port port
          (rlet ((rect :rect
                       :topleft #@(-32767 -32767)
                       :botright #@(32767 32767)))
            (#_ClipRect rect))
          (with-pen-saved
            (#_PenPat *gray-pattern*)
            (#_PenMode #$PatXor)
            (unwind-protect
              (progn
                (draw-box)
                (loop
                  (unless (#_stilldown) (return))
                  (let ((new-pos (view-mouse-position nil)))
                    (setq new-pos
                          (make-point (max (point-h new-pos) min-mouse-h)
                                      (max (point-v new-pos) min-mouse-v)))
                    (unless (eql mouse-pos new-pos)
                      (draw-box)
                      (setq mouse-pos new-pos)
                      (draw-box)))))
              (draw-box)))))
      (set-view-size w (subtract-points (add-points mouse-pos diff) pos)))))

(defmethod set-view-size ((w windoid-with-grow) h &optional v)
  (declare (ignore h v))
  (invalidate-grow-box w t)
  (prog1
    (call-next-method)
    (invalidate-grow-box w)))

(provide 'windoid-with-grow)