unit terminals;

{$M+}

interface
uses encodings, types, lexer_interfaces, DFAs;

type
  TUNIXTerminalInputReceived = procedure(Sender : TObject; input : { nowadays UTF-8 } String) of object;

  TTextAttribute = (taBold, taUnderline);
  TTextAttributes = set of TTextAttribute;

  // semi-private:
  TUNIXTerminalInputReceivedArray = array of TUNIXTerminalInputReceived;

  TTerminalSizeChanged = procedure(Sender : TObject; size : TSize) of object;
  ITerminal = interface
    procedure UpdateTerminalSize;
    procedure WriteUnicode(character : TUnicodeCodepoint);
    procedure Write(text : Char); overload;
    procedure Write(const text : UTF8String); overload; // convenience.
    procedure Write(text : PChar; aSize : Cardinal); overload;
    // procedure WriteRaw(const text : UTF8String); { you really don't want this to change caret position. }
    function WhereX : Cardinal; // 0-based.
    function WhereY : Cardinal;
    procedure ClrSCR;
    procedure GotoXY(x, y : Cardinal); // 0-based.
    procedure ClrEOL;
    procedure ClrEOS;
    procedure EnableLineWrapping;
    procedure DisableLineWrapping;
    procedure GotoHome;
    procedure Flush;
    procedure StoreCurrentPosition;
    procedure RestoreCurrentPosition;
    function GetSizeChanged : TTerminalSizeChanged;
    procedure SetSizeChanged(aValue : TTerminalSizeChanged);
    property SizeChanged : TTerminalSizeChanged read GetSizeChanged write SetSizeChanged;
    function GetSizeX : Cardinal;
    procedure SetSizeX(aValue : Cardinal);
    property SizeX : Cardinal read GetSizeX write SetSizeX;
    function GetSizeY : Cardinal;
    procedure SetSizeY(aValue : Cardinal);
    property SizeY : Cardinal read GetSizeY write SetSizeY;
    
    procedure ReadInput;
    procedure RegisterInputHandler(aPrefix : {lexer}String; aInputReceived : TUNIXTerminalInputReceived);
    procedure RestoreSettings;
    procedure SetTextColor(aColor : string); // FIXME make interface less silly.
    function GetTextColor() : string;
    procedure SetTextAttributes(aValue : TTextAttributes);
    function GetTextAttributes() : TTextAttributes;
    property TextColor : string read GetTextColor write SetTextColor;
    property TextAttributes : TTextAttributes read GetTextAttributes write SetTextAttributes;
    procedure SetTitle(aValue : string);
  end;

  TCustomTerminal = class(TInterfacedObject, IInterface)
  protected
    fSizeChanged : TTerminalSizeChanged;
    fWhereX : Cardinal;
    fWhereY : Cardinal;
    fTextAttributes : TTextAttributes;
    fSize : TSize;
    fNewSize : TSize;
  protected
    function GetSizeChanged : TTerminalSizeChanged;
    procedure SetSizeChanged(aValue : TTerminalSizeChanged);
    procedure EmitSizeChanged(aNewSize : TSize);
    function GetSizeX : Cardinal;
    procedure SetSizeX(aValue : Cardinal);
    function GetSizeY : Cardinal;
    procedure SetSizeY(aValue : Cardinal);
    procedure UpdateTerminalSize; virtual;
    procedure SetTextAttributes(aValue : TTextAttributes);
    function GetTextAttributes() : TTextAttributes;
    procedure WriteColorControlSequence(); virtual;
  public
    destructor Destroy; override;
  published
    constructor Create;
    property SizeChanged : TTerminalSizeChanged read GetSizeChanged write SetSizeChanged;
    property SizeX : Cardinal read GetSizeX write SetSizeX;
    property SizeY : Cardinal read GetSizeY write SetSizeY;
    procedure RestoreSettings; virtual;
    function WhereX : Cardinal; inline;
    function WhereY : Cardinal; inline;
  end;
    
  TUNIXTerminal = class(TCustomTerminal, ITerminal, IInterface)
  private
    fLow : Text;
    fUTF8Multibyte : array[0..4] of Char;
    fUTF8MultibyteCount : Cardinal;
    fInputLexer : ILexer;
    fInputAutomaton : IDFAAutomaton;
    fInputTokenCallbacks : TUNIXTerminalInputReceivedArray;
    fInputBuffer : array[0..63] of Char;
    fInputBufferUsed : Cardinal;
    fSimpleTextColor : Byte; // 0=default.
  protected
    procedure RecordInput(aSender : TObject; aInput : TLexerChar);
    procedure WriteColorControlSequence(); override;
  protected
    procedure SetTextColor(aColor : string); // FIXME make interface less silly.
    function GetTextColor() : string;
  public
  published
    constructor Create;
    procedure UpdateTerminalSize; override;
    procedure WriteUnicode(character : TUnicodeCodepoint);
    procedure Write(text : Char); overload;
    procedure Write(const text : UTF8String); overload; // convenience.
    procedure Write(text : PChar; aSize : Cardinal); overload;
    procedure ClrSCR;
    procedure GotoXY(x, y : Cardinal);
    procedure ClrEOL;
    procedure ClrEOS;
    procedure EnableSimpleMouseEvents;
    procedure DisableSimpleMouseEvents;
    procedure EnableMousePressReleaseTracking;
    procedure EnableMouseHighlightTracking;
    procedure EnableMouseButtonMotionTracking;
    procedure DisableMousePressReleaseTracking;
    procedure DisableMouseHighlightTracking;
    procedure DisableMouseButtonMotionTracking;
    procedure DisableMouseMotionTracking;
    procedure SetMouseHighlightTrackingRange(aStartX, aStartY, aFirstRow, aLastRow : Cardinal);
    // any... procedure Enable
    procedure EnableLineWrapping;
    procedure DisableLineWrapping;
    procedure GotoHome;
    procedure Flush;
    procedure StoreCurrentPosition;
    procedure RestoreCurrentPosition;

    // TODO add full reflection and management for this:
    procedure ReadInput; // auto-dispatch.
    procedure RegisterInputHandler(aPrefix : {lexer}String; aInputReceived : TUNIXTerminalInputReceived);
    property TextColor : string read GetTextColor write SetTextColor;
    property TextAttributes : TTextAttributes read GetTextAttributes write SetTextAttributes;
    procedure RestoreSettings; override;
    procedure WriteRaw(const text : UTF8String); { you really don't want this to change caret position. }
    procedure SetTitle(aValue : string);
  end;

{$IFDEF WIN32}  
  TWindowsTerminal = class(TCustomTerminal, ITerminal, IInterface)
  private
    fHOutput : THandle;
    fSimpleTextColor : Integer; // 0=default.
    fStoredCursorPositionX : Cardinal;
    fStoredCursorPositionY : Cardinal;
  protected
    procedure WriteColorControlSequence(); override;
    procedure SetTextColor(aColor : string); // FIXME make interface less silly.
    function GetTextColor() : string;
    procedure UpdateCursorPositionMemory(); inline;
  published
    property TextColor : string read GetTextColor write SetTextColor;
    property TextAttributes : TTextAttributes read GetTextAttributes write SetTextAttributes;
    procedure GotoXY(x, y : Cardinal); // 0-based.
    procedure SetTitle(aValue : string);
    procedure WriteUnicode(character : TUnicodeCodepoint);
    procedure Write(text : Char); overload;
    procedure Write(const text : UTF8String); overload; // convenience.
    procedure Write(text : PChar; aSize : Cardinal); overload;
    procedure ClrSCR;
    procedure ClrEOL;
    procedure ClrEOS;
    procedure EnableLineWrapping;
    procedure DisableLineWrapping;
    procedure GotoHome;
    procedure Flush;
    procedure StoreCurrentPosition;
    procedure RestoreCurrentPosition;
    procedure ReadInput;
    procedure RegisterInputHandler(aPrefix : {lexer}String; aInputReceived : TUNIXTerminalInputReceived);
    constructor Create();
    procedure RestoreSettings; override;
    procedure UpdateTerminalSize; override;
  end;
{$ENDIF}
  
implementation
uses buffers,
{$IFNDEF WIN32}
baseunix, termio, 
{$ELSE}
windows,
{$ENDIF}
classes, streams, keyboard, debug, sysutils;

{ TCustomTerminal }

var
  gTerminal : TCustomTerminal = nil; // for the signal handler.

constructor TCustomTerminal.Create;
begin
  InitKeyboard;

  if not Assigned(gTerminal) then
    gTerminal := Self;
end;

destructor TCustomTerminal.Destroy;
begin
  if gTerminal = Self then
    gTerminal := nil;

  Self.RestoreSettings; 
  
  inherited Destroy;
end;

procedure TCustomTerminal.RestoreSettings;
begin
end;

procedure TCustomTerminal.UpdateTerminalSize; 
begin
end;

function TCustomTerminal.GetSizeChanged : TTerminalSizeChanged;
begin
  Result := fSizeChanged;
end;

procedure TCustomTerminal.SetSizeChanged(aValue : TTerminalSizeChanged);
begin
  fSizeChanged := aValue;
  UpdateTerminalSize;
  // EmitSizeChanged(fSize);
end;

function TCustomTerminal.GetSizeX : Cardinal;
begin
  Result := fSize.cx;
end;

procedure TCustomTerminal.SetSizeX(aValue : Cardinal);
begin
  fSize.cx := aValue;
end;

function TCustomTerminal.GetSizeY : Cardinal;
begin
  Result := fSize.cy;
end;

procedure TCustomTerminal.SetSizeY(aValue : Cardinal);
begin
  fSize.cy := aValue;
end;

procedure TCustomTerminal.EmitSizeChanged(aNewSize : types.TSize);
begin
  fSize := fNewSize;

  if Assigned(fSizeChanged) then
    fSizeChanged(Self, aNewSize);
end;

function TCustomTerminal.GetTextAttributes() : TTextAttributes;
begin
  Result := fTextAttributes;
end;

procedure TCustomTerminal.SetTextAttributes(aValue : TTextAttributes);
begin
  fTextAttributes := aValue;
  WriteColorControlSequence();
end;

procedure TCustomTerminal.WriteColorControlSequence();
begin
end;

function TCustomTerminal.WhereX : Cardinal; inline;
begin
  Result := fWhereX;
end;

function TCustomTerminal.WhereY : Cardinal; inline;
begin
  Result := fWhereY;
end;

{ TUNIXTerminal }

{ you really don't want this to change caret position. }
procedure TUNIXTerminal.WriteRaw(const text : UTF8String);
begin
  System.Write(fLow, text);
end;

constructor TUNIXTerminal.Create;
begin
  inherited Create;
  fLow := StdOut;
  
  SetLength(fInputTokenCallbacks, 0);
  fInputAutomaton := TDFAAutomaton.Create;
  fInputLexer := TDFALexer.Create(fInputAutomaton);
  fInputLexer.SourceStream := TTerminalInputStream.Create(TextRec(fLow).Handle);
  fInputLexer.InputConsumed := Self.RecordInput;
  
  Self.UpdateTerminalSize;
  DisableMouseMotionTracking();
  EnableMouseButtonMotionTracking(); // fallback
  EnableMousePressReleaseTracking(); // fallback-fallback.
  // BROKEN EnableMouseHighlightTracking(); // FIXME optional.
end;

procedure TUNIXTerminal.RecordInput(aSender : TObject; aInput : TLexerChar);
begin
  if fInputBufferUsed < System.Length(fInputBuffer) then begin
    fInputBuffer[fInputBufferUsed] := aInput;
    Inc(fInputBufferUsed);
  end;
end;

procedure TUNIXTerminal.Write(text : Char);
begin
  Self.Write(PChar(@text), 1);
end;

procedure TUNIXTerminal.UpdateTerminalSize;
{$IFNDEF WIN32}
var
  size : TWinSize;
{$ENDIF}
begin
{$IFNDEF WIN32}
  // TODO support other (multiple?) terminals.
  
  if fpioctl(1, TIOCGWINSZ, @size) = -1 then
    Exit;

  if (size.ws_col = 0) or (size.ws_row = 0) then begin
    size.ws_col := 80;
    size.ws_row := 25;
  end;

  fNewSize.cx := size.ws_col;
  fNewSize.cy := size.ws_row;
  // ws_xpixel, ws_ypixel
  
  // TODO synchronisation.
  // TODO inject a key event (ungetc) to ourselves after we pulled all the stuff from "events.pp" over and do #"ReadKey" on the same terminal anyway.
  
  Self.EmitSizeChanged(fNewSize);
{$ENDIF}
end;

// this doesn't neccessarily print a glyph because diacritical marks could follow.
procedure TUNIXTerminal.WriteUnicode(character : TUnicodeCodepoint);
begin
  // TODO support non-UTF8 terminals?
  
  if character < $80 then begin
    fUTF8MultibyteCount := 1;
    fUTF8Multibyte[0] := Chr(character);
  end else if character < $800 then begin
    // 0000 0080–0000 07FF ->  110xxxxx 10xxxxxx
    fUTF8MultibyteCount := 2;
    fUTF8Multibyte[0] := Chr($C0 or (character shr 6));
    fUTF8Multibyte[1] := Chr($80 or (character and $3F));
  end else if character < $10000 then begin
    // 0000 0800–0000 FFFF -> 1110xxxx 10xxxxxx 10xxxxxx
    fUTF8MultibyteCount := 3;
    fUTF8Multibyte[0] := Chr($E0 or (character shr 12));
    fUTF8Multibyte[1] := Chr($80 or ((character shr 6) and $3F));
    fUTF8Multibyte[2] := Chr($80 or (character and $3F));
  end else if character < $110000 then begin
    // 0001 0000–0010 FFFF -> 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
    fUTF8MultibyteCount := 4;
    fUTF8Multibyte[0] := Chr($F0 or (character shr 18));
    fUTF8Multibyte[1] := Chr($80 or ((character shr 12) and $3F));
    fUTF8Multibyte[2] := Chr($80 or ((character shr 6) and $3F));
    fUTF8Multibyte[3] := Chr($80 or (character and $3F));
  end else begin
    fUTF8MultibyteCount := 1;
    fUTF8Multibyte[0] := '?';
  end;
  Self.Write(PChar(fUTF8Multibyte), fUTF8MultibyteCount);
end;

{ write possibly multi-line text }
procedure TUNIXTerminal.Write(const text : UTF8String); overload;
var
  iText : Integer;
  cText : Char;
begin
  for iText := 1 to Length(text) do begin
    cText := text[iText];
    if cText = buffers.cLineBreak then begin
      fWhereX := 0;
      Inc(fWhereY);
      System.Write(#13#10);
    end else begin
      System.Write(cText);
      if (Ord(cText) < $80) or (Ord(cText) >= $C0) then
        Inc(fWhereX);
    end;
  end;

  // TODO set terminal to #10-is-newline-mode and get rid of the Write() above
end;

procedure TUNIXTerminal.ClrEOL;
begin
  if fWhereX < SizeX then // some terminals like to constrain the cursor to the actual line. If you write 80 characters in a line of 80 characters, the caret will NOT be AFTER these 80 characters but on the 80th.
    WriteRaw(#27 + '[K');
end;

procedure TUNIXTerminal.ClrEOS;
begin
  WriteRaw(#27 + '[J');
end;

{ PChar, but not neccessarily null-terminated. In any case, the procedure doesn't care about the termination and you better hide it from it. }
procedure TUNIXTerminal.Write(text : PChar; aSize : Cardinal); overload;
var
  iText : Integer;
  cText : Char;
begin
  for iText := 1 to aSize do begin
    cText := text[0];
    if cText = buffers.cLineBreak then begin
      // the console character painter does this. It's a lot less magic that way. ClrEOL; // just in case.
      fWhereX := 0;
      Inc(fWhereY);
      System.Write(#13#10);
    end else begin
      System.Write(cText);
      Inc(fWhereX);
      //if fWhereX = SizeX then
      //  WriteRaw(#27 + '[A'); // some terminals like to constrain the cursor to the actual line. If you write 80 characters in a line of 80 characters, the caret will NOT be AFTER these 80 characters but on the 80th.
    end;
    Inc(text);
  end;

  // TODO set terminal to #10-is-newline-mode and get rid of the Write() above
end;

procedure TUNIXTerminal.ClrSCR;
begin
  WriteRaw(#27 + '[2J');
end;

procedure TUNIXTerminal.GotoXY(x, y : Cardinal);
begin
  WriteRaw(#27 + '[' + IntToStr(y + 1) + ';' + IntToStr(x + 1) + 'H');
  
  //Gotoxy(x, y);
  Self.Flush;
  fWhereX := x;
  fWhereY := y;
end;

procedure TUNIXTerminal.EnableSimpleMouseEvents;
begin
  WriteRaw(#27 + '[?9h'); // enable mouse events
end;

procedure TUNIXTerminal.DisableSimpleMouseEvents;
begin
  WriteRaw(#27 + '[?9l'); // Turn off mouse reporting
end;

procedure TUNIXTerminal.GotoHome;
begin
  WriteRaw(#27 + '[H');
end;

procedure TUNIXTerminal.Flush;
begin
  System.Flush(fLow);
end;

procedure TUNIXTerminal.StoreCurrentPosition;
begin
  WriteRaw(#27 + '[s');
end;

procedure TUNIXTerminal.RestoreCurrentPosition;
begin
  WriteRaw(#27 + '[u');
end;

procedure TUNIXTerminal.EnableLineWrapping;
begin
  WriteRaw(#27 + '[7h');
end;

procedure TUNIXTerminal.DisableLineWrapping;
begin
  WriteRaw(#27 + '[7l');
end;

procedure TUNIXTerminal.RegisterInputHandler(aPrefix : {lexer}String; aInputReceived : TUNIXTerminalInputReceived);
var
  newToken : TToken;
  previousSize : Integer;
  newSize : Integer;
  i : Integer;
begin
  newToken := fInputAutomaton.GetHighestToken + 1;
  newSize := Integer(newToken) + 1;

  previousSize := Length(fInputTokenCallbacks);
  
  // grow array:
  
  SetLength(fInputTokenCallbacks, newSize);
  
  for i := previousSize to newSize - 1 do begin
    fInputTokenCallbacks[i] := nil;
  end;

  assert(not Assigned(fInputTokenCallbacks[newToken])); // assigning multiple handlers to one location is not supported yet.  
  fInputTokenCallbacks[newToken] := aInputReceived;

  fInputAutomaton.AddLexed(aPrefix, newToken); 
end;

procedure TUNIXTerminal.ReadInput;
var
  token : TToken;
begin
  token := fInputLexer.Consume;
  
  if token <> TokenNone then begin // should always be, but...
    if Assigned(fInputTokenCallbacks[token]) then begin // should always be, but...
      fInputTokenCallbacks[token](Self, fInputBuffer);
    end;
  end;
  fInputBufferUsed := 0;
end;

procedure TUNIXTerminal.RestoreSettings;
begin
  DisableMousePressReleaseTracking;
  DisableMouseHighlightTracking;
  DisableMouseButtonMotionTracking;
  DoneKeyboard;
end;

procedure TUNIXTerminal.EnableMousePressReleaseTracking;
begin
  WriteRaw(#27'[?1000h');
end;

procedure TUNIXTerminal.EnableMouseHighlightTracking;
begin
  WriteRaw(#27'[?1001h');
end;

{ first row: row 1. If you want to disable tracking, pass lastrow < firstrow.
  ONLY call this after you received a "mouse button pressed" event and after you enabled Mouse hilight tracking. }
procedure TUNIXTerminal.SetMouseHighlightTrackingRange(aStartX, aStartY, aFirstRow, aLastRow : Cardinal);
begin
  if getenvironmentvariable('TERM') <> 'xterm' then
    Exit;

  Dump(Format('[%d;%d;%d;%d;%dT', [1, aStartX, aStartY, aFirstRow, aLastRow]));
  if aFirstRow <= aLastRow then
    WriteRaw(#27 + Format('[%d;%d;%d;%d;%dT', [1, aStartX, aStartY, aFirstRow, aLastRow]))
  else
    WriteRaw(#27'[0;0;0;0;0T');
  Flush;
end;

procedure TUNIXTerminal.EnableMouseButtonMotionTracking;
begin
  WriteRaw(#27'[?1002h');
end;

procedure TUNIXTerminal.DisableMousePressReleaseTracking;
begin
  WriteRaw(#27'[?1000l');
end;

procedure TUNIXTerminal.DisableMouseHighlightTracking;
begin
  WriteRaw(#27'[?1001l');
end;

procedure TUNIXTerminal.DisableMouseButtonMotionTracking;
begin
  WriteRaw(#27'[?1002l');
end;

procedure TUNIXTerminal.DisableMouseMotionTracking;
begin
  WriteRaw(#27'[?1003l');
end;

procedure TUNIXTerminal.WriteColorControlSequence();
var
  fColorText : string;
begin
  if fSimpleTextColor <> 0 then
    fColorText := IntToStr(fSimpleTextColor)
  else
    fColorText := '';

  if taBold in fTextAttributes then
    fColorText := fColorText + ';1';
  if taUnderline in fTextAttributes then
    fColorText := fColorText + ';4';
  WriteRaw(Format(#27'[%sm', [fColorText]));
end;

procedure TUNIXTerminal.SetTextColor(aColor : string); // FIXME make interface less silly.
var
  fColorCode : Byte;
begin
  if aColor = '' then fColorCode := 0
  else if aColor = 'red' then fColorCode := 31
  else if aColor = 'green' then fColorCode := 32
  else if (aColor = 'brown') or (aColor = 'yellow') then fColorCode := 33
  else if (aColor = 'blue') then fColorCode := 34
  else if (aColor = 'magenta') then fColorCode := 35
  else if (aColor = 'cyan') then fColorCode := 36
  else if (aColor = 'gray') or (aColor = 'white') then fColorCode := 37
  else fColorCode := 0;

  fSimpleTextColor := fColorCode;
  WriteColorControlSequence();
end;

function TUNIXTerminal.GetTextColor() : string;
begin
  case fSimpleTextColor of
  31: Result := 'red';
  32: Result := 'green';
  33: Result := 'brown';
  34: Result := 'blue';
  35: Result := 'magenta';
  36: Result := 'cyan';
  37: Result := 'gray';
  0: Result := '';
  else Result := '?';
  end;
end;

procedure TUNIXTerminal.SetTitle(aValue : string);
begin
  WriteRaw(Format(#27']0;%s'#7, [aValue])); // FIXME escape.
end;



{$IFNDEF WIN32} 
var
  savedSIGWINCHHandler : sigactionrec;
  //currentSize : TWinsize;
  //newSize : TWinsize;

procedure HandleSIGWINCH(signum : longint; SigInfo: PSigInfo; SigContext: PSigContext); cdecl;
begin
  // TODO if (sigactionhandler(SIG_IGN) <> savedSIGWINCHHandler.sa_handler) and (sigactionhandler(SIG_DFL) <> savedSIGWINCHHandler.sa_handler) then
    savedSIGWINCHHandler.sa_handler(signum, nil, nil);

  if Assigned(gTerminal) then
    gTerminal.UpdateTerminalSize;
end;

procedure InstallSIGWINCHHandler;
var
  SIGWINCHHandler : sigactionrec;
begin
  fpsigemptyset(SIGWINCHHandler.sa_mask);
  SIGWINCHHandler.sa_handler := @HandleSIGWINCH;
  SIGWINCHHandler.sa_flags:=0;
  fpsigaction(SIGWINCH, @SIGWINCHHandler, @savedSIGWINCHHandler);
end;

procedure RemoveSIGWINCHHandler;
begin
  //FIXME
  fpsigaction(SIGWINCH, @savedSIGWINCHHandler, nil);
end;
{$ENDIF}
{$IFDEF WIN32}
{ TWindowsTerminal }

const
  // TODO DBCS.
  // Attributes flags:

  FOREGROUND_BLUE      = $0001; // text color contains blue.
  FOREGROUND_GREEN     = $0002; // text color contains green.
  FOREGROUND_RED       = $0004; // text color contains red.
  FOREGROUND_INTENSITY = $0008; // text color is intensified.
  BACKGROUND_BLUE      = $0010; // background color contains blue.
  BACKGROUND_GREEN     = $0020; // background color contains green.
  BACKGROUND_RED       = $0040; // background color contains red.
  BACKGROUND_INTENSITY = $0080; // background color is intensified.

procedure TWindowsTerminal.WriteColorControlSequence();
var
  //fOldColorAttrs : DWORD;
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  Flush();
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  //fOldColorAttrs := csbiInfo.wAttributes;
  if not SetConsoleTextAttribute(fHOutput, FOREGROUND_RED or FOREGROUND_INTENSITY) then // FIXME color.
    Halt(1);

  // Turn off the line input and echo input modes 
  
  //if (! GetConsoleMode(hStdin, &fdwOldMode)) 
  //fdwMode = fdwOldMode &~(ENABLE_LINE_INPUT | ENABLE_ECHO_INPUT); 
  //if (! SetConsoleMode(hStdin, fdwMode)) 
end;

procedure TWindowsTerminal.SetTextColor(aColor : string); // FIXME make interface less silly.
var
  fColorCode : Byte;
begin
  if aColor = '' then fColorCode := 0
  else if aColor = 'red' then fColorCode := FOREGROUND_RED
  else if aColor = 'green' then fColorCode := FOREGROUND_GREEN
  else if (aColor = 'brown') or (aColor = 'yellow') then fColorCode := FOREGROUND_RED or FOREGROUND_GREEN
  else if (aColor = 'blue') then fColorCode := FOREGROUND_BLUE
  else if (aColor = 'magenta') then fColorCode := FOREGROUND_RED or FOREGROUND_BLUE
  else if (aColor = 'cyan') then fColorCode := FOREGROUND_GREEN or FOREGROUND_BLUE
  else if (aColor = 'gray') or (aColor = 'white') then fColorCode := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE
  else fColorCode := 0;

  fSimpleTextColor := fColorCode;
  WriteColorControlSequence();
end;

function TWindowsTerminal.GetTextColor() : string;
begin
  case fSimpleTextColor and (FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE) of
  FOREGROUND_RED: Result := 'red';
  FOREGROUND_GREEN: Result := 'green';
  FOREGROUND_RED or FOREGROUND_GREEN: Result := 'brown';
  FOREGROUND_BLUE: Result := 'blue';
  FOREGROUND_RED or FOREGROUND_BLUE: Result := 'magenta';
  FOREGROUND_GREEN or FOREGROUND_BLUE: Result := 'cyan';
  FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE: Result := 'gray';
  0: Result := '';
  else Result := '?';
  end;
end;

procedure TWindowsTerminal.GotoXY(x, y : Cardinal); // 0-based.
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  Flush();
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  csbiInfo.dwCursorPosition.X := x; 
  // if ((csbiInfo.dwSize.Y-1) == csbiInfo.dwCursorPosition.Y) 
  //      ScrollScreenBuffer(hStdout, 1); 
  csbiInfo.dwCursorPosition.Y := y; 

  fWhereX := x;
  fWhereY := y; 
  if not SetConsoleCursorPosition(fHOutput, csbiInfo.dwCursorPosition) then
    Halt(1);
end;

procedure TWindowsTerminal.SetTitle(aValue : string);
begin
  SetConsoleTitle(PChar(aValue));
end;

constructor TWindowsTerminal.Create();
begin
  inherited Create;
  fHOutput := GetStdHandle(STD_OUTPUT_HANDLE);

  if not SetConsoleCP(65001) then
    Halt(1);

  Self.UpdateTerminalSize;
end;

procedure TWindowsTerminal.RestoreSettings();
begin
end;

procedure TWindowsTerminal.WriteUnicode(character : TUnicodeCodepoint);
var
  fItem : DWORD;
  fWrittenCount : DWORD;
begin
  fItem := character;
  if not Windows.WriteConsoleW(fHOutput, @fItem, 1, fWrittenCount, nil) then
    Halt(1);

  UpdateCursorPositionMemory();
end;

procedure TWindowsTerminal.Write(text : Char); overload;
var
  fWrittenCount : DWORD;
begin
  if not Windows.WriteConsoleA(fHOutput, @text, 1, fWrittenCount, nil) then
    Halt(1);

  UpdateCursorPositionMemory();
end;

procedure TWindowsTerminal.Write(const text : UTF8String); overload; // convenience.
var
  fWrittenCount : DWORD;
begin
  if not Windows.WriteConsoleA(fHOutput, @text, Length(text), fWrittenCount, nil) or (fWrittenCount <> Length(text)) then
    Halt(1);

  UpdateCursorPositionMemory();
end;

procedure TWindowsTerminal.Write(text : PChar; aSize : Cardinal); overload;
var
  fWrittenCount : DWORD;
begin
  if not Windows.WriteConsoleA(fHOutput, text, aSize, fWrittenCount, nil) or (fWrittenCount <> aSize) then
    Halt(1);
end;

procedure TWindowsTerminal.ClrSCR;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
  fUpperLeft : COORD;
  fWrittenCount : DWORD;
begin 
  fUpperLeft.X := 0;
  fUpperLeft.Y := 0;
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  FillConsoleOutputCharacter(fHOutput, ' ', csbiInfo.dwSize.X * SizeY, fUpperLeft, @fWrittenCount);
  FillConsoleOutputAttribute(fHOutput, csbiInfo.wAttributes, csbiInfo.dwSize.X * SizeY, fUpperLeft, @fWrittenCount);
end;

procedure TWindowsTerminal.ClrEOL;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
  fUpperLeft : COORD;
  fWrittenCount : DWORD;
begin
  if fWhereX < SizeX then begin
    //GotoXY(fWhereX, fWhereY);
    fUpperLeft.X := fWhereX;
    fUpperLeft.Y := fWhereY;
    if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
      Halt(1);
    FillConsoleOutputCharacter(fHOutput, ' ', SizeX - fWhereX, fUpperLeft, fWrittenCount);
    FillConsoleOutputAttribute(fHOutput, csbiInfo.wAttributes, SizeX - fWhereX, fUpperLeft, fWrittenCount);
  end;
end;

procedure TWindowsTerminal.ClrEOS;
begin
  // FIXME
end;

procedure TWindowsTerminal.EnableLineWrapping;
var
  fOldMode : DWORD;
begin
  if not GetConsoleMode(fHOutput, @fOldMode) then
    Halt(1);
  fOldMode := fOldMode or ENABLE_WRAP_AT_EOL_OUTPUT;
  if not SetConsoleMode(fHOutput, fOldMode) then
    Halt(1);
end;

procedure TWindowsTerminal.DisableLineWrapping;
var
  fOldMode : DWORD;
begin
  if not GetConsoleMode(fHOutput, @fOldMode) then
    Halt(1);
  fOldMode := fOldMode and not ENABLE_WRAP_AT_EOL_OUTPUT;
  if not SetConsoleMode(fHOutput, fOldMode) then
    Halt(1);
end;

procedure TWindowsTerminal.GotoHome;
begin
  GotoXY(0, 0);
end;

procedure TWindowsTerminal.Flush;
begin
  // FIXME
end;

procedure TWindowsTerminal.StoreCurrentPosition;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  Flush();

  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  fStoredCursorPositionX := csbiInfo.dwCursorPosition.X;
  fStoredCursorPositionY := csbiInfo.dwCursorPosition.Y;
end;

procedure TWindowsTerminal.RestoreCurrentPosition;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  Flush();
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  csbiInfo.dwCursorPosition.X := fStoredCursorPositionX;
  csbiInfo.dwCursorPosition.Y := fStoredCursorPositionY;
  if not SetConsoleCursorPosition(fHOutput, csbiInfo.dwCursorPosition) then
    Halt(1);
end;

procedure TWindowsTerminal.ReadInput;
begin
end;

procedure TWindowsTerminal.RegisterInputHandler(aPrefix : {lexer}String; aInputReceived : TUNIXTerminalInputReceived);
begin
end;

procedure TWindowsTerminal.UpdateTerminalSize;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  with csbiInfo.srWindow do begin
    fNewSize.cx := Right - Left + 1;
    fNewSize.cy := Bottom - Top + 1;
  end;
  //fNewSize.cy := csbiInfo.dwSize.Y;
  Self.EmitSizeChanged(fNewSize);
end;

procedure TWindowsTerminal.UpdateCursorPositionMemory(); inline;
var
  csbiInfo : CONSOLE_SCREEN_BUFFER_INFO;
begin
  Flush();
  if not GetConsoleScreenBufferInfo(fHOutput, @csbiInfo) then
    Halt(1);
  fWhereX := csbiInfo.dwCursorPosition.X;
  fWhereY := csbiInfo.dwCursorPosition.Y;
end;

{$ENDIF}

{

void mouse_report(struct tty_struct *tty, int butt, int mrx, int mry)
        char buf[8];

        sprintf(buf, "\033[M%c%c%c", (char)(' ' + butt), (char)('!' + mrx),
                (char)('!' + mry));
        respond_string(buf, tty);   
}

initialization
{$IFNDEF WIN32}
  InstallSIGWINCHHandler;
{$ENDIF}

finalization
{$IFNDEF WIN32}
  RemoveSIGWINCHHandler;
{$ENDIF}
  if Assigned(gTerminal) then
    FreeAndNil(gTerminal);
  
  // TODO free the other terminals if neccessary.
                                     
end.