{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Terminal control (VCL)                          }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 03 Mar 2011                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}

unit nrterminal;

interface
uses StdCtrls, classes, graphics, windows, messages, controls, ExtCtrls,
     nrclasses, nransi, nrdataproc, nrutf8;
Const
  COLOR_MAP_COUNT = 16;

Type

  TAttr = packed record
    ColorFront:TColor;
    ColorBack:TColor;
    Blink:boolean;
    High:boolean;
  end;

  PScrAttr = ^TScrAttr;

  TScrAttr = packed record
    txChar:WideChar;
    txAttr:TAttr;
  end;

//  TnrTerminalMode       = (tmNone, tmANSI, tmVT100);
  TnrKeyboardMode       = (kmApplication, kmNormal);
  TnrCaretView          = (cvVert, cvHoriz, cvSquare);
  TnrTerminalOptions    = set of (toFKeyToEsc, toCharToOEM, toEscToDbl);
  TnrEnterKeySequence   = (ekCR, ekLF, ekCRLF, ekLFCR);
  TnrTerminalMouseMode  = (tmmAuto, tmMoveCursor, tmmNone);
  TnrDetectedMouseMode  = (dmmNone, dmmX10, dmmVT200, dmmVT200Highlight, dmmCell, dmmAny);
  TnrDetectedMouseModes = set of TnrDetectedMouseMode;

  TnrStrFromTerminalEvent = procedure (Sender:TObject; var sEsc:String; var Handled:boolean) of object;

  TnrTerminal = class(TCustomMemo)
  private
    TermColors:array[0 .. COLOR_MAP_COUNT - 1] of TColor;
    TimerBlink:TTimer;
    iBlink:integer;
    fColumns: cardinal;
    fRows: cardinal;
//    fMode: TnrTerminalMode;
    fCaretX:integer;
    fCaretY:integer;
    fSavedCaretX:integer;
    fSavedCaretY:integer;
    TxtScreen:PScrAttr;
    terminalBuffer1:PScrAttr;
    terminalBuffer2:PScrAttr;
    fUpdCount:integer;
    ps:TPaintStruct;
    ClientBM:Graphics.TBitmap;
    fCharHeight,fCharWidth:cardinal;
    fLinesInWindow:cardinal;
    fCharsInWindow:cardinal;
    fTopLine: cardinal;
    fLeftChar: cardinal;
    hX,hY:cardinal;
    fCaretWin:TPoint;
    fCaretView: TnrCaretView;
    fCurrentAttr:TAttr;
    fDefaultAttr:TAttr;
    fSavedAttr:TAttr;
    fOptions: TnrTerminalOptions;
    fOnCaretMove: TNotifyEvent;
    fOnStrFromTerminal: TnrStrFromTerminalEvent;
    fEnterKey: TnrEnterKeySequence;
    fLog: TnrCustomLogFile;
    fKeyboardMode : TnrKeyBoardMode;
    scrollRegionTop : integer;
    scrollRegionBottom : integer;
    fAnsi : TnrAnsi;
    fUtf8: boolean;
    decoderUtf8:TnrDecoderUTF8;
    fCaretVisible: boolean;
    fMouseMode: TnrTerminalMouseMode;
    fDetectedMouseModes:TnrDetectedMouseModes;
    procedure WMChar(var Msg:TWMChar); message WM_CHAR;
    procedure EMReplace(var Msg: TMessage); message EM_REPLACESEL;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure FreeTerminalBuffers;
    procedure SetTerminalSize(X,Y:cardinal);
    procedure SetColumns(const Value: cardinal);
    procedure SetRows(const Value: cardinal);
    procedure RepaintCharXY(X,Y: cardinal);
    procedure RepaintScreen;
    function XYToScreenPtr(x,y:cardinal):cardinal;
    function GetCharXY(X, Y: cardinal): WideChar;
    procedure SetCharXY(X, Y: cardinal; const Value: WideChar);
    function GetAttrXY(X, Y: cardinal): TAttr;
    procedure SetAttrXY(X, Y: cardinal; const Value: TAttr);
    procedure ResizeClientBitmap;
    procedure CalcMetrix;
    procedure SetLeftChar(const Value: cardinal);
    procedure SetTopLine(const Value: cardinal);
    procedure UpdateCaret(fX,fY:cardinal;flScroll:boolean);
    procedure UpdateWinCaret;
    procedure SetCaretView(const Value: TnrCaretView);
    procedure SetLog(const Value: TnrCustomLogFile);
    function GetLog: TnrCustomLogFile;
    function HandleSetAttribute(args: TStrings): boolean;
    procedure DoEraseLine(args: TStrings);
    procedure DoEraseLines(args: TStrings);
    procedure DoEraseChars(args: TStrings);
    procedure SaveCaretPosition;
    procedure RestoreCaretPosition;
    procedure DoChangeMode(const mode : integer; const isSet:boolean);
    procedure ChangeMouseMode(const mode: TnrDetectedMouseMode; const isSet:boolean);
    procedure AnsiHandler(Sender:TObject; packet:TnrDataPacket; cmd:TnrAnsiCommands);
    function DecodeChar(src: AnsiChar; var decoded: WideChar): boolean;
    function GetUtf8: boolean;
    procedure SetUtf8(const Value: boolean);
    procedure SetCaretVisible(const Value: boolean);
    function GetMouseMode: TnrTerminalMouseMode;
    procedure SetMouseMode(const Value: TnrTerminalMouseMode);
  protected
    procedure DoUpdate;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMLMouseDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMSysKey(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure CNChar(var Message: TWMChar); message CN_CHAR;
    procedure CMChildKey(var Message:TCMChildKey); message CM_CHILDKEY;
    procedure ScrollTextScreen(dY:integer);
    function ProcessKey(Key:word;Shift: TShiftState):boolean;
    procedure SendEscString(sEsc:String);
    function IsEsc(Ch:AnsiChar):boolean;
    procedure CreateCaret;
    procedure ResetCurrentAttr;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure DoBlink(Sender:TObject);
    procedure Logging(Det:TDetailLevel;Mess:string);
    procedure LoggingFmt(Det:TDetailLevel;Mess:string;const Arg: array of const);
    procedure SendMouseClick(x,y:integer; keys:integer);
    property CaretVisible:boolean read fCaretVisible write SetCaretVisible;

  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy;override;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure ClearScreen; virtual;
    procedure TerminalInputStr(sEsc:string);
    procedure TerminalInputChar(Ch:char);
    property CharXY[X,Y:cardinal]:WideChar read GetCharXY write SetCharXY;
    property AttrXY[X,Y:cardinal]:TAttr read GetAttrXY write SetAttrXY;
    property TopLine:cardinal read fTopLine write SetTopLine;
    property LeftChar:cardinal read fLeftChar write SetLeftChar;
    property CaretX:integer read fCaretX;
    property CaretY:integer read fCaretY;
    property DetectedMouseModes:TnrDetectedMouseModes read fDetectedMouseModes;
  published
    property Rows:cardinal read fRows write SetRows;
    property Columns:cardinal read fColumns write SetColumns;
    property CaretView:TnrCaretView read fCaretView write SetCaretView;
    property Options:TnrTerminalOptions read fOptions write fOptions;
    property Font;
    property Color;
    property Align;
    property WantTabs;
    property EnterKey:TnrEnterKeySequence read fEnterKey write fEnterKey;
    property Log:TnrCustomLogFile read GetLog write SetLog;
    property Utf8:boolean read GetUtf8 write SetUtf8;
    property OnClick;
    property OnDblClick;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
    property OnExit;
    property OnEnter;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnCaretMove:TNotifyEvent read fOnCaretMove write fOnCaretMove;
    property OnStrFromTerminal:TnrStrFromTerminalEvent read fOnStrFromTerminal
                                                       write fOnStrFromTerminal;
    property MouseMode:TnrTerminalMouseMode read GetMouseMode write SetMouseMode;

  end;

implementation
uses sysutils, dialogs;

Type

   TKeySequense = packed record
     Key:word;
     Shft:TShiftState;
     Seq:array [TnrKeyBoardMode] of string;
   end;

Const
  escKeySeqSize = 10;

Var
  escKeySequence:array [0 .. escKeySeqSize - 1]of TKeySequense = (
    // KEY;    SHIFT; ESC: (None, ANSI, VT100)
    (Key:VK_UP;Shft:[];Seq:(#27'OA',#27'[A')),
    (Key:VK_DOWN;Shft:[];Seq:(#27'OB',#27'[B')),
    (Key:VK_LEFT;Shft:[];Seq:(#27'OD',#27'[D')),
    (Key:VK_RIGHT;Shft:[];Seq:(#27'OC',#27'[C')),
    (Key:VK_HOME;Shft:[];Seq:(#27'[H',#27'[H')),
    (Key:VK_END;Shft:[];Seq:(#27'[F',#27'[F')),
    (Key:VK_NEXT;Shft:[];Seq:(#27'[6~',#27'[6~')),
    (Key:VK_PRIOR;Shft:[];Seq:(#27'[5~',#27'[5~')),
    (Key:VK_INSERT;Shft:[];Seq:(#27'[2~',#27'[2~')),
    (Key:VK_DELETE;Shft:[];Seq:(#27'[3~',#27'[3~'))
    //,
    //(Key:VK_BACK;Shft:[];Seq:('',#8,#8))
  );

  escEnterKeySequence:array [TnrEnterKeySequence] of string =
    ( #13, #10, #13#10, #10#13 );

procedure GetCharMaxSize(Cnv:TCanvas;var MaxCharHeight,MaxCharWidth:cardinal);
var w0,h0:cardinal;
//    i:byte;
//    fsSave:TFontStyles;
begin
  if Cnv = nil then exit;
//  fsSave := Cnv.Font.Style;
  MaxCharHeight := 0;
  MaxCharWidth := 0;
//  for i:=1 to 15 do begin
//    Cnv.Font.Style:=TFontStyles(i);
    w0:=Cnv.TextWidth('W');
    if MaxCharWidth<w0 then MaxCharWidth:=w0;
    w0:=Cnv.TextWidth('m');
    if MaxCharWidth<w0 then MaxCharWidth:=w0;
    h0:=Cnv.TextHeight('Wg');
    if MaxCharHeight<h0 then MaxCharHeight:=h0;
//  end;
//  Cnv.Font.Style:=fsSave;
end;

{ TnrTerminal }

constructor TnrTerminal.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCaretVisible := True;
  decoderUtf8 := TnrDecoderUTF8.Create();
  TimerBlink:=TTimer.Create(Self);
  TimerBlink.OnTimer:=DoBlink;
  TimerBlink.Interval:=700;
  TimerBlink.Enabled:=False;
//  argEsc:=TStringList.Create;
  ControlStyle:=ControlStyle+[csOpaque{,csMenuEvents}];

  // normal colors ...
  TermColors[0]:=clBlack;
  TermColors[1]:=clMaroon;
  TermColors[2]:=clGreen;
  TermColors[3]:=clOlive;
  TermColors[4]:=clNavy;
  TermColors[5]:=clPurple;
  TermColors[6]:=clTeal;
  TermColors[7]:=clSilver;
  // intense colors ...
  TermColors[8]:=clGray;
  TermColors[9]:=clRed;
  TermColors[10]:=clLime;
  TermColors[11]:=clYellow;
  TermColors[12]:=clBlue;
  TermColors[13]:=clFuchsia;
  TermColors[14]:=clAqua;
  TermColors[15]:=clWhite;

  ClientBM := Graphics.TBitmap.Create;



  hX := 2;
  hY := 2;
  fUpdCount := 0;
  //TxtScreen := nil;
  Color := clBlack;
  Font.Name := 'Terminal';
  Font.Color := clYellow;
  SetTerminalSize(80,24);
//  ClearEscState;
  fCaretView := cvSquare;
//  fMode:=tmANSI;
  fAnsi := TnrAnsi.Create(self);
  fAnsi.OnAnsiPacket := AnsiHandler;

end;

destructor TnrTerminal.Destroy;
begin
  fAnsi.Free;
//  if TxtScreen<>nil then LocalFree(Cardinal(TxtScreen));
  FreeTerminalBuffers();
  ClientBM.Free;
//  argEsc.Free;
  TimerBlink.Free;
  decoderUtf8.Free;
  inherited;
end;

procedure TnrTerminal.SetColumns(const Value: cardinal);
begin
  if Value<>fColumns then SetTerminalSize(Value,fRows);
end;

procedure TnrTerminal.SetRows(const Value: cardinal);
begin
  if Value<>fRows then SetTerminalSize(fColumns,Value);
end;

procedure TnrTerminal.FreeTerminalBuffers();
begin
  if terminalBuffer1 <> nil then LocalFree(Cardinal(terminalBuffer1));
  if terminalBuffer2 <> nil then LocalFree(Cardinal(terminalBuffer2));
  terminalBuffer1 := nil;
  terminalBuffer2 := nil;
end;

procedure TnrTerminal.SetTerminalSize(X, Y: cardinal);
var sz:cardinal;
    activeIsBuffer1:boolean;
begin

  activeIsBuffer1 := (TxtScreen = nil) or (TxtScreen = terminalBuffer1);

//  if TxtScreen <> nil then LocalFree(Cardinal(TxtScreen));

  FreeTerminalBuffers();

  sz := X * Y * SizeOf(TScrAttr);
//  TxtScreen := Pointer(LocalAlloc(LPTR, ));
  terminalBuffer1 :=  Pointer(LocalAlloc(LPTR, sz));
  terminalBuffer2 :=  Pointer(LocalAlloc(LPTR, sz));

  if activeIsBuffer1
    then TxtScreen := terminalBuffer1
    else TxtScreen := terminalBuffer2;

  fColumns := X;
  fRows := Y;
  ResizeClientBitmap;
  scrollRegionTop := 1;
  scrollRegionBottom := fRows;
end;

procedure TnrTerminal.ResizeClientBitmap;
begin
  ClientBM.Width := fCharWidth * fColumns + hX * 2;
  ClientBM.Height := fCharHeight * fRows + hY * 2;
  ClientBM.Canvas.Brush.Color := fDefaultAttr.ColorBack;
  ClientBM.Canvas.FillRect(ClientBM.Canvas.ClipRect);
end;

procedure TnrTerminal.RepaintCharXY(X, Y: cardinal);
var p:PScrAttr;
    rc:TRect;
    Ch:WideChar;
begin
  p := PScrAttr(Cardinal(TxtScreen) + XYToScreenPtr(X,Y));
  ch := p^.txChar;
  if (P^.txAttr.ColorFront <> clDefault)and
     (P^.txAttr.ColorBack <> P^.txAttr.ColorFront) then begin
    ClientBM.Canvas.Brush.Color := P^.txAttr.ColorBack;
    if not(P^.txAttr.Blink) or (iBlink=0)
      then ClientBM.Canvas.Font.Color := P^.txAttr.ColorFront
      else ClientBM.Canvas.Font.Color := P^.txAttr.ColorBack;
  end else begin
    ClientBM.Canvas.Brush.Color:=Color;
    ClientBM.Canvas.Font.Color:=Font.Color;
  end;
  X := X * fCharWidth + hX;
  Y := Y * fCharHeight + hY;
  rc.Left := X;
  rc.Top := Y;
  rc.Right := X + fCharWidth;
  rc.Bottom := Y + fCharHeight;
  ClientBM.Canvas.FillRect(rc);

  if ch = #0
    then ch := #32;
//  ClientBM.Canvas.TextOut(X, Y, Char(ch));
  TextOutW(ClientBM.Canvas.Handle, x, y, @ch, 1);
  rc := ClientRect;
  X := X - fLeftChar * fCharWidth;
  Y := Y - fTopLine * fCharHeight;
  if (X<Cardinal(rc.Right))and(Y<Cardinal(rc.Bottom)) then begin
    BeginUpdate;
    rc.Left := X;
    rc.Right := X + fCharWidth;
    rc.Top := Y;
    rc.Bottom := Y + fCharHeight;
    InvalidateRect(Handle,@rc,False);
    EndUpdate;
  end;
end;

procedure TnrTerminal.RepaintScreen;
var x,y:integer;
begin
  BeginUpdate;
  for y:=0 to fRows-1 do
    for x:=0 to fColumns-1 do RepaintCharXY(x,y);
  EndUpdate;
end;

function TnrTerminal.XYToScreenPtr(x, y: cardinal): cardinal;
begin
  Result:=0;
  if y<Rows then
    if x<Columns then Result:=(Y*fColumns+X)*SizeOf(TScrAttr);
end;

function TnrTerminal.GetCharXY(X, Y: cardinal): WideChar;
begin
  if (X >= fColumns) or (Y >= fRows)
    then Result := #0
    else Result := PScrAttr(Cardinal(TxtScreen) + XYToScreenPtr(X,Y))^.txChar;
end;

procedure TnrTerminal.SetCharXY(X, Y: cardinal; const Value: WideChar);
begin
  if (X >= fColumns) or (Y >= fRows)
    then exit
    else begin
      PScrAttr(Cardinal(TxtScreen) + XYToScreenPtr(X,Y))^.txChar := Value;
      RepaintCharXY(X,Y);
    end;
end;

function TnrTerminal.GetAttrXY(X, Y: cardinal): TAttr;
begin
  if (X>=fColumns) then begin X:=0; Inc(Y); end;
  if (Y>=fRows) then Y:=0;
  Result:=PScrAttr(Cardinal(TxtScreen)+XYToScreenPtr(X,Y))^.txAttr;
end;

procedure TnrTerminal.SetAttrXY(X, Y: cardinal; const Value: TAttr);
begin
  if (X>=fColumns)or(Y>=fRows)
    then exit
    else begin
      PScrAttr(Cardinal(TxtScreen)+XYToScreenPtr(X,Y))^.txAttr:=Value;
      RepaintCharXY(X,Y);
    end;
end;

procedure TnrTerminal.BeginUpdate;
begin
  Inc(fUpdCount);
end;

procedure TnrTerminal.EndUpdate;
begin
  Dec(fUpdCount);
  if fUpdCount=0 then DoUpdate;
end;

procedure TnrTerminal.DoUpdate;
begin
  if Assigned(Parent) then begin
    UpdateWinCaret;
    UpdateWindow(Handle);
  end;
end;

procedure TnrTerminal.WMPaint(var Message: TWMPaint);
begin
  Message.Result:=1;
  if fUpdCount<>0 then exit;
  BeginPaint(Handle,ps);
  if Focused then HideCaret(Handle);
  //OutputDebugString(PChar(Format('%u %u',[ps.rcPaint.Right,ps.rcPaint.Bottom])));
  //BitBlt(ps.hdc,ps.rcPaint.Left,ps.rcPaint.Top,ps.rcPaint.Right,ps.rcPaint.Bottom,
  //       ClientBM.Canvas.Handle,ps.rcPaint.Left,ps.rcPaint.Top,SRCCOPY);
  BitBlt(ps.hdc,ps.rcPaint.Left,ps.rcPaint.Top,ps.rcPaint.Right,ps.rcPaint.Bottom,
         ClientBM.Canvas.Handle,Cardinal(ps.rcPaint.Left)+fLeftChar*fCharWidth,
         Cardinal(ps.rcPaint.Top)+fTopLine*fCharHeight,SRCCOPY);
  EndPaint(Handle,ps);
  if Focused then ShowCaret(Handle);
  Message.Result:=0;
end;

procedure TnrTerminal.ResetCurrentAttr;
begin
  fDefaultAttr.Blink:=False;
  fDefaultAttr.High:=False;
  fCurrentAttr.ColorFront:=fDefaultAttr.ColorFront;
  fCurrentAttr.ColorBack:=fDefaultAttr.ColorBack;
  fCurrentAttr.Blink:=False;
  fCurrentAttr.High:=False;
end;

procedure TnrTerminal.CMColorChanged(var Message: TMessage);
begin
  inherited;
  fDefaultAttr.ColorFront:=Font.Color;
  fDefaultAttr.ColorBack:=Color;
  ResetCurrentAttr;
  CalcMetrix;
end;

procedure TnrTerminal.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ClientBM.Canvas.Font.Assign(Font);
  GetCharMaxSize(ClientBM.Canvas,fCharHeight,fCharWidth);
  fDefaultAttr.ColorFront:=Font.Color;
  fDefaultAttr.ColorBack:=Color;
  ResetCurrentAttr;
  CalcMetrix;
end;

procedure TnrTerminal.CalcMetrix;
var rc:TRect;
begin
  BeginUpdate;
  ResizeClientBitmap;
  if Assigned(Parent) then begin
    rc := ClientRect;
    if fCharWidth <= 0 then fCharWidth := 1;
    fLinesInWindow:=(Cardinal(rc.Bottom) - hX*2) div fCharHeight;
    fCharsInWindow:=(Cardinal(rc.Right) - hY*2) div fCharWidth;
    RepaintScreen;
    InvalidateRect(Handle,nil,True);
  end;
  EndUpdate;
end;

procedure TnrTerminal.SetLeftChar(const Value: cardinal);
begin
  fLeftChar := Value;
end;

procedure TnrTerminal.SetTopLine(const Value: cardinal);
var d,dy:integer;
    i:cardinal;
begin
  if fTopLine <> Value then begin
    i:= Value;
    if i>(fRows-fLinesInWindow)then i:=fRows-fLinesInWindow;
    d:=i-fTopLine;
    dy:=-d*Integer(fCharHeight);
    fTopLine:=i;
    BeginUpdate;
    ScrollWindowEx(Handle,0,dy,nil,nil,0,nil,SW_INVALIDATE);
    EndUpdate;
  end;
end;

{procedure TnrTerminal.SetScrollBars(const Value: TScrollStyle);
begin
  FScrollBars := Value;
end;

procedure TnrTerminal.SetScrollBarsAuto(const Value: boolean);
begin
  FScrollBarsAuto := Value;
end;
}
procedure TnrTerminal.UpdateCaret(fX, fY: cardinal; flScroll: boolean);
begin

  if fX >= fColumns then begin
    if flScroll then begin
      fY := fY + (fX div fColumns);
      fX := (fX mod fColumns);
    end else fX := fColumns - 1;
  end;

  if Integer(fY) >= scrollRegionBottom then begin
    if flScroll then ScrollTextScreen(Integer(fY) - scrollRegionBottom + 1);
    fY := fRows - 1;
  end;

{  if fY >= fRows then begin
    if flScroll then ScrollTextScreen(fY - fRows + 1);
    fY := fRows - 1;
  end;}

  if LeftChar > fX then LeftChar := fX;
  if TopLine > fY then TopLine := fY;
  if fX >= (LeftChar + fCharsInWindow) then LeftChar := fX - fCharsInWindow;
  if fY >= (TopLine + fLinesInWindow - 1) then TopLine := fY - fLinesInWindow;

  fCaretWin.X := hX + (fX - fLeftChar) * fCharWidth;
  fCaretWin.Y := hY + (fY - fTopLine) * fCharHeight;
  UpdateWinCaret;
  fCaretX := fX;
  fCaretY := fY;
end;

procedure TnrTerminal.UpdateWinCaret;
var i:integer;
begin
  if Focused and (fUpdCount = 0) then begin
    i := fCaretWin.Y;
    if (fCaretView = cvHoriz) and (fCharHeight > 0)
      then Inc(i, fCharHeight - 1);
    Windows.SetCaretPos(fCaretWin.X, i);
    if Assigned(fOnCaretMove) then fOnCaretMove(Self);
  end;
end;

procedure TnrTerminal.CreateCaret;
var h,w:integer;
begin
  DestroyCaret;
  if CaretVisible and Focused then begin
    h := fCharHeight;
    w := fCharWidth;
    case fCaretView of
      cvVert:  w := 2;
      cvHoriz: h := 2;
    end;
    Windows.CreateCaret(Handle, 0, w,h);
    ShowCaret(Handle);
    UpdateWinCaret;
  end;
end;

procedure TnrTerminal.SetCaretView(const Value: TnrCaretView);
begin
  fCaretView := Value;
  CreateCaret;
end;

procedure TnrTerminal.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  CreateCaret;
  UpdateCaret(fCaretX, fCaretY, False);
end;

procedure TnrTerminal.WMSize(var Message: TWMSize);
begin
  CalcMetrix;
end;

procedure TnrTerminal.EMReplace(var Msg: TMessage);
var P:PChar;
    pDst:PAnsiChar;
    len : integer;
    sDebug:string;
begin
//  OutputDebugString(PChar('EM_REPLACE'));
  BeginUpdate;
  p := Pointer(Msg.lParam);
  pDst := Pointer(Msg.lParam); // same copy of pointer to text !!!
  if toCharToOEM in fOptions then begin
    len := lstrlen(p);
    CharToOEMBuff(p, pDst, len);
    {$IFDEF UNICODE}
    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, pDst, lstrlenA(pDst), p, len);
    {$ENDIF}
  end;

  sDebug := '';
  while p^ <> #0 do begin
    TerminalInputChar(p^);
    sDebug := sDebug + p^;
    Inc(p);
  end;

  Logging(dlDebug, 'incoming data:' + sDebug);

  EndUpdate;

end;

procedure TnrTerminal.WMChar(var Msg: TWMChar);
var ch:char;
begin
  //OutputDebugString(PChar('WM_CHAR'));
  if Msg.KeyData <> 0 then begin
    //OutputDebugString(PChar('WM_CHAR2'));
    BeginUpdate;
    if toCharToOEM in fOptions then begin
      //OemToCharBuff(@Msg.CharCode,@Msg.CharCode,1);
      CharToOemBuff(@Msg.CharCode,@Msg.CharCode,1);
    end;
    ch := Char(Msg.CharCode);
//    if ch = #13
//      then TerminalInputStr(escEnterKeySequence[fEnterKey])
//      else TerminalInputChar(ch);
    TerminalInputChar(ch);
    Logging(dlDebug, 'incoming char:' + ch);
    EndUpdate;
  end;
end;

procedure TnrTerminal.TerminalInputChar(Ch: char);
var chDec:WideChar;
begin
  case Ch of
//    #13: UpdateCaret(0,fCaretY+1,True);
//    #10:;
    #$F: exit;
    #7:  MessageBeep(Cardinal(-1));
    #8:  UpdateCaret(fCaretX - 1, fCaretY, False);
    #13: UpdateCaret(0, fCaretY, true);
    #10: UpdateCaret(fCaretX, fCaretY + 1, True);
    else if not IsEsc(AnsiChar(Ch)) then begin
      if DecodeChar(AnsiChar(Ch), chDec) then begin
        SetCharXY(fCaretX, fCaretY, chDec);
        SetAttrXY(fCaretX ,fCaretY, fCurrentAttr);
        UpdateCaret(fCaretX + 1, fCaretY, True);
      end;
    end;
  end;
end;

procedure TnrTerminal.TerminalInputStr(sEsc: string);
var i:integer;
begin
  BeginUpdate;
  for i := 1 to Length(sEsc)
    do TerminalInputChar(sEsc[i]);
  EndUpdate;
end;

procedure TnrTerminal.ScrollTextScreen(dY: integer);
var szDeltaRow, szScrollRow: integer;
    pSrc,pDst: pointer;
    pStart:pointer;
    dYmax, szRow:integer;
begin
  BeginUpdate;
{
  szDeltaRow := dY * Integer(fColumns) * SizeOf(TScrAttr);

  if dY >= 0 then begin
    pSrc := Pointer(Integer(TxtScreen) + szDeltaRow);
    pDst := TxtScreen;
  end else begin
    pSrc := TxtScreen;
    pDst := Pointer(Integer(TxtScreen) + Abs(szDeltaRow));
  end;
  CopyMemory(pDst, pSrc, Integer(fColumns*fRows*SizeOf(TScrAttr)) - Abs(szDeltaRow));

  if dY >= 0
    then pDst := Pointer(Integer(TxtScreen)+Integer(fColumns*fRows*SizeOf(TScrAttr))-Abs(szDeltaRow))
    else pDst := TxtScreen;

  ZeroMemory(pDst, Abs(szDeltaRow));
 }
//  OutputDebugString(PChar(Format('Scroll: d = %d   Top = %d Bottom = %d', [dY, scrollRegionTop, scrollRegionBottom])));

  dYmax := scrollRegionBottom - scrollRegionTop + 1;
  if dY > dYmax then dY := dYmax;

  szRow := Integer(fColumns) * SizeOf(TScrAttr);
  szDeltaRow := dY * szRow;
  szScrollRow := dYmax * szRow;

  pStart := Pointer(Integer(TxtScreen) + (scrollRegionTop - 1) * szRow);

  if dY >= 0 then begin
    pSrc := Pointer(Integer(pStart) + szDeltaRow);
    pDst := pStart;
  end else begin
    pSrc := pStart;
    pDst := Pointer(Integer(pStart) + Abs(szDeltaRow));
  end;

  CopyMemory(pDst, pSrc, szScrollRow - Abs(szDeltaRow));

  if dY >= 0
    then pDst := Pointer(Integer(pStart) + szScrollRow - Abs(szDeltaRow))
    else pDst := pStart;

  ZeroMemory(pDst, Abs(szDeltaRow));

  RepaintScreen;
  EndUpdate;
end;

procedure TnrTerminal.SendEscString(sEsc: String);
var i:integer;
    flHandled:boolean;
begin
  //OutputDebugString(PChar('SendEscString:' + sEsc));
  flHandled := False;
  if Assigned(fOnStrFromTerminal)
    then fOnStrFromTerminal(Self,sEsc,flHandled);

  if not flHandled then
    for i := 1 to Length(sEsc) do
      SendMessage(Handle, WM_CHAR, Integer(AnsiChar(sEsc[i])), 0);
end;

procedure TnrTerminal.CNChar(var Message: TWMChar);
begin
  //OutputDebugString(PChar('CN_CHAR:' + AnsiChar(Message.CharCode)));
//  Message.Msg := 0;
  if (Message.CharCode = VK_RETURN)
//     or (Message.CharCode = VK_ESCAPE)
//   or (Message.CharCode = VK_BACK)
    then Message.Result := 1
//  Message.CharCode := 0;
end;

procedure TnrTerminal.WMSysKey(var Message: TWMSysKeyDown);
begin
  //OutputDebugString(PChar('WM_SYSKEY'));
  if ProcessKey(Message.CharCode,[])
    then Message.Result := 1;
end;

procedure TnrTerminal.WMKeyDown(var Message: TWMKeyDown);
begin
  //OutputDebugString(PChar('WM_DOWN'));
  if ProcessKey(Message.CharCode,[])
    then Message.Result := 1;
end;

procedure TnrTerminal.CMChildKey(var Message: TCMChildKey);
begin
  Message.Result := 1;
  if Message.CharCode = VK_TAB
    then SendEscString(String(AnsiChar(Message.CharCode)))
    else Message.Result := 0;
end;

function TnrTerminal.ProcessKey(Key: word; Shift: TShiftState): boolean;
var i:integer;
    s:string;
begin
  Result := False;
  for i := 0 to escKeySeqSize - 1 do
    if(Key = escKeySequence[i].Key) and (Shift = escKeySequence[i].Shft)
      then begin
        if escKeySequence[i].Seq[fKeyboardMode] <> '' then begin
           SendEscString(escKeySequence[i].Seq[fKeyboardMode]);
           Result:=True;
        end;
        break;
      end;

  //Result:=(Key=VK_BACK)or(Key=VK_END)or Result;
  if (not Result) and ( Key >= VK_F1) and (Key <= VK_F10) and (toFKeyToEsc in fOptions) then begin
    if Key = VK_F10 then Key := VK_F1 - 1;
    SendEscString(#27 + Char($30 + (Key - VK_F1 + 1)));
    Result := True;
  end;

  if (not Result) and (Key = VK_ESCAPE) and (toEscToDbl in fOptions) then begin
    SendEscString(#27#27);
    Result := True;
  end;

  if Key = VK_RETURN then begin
    SendEscString(escEnterKeySequence[fEnterKey]);
    Result := True;
  end;

  if not Result then begin
    s:=Char(Key);
    if Assigned(fOnStrFromTerminal)
      then fOnStrFromTerminal(Self,s,Result);
  end;

//  if not Result then SendEscString(AnsiChar(Key));

//  Result := True;

end;

function TnrTerminal.IsEsc(Ch: AnsiChar): boolean;
begin
  Result := (fAnsi.IsPacket(Byte(Ch)) >= 0) or fAnsi.IsPacketPossible;
end;

procedure TnrTerminal.WMLMouseDown(var Message: TWMLButtonDown);
var x,y:cardinal;
begin
  if not Focused
    then SetFocus
    else begin
      if (MouseMode = tmmNone) or ((MouseMode = tmmAuto) and (DetectedMouseModes = [])) then exit;
      x := (Word(Message.XPos) div fCharWidth) + 1;
      y := (Word(Message.YPos) div fCharHeight) + 1;
      if (x > fColumns) or (y > fRows) then exit;
      SendMouseClick(x, y, 1);
    end;
end;

procedure TnrTerminal.SendMouseClick(x, y, keys: integer);
var esc_mouse:AnsiString;
begin
  if MouseMode = tmMoveCursor then
    esc_mouse := AnsiChar(#27) + AnsiString(Format('[%d;%dH',[y,x]))
  else begin
    esc_mouse := AnsiChar(#27) + AnsiString('[M') + AnsiChar(keys + 32) +  AnsiChar(x + 32) + AnsiChar(y + 32);
  end;
  SendEscString(String(esc_mouse));
end;

procedure TnrTerminal.DoBlink(Sender: TObject);
var x,y:cardinal;
    fl:boolean;
begin
  if iBlink = 0 then iBlink := 1
                else iBlink := 0;
  TimerBlink.Enabled := False;
  fl := False;
  BeginUpdate;
  for y := 0 to fRows - 1 do
    for x := 0 to fColumns - 1 do
      if AttrXY[x,y].Blink then begin
        RepaintCharXY(x,y);
        fl := True;
      end;
  EndUpdate;
  TimerBlink.Enabled := fl;
end;

procedure TnrTerminal.ClearScreen;
var x,y:integer;
begin
  BeginUpdate;
  for y:=0 to fRows-1 do
    for x:=0 to fColumns-1 do begin
      SetCharXY(x,y,' ');
      SetAttrXY(x,y,fDefaultAttr);
    end;
  EndUpdate;
end;

function TnrTerminal.GetLog: TnrCustomLogFile;
begin
  Result := fLog;
end;

procedure TnrTerminal.SetLog(const Value: TnrCustomLogFile);
begin
  fLog := Value;
end;

procedure TnrTerminal.Logging(Det: TDetailLevel; Mess: string);
begin
  if Assigned(Log) then Log.AddLog(Det, 'nrTerminal:' + Mess);
end;

procedure TnrTerminal.LoggingFmt(Det: TDetailLevel; Mess: string;
  const Arg: array of const);
begin
  if Assigned(Log) then Log.AddLogFmt(Det, 'nrTerminal:' + Mess, Arg);
end;

procedure TnrTerminal.AnsiHandler(Sender: TObject; packet: TnrDataPacket;
  cmd: TnrAnsiCommands);
var val, x, y:integer;
    slArgs:TStrings;
begin

  //Logging(dlDebug,  'ansi:' + packet.Data);

  case cmd of

    acSetAttributeMode:
       HandleSetAttribute(fAnsi.GetArguments(packet));

    acNewLine:
      UpdateCaret(0, CaretY + 1, true);

    acCursorForward,
    acCursorBackward,
    acCursorUp,
    acCursorDown: begin
      val := 1;    // default value of moving
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 1
        then val := Integer(slArgs.Objects[0]);
                        //int.TryParse(e.Args[0], out val);
      x := CaretX;
      y := CaretY;
      case cmd of
        acCursorForward:  x := x + val;
        acCursorBackward: x := x - val;
        acCursorUp:       y := y - val;
        acCursorDown:     y := y + val;
      end;

      if (x < 0) then x := 0;
      if (y < 0) then y := 0;
      UpdateCaret(x, y, false);
    end;

    acCursorHome: begin
      y := 0;
      x := 0;
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count > 0 then begin
        y := Integer(slArgs.Objects[0]) - 1;
        if slArgs.Count > 1
          then x := Integer(slArgs.Objects[1]) - 1;
      end;
      if x < 0 then x := 0;
      if y < 0 then y := 0;
      LoggingFmt(dlDebug, '+===== CursorHome=%d : %d',[x,y]);
      UpdateCaret(x, y, false);
    end;

    acCursorLine: begin
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 1
        then y := Integer(slArgs.Objects[0]) - 1
        else y := 0;
      UpdateCaret(CaretX, y, false);
    end;

    acCursorColumn: begin
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 1
        then x := Integer(slArgs.Objects[0]) - 1
        else x := 0;
      UpdateCaret(x, CaretY, false);
    end;

    acEraseLine:
      DoEraseLine(fAnsi.GetArguments(packet));

    acEraseLines:
      DoEraseLines(fAnsi.GetArguments(packet));

    acEraseChars:
      DoEraseChars(fAnsi.GetArguments(packet));

    acDeleteLine,
    acInsertLine: begin
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 1
        then y := Integer(slArgs.Objects[0])
        else y := 1;

      if  cmd = acInsertLine then y := -y;
      ScrollTextScreen(y);
    end;

    acScrollDown:
      ScrollTextScreen(1);

    acScrollUp:
      ScrollTextScreen(-1);

    acSetScrollRegion: begin
      x := 1;
      y := Rows;

      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 2 then begin
        x := Integer(slArgs.Objects[0]);
        y := Integer(slArgs.Objects[1]) + 1;
      end;

      scrollRegionTop := x;
      scrollRegionBottom := y;
      Logging(dlDebug, '*******************   Set Scroll Region: ' + IntToStr(x) + ':' + IntToStr(y));
    end;

    acSaveCursorAndAttrs: begin
      fSavedAttr := fCurrentAttr;
      SaveCaretPosition;
    end;

    acRestoreCursorAndAttrs: begin
      fCurrentAttr := fSavedAttr;
      RestoreCaretPosition;
    end;

    acSetModePrivate,
    acResetModePrivate: begin
      slArgs := fAnsi.GetArguments(packet);
      if slArgs.Count = 1
        then DoChangeMode(Integer(slArgs.Objects[0]), cmd = acSetModePrivate);
    end;

    acKeyMode: begin
//      if packet.Data[1] = '='
//        then fKeyboardMode := kmApplication
//        else fKeyboardMode := kmNormal;
      Logging(dlDetail, ' Change Key Mode: ' + String(packet.Data));

    end;

    else begin
      Logging(dlDebug, 'Unhandled: ' + String(packet.Data));
    end;

  end;
end;

procedure TnrTerminal.DoChangeMode(const mode: integer;
  const isSet: boolean);
begin
  case mode of
    1:  if not isSet
        then fKeyboardMode := kmNormal
        else fKeyboardMode := kmApplication;

    25:  CaretVisible := isSet;
    47,
    1047,
    1049: begin
      BeginUpdate;
      if isSet then begin
        TxtScreen := terminalBuffer2;
        if mode = 1049 then begin
          SaveCaretPosition;
          ClearScreen();
        end else RepaintScreen();
      end else begin
        if TxtScreen = terminalBuffer2
          then ClearScreen();
        TxtScreen := terminalBuffer1;
        if mode = 1049
          then RestoreCaretPosition;
        RepaintScreen();
      end;
      EndUpdate;
    end;

    // mouse modes ...
    9:     // Send Mouse X & Y on button press. See the section Mouse Tracking
      ChangeMouseMode(dmmX10, isSet);
    1000:  // Send Mouse X & Y on button press and release. See the section Mouse Tracking.
      ChangeMouseMode(dmmVT200, isSet);
    1001:  // Use Highlight Mouse Tracking.
      ChangeMouseMode(dmmVT200Highlight, isSet);
    1002:  // Use Cell Motion Mouse Tracking.
      ChangeMouseMode(dmmCell, isSet);
    1003:  // Use All Motion Mouse Tracking.
      ChangeMouseMode(dmmAny, isSet);
    else
      Logging(dlDetail, 'Unhandled Mode Change: ' + IntToStr(mode) + ' = ' + IntToStr(Integer(isSet)));
  end;
end;

procedure TnrTerminal.ChangeMouseMode(const mode: TnrDetectedMouseMode;
  const isSet: boolean);
begin
  if isSet
    then fDetectedMouseModes := fDetectedMouseModes + [mode]
    else fDetectedMouseModes := fDetectedMouseModes - [mode];
end;

procedure TnrTerminal.SaveCaretPosition;
begin
  fSavedCaretX := CaretX;
  fSavedCaretY := CaretY;
end;

procedure TnrTerminal.RestoreCaretPosition;
begin
  UpdateCaret(fSavedCaretX, fSavedCaretY, false);
end;

procedure TnrTerminal.DoEraseLine(args: TStrings);
var xStart, xEnd:integer;
begin
  // Erase ful line by default ...
  xStart := XYToScreenPtr(fCaretX, fCaretY);
  xEnd := XYToScreenPtr(fColumns - 1, fCaretY);
  if args.Count = 1 then begin
    if Integer(args.Objects[0]) = 1 then xEnd := xStart;
    xStart := XYToScreenPtr(0, fCaretY);
  end;
  ZeroMemory(Pointer(Cardinal(TxtScreen) + Cardinal(xStart)), xEnd - xStart);
  RepaintScreen;
end;

procedure TnrTerminal.DoEraseLines(args: TStrings);
var yStart, yEnd:integer;
begin
  // Erase Full screen by default ...
  yStart := XYToScreenPtr(fCaretX, fCaretY);
  yEnd := XYToScreenPtr(fColumns - 1, fRows - 1);
  if args.Count = 1 then begin
    if Integer(args.Objects[0]) = 1 then yEnd := yStart;
    yStart := 0;
  end;
  ZeroMemory(Pointer(Cardinal(TxtScreen) + Cardinal(yStart)), yEnd - yStart);
  RepaintScreen;
end;

procedure TnrTerminal.DoEraseChars(args: TStrings);
var xCount:integer;
begin
  // Erase chars in line ...
  xCount := 1;
  if args.Count > 0
    then xCount := Integer(args.Objects[0]);
  ZeroMemory(Pointer(Cardinal(TxtScreen) + XYToScreenPtr(fCaretX, fCaretY)), xCount);
  RepaintScreen;
end;

function TnrTerminal.HandleSetAttribute(args: TStrings): boolean;
var i, x,y:integer;
begin
  Result := true;
  if args.Count > 0 then begin
    for i := 0 to args.Count - 1 do begin
      x := Integer(args.Objects[i]);// GetEscArgInt(i);
      case x of
        0,10: ResetCurrentAttr;
           1: fCurrentAttr.High:=True;
           5: begin
                fCurrentAttr.Blink:=True;
                TimerBlink.Enabled:=True;
              end;
           7: begin
                fCurrentAttr.ColorFront:= fDefaultAttr.ColorBack;
                fCurrentAttr.ColorBack:= fDefaultAttr.ColorFront;
              end;
           else begin
             y := x div 10;
             x := x mod 10;
             if x < 8 then begin
               if y = 4
                 then fCurrentAttr.ColorBack := TermColors[x]
                 else begin
                  if fCurrentAttr.High then x := x + 8;
                  fCurrentAttr.ColorFront := TermColors[x];
                 end;
             end else ResetCurrentAttr;
           end;
      end;
    end;
  end else ResetCurrentAttr;//fCurrentAttr:=fDefaultAttr;
end;

function TnrTerminal.DecodeChar(src: AnsiChar;
  var decoded: WideChar): boolean;
begin
//  Result := False;
//  if src <= #$F then exit;
  decoded := WideChar(src);
  if fUtf8 then begin
    Result := decoderUtf8.Decode(Byte(src), decoded)
    //Utf8ToUnicode()
  end else Result := true;
end;

function TnrTerminal.GetUtf8: boolean;
begin
  Result := fUtf8;
end;

procedure TnrTerminal.SetUtf8(const Value: boolean);
begin
  fUtf8 := Value;
end;

procedure TnrTerminal.SetCaretVisible(const Value: boolean);
begin
  fCaretVisible := Value;
  CreateCaret;
end;

function TnrTerminal.GetMouseMode: TnrTerminalMouseMode;
begin
  Result := fMouseMode;
end;

procedure TnrTerminal.SetMouseMode(const Value: TnrTerminalMouseMode);
begin
  fMouseMode := Value;
end;

end.
