unit views;

{$M+}

{ TODO: file name bar? menu bar? status bar? scrolling? 'modified' flag (since loading)? }

interface

uses types, buffers, classes, terminals, painters, marks;

type
  TTextViewRefreshMode = (rmDummy, rmAll, rmScroll, rmCurrentLine, rmJustCaret);
  ITextView = interface
    ['{3d04a810-159d-11de-ad28-89da6fdef6ff}']
    procedure QueueRefreshAll;
    procedure Idle;
    function GetBuffer : ITextBuffer;
    procedure SetBuffer(aBuffer : ITextBuffer);
    property Buffer : ITextBuffer read GetBuffer write SetBuffer;
    function GetCaret : ITextMark;
    property Caret : ITextMark read GetCaret;
    procedure Refresh(aMode : TTextViewRefreshMode = rmAll); overload;
    function GetBufferWindowSize : Cardinal;
    property BufferWindowSize : Cardinal read GetBufferWindowSize; // number of items from the buffer _currently_ (i.e. after "Refresh") visible on screen.
    function FindOffsetNearVisualPosition(aX, aY : Cardinal; out oCharacterRect : TRect) : Cardinal;
    
    // FIXME mark:
    function GetWindowBeginning() : Cardinal;
    procedure SetWindowBeginning(aValue : Cardinal);
    property WindowBeginning : Cardinal read GetWindowBeginning write SetWindowBeginning;
    
    function GetBeginning() : ITextMark;
    property Beginning : ITextMark read GetBeginning; // TODO SetBeginning.
    function GetEnd1() : ITextMark;
    property End1 : ITextMark read GetEnd1;
    procedure BeginSelectingAt(aX, aY : Cardinal);
    procedure ContinueSelectingTo(aX, aY : Cardinal);
    procedure EndSelectingAt(aX, aY : Cardinal);
  end;

  TTextView = class(TInterfacedObject, ITextView, IInterface)
  private
    fBuffer : ITextBuffer;
    fRefreshAllP : Boolean;
    fTextCaret : ITextMark;
    fLineBeginnings : IInterfaceList; // array of ITextMark // not neccessarily paragraph beginnings?
    fPainter : IContinuousCharacterPainter;
    fDummyPainter : IContinuousCharacterPainter;
    fNewSize : TSize;
    fWindowBeginning : ITextMark;
    fDirtyBeginning : ITextMark; // was-too-lazy-to-repaint far beginning edge.
    fBeginning : ITextMark;
    fEnd1 : ITextMark;
    // fWindowEnd : ITextMark;  // unimplementable.
    fBufferWindowSize : Cardinal; // number of items from the buffer _currently_ (i.e. after "Refresh", and just in the window without scrolling) visible on screen.
  protected
    function GetBuffer : ITextBuffer;
    procedure SetBuffer(aBuffer : ITextBuffer);
    function GetCaret : ITextMark;
    procedure UpdateTextCaretPosition(Sender : TObject);
    
    procedure HandleResize(Sender : TObject; aNewSize : TSize);
    function PrintCopyFromBuffer(const aPainter : IContinuousCharacterPainter; const aBlocks : ITextBufferBlockIterator) : Boolean;
    function GetBufferWindowSize : Cardinal;

    //function GetMarkVisualPosition(aMark : ITextMark): TPoint;
    function RedrawText(aMode : TTextViewRefreshMode) : Cardinal;
    function GetWindowBeginning() : Cardinal;
    procedure SetWindowBeginning(aValue : Cardinal);
    function GetBeginning() : ITextMark;
    function GetEnd1() : ITextMark;
    function Painter(aMode : TTextViewRefreshMode) : IContinuousCharacterPainter; inline;
  public
    destructor Destroy; override;
  published
    property Buffer : ITextBuffer read GetBuffer write SetBuffer;
    property Caret : ITextMark read GetCaret;
    // TODO Pointer ?
    property BufferWindowSize : Cardinal read GetBufferWindowSize; // number of items from the buffer _currently_ (i.e. after "Refresh") visible on screen.
    property WindowBeginning : Cardinal read GetWindowBeginning write SetWindowBeginning;
    property Beginning : ITextMark read GetBeginning; // TODO SetBeginning.
    property End1 : ITextMark read GetEnd1; // TODO writer.
    
    procedure DisplayBufferChange(Sender : TObject; aAction : TTextBufferAction; aPosition : Cardinal; aCount : Cardinal; aValue : PChar); overload;
    procedure Refresh(aMode : TTextViewRefreshMode = rmAll); overload;
    procedure QueueRefreshAll;
    procedure Idle; // refresh...
    constructor Create(aPainter : IContinuousCharacterPainter);
    function FindOffsetNearVisualPosition(aX, aY : Cardinal; out oCharacterRect : TRect) : Cardinal;
    procedure BeginSelectingAt(aX, aY : Cardinal);
    procedure ContinueSelectingTo(aX, aY : Cardinal);
    procedure EndSelectingAt(aX, aY : Cardinal);
  end;
  
implementation

uses sysutils, textfitters, debug, ModificationMonitorTextMarks;

{$IFNDEF UNIT_TEST}
//uses crt;
{$ENDIF}

function TTextView.GetBuffer : ITextBuffer;
begin
  Result := fBuffer;
end;

procedure TTextView.UpdateTextCaretPosition(Sender : TObject);
begin
  // TODO make sure that the new caret is inside the currently visible window.
  Self.Refresh(rmJustCaret);
end;

procedure TTextView.SetBuffer(aBuffer : ITextBuffer);
begin
  if aBuffer = fBuffer then
    Exit;

  fTextCaret := nil;
      
  fTextCaret := aBuffer.CreateTextMark(0, afEnd);
  fTextCaret.PositionChanged := Self.UpdateTextCaretPosition;
  fBeginning := aBuffer.CreateTextMark(0, afBeginning);
  fEnd1 := aBuffer.CreateTextMark(0, afEnd);
  fWindowBeginning := aBuffer.CreateTextMark(0, afBeginning);
  fDirtyBeginning := aBuffer.CreateTextMark(0, afBeginning);

  aBuffer.Modified := DisplayBufferChange;
  fBuffer := aBuffer;
  QueueRefreshAll;
end;

function TTextView.GetCaret : ITextMark;
begin
  Result := fTextCaret;
end;

procedure TTextView.HandleResize(Sender : TObject; aNewSize : TSize);
begin
  // called by a signal handler. NO COMPLICATED STUFF (malloc, ...) HERE.

  fNewSize := aNewSize;
    
  Self.QueueRefreshAll;
end;

// called from a signal handler, be careful.
procedure TTextView.QueueRefreshAll;
begin
  // TODO delay
  fRefreshAllP := True;
end;

procedure TTextView.DisplayBufferChange(Sender : TObject; aAction : TTextBufferAction; aPosition : Cardinal; aCount : Cardinal; aValue : PChar); overload;
begin
  // notify all of our ModificationMonitorTextMarks in the vicinity of the change.
  
  // TODO handle every modification, not refreshing everything if it can be avoided.
  // as a compromise, you can remember min(aPosition) and only refresh if current-scroll-window-end-position >= that.
  // TODO if there are too many modifications in a small time window, revert to rmAll delayed execution.
  QueueRefreshAll; // (rmAll);
end;
  
{ stupid workarounds }

function CountNewlines(const text : UTF8String) : Cardinal;
var 
  iText : Integer;
begin
  Result := 0;
  for iText := 1 to Length(text) do 
    if text[iText] = buffers.cLineBreak then 
      Inc(Result);
end;


function TTextView.PrintCopyFromBuffer(const aPainter : IContinuousCharacterPainter; const aBlocks : ITextBufferBlockIterator) : Boolean;
var
  vItem : TTextBufferBlockIteratorItem;
  vWrittenCount : Cardinal;
  vItemBeginning : PTextBufferItem;
  vItemSize : Cardinal;
begin
  Result := True;
  vItem := aBlocks.Next;
  if vItem = nil then
    Exit;

  vItemBeginning := vItem.Beginning;
  vItemSize := vItem.Size;

  repeat
    if vItemSize > 0 then      
    repeat
      Dump(Format('PrintCopyFromBuffer chunk size: %d', [vItemSize]));

      // it's not allowed to switch painter here or even just reorder because the painter has state on how far it is in a multibyte character.
      vWrittenCount := aPainter.ProcessBlock(vItemBeginning, vItemSize);
      assert(vWrittenCount <= vItemSize);
      // Inc(Result, vWrittenCount);
      Inc(vItemBeginning, vWrittenCount);
      Dec(vItemSize, vWrittenCount);
    until (vItemSize = 0) or (vWrittenCount = 0); // either nothing left or could not write anything anymore.

    vItem := aBlocks.Next;
    if vItem = nil then
      Exit;
      
    vItemBeginning := vItem.Beginning;
    vItemSize := vItem.Size;
  until (vItem = nil) or (vWrittenCount = 0);
  if vWrittenCount = 0 then // oops
    Result := False;
end;

function TTextView.RedrawText(aMode : TTextViewRefreshMode) : Cardinal;
var
  tCaretLLPosition : Cardinal; // TODO #"IInterface" instead?
  fPainter : IContinuousCharacterPainter;
  function max(a, b : Cardinal) : Cardinal; inline; begin
    if a > b then
      Result := a
    else
      Result := b
  end;
begin
  fPainter := Painter(aMode);
  //tCaretLLPosition := fPainter.StoreCaretPosition;
  
  fPainter.BeginRound;

  if Self.PrintCopyFromBuffer(fPainter, fBuffer.Range(fWindowBeginning.Position, fTextCaret.Position)) and fPainter.FinishCharacter then begin
    Result := fPainter.CompletedInputCount;
  end else begin
    Result := fPainter.CompletedInputCount;
    Exit;
  end;

  fPainter.Flush;
    
  if aMode <> rmJustCaret then begin
    tCaretLLPosition := fPainter.StoreCaretPosition();
    Self.PrintCopyFromBuffer(fPainter, fBuffer.Range(max(fTextCaret.Position, fWindowBeginning.Position), Self.End1.Position));
    fPainter.FinishCharacter;
  
    fPainter.FinishRound;
    fPainter.Flush;

    Result := fPainter.CompletedInputCount; // tPrintedItemCount;

    //Write(fBuffer.End1.Position);
  
    //fPainter.WriteDebug(fBuffer.Debug(fTextCaret));
  
    fPainter.SetCaretPosition(tCaretLLPosition);
  end;
end;

procedure TTextView.Refresh(aMode : TTextViewRefreshMode = rmAll); overload;
var
  tPrintedItemCount : Cardinal;
  tRectangle : TTextLayoutRectangle;
  fPainter : IContinuousCharacterPainter;
begin
  fPainter := Painter(aMode);
  if aMode = rmAll then begin // FIXME make this nicer.
    tRectangle.Init;
    tRectangle.Width := fNewSize.cx;
    tRectangle.Height := fNewSize.cy;
    fPainter.SetRectangle(tRectangle);
  end;
  
  // TODO use an iterator, only output what you need to output.

{$IFDEF UNIT_TEST}  
  Writeln('');
  
  // TODO use interator
  tText := fBuffer.RangeText(fView.Beginning, fView.End1);
  // fTextCaret
  
  Write(tText);
{$ELSE}
  tPrintedItemCount := RedrawText(aMode);

  if aMode = rmJustCaret then
    Exit;

  if (aMode <> rmDummy) then
    fBufferWindowSize := tPrintedItemCount;

  // update the position starting from where our visual positions are currently invalid.
  fDirtyBeginning.Position := fWindowBeginning.Position + fBufferWindowSize;
  
  // TODO find out line lengths / heights, find out page lengths, store current page length somewhere, ...
  fPainter.Flush;
{$ENDIF}
end;

constructor TTextView.Create(aPainter : IContinuousCharacterPainter);
begin
  fLineBeginnings := TInterfaceList.Create;
  fPainter := aPainter;
  fPainter.RowSpacing := 0; // TODO.
  fPainter.TotalSizeChanged := HandleResize;
  //fPainter.GotoHome;
  fDummyPainter := fPainter.GetDummyPainter();
end;

destructor TTextView.Destroy;
begin
  inherited;
end;

procedure TTextView.Idle;
begin
  if fRefreshAllP then begin
    fRefreshAllP := False;
    Self.Refresh(rmAll);
  end;
end;

function TTextView.GetWindowBeginning() : Cardinal;
begin
  Result := fWindowBeginning.Position;
end;

function TTextView.GetBeginning() : ITextMark;
begin
  Result := fBeginning;
end;

function TTextView.GetEnd1() : ITextMark;
begin
  Result := fEnd1;
end;

procedure TTextView.SetWindowBeginning(aValue : Cardinal);
begin
  fWindowBeginning.Position := aValue;
  Refresh(rmAll); // or Queue?
  //QueueRefresh;
end;

function TTextView.GetBufferWindowSize : Cardinal;
begin
  Result := fBufferWindowSize;
end;

{function TTextView.GetMarkVisualPosition(aMark : ITextMark): TPoint;
begin
  // TODO Refresh rmDummy, override windowendposition
  if aMark.Position >= fDirtyBeginning.Position then
    clear cached visual position;
  
  // TODO hashtable aMark -> TPoint.
  // Result := TPoint.Create();
end;}
  
{ given a (pixel) position, finds the nearest character and returns its offset in the buffer and where it was. Note that you should call "Refresh" in order for it to even know. }
function TTextView.FindOffsetNearVisualPosition(aX, aY : Cardinal; out oCharacterRect : TRect) : Cardinal;
var
  fPainter : IContinuousCharacterPainter;
begin
  fPainter := Painter(rmDummy);
  Result := fPainter.FindOffsetNearVisualPosition(aX, aY, oCharacterRect);
  if Result = CardinalMaximum then begin // not found.
    // TODO scrolling?
    // TODO set "oCharacterRect".
    // TODO do something faster.
  
    fPainter.BreakPositionX := aX;
    fPainter.BreakPositionY := aY;

    Result := RedrawText(rmDummy);
  
    fPainter.BreakPositionX := CardinalMaximum;
    fPainter.BreakPositionY := CardinalMaximum;
  end;
  Inc(Result, WindowBeginning);
end;

// TODO move TTextController.ProcessEvent here?
// use dynamic keyboard shortcuts (defined by the controller) ?
// TODO maybe internalize the cursor stuff so much that the controller doesn't even know any positions?

// TODO do this in an exported function? use mouse unit?

procedure TTextView.BeginSelectingAt(aX, aY : Cardinal);
begin
  //Self.fPainter.SelectionBeginning := aPosition;
  //Self.fPainter.SelectionEnd := aPosition;
  Painter(rmAll).BeginSelectingAt(aX, aY);
end;

procedure TTextView.ContinueSelectingTo(aX, aY : Cardinal);
begin
  Painter(rmAll).EndSelectingAt(aX, aY);
end;

procedure TTextView.EndSelectingAt(aX, aY : Cardinal);
begin
  Painter(rmAll).EndSelectingAt(aX, aY);
end;

function TTextView.Painter(aMode : TTextViewRefreshMode) : IContinuousCharacterPainter; inline;
begin
  if aMode = rmDummy then
    Result := Self.fDummyPainter
  else
    Result := Self.fPainter;
end;

end.