-- Copyright (C) 1982, 1984  by Xerox Corporation. All rights reserved. 
-- WindowImplA.mesa - last edited by
-- Daniels	16-Mar-84 14:18:04
-- Bruce	20-Dec-82 15:35:50

DIRECTORY
  BitBlt: TYPE USING [BitAddress, BITBLT],
  Display: TYPE USING [boxFlags, replaceFlags],
  Inline: TYPE USING [DBITSHIFT, LongMult],
  RecOps: TYPE USING [
    Bite, Blt, CheckForLeaks, CleanInvalid, Coalesce, Convert, ConvertBox,
    Copy, Disjoint, Free, FreeRecList, Intersect, RecList, ScreenToWindowBox,
    Shift, SimpleAppend, Visible],
  SpecialDisplay USING [defaultContext, Special, SpecialContext],
  Window: TYPE USING [Box, Clarity, ErrorCode, GetBitmapUnder, Gravity, Place],
  WindowOps: TYPE USING [
    bbPtr, Bounds, DIVMOD16, GetContext, GetBpl, Handle, lock, nullGray,
    Object, rootWindow, ScreenBox, SpecialTimesWpl];

WindowImplA: MONITOR LOCKS WindowOps.lock
  IMPORTS BitBlt, Inline, RecOps, SpecialDisplay, Window, WindowOps
  EXPORTS Display, Window, WindowOps =
  
  BEGIN

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

  Error: PUBLIC ERROR [code: Window.ErrorCode] = CODE;

  EnumerateInvalidBoxes: PUBLIC PROC [
    window: Handle, proc: PROC [Handle, Window.Box]] = {
    invalidList: RecOps.RecList;
    CopyInvalidBoxes: ENTRY PROC RETURNS [RecOps.RecList] = {
      ENABLE UNWIND => NULL;
      RETURN RecOps.Copy[window.badPhosphor]};
    IF ~window.inTree THEN RETURN;
    invalidList ¬ CopyInvalidBoxes[];
    FOR r: RecOps.RecList ¬ invalidList, r.link UNTIL r = NIL DO
      box: Window.Box ¬ RecOps.ScreenToWindowBox[r.box];
      box.place.x ¬ box.place.x - window.place.x;
      box.place.y ¬ box.place.y - window.place.y;
      proc[window, box];
      ENDLOOP;
    RecOps.FreeRecList[invalidList]};

  EnumerateTree: PUBLIC PROC [root: Handle, proc: PROC [window: Handle]] = {
    proc[root];
    FOR child: Handle ¬ root.child, child.sibling UNTIL child = NIL DO
      EnumerateTree[child, proc] ENDLOOP};

  FreeBadPhosphorList: PUBLIC ENTRY PROC [window: Handle] = {
    ENABLE UNWIND => NULL;
    IF ~window.inTree THEN RETURN;
    RecOps.FreeRecList[window.badPhosphor];
    window.badPhosphor ¬ NIL};

  InvalidateBox: PUBLIC ENTRY PROC [
    window: Handle, box: Window.Box, clarity: Window.Clarity] = {
    ENABLE UNWIND => NULL;
    -- clarity ignored: any whitening is done @ Validate time
    InvalidateList[window, RecOps.ConvertBox[window, box]]};
  
  InvalidateList: INTERNAL PROC [window: Handle, list: RecOps.RecList] = {
    -- Consumes list.
    IF list = NIL THEN RETURN;
    IF ~window.inTree THEN {RecOps.FreeRecList[list]; RETURN};
    <<FOR r: RecOps.RecList ¬ list, r.link UNTIL r = NIL DO
      r.src ¬ r.dst ¬ NIL ENDLOOP;>>
    window.invalid ¬ RecOps.SimpleAppend[window.invalid, list]};

  InsertIntoTree: PUBLIC PROC [window: Handle] = {
    IF window.parent.inTree AND window.underNow THEN 
      ValidateTree[WindowOps.rootWindow];
    InsertIntoTreeLocked[window]};

  InsertIntoTreeLocked: ENTRY PROC [window: Handle] = {
    ENABLE UNWIND => NULL;
    invalidList: RecOps.RecList;
    whiten: BOOLEAN = window.child # NIL OR window.clearingRequired;
    MarkWindowInTree: PROC [window: Handle] = {
      window.place.x ¬ window.parent.place.x + window.box.place.x;
      window.place.y ¬ window.parent.place.y + window.box.place.y;
      window.inTree ¬ TRUE};
    IF window.sibling = window.parent.child THEN window.parent.child ¬ window
    ELSE
      FOR ww: Handle ¬ window.parent.child, ww.sibling UNTIL ww = NIL DO
        IF ww.sibling = window.sibling THEN {ww.sibling ¬ window; EXIT};
        REPEAT FINISHED => ERROR Error[noSuchSibling];
        ENDLOOP;
    IF ~window.parent.inTree THEN RETURN;
    ResetCache[];
    EnumerateTree[window, MarkWindowInTree];
    IF window.underNow THEN {
      ctx: SpecialDisplay.Special = SpecialDisplay.defaultContext;
      offset, bit: INTEGER;
      AssertUnobscured[window, illegalBitmap];
      [offset, bit] ¬ WindowOps.DIVMOD16[CARDINAL[window.place.x]];
      WindowOps.bbPtr­ ¬ [
        dst: [word: Window.GetBitmapUnder[window], bit: bit], 
	dstBpl: WindowOps.GetBpl[window], flags: Display.replaceFlags, 
	src: [word: 
	  ctx.bmAddress + WindowOps.SpecialTimesWpl[window.place.y, ctx] 
	  + offset, bit: bit], 
	srcDesc: [srcBpl[ctx.bpl]], width: window.box.dims.w, 
	height: window.box.dims.h];
      BitBlt.BITBLT[WindowOps.bbPtr]};
    invalidList ¬ RecOps.Visible[window, RecOps.Convert[window], dst];
    IF invalidList # NIL THEN {
      IF whiten THEN WhitenRecList[invalidList];
      BadPhosphorToInvalid[window.parent];
      InvalidateTree[window, window.child, invalidList]}};

  RemoveFromTree: PUBLIC ENTRY PROC [window: Handle] = {
    ENABLE UNWIND => NULL;
    MarkWindowNotInTree: PROC [window: Handle] = {
      window.inTree ¬ FALSE;
      IF window.invalid # NIL THEN {
        RecOps.FreeRecList[window.invalid]; window.invalid ¬ NIL};
      IF window.badPhosphor # NIL THEN {
        RecOps.FreeRecList[window.badPhosphor]; window.badPhosphor ¬ NIL}};
    justPlaying: BOOLEAN = ~window.inTree;
    parent: Handle = window.parent;
    sibling: Handle = window.sibling;
    box: Window.Box = window.box;
    invalidList: RecOps.RecList;
    ww: Handle;
    IF justPlaying THEN invalidList ¬ NIL
    ELSE {
      ResetCache[];
      invalidList ¬ RecOps.Visible[window, RecOps.Convert[window], dst, FALSE];
      IF invalidList # NIL AND ~window.underNow THEN WhitenRecList[invalidList]};
    EnumerateTree[window, MarkWindowNotInTree];
    SELECT TRUE FROM
      window.parent.child = window => window.parent.child ¬ window.sibling;
      window.parent.child = NIL => ERROR Error[windowNotChildOfParent];
      ENDCASE =>
        FOR ww ¬ window.parent.child, ww.sibling UNTIL ww.sibling = NIL DO
          IF ww.sibling = window THEN {ww.sibling ¬ window.sibling; EXIT};
          REPEAT FINISHED => ERROR Error[windowNotChildOfParent];
          ENDLOOP;
    IF window.underNow THEN {
      -- A clone of Display.Bitmap...
      OPEN WindowOps;
      abs: ScreenBox = Bounds[window];
      src: BitBlt.BitAddress = [
        word: Window.GetBitmapUnder[window],
	bit: CARDINAL[window.place.x] MOD 16];
      srcBpl: INTEGER = GetBpl[window];
      absOffset, absBit: INTEGER;
      [absOffset, absBit] ¬ WindowOps.DIVMOD16[CARDINAL[abs.left]];
      FOR r: RecOps.RecList ¬ invalidList, r.link UNTIL r = NIL DO
	clipLeft: INTEGER = r.box.left - abs.left;
	clipTop: INTEGER = r.box.top - abs.top;
	clipRight: INTEGER = abs.right - r.box.right;
	clipBottom: INTEGER = abs.bottom - r.box.bottom;
	ctx: SpecialDisplay.Special = GetContext[
	  r, SpecialDisplay.defaultContext];
	bbPtr­ ¬ [
	  dst: [word: ctx.bmAddress + absOffset + SpecialTimesWpl[
	    abs.top, ctx], bit: absBit], src: src, srcDesc: [srcBpl[srcBpl]],
	  dstBpl: ctx.bpl, flags: Display.replaceFlags,
	  height: window.box.dims.h, width: window.box.dims.w];
	IF clipTop > 0 THEN {
	  bbPtr.src.word ¬ bbPtr.src.word +
	    Inline.DBITSHIFT[Inline.LongMult[clipTop, srcBpl], -4];
	  bbPtr.height ¬ bbPtr.height - clipTop;
	  bbPtr.dst.word ¬ bbPtr.dst.word + SpecialTimesWpl[clipTop, ctx]};
	IF clipBottom > 0 THEN bbPtr.height ¬ bbPtr.height - clipBottom;
	IF clipRight > 0 THEN bbPtr.width ¬ bbPtr.width - clipRight;
        IF clipLeft > 0 THEN {
          wordOffset, bitOffset, bit: INTEGER;
          [wordOffset, bitOffset] ¬ WindowOps.DIVMOD16[CARDINAL[clipLeft]];
          bbPtr.src.word ¬ bbPtr.src.word + wordOffset;
          bbPtr.dst.word ¬ bbPtr.dst.word + wordOffset;
          [wordOffset, bit] ¬ WindowOps.DIVMOD16[
	    CARDINAL[bbPtr.src.bit + bitOffset]];
          bbPtr.src ¬ [word: bbPtr.src.word + wordOffset, bit: bit];
          [wordOffset, bit] ¬ WindowOps.DIVMOD16[
	    CARDINAL[bbPtr.dst.bit + bitOffset]];
          bbPtr.dst ¬ [word: bbPtr.dst.word + wordOffset, bit: bit];
          bbPtr.width ¬ bbPtr.width - clipLeft};
	IF INTEGER[bbPtr.width] <= 0 OR INTEGER[bbPtr.height] <= 0 THEN LOOP;
	BitBlt.BITBLT[bbPtr];
	ENDLOOP;
      TakeMyNameOffBadPhosphors[window, sibling];
      RecOps.FreeRecList[invalidList]}
    ELSE InvalidateTree[parent, sibling, invalidList]};

  TakeMyNameOffBadPhosphors: INTERNAL PROC [bmu, sib: Handle] = {
    -- trim bad phosphor lists that used to point to bmu
    CheckBadPhosphor: INTERNAL PROC [window: Handle] = {
      newBad, invalid: RecOps.RecList ¬ NIL;
      oldBad, next: RecOps.RecList ¬ TRASH;
      IF window.badPhosphor = NIL THEN RETURN;
      next ¬ window.badPhosphor;
      UNTIL (oldBad ¬ next) = NIL DO
        next ¬ oldBad.link;
	IF oldBad.dst = bmu THEN {
	  oldBad.dst ¬ NIL; oldBad.link ¬ invalid; invalid ¬ oldBad}
	ELSE {oldBad.link ¬ newBad; newBad ¬ oldBad};
        ENDLOOP;
      window.badPhosphor ¬ newBad;
      InvalidateList[window, invalid]};
    FOR w: Handle ¬ sib, w.sibling UNTIL w = NIL DO
      EnumerateTree[w, CheckBadPhosphor] ENDLOOP};
  
  BadPhosphorToInvalid: INTERNAL PROC [sib: Handle] = {
    BPTI: INTERNAL PROC [w: Handle] = {
      IF w.badPhosphor # NIL THEN {
        InvalidateList[w, w.badPhosphor]; w.badPhosphor ¬ NIL}};
    FOR w: Handle ¬ sib, w.sibling UNTIL w = NIL DO
      EnumerateTree[w, BPTI] ENDLOOP};
    
  Shift: PUBLIC ENTRY PROC [
    window: Handle, box: Window.Box, newPlace: Window.Place] = {
    ENABLE UNWIND => NULL;
    << We need to blt from the visible part of what was visible to the
       visible part of where it goes.  Boxes to blt by dx, dy are:  
       Unshift of VP(Shift of VP(old)).  
       The invalid list becomes the boxes we were unable to paint at the 
       destination place; it is: BiteOut Shift of VP(oldBox) from VP(newBox) >>
    IF window.inTree THEN {
      dx: INTEGER = newPlace.x - box.place.x;
      dy: INTEGER = newPlace.y - box.place.y;
      oldBox: RecOps.RecList = RecOps.ConvertBox[window, box];
      vpOldShifted: RecOps.RecList = RecOps.Shift[
        RecOps.Bite[
          list: RecOps.Visible[window, RecOps.Copy[oldBox], src],
	  biter: RecOps.Copy[RecOps.CleanInvalid[window]]],
	dx, dy];
      list: RecOps.RecList = RecOps.Shift[
        RecOps.Visible[window, RecOps.Copy[vpOldShifted], dst], -dx, -dy];
      vpNew: RecOps.RecList = RecOps.Visible[
        window, RecOps.Shift[oldBox, dx, dy], dst];
      invalid: RecOps.RecList = RecOps.Bite[list: vpNew, biter: vpOldShifted];
      RecOps.Blt[list, dx, dy];
      IF invalid # NIL THEN InvalidateList[window, invalid]}};

  Slide: PUBLIC PROC [window: Handle, newPlace: Window.Place] = {
    SlideAndSizeAndStack[
      window, [newPlace, window.box.dims], window.sibling, window.parent, nw]};

  Stack: PUBLIC PROC [window: Handle, newSibling, newParent: Handle] = {
    SlideAndSizeAndStack[window, window.box, newSibling, newParent, nw]};

  SlideAndStack: PUBLIC PROCEDURE [
    window: Handle, newPlace: Window.Place, newSibling: Handle,
    newParent: Handle] = {
    SlideAndSizeAndStack[
      window: window, newBox: [newPlace, window.box.dims], newSibling: newSibling,
      newParent: newParent, gravity: nil]};

  SlideAndSize: PUBLIC PROCEDURE [
    window: Handle, newBox: Window.Box, gravity: Window.Gravity] = {
    SlideAndSizeAndStack[window, newBox, window.sibling, window.parent, gravity]};

  SlideAndSizeAndStack: PUBLIC ENTRY PROC [
    window: Handle, newBox: Window.Box, newSibling: Handle, newParent: Handle,
    gravity: Window.Gravity] = {
    ENABLE UNWIND => NULL;
    << Boxes of interest are (shifts are move + scrolling):
         ValidBoxes ¬ VP(newBox) Intersect Shift of VP(old)
         BoxesToBlt ¬ Unshift of ValidBoxes
         invalid ¬ Bite ValidBoxes from (VP(newBox) union VP(old))
       Note that VP(newBox) can't be taken until the stack is done. >>
    MoveChildren: INTERNAL PROC [w: Handle] = {
      IF w # window THEN ShiftWindow[w, shiftX, shiftY]};
    dx: INTEGER ¬ newBox.place.x - window.box.place.x;
    dy: INTEGER ¬ newBox.place.y - window.box.place.y;
    purePromotion: BOOLEAN ¬ dx = 0 AND dy = 0 AND newBox = window.box;
    demotion: BOOLEAN ¬ TRUE;
    oldParent, oldSibling: Handle;
    shiftX, shiftY: INTEGER;
    vpNew, vpOld, validBoxes, boxesToBlt, invalid, temp, oldBox: RecOps.RecList;
    IF window.underNow AND window.box.dims # newBox.dims THEN
      ERROR Error[sizingWithBitmapUnder];
    IF newParent = NIL THEN newParent ¬ window.parent;
    IF newBox = window.box AND newSibling = window.sibling
      AND newParent = window.parent THEN RETURN;
    IF ~window.inTree THEN {
      window.box ¬ newBox; StackInternal[window, newSibling, newParent]; RETURN};
    oldParent ¬ window.parent;
    oldSibling ¬ window.sibling;
    dx ¬ dx + newParent.place.x - oldParent.place.x;
    dy ¬ dy + newParent.place.y - oldParent.place.y;
    IF newParent # oldParent THEN {purePromotion ¬ FALSE; demotion ¬ TRUE}
    ELSE FOR sib: Handle ¬ window.parent.child, sib.sibling DO
      IF sib = newSibling THEN {demotion ¬ FALSE; EXIT};
      IF sib = window.sibling THEN {purePromotion ¬ FALSE; EXIT};
      ENDLOOP;
    BEGIN
    scrollX, scrollY: INTEGER;
    SELECT gravity FROM
      nw, xxx => scrollX ¬ scrollY ¬ 0;
      n => {
	scrollX ¬ CARDINAL[newBox.dims.w]/2 - CARDINAL[window.box.dims.w]/2;
	scrollY ¬ 0};
      ne => {scrollX ¬ newBox.dims.w - window.box.dims.w; scrollY ¬ 0};
      e => {
	scrollX ¬ newBox.dims.w - window.box.dims.w;
	scrollY ¬ CARDINAL[newBox.dims.h]/2 - CARDINAL[window.box.dims.h]/2};
      se => {
	scrollX ¬ newBox.dims.w - window.box.dims.w;
	scrollY ¬ newBox.dims.h - window.box.dims.h};
      s => {
	scrollX ¬ CARDINAL[newBox.dims.w]/2 - CARDINAL[window.box.dims.w]/2;
	scrollY ¬ newBox.dims.h - window.box.dims.h};
      sw => {
	scrollX ¬ 0;
	scrollY ¬ newBox.dims.h - window.box.dims.h};
      w => {
	scrollX ¬ 0;
	scrollY ¬ CARDINAL[newBox.dims.h]/2 - CARDINAL[window.box.dims.h]/2};
      c => {
	scrollX ¬ CARDINAL[newBox.dims.w]/2 - CARDINAL[window.box.dims.w]/2;
	scrollY ¬ CARDINAL[newBox.dims.h]/2 - CARDINAL[window.box.dims.h]/2};
      nil => {scrollX ¬ -dx; scrollY ¬ -dy};
      ENDCASE;
    FOR child: Handle ¬ window.child, child.sibling UNTIL child = NIL DO
      child.box.place.x ¬ child.box.place.x + scrollX;
      child.box.place.y ¬ child.box.place.y + scrollY;
      ENDLOOP;
    shiftX ¬ dx + scrollX;
    shiftY ¬ dy + scrollY;
    END;
    oldBox ¬ RecOps.Convert[window];
    vpOld ¬ RecOps.Visible[window, RecOps.Convert[window], src];
    ResetCache[];
    window.box ¬ newBox;
    StackInternal[window, newSibling, newParent];
    window.place.x ¬ window.place.x + dx;
    window.place.y ¬ window.place.y + dy;
    window.invalid ¬ RecOps.Shift[window.invalid, shiftX, shiftY];
    window.badPhosphor ¬ RecOps.Shift[window.badPhosphor, shiftX, shiftY];
    EnumerateTree[window, MoveChildren];
    vpNew ¬ RecOps.Visible[window, RecOps.Convert[window], dst];
    temp ¬ RecOps.Shift[vpOld, shiftX, shiftY];
    validBoxes ¬ IF gravity = xxx THEN NIL ELSE RecOps.Intersect[vpNew, temp];
    RecOps.FreeRecList[temp];
    boxesToBlt ¬
      IF shiftX = 0 AND shiftY = 0 THEN NIL
      ELSE RecOps.Shift[RecOps.Copy[validBoxes], -shiftX, -shiftY];
    invalid ¬ RecOps.Bite[list: vpNew, biter: validBoxes];
    RecOps.Blt[boxesToBlt, shiftX, shiftY];
    BadPhosphorToInvalid[window.sibling];
    IF window.underNow THEN TakeMyNameOffBadPhosphors[window, oldSibling];
    InvalidateTree[window, window.child, invalid];
    IF NOT purePromotion THEN {
      InvalidateTree[
        window: oldParent, dirtyChild: IF demotion THEN oldSibling ELSE window,
        invalid: oldBox, butNot: window];
      BadPhosphorToInvalid[window.child]}
    ELSE RecOps.Free[oldBox]};

  ShiftWindow: INTERNAL PROC [w: Handle, dx, dy: INTEGER] = INLINE {
    w.place.x ¬ w.place.x + dx; 
    w.place.y ¬ w.place.y + dy;
    w.invalid ¬ RecOps.Shift[w.invalid, dx, dy];
    w.badPhosphor ¬ RecOps.Shift[w.badPhosphor, dx, dy]};
    
  ValidateTree: PUBLIC PROC [window: Handle] = {
    EnumerateTree[window, Validate]; 
    IF window = WindowOps.rootWindow THEN RecOps.CheckForLeaks[FALSE, cache.r]};

  Validate: PUBLIC PROC [window: Handle] = {
    IF ~window.inTree OR ~ShouldDisplay[window] THEN RETURN;
    DO
      SetUpBadPhosphorList[window];
      IF window.badPhosphor = NIL THEN EXIT;
      << Three things can happen to the window while the following procedure is 
         running.  They are:
           nothing  (the common case).
           more of the window is obscured.  
             In this case the badPhosphor list is trimmed when that happens. 
           more of the window is exposed or marked invalid by the client
             In this case the badPhosphor list remains unchanged, but boxes
             are added to the invalid list.  They get displayed the next
             time around this loop. 
         If the client looks at the reclist through EnumerateInvalidBoxes, it 
         may become "stale" in these uncommon cases; i.e., it will not 
         reflect additional trimming of the badPhosphor list as the result of an
         asynchronous action.  However, this is not "dangerous" in that all the 
         painting routines clip to the badPhosphor list. >>
      IF window.display # NIL THEN window.display[window];
      ENDLOOP;
    DoneDisplay[window];
    RETURN};

  DoneDisplay: ENTRY PROC [window: Handle] = {window.beingDisplayed ¬ FALSE};

  SetUpBadPhosphorList: ENTRY PROC [window: Handle] = {
    ENABLE UNWIND => NULL;
    RecOps.FreeRecList[window.badPhosphor];
    window.badPhosphor ¬ NIL;
    window.useBadPhosphor ¬ TRUE;
    IF window.invalid # NIL THEN {
      vp: RecOps.RecList = RecOps.Visible[
        window, RecOps.Convert[window], dst, TRUE];
      window.badPhosphor ¬ RecOps.Coalesce[
        RecOps.Intersect[RecOps.CleanInvalid[window], vp]];
      RecOps.FreeRecList[window.invalid];
      window.invalid ¬ NIL;
      RecOps.FreeRecList[vp];
      IF window.clearingRequired THEN WhitenRecList[window.badPhosphor]}};

  ShouldDisplay: ENTRY PROC [window: Handle] RETURNS [BOOLEAN] = {
    IF window.beingDisplayed THEN RETURN[FALSE];
    RETURN[window.beingDisplayed ¬ TRUE]};

  InvalidateTree: PUBLIC INTERNAL PROC [
    window, dirtyChild: Handle, invalid: RecOps.RecList, butNot: Handle ¬ NIL] = {
    SELECT TRUE FROM
      invalid = NIL => NULL;
      NOT window.inTree => RecOps.FreeRecList[invalid];
      dirtyChild = NIL => InvalidateList[window, invalid];
      ENDCASE => {
        childBox: RecOps.RecList = RecOps.Convert[dirtyChild];
	invalidInChild: RecOps.RecList;
        IF RecOps.Disjoint[invalid, childBox] THEN {
	  RecOps.FreeRecList[childBox];
	  InvalidateTree[window, dirtyChild.sibling, invalid, butNot];
	  RETURN};
	invalidInChild ¬ RecOps.Intersect[childBox, invalid];
	invalid ¬ RecOps.Bite[list: invalid, biter: childBox];
	IF invalid # NIL THEN
	  IF dirtyChild.sibling = NIL THEN InvalidateList[window, invalid]
	  ELSE InvalidateTree[window, dirtyChild.sibling, invalid, butNot];
	-- If we got here, invalidInChild is guaranteed non-NIL
	IF butNot = dirtyChild THEN RecOps.FreeRecList[invalidInChild]
	ELSE InvalidateTree[
	  dirtyChild, dirtyChild.child, invalidInChild, butNot]}};
    
  StackInternal: INTERNAL PROC [window, newSibling, newParent: Handle] = {
    parent: Handle = window.parent;
    IF window = newSibling THEN newSibling ¬ window.sibling;
    IF window.sibling = newSibling AND parent = newParent THEN RETURN;
    IF window.inTree # newParent.inTree THEN ERROR Error[illegalStack];
    -- first delink
    IF parent.child = window THEN parent.child ¬ window.sibling
    ELSE {
      FOR sib: Handle ¬ parent.child, sib.sibling UNTIL sib.sibling = NIL DO
        IF sib.sibling = window THEN {sib.sibling ¬ window.sibling; EXIT};
        REPEAT FINISHED => ERROR Error[windowNotChildOfParent];
        ENDLOOP};
    -- then enlink
    window.parent ¬ newParent;
    IF newSibling = newParent.child THEN {
      window.sibling ¬ newParent.child; newParent.child ¬ window}
    ELSE 
      FOR sib: Handle ¬ newParent.child, sib.sibling UNTIL sib = NIL DO
	IF sib.sibling = newSibling THEN {
	  window.sibling ¬ sib.sibling; sib.sibling ¬ window; EXIT};
	REPEAT FINISHED => ERROR Error[noSuchSibling];
	ENDLOOP};

  white: CARDINAL ¬ 0;
  whiteSrc: BitBlt.BitAddress = [word: @white, bit: 0];

  WhitenRecList: PUBLIC INTERNAL PROC [boxes: RecOps.RecList] = {
    FOR r: RecOps.RecList ¬ boxes, r.link UNTIL r = NIL DO
      top: INTEGER = r.box.top;
      left: INTEGER = r.box.left;
      width: INTEGER = r.box.right - left;
      height: INTEGER = r.box.bottom - top;
      ctx: SpecialDisplay.Special = 
        WindowOps.GetContext[r, SpecialDisplay.defaultContext];
      offset, bit: INTEGER;
      IF height <= 0 OR width <= 0 THEN LOOP;
      [offset, bit] ¬ WindowOps.DIVMOD16[CARDINAL[left]];
      WindowOps.bbPtr­ ¬ [
        dst: [
          word: ctx.bmAddress + WindowOps.SpecialTimesWpl[top, ctx] + offset,
          bit: bit], 
	dstBpl: ctx.bpl, src: whiteSrc, srcDesc: WindowOps.nullGray,
        width: width, height: height, flags: Display.boxFlags];
      BitBlt.BITBLT[WindowOps.bbPtr];
      ENDLOOP};

  globalCtx: SpecialDisplay.SpecialContext ¬ [
    bmAddress: NIL, wpl: 0, bpl: 0, alloc: NIL, free: NIL];
  
  MakeContext: PUBLIC INTERNAL PROC [r: RecOps.RecList] 
    RETURNS [SpecialDisplay.Special] = {
    lp: LONG ORDERED POINTER = LOOPHOLE[Window.GetBitmapUnder[r.dst]];
    IF lp = NIL THEN ERROR Error[illegalBitmap];
    globalCtx.wpl ¬ (CARDINAL[r.dst.box.dims.w] + 31)/16;
    globalCtx.bpl ¬ globalCtx.wpl*16;
    globalCtx.bmAddress ¬ 
      lp - CARDINAL[r.dst.place.x]/16 - Inline.LongMult[globalCtx.wpl,
      r.dst.place.y];
    RETURN[@globalCtx]};

  cache: RECORD [w: Handle, r: RecOps.RecList] ¬ [NIL, NIL];

  ResetCache: INTERNAL PROC = {RecOps.FreeRecList[cache.r]; cache ¬ [NIL, NIL]};

  GetRecList: PUBLIC INTERNAL PROC [window: Handle] RETURNS [RecOps.RecList] = {
    IF cache.w # window THEN {
      RecOps.FreeRecList[cache.r];
      cache ¬ IF ~window.inTree THEN [NIL, NIL]
      ELSE [window, RecOps.Visible[window, RecOps.Convert[window], dst, TRUE]]};
    RETURN[cache.r]};

  AssertUnobscured: PUBLIC PROC [w: Handle, code: Window.ErrorCode] = {
    wList: RecOps.RecList = RecOps.Convert[w];
    vp: RecOps.RecList = RecOps.Visible[w, RecOps.Copy[wList], null];
    obscured: BOOLEAN ¬ wList.box # vp.box;
    RecOps.FreeRecList[wList];
    RecOps.FreeRecList[vp];
    IF obscured THEN ERROR Error[code]};

  END.