{$I M_OPS.PAS} Unit m_Term_Ansi; Interface Uses m_Output, m_io_Base, m_Strings; Type TTermAnsi = Class Screen : TOutput; WasValid : Boolean; Private Client : TIOBase; State : Byte; SavedX : Byte; SavedY : Byte; Options : String; Procedure CheckCode (Ch: Char); Function ParseNumber : Integer; Procedure ResetState; Procedure CursorUp; Procedure CursorMove; Procedure CursorDown; Procedure CursorRight; Procedure CursorLeft; Public Constructor Create (Var Con: TOutput); Destructor Destroy; Override; Procedure Process (Ch: Char); Procedure ProcessBuf (Var Buf; BufLen : Word); Procedure SetReplyClient (Var Cli: TIOBase); End; Implementation Const ColorTable : Array[30..47] of Byte = (0, 4, 2, 6, 1, 5, 3, 7, 0, 0, 0, 64, 32, 96, 16, 80, 48, 112); Constructor TTermAnsi.Create (Var Con: TOutput); Begin Inherited Create; Screen := Con; Client := NIL; WasValid := False; ResetState; End; Destructor TTermAnsi.Destroy; Begin Inherited Destroy; End; Procedure TTermAnsi.SetReplyClient (Var Cli: TIOBase); Begin Client := Cli; End; Function TTermAnsi.ParseNumber : Integer; Var Res : LongInt; Str : String; Begin Val (Options, Result, Res); If Res = 0 Then Options := '' Else Begin Str := Copy(Options, 1, Pred(Res)); Delete (Options, 1, Res); Val (Str, Result, Res); End; End; Procedure TTermAnsi.ResetState; Begin State := 0; Options := ''; End; Procedure TTermAnsi.CursorMove; Var X : Byte; Y : Byte; Begin Y := ParseNumber; If Y = 0 Then Y := 1; X := ParseNumber; If X = 0 Then X := 1; Screen.CursorXY (X, Y); ResetState; End; Procedure TTermAnsi.CursorUp; Var Y : Integer; NewY : Integer; Offset : Integer; Begin Offset := ParseNumber; If Offset = 0 Then Offset := 1; Y := Screen.CursorY; If (Y - Offset) < 1 Then NewY := 1 Else NewY := Y - Offset; Screen.CursorXY (Screen.CursorX, NewY); ResetState; End; Procedure TTermAnsi.CursorDown; Var NewY : Byte; Begin NewY := ParseNumber; If NewY = 0 Then NewY := 1; NewY := NewY + Screen.CursorY; Screen.CursorXY (Screen.CursorX, NewY); ResetState; End; Procedure TTermAnsi.CursorRight; Var X : Integer; Offset : Integer; Begin Offset := ParseNumber; If Offset = 0 Then Offset := 1; X := Screen.CursorX; If (X + Offset) > 80 Then Begin Screen.CursorXY (80, Screen.CursorY); //Screen.WriteChar(#10); // force lf incase we have to scroll //Screen.CursorXY(X + Offset - 80, Screen.CursorY); End Else Screen.CursorXY (x + offset, Screen.CursorY); ResetState; End; Procedure TTermAnsi.CursorLeft; Var X : Integer; NewX : Integer; Offset : Integer; Begin Offset := ParseNumber; If Offset = 0 Then offset := 1; X := Screen.CursorX; If (X - Offset) < 1 Then NewX := 1 Else NewX := X - Offset; Screen.CursorXY (NewX, Screen.CursorY); ResetState; End; Procedure TTermAnsi.CheckCode (Ch : Char); Var Temp : Byte; Begin Case Ch of 'h' : ResetState; '0'..'9', '?', ';' : Options := Options + Ch; 'H', 'f' : CursorMove; 'A' : CursorUp; 'B' : CursorDown; 'C' : CursorRight; 'D' : CursorLeft; 'J' : Begin Screen.ClearScreen; ResetState; End; 'K' : Begin Screen.ClearEOL; ResetState; End; 'm' : Begin If Length(Options) = 0 Then Begin Screen.TextAttr := 7; ResetState; End Else While Length(Options) > 0 Do Begin Temp := ParseNumber; Case Temp of 0 : Screen.TextAttr := 7; 1 : Screen.TextAttr := Screen.TextAttr OR $08; 5 : Screen.TextAttr := Screen.TextAttr OR $80; 7 : Begin Screen.TextAttr := Screen.TextAttr AND $F7; Screen.TextAttr := (((Screen.TextAttr AND $70) SHR 4) + ((Screen.TextAttr AND $7) SHL 4) + Screen.TextAttr AND $80); End; 30.. 37: Screen.TextAttr := (Screen.TextAttr AND $F8 + ColorTable[Temp]); 40.. 47: Screen.TextAttr := (Screen.TextAttr AND $F + ColorTable[Temp]); End; End; ResetState; End; 'n' : Begin If Client <> NIL Then Client.WriteStr(#27 + '[' + strI2S(Screen.CursorY) + ';' + strI2S(Screen.CursorX) + 'R'); ResetState; End; 's' : Begin SavedX := Screen.CursorX; SavedY := Screen.CursorY; ResetState; End; 'u' : Begin Screen.CursorXY (SavedX, SavedY); ResetState; End; Else ResetState; End; END; Procedure TTermAnsi.Process (Ch : Char); Begin WasValid := False; Case State of 0 : Begin Case Ch of #0 : ; #27 : State := 1; #9 : Screen.CursorXY (Screen.CursorX + 8, Screen.CursorY); #12 : Screen.ClearScreen; {$IFDEF UNIX} #14, #15 : Begin Screen.WriteChar('X'); State := 0; WasValid := True; End; {$ENDIF} Else Screen.WriteChar(Ch); State := 0; WasValid := True; End; End; 1 : If Ch = '[' Then Begin State := 2; Options := ''; End Else State := 0; 2 : CheckCode(Ch); Else ResetState; End; End; Procedure TTermAnsi.ProcessBuf (Var Buf; BufLen : Word); Var Count : Word; Data : Array[1..16384] of Char Absolute Buf; Begin For Count := 1 to BufLen Do Begin WasValid := False; Case State of 0 : Begin Case Data[Count] of #0 : ; #27 : State := 1; #9 : Screen.CursorXY (Screen.CursorX + 8, Screen.CursorY); #12 : Screen.ClearScreen; {$IFDEF UNIX} #14, #15 : Begin Screen.WriteChar('X'); State := 0; WasValid := True; End; {$ENDIF} Else Screen.WriteChar(Data[Count]); WasValid := True; State := 0; End; End; 1 : If Data[Count] = '[' Then Begin State := 2; Options := ''; End Else State := 0; 2 : CheckCode(Data[Count]); Else ResetState; End; End; Screen.BufFlush; End; End.