-- N.Wirth June 1, 1977
-- S.Andler August 24, 1977 10:54 PM
DIRECTORY
AltoFileDefs: FROM "AltoFileDefs",
IODefs: FROM "IODefs",
RectangleDefs: FROM "RectangleDefs",
SegmentDefs: FROM "SegmentDefs",
StringDefs: FROM "StringDefs",
SystemDefs: FROM "SystemDefs",
TeleSilDefs: FROM "TeleSilDefs";

DEFINITIONS FROM TeleSilDefs;

--------------------------------------------------------------------
TeleSilDisplay: PROGRAM=
BEGIN
-- External procedures --
-- From an unknown! package --
DirectoryLookup: EXTERNAL PROCEDURE
[POINTER TO AltoFileDefs.FP, STRING, BOOLEAN] RETURNS[BOOLEAN];
-- From TeleSilResident --
EraseRectangle: EXTERNAL PROCEDURE[z: Zone];
LockFonts: EXTERNAL PROCEDURE[pFD: POINTER TO ARRAY FontNumber OF FontDesc];
-- From TeleSilIO --
DefaultExtension: EXTERNAL PROCEDURE[fileName, extension: STRING];

--------------------------------------------------------------------
-- TEXT DISPLAY AND FONTS
-- defines GetString, Confirm, Error, FontLoaded, ChangeFonts, FontName

BM: RectangleDefs.BMptr; -- main BitMap
fonts: ARRAY FontNumber OF FontDesc;

GetString: PUBLIC PROCEDURE[s: STRING, fno: FontNumber, ch: CHARACTER]
RETURNS[CARDINAL, CARDINAL]=
-- returns width and height of displayed string
BEGIN -- first character already in ch
OPEN IODefs; --
BS, CR, DEL, ESC, ReadChar

headOrg: Coord= [32,16]; -- origin for text display
HeadBM: RectangleDefs.BMptr ← BM+((headOrg.y-1)*BMWordsPerLine+headOrg.x/16);
i,j,w,dw: CARDINAL ← 0;
dwa: RectangleDefs.BMptr ← HeadBM;
dba: [0..15] ← 15;
fnt: RectangleDefs.FAptr ← fonts[fno].fnt; -- current font
h: CARDINAL ← fonts[fno].height;
WHILE ch#CR AND ch#ESC DO
IF ch=DEL THEN
BEGIN -- delete entire string
EraseRectangle[Zone[headOrg, w, h]];
dwa ← HeadBM; dba ← 15; w ← i ← 0
END
ELSE IF ch >= ’ THEN
BEGIN s[i] ← ch; i ← i+1;
[dw, dba, dwa] ← RectangleDefs.CONVERT[ch, fnt, dwa, BMWordsPerLine, dba];
w ← w+dw
END
ELSE IF ch=BS AND i>0 THEN
BEGIN -- backspace by deleting and repainting
EraseRectangle[Zone[headOrg, w, h]];
dwa ← HeadBM; dba ← 15; w ← 0; i ← i-1;
FOR j IN [0..i) DO
[dw, dba, dwa] ← RectangleDefs.CONVERT[s[j], fnt, dwa, BMWordsPerLine, dba];
w ← w+dw
ENDLOOP
END;
ch ← ReadChar[]
ENDLOOP;
s.length ← i; EraseRectangle[Zone[headOrg, w, h]];
RETURN[w, h]
END;

Confirm: PUBLIC PROCEDURE RETURNS [b:BOOLEAN]=
BEGIN OPEN IODefs; --
WriteString, WriteLine, CR
ch: CHARACTER;
WriteString[" [confirm] "];
DO
SELECT ReadChar[] FROM
CR, ’Y, ’y => BEGIN WriteLine["yes"]; RETURN[TRUE] END;
DEL, ’N, ’n => BEGIN WriteLine["no"]; RETURN[FALSE] END;
ENDCASE => WriteChar[’?];
ENDLOOP
END;

Error: PUBLIC PROCEDURE[s: STRING]=
BEGIN OPEN IODefs;
IF NOT NewLine[] THEN WriteChar[CR];
WriteString["*** "]; WriteLine[s]
END;

LoadFont: PROCEDURE[n: FontNumber, fname: STRING] RETURNS[BOOLEAN]=
BEGIN -- delete old (if any) and fetch new font
-- returns TRUE if new font was loaded, FALSE otherwise
old: BOOLEAN;
fh: SegmentDefs.FileHandle;
fp: AltoFileDefs.FP;

old ← DirectoryLookup[@fp, fname, FALSE];
IF old THEN
BEGIN
ReleaseFont[n];
fh ← SegmentDefs.InsertFile[@fp, SegmentDefs.Read];
fonts[n].fsh ← SegmentDefs.NewFileSegment[fh, SegmentDefs.DefaultBase, SegmentDefs.DefaultPages, SegmentDefs.Read];
StringDefs.AppendString[fonts[n].name, fname];
RETURN[TRUE]
END
ELSE RETURN[FALSE]
END;

FontLoaded: PUBLIC PROCEDURE[n: FontNumber] RETURNS[BOOLEAN]=
BEGIN RETURN[fonts[n].fnt # NIL] END ;

ReleaseFont: PROCEDURE[n: FontNumber]=
BEGIN
IF FontLoaded[n] THEN
BEGIN SegmentDefs.Unlock[fonts[n].fsh];
fonts[n].fnt ← NIL; fonts[n].name.length ← 0;
SegmentDefs.DeleteFileSegment[fonts[n].fsh]
END
END;

ChangeFonts: PUBLIC PROCEDURE=
BEGIN OPEN IODefs, StringDefs;
i: FontNumber ← 0;
ch: CHARACTER;
header: STRING ← [40];
FOR i IN (FIRST[FontNumber]..LAST[FontNumber]] DO
DO -- until a font has been loaded in slot i, or the user gives up
WriteString["Font "]; WriteDecimal[i]; WriteString[": "];
header.length ← 0; AppendString[header, fonts[i].name];
ReadID[header];
IF header.length=0 THEN BEGIN ReleaseFont[i]; WriteLine[" Released"]; EXIT END;
DefaultExtension[header,"al"];
IF EquivalentString[header, fonts[i].name] THEN
BEGIN WriteLine[" Unchanged"]; EXIT END;
IF LoadFont[i, header] THEN
BEGIN WriteLine[" Loaded"]; EXIT END;
Error["Font not found"]
ENDLOOP;
ENDLOOP;
WriteLine["Locking fonts in low core"];
LockFonts[@fonts];
WriteLine["Fonts locked"]
END;

FontName: PUBLIC PROCEDURE[fontno: FontNumber] RETURNS[STRING]=
BEGIN RETURN[fonts[fontno].name] END;

FontHeight: PUBLIC PROCEDURE[fontno: FontNumber] RETURNS[CARDINAL]=
BEGIN RETURN[fonts[fontno].height] END;

SetBM: PUBLIC PROCEDURE[newBM: RectangleDefs.BMptr]=
BEGIN BM ← newBM END;

--------------------------------------------------------------------
-- Initialization of fonts
--------------------------------------------------------------------
i: FontNumber;
DefaultFontName: ARRAY FontNumber OF STRING=
["helvetica10.al", "helvetica8.al", "helvetica12.al", "gates32.al"];

FOR i IN FontNumber DO
fonts[i].fnt ← NIL;
fonts[i].name ← SystemDefs.AllocateHeapString[40];
IF NOT LoadFont[i, DefaultFontName[i]] THEN ERROR
ENDLOOP;
LockFonts[@fonts]
END.