-- 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.