БЭМЗ полищук доки / Comp / sources / CPortEsc

(******************************************************
* ComPort Library ver. 3.0 *
* for Delphi 3, 4, 5, 6, 7 and *
* C++ Builder 3, 4, 5, 6 *
* written by Dejan Crnila, 1998 - 2002 *
* maintained by Lars B. Dybdahl, 2003 *
* Homepage: http://comport.sf.net/ *
*****************************************************)

unit CPortEsc;

interface

uses
Classes;

type
// terminal charachter result
TEscapeResult = (erChar, erCode, erNothing);
// terminal escape codes
TEscapeCode = (ecUnknown, ecNotCompleted, ecCursorUp, ecCursorDown,
ecCursorLeft, ecCursorRight, ecCursorHome, ecCursorMove, ecReverseLineFeed,
ecAppCursorLeft, ecAppCursorRight, ecAppCursorUp, ecAppCursorDown,
ecEraseLineFrom, ecEraseScreenFrom, ecEraseLine, ecEraseScreen,
ecSetTab, ecClearTab, ecClearAllTabs,
ecIdentify, ecIdentResponse, ecQueryDevice, ecReportDeviceOK,
ecReportDeviceFailure, ecQueryCursorPos, ecReportCursorPos,
ecAttributes, ecSetMode, ecResetMode, ecReset,
ecSaveCaretAndAttr, ecRestoreCaretAndAttr, ecSaveCaret, ecRestoreCaret,
ecTest);

// terminal escape codes processor
TEscapeCodes = class
private
FCharachter: Char;
FCode: TEscapeCode;
FData: string;
FParams: TStrings;
public
constructor Create;
destructor Destroy; override;
function ProcessChar(Ch: Char): TEscapeResult; virtual; abstract;
function EscCodeToStr(Code: TEscapeCode; AParams: TStrings): string; virtual; abstract;
function GetParam(Num: Integer; AParams: TStrings): Integer;
property Data: string read FData;
property Code: TEscapeCode read FCode;
property Charachter: Char read FCharachter;
property Params: TStrings read FParams;
end;

// VT52 escape codes
TEscapeCodesVT52 = class(TEscapeCodes)
private
FInSequence: Boolean;
function DetectCode(Str: string): TEscapeCode;
public
function ProcessChar(Ch: Char): TEscapeResult; override;
function EscCodeToStr(Code: TEscapeCode; AParams: TStrings): string; override;
end;

// ANSI/VT100 escape codes
TEscapeCodesVT100 = class(TEscapeCodes)
private
FInSequence: Boolean;
FInExtSequence: Boolean;
function DetectCode(Str: string): TEscapeCode;
function DetectExtCode(Str: string): TEscapeCode;
public
function ProcessChar(Ch: Char): TEscapeResult; override;
function EscCodeToStr(Code: TEscapeCode; AParams: TStrings): string; override;
end;

implementation

uses
SysUtils;

(*****************************************
* TEscapeCodes class *
*****************************************)

constructor TEscapeCodes.Create;
begin
inherited Create;
FParams := TStringList.Create;
end;

destructor TEscapeCodes.Destroy;
begin
FParams.Free;
inherited Destroy;
end;

function TEscapeCodes.GetParam(Num: Integer; AParams: TStrings): Integer;
begin
if (AParams = nil) or (AParams.Count < Num) then
Result := 1
else
try
Result := StrToInt(AParams[Num - 1]);
except
Result := 1;
end;
end;

(*****************************************
* TEscapeCodesVT52 class *
*****************************************)

// process charachter
function TEscapeCodesVT52.ProcessChar(Ch: Char): TEscapeResult;
var
TempCode: TEscapeCode;
begin
Result := erNothing;
if not FInSequence then
begin
if Ch = #27 then
begin
FData := '';
FInSequence := True;
end
else begin
FCharachter := Ch;
Result := erChar;
end;
end else
begin
FData := FData + Ch;
TempCode := DetectCode(FData);
if TempCode <> ecNotCompleted then
begin
FCode := TempCode;
FInSequence := False;
Result := erCode;
end;
end;
end;

// escape code to string
function TEscapeCodesVT52.EscCodeToStr(Code: TEscapeCode; AParams: TStrings): string;
begin
case Code of
ecCursorUp: Result := #27'A';
ecCursorDown: Result := #27'B';
ecCursorRight: Result := #27'C';
ecCursorLeft: Result := #27'D';
ecCursorHome: Result := #27'H';
ecReverseLineFeed: Result := #27'I';
ecEraseScreenFrom: Result := #27'J';
ecEraseLineFrom: Result := #27'K';
ecIdentify: Result := #27'Z';
ecIdentResponse: Result := #27'/Z';
ecCursorMove: Result := #27'Y' +
Chr(GetParam(1, AParams) + 31) + Chr(GetParam(2, AParams) + 31);
else
Result := '';
end;
end;

// get escape code from string
function TEscapeCodesVT52.DetectCode(Str: string): TEscapeCode;
begin
Result := ecUnknown;
case Str[1] of
'A': Result := ecCursorUp;
'B': Result := ecCursorDown;
'C': Result := ecCursorRight;
'D': Result := ecCursorLeft;
'H': Result := ecCursorHome;
'I': Result := ecReverseLineFeed;
'J': Result := ecEraseScreenFrom;
'K': Result := ecEraseLineFrom;
'Z': Result := ecIdentify;
'/': begin
if Length(Str) = 1 then
Result := ecNotCompleted
else
if (Length(Str) = 2) and (Str = '/Z') then
Result := ecIdentResponse;
end;
'Y': begin
if Length(Str) < 3 then
Result := ecNotCompleted
else
begin
Result := ecCursorMove;
FParams.Add(IntToStr(Ord(Str[3]) - 31));
FParams.Add(IntToStr(Ord(Str[2]) - 31));
end;
end;
end;
end;

(*****************************************
* TEscapeCodesVT100class *
*****************************************)

// process charachter
function TEscapeCodesVT100.ProcessChar(Ch: Char): TEscapeResult;
var
TempCode: TEscapeCode;
begin
Result := erNothing;
if not FInSequence then
begin
if Ch = #27 then
begin
FData := '';
FInSequence := True;
end
else begin
FCharachter := Ch;
Result := erChar;
end;
end else
begin
FData := FData + Ch;
TempCode := ecNotCompleted;
if FInExtSequence then
TempCode := DetectExtCode(FData)
else
// charachter [ after ESC defines extended escape code
if FData[1] = '[' then
FInExtSequence := True
else
TempCode := DetectCode(FData);
if TempCode <> ecNotCompleted then
begin
FCode := TempCode;
FInSequence := False;
FInExtSequence := False;
Result := erCode;
end;
end;
end;

// escape code to string conversion
function TEscapeCodesVT100.EscCodeToStr(Code: TEscapeCode;
AParams: TStrings): string;
begin
case Code of
ecIdentify: Result := #27'[c';
ecIdentResponse: Result := Format(#27'[?1;%dc', [GetParam(1, AParams)]);
ecQueryCursorPos: Result := #27'[6n';
ecReportCursorPos: Result := Format(#27'[%d;%dR', [GetParam(1, AParams), GetParam(2, AParams)]);
ecQueryDevice: Result := #27'[5n';
ecReportDeviceOK: Result := #27'[0n';
ecReportDeviceFailure: Result := #27'[3n';
ecCursorUp: Result := #27'[A';
ecCursorDown: Result := #27'[B';
ecCursorRight: Result := #27'[C';
ecAppCursorLeft: Result := #27'OD';
ecAppCursorUp: Result := #27'OA';
ecAppCursorDown: Result := #27'OB';
ecAppCursorRight: Result := #27'OC';
ecCursorLeft: Result := #27'[D';
ecCursorHome: Result := #27'[H';
ecCursorMove: Result := Format(#27'[%d;%df', [GetParam(1, AParams), GetParam(2, AParams)]);
ecEraseScreenFrom: Result := #27'[J';
ecEraseLineFrom: Result := #27'[K';
ecEraseScreen: Result := #27'[2J';
ecEraseLine: Result := #27'[2K';
ecSetTab: Result := #27'H';
ecClearTab: Result := #27'[g';
ecClearAllTabs: Result := #27'[3g';
ecAttributes: Result := #27'[m'; // popravi
ecSetMode: Result := #27'[h';
ecResetMode: Result := #27'[l';
ecReset: Result := #27'c';
ecSaveCaret: Result := #27'[s';
ecRestoreCaret: Result := #27'[u';
ecSaveCaretAndAttr: Result := #27'7';
ecRestoreCaretAndAttr: Result := #27'8';
ecTest: Result := #27'#8';
else
Result := '';
end;
end;

// get vt100 escape code from string
function TEscapeCodesVT100.DetectCode(Str: string): TEscapeCode;
begin
if Length(Str) = 1 then
case Str[1] of
'H': Result := ecSetTab;
'c': Result := ecReset;
'7': Result := ecSaveCaretAndAttr;
'8': Result := ecRestoreCaretAndAttr;
'#': Result := ecNotCompleted;
'O': Result := ecNotCompleted;
else
Result := ecUnknown;
end
else
begin
Result := ecUnknown;
if Str = '#8' then
Result := ecTest;
if Str[1] = 'O' then
case Str[2] of
'A': Result := ecAppCursorUp;
'B': Result := ecAppCursorDown;
'C': Result := ecAppCursorRight;
'D': Result := ecAppCursorLeft;
end;
end;
end;

// get extended vt100 escape code from string
function TEscapeCodesVT100.DetectExtCode(Str: string): TEscapeCode;
var
LastCh: Char;
TempParams: TStrings;

procedure ParseParams(Str: string);
var
I: Integer;
TempStr: string;
begin
I := 1;
TempStr := '';
while I <= Length(Str) do
begin
if (Str[I] = ';') and (TempStr <> '') then
begin
TempParams.Add(TempStr);
TempStr := '';
end
else
TempStr := TempStr + Str[I];
Inc(I);
end;
if (TempStr <> '') then
TempParams.Add(TempStr);
end;

function CodeEraseScreen: TEscapeCode;
var
Str: string;
begin
if TempParams.Count = 0 then
Result := ecEraseScreenFrom
else
begin
Str := TempParams[0];
case Str[1] of
'0': Result := ecEraseScreenFrom;
'2': Result := ecEraseScreen;
else
Result := ecUnknown;
end;
end;
TempParams.Clear;
end;

function CodeEraseLine: TEscapeCode;
var
Str: string;
begin
if TempParams.Count = 0 then
Result := ecEraseLineFrom
else
begin
Str := TempParams[0];
case Str[1] of
'0': Result := ecEraseLineFrom;
'2': Result := ecEraseLine;
else
Result := ecUnknown;
end;
end;
TempParams.Clear;
end;

function CodeTab: TEscapeCode;
var
Str: string;
begin
if TempParams.Count = 0 then
Result := ecClearTab
else
begin
Str := TempParams[0];
case Str[1] of
'0': Result := ecClearTab;
'3': Result := ecClearAllTabs;
else
Result := ecUnknown;
end;
end;
TempParams.Clear;
end;

function CodeDevice: TEscapeCode;
var
Str: string;
begin
if TempParams.Count = 0 then
Result := ecUnknown
else
begin
Str := TempParams[0];
case Str[1] of
'5': Result := ecQueryDevice;
'0': Result := ecReportDeviceOK;
'3': Result := ecReportDeviceFailure;
'6': Result := ecQueryCursorPos;
else
Result := ecUnknown;
end;
end;
TempParams.Clear;
end;

function CodeIdentify: TEscapeCode;
begin
if (TempParams.Count = 0) or
((TempParams.Count = 1) and (TempParams[0] = '0'))
then
Result := ecIdentify
else
if (TempParams.Count = 2) and (TempParams[1] = '?1') then
Result := ecIdentResponse
else
Result := ecUnknown;
end;

begin
Result := ecNotCompleted;
LastCh := Str[Length(Str)];
if not (LastCh in ['A'..'Z', 'a'..'z']) then
Exit;
TempParams := TStringList.Create;
try
ParseParams(Copy(Str, 2, Length(Str) - 2));
case LastCh of
'A': Result := ecCursorUp;
'B': Result := ecCursorDown;
'C': Result := ecCursorRight;
'D': Result := ecCursorLeft;
'H': Result := ecCursorHome;
'f': Result := ecCursorMove;
'J': Result := CodeEraseScreen;
'K': Result := CodeEraseLine;
'g': Result := CodeTab;
'm': Result := ecAttributes;
'h': Result := ecSetMode;
'l': Result := ecResetMode;
's': Result := ecSaveCaret;
'u': Result := ecRestoreCaret;
'n': Result := CodeDevice;
'c': Result := CodeIdentify;
'R': Result := ecReportCursorPos;
else
Result := ecUnknown;
end;
FParams.Assign(TempParams);
finally
TempParams.Free;
end;
end;

end.