emulvt.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.BackSpace;
begin
    if FCol > 0 then
        Dec(FCol);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ClearScreen;
var
    Row : Integer;
begin
    for Row := 0 to FRowCount - 1 do
        Lines[Row].Clear(FAttribute);
    FRow := 0;
    FCol := 0;
    FAllInvalid := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.InvClear;
begin
    with FInvRect do begin
        Top    := 9999;
        Left   := 9999;
        Right  := -1;
        Bottom := -1;
    end;
    FAllInvalid := FALSE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.InvRect(nRow, nCol : Integer);
begin
    if not FAllInvalid then begin
        if FInvRect.Top > nRow then
            FInvRect.Top := nRow;
        if FInvRect.Bottom < nRow then
            FInvRect.Bottom := nRow;
        if FInvRect.Left > nCol then
            FInvRect.Left := nCol;
        if FInvRect.Right < nCol then
            FInvRect.Right := nCol;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ The FLines array is inverted with the last host line at position 0 and
  the first host line as position FRowCount - 1. }
procedure Tscreen.SetLines (I : Integer; Value : TLine);
begin
    FLines^[FRowCount - 1 - I] := Value;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TScreen.GetLines (I : Integer) : TLine;
begin
    Result := FLines^[FRowCount - 1 - I];
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.Eol;
begin
    with Lines[FRow] do begin
        FillChar(Txt[FCol], FColCount - FCol, ' ');
        FillChar(Att[FCol], (FColCount - FCol) * SizeOf(Att[FCol]), FAttribute);
    end;
    InvRect(Frow, FCol);
    InvRect(Frow, FColCount);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.Eop;
var
    Row : Integer;
begin
    Eol;
    for Row := FRow + 1 to FRowCount - 1 do
        Lines[Row].Clear(FAttribute);
    if FRow = 0 then
        FAllInvalid := TRUE
    else begin
       InvRect(FRow, 0);
       InvRect(FRowCount, FColCount);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_J;                  { Clear the screen         }
var
    Mode : Integer;
    Row  : Integer;
begin
    GetEscapeParam(2, Mode);
    case Mode of
    0: begin                                   { Cursor to end of screen    }
           FAttribute := F_WHITE;
           Eop;
       end;
    1: begin                                   { Start of screen to cursor  }
           for Row := 0 to FRow do
               Lines[Row].Clear(FAttribute);
           InvRect(0, 0);
           InvRect(FRow, FColCount);
       end;
    2: begin                                   { Entire screen              }
           if vtoCopyBackOnClear in FOptions then CopyScreenToBack;
           ClearScreen;
       end;
    else
        InvalidEscape('J');
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_K;                  { Erase to End of Line    }
begin
    Eol;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_L;                   { Insert Line             }
var
    nLine : Integer;
    nRow  : Integer;
    Temp  : TLine;
begin
    FCol := 0;
    GetEscapeParam(2, nLine);
    if nLine = 0 then
        nLine := 1;

    if (FRow + nLine) > FScrollRowBottom then begin
        for nRow := FRow to FScrollRowBottom do
            Lines[nRow].Clear(FAttribute);
        Exit;
    end;

    for nRow := FScrollRowBottom downto FRow + nLine do begin
        Temp                := Lines[nRow];
        Lines[nRow]         := Lines[nRow - nLine];
        Lines[nRow - nLine] := Temp;
    end;

    for nRow := FRow to FRow + nLine - 1 do
        Lines[nRow].Clear(FAttribute);

    FAllInvalid := TRUE;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_M;                   { Delete Line             }
var
    nLine : Integer;
    nRow  : Integer;
    Temp  : TLine;
begin
    FAllInvalid := TRUE;
    FCol := 0;
    GetEscapeParam(2, nLine);
    if nLine = 0 then
        nLine := 1;

    if (FRow + nLine) > FScrollRowBottom then begin
        for nRow := FRow to FScrollRowBottom do
            Lines[nRow].Clear(FAttribute);
        Exit;
    end;

    for nRow := FRow to FRow + nLine - 1 do
        Lines[nRow].Clear(FAttribute);
    for nRow := FRow to FScrollRowBottom - nLine do begin
        Temp                := Lines[nRow];
        Lines[nRow]         := Lines[nRow + nLine];
        Lines[nRow + nLine] := Temp;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_m_lc;               { Select Attributes       }
var
    From, n : Integer;
begin
    if FEscBuffer[1] <> '[' then
        Exit;

    if Length(FEscBuffer) < 2 then begin
        FAttribute    := F_WHITE;
        FReverseVideo := FALSE;
        Exit;
    end;

    From := 2;
    while From <= Length(FEscBuffer) do begin
        if FEscBuffer[From] in [' ', '[', ';'] then
            Inc(From)
        else begin
            From := GetEscapeParam(From, n);
            case n of
	    0: 	begin			{ All attributes off	   }
		    FAttribute    := F_WHITE;
		    FReverseVideo := FALSE;
                    FUnderLine    := FALSE;
                end;
	    1:	begin			{ High intensity	   }
		    FAttribute := FAttribute or F_INTENSE;
		end;
            4:  begin                   { Underline                }
                    FUnderLine := TRUE;
                end;
	    5:	begin			{ Blinking		   }
		    FAttribute := FAttribute or B_BLINK;
		end;
	    7:	begin			{ Reverse video	           }
		    FReverseVideo := TRUE;
		end;
	    8:	begin			{ Secret		   }
		    FAttribute := 0;
		end;
	    10:	begin			{ Don't force high bit	   }
		    FForceHighBit := FALSE;
		end;
	    12:	begin			{ Force high bit on	   }
		    FForceHighBit := TRUE;
		end;
	    22:	begin			{ Normal intensity	   }
		    FAttribute := FAttribute and (not F_INTENSE);
		end;
	    27: begin			{ Normal characters	   }
		    FAttribute    := F_WHITE;
		    FReverseVideo := FALSE;
		end;
	    30, 31, 32, 33, 34, 35, 36, 37:
                begin			{ Foreground color	   }
		    FAttribute := (n mod 10) or (FAttribute and $F8);
		end;
	    40, 41, 42, 43, 44, 45, 46, 47:
                begin                   { Background color	   }
		    FAttribute := ((n mod 10) shl 4) or (FAttribute and $8F);
		end;
	    else
		InvalidEscape('m');
	    end;
        end;
    end;
    if FReverseVideo then begin
        FAttribute := ((FAttribute and 7) shl 4) or
                      ((FAttribute shr 4) and 7) or
                      (FAttribute and $88);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_n_lc;                { Cursor position report  }
begin
    UnimplementedEscape('n');
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_at;                 { Insert character        }
var
    nChar : Integer;
    nCnt  : Integer;
    nCol  : Integer;
    Line  : TLine;
begin
    GetEscapeParam(2, nChar);
    if nChar = 0 then
        nChar := 1;

    nCnt := FColCount - FCol - nChar;
    if nCnt <= 0 then begin
        Eol;
        Exit;
    end;

    Line := Lines[FRow];
    for nCol := FColCount - 1 downto FCol + nChar do begin
        Line.Txt[nCol] := Line.Txt[nCol - nChar];
        Line.Att[nCol] := Line.Att[nCol - nChar];
        InvRect(Frow, nCol);
    end;

    for nCol := FCol to FCol + nChar - 1 do begin
        Line.Txt[nCol] := ' ';
        Line.Att[nCol] := FAttribute;
        InvRect(Frow, nCol);
    end;

end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TScreen.ProcessCSI_r_lc;                { Scrolling margins       }
var
    From, Top, Bottom : Integer;
begin
    From := GetEscapeParam(2, Top);
    if Top = 0 then begin                         { Default = full screen   }
        FScrollRowTop    := 0;
        FScrollRowBottom := FRowCount - 1;
    end
    else begin
        while (From <= Length(FEscBuffer)) and (FEscBuffer[From] = ' ') do
            From := From + 1;
        if FEscBuffer[From] = ';' then
            GetEscapeParam(From + 1, Bottom)
        else
            Bottom := 1;

        FScrollRowTop    := Top    - 1;
        FScrollR