-- JaMTypeScriptImpl.mesa
-- Last changed by Paxton, October 4, 1982 2:35 pm
-- Last Edited by: Stone, March 29, 1983 4:57 pm
-- Last Edited by: Pier, March 22, 1983 5:09 pm

DIRECTORY
  JaMBasic,
  JaMInternal,
  JaMOps,
  JaMTSFrame,
  JaMTSInfo,
  JaMTypeScript,
  JaMVM,
  StreamDefs,
  Atom USING [GetPropFromList, PutPropOnList],
  JaMStorage USING [Zone],
  FS USING [OpenFile, Open, Error],
  EditedStream USING [Rubout],
  Basics USING [LowHalf],
  Loader USING [Error, Instantiate, Start],
  PrincOps USING [ControlModule],
  Menus USING [Menu, CreateEntry, CreateMenu, InsertMenuEntry, MenuProc],
  Process USING [Abort, Detach],
  ProcessExtras USING [CheckForAborts],
  Rope USING [Concat, ROPE, Fetch, Flatten, Size, FromRefText, ToRope],
  Runtime USING [CallDebugger],
  IO USING [PutChar, GetLineRope, PutRope, STREAM],
  ViewerIO USING [CreateViewerStreams],
  ViewerClasses USING [Viewer],
  ViewerOps USING [DestroyViewer, OpenIcon, CreateViewer];

JaMTypeScriptImpl: PROGRAM
IMPORTS
  JaMOps, JaMTSFrame, JaMTSInfo, Loader,
  JaMStorage, Basics, Menus, Process, ProcessExtras, Rope, Runtime,
  ViewerOps, IO, ViewerIO, Atom, FS, EditedStream
EXPORTS
  JaMTypeScript, StreamDefs
= {
OPEN StreamDefs, JaMOps, JaMInternal, JaMBasic, JaMTypeScript;

z: UNCOUNTED ZONE = JaMStorage.Zone[];

version: STRING _ "JaM of 18-Jan-82";

prompt,start,badfile,badname,badversion: name Object;

dsObject: StreamObject _ [reset: DReset, get: DGet,
  putback: DPutback, put: DPut, endof: DEndof, destroy: DDestroy, data: NIL];
ds: StreamHandle _ @dsObject;

GetDefaultDisplayStream: PUBLIC PROC RETURNS[StreamHandle] = { RETURN[ds] };

GetTypeScript: PUBLIC PROC [frame: Frame] RETURNS [ViewerClasses.Viewer] = {
  RETURN [JaMTSFrame.GetTypeScript[frame]] };

DReset: PROC[StreamHandle] = { };
DGet: PROC[StreamHandle] RETURNS[CHARACTER] = { RETURN[0C] };
DPutback: PROC[StreamHandle,CHARACTER] = { };
DPut: PROC[s: StreamHandle, c: CHARACTER] = {
  tool: ViewerClasses.Viewer _ JaMTSFrame.GetTypeScript[defaultFrame];
  IF tool#NIL THEN {
      out: IO.STREAM _NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
      IO.PutChar[out,c]};
  };
DEndof: PROC[StreamHandle] RETURNS[BOOLEAN] = { RETURN[FALSE] };
DDestroy: PROC[StreamHandle] = { };

LReset: PROC[s: StreamHandle] = {
    data: LineInfo _ LOOPHOLE[s.data];
    data.index _ 0 };
LGet: PROC[s: StreamHandle] RETURNS[UNSPECIFIED] = {
    data: LineInfo _ LOOPHOLE[s.data];
    i: CARDINAL _ data.index;
    IF i<data.string.length THEN { data.index _ i + 1; RETURN[data.string[i]] }
    ELSE RETURN[0C] };
LPutback: PROC[s: StreamHandle, x: UNSPECIFIED] = {
    data: LineInfo _ LOOPHOLE[s.data];
    IF data.index>0 THEN data.index _ data.index - 1 };
LEndof: PROC[s: StreamHandle] RETURNS[BOOLEAN] = {
    data: LineInfo _ LOOPHOLE[s.data];
    RETURN[data.index>=data.string.length] };
LPut: PROC[s: StreamHandle, x: UNSPECIFIED] = { };
LDestroy: PROC[s: StreamHandle] = {
  data: LineInfo _ LOOPHOLE[s.data];
  IF ~data.destroy THEN RETURN;
  z.FREE[@data.string];
  z.FREE[@data];
  z.FREE[@s] };
LineInfo: TYPE = LONG POINTER TO LineInfoRec;
LineInfoRec: TYPE = RECORD [ string: LONG STRING, index: CARDINAL _ 0, destroy: BOOLEAN _ FALSE ];

FillStream: PROC [s: StreamHandle, rope: Rope.ROPE] = {
  size: CARDINAL _ LOOPHOLE[Basics.LowHalf[Rope.Size[rope]]];
  data: LineInfo _ LOOPHOLE[s.data];
  IF data.string.length < size THEN {
      z.FREE[@data.string];
    data.string _ z.NEW[StringBody[size]] };
  FOR i:CARDINAL IN [0..size) DO data.string[i] _ Rope.Fetch[rope,i]; ENDLOOP;
  data.string.length _ size;
  data.index _ 0 };

ReadLine: PROC[frame: Frame] = {
  info: LineInfo _ NIL;
  s: StreamHandle _ NIL;
  tool: ViewerClasses.Viewer _ JaMTSFrame.GetTypeScript[frame];
  rope: Rope.ROPE;
  in: IO.STREAM _NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
  out: IO.STREAM _NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
  IF tool # NIL THEN rope _ GetCompleteLine[tool,in,out];
  info _ z.NEW[LineInfoRec];
  info.string _ z.NEW[StringBody[LOOPHOLE[Inline.LowHalf[Rope.Size[rope]]]]];
  info.destroy _ TRUE; -- free the stream when done with it
  s _ z.NEW[StreamObject];
  s^ _ [reset: LReset, get: LGet, putback: LPutback,
    endof: LEndof, put: LPut, destroy: LDestroy, data: info];
  FillStream[s,rope];
  JaMOps.Push[frame.opstk,MakeStream[s,X]];
  };

QuitSignal: SIGNAL = CODE; -- for Quit to communicate with RunJaM
Quit: PROC[frame: Frame] = {
  SIGNAL QuitSignal;
  Stop[frame] };

JOpenTypescript: PROC[frame: Frame] = { -- expects name on stack
  name: string JaMBasic.Object _ PopString[frame.opstk];
  tool: ViewerClasses.Viewer _ JaMTSFrame.GetTypeScript[frame];
  IF tool=NIL THEN {
    text: STRING _ [64];
    StringText[name,text];
    tool _ InitTool[Rope.FromRefText[LOOPHOLE[LONG[text],REF READONLY TEXT]],frame].tool };
  ViewerOps.OpenIcon[tool] };

CallDebugger: PROC[frame: Frame] = {
  Runtime.CallDebugger["JaM executed .calldebugger"L];
  };

LoadBCD: PROC[frame: Frame] = { BCDLoader[frame,FALSE] };
-- Expects opstk: (bcdFileName)
-- Loads and STARTS the configuration in bcdFileName

DebugBCD: PROC[frame: Frame] = { BCDLoader[frame,TRUE] };
-- Expects opstk: (bcdFileName)
-- Like LoadBCD, but invokes the debugger before STARTing

BCDLoader: PROC[frame: Frame, debug: BOOLEAN] = {
  nameString: STRING _ [80];
  name: Rope.ROPE;
  ext: Rope.ROPE _ ".bcd";
  extended: BOOLEAN _ FALSE;
  file: FS.OpenFile;
  prog: PrincOps.ControlModule _ NIL;
  string: string Object _ PopString[frame.opstk];
  IF string.length>nameString.maxlength THEN GOTO BadName
  ELSE StringText[string,nameString];
  name _ Rope.ToRope[nameString];
  file _ FS.Open[name !
    FS.Error => IF error.group=user THEN
        IF extended THEN GOTO BadName
       ELSE { Rope.Concat[name,ext]; extended _ TRUE; RETRY }
      ELSE GOTO BadName];
  prog _ Loader.Instantiate[file: file !
    Loader.Error => SELECT type FROM
      versionMismatch => GOTO BadVersion;
      ENDCASE => GOTO BadFile;
    -- The following awful crock brought to you by the purveyors of CedarLoaderCore...
    Loader.Error => GOTO BadVersion];
  IF debug THEN {
    message: STRING _ [100];
    Append[message,"JaM: Just loaded "];
    Append[message,name];
    Runtime.CallDebugger[message];
    };
  Loader.Start[prog];
  EXITS
    BadFile => ERROR Error[badfile];
    BadName => ERROR Error[badname];
    BadVersion => ERROR Error[badversion];
  };

JPrint: PROC[frame: Frame] = {
  string: string Object _ PopString[frame.opstk];
  Proc: PROC[c: CHARACTER] RETURNS[BOOLEAN] = {
    abort: BOOLEAN _ GetAbort[frame];
    IF NOT abort THEN IO.PutChar[out,c];
    RETURN[abort] };
  tool: ViewerClasses.Viewer _ JaMTSFrame.GetTypeScript[frame];
  out,in: IO.STREAM;
  IF tool=NIL THEN RETURN;
  out _ NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
  in _ NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
  IF ProcessExtras.UserAbort[in] THEN SetAbort[frame,TRUE]
  ELSE StringForAll[string,Proc];
  };

NullName: PROC[frame: Frame] = {
  Push[frame.opstk,[L,name[id:[local:FALSE,index:0]]]]
  };

InstallJaMViewer: PROC[frame: Frame] = {
--    found: BOOLEAN;
    badfile _ MakeName[".badfile"L];
    badname _ MakeName[".badname"L];
    badversion _ MakeName[".badversion"L];
    prompt _ MakeName[".prompt"L];
    
    RegisterExplicit[frame,".userline"L,ReadLine];
    RegisterExplicit[frame,".print"L,JPrint];
    RegisterExplicit[frame,".loadbcd"L,LoadBCD];
    RegisterExplicit[frame,".debugbcd"L,DebugBCD];
    RegisterExplicit[frame,".calldebugger"L,CallDebugger];
    RegisterExplicit[frame,".quit"L,Quit];
    RegisterExplicit[frame,".nullname"L,NullName];
    RegisterExplicit[frame,".opentypescript"L,JOpenTypescript];

    Def[frame,prompt,MakeString["(*).print"L,X]];
    Def[frame,MakeName[".version"L],MakeString[version]];
 --   Def[frame, undefname, MakeString["(Undefined name - .undefname: ).print
--(                         ).cvis .print"L,X]];
--Assert:  .start is already defined by the time we get here
--    [found,] _ TryToLoad[frame,start];
--    IF NOT found THEN Def[frame,start,MakeString[".version .print (
--).print"L,X]];
  };

RunJaM: PROC [tool: ViewerClasses.Viewer, frame: Frame, tsi: JaMTSInfo.TSInfo] = {
  lineLoop: PROCESS _ NIL;
  quit: BOOLEAN _ FALSE;

  Process.Detach[lineLoop _ FORK LineLoop[tool,tsi]];
  tsi.state _ idle;
  UNTIL quit DO
    JaMTSInfo.WaitForSomethingToDo[tsi];
    Execute[frame, tsi.objectToDo ! 
      QuitSignal => { quit _ TRUE; RESUME }; -- signal raised by Quit
      ABORTED => CONTINUE];
    JaMTSInfo.NotifyReadyForMore[tsi];
    ENDLOOP;

  Process.Abort[lineLoop];
  DestroyTS[tool];
  };

DestroyTS: PROC [tool: ViewerClasses.Viewer] = {
  info: JaMTSInfo.TSInfo _ JaMTSFrame.GetTSInfo[tool];
  frame: Frame _ JaMTSFrame.GetFrame[tool];
  info.proc[frame];
  JaMTSFrame.Forget[tool];
  ViewerOps.DestroyViewer[tool];
  };

GetCompleteLine: PROC [tool: ViewerClasses.Viewer, in, out: IO.STREAM] RETURNS [line: Rope.ROPE _ NIL] = TRUSTED {
     DO -- continue until have a complete line
        IF tool.destroyed OR Process.CheckForAborts[in] THEN RETURN [NIL];
        line _ Rope.Concat[line,IO.GetLineRope[in !
          EditedStream.Rubout => {
            IO.PutRope[out, " XXX\n"];
            CONTINUE};
          ]];
        IF line=NIL THEN RETURN;
        IF JaMOps.LineComplete[LOOPHOLE[Rope.Flatten[line], LONG STRING]] THEN RETURN;
        line _ Rope.Concat[line,"\n"];
        ENDLOOP;
    };

LineLoop: PROC [tool: ViewerClasses.Viewer, tsi: JaMTSInfo.TSInfo] = {
  in: IO.STREAM _NARROW [Atom.GetPropFromList[tool.props,$JaMTSIn]];
  out: IO.STREAM _NARROW [Atom.GetPropFromList[tool.props,$JaMTSOut]];
  UNTIL tool.destroyed DO
    JaMTSInfo.Do[prompt,tsi];
    FillStream[tsi.lineStream,GetCompleteLine[tool, in, out]];
    IF tool.destroyed THEN EXIT;
    JaMTSInfo.Do[MakeStream[tsi.lineStream,X],tsi];
    ENDLOOP;
  };

mouseProc: MouseProc _ DefaultMouseProc;

DefaultMouseProc: PROC[frame: Frame, x,y: REAL] = {
  PushReal[frame.opstk, x];
  PushReal[frame.opstk, y];
  };

SetMouseProc: PUBLIC PROC[new: MouseProc] RETURNS[MouseProc] = {
  old: MouseProc _ mouseProc;
  mouseProc _ new; RETURN[old];
  };

DoAtom: PUBLIC PROC[tool: ViewerClasses.Viewer, atom: ATOM] = {
  frame: Frame _ JaMTSFrame.GetFrame[tool];
  tsi: JaMTSInfo.TSInfo _ JaMTSFrame.GetTSInfo[tool];
  JaMTSInfo.DoAtom[tsi,frame,atom] };

DoButton: PUBLIC PROC[tool: ViewerClasses.Viewer, atom: ATOM, x,y: REAL] = {
  frame: Frame _ JaMTSFrame.GetFrame[tool];
  tsi: JaMTSInfo.TSInfo _ JaMTSFrame.GetTSInfo[tool];
  JaMTSInfo.DoButton[tsi,frame,atom,x,y,mouseProc] };

-- Viewers stuff

InitTool: PUBLIC PROC [viewerName: Rope.ROPE, frame: Frame _ NIL, param: Rope.ROPE _ NIL, initFrame: BOOLEAN _ FALSE]
  RETURNS [tool: ViewerClasses.Viewer, already: BOOLEAN] = { OPEN Menus;
  toolMenu: Menus.Menu;
  in, out: IO.STREAM;
  tsi: JaMTSInfo.TSInfo;
  IF frame=NIL THEN frame _ defaultFrame;
  IF (tool _ JaMTSFrame.GetTypeScript[frame]) # NIL THEN { already _ TRUE; RETURN };
  already _ FALSE;
  toolMenu _ CreateMenu[];
  Menus.InsertMenuEntry[toolMenu, CreateEntry[name: "Interrupt", proc: InterruptButton]];
  Menus.InsertMenuEntry[toolMenu, CreateEntry[name: "Destroy", proc: DestroyButton]];
  tool _ ViewerOps.CreateViewer[flavor: $Typescript, info: [name: viewerName, iconic: FALSE, column: right]];
  tool.menu _ toolMenu;
  [in,out] _ ViewerIO.CreateViewerStreams[name: viewerName, viewer: tool];
  tsi _ JaMTSInfo.Create[];
  tool.props _ Atom.PutPropOnList[propList: tool.props, prop: $JaMTSIn, val: in];
  tool.props _ Atom.PutPropOnList[propList: tool.props, prop: $JaMTSOut, val: out];
  tsi.lineStream _ z.NEW[StreamObject _ [reset: LReset, get: LGet, putback: LPutback,
    endof: LEndof, put: LPut, destroy: LDestroy, data: NIL]];
  tsi.lineStream.data _ z.NEW[LineInfoRec _ [string: z.NEW[StringBody[200]], index: 0, destroy: FALSE]];
  tsi.proc _ NullProc;
  JaMTSFrame.Remember[tool,frame,tsi];
  IF initFrame THEN {
      Begin[frame, root.sysDict]; -- push the system dictionary
    Execute[frame, start !
            QuitSignal => RESUME;
            ABORTED => CONTINUE] };
  IF Rope.Size[param] > 0 THEN { -- do command line
      FillStream[tsi.lineStream,param];
    Execute[frame,MakeStream[tsi.lineStream,X] !ABORTED => CONTINUE] };
  Process.Detach[FORK RunJaM[tool,frame,tsi]] };

NullProc: PROC [Frame] = { };

NotifyBeforeDestroy: PUBLIC PROC [ts: ViewerClasses.Viewer, proc: PROC [JaMInternal.Frame]] = {
  -- before destroy ts, call proc with frame for ts as arg
  info: JaMTSInfo.TSInfo _ JaMTSFrame.GetTSInfo[ts];
  info.proc _ proc };

DestroyButton: Menus.MenuProc = TRUSTED { 
  DestroyTS[NARROW[parent]] };

InterruptButton: Menus.MenuProc = TRUSTED {
  frame: Frame _ JaMTSFrame.GetFrame[NARROW[parent]];
  IF frame#NIL THEN SetAbort[frame,TRUE];
  };

-- Initialization

Start: PROC = {
    start _ MakeName[".start"L];
    Execute[defaultFrame,start !
    QuitSignal => RESUME;
    ABORTED => CONTINUE];
    InstallJaMViewer[defaultFrame];
  };

Start; -- this starts the whole thing

}.