adtrmpsr.pas

测试用例

begin
  FSequence := ReAllocSeq(FSequence, 0);
  FSavedSeq := ReAllocSeq(FSavedSeq, 0);
  if (FArgs <> nil) then begin
    FreeMem(FArgs, sizeof(integer) * FArgCountMax);
    FArgs := nil;
    FArgCountMax := 0;
  end;
  inherited Destroy;
end;
{--------}
procedure TAdVT100Parser.Clear;
begin
  ClearSeq(FSequence);
  FCommand := eNone;
  if (FArgCount <> 0) then begin
    FillChar(FArgs^, sizeof(integer) * FArgCount, 0);
    FArgCount := 0;
  end;
end;
{--------}
function TAdVT100Parser.ProcessChar(aCh : AnsiChar) : TAdParserCmdType;
begin
  {if the current state is psGotCommand, the previous character
   managed to complete a command. Before comtinuing we should clear
   all traces of the previous command and sequence}
  if (FState = psGotCommand) then begin
    FArgCount := 0;
    ClearSeq(FSequence);
    FCommand := eNone;
    FState := psIdle;
  end;

  {if the current state is psGotInterCommand, the previous character
   was non-displayable and a command; restore the previously saved
   state}
  if (FState = psGotInterCommand) then begin
    FArgCount := 0;
    FCommand := eNone;
    CopySeq(FSavedSeq, PSeq(FSequence));
    FState := FSavedState;
  end;

  {assume that the result is going to be that we are building up a
   command escape sequence}
  Result := pctPending;

  {add the character to the sequence string we're building up,
   although we may delete it later}
  AddCharToSeq(PSeq(FSequence), aCh);

  {if the character is non-displayable, process it immediately, even
   if we're in the middle of parsing some other command}
  if (aCh < ' ') then begin
    FSavedState := FState;
    DelCharFromSeq(FSequence);
    CopySeq(FSequence, PSeq(FSavedSeq));
    FState := psGotInterCommand;
    Result := pctComplete;
    case aCh of
      cENQ : begin {enquiry request}
               AssignSeqToChar(PSeq(FSequence), cENQ);
               FCommand := eENQ;
             end;
      cBel : begin {sound bell}
               AssignSeqToChar(PSeq(FSequence), cBel);
               FCommand := eBel;
             end;
      cBS  : begin {backspace}
               AssignSeqToChar(PSeq(FSequence), cBS);
               FCommand := eBS;
             end;
      cTab : begin {horizontal tab}
               AssignSeqToChar(PSeq(FSequence), cTab);
               FCommand := eCHT;
               FArgCount := 1;
               FArgs^[0] := 1; {ie a single tab}
             end;
      cLF  : begin
               AssignSeqToChar(PSeq(FSequence), cLF);
               FCommand := eLF;
             end;
      cVT  : begin
               AssignSeqToChar(PSeq(FSequence), cVT);
               FCommand := eCVT;
               FArgCount := 1;
               FArgs^[0] := 1; {ie a single tab}
             end;
      cFF  : begin {formfeed, equals clear screen}
               AssignSeqToChar(PSeq(FSequence), cFF);
               FCommand := eED;
               FArgCount := 1;
               FArgs^[0] := 2; {ie <esc>[2J}
             end;
      cCR  : begin {carriage return}
               AssignSeqToChar(PSeq(FSequence), cCR);
               FCommand := eCR;
             end;
      cSO  : begin {shift out character set, ie use G0}
               AssignSeqToChar(PSeq(FSequence), cSO);
               FCommand := eSO;
             end;
      cSI  : begin {shift in character set, ie use G1}
               AssignSeqToChar(PSeq(FSequence), cSI);
               FCommand := eSI;
             end;
      cCan,
      cSub : begin {abandon current escape sequence}
               Result := pctNone;
             end;
      cEsc : begin {start a new escape sequence}
               {abandon whatever escape sequence we're in}
               AssignSeqToChar(PSeq(FSequence), cEsc);
               FArgCount := 0;
               FState := psGotEscape;
               Result := pctPending;
             end;
    else
      {otherwise ignore the non-displayable char}
      DelCharFromSeq(FSequence);
      Result := pctNone;
    end;{case}
  end
  {otherwise parse the character}
  else begin
    case FState of
      psIdle :
        begin
          if (aCh < #127) then begin
            FState := psGotCommand;
            FCommand := eChar;
            Result := pctChar;
          end
          else {full 8-bit char} begin
            FState := psGotCommand;
            FCommand := eChar;
            Result := pct8bitChar;
          end;
        end;
      psGotEscape :
        if InVT52Mode then begin
          Result := vtpProcessVT52(aCh);
        end
        else {in VT100 mode} begin
          case aCh of
            '[' : FState := psParsingANSI;
            '(' : FState := psParsingLeftParen;
            ')' : FState := psParsingRightParen;
            '#' : FState := psParsingHash;
            '*', '+', '-', '.', '/' : FState := psParsingCharSet;
          else {it's a two character esc. seq.}
            FState := psGotCommand;
            Result := pctComplete;
            case aCh of
              '1' : begin {set graphics processor option on}
                      { NOT SUPPORTED }
                      FCommand := eNone;
                    end;
              '2' : begin {set graphics processor option off}
                      { NOT SUPPORTED }
                      FCommand := eNone;
                    end;
              '7' : begin {save cursor pos}
                      FCommand := eSaveCursorPos;
                    end;
              '8' : begin {restore cursor pos}
                      FCommand := eRestoreCursorPos;
                    end;
              '<' : begin {switch to ANSI--ie, do nothing}
                      FCommand := eNone;
                      Result := pctNone;
                    end;
              '=' : begin {set application keypad mode}
                      FCommand := eSM;
                      FArgCount := 2;
                      FArgs^[0] := -2;
                      FArgs^[1] := 999; {special APRO code!}
                    end;
              '>' : begin {set numeric keypad mode}
                      FCommand := eRM;
                      FArgCount := 2;
                      FArgs^[0] := -2;
                      FArgs^[1] := 999; {special APRO code!}
                    end;
              'D' : begin {index = cursor down + scroll}
                      FCommand := eIND2;
                    end;
              'E' : begin {next line}
                      FCommand := eNEL;
                    end;
              'H' : begin {set horx tab stop}
                      FCommand := eHTS;
                    end;
              'M' : begin {reverse index = cursor up + scroll}
                      FCommand := eRI;
                    end;

              'Z' : begin {device attributes}
                      FCommand := eDA;
                      FArgCount := 1;
                      FArgs^[0] := 0; {stands for VT100}
                    end;
              'c' : begin
                      FCommand := eRIS;
                    end;
            else
              {ignore the char & seq.--it's not one we know}
              Result := pctNone;
            end;{case}
          end;{case}
        end;
      psParsingANSI :
        begin
          if (#$40 <= aCh) and (aCh < #$7F) then begin
            {the command is now complete-see if we know about it}
            FState := psGotCommand;
            Result := vtpParseANSISeq(aCh);
          end;
          {otherwise, the next character has already been added to
           the sequence string, so there's nothing extra to do}
        end;
      psParsingLeftParen :
        begin
          if ('0' <= aCh) and (aCh <= '~') then begin
            {the command is complete}
            if (GetSeqLength(FSequence) = 3) then begin
              FState := psGotCommand;
              Result := pctComplete;
              FCommand := eDECSCS;
              FArgCount := 2;
              FArgs^[0] := 0; {0 = set G0 charset}
              case aCh of
                'A' : FArgs^[1] := ord('A');
                'B' : FArgs^[1] := ord('B');
                '0' : FArgs^[1] := 0;
                '1' : FArgs^[1] := 1;
                '2' : FArgs^[1] := 2;
              else
                {ignore the char & seq.--it's not one we know}
                FState := psGotCommand;
                Result := pctNone;
                FCommand := eNone;
                FArgCount := 0;
              end;{case}
            end
            else {sequence is too long} begin
              FState := psGotCommand;
              Result := pctNone;
              FCommand := eNone;
              FArgCount := 0;
            end;
          end;
        end;
      psParsingRightParen :
        begin
          if ('0' <= aCh) and (aCh <= '~') then begin
            {the command is complete}
            if (GetSeqLength(FSequence) = 3) then begin
              FState := psGotCommand;
              Result := pctComplete;
              FCommand := eDECSCS;
              FArgCount := 2;
              FArgs^[0] := 1; {0 = set G1 charset}
              case aCh of
                'A' : FArgs^[1] := ord('A');
                'B' : FArgs^[1] := ord('B');
                '0' : FArgs^[1] := 0;
                '1' : FArgs^[1] := 1;
                '2' : FArgs^[1] := 2;
              else
                {ignore the char & seq.--it's not one we know}
                FState := psGotCommand;
                Result := pctNone;
                FCommand := eNone;
                FArgCount := 0;
              end;{case}
            end
            else {sequence is too long} begin
              FState := psGotCommand;
              Result := pctNone;
              FCommand := eNone;
              FArgCount := 0;
            end;
          end;
        end;
      psParsingCharSet :
        begin
          {these are the VT200+ "switch charset" sequences: we ignore
           them after finding the first char in range $30..$7E}
          if ('0' <= aCh) and (aCh <= '~') then begin
            FState := psGotCommand;
            Result := pctNone;
            FCommand := eNone;
            FArgCount := 0;
          end;
        end;
      psParsingHash :
        begin
          FState := psGotCommand;
          Result := pctComplete;
          case aCh of
            '3' : begin
                    FCommand := eDECDHL;
                    FArgCount := 1;
                    FArgs^[0] := 0; {0 = top half}
                  end;
            '4' : begin
                    FCommand := eDECDHL;
                    FArgCount := 1;
                    FArgs^[0] := 1; {1 = bottom half}
                  end;
            '5' : begin
                    FCommand := eDECSWL;
                  end;
            '6' : begin
                    FCommand := eDECDWL;
                  end;
            '8' : begin
                    FCommand := eDECALN;
                  end;
          else
            {ignore the char & seq.--it's not one we know}
            FState := psGotCommand;
            Result := pctNone;
          end;{case}
        end;
      psParsingCUP52 :
        begin
          if (FArgCount = 0) then begin
            FArgs^[0] := ord(aCh) - $1F;
            inc(FArgCount);
          end
          else begin
            FState := psGotCommand;
            FCommand := eCUP;
            FArgs^[1] := ord(aCh) - $1F;
            inc(FArgCount);
            Result := pctComplete;
          end;
        end;
    else
      {invalid state?}
    end;{case}
  end;
end;
{--------}
{$IFDEF Win32}
function TAdVT100Parser.ProcessWideChar(aCh : WideChar) :TAdParserCmdType;
begin
  Result := pctNone;
end;
{$ENDIF}
{--------}
function TAdVT100Parser.tpGetArgument(aInx : integer) : integer;
begin
  if (aInx < 0) or (aInx >= FArgCount) then
    Result := 0
  else
    Result := FArgs^[aInx];
end;
{--------}
function TAdVT100Parser.tpGetSequence : string;
begin
  if (FCommand <> eNone) then
    Result := GetStringFromSeq(FSequence)
  else
    Result := '';
end;
{--------}
function TAdVT100Parser.vtpGetArguments : boolean;
var
  ChInx   : integer;
  StartInx: integer;
  Ch      : char;
  ec      : integer;
  TempStr : string[255];
begin
  {for this parser, we assume