IMPLEMENTATION MODULE CursorMouse; (*J. Gutknecht, 14.11.84*)

FROM SYSTEM IMPORT WORD;

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

CONST maxLev = 7;
unit = 32; offset = unit*2;
msW = 1024 DIV unit; msH = 1024 DIV unit (*mouse range*);

VAR scW, scH, W, H, W0, H0, u, v, top, cur: CARDINAL;

done: BOOLEAN;

tab: ARRAY [0..maxLev] OF RECORD
lev: CARDINAL; read: ReadProc
END;

TYPE Pattern1 = RECORD
height: CARDINAL;
raster: ARRAY [0..15] OF BITSET
END;

PROCEDURE GET(chan: CARDINAL; VAR val: WORD);
CODE 126B
END GET;

PROCEDURE PUT(chan: CARDINAL; val: WORD);
CODE 126B
END PUT;

PROCEDURE SetMouse(x, y: CARDINAL);
BEGIN u := x; v := y; PUT(6, 0)
END SetMouse;

PROCEDURE GetMouse(VAR s: BITSET; VAR x, y: CARDINAL);
VAR keys: CARDINAL;
BEGIN GET(6, x); GET(7, y); GET(3, keys);
x := (x * W0 DIV msW + u) MOD W;
y := (y * H0 DIV msH + v) MOD H;
IF x > scW + offset THEN x := 0
ELSIF x > scW THEN x := scW
END;
IF y > scH + offset THEN y := 0
ELSIF y > scH THEN y := scH
END;
s := BITSET(keys)
END GetMouse;

PROCEDURE ReadMouse(VAR s: BITSET; VAR x, y: CARDINAL);
BEGIN
IF cur = 0 THEN GetMouse (s, x, y)
ELSE cur := cur-1; tab[cur].read(s, x, y); cur := cur+1
END
END ReadMouse;

PROCEDURE Assign(p: ReadProc);
VAR curLev: CARDINAL;
BEGIN
IF cur = top THEN curLev := CurrentLevel();
IF (top = 0) OR (tab[top-1].lev < curLev) THEN
IF top <= maxLev THEN
tab[top].read := p; tab[top].lev := curLev;
top := top+1; cur := top
END
ELSE tab[top-1].read := p
END
END
END Assign;

PROCEDURE Cleanup;
VAR curLev: CARDINAL;
BEGIN
curLev := CurrentLevel();
WHILE (top > 0) & (tab[top-1].lev >= curLev) DO
top := top - 1
END
END Cleanup;


CONST lu = 0; ld = 1; ru = 2; rd = 3;

TYPE Block = RECORD x,y,w,h: CARDINAL END;

Direction = [lu..rd];

VAR standard: BOOLEAN;
i, prevX, prevY: CARDINAL;
cursor: Pattern; curBlk: Block;

test: Pattern1;

curOn: BOOLEAN;
arrow: ARRAY Direction OF Pattern;
privPat: Pattern;

PROCEDURE REPL(m: CARDINAL; bmd: BMDescriptor; pat: Pattern; blk: Block);
CODE 126B
END REPL;

PROCEDURE PaintCursor(X, Y: CARDINAL);
VAR d: Direction;
BEGIN
WITH curBlk DO
IF X + 16 <= scW THEN x := X;
IF Y >= 16 THEN y := Y - 16; d := lu ELSE y := Y; d := ld END
ELSE x := X - 16;
IF Y >= 16 THEN y := Y - 16; d := ru ELSE y := Y; d := rd END
END
END;
IF standard THEN cursor := arrow[d]
ELSE cursor := privPat
END;
REPL(2, BMD, cursor, curBlk)
END PaintCursor;

PROCEDURE MoveCursor(x, y: CARDINAL);
BEGIN
IF curOn THEN
IF (x # prevX) OR (y # prevY) THEN
REPL(2, BMD, cursor, curBlk);
prevX := x; prevY := y;
PaintCursor(x, y)
END
ELSE curOn := TRUE; prevX := x; prevY := y;
PaintCursor(x, y)
END
END MoveCursor;

PROCEDURE EraseCursor;
BEGIN
IF curOn THEN curOn := FALSE;
REPL(2, BMD, cursor, curBlk)
END
END EraseCursor;

PROCEDURE SetPattern(VAR p: Pattern);
BEGIN privPat := p; standard := FALSE
END SetPattern;

PROCEDURE ResetPattern;
BEGIN standard := TRUE
END ResetPattern;

BEGIN

scW := ScreenWidth(); scH := MapHeight();
WITH arrow[lu] DO
raster[ 0] := {0..7}; raster[ 1] := {0..6};
raster[ 2] := {0..5}; raster[ 3] := {0..6};
raster[ 4] := {0..7}; raster[ 5] := {0..8};
raster[ 6] := {0..1,3..9}; raster[ 7] := {0,4..10};
raster[ 8] := {5..11}; raster[ 9] := {6..12};
raster[10] := {7..13}; raster[11] := {8..14};
raster[12] := {9..15}; raster[13] := {10..14};
raster[14] := {11..13}; raster[15] := {12};

height := 16
END;
WITH arrow[ld] DO height := 16;
FOR i := 0 TO 15 DO
raster[i] := arrow[lu].raster[15-i]
END
END;

WITH test DO
raster[ 0] := {0..7}; raster[ 1] := {0..6};
raster[ 2] := {0..5}; raster[ 3] := {0..6};
raster[ 4] := {0..7}; raster[ 5] := {0..8};
raster[ 6] := {0..1,3..9}; raster[ 7] := {0,4..10};
raster[ 8] := {5..11}; raster[ 9] := {6..12};
raster[10] := {7..13}; raster[11] := {8..14};
raster[12] := {9..15}; raster[13] := {10..14};
raster[14] := {11..13}; raster[15] := {12};

height := 16
END;
WITH test DO height := 16;
FOR i := 0 TO 15 DO
raster[i] := arrow[lu].raster[15-i]
END

END;
WITH arrow[ru] DO height := 16;
raster[ 0] := {8..15}; raster[ 1] := {9..15};
raster[ 2] := {10..15}; raster[ 3] := {9..15};
raster[ 4] := {8..15}; raster[ 5] := {7..15};
raster[ 6] := {6..12,14..15}; raster[ 7] := {5..11,15};
raster[ 8] := {4..10}; raster[ 9] := {3..9};
raster[10] := {2..8}; raster[11] := {1..7};
raster[12] := {0..6}; raster[13] := {1..5};
raster[14] := {2..4}; raster[15] := {3}
END;
WITH arrow[rd] DO height := 16;
FOR i := 0 TO 15 DO
raster[i] := arrow[ru].raster[15-i]
END
END;
WITH curBlk DO w := 16; h := 16 END;
curOn := FALSE; standard := TRUE
END CursorMouse.