-- 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.(1799)\625b14B153b43B185b2B39b5B48b9B203b2B2b2B2b3B2b3B2b8B1072b7B62b11B2b9B2b2B240b5B135b8B345b15B2b10B2b11B2b12B2b4B231b10B94b11B222b11B819b8B97b10B101b5B