-- N.Wirth  June 1, 1977
				-- S.Andler  August 24, 1977  10:45 PM
DIRECTORY
  FSPDefs: FROM "FSPDefs",
  IODefs: FROM "IODefs",
  InlineDefs: FROM "InlineDefs",
  PupDefs: FROM "PupDefs",
  SystemDefs: FROM "SystemDefs",
  SegmentDefs: FROM "SegmentDefs",
  StreamDefs: FROM "StreamDefs",
  StringDefs: FROM "StringDefs",
  TeleSilDefs: FROM "TeleSilDefs";

DEFINITIONS FROM
  StreamDefs,  -- StreamHandle, GetDefaultKey, endof, get
  SystemDefs,  -- AllocateHeapNode, AllocateHeapString, FreeHeapNode
  IODefs,  -- DEL, CR, ReadChar, Control?
  TeleSilDefs;

------------------------------------------------------------------

TeleSilMain: PROGRAM=
BEGIN
      -- A picture is represented by a single circular linked list.
      -- Each element represents either a line, an area, or a text
      -- string.  It is of type Object.  Rover is a pointer some
      -- element of the chain.  Objects are allocated from the heap.
      -- Unused objects are freed.

  -- External procedures --
    -- From TeleSilResident --
      CursorPosition: EXTERNAL PROCEDURE RETURNS[Coord];
      EraseRectangle: EXTERNAL PROCEDURE[z: Zone];
      InitDisplay: EXTERNAL PROCEDURE;
      Mark: EXTERNAL PROCEDURE[point: Coord, icon: CursorIcon];
      MouseEvent: EXTERNAL PROCEDURE[m: CARDINAL] RETURNS[CARDINAL];
      MouseValue: EXTERNAL PROCEDURE RETURNS[INTEGER];
      PaintRectangle: EXTERNAL PROCEDURE[f: CARDINAL, z: Zone, g: GrayTone];
      PaintString: EXTERNAL PROCEDURE[s:STRING, z: Zone, fno:CARDINAL]
        RETURNS [CARDINAL];
      SetCursorIcon: EXTERNAL PROCEDURE[icon: CursorIcon] RETURNS[oldIcon: CursorIcon];
      SetMousePosition: EXTERNAL PROCEDURE[point: Coord];
      SetGridSpacing: EXTERNAL PROCEDURE[gridSpacing: GridSpacing];
      ShrinkBM: EXTERNAL PROCEDURE;
    -- From TeleSilDisplay --
      BitMapDisplay: EXTERNAL PROCEDURE;
      ChangeFonts: EXTERNAL PROCEDURE;
      Confirm: EXTERNAL PROCEDURE RETURNS[BOOLEAN];
      DisplayTicks, EraseTicks: EXTERNAL PROCEDURE;
      Error: EXTERNAL PROCEDURE[s: STRING];
      FontHeight: EXTERNAL PROCEDURE[fontno: FontNumber] RETURNS[CARDINAL];
      FontLoaded: EXTERNAL PROCEDURE[n: CARDINAL] RETURNS[BOOLEAN];
      GetString: EXTERNAL PROCEDURE[s: STRING, fno: CARDINAL, ch: CHARACTER]
        RETURNS[CARDINAL, CARDINAL];
      TypeScriptWindow: EXTERNAL PROCEDURE;
    -- From TeleSilIO --
      Input: EXTERNAL PROCEDURE;
      HardCopy, Output: EXTERNAL PROCEDURE;
    -- From TeleSilPup --
      AllocateCmd: EXTERNAL PROCEDURE RETURNS[CmdPtr];
      CmdWaiting: EXTERNAL PROCEDURE RETURNS[BOOLEAN];
      Connect, Disconnect: EXTERNAL PROCEDURE;
      FreeCmd: EXTERNAL PROCEDURE[CmdPtr];
      Listen: EXTERNAL PROCEDURE;
      NextCmd: EXTERNAL PROCEDURE RETURNS[pCmd: CmdPtr];
      Refresh: EXTERNAL PROCEDURE;
      RequestControl: EXTERNAL PROCEDURE RETURNS[BOOLEAN];
      SendCmd: EXTERNAL PROCEDURE[pCmd: CmdPtr];
      Yield: EXTERNAL PROCEDURE;

  -- Global Variables --
    boxShade: GrayTone _ 2;
    centext: BOOLEAN _ TRUE;  -- center text
    pictureChanged: BOOLEAN _ FALSE; -- picture changed since last output
    rebuildNeeded: BOOLEAN _ FALSE; -- display might have "holes"
    etherOn: BOOLEAN _ FALSE;
    textFont: FontNumber _ 0;
    lineWidth: CARDINAL _ 2;
    new, old: Coord;  -- Cursor coordinates
    tickon: BOOLEAN _ TRUE;

  IsLetter: PROCEDURE[ch: CHARACTER] RETURNS[BOOLEAN]=
  BEGIN RETURN[ch IN ['a..'z] OR ch IN ['A..'Z]] END;

  UpperCase: PROCEDURE[ch: CHARACTER] RETURNS[CHARACTER]=
  BEGIN
    RETURN[IF ch IN ['a..'z]
      THEN LOOPHOLE[InlineDefs.BITAND[LOOPHOLE[ch], 337B]] ELSE ch]
  END;

------------------------------------------------------------------
-- STORAGE ALLOCATION
-- defines Rover, AllocateObject, FreeObject
  rover: ObjPtr _ NIL;  -- Pointer to current object in the circular list

  Rover: PUBLIC PROCEDURE RETURNS[POINTER TO ObjPtr]=
  BEGIN RETURN[@rover] END;

  AllocateObject: PUBLIC PROCEDURE[kind: ObjKind]=
  BEGIN
    previous: ObjPtr _ rover;
    rover _ SystemDefs.AllocateHeapNode[
      SELECT kind FROM
        line => SIZE[line Object],
        area => SIZE[area Object],
        text => SIZE[text Object],
      ENDCASE => SIZE[Object]];
    SELECT kind FROM
      line => rover^ _ Object[next: rover, zone:, state: dead, body: line[]];
      area => rover^ _ Object[next: rover, zone:, state: dead, body: area[]];
      text => rover^ _ Object[next: rover, zone:, state: dead, body: text[,]];
    ENDCASE;
    IF previous#NIL THEN
      BEGIN rover.next_previous.next; previous.next _ rover END;
    pictureChanged _ TRUE
  END;

  FreeObject: PUBLIC PROCEDURE[pObj: ObjPtr]=
  BEGIN
    WITH pObj SELECT FROM text =>
      SystemDefs.FreeHeapString[str];
    ENDCASE;
    SystemDefs.FreeHeapNode[pObj];
    pictureChanged _ TRUE
  END;

------------------------------------------------------------------
  MakeObject: PROCEDURE[kind: ObjKind, z: Zone]=
  BEGIN
    AllocateObject[kind];
    rover.state _ selected; rover.zone _ z
  END;

  Display: PROCEDURE[pObj: ObjPtr]=
  BEGIN z: Zone _ pObj.zone;
    SELECT pObj.state FROM
      dead => BEGIN EraseRectangle[z]; rebuildNeeded _ TRUE END;
      active => 
        WITH pObj SELECT FROM
          line => PaintRectangle[12, z, black];
          area => PaintRectangle[13, z, shade];
          text => [] _ PaintString[str, z, fontno];
        ENDCASE;
      selected =>
        WITH pObj SELECT FROM
          line => PaintRectangle[12, z, gray];
          area => PaintRectangle[13, z, shade];
          text =>
            BEGIN [] _ PaintString[str, z, fontno];
              PaintRectangle[13, z, 1]
            END;
        ENDCASE;
    ENDCASE 
  END;

  MakeLine: PROCEDURE=
  BEGIN  -- draw line from old to new
    w: INTEGER _ old.x - new.x;
    h: INTEGER _ old.y - new.y;
    IF ABS[w]<ABS[h] THEN
    BEGIN  -- line is vertical
      w _ lineWidth; new.x _ old.x;
      IF h<0 THEN  -- top down
        MakeObject[line, [old,w,-h]]
      ELSE  -- bottom up
        MakeObject[line, [[new.x, new.y+lineWidth],w,h]];
      new.x _ old.x
    END ELSE
    BEGIN  -- line is horizontal
      h _ lineWidth; new.y _ old.y;
      IF w<0 THEN  -- left to right
        MakeObject[line, [old,-w,h]]
      ELSE  -- right to left
        MakeObject[line, [[new.x+lineWidth, new.y],w,h]];
      new.y _ old.y
    END;
    Display[rover];
    SetMousePosition[new] -- indicate where we assumed the cursor to be
  END;

  MakeArea: PROCEDURE=
  BEGIN
    MakeObject[area, [[MIN[old.x, new.x], MIN[old.y, new.y]],
      ABS[new.x-old.x], ABS[new.y-old.y]]];
    WITH rover SELECT FROM area => shade _ boxShade; ENDCASE;
    Display[rover]
  END;

  MakeText: PROCEDURE[ch: CHARACTER]=
  BEGIN -- First character already in ch
    i, w, h: CARDINAL;
    header: STRING  _ [80];  -- buffer for text input
    pos: Coord;
    s: STRING;
    [w,h] _ GetString[header, textFont, ch]; rebuildNeeded _ TRUE;
    IF w > 0 THEN
    BEGIN ClearSelections;
      s _ AllocateHeapString[header.length];
      StringDefs.AppendString[s,header];
      pos _ CursorPosition[];
      IF centext THEN pos _ [pos.x - w/2, pos.y - h/2];
      MakeObject[text, Zone[pos, w, h]];
      WITH rover SELECT FROM text =>
        BEGIN fontno _ textFont; str _ s; END;
      ENDCASE;
      Display[rover]
    END
  END;

  MakeBox: PROCEDURE=
  BEGIN
    x0: CARDINAL _ MIN[old.x, new.x];
    y0: CARDINAL _ MIN[old.y, new.y];
    x1: CARDINAL _ MAX[old.x, new.x];
    y1: CARDINAL _ MAX[old.y, new.y];
    MakeObject[line, [[x0,y0], x1-x0, lineWidth]];
    Display[rover];
    MakeObject[line, [[x1,y0], lineWidth, y1-y0]];
    Display[rover];
    MakeObject[line, [[x0+lineWidth,y1], x1-x0, lineWidth]];
    Display[rover];
    MakeObject[line, [[x0,y0+lineWidth], lineWidth, y1-y0]];
    Display[rover];
  END;

  ClearSelections: PROCEDURE=
  BEGIN stop: ObjPtr _ rover;
    IF rover#NIL THEN DO
      IF rover.state=selected THEN
        BEGIN
          WITH rover SELECT FROM text =>
            BEGIN state _ dead; Display[rover] END;
          ENDCASE;
          rover.state _ active; Display[rover]
        END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP 
  END;

  NewPicture: PUBLIC PROCEDURE=
  BEGIN
    -- This routine relies on somebody else clearing the display
    stop: ObjPtr _ rover; nextObj: ObjPtr;
    IF rover#NIL THEN DO
        nextObj _ rover.next;
        FreeObject[rover];
        IF (rover _ nextObj)=stop THEN BEGIN rover _ NIL; EXIT END
      ENDLOOP;
    rebuildNeeded _ TRUE
  END;

  AddPicture: PROCEDURE=
  BEGIN
    pictureChanged _ TRUE;
    rebuildNeeded _ TRUE
  END;

  SelectObject: PROCEDURE=  -- the one at the cursor's position
  BEGIN stop: ObjPtr _ rover;
    selObj: ObjPtr _ NIL;
    z: Zone;
    p: CARDINAL _ maxCARDINAL;  -- perimeter
    x: INTEGER _ new.x;
    y: INTEGER _ new.y;
    IF rover#NIL THEN DO
      IF rover.state=active THEN
      BEGIN z _ rover.zone;
        IF (x IN [z.point.x .. z.point.x+LOOPHOLE[z.w,INTEGER]]) AND
            (y IN [z.point.y .. z.point.y+LOOPHOLE[z.h,INTEGER]]) AND
            (z.w+z.h<p)
        THEN BEGIN p _ z.w+z.h; selObj _ rover END
      END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP;
    IF selObj#NIL THEN BEGIN selObj.state _ selected; Display[selObj] END
  END;

  SelectZone: PROCEDURE=
  BEGIN stop: ObjPtr _ rover;
    x0: INTEGER _ MIN[old.x, new.x];
    y0: INTEGER _ MIN[old.y, new.y];
    x1: INTEGER _ MAX[old.x, new.x];
    y1: INTEGER _ MAX[old.y, new.y];
    z: Zone;
    IF rover#NIL THEN DO
      IF rover.state=active THEN
      BEGIN z _ rover.zone;
        IF (z.point.x IN [x0..x1])
          AND (z.point.x+LOOPHOLE[z.w,INTEGER] IN [x0..x1])
          AND (z.point.y IN [y0..y1])
          AND (z.point.y+LOOPHOLE[z.h,INTEGER] IN [y0..y1])
        THEN BEGIN rover.state _ selected; Display[rover] END
      END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP
  END;

  SelectEverything: PROCEDURE=
  BEGIN stop: ObjPtr _ rover;
    IF rover#NIL THEN DO
      IF rover.state=active THEN
      BEGIN rover.state _ selected; Display[rover] END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP
  END;

  MoveSelectedObjects: PROCEDURE=
  BEGIN stop: ObjPtr _ rover;
    dx: INTEGER _ new.x - old.x;
    dy: INTEGER _ new.y - old.y;
    IF rover#NIL THEN DO
      IF rover.state=selected THEN
      BEGIN rover.state _ dead; Display[rover];
        rover.zone.point.x _ rover.zone.point.x+dx;
        rover.zone.point.y _ rover.zone.point.y+dy;
        rover.state _ selected; Display[rover];
        pictureChanged _ TRUE
      END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP
  END;

  DeleteSelectedObjects: PROCEDURE=
  BEGIN
    stop: ObjPtr _ rover;
    pObj: ObjPtr;
    IF rover#NIL THEN DO
      pObj _ rover.next;
      IF pObj.state=selected THEN
        BEGIN pObj.state _ dead; Display[pObj];
          IF pObj=rover THEN rover _ NIL ELSE rover.next _ pObj.next;
          FreeObject[pObj]
        END
      ELSE rover _ pObj;
      IF pObj=stop THEN EXIT
    ENDLOOP
  END;

  CopySelectedObjects: PROCEDURE=
  BEGIN oldObj: ObjPtr; stop: ObjPtr _ rover;
    dx: INTEGER _ new.x - old.x;
    dy: INTEGER _ new.y - old.y;
    z: Zone;
    IF rover#NIL THEN DO
      IF rover.state=selected THEN
        BEGIN
          WITH rover SELECT FROM text =>
            BEGIN state _ dead; Display[rover] END;
          ENDCASE;
          rover.state _ marked
        END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP; 
    IF rover#NIL THEN DO
      IF rover.state=marked THEN
      BEGIN rover.state _ active; Display[rover];
        z _ rover.zone;
        z _ [[z.point.x + dx, z.point.y + dy], z.w, z.h];
        oldObj _ rover;
        WITH old: oldObj SELECT FROM
          line => MakeObject[line, z];
          area =>
            BEGIN
              MakeObject[area, z];
              WITH new: rover SELECT FROM
                area => new.shade _ old.shade;
              ENDCASE;
            END;
          text =>
            BEGIN
              MakeObject[text, z];
              WITH new: rover SELECT FROM text =>
                BEGIN new.fontno _ old.fontno;
                  new.str _ AllocateHeapString[old.str.length];
                  StringDefs.AppendString[new.str, old.str]
                END;
              ENDCASE;
            END;
        ENDCASE;
        Display[rover]
      END;
      IF (rover _ rover.next)=stop THEN EXIT
    ENDLOOP
  END;

  Rebuild: PUBLIC PROCEDURE=
  BEGIN
    counter: CARDINAL _ 0;
    stop: ObjPtr _ rover;
    oldIcon: CursorIcon _ SetCursorIcon[rebuild];
    IF rover#NIL THEN DO
      Display[rover];
      IF (rover _ rover.next)=stop OR (counter _ counter+1)=rebuildChunk THEN
      BEGIN
        IF MouseValue[]#0 OR NOT keys.endof[keys] THEN GOTO interrupt;
        IF etherOn THEN
        BEGIN
          Yield; -- let Pup Package do its thing
          IF CmdWaiting[] THEN GOTO interrupt
        END;
        IF rover=stop THEN EXIT;
        counter _ 0
      END
    REPEAT
      interrupt =>
        BEGIN
          [] _ SetCursorIcon[oldIcon];
          rebuildNeeded _ TRUE;
          RETURN
        END
    ENDLOOP;
    IF tickon THEN DisplayTicks;
    rebuildNeeded _ FALSE;
    [] _ SetCursorIcon[oldIcon]
  END;

  Ticks: PROCEDURE[newTick: BOOLEAN]=
  BEGIN
    IF newTick#tickon THEN
    BEGIN
      tickon _ newTick;
      IF tickon THEN DisplayTicks
      ELSE BEGIN EraseTicks; rebuildNeeded _ TRUE END
    END
  END;

  NextDigit: PROCEDURE [prompt: STRING, max: CARDINAL] RETURNS [CARDINAL]=
  BEGIN d: CARDINAL; ch: CHARACTER;
    headOrg: Coord= [32,16]; -- origin for text display
    strHeight: CARDINAL _ FontHeight[fontno: 0];
    strWidth: CARDINAL _ PaintString[prompt, [point: headOrg, w: BMBitsPerLine-headOrg.x, h: strHeight], 0];
    ch _ ReadChar[];
    EraseRectangle[[point: headOrg, w: strWidth, h: strHeight]];
    rebuildNeeded _ TRUE;
    d _ LOOPHOLE[ch, CARDINAL] - 60B; 
    IF d IN [0..max] THEN RETURN [d] ELSE  RETURN [0]
  END;

  MouseAction: PROCEDURE[mouseEvent: CARDINAL]=
  BEGIN
    SetMousePosition[new]; -- indicate mouseposition at entry to command
    SELECT mouseEvent FROM
      0=> -- Blue button -- -- select
        BEGIN ClearSelections;
          IF ABS[new.x-old.x]+ABS[new.y-old.y]>16 THEN SelectZone ELSE SelectObject
        END;
      1=> -- Blue button + LeftShift key -- -- multiple select
        IF ABS[new.x-old.x]+ABS[new.y-old.y]>16 THEN SelectZone ELSE SelectObject;
      2=> -- Blue button + Ctrl key -- NULL;
      3=> -- Blue button + LeftShift + Ctrl keys -- NULL;
      4=> -- Yellow button -- -- draw line
        BEGIN ClearSelections;
          IF new#old THEN MakeLine;
        END;
      5=> -- Yellow button + LeftShift key -- -- draw box
        BEGIN ClearSelections;
          IF new#old THEN MakeBox;
        END;
      6=> -- Yellow button + Ctrl key -- -- draw area
        BEGIN ClearSelections;
          IF new#old THEN MakeArea;
        END;
      7=> -- Yellow button + LeftShift + Ctrl keys -- NULL;
      8=> -- Red button -- -- move
        IF new#old THEN MoveSelectedObjects;
      9=> -- Red button + LeftShift key -- -- copy
        IF new#old THEN CopySelectedObjects;
      10=> -- Red button + Ctrl key -- NULL;
      11=> -- Red button + LeftShift + Ctrl keys -- NULL;
    ENDCASE;
  END;

  MouseCmd: PROCEDURE[mouseEvent: CARDINAL]=
  BEGIN cmd: CmdObj;
    MouseAction[mouseEvent];
    IF etherOn THEN
    BEGIN
      cmd _ [mouse[mouseEvent,old,new]];
      SendCmd[@cmd]
    END;
  END;

  KeyAction: PROCEDURE RETURNS[{goOn, quit}]=
  BEGIN
    ch: CHARACTER _ ReadChar[];
    [] _ SetCursorIcon[input];
    IF ch=DEL THEN BEGIN DeleteSelectedObjects; KeyCmd[DEL,0] END
    ELSE IF ch>'  THEN StringCmd[ch]
    ELSE
      SELECT ch FROM
ControlA=> -- ^Add file
        BEGIN TypeScriptWindow;
          WriteString["Add "];
          IF (IF pictureChanged THEN Confirm[] ELSE TRUE) THEN
          BEGIN AddPicture; Input;
            IF etherOn THEN Refresh
          END;
          BitMapDisplay
        END;
ControlC=> -- set ^Color
        BEGIN 
          boxShade _ NextDigit["Color", black];
          KeyCmd[ControlC,boxShade];
        END;
ControlD=> -- ^Debug
         SIGNAL Debug;
ControlE=> -- ^Ethernet action
        BEGIN TypeScriptWindow;
          WriteString["EtherNet command: Listen/Connect/Refresh/Disconnect: "];
          SELECT UpperCase[ReadChar[]] FROM
            'L => -- Listen
              BEGIN WriteLine["Listen"];
                IF etherOn THEN  Error["Already listening"] ELSE Listen
              END;
            'C => -- Connect
              BEGIN WriteLine["Connect"];
                IF etherOn THEN  Error["Disconnect first"] ELSE Connect
              END;
            'R => -- Refresh
              BEGIN WriteLine["Refresh"];
                IF NOT etherOn THEN  Error["No connections"]
                ELSE Refresh
              END;
            'D => -- Disconnect
              BEGIN WriteLine["Disconnect"];
                IF NOT etherOn THEN  Error["No connections"] ELSE Disconnect
              END;
          ENDCASE => WriteLine["XXX"];
          BitMapDisplay
        END;
ControlF=> -- set ^Font number
        BEGIN
          textFont _ NextDigit["Font number", LAST[FontNumber]];
          IF NOT FontLoaded[textFont] THEN textFont _ 0;
          KeyCmd[ControlF,textFont]
        END;
ControlG=> -- set ^Grid spacing
        BEGIN
          SetGridSpacing[gridSpacing _ NextDigit["Gridspacing", LAST[GridSpacing]]];
          KeyCmd[ControlG, gridSpacing];
        END;
ControlH=> -- ^Hardcopy
        BEGIN TypeScriptWindow;
          WriteLine["Hardcopy"]; HardCopy;
          BitMapDisplay
        END; 
ControlI=> -- ^Input file
        BEGIN TypeScriptWindow;
          WriteString["Input "];
          IF (IF pictureChanged THEN Confirm[] ELSE TRUE) THEN
          BEGIN NewPicture; Input;
            IF etherOn THEN Refresh
          END;
          BitMapDisplay
        END;
ControlO=> -- ^Output
        BEGIN TypeScriptWindow;
          WriteLine["Output"]; Output;
          pictureChanged _ FALSE;
          BitMapDisplay
        END;
ControlQ=> -- ^Quit
        BEGIN TypeScriptWindow;
          WriteString["Quit "];
          IF (IF pictureChanged THEN Confirm[] ELSE TRUE) THEN
          BEGIN
            IF etherOn THEN Disconnect;
            RETURN[quit]
          END;
          BitMapDisplay
        END;
ControlR=> -- ^Restart
        BEGIN TypeScriptWindow;
          WriteString["Restart "];
          IF (IF pictureChanged THEN Confirm[] ELSE TRUE) THEN
            BEGIN
              NewPicture;
              ChangeFonts;
              KeyCmd[ControlR,0]
            END;
          BitMapDisplay
        END;
ControlS=> -- ^Shrink bitmap
        BEGIN
          ShrinkBM;
          KeyCmd[ControlS,0]
        END;
ControlT=> -- on/off ^Ticks
        BEGIN
          Ticks[NOT tickon];
          KeyCmd[ControlT,tickon]
        END;
ControlW=> -- set line^Width
        BEGIN
          lineWidth _ NextDigit["line Width", 9];
          IF lineWidth=0 THEN lineWidth _ 16;
          KeyCmd[ControlW,lineWidth];
        END;
ControlX=> -- centered/not centered te^Xt
        BEGIN
          centext _ NOT centext;
          KeyCmd[ControlX,centext]
        END;
ControlY=> -- select ever^Ything
        BEGIN
          SelectEverything;
          KeyCmd[ControlY,0]
        END;
      ENDCASE;
    [] _ SetCursorIcon[arrow];
    RETURN[goOn]
  END;

  KeyCmd: PROCEDURE[ch: CHARACTER, word: UNSPECIFIED]=
  BEGIN cmd: CmdObj;
    IF etherOn THEN BEGIN
      cmd _ [keyboard[ch,word]];
      SendCmd[@cmd]
    END
  END;

  StringCmd: PROCEDURE[ch: CHARACTER]=
  BEGIN cmd: CmdObj; tmp: STRING;
    MakeText[ch];
    IF etherOn THEN BEGIN
      WITH rover SELECT FROM text =>
        BEGIN
          tmp _ AllocateHeapString[str.length];
          StringDefs.AppendString[tmp, str];
          cmd _ [text[zone, tmp]];
          SendCmd[@cmd]
        END;
      ENDCASE;
    END
  END;

  MarkCmd: PROCEDURE[point: Coord, icon: CursorIcon]=
  BEGIN cmd: CmdObj;
    Mark[point, icon];
    IF etherOn THEN BEGIN
      cmd _ [mark[point, icon]];
      SendCmd[@cmd]
    END
  END;

  CursorCmd: PROCEDURE[point: Coord]=
  BEGIN cmd: CmdObj;
    IF etherOn THEN BEGIN
      cmd _ [cursor[point]];
      SendCmd[@cmd]
    END
  END;

  SetCursorIconCmd: PROCEDURE[icon: CursorIcon] RETURNS[oldIcon: CursorIcon]=
  BEGIN cmd: CmdObj;
    oldIcon _ SetCursorIcon[icon];
    IF etherOn THEN BEGIN
      cmd _ [setCursorIcon[icon]];
      SendCmd[@cmd]
    END
  END;

  InputStatus: PUBLIC PROCEDURE[GetWord: PROCEDURE RETURNS[WORD]]=
  BEGIN
    boxShade _ GetWord[];
    textFont _ GetWord[];
    SetGridSpacing[gridSpacing _ GetWord[]];
    Ticks[LOOPHOLE[GetWord[]]];
    lineWidth _ GetWord[];
    centext _ LOOPHOLE[GetWord[]]
  END;

  OutputStatus: PUBLIC PROCEDURE[PutWord: PROCEDURE[word: WORD]]=
  BEGIN
    PutWord[boxShade];
    PutWord[textFont];
    PutWord[gridSpacing];
    PutWord[LOOPHOLE[tickon]];
    PutWord[lineWidth];
    PutWord[LOOPHOLE[centext]]
  END;

  ZoneChecking:  PROCEDURE RETURNS[BOOLEAN]=
  BEGIN
    z: FSPDefs.ZonePointer _ SystemDefs.HeapZone[];
    RETURN[z.checking _ NOT z.checking]
  END;

  SetEtherOn: PUBLIC PROCEDURE[newValue: BOOLEAN]=
  BEGIN etherOn _ newValue END;

--------------------------------------------------------------------
  -- Used at the end of the main program only
  StopMesa:  EXTERNAL PROCEDURE;
--------------------------------------------------------------------
  -- MAIN PROGRAM
  keys: StreamHandle;
  mouseValue, mouseEvent: CARDINAL;  -- mouse buttons
  pCmd: CmdPtr;
  gridSpacing: GridSpacing;
  tmp: Coord;
  Debug: SIGNAL= CODE;  -- Used to get to the debugger

  [] _ SetCursorIcon[arrow];
  SetGridSpacing[gridSpacing _ 3];
  keys _ GetDefaultKey[];
  IF zoneChecking THEN [] _ ZoneChecking[];
  InitDisplay;

--------------------------------------------------------------------
-- Surround the following loop with this enable-clause in TeleSilResident
-- ENABLE SegmentDefs.InsufficientVM => BEGIN ShrinkBM; RESUME END;
--------------------------------------------------------------------

  DO
    IF (mouseValue _ MouseValue[])#0 AND RequestControl[] THEN
    BEGIN -- Mouse Action!
      new _ old _ CursorPosition[];
      mouseEvent _ MouseEvent[mouseValue];
      CursorCmd[tmp _ old];
      IF mouseEvent=2 THEN [] _ SetCursorIconCmd[blackArrow]
      ELSE MarkCmd[old, greyArrow];
      WHILE MouseValue[]#0 DO -- Mouse button down
        IF etherOn THEN Yield; -- Let Pup Package do its thing
        new _ CursorPosition[];
        IF new#tmp THEN CursorCmd[tmp _ new]
      ENDLOOP;
      IF mouseEvent=2 THEN [] _ SetCursorIconCmd[arrow]
      ELSE BEGIN MarkCmd[old, greyArrow]; MouseCmd[MouseEvent[mouseValue]] END
    END;

    IF NOT keys.endof[keys] AND RequestControl[] THEN -- Keyboard Action!
      IF KeyAction[]=quit THEN EXIT;

    IF etherOn THEN
    BEGIN
      Yield; -- Let PUP Package do its thing

      WHILE CmdWaiting[] DO
        pCmd _ NextCmd[];
        IF pCmd#NIL THEN
        BEGIN
          WITH pCmd SELECT FROM
            mouse =>
              BEGIN old _ oldCoord; new _ newCoord;
                MouseAction[mouseEvent]
              END;
            keyboard =>
              SELECT char FROM
                DEL => DeleteSelectedObjects;
                ControlC => boxShade _ info;
                ControlF => textFont _ info;
                ControlG => SetGridSpacing[gridSpacing _ info];
                ControlR =>
                  BEGIN TypeScriptWindow;
                    Error["Restart not implemented"];
                    BitMapDisplay
                  END;
                ControlS => ShrinkBM;
                ControlT => Ticks[info];
                ControlW => lineWidth _ info;
                ControlX => centext _ info;
                ControlY => SelectEverything;
              ENDCASE;
            text => 
              BEGIN MakeObject[text, z];
                WITH rover SELECT FROM text =>
                  BEGIN fontno _ textFont; str _ s END;
                ENDCASE;
                Display[rover]
              END;
          ENDCASE;
          FreeCmd[pCmd];
          Yield; -- Let PUP Package do its thing - again
        END
      ENDLOOP
    END;

    IF rebuildNeeded THEN Rebuild
  ENDLOOP;

  StopMesa
END.
(2048)\399b12B2b13B2b5B2b3B19b16B2b18B2b12B15b3B2b2B2b8B2b8B85b11B387b14B43b14B37b11B28b4B60b10B59b10B45b14B63b11B88b13B75b16B42b14B54b8B58b13B28b11B28b7B45b24B28b5B39b10B66b10B58b9B105b16B53b5B28b8B2b6B50b15B40b14B41b11B1b11B24b11B32b10B28b7B46b11B24b18B45b7B42b5B425b8B102b9B371b5B78b14B669b10B265b10B124b7B669b8B752b8B218b8B640b7B487b15B357b10B335b10B83b12B665b10B623b16B224b19B477b21B382b19B1388b7B807b5B206b9B529b11B1314b8B195b9B3942b6B165b9B355b7B186b9B141b16B215b11B262b12B228b12B141b10B190b8B246b5B