-- File: ScriptParseInterface.mesa - last edit by:
-- Karlton,	19-Aug-82 18:43:28

DIRECTORY
  FormSW USING [
    AllocateItemDescriptor, ClientItemsProcType, CommandItem, newLine,
    ProcType, StringItem],
  Heap USING [Create, Delete, systemZone],
  Helvetica12 USING [],
  Helvetica12b USING [],
  Helvetica12i USING [],
  Helvetica12bi USING [],
  MStream USING [Error, ReadOnly, WriteOnly],
  Runtime USING [GetTableBase, GlobalFrame],
  Put USING [Char, LongDecimal, Line, Text],
  ScriptHash USING [Destroy, Handle],
  ScriptParse USING [Error, Externalize, Internalize, ShowTree],
  ScriptTree USING [Destroy, TreeHandle],
  Storage USING [CopyString, StringLength],
  Stream USING [Delete, Handle],
  Tool USING [Create, MakeFormSW, MakeMsgSW, MakeSWsProc],
  ToolWindow USING [TransitionProcType],
  UserTerminal USING [BlinkDisplay],
  Window USING [Handle],
  WindowFont USING [Handle, Initialize, Object];

ScriptParseInterface: PROGRAM
  IMPORTS
    FormSW, Heap, Helvetica12, Helvetica12b, Helvetica12i, Helvetica12bi,
    MStream, Put, Runtime, ScriptHash, ScriptParse, ScriptTree, Stream, Storage,
    Tool, UserTerminal, WindowFont =
  BEGIN

  -- TYPEs

  Fonts: TYPE = {normal, bold, italic, boldItalic};
  DataHandle: TYPE = LONG POINTER TO Data;
  Data: TYPE = RECORD [
    msgSW: Window.Handle _ NIL,
    formSW: Window.Handle _ NIL,
    hadFailure: BOOLEAN _ FALSE,
    input, output, debug: LONG STRING _ NIL,
    univ, id: ScriptHash.Handle _ NIL,
    tree: ScriptTree.TreeHandle _ NIL,
    z: UNCOUNTED ZONE _ NULL];

  fonts: ARRAY Fonts OF WindowFont.Object _ ALL[[address: NIL]];
  toolData: DataHandle _ NIL;
  wh: Window.Handle;  -- Tool's window

  GiveUp: ERROR = CODE;
  
  Failed: PROCEDURE [w: Window.Handle, s: LONG STRING, pos: LONG CARDINAL _ 0] = {
    IF pos # 0 THEN {Put.Char[w, '(]; Put.LongDecimal[w, pos]; Put.Text[w, ") "L]};
    Put.Line[w, s];
    UserTerminal.BlinkDisplay[];
    ERROR GiveUp};
    
  FreeTree: PROCEDURE [d: DataHandle] = {
    IF d.tree = NIL THEN RETURN;
    ScriptHash.Destroy[d.univ];
    ScriptHash.Destroy[d.id];
    ScriptTree.Destroy[d.tree];
    Heap.Delete[d.z];
    d.tree _ NIL};
    
  Command: FormSW.ProcType = {
    ENABLE GiveUp => CONTINUE;
    SELECT index FROM
      0 => Parse[toolData];
      2 => ShowTree[toolData];
      4 => Unparse[toolData];
      ENDCASE};
    
  GetStream: PROC [
    w: Window.Handle, name: LONG STRING, rw: {read, write}, prompt: STRING]
   RETURNS [s: Stream.Handle] = {
   Put.Text[w, prompt];
   IF Storage.StringLength[name] = 0 THEN Failed[w, "No file specified."L];
    Put.Text[w, name];
    s _ SELECT rw FROM
      read => MStream.ReadOnly[name, [] ! MStream.Error =>
        Failed[w, " can't be read."L]],
      write => MStream.WriteOnly[name, [], text ! MStream.Error =>
        Failed[w, " can't be written."L]],
      ENDCASE => ERROR GiveUp};
     
  Unparse: PROC [d: DataHandle] = {
    output: Stream.Handle;
    IF d.tree = NIL THEN Failed[d.msgSW, "No current tree."L];
    output _ GetStream[d.msgSW, d.output, write, "Externalizing: "L];
    ScriptParse.Externalize[output, d.univ, d.id, d.tree];
    Put.Line[toolData.msgSW, " ... done"L];
    output.Delete[]};

  ShowTree: PROC [d: DataHandle] = {
    output: Stream.Handle;
    IF d.tree = NIL THEN Failed[d.msgSW, "No current tree."L];
    output _ GetStream[d.msgSW, d.debug, write, "Showing Tree: "L];
    ScriptParse.ShowTree[output, d.univ, d.id, d.tree];
    Put.Line[toolData.msgSW, " ... done"L];
    output.Delete[]}; 

  Parse: PROC [d: DataHandle] = {
    input: Stream.Handle _ GetStream[d.msgSW, d.input, read, "Internalizing: "L];
    FreeTree[d];
    d.z _ Heap.Create[initial: 4];
    [d.univ, d.id, d.tree] _ ScriptParse.Internalize[input, d.z !
      ScriptParse.Error => Failed[toolData.msgSW, ": Parse failure"L, position];
      UNWIND => {Heap.Delete[d.z]; input.Delete[]}];
    Put.Line[toolData.msgSW, " ... done"L];
    input.Delete[]};
    
  ClientTransition: ToolWindow.TransitionProcType =
    BEGIN
    SELECT TRUE FROM
      old = inactive =>
	IF toolData = NIL THEN toolData _ Heap.systemZone.NEW[Data _ []];
      new = inactive =>
        IF toolData # NIL THEN {
	  FreeTree[toolData]; Heap.systemZone.FREE[@toolData]};
      ENDCASE;
    END;

  Init: PROCEDURE =
    BEGIN
    MakeFont[Helvetica12, @fonts[normal]];
    MakeFont[Helvetica12b, @fonts[bold]];
    MakeFont[Helvetica12i, @fonts[italic]];
    MakeFont[Helvetica12bi, @fonts[boldItalic]];
    wh _ Tool.Create[
      initialBox: [[0, 30], [350, 100]],
      makeSWsProc: MakeSWs, initialState: default,
      clientTransition: ClientTransition, name: "Interscript Tool"L,
      symbioteId: "ScriptParseTool"L, tinyName1: "Inter-"L, tinyName2: "script"L];
    END;

  MakeFont: PROCEDURE [program: UNSPECIFIED, f: WindowFont.Handle] = {
    f.address _ Runtime.GetTableBase[Runtime.GlobalFrame[program]];
    WindowFont.Initialize[f]};

  MakeForm: FormSW.ClientItemsProcType =
    BEGIN OPEN FormSW;
    -- This procedure creates a sample FormSW.
    nItems: CARDINAL = 6;
    items _ AllocateItemDescriptor[nItems];
    toolData.input _ Storage.CopyString["Sample.script"L];
    toolData.output _ Storage.CopyString["Canonical.script"L];
    toolData.debug _ Storage.CopyString["Sample.tree"L];
    items[0] _ CommandItem[tag: "Internalize"L, place: newLine, proc: Command];
    items[1] _ StringItem[tag: "File"L, string: @toolData.input, inHeap: TRUE];
    items[2] _ CommandItem[tag: "Show Tree"L, place: newLine, proc: Command];
    items[3] _ StringItem[tag: "File"L, string: @toolData.debug, inHeap: TRUE];
    items[4] _ CommandItem[tag: "Externalize"L, place: newLine, proc: Command];
    items[5] _ StringItem[tag: "File"L, string: @toolData.output, inHeap: TRUE];
    RETURN[items: items, freeDesc: TRUE];
    END;

  MakeSWs: Tool.MakeSWsProc =
    BEGIN
    logName: STRING _ [40];
    toolData.msgSW _ Tool.MakeMsgSW[window: window];
    toolData.formSW _ Tool.MakeFormSW[window: window, formProc: MakeForm];
    END;

  -- Mainline code

  Init[];  -- this gets string out of global frame

  END...