awterm.pas

测试用例

type
  PMinMaxInfo = ^TMinMaxInfo;
  TMinMaxInfo = record
    ptReserved     : TPoint;
    ptMaxSize      : TPoint;
    ptMaxPosition  : TPoint;
    ptMinTrackSize : TPoint;
    ptMaxTrackSize : TPoint;
  end;

const
  tmScrollTimer = 1;
  tmBlinkTimer  = 2;
  DefBlinkTime  = 550;

  {Default buffer size}
  DefRows = 200;
  DefCols = 80;
  DefPageHeight = 25;

  {Default font, OemFixedFont}
  DefFont = Oem_Fixed_Font;

  {Capture buffer constants}
  DefCaptureName = 'CAPTURE.CAP';
  MaxCaptureSize = 8192;

  {Tab stop constants}
  DefTabStop     = 8;

  {moved here for access to the emulator types in the terminal window}
  {Emulator types}
  etNone      = 0;
  etANSI      = 1;
  etVT52      = 2;
  etVT100     = 3;
  etANSIBBS   = 4;


{General purpose routines}

  function GetTerminalPtr(HW : TApdHwnd) : TTerminal;
    {-Extract the terminal window object pointer from the window long}
  begin
    GetTerminalPtr := TTerminal(GetWindowLong(HW, gwl_Terminal));
  end;

{TBuffer}

  constructor TBuffer.Create(AWnd : TApdHwnd; Height, Width : Word);
    {-Allocate pages and init fields}
  begin
    inherited Create;
    {Load the default color map}
    Move(ColorValues, bColors, SizeOf(bColors));

    {Set the startup colors}
    bSetColors(aweDefForeground, aweDefBackground);

    {Allocate buffers}
    bScreenBuffer := nil;
    bAttrBuffer := nil;
    bAttrBufferB := nil;
    bExtAttrBuffer := nil;
    bHorizTabStop := nil;
    bVertiTabStop := nil;

    bBufferSize := 0;

    if bNewBuffer(Height, Width, DefPageHeight) <> ecOK then
      raise Exception.Create('Buffer allocation failed');

    {Init fields}
    bWnd := AWnd;
    bCapture := False;
    bCom := nil;
    bExtAttr := 0;
    bBlinkReset := False;
    bInMargins := True;
    bSaveFlag := False;

    {No marking}
    bResetMarking;
    bSetHighlightColors(aweDefBackground, aweDefForeground);

    {Start off with a null emulator}
    bEmulator := nil;
    @bEmuProc := nil;
  end;

  destructor TBuffer.Destroy;
    {-Clean up}
  begin
    if bCapture then
      bSetCapture(False, False, '');
    bDeallocBuffers;
  end;

  procedure TBuffer.bDeallocBuffers;
    {-Release pages}
  begin
    if bScreenBuffer <> nil then
      FreeMem(bScreenBuffer, bBufferSize);
    if bAttrBuffer <> nil then
      FreeMem(bAttrBuffer, bBufferSize);
    if bAttrBufferB <> nil then
      FreeMem(bAttrBufferB, bBufferSize);
    if bExtAttrBuffer <> nil then
      FreeMem(bExtAttrBuffer, bBufferSize);
    if bHorizTabStop <> nil then
      FreeMem(bHorizTabStop, SizeOf(THorizontalTabStop));
    if bVertiTabStop <> nil then
      FreeMem(bVertiTabStop, SizeOf(TVerticalTabStop));
  end;

  function TBuffer.bNewBuffer(Rows, Cols, PageHeight : Word) : Integer;
    {-Free the old buffer, allocate a new one}
  var
    Attr : Byte;
    Loop : Byte;
  begin
    {Check for maximum column size}
    if Cols > MaxCols then begin
      bNewBuffer := ecBadArgument;
      Exit;
    end;

    {Check for to few Rows}
    if (PageHeight > Rows) then begin
      bNewBuffer := ecBadArgument;
      Exit;
    end;

    {Check new size}
    if LongInt(Rows) * Cols > 65535 then begin
      bNewBuffer := ecBadArgument;
      Exit;
    end;

    {Get rid of old buffers, if any}
    bDeallocBuffers;

    {calculate new buffer size}
    bBufferSize := Rows * Cols;                                      

    {Allocate new buffers}
    bScreenBuffer := AllocMem(bBuffersize);
    bAttrBuffer := AllocMem(bBufferSize);
    bAttrBufferB := AllocMem(bBufferSize);
    bExtAttrBuffer := AllocMem(bBufferSize);
    bHorizTabStop := AllocMem(SizeOf(THorizontalTabStop));
    bVertiTabStop := AllocMem(SizeOf(TVerticalTabStop));

    {Okay}
    bNewBuffer := ecOK;

    {Init buffer fields}
    bWidth := Cols;
    bHeight := Rows;
    bX := 0;
    bY := 0;
    bMaxY := PageHeight-1;
    bPageHeight := PageHeight;

    {Initialize screen and attribute buffers}
    FillChar(bScreenBuffer^, bBufferSize, ' ');
    FillChar(bAttrBuffer^, bBufferSize, 0);
    Attr := (bbColor shl 4) or bbColor;
    FillChar(bAttrBuffer^, bWidth*bPageHeight, Attr);

    FillChar(bAttrBufferB^, bBufferSize, 0);
    FillChar(bExtAttrBuffer^, bBufferSize, 0);
    FillChar(bAttrBufferB^, bWidth*bPageHeight, Attr);
    FillChar(bHorizTabStop^, SizeOf(THorizontalTabStop), 0);

    {initialize the tab stop buffer to ever Nth column}
    for Loop := 1 to (bWidth div DefTabStop) do
      bSetHorizontalTabStop(Loop*DefTabStop);

    FillChar(bVertiTabStop^, SizeOf(TVerticalTabStop), 0);

    {Set total number of chars -1 line}
    bBufferLimit :=  LongInt(bWidth)*(bHeight-1);

    {No update needed right now}
    bNeedVScroll := 0;
    bNeedHScroll := 0;
    FillChar(bRedrawRect, SizeOf(bRedrawRect), 0);

    {Initial client area is upper left quadrant of buffer}
    bXPos := 0;
    bYPos := 0;
    cLastHeight := 0;
    cLastWidth := 0;
    cMarginBottom := bPageHeight;
  end;

  procedure TBuffer.bSetColors(FC, BC : Word);
    {-Set default colors}
  begin
    bfColorOrg := FC;
    bbColorOrg := BC;
    bfColor := FC;
    bbColor := BC;
    bSetHighlightColors(BC, FC);
  end;

  procedure TBuffer.bSetHighlightColors(FC, BC : Word);
  begin
    bMarkColorF := FC;
    bMarkColorB := BC;
  end;

  procedure TBuffer.bFlushCapture;
    {-Flush capture file, turn off capture on error}
  var
    BW : Cardinal;
    Res : Integer;
  begin
    if bCapIndex >= 1 then begin                                    
      BlockWrite(bCaptureFile, bCapBuffer^, bCapIndex, BW);
      if BW <> bCapIndex then
        Res := ecDiskFull
      else
        Res := IoResult;
      if Res <> ecOK then begin
        FreeMem(bCapBuffer, MaxCaptureSize);
        Close(bCaptureFile);
        bCapture := False;                                         
        if IoResult <> ecOK then ;
        SendMessage(bWnd, apw_TermError, Word(-Res), 0);
      end;
      bCapIndex := 0;
    end;
  end;

  procedure TBuffer.bAddToCapture(C : Char);
    {-Add C to capture file, turn off capture on error}
  begin
    if bCapture then begin
      Inc(bCapIndex);
      bCapBuffer^[bCapIndex] := C;
      if bCapIndex = MaxCaptureSize then
        bFlushCapture;
    end;
  end;

  function TBuffer.bSetCapture(Enable, Append : Bool; FName : PChar) : Integer;
    {-Turn capturing on/off}
  var
    Res : Word;
  begin
    if Enable and not bCapture then begin
      {Allocate a capture buffer}
      bCapBuffer := AllocMem(MaxCaptureSize);

      {Get file name}
      if FName[0] = #0 then
        StrCopy(bCaptureName, DefCaptureName)
      else
        StrCopy(bCaptureName, FName);
      {Open the file...}
      Assign(bCaptureFile, bCaptureName);
      if Append then begin
        {Appending, get file size, seek to end}
        Reset(bCaptureFile, 1);
        Res := IoResult;
        case Res of
          0 : begin
                Seek(bCaptureFile, FileSize(bCaptureFile));
                Res := IoResult;
              end;
          2 : begin
                Rewrite(bCaptureFile, 1);
                Res := IoResult;
              end;
        end;
        if Res <> 0 then begin
          Close(bCaptureFile);
          bCapture := False;                                    
          if IoResult <> 0 then ;
        end;
      end else begin
        {Not appending, open new file}
        Rewrite(bCaptureFile, 1);
        Res := IoResult;
      end;

      {If capture started okay, init fields}
      if Res = ecOK then begin
        bCapture := True;
        bCapIndex := 0;
      end;
    end else if bCapture then begin
      {Ending capture, close file and release buffer}
      bFlushCapture;
      Close(bCaptureFile);
      Res := IoResult;
      FreeMem(bCapBuffer, MaxCaptureSize);
      bCapture := False;
    end else
      Res := 0;
    bSetCapture := -Res;
  end;

  procedure TBuffer.bSetScrollMode(Scrollback : Bool);
    {-Set flag in buffer for normal or scrollback}
  begin
    bScrollback := Scrollback;
  end;

  procedure TBuffer.bInvalidateChar(X, Y : Word);
    {-Invalidate client rectangle containing Buffer location X, Y}
  var
    Rect : TRect;
  begin
    {Convert buffer(X,Y) to client area coordinates}
    with Rect do begin
      Left   := (X-bXPos) * bCharWidth;
      Top    := (Y-bYPos) * bCharHeight;
      Right  := Left + bCharWidth;
      Bottom := Top + bCharHeight;

      if (Bottom <= cSizeY) then
        {Merge this invalid area with existing update rectangle}
        UnionRect(bRedrawRect, bRedrawRect, Rect)
      else
        {Character is outside of client area, just move caret}
        bMoveCaret;
    end;
  end;

  procedure TBuffer.bPostStatusMsg;
    {-Send a status message to the window}
  var
    Row, Col, Left : Word;
    Top : LongInt;
  begin
    if bScrollback then begin
      {Row/Col always zero when in scrollback mode}
      Row := 0;
      Col := 0;
    end else begin
      {Set Row/Col to current cursor position}
      Col := bX+1;
      Row := bY-bYPos+1;
    end;

    {Coordinate of top/left visible corner}
    Left := bXPos+1;
    Top := bYPos+1;
    PostMessage(bWnd, apw_TermStatus,
                (Col shl 8) or Row,
                (LongInt(Left) shl 16) or Top);
  end;

  procedure TBuffer.bUpdateFont(Height, Width : Word);
    {-Set new char width and height values}
  begin
    bCharHeight := Height;
    bCharWidth  := Width;
    cHeight := cSizeY div bCharHeight;
    cWidth := cSizeX div bCharWidth;
    cMarginBottom := bPageHeight;
    cMarginTop := 1;
  end;

  procedure TBuffer.bUpdateBuffer;
    {-Adjust buffer contents or bYPos,bXPos for new bX,bY value}
  var
    Diff : Integer;
    Max  : Word;
    TempBuf        : array[0..MaxCols-1] of byte;
    TempAttrBuf    : array[0..MaxCols-1] of byte;
    TempAttrBufB   : array[0..MaxCols-1] of byte;
    TempExtAttrBuf : array[0..MaxCols-1] of byte;
    Limit : Word;
    MoveSize : Word;
    MoveFrom : Word;
    MoveTo : Word;
  begin
    {Adjust highwater mark}
    if (bY > bMaxY) and (bY <> bHeight) then begin
      bMaxY := bY;
      if bScrollback then begin
        {Adjust scroll range}
        if bMaxY >= cHeight then
          Max := (bMaxY-cHeight)+1
        else
          Max := bMaxY;
        SetScrollRange(bWnd, sb_Vert, 1, Max, False);
      end;
    end;

    MoveSize := bBufferLimit-((bPageHeight-cMarginBottom)*bWidth);
    Limit := bY+(bPageHeight-cMarginBottom);

    if Limit = bHeight then begin
      {Buffer is full, move data and attributes up one line, clear last line}
      Move(bScreenBuffer^[bWidth], bScreenBuffer^[0], MoveSize);
      Move(bAttrBuffer^[bWidth], bAttrBuffer^[0], MoveSize);
      Move(bAttrBufferB^[bWidth], bAttrBufferB^[0], MoveSize);
      Move(bExtAttrBuffer^[bWidth], bExtAttrBuffer^[0], MoveSize);

      FillChar(bScreenBuffer^[MoveSize], bWidth, ' ');
      FillChar(bAttrBuffer^[MoveSize], bWidth, (bbColor shl 4) or bfColor);