-- N.Wirth June 1, 1977
-- S.Andler August 24, 1977 10:54 PM
-- C.Geschke August 31, 1977 11:39 AM
-- E.Satterthwaite September 9, 1977 8:58 AM
-- R.Johnsson September 18, 1977 9:22 PM
-- J.Sandman October 19, 1977 11:10 AM
DIRECTORY
AltoFileDefs: FROM "AltoFileDefs",
DirectoryDefs: FROM "DirectoryDefs",
IODefs: FROM "IODefs",
RectangleDefs: FROM "RectangleDefs",
SegmentDefs: FROM "SegmentDefs",
StringDefs: FROM "StringDefs",
TeleSilDefs: FROM "TeleSilDefs",
TeleSilProcDefs: FROM "TeleSilProcDefs";

--------------------------------------------------------------------
TeleSilDisplay: PROGRAM
IMPORTS
DirectoryDefs, SegmentDefs, StringDefs, IODefs,
TeleSilProcDefs
EXPORTS TeleSilProcDefs =
BEGIN
OPEN
TeleSilProcDefs,-- EraseRectangle, LockFonts, DefaultExtension
TeleSilDefs;

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

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

GetString: PUBLIC PROCEDURE[s: STRING, fno: FontNumber, ch: CHARACTER]
RETURNS[CARDINAL, CARDINAL]=
BEGIN -- returns width and height of displayed string
-- 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 [BOOLEAN]=
BEGIN OPEN IODefs; -- WriteString, WriteLine, CR
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 ← DirectoryDefs.DirectoryLookup[@fp, fname, FALSE];
IF old THEN
BEGIN
OPEN SegmentDefs; -- NewFileSegment, InsertFile, DefaultBase, DefaultPages, Read
ReleaseFont[n];
fh ← InsertFile[@fp, Read];
fonts[n].fsh ← NewFileSegment[fh, DefaultBase, DefaultPages, 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;
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
--------------------------------------------------------------------

fonts ← GetFonts[];

END.