adtrmpsr.pas

测试用例

     1. arguments consist of numeric digits only
     2. arguments are separated by ';'
     3. the first argument can be ? (DEC VT100 special)
     4. argument parsing stops at the first character #$20 - #$2F, or
        #$40 - #$7E}

  {assume the sequence is badly formed}
  Result := false;

  {first check for the third character being ?}
  if (PSeq(FSequence)^.sText[3] = '?') then begin
    FArgCount := 1;
    FArgs^[0] := -2;
    StartInx := 4;
  end
  else
    StartInx := 3;

  {scan the rest of the characters until we reach a char in the range
   $20-$2F, or $40-$7E; look out for numeric digits and semi-colons}
  TempStr := '';
  for ChInx := StartInx to PSeq(FSequence)^.sLen do begin
    Ch := PSeq(FSequence)^.sText[ChInx];
    if ((#$20 <= Ch) and (Ch <= #$2F)) or
       ((#$40 <= Ch) and (Ch <= #$7E)) then
      Break;
    if (Ch = ';') then begin
      if (FArgCountMax = FArgCount) then
        vtpGrowArgs;
      if (TempStr = '') then begin
        FArgs^[FArgCount] := -1;
        inc(FArgCount);
      end
      else begin
        Val(TempStr, FArgs^[FArgCount], ec);
        if (ec <> 0) then
          Exit;
        inc(FArgCount);
        TempStr := '';
      end;
    end
    else if ('0' <= Ch) and (Ch <= '9') then begin
      TempStr := TempStr + Ch;
    end
    else {bad character}
      Exit;
  end;

  {convert the final argument}
  if (FArgCountMax = FArgCount) then
    vtpGrowArgs;
  if (TempStr = '') then begin
    FArgs^[FArgCount] := -1;
    inc(FArgCount);
  end
  else begin
    Val(TempStr, FArgs^[FArgCount], ec);
    if (ec <> 0) then
      Exit;
    inc(FArgCount);
  end;

  {if we got here, everything was all right}
  Result := true;
end;
{--------}
procedure TAdVT100Parser.vtpGrowArgs;
var
  NewMax   : integer;
  NewArray : PAdIntegerArray;
begin
  {use a simple increase-by-half algorithm}
  if (FArgCountMax = 0) then
    NewMax := 16
  else
    NewMax := (FArgCountMax * 3) div 2;
  {alloc the new array, zeroed}
  NewArray := AllocMem(sizeof(integer) * NewMax);
  {if there's any data in the old array copy it over, delete it}
  if (FArgs <> nil) then begin
    Move(FArgs^, NewArray^, sizeof(integer) * FArgCount);
    FreeMem(FArgs, sizeof(integer) * FArgCountMax);
  end;
  {remember the new details}
  FArgs := NewArray;
  FArgCountMax := NewMax;
end;
{--------}
function TAdVT100Parser.vtpParseANSISeq(aCh : char) : TAdParserCmdType;
begin
  {when this method is called FSequence has the full escape sequence,
   and FArgCount, FArgs, FCommand have to be set; for convenience aCh
   is the final character in FSequence--the command identifier--and
   FSequence must have at least three characters in it}

  {assume the sequence is invalid}
  Result := pctNone;

  {special case: DECSCL}
  if (GetStringFromSeq(FSequence) = DECSCLseq) then begin
    FCommand := eRIS;
    Result := pctComplete;
  end;

  {split out the arguments in the sequence, build up the FArgs array;
   note that an arg of -1 means 'default', and -2 means ? (a special
   DEConly parameter)}
  if not vtpGetArguments then
    Exit;

  {identify the command character}
  case aCh of
    '@' : begin {insert character--VT102}
            FCommand := eICH;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'A' : begin {Cursor up}
            FCommand := eCUU;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'B' : begin {Cursor down}
            FCommand := eCUD;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'C' : begin {Cursor right}
            FCommand := eCUF;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'D' : begin {cursor left}
            FCommand := eCUB;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'H' : begin {cursor position}
            FCommand := eCUP;
            {should have two parameters, both default of 1}
            if not vtpValidateArgsPrim(2, 2, 1) then Exit;
          end;
    'J' : begin {Erase in display}
            FCommand := eED;
            {should only have one parameter, default of 0}
            if not vtpValidateArgsPrim(1, 1, 0) then Exit;
          end;
    'K' : begin {Erase in line}
            FCommand := eEL;
            {should only have one parameter, default of 0}
            if not vtpValidateArgsPrim(1, 1, 0) then Exit;
          end;
    'L' : begin {Insert line--VT102}
            FCommand := eIL;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'M' : begin {Delete line--VT102}
            FCommand := eDL;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'P' : begin {delete character--VT102}
            FCommand := eDCH;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'X' : begin {erase character--VT102}
            FCommand := eECH;
            {should only have one parameter, default of 1}
            if not vtpValidateArgsPrim(1, 1, 1) then Exit;
          end;
    'c' : begin {Device attributes}
            FCommand := eDA;
            {should only have one parameter, default of 0}
            if not vtpValidateArgsPrim(1, 1, 0) then Exit;
          end;
    'f' : begin {cursor position}
            FCommand := eCUP;
            {should have two parameters, both default of 1}
            if not vtpValidateArgsPrim(2, 2, 1) then Exit;
          end;
    'g' : begin {clear horizontal tabs}
            FCommand := eTBC;
            {should only have one parameter, default of 0}
            if not vtpValidateArgsPrim(1, 1, 0) then Exit;
          end;
    'h' : begin {set mode}
            FCommand := eSM;
            {should have one parameter, or 2 if the first is ?, no
             defaults}
           end;
    'l' : begin {reset mode}
            FCommand := eRM;
            {should have one parameter, or 2 if the first is ?, no
             defaults}
            {we have to try and spot one command in particular: the
             switch to VT52 mode}
            if (FArgCount = 2) and
               (FArgs^[0] = -2) and (FArgs^[1] = 2) then
              FInVT52Mode := true; 
          end;
    'm' : begin
            FCommand := eSGR;
            {should have at least one parameter, default of 0 for all
             parameters}
            if not vtpValidateArgsPrim(1, 30000, 0) then Exit;
          end;
    'n' : begin {Device status report}
            FCommand := eDSR;
            {should only have one parameter, no default}
            if not vtpValidateArgsPrim(1, 1, -1) then Exit;
          end;
    'q' : begin {DEC PRIVATE-set/clear LEDs}
            FCommand := eDECLL;
            {should have at least one parameter, default of 0 for all
             parameters}
            if not vtpValidateArgsPrim(1, 30000, 0) then Exit;
          end;
    'r' : begin {DEC PRIVATE-set top/bottom margins}
            FCommand := eDECSTBM;
            {should have two parameters, first default of 1, second
             default unknowable by this class}
          end;
    's' : begin {save cursor pos - ANSI.SYS escape sequence}
            FCommand := eSaveCursorPos;
          end;
    'u' : begin {restore cursor pos - ANSI.SYS escape sequence}
            FCommand := eRestoreCursorPos;
          end;
    'x' : begin {DEC PRIVATE-request terminal parameters}
            FCommand := eDECREQTPARM;
            {should only have one parameter, no default}
            if not vtpValidateArgsPrim(1, 1, -1) then Exit;
          end;
    'y' : begin {DEC PRIVATE-invoke confidence test}
            FCommand := eDECTST;
            {should have two parameters, no default for first, second
             default to 0}
          end;
  else {the command letter is unknown}
    Exit;
  end;{case}

  {if we get here the sequence is valid and we've patched up the
   arguments list and count}
  Result := pctComplete;
end;
{--------}
function TAdVT100Parser.vtpProcessVT52(aCh : char) : TAdParserCmdType;
begin
  FState := psGotCommand;
  Result := pctComplete;
  case aCh of
    '<' : begin {switch to ANSI mode}
            FCommand := eSM;
            FArgCount := 2;  {pretend it's Esc[?2h}
            FArgs^[0] := -2;
            FArgs^[1] := 2;
            FInVT52Mode := false;
          end;
    '=' : begin {enter alternate keypad mode}
            FCommand := eSM;
            FArgCount := 2;
            FArgs^[0] := -2;
            FArgs^[1] := 999; {special APRO code!}
          end;
    '>' : begin {leave alternate keypad mode}
            FCommand := eRM;
            FArgCount := 2;
            FArgs^[0] := -2;
            FArgs^[1] := 999; {special APRO code!}
          end;
    'A' : begin {cursor up}
            FCommand := eCUU;
            FArgCount := 1;
            FArgs^[0] := 1;
          end;
    'B' : begin {cursor down}
            FCommand := eCUD;
            FArgCount := 1;
            FArgs^[0] := 1;
          end;
    'C' : begin {cursor right}
            FCommand := eCUF;
            FArgCount := 1;
            FArgs^[0] := 1;
          end;
    'D' : begin {cursor left}
            FCommand := eCUB;
            FArgCount := 1;
            FArgs^[0] := 1;
          end;
    'F' : begin {switch to graphics characters}
            FCommand := eSO;
          end;
    'G' : begin {switch to ASCII characters}
            FCommand := eSI;
          end;
    'H' : begin {move cursor home}
            FCommand := eCUP;
            FArgCount := 2;
            FArgs^[0] := 1;
            FArgs^[1] := 1;
          end;
    'I' : begin {reverse index = cursor up + scroll}
            FCommand := eRI;
          end;
    'J' : begin {erase to end of screen}
            FCommand := eED;
            FArgCount := 1;
            FArgs^[0] := 0; {ie <esc>[0J}
          end;
    'K' : begin {erase to end of line}
            FCommand := eEL;
            FArgCount := 1;
            FArgs^[0] := 0; {ie <esc>[0K}
          end;
    'Y' : begin {position cursor}
            FState := psParsingCUP52;
            FCommand := eCUP;
            Result := pctPending;
          end;
    'Z' : begin {device attributes, identify}
            FCommand := eDA;
            FArgCount := 1;
            FArgs^[0] := 52; {ie VT52 emulation}
          end;
  else
    Result := pctNone;
  end;{case}
end;
{--------}
function TAdVT100Parser.vtpValidateArgsPrim(aMinArgs : integer;
                                            aMaxArgs : integer;
                                            aDefault : integer) : boolean;
var
  i : integer;
begin
  Result := false;
  {if we have too many arguments, something's obviously wrong}
  if (FArgCount > aMaxArgs) then
    Exit;
  {if we have too few, make the missing ones the default}
  while (FArgCount < aMinArgs) do begin
    if (FArgCountMax = FArgCount) then
      vtpGrowArgs;
    FArgs^[FArgCount] := aDefault;
    inc(FArgCount);
  end;
  {convert any -1 arguments to the default}
  for i := 0 to pred(FArgCount) do
    if (FArgs^[i] = -1) then
      FArgs^[i] := aDefault;
  {and we're done}
  Result := true;
end;
{====================================================================}


{===Initialization/finalization======================================}
procedure ADTrmPsrDone; far;
begin
  { }
end;
{--------}
initialization
  {$IFDEF Windows}
  AddExitProc(ADTrmPsrDone);
  {$ENDIF}
{--------}
{$IFDEF Win32}
finalization
  ADTrmPsrDone;
{$ENDIF}
{--------}
end.