-- Copyright (C) 1982, 1984  by Xerox Corporation. All rights reserved. 
-- RectangleImpl.mesa - last edited by
--  Bruce	20-Dec-82 17:37:23
--  Daniels	 6-Jun-84 14:20:18
--  Karlton	30-Dec-82 14:50:19

DIRECTORY
  BitBlt: TYPE USING [BITBLT, BitBltFlags],
  Environment: TYPE USING [wordsPerPage],
  Inline: TYPE USING [LongMult],
  RecOps: TYPE USING [What],
  SpecialDisplay: TYPE USING [defaultContext, SpecialContext],
  SpecialWindow: TYPE USING [GetPages],
  Window: TYPE USING [Box, EnumerateTree, GetBitmapUnder, Place],
  WindowOps: TYPE USING [
    bbPtr, DIVMOD16, Object, RecList, Rectangle, rootWindow, ScreenBox,
    SpecialTimesWpl];

RectangleImpl: MONITOR
  IMPORTS BitBlt, Inline, SpecialDisplay, SpecialWindow, Window, WindowOps
  EXPORTS RecOps, Window =
  BEGIN

  Handle: TYPE = LONG POINTER TO Object;
  Object: PUBLIC TYPE = WindowOps.Object;

  RecList: TYPE = WindowOps.RecList;

  ErrorCode: TYPE = {ambiguous, nilWindow, notInTree};
  ClientBug: SIGNAL [code: ErrorCode] = CODE;

  -- conversion

  WindowToScreenBox: PUBLIC PROC [wb: Window.Box]
    RETURNS [b: WindowOps.ScreenBox] = {
    b.left ¬ wb.place.x;
    b.right ¬ b.left + wb.dims.w;
    b.top ¬ wb.place.y;
    b.bottom ¬ b.top + wb.dims.h};

  ScreenToWindowBox: PUBLIC PROC [b: WindowOps.ScreenBox]
    RETURNS [wb: Window.Box] = {
    wb.place.x ¬ b.left;
    wb.place.y ¬ b.top;
    wb.dims.w ¬ b.right - b.left;
    wb.dims.h ¬ b.bottom - b.top};

  Convert: PUBLIC PROC [w: Handle] RETURNS [r: RecList] = {
    r ¬ Alloc[];
    r­ ¬ [link: NIL, box: WindowToScreenBox[[w.place, w.box.dims]]]};

  ConvertBox: PUBLIC PROC [w: Handle, box: Window.Box] RETURNS [r: RecList] = {
    box.place.x ¬ w.place.x + box.place.x;
    box.place.y ¬ w.place.y + box.place.y;
    r ¬ Alloc[];
    r­ ¬ [link: NIL, box: WindowToScreenBox[box]]};

  -- operations

  Append: PUBLIC PROC [list1, list2: RecList] RETURNS [list3: RecList] = {
    next: RecList;
    IF list1 = NIL THEN RETURN[list2];
    IF list2 = NIL THEN RETURN[list1];
    list1 ¬ Bite[list: list1, biter: Copy[list2]];
    IF list1 = NIL THEN RETURN[list2];
    FOR r: RecList ¬ list1, next DO
      next ¬ r.link; IF next = NIL THEN {r.link ¬ list2; RETURN[list1]}; ENDLOOP};

  Copy: PUBLIC PROC [old: RecList] RETURNS [new: RecList ¬ NIL] = {
    FOR r: RecList ¬ old, r.link UNTIL r = NIL DO
      copy: RecList = Alloc[];
      copy­ ¬ r­;
      copy.link ¬ new; new ¬ copy;
      ENDLOOP};

  CleanInvalid: PUBLIC PROC [window: Handle] RETURNS [invalid: RecList ¬ NIL] = {
    -- This is where boxesCount logic can be hidden...
    this: RecList;
    FOR this ¬ window.invalid, window.invalid UNTIL this = NIL DO
      window.invalid ¬ this.link;
      this.link ¬ NIL;
      this.src ¬ this.dst ¬ NIL;
      invalid ¬ Append[invalid, this];
      ENDLOOP;
    RETURN[window.invalid ¬ invalid]};
      
  ClipBox: PUBLIC PROC [window: Handle, box: RecList]
    RETURNS [clippedBox: RecList, lastParent: Handle] = {
    next: Handle;
    IF window = NIL THEN {SIGNAL ClientBug[nilWindow]; RETURN[box, NIL]};
    IF ~window.inTree THEN {SIGNAL ClientBug[notInTree]; RETURN[box, NIL]};
    IF window = WindowOps.rootWindow THEN RETURN[box, NIL];
    IF (next ¬ window.parent) = WindowOps.rootWindow THEN RETURN[box, window];
    clippedBox ¬ box;
    FOR lastParent ¬ next, next UNTIL lastParent = NIL DO
      box: RecList = Convert[lastParent];
      temp: RecList = Intersect[box, clippedBox];
      FreeRecList[box];
      FreeRecList[clippedBox];
      clippedBox ¬ temp;
      IF (next ¬ lastParent.parent) = WindowOps.rootWindow THEN RETURN;
      ENDLOOP;
    SIGNAL ClientBug[notInTree]};
  
  Disjoint: PUBLIC PROC [list1, list2: RecList] RETURNS [BOOLEAN] = {
    IF list1 = NIL OR list2 = NIL THEN RETURN[TRUE];
    FOR r1: RecList ¬ list1, r1.link UNTIL r1 = NIL DO
      FOR r2: RecList ¬ list2, r2.link UNTIL r2 = NIL DO
        box: WindowOps.ScreenBox;
        box.left ¬ MAX[r1.box.left, r2.box.left];
        box.top ¬ MAX[r1.box.top, r2.box.top];
        box.right ¬ MIN[r1.box.right, r2.box.right];
        box.bottom ¬ MIN[r1.box.bottom, r2.box.bottom];
        IF box.left < box.right AND box.top < box.bottom THEN RETURN[FALSE];
	ENDLOOP;
      REPEAT FINISHED => RETURN[TRUE]
      ENDLOOP};

  Intersect: PUBLIC PROC [list1, list2: RecList]
    RETURNS [list3: RecList ¬ NIL] = {
    FOR r1: RecList ¬ list1, r1.link UNTIL r1 = NIL DO
      FOR r2: RecList ¬ list2, r2.link UNTIL r2 = NIL DO
        box: WindowOps.ScreenBox;
        box.left ¬ MAX[r1.box.left, r2.box.left];
        box.top ¬ MAX[r1.box.top, r2.box.top];
        box.right ¬ MIN[r1.box.right, r2.box.right];
        box.bottom ¬ MIN[r1.box.bottom, r2.box.bottom];
        IF box.left < box.right AND box.top < box.bottom THEN {
          new: RecList = Alloc[];
          new­ ¬ [
	    box: box, link: list3, src: SetUnder[r1.src, r2.src], 
	    dst: SetUnder[r1.dst, r2.dst]];
          list3 ¬ new};
        ENDLOOP;
      ENDLOOP};

  SetUnder: PROC [w1, w2: Handle] RETURNS [Handle] = INLINE {
    IF w1 = NIL THEN RETURN[w2];
    IF w2 # NIL AND w1 # w2 THEN SIGNAL ClientBug[ambiguous];
    RETURN[w1]};
    	
  Shift: PUBLIC PROC [list: RecList, dx, dy: INTEGER] RETURNS [r: RecList] = {
    -- This used to clip to bitmap bounds.  Should it?
    FOR r: RecList ¬ list, r.link UNTIL r = NIL DO
      r.box.left ¬ r.box.left + dx;
      r.box.top ¬ r.box.top + dy;
      r.box.right ¬ r.box.right + dx;
      r.box.bottom ¬ r.box.bottom + dy;
      ENDLOOP;
    RETURN[list]};
	
  Blt: PUBLIC PROC [list: RecList, dx, dy: INTEGER] = {
    disjointItems: BOOLEAN = dy # 0;
    south: BOOLEAN = dy > 0;
    east: BOOLEAN = dx > 0;
    dir: {nw, ne, se, sw} =
      IF east THEN IF south THEN se ELSE ne ELSE IF south THEN sw ELSE nw;
    flags: BitBlt.BitBltFlags ¬ [
      direction: IF south OR (~disjointItems AND east) THEN backward ELSE forward,
      disjoint: FALSE, disjointItems: disjointItems, gray: FALSE, srcFunc: null,
      dstFunc: null, reserved: 0];
    WHILE list # NIL DO
      prev: RecList ¬ NIL;
      didSomething: BOOLEAN ¬ FALSE;
      next: RecList;
      FOR r: RecList ¬ list, next UNTIL r = NIL DO
        left: INTEGER = r.box.left;
        top: INTEGER = r.box.top;
        bottom: INTEGER = r.box.bottom;
        right: INTEGER = r.box.right;
        next ¬ r.link;
        FOR spoiler: RecList ¬ list, spoiler.link UNTIL spoiler = NIL DO
          IF spoiler = r THEN LOOP;
          SELECT dir FROM
            nw =>
              IF spoiler.box.left < right AND spoiler.box.top < bottom THEN {
                prev ¬ r; EXIT};
            ne =>
              IF spoiler.box.right > left AND spoiler.box.top < bottom THEN {
                prev ¬ r; EXIT};
            sw =>
              IF spoiler.box.left < right AND spoiler.box.bottom > top THEN {
                prev ¬ r; EXIT};
            se =>
              IF spoiler.box.right > left AND spoiler.box.bottom > top THEN {
                prev ¬ r; EXIT};
            ENDCASE;
          REPEAT
            FINISHED => {
              width: INTEGER = right - left;
              height: INTEGER = bottom - top;
	      src, dst: LONG POINTER;
              srcOffset, srcBit, dstOffset, dstBit, srcBpl, dstBpl: INTEGER;
	      
	      Calc: PROC [w: Handle, offset, dy: INTEGER] 
	        RETURNS [LONG POINTER, INTEGER] = INLINE {
		ctx: SpecialDisplay.SpecialContext;
		IF w = NIL THEN ctx ¬ SpecialDisplay.defaultContext­
		ELSE {
		  ctx.wpl ¬ (CARDINAL[w.box.dims.w] + 31)/16;
		  ctx.bpl ¬ ctx.wpl*16;
		  ctx.bmAddress ¬ LOOPHOLE[
		    Window.GetBitmapUnder[w] - w.place.x/16 
		    - Inline.LongMult[ctx.wpl, w.place.y]];
		  ctx.alloc ¬ NIL; ctx.free ¬ NIL};
		IF flags.disjoint OR flags.direction = forward THEN 
		  RETURN[
		    ctx.bmAddress + offset +
		      WindowOps.SpecialTimesWpl[top+dy, @ctx],
		    ctx.bpl];
		RETURN[
		  ctx.bmAddress + offset +
		    WindowOps.SpecialTimesWpl[bottom+dy-1, @ctx],
		  -ctx.bpl]};
		
              [srcOffset, srcBit] ¬ WindowOps.DIVMOD16[CARDINAL[left]];
              [dstOffset, dstBit] ¬ WindowOps.DIVMOD16[CARDINAL[left + dx]];
              flags.disjoint ¬ 
	        ABS[dy] > height OR ABS[dx] > width 
		OR ((r.dst # NIL OR r.src # NIL) AND r.dst # r.src);
	      [src, srcBpl] ¬ Calc[r.src, srcOffset, 0];
	      [dst, dstBpl] ¬ Calc[r.dst, dstOffset, dy];
              WindowOps.bbPtr­ ¬ [
                dst: [word: dst, bit: dstBit], dstBpl: dstBpl, 
                src: [word: src, bit: srcBit], srcDesc: [srcBpl[srcBpl]], 
		flags: flags, height: height, width: width];
              BitBlt.BITBLT[WindowOps.bbPtr];
              didSomething ¬ TRUE;
              IF prev = NIL THEN list ¬ next ELSE prev.link ¬ next;
              Free[r]};
          ENDLOOP;
        REPEAT
          FINISHED => {
            CouldntBlt: SIGNAL = CODE; IF ~didSomething THEN SIGNAL CouldntBlt};
        ENDLOOP;
      ENDLOOP};

  Coalesce: PUBLIC PROC [r: RecList] RETURNS [new: RecList] = {
    changesMade: BOOLEAN ¬ TRUE;
    dummy: RecList; -- sort
    IF r = NIL OR r.link = NIL THEN RETURN[r];
    dummy ¬ Alloc[];
    dummy­ ¬ [box: [0, 0, 0, 0], link: NIL];
    new ¬ dummy;
    -- first, sort by upper left corner
    UNTIL r = NIL DO
      cur: RecList = r;
      candidate: RecList ¬ new;
      r ¬ cur.link;
      FOR this: RecList ¬ new, this.link UNTIL this = NIL DO
	IF cur.box.top >= this.box.top AND cur.box.left >= this.box.left THEN
	  candidate ¬ this;
	ENDLOOP;
      cur.link ¬ candidate.link;
      candidate.link ¬ cur;
      ENDLOOP;
    IF new = dummy THEN {new ¬ dummy.link; Free[dummy]}
    ELSE {BadSort: ERROR = CODE; ERROR BadSort};
    -- ASSERT[rectangles below and to the right of r come after it in the list]
    << A heuristic for merging rectangles: try to merge down first, since the
    biting algorithms produce more breakage in the y-axis. >>
    WHILE changesMade DO
      that, pred: RecList;
      changesMade ¬ FALSE;
      FOR this: RecList ¬ new, this.link UNTIL this = NIL DO {
	-- try to merge down
	FOR pred ¬ this, pred.link UNTIL pred = NIL DO
	  IF (that ¬ pred.link) = NIL THEN EXIT;
	  IF this.box.bottom = that.box.top AND this.box.left = that.box.left
	    AND this.box.right = that.box.right AND this.src = that.src 
	    AND this.dst = that.dst THEN {
	    this.box.bottom ¬ that.box.bottom;
	    GOTO FreeThat};
	  ENDLOOP;
        -- try to merge right
	FOR pred ¬ this, pred.link UNTIL pred = NIL DO
	  IF (that ¬ pred.link) = NIL THEN EXIT;
	  IF this.box.right = that.box.left AND this.box.top = that.box.top
	    AND this.box.bottom = that.box.bottom 
	    AND this.src = that.src AND this.dst = that.dst THEN {
	    this.box.right ¬ that.box.right;
	    GOTO FreeThat};
	  ENDLOOP;
	EXITS 
	  FreeThat => {
	    changesMade ¬ TRUE;
	    pred.link ¬ that.link;
	    Free[that]}};
	ENDLOOP;
      ENDLOOP};

  -- things that bite out rectangles
  
  Bite: PUBLIC PROC [list, biter: RecList] RETURNS [newList: RecList ¬ NIL] = {
    prev: RecList ¬ NIL;
    next: RecList;
    FOR l: RecList ¬ list, next UNTIL l = NIL DO
      lRemaining: BOOLEAN ¬ TRUE;
      boxes: RecList ¬ NIL;
      next ¬ l.link;
      FOR b: RecList ¬ biter, b.link UNTIL b = NIL DO
        thisBox: WindowOps.Rectangle ¬ b­;
	thisBox.link ¬ NIL;
        CheckOldBites[@boxes, @thisBox];
        IF lRemaining AND BiteOut[l, @thisBox, @boxes] THEN {
          IF l = list THEN list ¬ next ELSE prev.link ¬ next;
	  Free[l];
	  lRemaining ¬ FALSE};
        REPEAT FINISHED => IF lRemaining THEN prev ¬ l;
        ENDLOOP;
      newList ¬ SimpleAppend[newList, boxes];
      ENDLOOP;
    FreeRecList[biter];
    RETURN[SimpleAppend[newList, list]]};
  
  BiteOutSiblings: PROC [
    sib, me: Handle, list, under: RecList, what: RecOps.What]
    RETURNS [newList, newUnder: RecList ¬ NIL] = {
    << Constructs a RecList that consists of the sibling boxes, then calls Bite
    to do the work.  If one of the siblings has a BMU, escape to the hard case.
     Easy case doesn't touch under. >>
    sibList: RecList ¬ NIL;
    IF list = NIL THEN RETURN[list, under];
    FOR w: Handle ¬ sib, w.sibling UNTIL w = me DO
      thisSib: RecList;
      IF w.underNow AND what # null THEN {
        FreeRecList[sibList];
        RETURN BiteOutSiblingsTheHardWay[sib, me, list, under, what]};
      -- sibList ¬ SimpleAppend[Convert[w], sibList]...
      thisSib ¬ Convert[w];
      thisSib.link ¬ sibList;
      sibList ¬ thisSib;
      ENDLOOP;
    RETURN[Bite[list, sibList], under]};
    
  BiteOutSiblingsTheHardWay: PROC [
    sib, me: Handle, list, under: RecList, what: RecOps.What]
    RETURNS [newList, newUnder: RecList ¬ NIL] = {
    << Recursively calls itself until it reaches me, then unwinds the call stack.
      The effect of this is that the sibling leading to me is processed in
      reverse order.  The bite-out code is a clone of BiteOut that also
      saves the intersection in newUnder if sib is a BMU.
      Consumes list and under >>
    saveUnder: BOOLEAN;
    biter: WindowOps.ScreenBox;
    AddBox: PROC [left, top, right, bottom: INTEGER, from: RecList] = {
      b: RecList = Alloc[];
      b­ ¬ [
        link: newList, box: [left, top, right, bottom],
	src: from.src, dst: from.dst];
      newList ¬ b};
    AddUnderBox: PROC [left, top, right, bottom: INTEGER, from: RecList] = {
      b: RecList = Alloc[];
      b­ ¬ [
        link: newUnder, box: [left, top, right, bottom],
	src: IF what = src THEN sib ELSE from.src,
	dst: IF what = dst THEN sib ELSE from.dst];
      newUnder ¬ b};
    SELECT TRUE FROM
      sib = me => RETURN[list, under];
      sib = NIL => {
        WrongSiblings: SIGNAL = CODE; SIGNAL WrongSiblings; RETURN[list, under]};
      list = NIL => RETURN[list, under]; -- optimization
      ENDCASE;
    -- call self recursively for list traversal...
    [list, newUnder] ¬ BiteOutSiblingsTheHardWay[
      sib: sib.sibling, me: me, list: list, under: under, what: what];
    -- bite out sib from list, saving bitten pieces on newUnder if saveUnder
    saveUnder ¬ sib.underNow AND what # null;
    biter ¬ WindowToScreenBox[[sib.place, sib.box.dims]];
    FOR r: RecList ¬ list, r.link UNTIL r = NIL DO
      lIn: CARDINAL =
        SELECT TRUE FROM
          biter.left >= r.box.right => DisjointBoxes,
          biter.right <= r.box.left => DisjointBoxes,
          biter.left <= r.box.left => 0,
          ENDCASE => LeftIn;
      rIn: CARDINAL = IF biter.right < r.box.right THEN RightIn ELSE 0;
      tIn: CARDINAL =
        SELECT TRUE FROM
          biter.top >= r.box.bottom => DisjointBoxes,
          biter.bottom <= r.box.top => DisjointBoxes,
          biter.top <= r.box.top => 0,
          ENDCASE => TopIn;
      bIn: CARDINAL = IF biter.bottom < r.box.bottom THEN BottomIn ELSE 0;
      SELECT lIn + rIn + tIn + bIn FROM -- what's obscured?
        0 => -- everything
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, r.box.top, r.box.right, r.box.bottom, r];
	LeftIn => { -- right
	  AddBox[r.box.left, r.box.top, biter.left, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, r.box.top, r.box.right, r.box.bottom, r]};
	BottomIn => { -- top
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, r.box.top, r.box.right, biter.bottom, r]};
	TopIn => { -- bottom
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, biter.top, r.box.right, r.box.bottom, r]};
	RightIn => { -- left
	  AddBox[biter.right, r.box.top, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, r.box.top, biter.right, r.box.bottom, r]};
	LeftIn + RightIn => { -- vertical strip
	  AddBox[r.box.left, r.box.top, biter.left, r.box.bottom, r];
	  AddBox[biter.right, r.box.top, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, r.box.top, biter.right, r.box.bottom, r]};
	TopIn + BottomIn => { -- horizontal strip
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, biter.top, r.box.right, biter.bottom, r]};
	RightIn + BottomIn => { -- top left
	  AddBox[biter.right, r.box.top, r.box.right, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, r.box.top, biter.right, biter.bottom, r]};
	LeftIn + BottomIn => { -- top right
	  AddBox[r.box.left, r.box.top, biter.left, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, r.box.top, r.box.right, biter.bottom, r]};
	RightIn + TopIn => { -- bottom left
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[biter.right, biter.top, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, biter.top, biter.right, r.box.bottom, r]};
	LeftIn + TopIn => { -- bottom right
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[r.box.left, biter.top, biter.left, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, biter.top, r.box.right, r.box.bottom, r]};
	RightIn + BottomIn + TopIn => { -- left edge
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[biter.right, biter.top, r.box.right, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    r.box.left, biter.top, biter.right, biter.bottom, r]};
	LeftIn + BottomIn + TopIn => { -- right edge
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[r.box.left, biter.top, biter.left, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, biter.top, r.box.right, biter.bottom, r]};
	RightIn + LeftIn + TopIn => { -- bottom edge
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[r.box.left, biter.top, biter.left, r.box.bottom, r];
	  AddBox[biter.right, biter.top, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, biter.top, biter.right, r.box.bottom, r]};
	RightIn + LeftIn + BottomIn => { -- top edge
	  AddBox[r.box.left, r.box.top, biter.left, biter.bottom, r];
	  AddBox[biter.right, r.box.top, r.box.right, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, r.box.top, biter.right, biter.bottom, r]};
	RightIn + TopIn + BottomIn + LeftIn => { -- center
	  AddBox[r.box.left, r.box.top, r.box.right, biter.top, r];
	  AddBox[r.box.left, biter.top, biter.left, biter.bottom, r];
	  AddBox[biter.right, biter.top, r.box.right, biter.bottom, r];
	  AddBox[r.box.left, biter.bottom, r.box.right, r.box.bottom, r];
	  IF saveUnder THEN AddUnderBox[
	    biter.left, biter.top, biter.right, biter.bottom, r]};
	ENDCASE => -- disjoint
	  AddBox[r.box.left, r.box.top, r.box.right, r.box.bottom, r];
      ENDLOOP;
    FreeRecList[list]};
  
  Visible: PUBLIC PROC [
    w: Handle, list: RecList, what: RecOps.What, biteChildren: BOOLEAN ¬ FALSE]
    RETURNS [newList: RecList] = {
    abs: RecList ¬ Convert[w];
    underList: RecList ¬ NIL;
    newList ¬ Intersect[list, abs];
    FreeRecList[list];
    IF biteChildren AND w.child # NIL THEN 
      [newList, underList] ¬ BiteOutSiblings[
        sib: w.child, me: NIL, list: newList, under: underList, what: what];
    IF w.parent # NIL THEN {
      [newList, underList] ¬ BiteOutSiblings[
        sib: w.parent.child, me: w, list: newList, under: underList, what: what];
      FOR p: Handle ¬ w.parent, p.parent DO
        temp: RecList;
        -- Trim box to parent
        Free[abs];
	abs ¬ Convert[p];
        temp ¬ Intersect[abs, newList];
	FreeRecList[newList];
	newList ¬ temp;
	temp ¬ Intersect[abs, underList];
	FreeRecList[underList];
	underList ¬ temp;
	-- Bite out uncles
	IF p.parent = NIL THEN EXIT;
	[newList, underList] ¬ BiteOutSiblings[
	  sib: p.parent.child, me: p, list: newList, under: underList,
	  what: what];
	ENDLOOP};
    Free[abs];
    RETURN[SimpleAppend[underList, newList]]};
    
  CheckOldBites: PROC [boxes: POINTER TO RecList, biter: RecList] = {
    << we have to check the biter against all the rectangles created by the 
    previous bites.  They are on the boxes list. >>
    prev: RecList ¬ NIL;
    next: RecList;
    FOR r: RecList ¬ boxes­, next UNTIL r = NIL DO
      next ¬ r.link;
      IF BiteOut[r, biter, boxes] THEN {
        IF prev = NIL THEN boxes­ ¬ next ELSE prev.link ¬ next; Free[r]}
      ELSE prev ¬ r;
      ENDLOOP};

  SimpleAppend: PUBLIC PROC [list1, list2: RecList] RETURNS [list3: RecList] = {
    next: RecList;
    IF list1 = NIL THEN RETURN[list2];
    IF list2 = NIL THEN RETURN[list1];
    FOR r: RecList ¬ list1, next DO
      next ¬ r.link; IF next = NIL THEN {r.link ¬ list2; RETURN[list1]}; ENDLOOP};
  
  LeftIn: CARDINAL = 1;
  RightIn: CARDINAL = 2;
  TopIn: CARDINAL = 4;
  BottomIn: CARDINAL = 8;
  DisjointBoxes: CARDINAL = 100B;

  BiteOut: PROC [list: RecList, clip: RecList, boxes: POINTER TO RecList]
    RETURNS [delete: BOOLEAN] = {
    << Bites out the clip box from a single rectangle (list).  Any new boxes are 
       prepeneded to boxes­.  If delete is true, the rectangle
       passed in has been completely clipped.  BiteOut changes list.box but does
       not touch the link. >>
    NewRect: PROC RETURNS [r: RecList] = {
      r ¬ Alloc[]; r­ ¬ list­; r.link ¬ boxes­; boxes­ ¬ r};
    lIn: CARDINAL =
      SELECT TRUE FROM
        clip.box.left >= list.box.right => DisjointBoxes,
        clip.box.right <= list.box.left => DisjointBoxes,
        clip.box.left <= list.box.left => 0,
        ENDCASE => LeftIn;
    rIn: CARDINAL = IF clip.box.right < list.box.right THEN RightIn ELSE 0;
    tIn: CARDINAL =
      SELECT TRUE FROM
        clip.box.top >= list.box.bottom => DisjointBoxes,
        clip.box.bottom <= list.box.top => DisjointBoxes,
        clip.box.top <= list.box.top => 0,
        ENDCASE => TopIn;
    bIn: CARDINAL = IF clip.box.bottom < list.box.bottom THEN BottomIn ELSE 0;
    SELECT lIn + rIn + tIn + bIn FROM
      0 => RETURN[TRUE];  -- all of w was in clip 
      LeftIn => list.box.right ¬ clip.box.left;  -- clipped on right
      BottomIn => list.box.top ¬ clip.box.bottom;  -- clipped on top
      TopIn => list.box.bottom ¬ clip.box.top;  -- clipped on bottom
      RightIn => list.box.left ¬ clip.box.right;  -- clipped on left
      LeftIn + RightIn => {  -- vertical strip from middle
        n: RecList = NewRect[]; 
	list.box.right ¬ clip.box.left;
        n.box.left ¬ clip.box.right};
      TopIn + BottomIn => {  -- horizontal strip from middle
        n: RecList = NewRect[]; 
	list.box.bottom ¬ clip.box.top; 
	n.box.top ¬ clip.box.bottom};
      RightIn + BottomIn => {  -- upper left-hand corner
        n: RecList = NewRect[];
        list.box.top ¬ clip.box.bottom;
        n.box.bottom ¬ clip.box.bottom;
        n.box.left ¬ clip.box.right};
      LeftIn + BottomIn => {  -- upper right-hand corner
        n: RecList = NewRect[];
        list.box.top ¬ clip.box.bottom;
        n.box.bottom ¬ clip.box.bottom;
        n.box.right ¬ clip.box.left};
      RightIn + TopIn => {  -- lower left-hand corner
        n: RecList = NewRect[];
        list.box.bottom ¬ clip.box.top;
        n.box.top ¬ clip.box.top;
        n.box.left ¬ clip.box.right};
      LeftIn + TopIn => {  -- lower right-hand corner
        n: RecList = NewRect[];
        list.box.bottom ¬ clip.box.top;
        n.box.top ¬ clip.box.top;
        n.box.right ¬ clip.box.left};
      RightIn + BottomIn + TopIn => {  -- left edge
        n: RecList = NewRect[];
        m: RecList = NewRect[];
        list.box.left ¬ clip.box.right;
        n.box.bottom ¬ clip.box.top;
        n.box.right ¬ clip.box.right;
        m.box.top ¬ clip.box.bottom;
        m.box.right ¬ clip.box.right};
      LeftIn + BottomIn + TopIn => {  -- right edge
        n: RecList = NewRect[];
        m: RecList = NewRect[];
        list.box.right ¬ clip.box.left;
        n.box.bottom ¬ clip.box.top;
        n.box.left ¬ clip.box.left;
        m.box.top ¬ clip.box.bottom;
        m.box.left ¬ clip.box.left};
      RightIn + LeftIn + TopIn => {  -- bottom edge
        n: RecList = NewRect[];
        m: RecList = NewRect[];
        list.box.bottom ¬ clip.box.top;
        n.box.right ¬ clip.box.left;
        n.box.top ¬ clip.box.top;
        m.box.left ¬ clip.box.right;
        m.box.top ¬ clip.box.top};
      RightIn + LeftIn + BottomIn => {  -- top edge
        n: RecList = NewRect[];
        m: RecList = NewRect[];
        list.box.top ¬ clip.box.bottom;
        n.box.right ¬ clip.box.left;
        n.box.bottom ¬ clip.box.bottom;
        m.box.left ¬ clip.box.right;
        m.box.bottom ¬ clip.box.bottom};
      RightIn + TopIn + BottomIn + LeftIn => {  -- center
        n: RecList = NewRect[];
        m: RecList = NewRect[];
        l: RecList = NewRect[];
        list.box.bottom ¬ clip.box.top;
        n.box.top ¬ clip.box.bottom;
        m.box.top ¬ clip.box.top;
        m.box.bottom ¬ clip.box.bottom;
        m.box.right ¬ clip.box.left;
        l.box.top ¬ clip.box.top;
        l.box.bottom ¬ clip.box.bottom;
        l.box.left ¬ clip.box.right};
      ENDCASE;  -- left w alone
    RETURN[FALSE]};

  -- allocator

  FreeHandle: TYPE = LONG POINTER TO FreeObject;
  FreeObject: TYPE = RECORD [link: FreeHandle];

  Header: TYPE = LONG POINTER TO HeaderObject;
  HeaderObject: TYPE = RECORD [
    link: Header, cnt: CARDINAL, list: ARRAY [0..0) OF WindowOps.Rectangle ¬ NULL];

  Max: CARDINAL = WordsAvailable/WindowOps.Rectangle.SIZE;
  TileSize: CARDINAL = 4;
  WordsAvailable: CARDINAL =
    Environment.wordsPerPage*TileSize - HeaderObject.SIZE;

  allocHead: Header ¬ SpecialWindow.GetPages[TileSize];
  freeList: FreeHandle ¬ NIL;

  Alloc: PUBLIC ENTRY PROC RETURNS [lp: RecList] = {
    ENABLE UNWIND => NULL;
    IF freeList # NIL THEN {
      lp ¬ LOOPHOLE[freeList]; freeList ¬ freeList.link; RETURN};
    IF allocHead.cnt = Max THEN {
      new: Header ¬ SpecialWindow.GetPages[TileSize];
      new­ ¬ [link: allocHead, cnt: 0];
      allocHead ¬ new};
    lp ¬ @allocHead.list[allocHead.cnt];
    allocHead.cnt ¬ allocHead.cnt + 1;
    RETURN[lp]};

  Free: PUBLIC ENTRY PROC [lp: RecList] = {
    ENABLE UNWIND => NULL;
    LOOPHOLE[lp, FreeHandle].link ¬ freeList;
    freeList ¬ LOOPHOLE[lp]};

  FreeRecList: PUBLIC ENTRY PROC [list: RecList] = {
    ENABLE UNWIND => NULL;
    next: RecList;
    FOR nil: RecList ¬ list, next UNTIL nil = NIL DO
      next ¬ nil.link;
      LOOPHOLE[nil, FreeHandle].link ¬ freeList;
      freeList ¬ LOOPHOLE[nil];
      ENDLOOP};

  debug: BOOLEAN = FALSE;

  CheckForLeaks: PUBLIC ENTRY PROC [useTree: BOOLEAN, cache: RecList] = {
    ENABLE UNWIND => NULL;
    Leak: SIGNAL = CODE;
    IF debug THEN {
      allocated, returned, busy, cached: CARDINAL ¬ 0;
      FOR h: Header ¬ allocHead, h.link UNTIL h = NIL DO
        allocated ¬ allocated + h.cnt; ENDLOOP;
      FOR f: FreeHandle ¬ freeList, f.link UNTIL f = NIL DO
        returned ¬ returned + 1; ENDLOOP;
      FOR r: RecList ¬ cache, r.link UNTIL r = NIL DO cached ¬ cached + 1; ENDLOOP;
      IF useTree THEN {
        CountBusy: PROC [w: Handle] = {
          FOR r: RecList ¬ w.invalid, r.link UNTIL r = NIL DO
            busy ¬ busy + 1; ENDLOOP;
          FOR r: RecList ¬ w.badPhosphor, r.link UNTIL r = NIL DO
            busy ¬ busy + 1; ENDLOOP};
        Window.EnumerateTree[WindowOps.rootWindow, CountBusy]};
      IF allocated # busy + returned + cached THEN SIGNAL Leak;
      useTree ¬ FALSE -- for Ed -- }};

  allocHead­ ¬ [link: NIL, cnt: 0];

  END.