IMPLEMENTATION MODULE Windows; (*J. Gutknecht, 19.10.84*)

FROM Programs IMPORT CurrentLevel, TermProcedure;
FROM DisplayDriver IMPORT BMDescriptor, BMD, ScreenWidth, MapHeight, DFF,
LineHeight, CharWidth;

TYPE Block = RECORD x,y,w,h: CARDINAL END;
Set = SET OF Window;
WindowState = (inactive, disabled, enabled);
Font = CARDINAL;

WindowRec = RECORD
state: WindowState; level: CARDINAL;
blk: Block; Redraw: RestoreProc; succ: Set
END;

Pattern = RECORD size: CARDINAL; bits: ARRAY[0..7] OF BITSET END;
PROCEDURE REPL(m: CARDINAL; VAR bmd: BMDescriptor; VAR pat: Pattern;
VAR blk: Block);
CODE 126B
END REPL;
VAR done: BOOLEAN;
scW, scH, FP, lineH, charW: CARDINAL; u, v: Window; U: Set;

white, black, dark: Pattern;
g: ARRAY[0..3] OF BITSET;

Wdw: ARRAY Window OF WindowRec;
PROCEDURE DrawPattern(u: Window);
VAR Y: CARDINAL;
BEGIN
WITH Wdw[u] DO
WITH blk DO Y := y + h;
WITH dark DO
bits[Y MOD 6] := g[x MOD 4];
bits[(Y+1) MOD 6] := {0..15};
bits[(Y+2) MOD 6] := {0..15};
bits[(Y+3) MOD 6] := g[(x+2) MOD 4];
bits[(Y+4) MOD 6] := {0..15};
bits[(Y+5) MOD 6] := {0..15}
END
END;
REPL(0, BMD, dark, blk)
END
END DrawPattern;

PROCEDURE DCH(VAR bmd: BMDescriptor; VAR fnt: Font; VAR blk: Block; ch: CHAR);
CODE 126B
END DCH;

PROCEDURE InitBackground;
BEGIN
WITH Wdw[Background] DO state := enabled;
blk.x := 0; blk.y := 0; blk.w := scW; blk.h := scH;
Redraw := DrawPattern; succ := Set {};
REPL(0, BMD, white, blk)
END
END InitBackground;

PROCEDURE Update(u: Window);
VAR v: Window;

PROCEDURE Disjoint(b1, b2: Block): BOOLEAN;
BEGIN RETURN
(b1.x < b2.x) & (b1.x + b1.w <= b2.x) OR
(b2.x < b1.x) & (b2.x + b2.w <= b1.x) OR
(b1.y < b2.y) & (b1.y + b1.h <= b2.y) OR
(b2.y < b1.y) & (b2.y + b2.h <= b1.y)
END Disjoint;

BEGIN
WITH Wdw[u] DO succ := Set {};
FOR v := FirstWindow TO LastWindow DO
IF v # u THEN
WITH Wdw[v] DO
IF (state = enabled) & NOT Disjoint(Wdw[u].blk, blk) THEN
INCL(succ, u)
END
END
END
END
END
END Update;

PROCEDURE DisableSucc(u: Window);
VAR v: Window; S: Set;
BEGIN
WITH Wdw[u] DO S := succ; v := 0;
WHILE S # Set {} DO INC(v);
IF v IN S THEN Wdw[v].state := disabled; EXCL(S, v) END
END
END
END DisableSucc;

PROCEDURE DrawWindow(u: Window);
VAR b: Block;
BEGIN
WITH Wdw[u] DO
REPL(0, BMD, white, blk);
WITH b DO
x := blk.x; y := blk.y + blk.h - 1; w := blk.w; h := 1;
REPL(0, BMD, black, b);
y := blk.y;
REPL(0, BMD, black, b);
w := 1; h := blk.h;
REPL(0, BMD, black, b);
x := blk.x + blk.w - 1;
REPL(0, BMD, black, b)
END
END
END DrawWindow;

PROCEDURE Restore(U: Set);
VAR u: CARDINAL; upU, S: Set;

PROCEDURE PickOut(U: Set; VAR upU: Set);
VAR v: CARDINAL; V: Set;
BEGIN
upU := Set {}; V := U; v := 0;
WHILE V # Set {} DO
IF (v IN V) & (Wdw[v].succ*U = Set {}) THEN INCL(upU, v) END;
EXCL(V, v); INC(v)
END
END PickOut;

BEGIN
PickOut(U, upU);
IF upU # Set {} THEN
Restore(U - upU); u := 0;
WHILE upU # Set {} DO
WITH Wdw[u] DO
IF (u IN upU) & (state = disabled) THEN
DrawWindow(u); Redraw(u); state := enabled; DisableSucc(u)
END
END;
EXCL(upU, u); INC(u)
END
END
END Restore;

PROCEDURE OpenWindow(VAR u: Window; x,y,w,h: CARDINAL;
Repaint: RestoreProc; VAR done: BOOLEAN);
VAR v: Window; S: Set;
BEGIN
IF (x < scW) & (w >= 2) & (w <= scW - x)
& (y < scH) & (h >= 2) & (h <= scH - y) THEN
u := FirstWindow;
WHILE (Wdw[u].state # inactive) & (u # LastWindow) DO INC(u) END;
IF (Wdw[u].state = inactive) THEN
WITH Wdw[u] DO
level := CurrentLevel(); state := enabled;
blk.x := x; blk.y := y; blk.w := w; blk.h := h;
Redraw := Repaint; succ := Set {};
IF U = Set {0} THEN DrawPattern(Background) ELSE Update(u) END;
INCL(U, u); DrawWindow(u);
done := TRUE
END
ELSE done := FALSE
END
ELSE done := FALSE
END
END OpenWindow;

PROCEDURE DrawTitle(u: Window; title: ARRAY OF CHAR);
VAR L, l: CARDINAL; VAR b: Block;
BEGIN
WITH Wdw[u] DO
IF (u # 0) & (state > inactive) & (blk.h >= lineH) THEN
WITH b DO
x := blk.x + 1; y := blk.y + blk.h - lineH;
w := blk.w - 2; h := lineH;
REPL(0, BMD, white, b);
L := HIGH(title); l := 0;
WHILE (l <= L) & (title[l] # 0C) & (w >= charW) DO
DCH(BMD, FP, b, title[l]); INC(l)
END;
x := blk.x + 1; w := blk.w - 2;
REPL(2, BMD, black, b)
END
END
END
END DrawTitle;

PROCEDURE Fade(u: Window);
VAR v: Window;
BEGIN
WITH Wdw[0] DO
state := disabled; blk:= Wdw[u].blk; succ := Wdw[u].succ
END;
FOR v := FirstWindow TO LastWindow DO
WITH Wdw[v] DO
IF (state = enabled) & (u IN succ) THEN
EXCL(succ, u); INCL(Wdw[0].succ, v)
END
END
END
END Fade;

PROCEDURE RedefineWindow(u: Window; x,y,w,h: CARDINAL; VAR done: BOOLEAN);
VAR v: Window; S: Set;
BEGIN
WITH Wdw[u] DO
IF (u # 0) & (state = enabled)
& (x < scW) & (w >= 2) & (w <= scW - x)
& (y < scH) & (h >= 2) & (h <= scH - y) THEN
Fade(u); state := disabled;
blk.x := x; blk.y := y; blk.w := w; blk.h := h;
Update(u); Restore(U);
done := TRUE
ELSE done := FALSE
END
END
END RedefineWindow;

PROCEDURE CloseWindow(u: Window);
VAR S: Set;
BEGIN
WITH Wdw[u] DO
IF (u # 0) & (state > inactive) THEN
Fade(u); state := inactive; EXCL(U, u);
IF U = Set {0} THEN InitBackground ELSE Restore(U) END
END
END
END CloseWindow;

PROCEDURE CloseAll;
VAR u: Window;
BEGIN
FOR u := FirstWindow TO LastWindow DO
IF (Wdw[u].state # inactive) & (Wdw[u].level >= CurrentLevel()) THEN
Fade(u); Wdw[u].state := inactive; EXCL(U, u)
END
END;
IF U = Set {0} THEN InitBackground ELSE Restore(U) END
END CloseAll;

PROCEDURE OnTop(u: Window): BOOLEAN;
BEGIN
WITH Wdw[u] DO
RETURN (u # 0) & (state = enabled) & (succ = Set {})
END
END OnTop;

PROCEDURE PlaceOnTop (u: Window);
VAR v: Window;
BEGIN
WITH Wdw[u] DO
IF (u # 0) & (state = enabled) THEN v := 0;
WHILE succ # Set {} DO INC(v);
IF v IN succ THEN INCL(Wdw[v].succ, u); EXCL(succ, v) END
END;
DrawWindow(u); Redraw(u)
END
END
END PlaceOnTop;

PROCEDURE PlaceOnBottom(u: Window);
VAR v: Window; S: Set;
BEGIN
WITH Wdw[u] DO
IF (u # 0) & (state = enabled) THEN
FOR v := FirstWindow TO LastWindow DO
WITH Wdw[v] DO
IF (state = enabled) & (u IN succ) THEN
EXCL(succ, u); INCL(Wdw[u].succ, v)
END
END
END;
DisableSucc(u); Restore(U)
END
END
END PlaceOnBottom;

PROCEDURE UpWindow(x, y: CARDINAL): Window;
VAR found: BOOLEAN; u, v: Window;
V: Set;

PROCEDURE InBlock(x, y: CARDINAL; b: Block): BOOLEAN;
BEGIN RETURN
(x >= b.x) & (x < b.x + b.w) & (y >= b.y) & (y < b.y + b.h)
END InBlock;

BEGIN
V := U - Set {0}; u := 0;
WHILE V # Set {} DO
v := 0; found := FALSE;
WHILE NOT found & (v # LastWindow) DO INC(v);
found := (v IN V) & InBlock(x, y, Wdw[v].blk)
END;
IF found THEN u := v; V := Wdw[v].succ ELSE V := Set {} END
END;
RETURN u
END UpWindow;

BEGIN
WITH white DO size := 1; bits [0] := {} END;
WITH black DO size := 1; bits [0] := {0..15} END;
dark.size := 6;
g[0] := {1,2,3,5,6,7,9,10,11,13,14,15};
g[1] := {0,1,2,4,5,6,8,9,10,12,13,14};
g[2] := {0,1,3,4,5,7,8,9,11,12,13,15};
g[3] := {0,2,3,4,6,7,8,10,11,12,14,15};
scW := ScreenWidth(); scH := MapHeight();
FP := DFF(); lineH := LineHeight(); charW := CharWidth();
InitBackground;
FOR v := FirstWindow TO LastWindow DO Wdw[v].state := inactive END;
U := Set {0};
TermProcedure(CloseAll, done)
END Windows.