Topspeed_JPI/TS-V3/SRC/SCRIPTPR.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  SCRIPTPR.MOD - COMMS Toolkit script processor                           *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE ScriptProcessor;
  IMPORT CommUtil,FIO,FTSupport,IO,Kermit,Lib,RS232,ScriptCompiler,Storage,
         Str,Term,Timer,Window,WXModem,XModem,YModem;

  CONST
    StackSize           = 40;

  TYPE
    StringPtr           = POINTER TO String80;

  VAR
    CPUFlag,
    KbdWait,WaitForever : BOOLEAN;
    IPC,SLnth,StackPtr  : CARDINAL;
    Stack               : ARRAY[0..StackSize-1] OF CARDINAL;
    SVar                : ARRAY[0..9] OF String80; (* Script Variables *)

(*.............................................*)

  PROCEDURE TerminateScript;
    VAR
      flag              : ScriptFlags;
    BEGIN
      IF ScriptState<>Off THEN
        ScriptState := Off;
        CommUtil.ScriptFile := '';
        CommUtil.StatusLine(CommUtil.script);
      END;
      WhenProcessing := FALSE;
      FOR flag:=Linked TO WaitFor DO
        Flags[flag] := FALSE;
      END;
    END TerminateScript;

(*.............................................*)

  PROCEDURE InitScriptProcessor;
    BEGIN
      TerminateScript;
    END InitScriptProcessor;

(*.............................................*)

  PROCEDURE LoadScript(Filename:ARRAY OF CHAR):BOOLEAN;
    BEGIN
      TerminateScript;
      Lib.Move(ADR(Filename),ADR(CommUtil.ScriptFile),81);
      IF ScriptCompiler.Compile(CommUtil.ScriptFile) THEN
        Lib.Fill(ADR(SVar),SIZE(SVar),0C);
        IPC := 0;
        StackPtr:=0;
        ScriptState := Running;
        CommUtil.StatusLine(CommUtil.script);
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END LoadScript;

(*.............................................*)

  PROCEDURE Push(w:CARDINAL);
    BEGIN
      IF StackPtr<StackSize THEN
        Stack[StackPtr] := w;
        INC(StackPtr)
      ELSE
        IO.WrStr('Script Error: GOSUB Stack Overflow!!');
        IO.WrLn;
        TerminateScript;
      END;
    END Push;

(*.............................................*)

  PROCEDURE Pop(VAR w:CARDINAL);
    BEGIN
      IF StackPtr>0 THEN
        DEC(StackPtr);
        w := Stack[StackPtr];
      ELSE
        IO.WrStr('Script Error: GOSUB Stack Underflow!!');
        IO.WrLn;
        TerminateScript;
      END;
    END Pop;

(*.............................................*)

  PROCEDURE IFetch(VAR op:SHORTCARD);
    BEGIN
      op := ScriptCompiler.CodeBuff^[IPC];
      INC(IPC);
    END IFetch;

(*.............................................*)

  PROCEDURE IFetchW(VAR op:CARDINAL);
    VAR
      lsb,msb           : SHORTCARD;
    BEGIN
      IFetch(lsb);
      IFetch(msb);
      op := CARDINAL(lsb)+CARDINAL(msb)*100H;
    END IFetchW;

(*.............................................*)

  PROCEDURE IFetchS(VAR p:StringPtr);
    VAR
      op                : SHORTCARD;
    BEGIN
      IFetch(op);
      IF op<>255 THEN
        p := ADR(SVar[CARDINAL(op)]);
        SLnth := Str.Length(p^);
      ELSE
        p := ADR(ScriptCompiler.CodeBuff^[IPC]);
        SLnth := Str.Length(p^);
        INC(IPC,SLnth+1);
      END;
    END IFetchS;

(*.............................................*)

  PROCEDURE SetSuccess(Setting:BOOLEAN);
    BEGIN
      Flags[Success] := Setting;
      Flags[Failure] := NOT Setting;
    END SetSuccess;

(*.............................................*)

  PROCEDURE Dos(CmdLine:ARRAY OF CHAR);
    BEGIN
      SetSuccess(FALSE);
    END Dos;

(*.............................................*)

  PROCEDURE Run(CmdLine:ARRAY OF CHAR);
    BEGIN
      SetSuccess(FALSE);
    END Run;

(*.............................................*)

  PROCEDURE ChangeEmulation(name:ARRAY OF CHAR);
    BEGIN
      Str.Caps(name);
      IF Str.Compare(name,'VT100')=0 THEN
        Term.EmulateVT100
      ELSIF Str.Compare(name,'VT52')=0 THEN
        Term.EmulateVT52
      ELSIF Str.Compare(name,'ANSI')=0 THEN
        Term.EmulateANSI
      END;
    END ChangeEmulation;

(*.............................................*)

  PROCEDURE RdStr(VAR s:ARRAY OF CHAR; Max:CARDINAL; Echo:BOOLEAN);
    VAR
      ch                : CHAR;
      ptr               : CARDINAL;
    BEGIN
      ptr:=0;
      REPEAT
        REPEAT
          ch := IO.RdKey();
        UNTIL (ch=CHR(13)) OR ((ch=CHR(8)) AND (ptr>0)) OR ((ch>=' ') AND (ch<=CHR(126)) AND (ptr<Max));
        IF ch=CHR(13) THEN
          CommUtil.WrChar(ch);
          CommUtil.WrChar(CHR(10))
        ELSIF ch=CHR(8) THEN
          CommUtil.WrChar(ch);
          CommUtil.WrChar(' ');
          CommUtil.WrChar(ch);
          DEC(ptr);
        ELSE
          IF Echo THEN
            CommUtil.WrChar(ch)
          ELSE
            CommUtil.WrChar('*');
          END;
          s[ptr]:=ch;
          INC(ptr);
        END;
      UNTIL ch=CHR(13);
      IF ptr<=HIGH(s) THEN
        s[ptr]:=0C;
      END;
    END RdStr;

(*....................................................*)

  PROCEDURE FileTransfer(Download:BOOLEAN;Protocol:CARDINAL;FileSpec:ARRAY OF CHAR);

(*. . . . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE ReceiveFile():BOOLEAN;
      BEGIN
        CASE Protocol OF
          0             : RETURN FALSE; (*Ascii - not allowed *)          |
          1             : RETURN Kermit.KermitReceive()=0;                |
          2             : RETURN XModem.XModemReceive(FileSpec)=0;        |
          3             : RETURN WXModem.WXModemReceive(FileSpec)=0;      |
          4             : RETURN YModem.YModemReceive(FileSpec)=0;        |
          5             : RETURN YModem.YModemBatchReceive()=0;           |
          6             : RETURN FALSE; (*Spare*)                         |
        END;
        RETURN TRUE
      END ReceiveFile;

(*. . . . . . . . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE SendFile():BOOLEAN;
      BEGIN
        CASE Protocol OF
          0             : RETURN FTSupport.ASCIISend(FileSpec)=0;         |
          1             : RETURN Kermit.KermitSend(FileSpec)=0;           |
          2             : RETURN XModem.XModemSend(FileSpec)=0;           |
          3             : RETURN WXModem.WXModemSend(FileSpec)=0;         |
          4             : RETURN YModem.YModemSend(FileSpec)=0;           |
          5             : RETURN YModem.YModemBatchSend(FileSpec)=0;      |
          6             : RETURN FALSE;                                   |
        END;
        RETURN TRUE
      END SendFile;

(*. . . . . . . . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* FileTransfer *)
      IF Download THEN
        SetSuccess(ReceiveFile());
      ELSE
        SetSuccess(SendFile());
      END;
    END FileTransfer;

(*....................................................*)

  PROCEDURE Value(VAR s:ARRAY OF CHAR):CARDINAL;
    VAR
      i,x               : CARDINAL;
      c                 : CHAR;
    BEGIN
      x := 0;
      FOR i:=0 TO HIGH(s) DO
        c := s[i];
        IF c=0C THEN
          RETURN x
        ELSIF (c>='0') AND (c<='9') THEN
          x := x*10+ORD(c)-48;
        END;
      END;
      RETURN x;
    END Value;

(*..............................................*)

  PROCEDURE Hangup;
    BEGIN
      RS232.UnInstall;
      Lib.Delay(500);
      RS232.Install;
      SetSuccess(TRUE);
      CommUtil.StatusLine(CommUtil.carrier);
    END Hangup;

(*..............................................*)

  PROCEDURE RFlush;
    VAR
      c                 : CHAR;
    BEGIN
      WHILE RS232.SerialRead(c,0) DO
        (* flush *)
      END;
    END RFlush;

(*..............................................*)

  PROCEDURE NextInstruction;
    VAR
      c                 : CHAR;
      op                : SHORTCARD;
      i,temp,opw        : CARDINAL;
      sp,sp2            : StringPtr;
    BEGIN
      Flags[Connected] := RS232.CarrierDetect();
      IFetch(op);
      CASE op OF
        0               : (*Alarm*)
                          IFetch(op);
                          temp := CARDINAL(op)*2;
                          WHILE temp>0 DO
                            CommUtil.WrChar(7C);
                            Lib.Delay(500);
                            DEC(temp);
                          END;                                            |
        1               : (*Assign*)
                          IFetch(op);
                          i:=CARDINAL(op);
                          IFetchS(sp);
                          Lib.Move(sp,ADR(SVar[i]),SLnth+1);              |
        3               : (* Unconditional Jump *)
                          IFetchW(opw);
                          IPC := opw;                                     |
        6               : (* Clear Screen using default colours *)
                          Term.ClearScreen;                               |
        7               : (* Clear Screen using new colours *)
                          IFetch(op);
                          Window.TextColor(Window.Color(op MOD 16));
                          Window.TextBackground(Window.Color(op DIV 16));
                          Term.ClearScreen;                               |
        8               : (* Run program via DOS command interpreter *)
                          IFetch(op);
                          KbdWait := (op=1);
                          IFetchS(sp);
                          Dos(sp^);                                       |
        9               : (* Message *)
                          IFetchS(sp);
                          i:=0;
                          WHILE i<SLnth DO
                            c := sp^[i];
                            IF c='|' THEN
                              CommUtil.WrChar(CHR(13));
                              c:=CHR(10);
                            END;
                            CommUtil.WrChar(c);
                            INC(i);
                          END;                                            |
        10              : (* Transmit string *)
                          IFetchS(sp);
                          Lib.Move(sp,ADR(TransmitString),SLnth+1);
                          TxPtr := 0;
                          ScriptState := Transmitting;                    |
        11              : (* WaitFor *)
                          IFetch(op);
                          IFetchS(sp);
                          Lib.Move(sp,ADR(WaitString),SLnth+1);
                          Timer.SetAppTimer(CARDINAL(op));
                          WaitForever := (op=0);
                          ScriptState := Waiting;                         |
        12..17          : (* Test a flag *)
                          CPUFlag := Flags[VAL(ScriptFlags,CARDINAL(op-12))];|
        18              : (* Jump if test was TRUE *)
                          IFetchW(opw);
                          IF CPUFlag THEN
                            IPC:=opw;
                          END;                                            |
        19              : (* Jump if test was FALSE *)
                          IFetchW(opw);
                          IF NOT CPUFlag THEN
                            IPC:=opw;
                          END;                                            |
        20              : (* EXIT - terminate script *)
                          TerminateScript;
                          IF ScriptCompiler.CodeBuff<>NIL THEN (* it shouldnt be!! *)
                            Storage.DEALLOCATE(ScriptCompiler.CodeBuff,ScriptCompiler.MaxCodeBytes);
                          END;                                            |
        21              : (* PAUSE *)
                          IFetch(op);
                          ScriptState := Pausing;
                          Timer.SetAppTimer(CARDINAL(op));                |
        22              : (* Emulate *)
                          IFetchS(sp);
                          ChangeEmulation(sp^);                           |
        23              : (* Execute script (chain) *)
                          IFetchS(sp);
                          IF LoadScript(sp^) THEN
                            IO.WrStr('Script Error: Script "');
                            IO.WrStr(sp^);
                            IO.WrStr('" not found.');
                            IO.WrLn;
                          END;                                            |
        24              : (* Find *)
                          IFetch(op);
                          IFetchS(sp);
                          i:=CARDINAL(op);
                          Str.Caps(SVar[i]);
                          Str.Caps(sp^);
                          Flags[Found] := (Str.Pos(SVar[i],sp^)<>0FFFFH); |
        25,26           : (* Get, MGet *)
                          temp := CARDINAL(op);
                          IFetch(op);
                          i:=CARDINAL(op);
                          IFetch(op);
                          SLnth:=CARDINAL(op);
                          RdStr(SVar[i],SLnth,(temp=25));                 |
        27,28           : (* GetFile, SendFile *)
                          temp := CARDINAL(op);
                          IFetch(op); i:=CARDINAL(op);
                          IFetchS(sp);
                          FileTransfer((temp=27),i,sp^);                  |
        29              : (* Gosub *)
                          IFetchW(opw);
                          Push(IPC);
                          IPC:=opw;                                       |
        30              : (* Goto *)
                          IFetchW(opw);
                          IPC:=opw;                                       |
        31              : (* Hangup *)
                          Hangup;                                         |
        32              : (* Return *)
                          Pop(IPC);                                       |
        33              : (* IsFile *)
                          IFetchS(sp);
                          SetSuccess(FIO.Exists(sp^));                    |
        34              : (* KFlush *)
                          WHILE IO.KeyPressed() DO
                            c:=IO.RdKey();
                          END;                                            |
        35              : (* Locate(row,col) *)
                          IFetch(op);
                          temp:=CARDINAL(op);
                          IFetch(op);
                          Window.GotoXY(CARDINAL(op)+1,temp+1);           |
        36              : (* Open Logfile *)
                          IFetchS(sp);
                          Lib.Move(sp,ADR(CommUtil.CaptureFile),SLnth+1);
                          IF CommUtil.CaptureFile[0]=0C THEN
                            CommUtil.CaptureFile:='ODYSSEY.LOG';
                          END;
                          CommUtil.SetLogMode(CommUtil.OpenLogging);
                          SetSuccess(FIO.IOresult()=0);
                          CommUtil.StatusLine(CommUtil.capture);          |
        37              : CommUtil.SetLogMode(CommUtil.CloseLogging);
                          CommUtil.StatusLine(CommUtil.capture);          |
        38              : CommUtil.SetLogMode(CommUtil.SuspendLogging);
                          CommUtil.StatusLine(CommUtil.capture);          |
        39              : CommUtil.SetLogMode(CommUtil.ResumeLogging);
                          CommUtil.StatusLine(CommUtil.capture);          |
        40              : (* Send Macro String *)
                          IFetch(op);
                          i:=CARDINAL(op);
                          CommUtil.TransmitMacro(i);                      |
        41              : IFetchS(sp);
                          i:=Value(sp^);
                          IF i<10 THEN
                            CommUtil.TransmitMacro(i);
                          END;                                            |
        42              : (* Load Macro File *)
                          IFetchS(sp);
                          (*ErrorMessage('Load Macro File command not supported!');*)|
        43              : CommUtil.Printer(TRUE);                         |
        44              : CommUtil.Printer(FALSE);                        |
        45              : (* Quit *)
                          Hangup;
                          Window.Clear;
                          HALT;                                           |
        46              : RFlush;                                         |
        47              : (* RGet *)
                          IFetch(op); IFetch(op); IFetch(op);             |
        48              : (* Run *)
                          IFetch(op);
                          KbdWait := (op=1);
                          IFetchS(sp);
                          Run(sp^);                                       |
        49,50,51        : (* Empty *);                                    |
        52              : (* CompareStr - used in SWITCH code *)
                          IFetch(op);
                          i:=CARDINAL(op);
                          IFetchS(sp);
                          Str.Caps(SVar[i]);
                          Str.Caps(sp^);
                          SetSuccess(Str.Compare(SVar[i],sp^)=0);         |
        53              : (* When *)
                          IFetchS(sp);
                          Lib.Move(sp,ADR(WhenString),SLnth+1);
                          IFetchS(sp);
                          Lib.Move(sp,ADR(WhenAction),SLnth+1);
                          WhenProcessing := TRUE;                         |
        54              : (* CWhen *)
                          WhenProcessing := FALSE;                        |
        55              : (* NOP *)                                       |
        56              : (* NOP *)                                       |
      ELSE
        IO.WrStr('Illegal Script Instruction!');
        IO.WrLn;
        TerminateScript;
      END; (* cases *)
    END NextInstruction;

(*.............................................*)

  PROCEDURE GetChar(VAR c:CHAR) : BOOLEAN;
    VAR
      res               : BOOLEAN;
    BEGIN
      res := TRUE;
      c := TransmitString[TxPtr];
      INC(TxPtr);
      IF c='^' THEN
        c := TransmitString[TxPtr];
        INC(TxPtr);
        IF (c>='@') AND (c<='_') THEN
          c := CHR(ORD(c)-64);
        END;
      ELSIF c='|' THEN
        c := CHR(13);
      ELSIF c='~' THEN
        Lib.Delay(500);
        res := FALSE;
      END;
      IF TransmitString[TxPtr]=0C THEN
        ScriptState := Running
      END;
      RETURN res;
    END GetChar;

(*.............................................*)

  PROCEDURE SingleStep;
    VAR
      c                 : CHAR;
    BEGIN
      CASE ScriptState OF
        Off             : RETURN;                                         |
        Running         : NextInstruction;                                |
        Transmitting    : IF GetChar(c) THEN
                            RS232.SerialWrite(c,1);
                            Lib.Delay(20);
                          END;                                            |
        Waiting         : IF (NOT WaitForever) AND Timer.AppTimerExpired() THEN
                            Flags[WaitFor] := FALSE;
                            ScriptState := Running;
                          END;                                            |
        Pausing         : IF Timer.AppTimerExpired() THEN
                            ScriptState := Running;
                          END;                                            |
        WaitSuccess     : Flags[WaitFor]:=TRUE;
                          ScriptState:=Running;                           |
      END; (* cases *)
      Timer.UpdateTimer;
    END SingleStep;

(*.............................................*)

  BEGIN
    ScriptState := Off;
  END ScriptProcessor.