{ 
    SemTel version 1.0.0 ... comfortable telnet client
    Copyright (C) 1995-2000 Jan Tomasek <jan@tomasek.cz>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
{-------------------------------------------------------------------------------
Version  : 0.882
Date     : 22.07.98
Dialog   :
History  :
  19.05.98 pridana metoda scroll, mozno kopirovat z jine nez posledni stranky
           konzole
  22.07.98 kurzor se už chová normálně
TODO     :
-------------------------------------------------------------------------------}
unit Console;
{$F+}

interface
Uses
  Classes,  Controls, WinTypes, WinProcs,
  Graphics, SysUtils, Forms,    Dialogs,
  ExtCtrls, StdCtrls, Messages;

Const
  prCols  = 1;
  prRows  = 2;
Type
  TCel       = Record
    Char   : Byte;
    Color  : Byte;
    Attrib : Byte;
  End;
Const
  ColSize = SizeOf(TCel);
  RowSize = SizeOf(Pointer);
  maxCols = ($FFFF Div ColSize)-1;
  maxRows = {}($FFFF Div RowSize)-1{25};
Type
  PRow       =^TRow;
  TRow       = Array[0..maxCols] of TCel;
  PBuffer    =^TBuffer;
  TBuffer    = Array[0..maxRows-1] of PRow;
{-------------------------------------------------------------------------------
Buffer organisation:            1                        2
................................nnnnnnnnnnnnnnnnnnnnnnnnnVVVVVVVVVVVVVVVVVVVnnnn
. Empty positions in buffer = nil, not allocated!
n allocated positions, but not visible. Memory for scrolling.
V allocated positions and visible.
1 FBufferTop
2 FVisibleTop
-------------------------------------------------------------------------------}
Type
  TCursorMode = (cmOverride, cmInsert, cmLine);
  TColorTable =  Record
    Pen   : Array [0..15] of TColor;
    Paper : Array [0..15] of TColor;
  End;
  PxTermConsole =^TxTermConsole;
  TxTermConsole = class (TGraphicControl)
  private
    FBuffer        : PBuffer;    {Char/Color/Attrib buffer}
    FBufferTop     : Word;       {First allocated line of buffer, the oldest line!}
    LastPageStart  : Word;
    BufferRaised   : Boolean;
    FVisibleTop    : Word;       {Position of begin of visible area. End=FVisibleTop+FRows-1}
    FCols          : Word;       {Number of cols of visible area (X dimension)}
    FRows          : Word;       {Number of rows of visible area (Y dimension)}
    FFontName      : String;     {Name of font}
    FFontSize      : Integer;    {Size of font}
    FFontBold      : Boolean;    {Bold face?}
    FFontHeight    : Integer;    {Size of font}
    FCharDim       : TPoint;     {Dimensions of character cell}
    FTextMetrics   : TTextMetric;
    FCursor        : TPoint;     {Cursor position}
    FCursorVisible : Boolean;    {NC}
    FCursorCreated : Boolean;
    FFullTimeCursor: Boolean;    {}
    FCursorMode    : TCursorMode;{Override, insert}
    FCursorColor   : LongInt;
    FColorTable    : TColorTable;
    FPenColor      : Byte;       {Foreground color}
    FPaperColor    : Byte;       {Background color}
    FTabSize       : Byte;
    FScrollBar     : TScrollBar;
    FScrollRegY1   : Integer;
    FScrollRegY2   : Integer;

    FAutoMargin    : Boolean;
    FCheckBeforeCh : Boolean;

    AllChanged     : Boolean;
    UpdateTimer    : TTimer;

    {-- property stuff --------------------------------------------------------}
    procedure WColsRows(Index:Integer;W:Word);
    procedure WFontName(aName:String);
    procedure WPenColor(C:Byte);
    procedure WPaperColor(C:Byte);
    procedure WFontSize(aSize:Integer);
    procedure WFontHeight(aHeight:Integer);
    procedure WFontBold(aBold:Boolean);
    function  RFontSize:Integer;
    Function  RFontHeight:Integer;
    procedure WCursorVisible(B:Boolean);
    procedure WCursorMode(M:TCursorMode);
    procedure WCursorColor(C:Longint);
    function  RScreenWidth:Word;
    function  RScreenHeight:Word;
    function  RScrollBarWidth:Word;
    {-- buffer stuff ----------------------------------------------------------}
    procedure AllocBuffer;
    procedure DisposeBuffer;
    {procedure ClearBuffer;}
    function  AllocRow:PRow;
    procedure ClearRow(Row:PRow;Color:Byte);
    {-- scrolling stuff -------------------------------------------------------}
    procedure SetScrollBar;
    procedure ScrollEvent(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
    {-- other stuff -----------------------------------------------------------}
    procedure InitFont; {Set font to canvas, after FontName, FontSize change}
  public
    FbFontSize     : Boolean;    {Used size/height}
    FCaretBm       : TBitmap;

    {-- buffer stuff ----------------------------------------------------------}
    procedure ResizeTo(aCols,aRows:Word);

    {-- Painting stuff --------------------------------------------------------}
    procedure RePaint; override;
    procedure Paint; override;
    procedure InteligentPaint;
    procedure TimerPaint(Sender:TObject);

    {-- Printing stuff --------------------------------------------------------}
    procedure WriteBuff(S:PChar;Len:Word);
    procedure WriteChar(C:Char);
    procedure WriteString(S:String);
    procedure InsertCharacters(No:Word);
    procedure InsertLine(No:Word);
    procedure RepeatLastChar(No:Word);
    procedure DeleteCharacters(No:Word);
    procedure DeleteLine(No:Word);
    procedure ClrScr;
    procedure ClrEol;
    procedure ClrBol;
    procedure ClrEos;
    function  GetText(X,Y,XX,YY:Word):PChar;
    procedure ReverseScroll;
    procedure NormalScroll;

    {-- Init/Destroy stuff ----------------------------------------------------}
    Constructor Create(aOwner:TComponent); override;
    Destructor Destroy; override;

    {-- Other stuff -----------------------------------------------------------}
    procedure CursorTo(X,Y:Integer);
    procedure Cursor2Home;
    procedure Cursor2ll;
    procedure ValidateCursorPos;
    procedure _CursorCreate;   {Vytvoří kurzor, a nastaví FCursorCreated=1, FCursorVisible=0}
    function  CaretCreate:boolean;
    function  CaretShow:boolean;
    function  CaretHide:boolean;
    function  CaretDestroy:boolean;
    procedure _CursorDestroy;  {Zlikviduje kurzor, a nastaví FCursorCreated=0, FCursorVisible=0}
    procedure _CursorShow;     {Zobrazí kurzor, nastaví FCursorVisible=1}
    procedure _CursorHide;     {Skryje kurzor, nastaví FCursorVisible=0}
    procedure _CursorMoveTo;   {Realizuje přesun kurzoru na pozici FCursor}
    Procedure SaveToFile(Var TF:TextFile; ANSI:Boolean; Msg:Word);
    procedure Scroll(ScrollCode: TScrollCode);

    property CharSize      : TPoint            read FCharDim;
    property ScreenWidth   : Word              read RScreenWidth;
    property ScreenHeight  : Word              read RScreenHeight;
    property CursorPos     : TPoint            read FCursor         write FCursor;
    property ScrollBarWidth: Word              read RScrollBarWidth;
    property ScrollBar     : TScrollBar        read FScrollBar      write FScrollBar;
    property ColorTable    : TColorTable       read FColorTable     write FColorTable;
    property ScreenTop     : Word              read LastPageStart;
    property ScrollRegY1   : Integer           Read FScrollRegY1    write FScrollRegY1;
    property ScrollRegY2   : Integer           Read FScrollRegY2    write FScrollRegY2;
  published
    property AutoMargin    : Boolean           read FAutoMargin     write FAutoMargin;
    property CheckBeforeCh : Boolean           read FCheckBeforeCh  write FCheckBeforeCh;
    property Cols          : Word index prCols read FCols           write WColsRows        default 80;
    property Rows          : Word index prRows read FRows           write WColsRows        default 24;
    property FontName      : String            read FFontName       write WFontName;
    property FontSize      : Integer           read RFontSize       write WFontSize        default 8;
    property FontHeight    : Integer           read RFontHeight     write WFontHeight      default 8;
    property FontBold      : Boolean           read FFontBold       write WFontBold        default False;
    property PenColor      : Byte              read FPenColor       write WPenColor        default 0;
    property PaperColor    : Byte              read FPaperColor     write WPaperColor      default 0;
    property CursorVisible : Boolean           read FCursorVisible  write WCursorVisible   default True;
    property CursorCreated : Boolean           read FCursorCreated;
    property FullTimeCursor: Boolean           read FFullTimeCursor write FFullTimeCursor  default True;
    property CursorMode    : TCursorMode       read FCursorMode     write WCursorMode      default cmOverride;
    property CursorColor   : LongInt           read FCursorColor    write WCursorColor     default clLime;
    property TabSize       : Byte              read FTabSize        write FTabSize         default 8;
    property Align;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDblClick;
  End;{-- TxTermConsole -------------------------------------------------------}

  Function RealXOR(A, B: Longint):Longint;

Const
  clrBlack     = 0;
  clrRed       = 1;
  clrGreen     = 2;
  clrYellow    = 3;
  clrBlue      = 4;
  clrMagenta   = 5;
  clrCyan      = 6;
  clrWhite     = 7;
  clrNormal    = 8;
  clrInverse   = 9;
  clrBold      =10;
  clrUnderline =11;
  clrBlink     =12;
  clrLocalEcho =13;

  clrDefault   = (clrNormal shl 4)or clrNormal;

procedure Register;

implementation
Uses
  C3216, SafeMem;

Const
  chrEmpty     = #32;

  atrNone      =             $00;
  atrChanged   = {1000 0000} $80;
  atrBold      = {0000 0001} $01;
  atrItalic    = {0000 0010} $02;
  atrUnderLine = {0000 0011} $03;

  DefColorTable : TColorTable =
   (Pen:  ((clGray ),(clRed),   (clLime), (clYellow),(clBlue), (clFuchsia),(clAqua), (clWhite),
           (clBlack),(clBlack), (clBlack),(clBlack), (clBlack),(clBlack),  (clBlack),(clBlack));
    Paper:((clBlack),(clMaroon),(clGreen),(clOlive), (clNavy), (clPurple), (clTeal), (clSilver),
           (clWhite),(clWhite), (clWhite),(clWhite), (clWhite),(clWhite),  (clWhite),(clWhite)));


procedure Register;
Begin
  RegisterComponents('Custom', [TxTermConsole]);
End;

{** property stuff ************************************************************}
procedure TxTermConsole.WColsRows(Index:Integer;W:Word);
Begin
  Case Index of
    prCols : ResizeTo(W,FRows);
    prRows : ResizeTo(FCols,W);
  End;
End;{-- WColsRows -------------------------------------------------------------}
procedure TxTermConsole.WFontName(aName:String);
begin
  FFontName:=aName;
  InitFont;
  Invalidate;
end; {-- WFontName ------------------------------------------------------------}
procedure TxTermConsole.WPenColor(C:Byte);
Begin
  FPenColor   := C;
End; {-- WPenColor ------------------------------------------------------------}
procedure TxTermConsole.WPaperColor(C:Byte);
Begin
  FPaperColor := C;
End; {-- WPaperColor ----------------------------------------------------------}
procedure TxTermConsole.WFontSize(aSize:Integer);
begin
  FFontSize:=aSize;
  FbFontSize:=True;
  InitFont;
  Invalidate;
end; {-- WFontSize ------------------------------------------------------------}
procedure TxTermConsole.WFontHeight(aHeight:Integer);
begin
  FFontHeight:=aHeight;
  FbFontSize:=False;
  InitFont;
  Invalidate;
end; {-- WFontHeight ----------------------------------------------------------}
procedure TxTermConsole.WFontBold(aBold:Boolean);
Begin
  FFontBold:=aBold;
  InitFont;
  Invalidate;
End; {-- WFontBold ------------------------------------------------------------}
function  TxTermConsole.RFontSize:Integer;
begin
  Result:=abs(Canvas.Font.Size);
end; {-- RFontSize ------------------------------------------------------------}
function  TxTermConsole.RFontHeight:Integer;
begin
  Result:=abs(Canvas.Font.Height);
end; {-- RFontHeight ----------------------------------------------------------}
procedure TxTermConsole.WCursorVisible(B:Boolean);
Begin
  If B=FCursorVisible Then Exit;
  {!@# If B Then CursorShow Else CursorHide;}
End;{-- WCursorVisible --------------------------------------------------------}
procedure TxTermConsole.WCursorMode(M:TCursorMode);
Var
  CV : Boolean;
Begin
  If M=FCursorMode Then Exit;
  CV:=FCursorVisible;
  If CV Then Begin
    _CursorDestroy;
    FCursorMode:=M;
    _CursorCreate;
  End;
End;{-- WCursorMode -----------------------------------------------------------}
procedure TxTermConsole.WCursorColor(C:Longint);
Begin
  FCursorColor:=C;
  _CursorCreate;
End;{-- WCursorColor ----------------------------------------------------------}
function  TxTermConsole.RScreenWidth:Word;
Begin
  Result:=FCharDim.X*FCols+FScrollBar.Width;
End;{-- RScreenWidth ----------------------------------------------------------}
function  TxTermConsole.RScreenHeight:Word;
Begin
  Result:=FCharDim.Y*FRows;
End;{-- RScreenHeight ---------------------------------------------------------}
function TxTermConsole.RScrollBarWidth:Word;
Begin
  Result:=FScrollBar.Width;
End;

{** buffer stuff **************************************************************}
Procedure TxTermConsole.AllocBuffer;
Var
  I : Word;
Begin
  SafeGetMem(FBuffer, maxRows*RowSize);
  For I:=0 To maxRows-1 Do FBuffer^[I]:=nil;

  For I:=LastPageStart To maxRows-1 Do
   Begin
     FBuffer^[I]:=AllocRow;
     ClearRow(FBuffer^[I],clrDefault);
   End;
End;{-- AllocBuffer -----------------------------------------------------------}
procedure TxTermConsole.DisposeBuffer;
Var
  I : Word;
Begin
  For I:=FBufferTop To maxRows-1 Do
   Begin
     SafeFreeMem(FBuffer^[I], FCols*ColSize);
   End;
  SafeFreeMem(FBuffer,maxRows*RowSize);
  FBuffer:=nil;
End;{-- AllocBuffer -----------------------------------------------------------}
function  TxTermConsole.AllocRow:PRow;
Begin
  SafeGetMem(Result, FCols*ColSize);
End;{-- AllocRow --------------------------------------------------------------}
procedure TxTermConsole.ClearRow(Row:PRow;Color:Byte);
Var
  I : Word;
Begin
  For I:=0 To FCols-1 Do
   Begin
     Row^[I].Char  := Byte(chrEmpty);
     Row^[I].Color := Color;
     Row^[I].Attrib:= atrChanged;
   End;
End;{-- ClearRow --------------------------------------------------------------}
procedure TxTermConsole.ResizeTo(aCols,aRows:Word);
Var
  Y,X       : Word;
  OldRowLen : Word;
  OldRow    : PRow;
  NewRow    : PRow;
Begin
  OldRowLen      := FCols;

  FCols          := aCols;
  FRows          := aRows;
  LastPageStart  := maxRows-FRows;
  FScrollRegY1   := FScrollRegY1; {???}
  FScrollRegY2   := FRows-1;
  FVisibleTop    := LastPageStart;
  Width          := FCharDim.X*FCols+FScrollBar.Width;
  Height         := FCharDim.Y*FRows;

  For Y:=0 To maxRows-1 Do
   Begin
     NewRow := nil;
     OldRow := FBuffer^[Y];
     If OldRow<>nil Then
      Begin
        NewRow:=AllocRow;
        ClearRow(NewRow,clrDefault);
        For X:=0 To Min(OldRowLen-1,FCols-1) Do NewRow^[X]:=OldRow^[X];
        SafeFreeMem(OldRow, OldRowLen*ColSize);
      End
     Else
      If LastPageStart<=Y Then
       Begin
         FBufferTop := LastPageStart;
         NewRow     := AllocRow;
         ClearRow(NewRow,clrDefault);
       End;
     FBuffer^[Y] := NewRow;
   End;

  Paint;
  SetScrollBar;
End;{-- ResizeTo --------------------------------------------------------------}

{** scrolling stuff ***********************************************************}
procedure TxTermConsole.SetScrollBar;
Var
  I   : Word;
  Max : Word;
Begin
  If not Assigned(FScrollBar) Then Exit;
  
  FScrollBar.Top         := 0;
  FScrollBar.Height      := FCharDim.Y*FRows-1;
  FScrollBar.Left        := FCharDim.X*FCols;
  FScrollBar.SmallChange := 1;
  FScrollBar.LargeChange := FRows-1;
  If LastPageStart-FBufferTop>0 Then
   Begin
     FScrollBar.Enabled := True;
     Max                := LastPageStart-FBufferTop; If Max=1 Then Max:=2;
     If FScrollBar.Position=FScrollBar.Max Then I:=Max Else I:=FScrollBar.Position;
     FScrollBar.SetParams(I,1,Max);
   End
  Else FScrollBar.Enabled:= False;
End;
procedure TxTermConsole.ScrollEvent(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer);
Var
  Y         : Real;
Begin
  Case ScrollCode of
    scLineUp,
    scLineDown,
    scPageUp,
    scPageDown,
    scPosition,
    scTrack,
    scEndScroll :
     Begin
       Y          := (ScrollPos-FScrollBar.Min)/(FScrollBar.Max-FScrollBar.Min);
       FVisibleTop:= FBufferTop+Round(Y*(LastPageStart-FBufferTop));
       AllChanged := True;
     End;
    scTop       : Begin FVisibleTop:=FBufferTop;   AllChanged:=True End;
    scBottom    : Begin FVisibleTop:=LastPageStart;AllChanged:=True End;
{    scLineUp :
     If FVisibleTop>FBufferTop Then
      Begin
        Dest := Rect(0,FCharDim.Y,FCols*FCharDim.X,FRows*    FCharDim.Y);
        Src  := Rect(0,0,         FCols*FCharDim.X,(FRows-1)*FCharDim.Y);
        Canvas.CopyRect(Dest,Canvas,Src);
        Dec(FVisibleTop);
        For I:=0 To FCols-1 Do FBuffer^[FVisibleTop]^[I].Attrib:=
                         FBuffer^[FVisibleTop]^[I].Attrib or atrChanged;
      End;
    scLineDown :
     If FVisibleTop<LastPageStart Then
      Begin
        Src  := Rect(0,FCharDim.Y,FCols*FCharDim.X,FRows*    FCharDim.Y);
        Dest := Rect(0,0,         FCols*FCharDim.X,(FRows-1)*FCharDim.Y);
        Canvas.CopyRect(Dest,Canvas,Src);
        Inc(FVisibleTop);
        For I:=0 To FCols-1 Do FBuffer^[FVisibleTop+FRows-1]^[I].Attrib:=
                         FBuffer^[FVisibleTop+FRows-1]^[I].Attrib or atrChanged;
      End;}
  End;
  InteligentPaint;
End;

procedure TxTermConsole.Scroll(ScrollCode: TScrollCode);
Var
  ScrollPos : Integer;
Begin
  Case ScrollCode of
    scLineUp   : Begin FScrollBar.Position := FScrollBar.Position-1;        End;
    scLineDown : Begin FScrollBar.Position := FScrollBar.Position+1;        End;
    scTop      : Begin FScrollBar.Position := FScrollBar.Min;               End;
    scBottom   : Begin FScrollBar.Position := FScrollBar.Max;               End;
    scPageUp   : Begin FScrollBar.Position := FScrollBar.Position-(Rows-1); End;
    scPageDown : Begin FScrollBar.Position := FScrollBar.Position+(Rows-1); End;
  End;
  ScrollPos := FScrollBar.Position;

  ScrollEvent(Self, ScrollCode, ScrollPos);
End;


{** other stuff ***************************************************************}
procedure TxTermConsole.InitFont;
Begin
  Canvas.Font.Name    := FFontName;
  If not FbFontSize Then Begin
    Canvas.Font.Height:= FFontHeight;
    FFontSize         := Canvas.Font.Size;
  End Else Begin
    Canvas.Font.Size  := FFontSize;
    FFontHeight       := Canvas.Font.Height;
  End;
  Canvas.Font.Pitch   := {fpFixed}fpDefault;
  If FFontBold Then Canvas.Font.Style := [fsBold] Else Canvas.Font.Style := [];

  GetTextMetrics(Canvas.Handle,FTextMetrics);
  FCharDim.Y          := FTextMetrics.tmHeight{+FTextMetrics.tmExternalLeading};
  FCharDim.X          := FTextMetrics.tmAveCharWidth;

  Width               := FCharDim.X*FCols+FScrollBar.Width;
  Height              := FCharDim.Y*FRows;

 {Create a smiling bitmap using the wingdings font}
  _CursorCreate;
  SetScrollBar;
End;{-- InitFont --------------------------------------------------------------}
Function  TxTermConsole.CaretCreate:Boolean;
Begin
  {$IFDEF WIN32}Result := {$ENDIF}CreateCaret((Owner as TForm).Handle, FCaretBm.Handle, 0, 0);
End;
Function  TxTermConsole.CaretShow:Boolean;
Begin
  {$IFDEF WIN32}Result := {$ENDIF}ShowCaret((Owner as TForm).Handle);
  _CursorMoveTo;
End;
Function  TxTermConsole.CaretHide:Boolean;
Begin
  {$IFDEF WIN32}Result := {$ENDIF}HideCaret((Owner as TForm).Handle);
End;
Function  TxTermConsole.CaretDestroy:Boolean ;
Begin
  {$IFDEF WIN32}Result := {$ENDIF}DestroyCaret;
End;


Function RealXOR(A, B: Longint):Longint;
Begin
  If A<0 Then A:=GetSysColor(A-$80000000);
  If B<0 Then B:=GetSysColor(B-$80000000);
  {$IFDEF WIN32}
{  asm  THIS CODE IS OPTIMIZER UNSAFE !!!
    MOV EAX, A
    MOV EBX, B
    XOR EAX, EBX
    MOV Result, EAX
  end;}
  Result:=A XOR B;
  {$ELSE}
  Result:=clWhite XOR B;
  {$ENDIF}
End;

procedure TxTermConsole._CursorCreate;
Var
  CursorX,
  CursorY : Integer;
Begin
{!@#  if not (Owner as TWinControl).HandleAllocated then Exit;}

  CursorX:=FCharDim.X;
  CursorY:=FCharDim.Y;
  Case FCursorMode of
    cmInsert  : Begin CursorX:=FCharDim.X; CursorY:=FTextMetrics.tmDescent  End;
    cmOverride: ;
    cmLine    : Begin CursorX:=FTextMetrics.tmDescent; CursorY:=FCharDim.Y; End;
  End;

  If Assigned(FCaretBm) Then FCaretBm.Free;
  FCaretBm := TBitmap.Create;
  FCaretBm.Width  := Max(CursorX, 2);
  FCaretBm.Height := Max(CursorY, 2);
  FCaretBm.Canvas.Brush.Color := RealXOR(FColorTable.Paper[clrNormal], FCursorColor);
  FCaretBm.Canvas.FillRect(Rect(0, 0, FCaretBm.Width, FCaretBm.Height));
End;{-- CursorCreate ----------------------------------------------------------}
procedure TxTermConsole._CursorDestroy;
Begin
  DestroyCaret;
  FCursorVisible:=False;
  FCursorCreated:=False;
End;{-- CursorDestroy ---------------------------------------------------------}
procedure TxTermConsole._CursorShow;
Begin
  {$IFDEF WIN32}FCursorVisible:={$ENDIF}ShowCaret((Owner as TWinControl).Handle);
  {$IFNDEF WIN32}FCursorVisible:=True;{$ENDIF}
  _CursorMoveTo;
End;{-- ShowCursor ------------------------------------------------------------}
procedure TxTermConsole._CursorHide;
Begin
  HideCaret((Owner as TWinControl).Handle);
  FCursorVisible:=False;
End;{-- HideCursor ------------------------------------------------------------}
procedure TxTermConsole._CursorMoveTo;
Begin
  Case FCursorMode of
    cmInsert   :
      SetCaretPos(1+FCursor.X * FCharDim.X, FCursor.Y * FCharDim.Y+(
                   FTextMetrics.tmExternalLeading+FTextMetrics.tmInternalLeading+
                   FTextMetrics.tmAscent-Max(2, FTextMetrics.tmDescent)));
    cmOverride :
      SetCaretPos(1+FCursor.X * FCharDim.X, FCursor.Y * FCharDim.Y);
    cmLine     :
      SetCaretPos(1+FCursor.X * FCharDim.X, FCursor.Y * FCharDim.Y);
  End;
End;{-- CursorMoveTo ----------------------------------------------------------}
procedure TxTermConsole.CursorTo(X,Y:Integer);
Begin
  FCursor:=Point(X,Y);
  UpdateTimer.Enabled:=True;
End;
procedure TxTermConsole.Cursor2Home;
Begin
  FCursor:=Point(0, FScrollRegY1);
  UpdateTimer.Enabled:=True;
End; { -- TxTermConsole.Cursor2Home  ------------------------------------------}
Procedure TxTermConsole.Cursor2ll;
Begin
  FCursor:=Point(0, FScrollRegY2);
  UpdateTimer.Enabled:=True;
End; { -- TxTermConsole.Cursor2ll ---------------------------------------------}

Procedure TxTermConsole.SaveToFile(Var TF:TextFile; ANSI:Boolean; Msg:Word);
Procedure WriteANSIColor(C,A:Byte);
Begin
  Case C of
    clrBlack..clrWhite : Write(TF,#27+'[',C+A,'m');
    clrNormal          : Write(TF,#27+'[10m');
    clrBold            : Write(TF,#27+'[1m');
    clrUnderline       : Write(TF,#27+'[4m');
    clrBlink           : Write(TF,#27+'[5m');
  End;
End;
Var
  I,J   : Word;
  LastC : Byte;
  F,B   : Byte;
Begin
  LastC := $FF;
  For I:=FBufferTop To maxRows-1 Do
   Begin
     For J:=0 To FCols-1 Do
      Begin
        If LastC<>FBuffer^[I]^[J].Color Then
         Begin
           LastC:=FBuffer^[I]^[J].Color;
           If ANSI Then
            Begin
              F := FBuffer^[I]^[J].Color and $0F;
              B := FBuffer^[I]^[J].Color shr 4;
              WriteANSIColor(F,30);
              WriteANSIColor(B,40);
            End;
         End;
       Write(TF,Char(FBuffer^[I]^[J].Char));
     End;
     If Not ANSI Then Write(TF,#13#10);
   End;
End;

{** Painting stuff ************************************************************}
procedure TxTermConsole.Paint;
Begin
  AllChanged:=True;
  InteligentPaint;
End;{-- Paint -----------------------------------------------------------------}
procedure TxTermConsole.RePaint;
Begin Paint End; {-- Repaint --------------------------------------------------}
procedure TxTermConsole.InteligentPaint;
Var
  X,Y    : Word;
  J      : Word;
{  oldCur : Boolean;}

  PrintBuffer: Array[0..$FF] of Byte;
  PrintColor : Byte;
  PrintCount : Byte;
  PrintStart : Byte;

Procedure PrintIt;
Begin
  Canvas.Font.Color  := FColorTable.Pen[PrintColor and $0F];
  Canvas.Brush.Color := FColorTable.Paper[PrintColor shr 4];
  TextOut(Canvas.Handle,PrintStart*FCharDim.X,J,@PrintBuffer,PrintCount);
  PrintCount         := 0;
End;

Begin
  If not Visible Then Exit;
{  oldCur:=FCursorVisible;}
  If (GetActiveWindow=(Owner as TForm).Handle) Then _CursorHide;

  J:=0;
  For Y:=FVisibleTop To FVisibleTop+FRows-1 Do
   Begin
     PrintCount := 0;
     For X:=0 To FCols-1 Do
      Begin
        If (FBuffer^[Y]^[X].Attrib and atrChanged = atrChanged)or AllChanged Then
         Begin{Character has changet atribut}
           If PrintCount=0 Then
            Begin
              PrintStart := X;
              PrintColor := FBuffer^[Y]^[X].Color;
            End;
           If FBuffer^[Y]^[X].Color<>PrintColor Then
            Begin
              PrintIt;
              PrintStart := X;
              PrintColor := FBuffer^[Y]^[X].Color;
            End;
           PrintBuffer[PrintCount]:=FBuffer^[Y]^[X].Char;
           FBuffer^[Y]^[X].Attrib:=FBuffer^[Y]^[X].Attrib and (not atrChanged);
           Inc(PrintCount);
           Continue;
         End;
        If PrintCount>0 Then PrintIt;
      End;
     If PrintCount>0 Then PrintIt;
     Inc(J,FCharDim.Y);
   End;
  AllChanged:=False;

  If (GetActiveWindow=(Owner as TForm).Handle) Then _CursorShow;
End;{-- InteligentPaint -------------------------------------------------------}
procedure TxTermConsole.TimerPaint(Sender:TObject);
Begin
  UpdateTimer.Enabled:=False;
  If BufferRaised Then
   Begin
     SetScrollBar;
     BufferRaised:=True;
   End;
  InteligentPaint;
End;{-- TimerPaint ------------------------------------------------------------}

{** Printing stuff ************************************************************}
procedure TxTermConsole.ValidateCursorPos;
Var
  LastRow    : PRow;
  bufStart   : Integer;
  bufStop    : Integer;
Begin
  If FCursor.X>=FCols Then Begin{Cursor to new line}
    FCursor.X:=0;Inc(FCursor.Y,1)
  End;

  If(FScrollRegY1=0)and(FScrollRegY2=(FRows-1))Then Begin
    bufStart := FBufferTop-1*Byte(FBufferTop>0);
    bufStop  := maxRows;
  End Else Begin {Scroll region}
    bufStart := LastPageStart+FScrollRegY1;
    bufStop  := LastPageStart+FScrollRegY2+1;
  End;

  If LastPageStart+FCursor.Y>=BufStop Then Begin{Cursor exceed screen size}
    LastRow:=FBuffer^[bufStart];
    If LastRow=Nil Then Begin
      LastRow:=AllocRow;
      BufferRaised:=True;
    End;
    ClearRow(LastRow,clrDefault);

    System.Move(FBuffer^[bufStart+1],FBuffer^[bufStart],(bufStop-bufStart-1)*SizeOf(PRow));
    FBufferTop:=bufStart;
    FBuffer^[bufStop-1]:=LastRow;

    AllChanged  :=True;
    FCursor.Y:=BufStop-LastPageStart-1;
  End;
End;{.. ValidateCursorPos .....................................................}


procedure TxTermConsole.WriteBuff(S:PChar;Len:Word);
Const
  EmptyString : String = '                                                    ';
Var
  XPos, YPos  : Word;
  Cell        :^TCel;
  I           : Word;
Begin
  For I:=0 To Len-1 Do
   Case S[I] of
     #0:;
     #8  : {BSP}If FCursor.X>0 Then Dec(FCursor.X);
     #1..#6,
     #11,#12,
     #14..#31,
     #32..#255:
       Begin{RealPrinting}
        If FAutoMargin and FCheckBeforeCh Then ValidateCursorPos;
        XPos := FCursor.X;
        YPos := LastPageStart+FCursor.Y;

        If not ((FCursor.X>=FCols)or(FCursor.Y>=FRows)) Then Begin
          Cell := @FBuffer^[YPos]^[XPos];
          Cell^.Attrib := Cell^.Attrib or atrChanged;
          Cell^.Color  := FPenColor or (FPaperColor shl 4);
          Cell^.Char   := Byte(S[I]);
        End;

        Inc(FCursor.X);
        If FAutoMargin and not FCheckBeforeCh Then ValidateCursorPos;
       End;
   End;
  {$IFDEF SLOW}
  InteligentPaint;
  Sleep(10);
  {$ELSE}
  UpdateTimer.Enabled:=True;
  {$ENDIF}
End;{-- WriteBuff -------------------------------------------------------------}
procedure TxTermConsole.WriteChar;
Begin WriteBuff(@C,1); End;{-- WriteChar --------------------------------------}
procedure TxTermConsole.WriteString;
Begin WriteBuff(@S[1],Length(S)); End;{-- WriteString ------------------------}
procedure TxTermConsole.InsertCharacters(No:Word);
Var
  I,Y   : Word;
Begin
  If No<=0 Then Exit;

  Y := LastPageStart+FCursor.Y;
  For I:=FCols-1 DownTo FCursor.X+No Do
   Begin{Shifted chars}
     FBuffer^[Y]^[I]:=FBuffer^[Y]^[I-No];
     FBuffer^[Y]^[I].Attrib:=FBuffer^[Y]^[I].Attrib or atrChanged;
   End;
  For I:=FCursor.X To FCursor.X+No-1 Do
   Begin{New empty chars}
     FBuffer^[Y]^[I].Char   := Byte(chrEmpty);
     FBuffer^[Y]^[I].Attrib := atrChanged;
   End;
  UpdateTimer.Enabled:=True;
End;{-- InsertCharacters ------------------------------------------------------}
procedure TxTermConsole.InsertLine(No:Word);
Var
  BottomLines    : PBuffer;
  Y,I,J          : Word;
  _LastPageStart : Integer;
  _maxRows       : Integer;
Begin
  If No<=0 Then Exit;

  If(FScrollRegY1=0)and(FScrollRegY2=(FRows-1))Then Begin
    _LastPageStart := LastPageStart;
    _maxRows       := maxRows;
  End Else Begin { scroll region }
    _LastPageStart := LastPageStart+FScrollRegY1;
    _maxRows       := LastPageStart+FScrollRegY2+1;
  End;

  Y := _LastPageStart+FCursor.Y;

  SafeGetMem(BottomLines,No*SizeOf(PRow));
  Move(FBuffer^[_maxRows-No],BottomLines^[0],No*RowSize);
  Move(FBuffer^[Y],FBuffer^[Y+No],(_maxRows-Y-No)*RowSize);

  For I:=0 To No-1 Do Begin
    If BottomLines^[I]=nil Then BottomLines^[I]:=AllocRow;
    ClearRow(BottomLines^[I],clrDefault);
  End;
  Move(BottomLines^[0],FBuffer^[Y],No*RowSize);
  SafeFreeMem(BottomLines,No*SizeOf(PRow));

  For I:=Y To _maxRows-1 Do
    For J:=0 To FCols-1 Do FBuffer^[I]^[J].Attrib:=FBuffer^[I]^[J].Attrib or atrChanged;

  UpdateTimer.Enabled:=True;
End;{-- InsertLine ------------------------------------------------------------}
procedure TxTermConsole.RepeatLastChar(No:Word);
Var
  I,Y   : Word;
  Cel   : TCel;
Begin
  If No<=0 Then Exit;
  
  Y := LastPageStart+FCursor.Y;
  Cel := FBuffer^[Y]^[FCursor.X-1];
  Cel.Attrib := Cel.Attrib or atrChanged;

  For I:=0 To No-1 Do Begin
    FBuffer^[Y]^[FCursor.X]:=Cel;
    Inc(FCursor.X);
    ValidateCursorPos;
  End;
End;{-- RepeatLastChar --------------------------------------------------------}
procedure TxTermConsole.DeleteCharacters(No:Word);
Var
  I,Y   : Word;
Begin
  If No<=0 Then Exit;

  Y := LastPageStart+FCursor.Y;

  For I:=FCursor.X To FCols-1-No Do
   Begin
     FBuffer^[Y]^[I]:=FBuffer^[Y]^[I+No];
     FBuffer^[Y]^[I].Attrib:=FBuffer^[Y]^[I].Attrib or atrChanged;
   End;
  For I:=FCols-1-(No-1) To FCols-1 Do
   Begin
     FBuffer^[Y]^[I].Char:=Byte(chrEmpty);
     FBuffer^[Y]^[I].Attrib:=atrChanged;
     FBuffer^[Y]^[I].Color:=(clrNormal shl 4)or clrNormal;
   End;

  UpdateTimer.Enabled:=True;
End;{-- DeleteCharacters ------------------------------------------------------}
procedure TxTermConsole.DeleteLine(No:Word);
Var
  MediumLines    : PBuffer;
  Y,I,J          : Word;
  _LastPageStart : Integer;
  _maxRows       : Integer;
Begin
  If No<=0 Then Exit;

  If(FScrollRegY1=0)and(FScrollRegY2=(FRows-1))Then Begin
    _LastPageStart := LastPageStart;
    _maxRows       := maxRows;
  End Else Begin { scroll region }
    _LastPageStart := LastPageStart+FScrollRegY1;
    _maxRows       := LastPageStart+FScrollRegY2+1;
  End;

  Y := _LastPageStart+FCursor.Y;

  SafeGetMem(MediumLines,No*SizeOf(PRow));
  Move(FBuffer^[Y],MediumLines^[0],No*RowSize);
  Move(FBuffer^[Y+No],FBuffer^[Y],(_maxRows-Y-No)*RowSize);

  For I:=0 To No-1 Do Begin
    If MediumLines^[I]=nil Then MediumLines^[I]:=AllocRow;
    ClearRow(MediumLines^[I],clrDefault);
  End;
  Move(MediumLines^[0],FBuffer^[_maxRows-No],No*RowSize);
  SafeFreeMem(MediumLines,No*SizeOf(PRow));

  For I:=Y To _maxRows-1 Do
   For J:=0 To FCols-1 Do FBuffer^[I]^[J].Attrib:=FBuffer^[I]^[J].Attrib or atrChanged;

  UpdateTimer.Enabled:=True;
End;{-- InsertLine ------------------------------------------------------------}
procedure TxTermConsole.ClrScr;
Var
  I   : Word;
  clr : Byte;
Begin
  clr := FPenColor or (FPaperColor shl 4);
  For I:=LastPageStart To maxRows-1 Do ClearRow(FBuffer^[I],clr);
  FCursor:=Point(0,0);
  UpdateTimer.Enabled:=True;
End;{-- ClrScr ----------------------------------------------------------------}
procedure TxTermConsole.ClrEol;
Var
  Y,I : Word;
  Cel : TCel;
Begin
  Y   := LastPageStart+FCursor.Y;
  Cel.Char  := Byte(chrEmpty);
  Cel.Color := FPenColor or (FPaperColor shl 4){FBuffer^[Y]^[FCursor.X].Color};
  Cel.Attrib:= atrChanged;
  For I:=FCursor.X To FCols-1 Do FBuffer^[Y]^[I] := Cel;
  UpdateTimer.Enabled:=True;
End;{-- ClrEol ----------------------------------------------------------------}
procedure TxTermConsole.ClrBol;
Var
  Y,I : Word;
  Cel : TCel;
Begin
  Y   := LastPageStart+FCursor.Y;
  Cel.Char  := Byte(chrEmpty);
  Cel.Color := FPenColor or (FPaperColor shl 4){FBuffer^[Y]^[FCursor.X].Color};
  Cel.Attrib:= atrChanged;
  For I:=0 To FCursor.X-1 Do FBuffer^[Y]^[I] := Cel;
  UpdateTimer.Enabled:=True;
End;{-- ClrEol ----------------------------------------------------------------}
procedure TxTermConsole.ClrEos;
Var
  Y,I,J : Word;
  Cel   : TCel;
Begin
  Y := LastPageStart+FCursor.Y;
  Cel.Char  := Byte(chrEmpty);
  Cel.Color := FPenColor or (FPaperColor shl 4){FBuffer^[Y]^[FCursor.X].Color};
  Cel.Attrib:= atrChanged;
  For I:=FCursor.X To FCols-1 Do FBuffer^[Y]^[I]:=Cel;
  For I:=Y+1 To maxRows-1 Do
   For J:=0 To FCols-1 Do FBuffer^[I]^[J]:=Cel;

  UpdateTimer.Enabled:=True;
End;{-- ClrEos ----------------------------------------------------------------}
function  TxTermConsole.GetText(X,Y,XX,YY:Word):PChar;
Var
  I,J,K   : Word;
  ResText : PChar;
Begin
  If X>XX Then Begin I:=XX;XX:=X;X:=I End;
  If Y>YY Then Begin I:=YY;YY:=Y;Y:=I End;

  ResText    := StrAlloc((XX-X+1+2)*(YY-Y+1)+2);
  ResText[0] := #0;

  K:=0;
  For I:=Y To YY Do Begin
    For J:=X To XX Do Begin
       K:=StrLen(ResText);
       ResText[K  ]:=Char(FBuffer^[FVisibleTop+I]^[J].Char);
       ResText[K+1]:=#0;
     End;
    While(ResText[StrLen(ResText)-1]=' ') Do ResText[StrLen(ResText)-1]:=#0;
    If YY-Y>1 Then Begin
      K:=StrLen(ResText);
      ResText[K  ]:=#13;
      ResText[K+1]:=#10;
      ResText[K+2]:=#0;
    End;
  End;
  Result:=ResText;
End;
procedure TxTermConsole.ReverseScroll;
Var
  LastRow : PRow;
Begin
  If (FScrollRegY1=0)and(FScrollRegY2=(FRows-1))Then Begin
    LastRow               := FBuffer^[maxRows-1];
    System.Move(FBuffer^[FVisibleTop],FBuffer^[FVisibleTop+1],(FRows-1)*SizeOf(PRow));
    ClearRow(LastRow,clrDefault);
    FBuffer^[FVisibleTop] := LastRow;
    AllChanged            := True;
  End Else Begin
    LastRow := FBuffer^[LastPageStart+FScrollRegY2];
    System.Move(FBuffer^[LastPageStart+FScrollRegY1],
                FBuffer^[LastPageStart+FScrollRegY1+1],
                (FScrollRegY2-FScrollRegY1)*SizeOf(PRow));
    ClearRow(LastRow,clrDefault);
    FBuffer^[LastPageStart+FScrollRegY1] := LastRow;
    AllChanged := True;
  End;
End;

procedure TxTermConsole.NormalScroll;
Begin
  Inc(FCursor.Y);
  if (FCursor.X=Cols) {and FAutoMargin and FCheckBeforeCh} then
  else
    ValidateCursorPos;
End;

{** Init/Destroy stuff ********************************************************}
Constructor TxTermConsole.Create(aOwner:TComponent);
Begin
  Inherited Create(aOwner);


  Self.Parent:=(aOwner as TForm);

  FCols               := 80;
  FRows               := 24;
  FScrollRegY1        := 0;
  FScrollRegY2        := FRows-1;
  FFontName           := 'Courier';
  FFontSize           := 10;
  FFontBold           := False;
  FbFontSize          := True;
  LastPageStart       := maxRows-FRows;
  FBufferTop          := LastPageStart;
  FVisibleTop         := LastPageStart;
  Align               := alNone;
  FCursor             := Point(0,0);
  FCursorVisible      := False;
  FCursorCreated      := False;
  FCursorColor        := clRed;
  FFullTimeCursor     := True;
  FCursorMode         := cmOverride;
  FColorTable         := DefColorTable;
  AllChanged          := False;
  BufferRaised        := False;
  TabSize             := 8;
  UpdateTimer         := TTimer.Create(nil);
  UpdateTimer.Enabled := False;
  UpdateTimer.OnTimer := TimerPaint;
  UpdateTimer.Interval:= 1;
  AllocBuffer;
  FPenColor           := clrNormal;
  FPaperColor         := clrNormal;
  FAutoMargin         := True;
  FCheckBeforeCh      := True;

  FScrollBar          := TScrollBar.Create(Self);
  FScrollBar.Parent   := Parent;
  FScrollBar.Kind     := sbVertical;
  FScrollBar.Min      := 1;
  FScrollBar.Max      := 100;
  FScrollBar.Position := FScrollBar.Max;
  FScrollBar.OnScroll := ScrollEvent;
  FScrollBar.Align    := alNone;
  FScrollBar.TabStop  := False;

  InitFont;
End;{-- Create ----------------------------------------------------------------}
Destructor TxTermConsole.Destroy;
Begin
  FCaretBM.Free;
  DisposeBuffer;
  UpdateTimer.Free;


  Inherited Destroy;
End;{-- Destroy ---------------------------------------------------------------}


end.
