-- N.Wirth June 1, 1977
-- S.Andler August 24, 1977 10:56 PM
DIRECTORY
InlineDefs: FROM "InlineDefs",
IODefs: FROM "IODefs",
KeyDefs: FROM "KeyDefs",
ProcessDefs: FROM "ProcessDefs",
RectangleDefs: FROM "RectangleDefs",
SegmentDefs: FROM "SegmentDefs",
StreamDefs: FROM "StreamDefs",
SystemDefs: FROM "SystemDefs",
TeleSilDefs: FROM "TeleSilDefs";

DEFINITIONS FROM
InlineDefs, -- BITAND, BITOR, BITXOR, BITNOT, BITSHIFT
TeleSilDefs;

--------------------------------------------------------------------
TeleSilResident: PROGRAM[typeScriptDCB: RectangleDefs.DCBptr]=
BEGIN
-- External procedures --
-- From an unknown! package --
Zero: EXTERNAL PROCEDURE[POINTER,INTEGER];
-- From TeleSilDisplay --
SetBM: EXTERNAL PROCEDURE[newBM: RectangleDefs.BMptr];
-- From TeleSilMain --
Rebuild: EXTERNAL PROCEDURE;

--------------------------------------------------------------------
-- THE MOUSE
-- defines MouseValue, MouseEvent, SetMousePosition
pMouseCoord: POINTER TO Coord= @MEMORY[424B];
MouseLoc: POINTER TO WORD= @MEMORY[177030B];

MouseValue: PUBLIC PROCEDURE RETURNS[INTEGER]=
BEGIN RETURN[BITXOR[BITAND[MouseLoc↑, 7], 7]] END ;

MouseEvent: PUBLIC PROCEDURE[m: CARDINAL] RETURNS[CARDINAL]=
BEGIN e: CARDINAL;
-- 8 for Red button (left or upper)
-- 4 for Yellow button (middle)
-- 0 for Blue button (right or lower)
-- add 1 for LeftShift key and/or 2 for Ctrl key
IF m=1 THEN e ← 4 ELSE IF m=2 THEN e ← 0 ELSE e ← 8;
IF KeyDefs.Keys.LeftShift=down THEN e ← e+1;
IF KeyDefs.Keys.Ctrl=down THEN e ← e+2;
RETURN [e]
END ;

SetMousePosition: PUBLIC PROCEDURE[point: Coord]=
BEGIN pMouseCoord↑ ← point END;

--------------------------------------------------------------------
-- THE CURSOR
-- defines SetCursorIcon, CursorPosition, SetGridSpacing

IntMask: POINTER TO WORD= @MEMORY[421B];
pCursorCoord: POINTER TO Coord= @MEMORY[426B];
pCursorBM: POINTER TO CursorBitMap= @MEMORY[431B];
CursorBitMap: TYPE= ARRAY[0 .. 15] OF WORD;
cursorIcon: CursorIcon;
gridMask: WORD ← 177777B;

CursorIcons: ARRAY CursorIcon OF CursorBitMap ←
[[177400B, 101000B, 102000B, 101000B, -- arrow
100400B, 120200B, 150100B, 104040B,
002020B, 001010B, 000404B, 000202B,
000101B, 000042B, 000024B, 000010B],
[177400B, 177000B, 176000B, 177000B, -- blackArrow
177400B, 177600B, 157700B, 107740B,
003760B, 001770B, 000774B, 000376B,
000177B, 000076B, 000034B, 000010B],
[177400B, 125000B, 152000B, 125000B, -- greyArrow
152400B, 125200B, 152500B, 105240B,
002520B, 001250B, 000524B, 000252B,
000125B, 000052B, 000024B, 000010B],
[177777B, 100001B, 100001B, 107741B, -- rebuild
107761B, 106061B, 106061B, 107761B,
107741B, 106141B, 106061B, 106061B,
106061B, 100001B, 100001B, 177777B],
[177777B, 100001B, 100001B, 103741B, -- input
103741B, 100601B, 100601B, 100601B,
100601B, 100601B, 100601B, 103741B,
103741B, 100001B, 100001B, 177777B]];

SetCursorIcon: PUBLIC PROCEDURE[icon: CursorIcon] RETURNS[oldCursorIcon: CursorIcon]=
BEGIN
oldCursorIcon ← cursorIcon;
pCursorBM↑ ← CursorIcons[cursorIcon ← icon]
END;

CursorPosition: PUBLIC PROCEDURE RETURNS[Coord]=
BEGIN RETURN[pCursorCoord↑] END;

SetGridSpacing: PUBLIC PROCEDURE[gridSpacing: GridSpacing]=
-- e.g. gridSpacing= 3 makes gridMask= -8= 177770B
BEGIN gridMask ← - BITSHIFT[1, gridSpacing] END;

TrackCursor: PROCEDURE=
BEGIN -- This is a process running at interrupt level 3 (every 1/60 sec)
DO
pMouseCoord↑ ← [MAX[0, MIN[pMouseCoord.x, xMax]], MAX[0, MIN[pMouseCoord.y, yMax]]];
pCursorCoord↑ ← [BITAND[pMouseCoord.x, gridMask], BITAND[pMouseCoord.y, gridMask]];
ProcessDefs.BLOCK
ENDLOOP
END ;

--------------------------------------------------------------------
-- THE DISPLAY
-- defines PaintString, PaintRectangle, EraseRectangle, Mark, New,
-- DisplayTicks, EraseTicks, TypeScriptWindow, BitMapDisplay

GrayToneMap: TYPE= ARRAY [0..4) OF WORD;

GrayToneCode: ARRAY GrayTone OF GrayToneMap ←
[[000000B, 000000B, 000000B, 000000B], -- white
[010421B, 000000B, 000000B, 000000B], -- 0
[010421B, 042104B, 000000B, 000000B], -- 1
[010421B, 010421B, 042104B, 042104B], -- 2
[010421B, 021042B, 042104B, 104210B], -- 3
[104210B, 042104B, 021042B, 010421B], -- 4
[114631B, 114631B, 063146B, 063146B], -- 5
[052525B, 125252B, 052525B, 125252B], -- gray
[177777B, 177777B, 177777B, 177777B]]; -- black

BBT: TYPE= MACHINE DEPENDENT RECORD[ -- BitBltTable
func, unused: CARDINAL,
-- BitBlt function codes:
-- BBoperation:BBsourcetype:
-- 0: d ← s’ (replace) 0: s’ = s (block)
-- 1: d ← s’ ior d (paint)4: s’ = ~s (complement)
-- 2: d ← s’ xor d (invert)8: s’ = s & g (andgray)
-- 3: d ← ~s’ & d (erase)12: s’ = g (gray)
dadr: RectangleDefs.BMptr, -- destination address
dwidth: CARDINAL, -- dest. bitmap width
d: Zone, -- destination zone
sadr: RectangleDefs.BMptr, -- source address
swidth: CARDINAL, -- source bitmap width
s: Coord, -- source zone coordinates
g: GrayToneMap]; -- gray block g

pBBT: POINTER TO BBT;
BM: RectangleDefs.BMptr; -- main BitMap
BMHeight: CARDINAL ← BMMaxHeight; -- display height in scan lines
BMSize: CARDINAL ← BMWordsPerLine*BMHeight; -- display size in words
xMax: INTEGER= BMBitsPerLine-16;
yMax: INTEGER ← BMHeight-16; -- changed in ShrinkBM
smallBMSize: CARDINAL;
pFonts: POINTER TO ARRAY FontNumber OF FontDesc;
DCBorg: POINTER TO RectangleDefs.DCBptr= @MEMORY[420B];
displayDCB: RectangleDefs.DCBptr;
OutOfStorage: SIGNAL= CODE;

BitBlt: EXTERNAL PROCEDURE[POINTER TO BBT];

PaintString: PUBLIC PROCEDURE[s: STRING, z: Zone, fno: FontNumber] RETURNS [CARDINAL]=
BEGIN i: CARDINAL; w, dw: CARDINAL;
dwa: RectangleDefs.BMptr; -- destination word address
dba: [0..15]; -- destination bit address
fnt: RectangleDefs.FAptr ← pFonts[fno].fnt;

IF z.point.x ~IN [0..LOOPHOLE[BMBitsPerLine-z.w, INTEGER]]
OR z.point.y ~IN [0..LOOPHOLE[BMHeight-z.h, INTEGER]]
THEN RETURN[0];

dwa ← BM+(BMWordsPerLine*(z.point.y-1)+z.point.x/16);
dba ← 15-(z.point.x MOD 16);
i ← w ← 0;
WHILE i<s.length AND w<z.w DO
[dw, dba, dwa] ← RectangleDefs.CONVERT[s[i], fnt, dwa, BMWordsPerLine, dba];
i ← i+1; w ← w+dw
ENDLOOP ;
RETURN [w]
END ;

PaintRectangle: PUBLIC PROCEDURE[f: CARDINAL, z: Zone, g: GrayTone]=
BEGIN pBBT.func ← f;
PaintZone[z, g]
END ;

EraseRectangle: PUBLIC PROCEDURE[z: Zone]=
BEGIN pBBT.func ← 12;
PaintZone[z, white]
END;

Mark: PUBLIC PROCEDURE[point: Coord, icon: CursorIcon]=
BEGIN
pBBT.func ← 2; -- d ← s xor d
pBBT.d ← [point, 16, 16];
pBBT.sadr ← LOOPHOLE[@CursorIcons[icon]]; pBBT.swidth ← 1; pBBT.s ← [0,0];
BitBlt[pBBT]
END;

PaintZone: PROCEDURE[z: Zone, g: GrayTone]=
BEGIN
x, y, absX, absY: CARDINAL;
pGTM: POINTER TO GrayToneMap;
i: [0..4);

IF z.point.x >= 0 THEN x ← z.point.x
ELSE
BEGIN
absX ← -z.point.x;
x ← 0;
z.w ← IF z.w>absX THEN z.w-absX ELSE 0
END;

IF z.point.y >= 0 THEN y ← z.point.y
ELSE
BEGIN
absY ← -z.point.y;
y ← 0;
z.h ← IF z.h>absY THEN z.h-absY ELSE 0
END;

IF x+z.w >= BMBitsPerLine
THEN IF x >= BMBitsPerLine THEN z.w ← 0 ELSE z.w ← BMBitsPerLine-x;

IF y+z.h >= BMHeight
THEN IF y >= BMHeight THEN z.h ← 0 ELSE z.h ← BMHeight-y;

IF z.w#0 AND z.h#0 THEN
BEGIN
pBBT.d ← [[x,y], z.w, z.h]; pBBT.s ← [0,0];
pGTM ← @GrayToneCode[g];
FOR i IN [0..4) DO
pBBT.g[i] ← pGTM[InlineDefs.BITAND[y+i, 3]]
ENDLOOP;
BitBlt[pBBT]
END
END;

DisplayTicks: PUBLIC PROCEDURE=
BEGIN OPEN InlineDefs; -- BITOR
line, word: CARDINAL;
pLine, pWord: POINTER TO WORD;
FOR line ← 0, line+16 WHILE line<BMHeight DO
pLine ← BM+line*BMWordsPerLine;
FOR word IN [0..BMWordsPerLine) DO
pWord ← pLine+word;
pWord↑ ← BITOR[pWord↑, 100000B]
ENDLOOP
ENDLOOP
END;

EraseTicks: PUBLIC PROCEDURE=
BEGIN OPEN InlineDefs; -- BITAND
line, word: CARDINAL;
pLine, pWord: POINTER TO WORD;
FOR line ← 0, line+16 WHILE line<BMHeight DO
pLine ← BM+line*BMWordsPerLine;
FOR word IN [0..BMWordsPerLine) DO
pWord ← pLine+word;
pWord↑ ← BITAND[pWord↑, 77777B]
ENDLOOP
ENDLOOP
END;

New: PROCEDURE[n: CARDINAL] RETURNS[POINTER]=
-- allocate n words with even address
BEGIN p: POINTER;
p ← SystemDefs.AllocateHeapNode[n+1];
p ← p + BITAND[LOOPHOLE[p], 1];
RETURN[p]
END ;

SwapEverythingOut: PROCEDURE=
BEGIN
tooMany: SegmentDefs.PageCount= 250;
[] ← SegmentDefs.NewDataSegment[SegmentDefs.DefaultBase, tooMany
! SegmentDefs.InsufficientVM => CONTINUE]
END;

InitDisplay: PUBLIC PROCEDURE=
BEGIN -- Simulate DisplayOn with our own bitmap and fontsegment
defaultBM: RectangleDefs.BMHandle ← RectangleDefs.GetDefaultBitmap[];
defaultDS: StreamDefs.DisplayHandle ← StreamDefs.GetDefaultDisplayStream[];
rectangle: RectangleDefs.Rptr ← defaultBM.rectangles;
smallBMSize ← defaultBM.words;

--------------------------------------------------------------------
-- Initialization of display
--------------------------------------------------------------------
IF NOT sandBarOK THEN SwapEverythingOut;
BM ← SystemDefs.AllocatePages[SystemDefs.PagesForWords[BMSize]];
displayDCB ← New[4]; -- Full display bitmap
displayDCB↑ ← RectangleDefs.DCB[next: RectangleDefs.DCBnil,
resolution: high, background: white, indenting: 0, width: BMWordsPerLine,
bitmap: LOOPHOLE[BM], height: BMHeight/2];
Zero[BM, BMSize];
DCBorg↑ ← displayDCB;
DisplayTicks;

--------------------------------------------------------------------
-- Simulate ReallocateBitmap
--------------------------------------------------------------------
defaultBM.addr ← BM;
defaultBM.width ← defaultBM.wordsperline*16;
defaultBM.height ← defaultBM.words/defaultBM.wordsperline;
IF InlineDefs.BITAND[defaultBM.height,1]=1 THEN
defaultBM.height ← defaultBM.height-1;
[] ← RectangleDefs.UpdateBitmap[defaultBM];
rectangle.visible ← TRUE;
defaultDS.pfont ← pFonts[0].fnt;

pBBT.dadr ← BM;
SetBM[BM]
END;

TypeScriptWindow: PUBLIC PROCEDURE=
BEGIN
DCBorg↑ ← RectangleDefs.DCBnil;
Zero[BM, smallBMSize];
DCBorg↑ ← typeScriptDCB;
IF NOT IODefs.NewLine[] THEN IODefs.WriteChar[IODefs.CR]
END;

BitMapDisplay: PUBLIC PROCEDURE=
BEGIN
IF NOT IODefs.NewLine[] THEN IODefs.WriteChar[IODefs.CR];
IODefs.WriteLine["[type any character to continue]"];
[] ← IODefs.ReadChar[];
DCBorg↑ ← RectangleDefs.DCBnil;
Zero[BM, BMSize];
DCBorg↑ ← displayDCB;
Rebuild
END;

ShrinkBM: PUBLIC PROCEDURE=
BEGIN
chunk: CARDINAL= 48; -- Bitmap height decrement in scan lines
defaultBM: RectangleDefs.BMHandle;
oldDCB: RectangleDefs.DCBptr ← DCBorg↑;

BMHeight ← BMHeight-chunk; -- chop some scan lines off the bottom
yMax ← BMHeight-16; -- used in TrackCursor
BMSize ← BMWordsPerLine*BMHeight; -- display size in words
IF BMSize<smallBMSize THEN SIGNAL OutOfStorage;

--------------------------------------------------------------------
-- Reinitialization of display
--------------------------------------------------------------------
DCBorg↑ ← RectangleDefs.DCBnil;
SystemDefs.FreePages[BM];
BM ← SystemDefs.AllocatePages[SystemDefs.PagesForWords[BMSize]];
displayDCB.bitmap ← LOOPHOLE[BM];
displayDCB.height ← BMHeight/2;
IF displayDCB.next#RectangleDefs.DCBnil THEN
displayDCB.next.height←displayDCB.next.height+chunk/2
ELSE BEGIN
displayDCB.next ← New[4];
displayDCB.next↑ ← RectangleDefs.DCB[next: RectangleDefs.DCBnil,
resolution: high, background: black, indenting: 0, width: 0,
bitmap: NIL, height: chunk/2]
END;

--------------------------------------------------------------------
-- Simulate ReallocateBitmap
--------------------------------------------------------------------
defaultBM ← RectangleDefs.GetDefaultBitmap[];
defaultBM.addr ← BM;
defaultBM.height ← defaultBM.words/defaultBM.wordsperline;
IF InlineDefs.BITAND[defaultBM.height,1]=1 THEN
defaultBM.height ← defaultBM.height-1;
[] ← RectangleDefs.UpdateBitmap[defaultBM];

pBBT.dadr ← BM;
SetBM[BM];
TypeScriptWindow;
IODefs.WriteLine["Storage released by shrinking bitmap"];
IF oldDCB=displayDCB THEN BitMapDisplay
END;

LockFonts: PUBLIC PROCEDURE[pFD: POINTER TO ARRAY FontNumber OF FontDesc]=
BEGIN i: FontNumber; fsa: RectangleDefs.Fptr;
pFonts ← pFD; -- save a copy of the pointer

-- Swap everything out before locking the file segments in core
SwapEverythingOut;
FOR i IN FontNumber DO
IF pFD[i].name.length#0 AND pFD[i].fsh.lock=0 THEN -- if it’s not already locked
BEGIN
SegmentDefs.SwapIn[pFD[i].fsh]; -- Swap in and lock font segment in low core
fsa ← SegmentDefs.FileSegmentAddress[pFD[i].fsh];
pFD[i].height ← fsa.FHeader.MaxHeight;
pFD[i].fnt ← @fsa.FCDptrs
END
ENDLOOP;
END;
--------------------------------------------------------------------
-- Initialization code
--------------------------------------------------------------------
ph: ProcessDefs.ProcessHandle;

StreamDefs.CursorTrack[FALSE]; -- disable tracking by system
ph ← ProcessDefs.CreateProcessFromProcedure[TrackCursor, 3];
ProcessDefs.ActivateProcess[ph];
IntMask↑ ← BITOR[IntMask↑, 10B];

pBBT ← New[16];
pBBT.dwidth ← BMWordsPerLine
END.