awterm.pas

测试用例

      FillChar(bAttrBufferB^[MoveSize], bWidth, (bbColor shl 4) or bfColor);
      FillChar(bExtAttrBuffer^[MoveSize], bWidth, bExtAttr);

      {One line free again, need a scroll}
      Dec(bY);
      Inc(bNeedVScroll, -BCharHeight);
    end else if bY >= (bYPos+cMarginBottom) then begin
      if bInMargins then begin
        {Client area should be scrolled up}
        Diff := bY-(bYPos+cMarginBottom-1);
        Inc(bNeedVScroll, -(Diff*bCharHeight));
        Inc(bYPos, Diff);
        if cMarginBottom < cHeight then begin
          MoveFrom := (bYPos+cMarginBottom)*bWidth;
          MoveTo := (bYPos+cMarginBottom-1)*bWidth;
          MoveSize := bBufferLimit-MoveFrom;

          {Step 1 - Move bottom-fixed area of client window down}
          Move(bScreenBuffer^[MoveTo], bScreenBuffer^[MoveFrom], MoveSize);
          Move(bAttrBuffer^[MoveTo], bAttrBuffer^[MoveFrom], MoveSize);
          Move(bAttrBufferB^[MoveTo], bAttrBufferB^[MoveFrom], MoveSize);
          Move(bExtAttrBuffer^[MoveTo], bExtAttrBuffer^[MoveFrom], MoveSize);

          {Clear first line of bottom-fixed area of client window}
          FillChar(bScreenBuffer^[MoveTo], bWidth, ' ');
          FillChar(bAttrBuffer^[MoveTo], bWidth, ' ');
          FillChar(bAttrBufferB^[MoveTo], bWidth, ' ');
          FillChar(bExtAttrBuffer^[MoveTo], bWidth, ' ');
        end;

        if cMarginTop > 1 then begin
          {Save top line of scrolling window (temp)}
          MoveTo := (((bYPos-1)+cMarginTop)-1)*bWidth;

          Move(bScreenBuffer^[MoveTo], TempBuf[0], bWidth);
          Move(bAttrBuffer^[MoveTo], TempAttrBuf[0], bWidth);
          Move(bAttrBufferB^[MoveTo], TempAttrBufB[0], bWidth);
          Move(bExtAttrBuffer^[MoveTo], TempExtAttrBuf[0], bWidth);

          {Move top-fixed area of client window down}
          MoveTo := (bYPos-1)*bWidth;
          MoveFrom := (bYPos)*bWidth;
          MoveSize := ((((bYPos-1)+cMarginTop)-1)*bWidth)-(MoveTo);

          Move(bScreenBuffer^[MoveTo], bScreenBuffer^[MoveFrom], MoveSize);
          Move(bAttrBuffer^[MoveTo], bAttrBuffer^[MoveFrom], MoveSize);
          Move(bAttrBufferB^[MoveTo], bAttrBufferB^[MoveFrom], MoveSize);
          Move(bExtAttrBuffer^[MoveTo], bExtAttrBuffer^[MoveFrom], MoveSize);

          {restore saved line to top line of client}
          Move(TempBuf[0], bScreenBuffer^[MoveTo], bWidth);
          Move(TempAttrBuf[0], bAttrBuffer^[MoveTo], bWidth);
          Move(TempAttrBufB[0], bAttrBufferB^[MoveTo], bWidth);
          Move(TempExtAttrBuf[0], bExtAttrBuffer^[MoveTo], bWidth);
        end;
      end else if (bY >= (bYPos+cHeight)) then
        Dec(bY);
    end else
      {No scrolling necessary, just set new caret position}
      bMoveCaret;

    {Make sure cursor remains visible}
    if bY >= (bYPos+cHeight) then begin
      {Client area should be scrolled up}
      Diff := bY-(bYPos+cHeight-1);
      Inc(bNeedVScroll, -(Diff*bCharHeight));
      Inc(bYPos, Diff);
    end else if bY < bYPos then begin
      {Client area should be scrolled down}
      Diff := bYPos-bY;
      Inc(bNeedVScroll, Diff*bCharHeight);
      Inc(bYPos, -Diff);
    end;
  end;

  procedure TBuffer.bWriteChar(C : Char);
    {-Write C}
  var
    BuffPos : Word;

    procedure NewLine;
      {-Advance one line}
    var
      FillPos : Word;
    begin
      {Advance buffer to next line}
      Inc(bY);

      {Update buffer for new bY}
      bUpdateBuffer;

      {If scrolled up, fill current line attributes with current background}

      if ((bNeedVScroll < 0) and ((bY+1) >= (bYPos+cMarginBottom))) then begin
        FillPos := bY*bWidth;
        FillChar(bAttrBuffer^[FillPos], bWidth, (bbColor shl 4) or bfColor);
        FillChar(bAttrBufferB^[FillPos], bWidth, (bbColor shl 4) or bfColor);
        FillChar(bExtAttrBuffer^[FillPos], bWidth, bExtAttr);
      end;
    end;

  begin
    {margin check}
    if ((((bY-bYPos)+1) >= cMarginTop) and
        (((bY-bYPos)+1) <= cMarginBottom)) then
       bInMargins := True
     else
       bInMargins := False;

    {Insert character}
    case C of
      cCR :
        begin
          bX := 0;
          bMoveCaret;
        end;
      cLF :
        NewLine;
      cBS :
        if bX <> 0 then begin
          Dec(bX);
          bScreenBuffer^[bY*bWidth+bX] := ' ';
          bInvalidateChar(bX, bY);
        end;
      else
        begin
          BuffPos := bY*bWidth+bX;
          bScreenBuffer^[BuffPos] := C;
          bAttrBuffer^[BuffPos] := (bbColor shl 4) or bfColor;
          bAttrBufferB^[BuffPos] := (bbColor shl 4) or bfColor;
          bExtAttrBuffer^[BuffPos] := bExtAttr;

          if ByteFlagIsSet(bExtAttr, eattrBlink) and bBlinkReset then begin
            bAttrBuffer^[BuffPos] := ((bAttrBuffer^[BuffPos] shr 4) shl 4) or
                                     (bAttrBuffer^[buffPos] shr 4);
          end;

          bInvalidateChar(bX, bY);
          if bX >= (bWidth-1) then begin
            bX := 0;
            NewLine;
          end else
            Inc(bX);
        end;
    end;

    {Add to capture file}
    bAddToCapture(C);
  end;

  procedure TBuffer.bClearScreen;
    {-Simulate clear screen by bringing bottom of physical screen to top}
  var
    I : Word;
    BuffPos : Word;
    FillSize : Word;
  begin
    bX := 0;
    if (bYPos + (bPageHeight*2)) < bHeight then
      {Still in virgin part of buffer}
      Inc(bYPos, bPageHeight)
    else begin
      {Issue enough newlines to get the current page to scroll off}
      bY := bHeight-1;
      for I := 1 to bPageHeight do
        bWriteChar(cLF);
      bYPos := bHeight-bPageHeight;
    end;
    bY := bYPos;
    BuffPos := bY*bWidth;
    FillSize := bWidth*bPageHeight;
    FillChar(bScreenBuffer^[BuffPos], FillSize, ' ');
    FillChar(bAttrBuffer^[BuffPos], FillSize, (bbColor shl 4) or bfColor);
    FillChar(bAttrBufferB^[BuffPos], FillSize,(bbColor shl 4) or bfColor);
    FillChar(bExtAttrBuffer^[BuffPos], FillSize, bExtAttr);

    InvalidateRect(bWnd, nil, False);
    UpdateWindow(bWnd);
  end;

  procedure TBuffer.bSortTabBuffer(var TabBuffer; Size: Byte);
  var
    DoneSort : Bool;
    Loop : Byte;
    Exch : Byte;
  begin
    repeat
      DoneSort := True;
      for Loop := 1 to Size-1 do begin
        if TByteBuffer(TabBuffer)[Loop] =
           TByteBuffer(TabBuffer)[Loop+1] then
             TByteBuffer(TabBuffer)[Loop] := 0;
        if TByteBuffer(TabBuffer)[Loop] >
           TByteBuffer(TabBuffer)[Loop+1] then begin
          Exch := TByteBuffer(TabBuffer)[Loop];
          TByteBuffer(TabBuffer)[Loop] := TByteBuffer(TabBuffer)[Loop+1];
          TByteBuffer(TabBuffer)[Loop+1] := Exch;
          DoneSort := False;
        end;
      end;
    until DoneSort;
  end;

  function TBuffer.bGetNextTabStop(CurrentPos, Count : Byte;
                                   var TabBuffer; Size : Byte): Byte;
  var
    TabLoop : Byte;
  begin
    bGetNextTabStop := CurrentPos;
    for TabLoop := 1 to Size do begin
      if (TByteBuffer(TabBuffer)[TabLoop] > CurrentPos) and
         (TByteBuffer(TabBuffer)[TabLoop] < bWidth)  then begin
        bGetNextTabStop := TByteBuffer(TabBuffer)[TabLoop];
        Dec(Count, 1);
        if Count = 0 then
          exit;
      end;
    end;
  end;

  function TBuffer.bGetPrevTabStop(CurrentPos, Count : Byte;
                                   var TabBuffer; Size : Byte): Byte;
  var
    TabLoop : Byte;
  begin
    bGetPrevTabStop := CurrentPos;
    for TabLoop := Size downto 1 do begin
      if TByteBuffer(TabBuffer)[TabLoop] < CurrentPos then begin
        if TByteBuffer(TabBuffer)[TabLoop] > 0 then
          bGetPrevTabStop := TByteBuffer(TabBuffer)[TabLoop];
        Dec(Count, 1);
        if Count = 0 then
          exit;
      end;
    end;
  end;

  procedure TBuffer.bSetHorizontalTabStop(Column : Byte);
  begin
    {-see if room in tab stop buffer}
    if bHorizTabStop^[1] = 0 then begin
      {-put new tab stop in buffer}
      bHorizTabStop^[1] := Column;

      {-sort the tab buffer to a logical order}
      bSortTabBuffer(bHorizTabStop^, SizeOf(THorizontalTabStop));
    end;
  end;

  procedure TBuffer.bClearHorizontalTabStop(Column : Byte);
  var
    TabLoop : Byte;
    FoundTab : Boolean;
  begin
    FoundTab := False;
    for TabLoop := 1 to SizeOf(THorizontalTabStop) do begin
      if bHorizTabStop^[TabLoop] = Column then begin
        FoundTab := True;
        bHorizTabStop^[TabLoop] := 0;
      end;
    end;
    {-sort the tab buffer to a logical order}
    if FoundTab then
      bSortTabBuffer(bHorizTabStop^, SizeOf(THorizontalTabStop));
  end;

  procedure TBuffer.bSetVerticalTabStop(Row : Byte);
  begin
    if bVertiTabStop^[1] = 0 then begin
      {-put new tab stop in buffer}
      bVertiTabStop^[1] := Row;

      {-sort the tab buffer to a logical order}
      bSortTabBuffer(bVertiTabStop^, SizeOf(TVerticalTabStop));
    end;
  end;

  procedure TBuffer.bClearVerticalTabStop(Row : Byte);
  var
    TabLoop : Byte;
    FoundTab : Boolean;
  begin
    FoundTab := False;
    for TabLoop := 1 to SizeOf(TVerticalTabStop) do begin
      if bVertiTabStop^[TabLoop] = Row then begin
        FoundTab := True;
        bVertiTabStop^[TabLoop] := 0;
      end;
    end;
    {-sort the tab buffer to a logical order}
    if FoundTab then
      bSortTabBuffer(bVertiTabStop^, SizeOf(TVerticalTabStop));
  end;

  procedure TBuffer.bProcessChar(C : Char);
    {-Show C to emulator, process results}
  var
    TempBColor : Byte;
    Start, Limit : Word;
    I : Word;
    MoveSize : Word;
    UpdateRect : TRect;

    procedure GetChangedRect(StartChange, EndChange: Word; var Dest : TRect);
    var
      ClientTop   : Word;
      SRow, LRow  : Word;
    begin
      { The clients top position in the buffer }
      ClientTop := (bYPos * bWidth);

      { Get the first character row }
      SRow := (StartChange-ClientTop) div bWidth;

      { Get the last character row }
      LRow := ((EndChange-ClientTop) div bWidth) + 1;

      { calculate a new TRect structure for the screen }
      Dest.Top    := SRow*bCharHeight;
      Dest.Left   := 0;
      Dest.Bottom := LRow*bCharHeight;
      Dest.Right  := bWidth*bCharWidth;                  
    end;

    procedure ClearPart(Start, Limit : Word);
      {-Clear part of the buffer and redraw}
    var
      FillSize  : Word;
      ClearRect : TRect;
    begin
      FillSize := Limit-Start;
      FillChar(bScreenBuffer^[Start], FillSize, ' ');
      FillChar(bAttrBuffer^[Start], FillSize, (bbColor shl 4) or bfColor);
      FillChar(bAttrBufferB^[Start], FillSize, (bbColor shl 4) or bfColor);
      FillChar(bExtAttrBuffer^[Start], FillSize, 0);

      GetChangedRect(Start, Limit, ClearRect); 
      InvalidateRect(bWnd, @ClearRect, False);

      UpdateWindow(bWnd);
    end;

    procedure ReportCursorPosition;
      {-Output CPR sequence with cursor position (no error checking)}
    var
      cpX : String[3];
      cpY : String[3];
      RCP : String[10];
    begin
      {convert the values to strings}
      Str(bX+1, cpX);
      Str((bY-bYPos)+1, cpY);

      {create the ANSI sequence}
      RCP := #27'['+cpY+';'+cpX+'R';
      bCom.PutBlock(RCP[1], Length(RCP));
    end;

    procedure ReportDeviceAttributes(TermType : Byte);
      {-Output DA sequence specifing the VT terminal type}
    const
      RDA100 : array[0..7] of char = #27'[?1;0c';
      RDA52  : array[0..3] of char = #27'/Z';
    begin
      Case TermType of
        0 : bCom.PutBlock(RDA52, 3);
        1 : bCom.PutBlock(RDA100, 7);
      end;
    end;

  begin
    {If emulator was attached, call it}
    if (bEmulator <> nil) and (@bEmuProc <> nil) then begin
      bEmuProc(bEmulator, C, bEC);
    end else begin
      bEC.Cmd := eChar;
      bEC.Ch := C;
    end;

    {Process emulator results}
    with bEC do begin
      case Cmd of
        eNone : {etNONE, etVT52, etANSI, etVT100}
          {nothing to do} ;
        eHT  :  {etNONE, etVT52, etANSI, etVT100}
          begin
            bX := bGetNextTabStop(bX, 1, bHorizTabStop^,
                                 SizeOf(THorizontalTabStop));
            if bX > bWidth then
              bX := bWidth;

            {Update the caret position}
            bMoveCaret;
          end;
        eChar : {etNONE, etVT52, etANSI, etVT100}
          if (Ch <> #0) then
            bWriteChar(Ch);
        eSGR : {etANSI, etVT100}
          if (FColor in [emBlack..emWhiteBold]) and
             (BColor in [emBlack..emWhiteBold]) then begin          
            bfColorOrg := FColor;
            bbColorOrg := BColor;
            bExtAttr := ExtAttr;
            if ByteFlagIsSet(ExtAttr, eattrInverse) then begin
              bfColor := BColor;
              bbColor := FColor;