bug w/ clip regions & views in 1.3.2

[Jeremy Jones <jaj>]

      Date: Wed, 15 Aug 90 16:41:21 -0400

      I am finally converting all our code from 1.2.1 to 1.3.2, and I have
      run into a problem.  CLIP-RECT and SET-CLIP-REGION do not seem to
      work.  Or, more specifically, they do change the window's clip region,
      but the next call to FOCUS-VIEW seems to restore the old value.  Is
      this a known bug?  Do you have a fix? 


The problem is that clip regions were co-opted by the view system in
1.3.

Here is some code that fixes the problem by defining a new class of
views that keep their own clip-regions and makes sure that all drawing
occurs in the intersection of the view's internal clip region and
whatever region the is set by CLIP-RECT or SET-CLIP-REGION.  The code
was hacked up quickly and has only been tested for simple cases.
Also, there is a storage leak: the regions never get disposed.  It
should be enough to get started though.

(defobject *view-with-clip* *view*)

(proclaim '(object-variable (*view-with-clip* my-clip-region)))

(defobfun (exist *view-with-clip*) (init-list)
  ;;make a new region initialized to the maximum size
  (let ((rgn (_NewRgn :ptr)))
    (_SetRecRgn :ptr rgn :word 0 :word 0 :word 32767 :word 32767)
    (have 'my-clip-region rgn))
  (usual-exist init-list))

;;This function gets called anytime the view's clip region need changing
;;Do the usual thing then intersect it with my clip region.
(defobfun (ccl::adjust-view-region *view-with-clip*) (rgn container)
  (ccl::usual-adjust-view-region rgn container)
  (_SectRgn :ptr rgn :ptr my-clip-region :ptr rgn))

;;The following shadow functions from quickdraw.lisp

(defobfun (clip-region *view-with-clip*) (&optional (save-region (_NewRgn :ptr)))
  (_CopyRgn :ptr my-clip-region :ptr save-region)
  save-region)

(defobfun (set-clip-region *view-with-clip*) (new-region)
  (_CopyRgn :ptr new-region :ptr my-clip-region)
  (ccl::adjust-view-region ccl::view-clip-region (view-container))
  new-region)

(defobfun (clip-rect *view-with-clip*) (left &optional top right bot)
  (ccl::with-rectangle-arg (r left top right bot)
    (_RectRgn :ptr my-clip-region :ptr r)
    (ccl::adjust-view-region ccl::view-clip-region (view-container)))
  nil)