UNIT TorInOut;

INTERFACE

Uses
{$IFDEF WIN32}
  Console,
{$ENDIF}
  TorMacro,
  OpCrt,
  tGlob,
  tMisc;

Const
  MinBufSize = 512;
  Macro1BeginSymbol = '$'; Macro1Length = 4;
  Macro2BeginSymbol = '\'; Macro2Length = 2;
  Macro3BeginSymbol = '%'; Macro3Length = 2;

  FNameSymbols: Set Of Char =
    ['0'..'9', ':', '-', '(', ')', '.', '_', '@'..'{', '}', '~', '#', '!', '%', '$', '&', ''''];

Type
  TInOutProc  = Procedure (Symbol: Byte);
  TSInOutProc = Procedure (S: String);
  TFileProc   = Procedure(FileNameStr: String);
  TExecProc   = Procedure (ExecNameStr: String);
  TRetColor   = Function (Attr : Byte): String;

  PBuffer = ^TBuffer;
  TBuffer = Array [0..65530] Of Byte;

  TMacroBufferB = Array [0..MaxMacroStringLength] Of Byte;
  TMacroBufferC = Array [0..MaxMacroStringLength] Of Char;
  TMacroBufferS = String [MaxMacroStringLength];

  PMacroBuffer = ^TMacroBuffer;
  TMacroBuffer = Record
    Case Integer Of
      1 : (B: TMacroBufferB);
      2 : (C: TMacroBufferC);
      3 : (S: TMacroBufferS);
  End;

  PTorInOut = ^TTorInOut;
  TTorInOut = Object
    MacroTable1                      : PMacrosTable;
    UseMacroTable1, UseMacroTable2,
    UseMacroTable3, EnableScreenOut,
    EnablePortOut, XLATenabled       : Boolean;
    OutPort, OutScreen               : TInOutProc;
    SOutPort, SOutScreen             : TSInOutProc;
    FileProc                         : TFileProc;
    ExecProc                         : TExecProc;
    RetColor                         : TRetColor;
    XLAT                             : tArr255;
    ioTextAttr                       : Byte;

    Constructor Init (OutPortProc, OutScreenProc : TInOutProc;
                SOutPortProc, SOutScreenProc : TSInOutProc;
                RetCol : TRetColor; LFileProc: TFileProc;
                LExecProc: TExecProc; Size: Word; XL: tArr255;
                XLATenable: Boolean; MT1 : PMacrosTable);

    Procedure OutON;
    Procedure OutOFF;

    Procedure StartBuffering;
    Procedure StopBuffering;
    Procedure Flush;
    Procedure OutByte (B: Byte); Virtual;
    Procedure OutString (S: String); Virtual;
    Procedure SetOutScreenProc (OutProc: TInOutProc);
    Procedure SetOutPortProc (OutProc: TInOutProc);
    Procedure SetFileProc (LFileProc: TFileProc);
    Procedure SetExecProc (LExecProc: TExecProc);
    Destructor Done;

    Private

    SizeOfBuffer, BufferPos   : Word;
    Buffer                    : PBuffer;
    MacroBuffer               : PMacroBuffer;
    ScanForX, BufferedOut,
    WasMacro1Begin,
    WasMacro2Begin,
    WasMacro3Begin,
    WasFileMacrosBegin,
    WasExecMacrosBegin,
    WasExecNameBegin,
    WasFileNameBegin          : Boolean;

    CurrentMacroStr,
    FileNameStr, ExecNameStr  : String;
    XNum, CurrentMacroLength  : Integer;
  End;

Implementation

Constructor TTorInOut. Init (OutPortProc, OutScreenProc : TInOutProc;
            SOutPortProc, SOutScreenProc : TSInOutProc; RetCol : TRetColor;
            LFileProc: TFileProc; LExecProc: TExecProc; Size: Word;
            XL: tArr255; XLATenable: Boolean; MT1 : PMacrosTable);

Begin
  EnableScreenOut := True;
  EnablePortOut := True;

  OutPort := OutPortProc;
  OutScreen := OutScreenProc;

  SOutPort := SOutPortProc;
  SOutScreen := SOutScreenProc;

  XLAT := XL;
  XLATenabled := XLATenable;

  FileProc := LFileProc;
  ExecProc := LExecProc;

  RetColor := RetCol;
  If Size < MinBufSize Then Size := MinBufSize;
  SizeOfBuffer := Size;
  GetMem (Buffer, SizeOfBuffer);
  BufferPos := 0;
  Dec (SizeOfBuffer);
  New (MacroBuffer);
  MacroBuffer^. B [0] := 0;
  StartBuffering;

  If MT1 = Nil Then MacroTable1 := New (PMacrosTable, Init (Nil)) Else MacroTable1 := MT1;

  UseMacroTable1 := True;
  UseMacroTable2 := True;
  UseMacroTable3 := True;

  WasMacro1Begin := False;
  WasMacro2Begin := False;
  WasMacro3Begin := False;

  WasFileMacrosBegin := False;
  WasFileNameBegin := False;

  WasExecMacrosBegin := False;
  WasExecNameBegin := False;

  ScanForX := False;
  XNum := 0;
  CurrentMacroStr := '';
  CurrentMacroLength := 0;
  ExecNameStr := '';
  ioTextAttr := TextAttr;
End;

Procedure TTorInOut. OutON;
Begin
  EnableScreenOut := True;
  EnablePortOut := True;
End;

Procedure TTorInOut. OutOFF;
Begin
  EnableScreenOut := False;
  EnablePortOut := False;
  MacroBuffer^. B [0]:=0;
  WasMacro1Begin := False;
  WasMacro2Begin := False;
  WasMacro3Begin := False;
  WasFileMacrosBegin := False;
  WasFileNameBegin := False;
  WasExecMacrosBegin := False;
  WasExecNameBegin := False;
End;

Procedure TTorInOut. StartBuffering;
Begin
  BufferedOut := True;
End;

Procedure TTorInOut. StopBuffering;
Begin
  Flush;
  BufferedOut := False;
End;

Procedure TTorInOut. Flush;
Var
  i, j      : Word;
  Tmp       : Boolean;
  S         : String;

Begin
  If BufferPos = 0 Then Exit;
  Tmp := BufferedOut;

  If ExecNameStr <> '' Then
  Begin
    BufferedOut := False;
    S := ExecNameStr;
    ExecNameStr := '';
    WasExecMacrosBegin := False;
    WasExecNameBegin := False;
    If Assigned (ExecProc) Then ExecProc (S);
  End;

  If FileNameStr <> '' Then
  Begin
    BufferedOut := False;
    S := FileNameStr;
    FileNameStr := '';
    WasFileMacrosBegin := False;
    WasFileNameBegin := False;
    If Assigned (FileProc) Then FileProc (S);
  End;

  BufferedOut := False;
  j := 1; S := '';

  For i := 0 To BufferPos-1 Do
  Begin
    If j > 255 Then
    Begin
      OutString (S);
      S := ''; j := 1;
    End;

    S := S + Chr (Buffer^ [i]);
    Inc (j);
  End;

  OutString (S);
  BufferedOut := Tmp;
  BufferPos := 0;
End;

Procedure TTorInOut. OutString (S: String);
Var
  P  : Byte;
  S1 : String;

Function Translate (S2: String; X: tArr255): String;
Var
  i : Byte;

Begin
  If XLATenabled Then
  For i := 1 To Length (S2) Do
    S2 [i] := X [Ord (S2 [i])];

  Translate := S2;
End;

Begin
  P := 1;

  While P <> 0 Do
  Begin
    If R. Emu <> teAvatar Then P := Pos (#1, S) Else P := 0;
    If P <> 0 Then
    Begin
      S1 := Copy (S, 1, P-1);
      S := Copy (S, P+1, 255);
    End Else
      S1 := S;

    If EnableScreenOut and Assigned (SOutScreen) Then SOutScreen (S1);
    If EnablePortOut and Assigned (SOutPort) Then SOutPort (Translate (S1, XLAT));

    If (P <> 0) And StopCodeEnable Then
    If (S1 [P-1] <> #22) and (S1 <> '') Then WaitReturn Else
    Begin
      If EnableScreenOut and Assigned (OutScreen) Then OutScreen (1);
      If EnablePortOut and Assigned (OutPort) Then OutPort (1);
    End;

  End;

End;

Procedure TTorInOut. OutByte (B: Byte);
Var
  Ch                            : Char Absolute B;
  i                             : {$IFNDEF OS2} Integer; {$ELSE} LongInt; {$ENDIF}
  Tmp                           : PElementOfMacrosTable;
  TmpBuf                        : TMacroBuffer;
  CurrentMacroStrL, TmpStr      : String;
  XNumL, CurrentMacroLengthL, j : Integer;
  TmpBufOut                     : Boolean;

Procedure BufOutByte (B:Byte);
Var
  i  : Byte;

Begin
  If BufferedOut Then
  Begin
    If BufferPos = SizeOfBuffer+1 Then
    Begin
      Flush;
      Buffer^ [BufferPos] := B;
      Inc (BufferPos);
    End Else
    Begin
      Buffer^ [BufferPos] := B;
      Inc (BufferPos);
    End;
  End Else
  Begin
    If (B = 1) And StopCodeEnable Then WaitReturn Else
    Begin
      If EnableScreenOut AND Assigned (OutScreen) Then OutScreen (B);
      B := Ord (XLAT [Ord (Ch)]);
      If EnablePortOut AND Assigned (OutPort) Then OutPort (B);
    End;
  End;
End;

Begin
  If NOT (EnableScreenOut OR EnablePortOut) Then Exit;

  If ScanForX Then
  Begin

    If R. Emu = teAvatar Then
    Begin
      If (XNum < 254) And (Ch = 'X') Then
      Begin
        Inc (XNum);
        Exit;
      End;

      If XNum = 255 Then
      If Ch = 'X' Then
      Begin
        XNum := 254;
        Exit;
      End Else
      Begin
        XNum := 0;
        BufOutByte (25);
        BufOutByte (Ord (Ch));
        Exit;
      End;

      If (Ch = #25) And (XNum = 0) Then
      Begin
        XNum := 255;
        Exit;
      End;

      If XNum = 254 Then
      Begin
        XNum := Ord (Ch);
        Exit;
      End;
    End Else
    If Ch='X' Then
    Begin
      Inc (XNum);
      Exit;
    End;

    If XNum <> 0 Then Inc (XNum);
    ScanForX:=False;
    XNumL:=XNum;
    CurrentMacroStrL:=CurrentMacroStr;
    CurrentMacroLengthL:=CurrentMacroLength;

    XNum:=0;
    CurrentMacroStr:='';
    CurrentMacroLength:=0;

    If XNumL=0 Then
    Begin
      For I:=1 To Length(CurrentMacroStrL) Do BufOutByte(Ord(CurrentMacroStrL[I]));
    End Else
    Begin
      XNumL:=XNumL+CurrentMacroLengthL;
      If Length(CurrentMacroStrL)>=XNumL Then
      Begin
        For I:=1 To XNumL Do BufOutByte(Ord(CurrentMacroStrL[I]));
      End Else
      Begin
        For I:=1 To Length(CurrentMacroStrL) Do BufOutByte(Ord(CurrentMacroStrL[I]));
        XNumL:=XNumL-Length(CurrentMacroStrL);
        For I:=1 To XNumL Do OutByte(Ord(' '));
      End;
    End;
  End;

  If WasFileNameBegin Then
  If Ch in FNameSymbols Then
  Begin
    FileNameStr:=FileNameStr+Ch;
    Exit;
  End Else
  Begin
    WasFileNameBegin:=False;
    If Assigned (FileProc) Then
    Begin
      TmpBufOut := BufferedOut;
      TmpStr := FileNameStr;
      FileNameStr := '';
      Flush;
      FileProc (TmpStr);
      BufferedOut := TmpBufOut;
    End;
    BufOutByte (Ord (Ch));
    Exit;
  End;

  If WasFileMacrosBegin Then
  If Ch=':' Then
  Begin
    WasFileNameBegin:=True;
    FileNameStr:='';
    WasFileMacrosBegin:=False;
    WasMacro1Begin:=False;
    MacroBuffer^.B[0]:=0;
    Exit;
  End Else
  Begin
    WasFileNameBegin:=False;
    WasFileMacrosBegin:=False;
    WasExecNameBegin:=False;
    WasExecMacrosBegin:=False;
    WasMacro1Begin:=False;
    MacroBuffer^.B[0]:=0;
    BufOutByte(Ord(Macro1BeginSymbol));
    BufOutByte(Ord('F'));
    BufOutByte(Ord('I'));
    BufOutByte(Ord('L'));
    BufOutByte(Ord('E'));
    OutByte(Ord(Ch));
    Exit;
  End;

  If WasExecNameBegin Then
{  If (Ch in FNameSymbols) And (ExecNameStr [Length(ExecNameStr)-3] <> '.') Then}
  If Ch in FNameSymbols Then
  Begin
    ExecNameStr := ExecNameStr + Ch;
    Exit;
  End Else
  Begin
    WasExecNameBegin := False;
    If Assigned (ExecProc) Then
    Begin
      TmpBufOut := BufferedOut;
      TmpStr := ExecNameStr;
      ExecNameStr := '';
      Flush;
      ExecProc (TmpStr);
      BufferedOut := TmpBufOut;
    End;

    BufOutByte (Ord (Ch));
    Exit;
  End;

  If WasExecMacrosBegin Then
  If Ch=':' Then
  Begin
    WasExecNameBegin:=True;
    ExecNameStr:='';
    WasExecMacrosBegin:=False;
    WasMacro1Begin:=False;
    MacroBuffer^.B[0]:=0;
    Exit;
  End Else
  Begin
    WasFileNameBegin := False;
    WasFileMacrosBegin := False;
    WasExecNameBegin := False;
    WasExecMacrosBegin := False;
    WasMacro1Begin := False;
    MacroBuffer^. B [0]:=0;
    BufOutByte (Ord (Macro1BeginSymbol));
    BufOutByte (Ord ('E'));
    BufOutByte (Ord ('X'));
    BufOutByte (Ord ('E'));
    BufOutByte (Ord ('C'));
    OutByte (Ord (Ch));
    Exit;
  End;

  If WasMacro1Begin AND (MacroBuffer^.B[0]<Macro1Length) Then
  Begin
    MacroBuffer^.S:=MacroBuffer^.S+Ch;

    If MacroBuffer^.S='FILE' Then
    Begin
      WasFileMacrosBegin:=True;
      WasMacro1Begin:=False;
      MacroBuffer^.B[0]:=0;
      Exit;
    End Else
    If MacroBuffer^.S='EXEC' Then
    Begin
      WasExecMacrosBegin:=True;
      WasMacro1Begin:=False;
      MacroBuffer^.B[0]:=0;
      Exit;
    End Else
    If MacroBuffer^.B[0]=Macro1Length Then
    Begin
      Tmp:=MacroTable1^.Table;

      While Tmp<>Nil Do
      Begin
        If MacroBuffer^.S=Tmp^.MacroName Then
        Begin
          ScanForX:=True;
          XNum:=0;
          CurrentMacroStr:=Tmp^.MacroStr;
          CurrentMacroLength:=Macro1Length;
          WasMacro1Begin:=False;
          MacroBuffer^.B[0]:=0;
          Exit;
        End;

        Tmp:=Tmp^.NextElement;
      End;

      BufOutByte(Ord(Macro1BeginSymbol));
      For I:=1 To Macro1Length Do TmpBuf.B[I]:=MacroBuffer^.B[I];
      WasMacro1Begin:=False;
      MacroBuffer^.B[0]:=0;
      For I:=1 To Macro1Length Do TTorInOut.OutByte(TmpBuf.B[I]);
    End;

    Exit;
  End;

  If WasMacro2Begin AND (MacroBuffer^.B[0] < Macro2Length) Then
  Begin
    MacroBuffer^.S:=MacroBuffer^.S+Ch;
    If MacroBuffer^.B[0] = Macro2Length Then
    Begin
      If ((MacroBuffer^.C[1]='0') AND (MacroBuffer^.C[2] In ['0'..'9'])) OR
         ((MacroBuffer^.C[1]='1') AND (MacroBuffer^.C[2] In ['0'..'5'])) Then
      Begin
        Val (MacroBuffer^. S, j, i);
        ioTextAttr := j + Hi4 (ioTextAttr) * 16;
        TmpStr := RetColor (ioTextAttr);
        WasMacro2Begin:=False;
        MacroBuffer^.B[0]:=0;
        For I:=1 To Length(TmpStr) Do BufOutByte(Ord(TmpStr[I]));
      End Else
      Begin
        BufOutByte(Ord(Macro2BeginSymbol));
        WasMacro2Begin:=False;
        MacroBuffer^.B[0]:=0;
        For I:=1 To Macro2Length Do TmpBuf.B[I]:=MacroBuffer^.B[I];
        For I:=1 To Macro2Length Do TTorInOut.OutByte(TmpBuf.B[I]);
      End;
    End;

    Exit;
  End;

  If WasMacro3Begin AND (MacroBuffer^.B[0] < Macro3Length) Then
  Begin
    MacroBuffer^.S:=MacroBuffer^.S+Ch;
    If MacroBuffer^.B[0] = Macro3Length Then
    Begin
      If ((MacroBuffer^.C[1]='0') AND (MacroBuffer^.C[2] In ['0'..'9'])) OR
         ((MacroBuffer^.C[1]='1') AND (MacroBuffer^.C[2] In ['0'..'5'])) Then
      Begin
        Val (MacroBuffer^. S, j, i);
        ioTextAttr := Lo4 (ioTextAttr) + j * 16;
        TmpStr := RetColor (ioTextAttr);
        WasMacro3Begin := False;
        MacroBuffer^. B [0] := 0;
        For i := 1 To Length (TmpStr) Do BufOutByte (Ord (TmpStr [i]));
      End Else
      Begin
        BufOutByte (Ord (Macro3BeginSymbol));
        WasMacro3Begin := False;
        MacroBuffer^. B [0] := 0;
        For i := 1 To Macro3Length Do TmpBuf. B [i] := MacroBuffer^. B [i];
        For i := 1 To Macro3Length Do TTorInOut. OutByte (TmpBuf. B [i]);
      End;
    End;

    Exit;
  End;

  If NOT (WasMacro1Begin OR WasMacro2Begin OR WasMacro3Begin) Then
  Begin
    If (Ch=Macro1BeginSymbol) AND UseMacroTable1 Then
    Begin
      WasMacro1Begin:=True;
      Exit
    End;

    If (Ch=Macro2BeginSymbol) AND UseMacroTable2 Then
    Begin
      WasMacro2Begin:=True;
      Exit
    End;

    If (Ch=Macro3BeginSymbol) AND UseMacroTable3 Then
    Begin
      WasMacro3Begin:=True;
      Exit
    End;
  End;

  BufOutByte(B);
End;

Procedure TTorInOut.SetOutScreenProc(OutProc:TInOutProc);
Begin
  OutScreen:=OutProc;
End;

Procedure TTorInOut.SetOutPortProc(OutProc:TInOutProc);
Begin
  OutPort:=OutProc;
End;

Procedure TTorInOut.SetFileProc(LFileProc: TFileProc);
Begin
  FileProc:=LFileProc;
End;

Procedure TTorInOut.SetExecProc(LExecProc: TExecProc);
Begin
  ExecProc:=LExecProc;
End;

Destructor TTorInOut.Done;
Begin
  Flush;
  FreeMem (Buffer, SizeOfBuffer);
  If MacroTable1 <> Nil Then Dispose (MacroTable1, Done);
  Dispose (MacroBuffer);
End;

End.
