-- N.Wirth  June 1, 1977
				-- S.Andler  August 24, 1977  10:45 PM
				-- C.Geschke  August 26, 1977  3:54 PM
				-- E.Satterthwaite  September 12, 1977 3:35 PM
				-- R.Johnsson  September 19, 1977  9:16 AM
				-- J.Sandman  October 19, 1977  10:00 AM
				-- C.Geschke  October 20, 1977  9:14 AM
DIRECTORY
  FSPDefs: FROM "FSPDefs",
  ImageDefs: FROM "ImageDefs",
  InlineDefs: FROM "InlineDefs",
  IODefs: FROM "IODefs",
  RectangleDefs: FROM "RectangleDefs",
  StreamDefs: FROM "StreamDefs",
  StringDefs: FROM "StringDefs",
  SystemDefs: FROM "SystemDefs",
  TeleSilDefs: FROM "TeleSilDefs",
  TeleSilProcDefs: FROM "TeleSilProcDefs";

DEFINITIONS FROM
  StreamDefs,  -- StreamHandle, GetDefaultKey, endof, get
  SystemDefs,  -- AllocateHeapNode, AllocateHeapString, FreeHeapNode
  IODefs;  -- DEL, CR, StreamIO

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

TeleSilMain: PROGRAM 
  IMPORTS
    IODefs, StreamDefs, StringDefs, SystemDefs, TeleSilProcDefs
  EXPORTS TeleSilProcDefs =
BEGIN
OPEN
  TeleSilProcDefs,
  TeleSilDefs;

      -- 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 to some
      -- element of the chain.  Objects are allocated from the heap.
      -- Unused objects are freed.

-- 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: , zone:, state: , body: line[]];
    area => rover^ _ Object[next: , zone:, state: , body: area[]];
    text => rover^ _ Object[next: , zone:, state: , body: text[,]];
    ENDCASE;
  rover.state _ dead;
  IF previous = NIL THEN rover.next _ rover
  ELSE 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 old = new THEN RETURN;
  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
  IF old.x = new.x OR old.y = new.y THEN RETURN;
  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;

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];
  IF x0 = x1 OR y0 = y1 THEN RETURN;
  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= 
  BEGIN -- the one at the cursor's position
  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.point.x _ z.point.x + dx;
      z.point.y _ z.point.y + dy;
      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 _ keys.get[keys];
  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; MakeLine; END;
    5 => -- Yellow button + LeftShift key -- -- draw box
      BEGIN ClearSelections; MakeBox; END;
    6 => -- Yellow button + Ctrl key -- -- draw area
      BEGIN ClearSelections; 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 _ keys.get[keys];
  [] _ SetCursorIcon[input];
  IF ch=DEL OR ch=ControlD 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;
      034C => -- ^\ (Debug)
	 CallDebugger[];
      ControlE=> -- ^Ethernet action
	BEGIN
	TypeScriptWindow;
	WriteString["EtherNet command: Listen/Connect/Refresh/Disconnect: "];
	SELECT UpperCase[keys.get[keys]] 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;

CallDebugger: MACHINE CODE = INLINE[347B, 54B]; -- KFCB, sCallDebugger

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;
  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];
    IF etherOn THEN 
      BEGIN
      tmp _ AllocateHeapString[s.length];
      StringDefs.AppendString[tmp, s];
      cmd _ [text[Zone[pos, w, h], tmp]];
      SendCmd[@cmd]
      END
    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;

--------------------------------------------------------------------
  -- MAIN PROGRAM


keys: StreamHandle;
mouseValue, mouseEvent: CARDINAL;  -- mouse buttons
pCmd: CmdPtr;
gridSpacing: GridSpacing;
tmp: Coord;
typeScriptDCB: RectangleDefs.DCBptr;

typeScriptDCB _ MEMORY[420B];
MEMORY[420B] _ RectangleDefs.DCBnil; -- Make display come up white

[] _ 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 ENABLE IODefs.Rubout => RESUME;
  IF (mouseValue _ MouseValue[])#0 AND
      (IF etherOn THEN RequestControl[] ELSE TRUE) 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
    (IF etherOn THEN RequestControl[] ELSE TRUE) AND
    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
	      ClearSelections; 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;

ImageDefs.StopMesa[]
END.
(1799)\680b12B2b13B2b5B2b3B19b16B2b18B2b12B15b3B2b2B2b8B70b11B494b8B20b7B38b14B60b13B53b7B23b8B22b9B20b3B2b3B36b6B19b8B100b9B261b5B2b14B2b10B1b6B68b5B75b14B647b10B247b10B112b7B554b8B740b8B259b7B498b15B329b10B309b10B71b12B637b10B588b16B222b19B470b21B364b19B1175b7B711b5B198b9B518b11B1180b8B175b9B3163b12B60b6B147b9B786b7B166b9B123b16B195b11B248b12B214b12B135b10B161b4B16b10B2b10B30b4B10b11B15b3B9b13B