adtrmbuf.pas

测试用例

  M := 1 shl (byte(aBit) and 7);
  P^ := char(byte(P^) and not M);
end;
{--------}
function ADTIsBitSet(aBitset : PByteArray; aBit : integer) : boolean;
var
  BS : PAnsiChar absolute aBitset;
  P  : PAnsiChar;
  M  : byte;
begin
  P := BS + (aBit shr 3);
  M := 1 shl (byte(aBit) and 7);
  Result := (byte(P^) and M) <> 0;
end;
{--------}
function ADTReallocBitset(aBitset      : PByteArray;
                          aOldBitCount : integer;
                          aNewBitCount : integer) : PByteArray;
var
  XferBitCount : integer;
begin
  if (aNewBitCount = 0) then
    Result := nil
  else begin
    Result := AllocMem(aNewBitCount);
    if (aBitset <> nil) then begin
      if (aOldBitCount < aNewBitCount) then
        XferBitCount := aOldBitCount
      else
        XferBitCount := aNewBitCount;
      Move(aBitset^, Result^, (XferBitCount+7) shr 3);
    end;
  end;
  FreeMem(aBitset, (aOldBitCount+7) shr 3);
end;
{--------}
(***** not used yet
procedure ADTSetAllBits(aBitset : PByteArray; aBitCount : integer);
begin
  FillChar(aBitset^, (aBitCount+7) shr 3, $FF);
end;
*****)
{--------}
procedure ADTSetBit(aBitset : PByteArray; aBit : integer);
var
  BS : PAnsiChar absolute aBitSet;
  P  : PAnsiChar;
  M  : byte;
begin
  P := BS + (aBit shr 3);
  M := 1 shl (byte(aBit) and 7);
  P^ := char(byte(P^) or M);
end;
{====================================================================}


{===Invalid rectangle routines==========================================}
const
  RectsPerPage = 200;
type
  PInvRect = ^TInvRect;
  TInvRect = packed record
    irNext : PInvRect;
    irRect : TRect;
  end;
  PInvRectPage = ^TInvRectPage;
  TInvRectPage = packed record
    irpNext  : PInvRectPage;
    irpRects : array [0.. pred(RectsPerPage)] of TInvRect;
  end;
var
  InvRectFreeList : PInvRect;
  InvRectPageList : PInvRectPage;
{--------}
procedure ADTFreeInvRect(P : PInvRect);
begin
  {push rect onto free list}
  P^.irNext := InvRectFreeList;
  InvRectFreeList := P;
end;
{--------}
procedure ADTAllocInvRectPage;
var
  NewPage : PInvRectPage;
  i       : integer;
begin
  {alloc new page and add it to front of page list}
  New(NewPage);
  NewPage^.irpNext := InvRectPageList;
  InvRectPageList := NewPage;
  {add all rects on this page to free list}
  for i := 0 to pred(RectsPerPage) do
    ADTFreeInvRect(@NewPage^.irpRects[i]);
end;
{--------}
function ADTAllocInvRect : PInvRect;
begin
  {pop top rect from free list; if none, add a whole page's worth}
  if (InvRectFreeList = nil) then
    ADTAllocInvRectPage;
  Result := InvRectFreeList;
  InvRectFreeList := Result^.irNext;
end;
{--------}
procedure ADTFreeInvRectPages;
var
  Temp : PInvRectPage;
begin
  {dispose of all rect pages}
  while (InvRectPageList <> nil) do begin
    Temp := InvRectPageList;
    InvRectPageList := Temp^.irpNext;
    Dispose(Temp);
  end;
  {since all rects have now gone, force the rect free list to nil}
  InvRectFreeList := nil;
end;
{--------}
procedure ADTAddInvalidRect(var aInvRectList : PInvRect;
                       const aRect        : TRect);
var
  NewRect : PInvRect;
begin
  NewRect := ADTAllocInvRect;
  NewRect^.irNext := aInvRectList;
  aInvRectList := NewRect;
  NewRect^.irRect := aRect;
end;
{--------}
function ADTRemoveInvalidRect(var aInvRectList : PInvRect;
                           var aRect        : TRect) : boolean;
var
  TopRect : PInvRect;
begin
  if (aInvRectList = nil) then
    Result := false
  else begin
    Result := true;
    TopRect := aInvRectList;
    aInvRectList := TopRect^.irNext;
    aRect := TopRect^.irRect;
    ADTFreeInvRect(TopRect);
  end;
end;
{--------}
function ADTPeekInvalidRect(aInvRectList : PInvRect;
                     var aRect        : TRect) : boolean;
begin
  if (aInvRectList = nil) then
    Result := false
  else begin
    Result := true;
    aRect := aInvRectList^.irRect;
  end;
end;
{--------}
procedure ADTMergeInvalidRects(aInvRectList : PInvRect);
var
  Temp    : PInvRect;
  Walker  : PInvRect;
  MinRect : TRect;
begin
  if (aInvRectList = nil) then
    Exit;
  {performs a simple merge of all the invalid rects in the list by
   working out the rect that just covers them all; free the rects from
   the list after we read them--leaving the first for our use}
  MinRect := aInvRectList^.irRect;
  Walker := aInvRectList^.irNext;
  while (Walker <> nil) do begin
    with Walker^.irRect do begin
      if Left < MinRect.Left then
        MinRect.Left := Left;
      if Top < MinRect.Top then
        MinRect.Top := Top;
      if Right > MinRect.Right then
        MinRect.Right := Right;
      if Bottom > MinRect.Bottom then
        MinRect.Bottom := Bottom;
    end;
    Temp := Walker;
    Walker := Walker^.irNext;
    ADTFreeInvRect(Temp);
  end;
  {MinRect now contains the smallest rectangle that covers all invalid
   rects in the list; set this minimum invalid rect into the first
   (and only) item in the list}
  aInvRectList^.irNext := nil;
  aInvRectList^.irRect := MinRect;
end;
{====================================================================}


{===TAdTerminalBuffer================================================}
constructor TAdTerminalBuffer.Create(aUseWideChars : boolean);
var
  i : integer;
begin
  inherited Create;

  FTerminalHandle := 0;                                                  {!!.05}

  {set the values of the properties that define defaults}
  FDefBackColor := adc_TermBufBackColor;
  FDefForeColor := adc_TermBufForeColor;
  FDefAnsiChar := ' ';
  {$IFDEF Win32}
  FDefWideChar := ' ';
  {$ENDIF}
  FDefCharSet := 0;
  FDefAttr := [];

  {set the 'power-up' values}
  FBackColor := adc_TermBufBackColor;
  FForeColor := adc_TermBufForeColor;
  UseAbsAddress := adc_TermBufUseAbsAddress;
  UseAutoWrap := adc_TermBufUseAutoWrap;
  UseAutoWrapDelay := adc_TermBufUseAutoWrapDelay;
  UseInsertMode := adc_TermBufUseInsertMode;
  UseNewLineMode := adc_TermBufUseNewLineMode;
  UseScrollRegion := adc_TermBufUseScrollRegion;

  {set up all the matrices to hold the displayed data}
  {..character matrix}
  {$IFDEF Win32}
  if aUseWideChars then begin
    FCharMatrix := TAdTerminalArray.Create(sizeof(WideChar));
    FCharMatrix.SetDefaultItem(@FDefWideChar);
  end
  else
  {$ENDIF}
  begin
    FCharMatrix := TAdTerminalArray.Create(sizeof(AnsiChar));
    FCharMatrix.SetDefaultItem(@FDefAnsiChar);
  end;
  FCharMatrix.ColCount := adc_TermBufColCount;
  FCharMatrix.RowCount := adc_TermBufScrollRowCount;

  {..character set matrix}
  FCharSetMatrix := TAdTerminalArray.Create(sizeof(byte));
  FCharSetMatrix.SetDefaultItem(@FDefCharSet);
  FCharSetMatrix.ColCount := adc_TermBufColCount;
  FCharSetMatrix.RowCount := adc_TermBufScrollRowCount;

  {..character attributes matrix}
  FAttrMatrix := TAdTerminalArray.Create(sizeof(TAdTerminalCharAttrs));
  FAttrMatrix.SetDefaultItem(@FDefAttr);
  FAttrMatrix.ColCount := adc_TermBufColCount;
  FAttrMatrix.RowCount := adc_TermBufScrollRowCount;

  {..character foreground color matrix}
  FForeColorMatrix := TAdTerminalArray.Create(sizeof(TColor));
  FForeColorMatrix.SetDefaultItem(@FDefForeColor);
  FForeColorMatrix.ColCount := adc_TermBufColCount;
  FForeColorMatrix.RowCount := adc_TermBufScrollRowCount;

  {..character background color matrix}
  FBackColorMatrix := TAdTerminalArray.Create(sizeof(TColor));
  FBackColorMatrix.SetDefaultItem(@FDefBackColor);
  FBackColorMatrix.ColCount := adc_TermBufColCount;
  FBackColorMatrix.RowCount := adc_TermBufScrollRowCount;

  {initialize the terminal dimensions}
  FUseWideChars := aUseWideChars;
  SVRowCount := adc_TermBufScrollRowCount;
  ColCount := adc_TermBufColCount;
  RowCount := adc_TermBufRowCount;

  ClearAllHorzTabStops;
  ClearAllVertTabStops;
  i := Col;
  while (i < ColCount) do begin
    Col := i;
    SetHorzTabStop;
    inc(i, 8);
  end;
  Row := 1;
  Col := 1;

  {set up the current cursor position}
  FCursorRow := SVRowCount - RowCount;
  FDisplayOriginRow := FCursorRow;
  FCursorCol := 0;

  {add the whole screen as an invalid rect}
  FCursorMoved := true;
  tbInvalidateRect(FCursorRow, 0,
                   pred(SVRowCount), pred(ColCount));
  tbFireOnCursorMovedEvent;                                            
end;
{--------}
destructor TAdTerminalBuffer.Destroy;
var
  OurRect : TRect;
begin
  {remove all of the invalid rects and discard them}
  while ADTRemoveInvalidRect(PInvRect(FInvRectList), OurRect) do {nothing};
  {free the tab stops}                                        
  ADTReallocBitset(FVertTabStops, RowCount, 0);               
  ADTReallocBitset(FHorzTabStops, ColCount, 0);               
  {free all arrays}
  FBackColorMatrix.Free;
  FForeColorMatrix.Free;
  FAttrMatrix.Free;
  FCharSetMatrix.Free;
  FCharMatrix.Free;
  inherited Destroy;
end;
{--------}
procedure TAdTerminalBuffer.ClearAllHorzTabStops;
begin
  if (ColCount <> 0) then
    ADTClearAllBits(FHorzTabStops, ColCount);
end;
{--------}
procedure TAdTerminalBuffer.ClearAllVertTabStops;
begin
  if (RowCount <> 0) then
    ADTClearAllBits(FVertTabStops, RowCount);
end;
{--------}
procedure TAdTerminalBuffer.ClearHorzTabStop;
begin
  if (ColCount <> 0) then
    ADTClearBit(FHorzTabStops, FCursorCol);
end;
{--------}
procedure TAdTerminalBuffer.ClearVertTabStop;
begin
  if (RowCount <> 0) then
    ADTClearBit(FVertTabStops, FCursorRow);
end;
{--------}
procedure TAdTerminalBuffer.DeleteChars(aCount : integer);
var
  CharCount : integer;
begin
  FBeyondMargin := false;
  {$IFDEF UseRangeCheck}
  if (aCount <= 0) then
    raise Exception.Create('TAdTerminalBuffer.DeleteChars: count must be positive');
  {$ENDIF}
  {the actual number of characters to delete is constrained by the
   current display region}
  CharCount := FDisplayOriginCol + FDisplayColCount - FCursorCol;
  if (CharCount > aCount) then
    CharCount := aCount;
  if (CharCount > 0) then begin
    FCharMatrix.DeleteItems(CharCount, FCursorRow, FCursorCol);
    FCharSetMatrix.DeleteItems(CharCount, FCursorRow, FCursorCol);
    FAttrMatrix.DeleteItems(CharCount, FCursorRow, FCursorCol);
    FForeColorMatrix.DeleteItems(CharCount, FCursorRow, FCursorCol);
    FBackColorMatrix.DeleteItems(CharCount, FCursorRow, FCursorCol);
    {the cursor does not move}
    tbInvalidateRect (FCursorRow,                                        {!!.05}
                      FCursorCol,                                        {!!.05}
                      FCursorRow,                                        {!!.05}
                      pred (FDisplayOriginCol + FDisplayColCount));      {!!.05}
  end;