-- N.Wirth June 1, 1977
-- S.Andler August 24, 1977 10:56 PM
-- C.Geschke August 30, 1977 2:54 PM
-- E.Satterthwaite September 12, 1977 3:35 PM
-- R.Johnsson September 19, 1977 9:52 AM
-- J.Sandman October 19, 1977 10:42 AM
-- R.Johnsson October 20, 1977 9:18 AM
DIRECTORY
ControlDefs: FROM "ControlDefs",
DisplayDefs: FROM "DisplayDefs",
FontDefs: FROM "FontDefs",
InlineDefs: FROM "InlineDefs",
IODefs: FROM "IODefs",
KeyDefs: FROM "KeyDefs",
MiscDefs: FROM "MiscDefs",
ProcessDefs: FROM "ProcessDefs",
RectangleDefs: FROM "RectangleDefs",
SchedDefs: FROM "SchedDefs",
SegmentDefs: FROM "SegmentDefs",
StreamDefs: FROM "StreamDefs",
SystemDefs: FROM "SystemDefs",
TeleSilDefs: FROM "TeleSilDefs",
TeleSilProcDefs: FROM "TeleSilProcDefs";

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

--------------------------------------------------------------------
TeleSilResident: PROGRAM
IMPORTS
DisplayDefs, FontDefs, IODefs, MiscDefs, ProcessDefs,
SegmentDefs, StreamDefs, SystemDefs, TeleSilProcDefs
EXPORTS SchedDefs, TeleSilProcDefs =
BEGIN
OPEN TeleSilDefs;

--------------------------------------------------------------------
-- 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 -- 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
e: CARDINAL;
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];
cursorIcon: CursorIcon;
gridMask: WORD ← 177777B;

CursorIcons: DESCRIPTOR FOR ARRAY CursorIcon OF CursorBitMap;

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

GrayToneCode: DESCRIPTOR FOR ARRAY GrayTone OF GrayToneMap;

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
Fonts: DESCRIPTOR FOR ARRAY OF FontDesc;
DCBorg: POINTER TO RectangleDefs.DCBptr= @MEMORY[420B];
displayDCB: RectangleDefs.DCBptr;
OutOfStorage: SIGNAL= CODE;

BitBlt: MACHINE CODE [POINTER TO BBT] = LOOPHOLE[RectangleDefs.HardwareBitBlt];

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 ← Fonts[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]=
BEGIN -- allocate n words with even address
p: POINTER ← 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

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

DisplayDefs.InitDisplay[0,0,0,FontDefs.CreateFont[Fonts[0].fsh]];
pBBT.dadr ← BM
END;

TypeScriptWindow: PUBLIC PROCEDURE=
BEGIN
DCBorg↑ ← RectangleDefs.DCBnil;
DisplayDefs.SetDummyDisplaySize[72];
DisplayDefs.SetSystemDisplaySize[6,4];
END;

BitMapDisplay: PUBLIC PROCEDURE=
BEGIN
clock: POINTER TO INTEGER = LOOPHOLE[430B];
now: INTEGER ← clock↑;
UNTIL clock↑ - now >= 39 DO NULL ENDLOOP;
DisplayDefs.SetDummyDisplaySize[0];
DisplayDefs.SetSystemDisplaySize[0,0];
DCBorg↑ ← displayDCB;
END;

ShrinkBM: PUBLIC PROCEDURE=
BEGIN
chunk: CARDINAL= 48; -- Bitmap height decrement in scan lines
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

--------------------------------------------------------------------
-- 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↑ ← [next: RectangleDefs.DCBnil, resolution: high,
background: black, indenting: 0, width: 0,
bitmap: NIL, height: chunk/2]
END;

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

LockFonts: PUBLIC PROCEDURE[FD: DESCRIPTOR FOR ARRAY OF FontDesc]=
BEGIN
i: FontNumber; fsa: RectangleDefs.Fptr;
Fonts ← FD; -- save a copy of the pointer
-- If first time swapping in fonts, then touch them so Segments is not swapped in
IF firstTimeFontsIn THEN
BEGIN
FOR i IN FontNumber DO
OPEN s: FD[i].fsh, SegmentDefs;
SwapIn[@s]; Unlock[@s]; SwapOut[@s];
firstTimeFontsIn ← FALSE;
ENDLOOP;
END;
-- Swap everything out before locking the file segments in core
SwapEverythingOut;
FOR i IN FontNumber DO
IF FD[i].name.length#0 THEN
BEGIN
IF FD[i].fsh.lock = 0 THEN SegmentDefs.SwapIn[FD[i].fsh]; -- Swap in and lock font segment
fsa ← SegmentDefs.AddressFromPage[FD[i].fsh.VMpage];
FD[i].height ← fsa.FHeader.MaxHeight;
FD[i].fnt ← @fsa.FCDptrs
END
ENDLOOP;
END;

firstTimeFontsIn: BOOLEAN ← TRUE;

--------------------------------------------------------------------
-- Scheduler code, copied from Sched.mesa
--------------------------------------------------------------------
-- all the blocks are chained around in a ring
slot: SchedDefs.SchedHandle; -- points to the currently active one
main: SchedDefs.SchedObject; -- one for the normal mesa "main" process

ScheduleeCreate: PUBLIC PROCEDURE [proc:PROCEDURE[UNSPECIFIED], arg: UNSPECIFIED] =
BEGIN OPEN ControlDefs, SchedDefs;
self: FrameHandle ← REGISTER[Lreg];
sched: SchedObject;
slot.returnlink ← self.returnlink;
self.returnlink ← [frame[NULLFrame]];
sched.next ← slot.next;
sched.previous ← slot;
slot.next.previous ← @sched;
slot.next ← @sched;
slot ← @sched;
proc[arg];
sched.previous.next ← sched.next;
sched.next.previous ← sched.previous;
slot ← sched.next;
self.returnlink ← slot.returnlink;
END;

Yield, ScheduleeYields: PUBLIC PROCEDURE =
BEGIN OPEN ControlDefs, SchedDefs;
self: FrameHandle ← REGISTER[Lreg];
slot.returnlink ← self.returnlink;
slot ← slot.next;
self.returnlink ← slot.returnlink;
END;

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

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

-- scheduler initialization
slot ← @main;
slot.next ← slot.previous ← slot;

-- cursor and graytone initialization

CursorIcons ← TeleSilProcDefs.GetCursorIcons[];
GrayToneCode ← TeleSilProcDefs.GetGrayToneCode[];

END.