-- 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.
(2048)\420b14B86b15B130b14B37b9B99b16B305b9B208b2B2b2B2b3B2b3B2b8B1142b7B64b11B2b9B2b2B271b5B141b8B637b10B96b11B226b11B888b8B99b10B103b5B