unit controllers;

{$M+}

interface
uses buffers, views, events, classes, sysutils, marks, undos;

type
  ITextController = interface
    procedure ProcessEvent(aSender : TObject; aEvent : TEvent);
    procedure Save;
    
    { Usage:
    
          Stream := TFileStream.Create('file', fmOpenRead);
          controller.Load(Stream); // can throw.
          controller.FileName := 'file';
          FreeAndNil(Stream);
    }
    procedure Load(aStream : TStream);
    
    procedure Close;
    function MoveCaretLeftOrUp : Boolean;
    function MoveCaretBy(aXOffset : Integer; aYOffset : Integer) : Boolean; // returns whether the caret moved. A move by (0,0) counts as 'no'.
    procedure Insert(aCharacter : Char);
    procedure DeleteCharacter;
    
    // use this only for small parts. You have been warned.
    function TextAtCaret(aOffset : Integer; aCount : Cardinal) : UTF8String;

    function GetFileName : TFileName;
    procedure SetFileName(const aValue : TFileName);
    property FileName : TFileName read GetFileName write SetFileName; // not really used other than for display.

    procedure Idle;
    
  end;
  
  TTextController = class(TInterfacedObject, ITextController, IInterface)
  private
    fView : ITextView;
    fBuffer : ITextBuffer; // cache
    fFileName : TFileName; // if any. Otherwise ''.
  protected
    function GetFileName : TFileName;
    procedure SetFileName(const aValue : TFileName);
  published
    constructor Create(view : ITextView);
    procedure Save;
    procedure Load(aStream : TStream);
    procedure Close;

    function MoveCaretLeftOrUp : Boolean;
    function MoveCaretBy(aXOffset : Integer; aYOffset : Integer) : Boolean;
    procedure Insert(aCharacter : Char);
    procedure DeleteCharacter;

    // use this only for small parts. You have been warned.
    function TextAtCaret(aOffset : Integer; aCount : Cardinal) : UTF8String; // semi-public, but...
    procedure ProcessEvent(aSender : TObject; aEvent : TEvent);
    procedure Idle;
    
    property FileName : TFileName read GetFileName write SetFileName; // not really used other than for display.
  end;
  
implementation
uses keyboard, debug, encodings;

constructor TTextController.Create(view : ITextView);
begin
  fView := view;
  fBuffer := view.Buffer;

{$IFDEF UNIT_TEST} 
  fBuffer.Insert(fView.Caret, '1');
  fBuffer.Insert(fBuffer.End1, '2');
  fBuffer.Insert(fBuffer.End1, '3');
  fBuffer.Insert(fBuffer.End1, '4');
  fBuffer.Insert(fBuffer.End1, '5');
  fBuffer.Insert(fBuffer.End1, '6');
  fBuffer.Insert(fBuffer.End1, '7');
{$ENDIF}
end;

{ kbXXX in unit "keyboard" ?? not found. }
{const 
  kbCursorUp = 72;
  kbCursorLeft = 75;
  kbCursorRight = 77;
  kbCursorDown = 80;
  kbDelete = 83;
  kbPageUp = 73;
  kbPageDown = 81;
  kbHome = 71;
  kbInsert = 82;
  kbF1 = 59;
  kbF2 = 60;
  kbF3 = 61;
  kbF4 = 62;
  kbF5 = 63;
  kbF6 = 64;
  kbF7 = 65;
  kbF8 = 66;
  kbF9 = 67;
  kbF10 = 68;
  kbF11 = 133;
  kbF12 = 134;
  
  // FPC compat
  
  kbDel = kbDelete;
  kbUp = kbCursorUp;
  kbDown = kbCursorDown;
  kbLeft = kbCursorLeft;
  kbRight = kbCursorRight;}

{const 
  kbCursorUp = $4800;
  kbCursorLeft = $4B00;
  kbCursorRight = $4D00;
  kbCursorDown = $5000;
  kbDelete = $5300;
  kbPageUp = $4900;
  kbPageDown = $5100;
  kbHome = $4700;
  kbEnd = $4F00;
  
  kbInsert = $5200;
  kbF1 = $3B00;
  kbF2 = $3C00;
  kbF3 = $3D00;
  kbF4 = $3E00;
  kbF5 = $3F00;
  kbF6 = $4000;
  kbF7 = $4100;
  kbF8 = $4200;
  kbF9 = $4300;
  kbF10 = $4400;
  kbF11 = $5400;
  kbF12 = $5500;
  kbEscape = $11B; // actually double-escape.
  
  // FPC compat
  
  kbDel = kbDelete;
  kbUp = kbCursorUp;
  kbDown = kbCursorDown;
  kbLeft = kbCursorLeft;
  kbRight = kbCursorRight;  
}

const
  kbCursorUp = kbdUp;
  kbCursorLeft = kbdLeft;
  kbCursorRight = kbdRight;
  kbCursorDown = kbdDown;
  kbDelete = kbdDelete;
  kbPageUp = kbdPgUp;
  kbPageDown = kbdPgDn;
  kbHome = kbdHome;
  kbEnd = kbdEnd;
  kbInsert = kbdInsert;
  kbF1 = kbdF1;
  kbF2 = kbdF2;
  kbF3 = kbdF3;
  kbF4 = kbdF4;
  kbF5 = kbdF5;
  kbF6 = kbdF6;
  kbF7 = kbdF7;
  kbF8 = kbdF8;
  kbF9 = kbdF9;
  kbF10 = kbdF10;
  kbF11 = kbdF11;
  kbF12 = kbdF12;
  //kbEscape = kbdEscape; // actually double-escape.

  // FPC compat
  
  kbDel = kbDelete;
  kbUp = kbCursorUp;
  kbDown = kbCursorDown;
  kbLeft = kbCursorLeft;
  kbRight = kbCursorRight;  

const
  cBackspace = #8;
  cHorizontalTab = #9;
  cReturn = #13;
  cEscape = #27;

function TextFromBlockIteratorItem(const aItem : TTextBufferBlockIteratorItem) : string;
var
  i : Integer;
  aPosition : PTextBufferItem;
begin
  Result := '';
  SetLength(Result, aItem.Size);
  
  { TODO just use #"Move" after asserting proper item sizes. }
  
  aPosition := aItem.Beginning;
  for i := 1 to aItem.Size do begin
    Result[i] := aPosition^;
    Inc(aPosition);
  end;
end;

function TTextController.TextAtCaret(aOffset : Integer; aCount : Cardinal) : UTF8String;
var
  tPosition : Cardinal;
  tBufferIterator : ITextBufferBlockIterator;
  tBufferBlock : TTextBufferBlockIteratorItem;
  tTempResult : string;
begin 
  tTempResult := '';
  
  tPosition := fView.Caret.Position;
  
  if (aOffset < 0) and (tPosition < -aOffset) then begin // OOPS
    Result := '';
    Exit;
  end;
  
  Inc(tPosition, aOffset);
  
  { TODO check bounds? }
  
  tBufferIterator := fView.Buffer.Range(tPosition, tPosition + aCount);
  repeat
    tBufferBlock := tBufferIterator.Next;
    if tBufferBlock = nil then
      Exit;
      
    tTempResult := tTempResult + TextFromBlockIteratorItem(tBufferBlock);
  until tBufferBlock = nil;
  
  Result := UTF8String(tTempResult);
end;

procedure TTextController.Insert(aCharacter : Char);
begin
  // TODO selection?
  fBuffer.Insert(fView.Caret.Position, aCharacter);
end;

procedure TTextController.DeleteCharacter;
begin
  // TODO selection?

  // FIXME honor text encoding.
  // FIXME Unicode and diaresis handling.

  //fBuffer.Decoder.SourcePosition := 0;
  //fBuffer.Decoder.SourceStream := ; 
  //fBuffer.Decoder.Decode(fBuffer.Range());
  //fBuffer.Decoder.SourcePosition
  fBuffer.DeleteCount(fView.Caret.Position, UTF8Length(fBuffer.GetItem(fView.Caret.Position)));
  // until (fItem >= $C0) or (fItem < $80);
end;

// FIXME make this more generic and move to "encodings".
function DecodeUTF8Backwards(const aBuffer : ITextBuffer; var aPosition : Cardinal) : TUnicodeCodepoint;
var
  fEncodedCharacter : TUTF8EncodedCharacter;
  fEncodedCharacterIndex : Integer;
  fCount : Cardinal;
  fItem : TTextBufferItem;
begin
    fEncodedCharacterIndex := High(fEncodedCharacter);
    // find beginning of UTF-8 sequence.
    while (aPosition >= 0) do begin
      fItem := aBuffer.GetItem(aPosition);
      fEncodedCharacter[fEncodedCharacterIndex] := fItem;
      Write(Format('aaa %d %d ', [fEncodedCharacterIndex, aPosition]));
      if fEncodedCharacterIndex = 0 then
        raise EConvertError.Create('encountered invalid encoded text');
      Dec(fEncodedCharacterIndex);
        
      if (Ord(fItem) >= $C0) or (Ord(fItem) < $80) then begin // beginning
        fCount := High(fEncodedCharacter) + 1 - fEncodedCharacterIndex;
        Inc(fEncodedCharacterIndex);

        // FIXME check bounds.
        Result := DecodeUTF8(fEncodedCharacter, fEncodedCharacterIndex);
        Exit;
      end;
      if aPosition = 0 then 
        Break;
      Dec(aPosition);
    end;
    raise EConvertError.Create('encountered invalid encoded text');
end;

function TTextController.MoveCaretLeftOrUp : Boolean;
var
  fPosition : Cardinal;
  fItem : TTextBufferItem;
  fCodepoint : TUnicodeCodepoint;
begin
  fPosition := fView.Caret.Position;
  if fPosition > 0 then begin
    // FIXME Unicode: read backwards, check for diaresis, check for non-diaresis codepoint, then finally go there.
    // FIXME support combining grapheme joiner, U+034F
    // FIXME support other encodings.
    repeat
      Dec(fPosition);
      if fPosition = 0 then 
        Break;
      fCodepoint := DecodeUTF8Backwards(fBuffer, fPosition);
    until IsBeginningOfNewCharacter(fCodepoint) or (fPosition <= 0);
    fView.Caret.Position := fPosition;
    Result := True;
  end else begin
    Result := False;
  end;
end;

// TODO use absolute values and cache some line's beginnings so you don't have to scan the file all the time.
function TTextController.MoveCaretBy(aXOffset : Integer; aYOffset : Integer) : Boolean;
var
  vPosition : Cardinal;
  
  function MoveX() : Boolean;
  begin
    Result := False;
    if (aXOffset < 0) then begin
      if (vPosition >= -aXOffset) then begin
        Inc(vPosition, aXOffset);
        Result := True;
      end else
        vPosition := 0;
    end else if aXOffset > 0 then begin
      Inc(vPosition, aXOffset);
      if (vPosition > fView.End1.Position) then
        vPosition := fView.End1.Position
      else
        Result := True;
    end;
  end;
  
  function MoveY() : Boolean;
  var
    iOffset : Integer;
  begin
    Result := False;
    if aYOffset < 0 then begin
      Inc(vPosition);
      for iOffset := 1 to -aYOffset do begin
        if vPosition > 0 then 
          Dec(vPosition)
        else
          Exit(False);

        // TODO do this with a lambda (callback) over the buffer range iterator.
        if Self.fBuffer.FindLast(fView.Beginning.Position, vPosition, buffers.cLineBreak, {out} vPosition) then begin
        end else
          Exit(False);
      end;
    end else if aYOffset > 0 then begin
      for iOffset := 1 to aYOffset do begin
        // TODO do this with a lambda (callback) over the buffer range iterator.
        if Self.fBuffer.Find(vPosition, fView.End1.Position, buffers.cLineBreak, {out} vPosition) then begin
          Inc(vPosition);
          Dump(Format('vPosition %d', [vPosition]));
        end else begin
          vPosition := Self.fView.End1.Position;
          Exit(False);
        end;
      end;
    end;
    Result := True;
  end;
  
  procedure ScrollDown;
  var
    vScrollPosition : Cardinal;
    vOldPosition : Cardinal;
  begin
    //fView.Caret.Position := vPosition;
    //fView.Refresh(rmAll);
    if vPosition >= fView.WindowBeginning + fView.BufferWindowSize then begin // FIXME why -1 ?
      if (aXOffset >= fView.BufferWindowSize) then begin
        vScrollPosition := fView.WindowBeginning + fView.BufferWindowSize;
      end else
        vScrollPosition := fView.WindowBeginning;
      vOldPosition := vScrollPosition;
      if Self.fBuffer.Find(vScrollPosition, fView.End1.Position, buffers.cLineBreak, {out} vScrollPosition) then begin
        Inc(vScrollPosition);
        fView.WindowBeginning := vScrollPosition;
      end else begin
        fView.WindowBeginning := vOldPosition;
      end;
  
      //fView.WindowBeginning := fView.Caret.Position; // - fView.BufferWindowSize;
    end;
  end;
  
  procedure ScrollUp;
  begin
    if vPosition < fView.WindowBeginning then begin // scroll up.
      // fView.WindowBeginning := fView.Caret.Position; // TODO only lines.
      
      // FIXME actually, here, any run is fine, not just the actual hard line breaks. Use the view's run marks.
  
      if Self.fBuffer.FindLast(fView.Beginning.Position, vPosition, buffers.cLineBreak, {out} vPosition) then begin
        Inc(vPosition);
      end else begin
        vPosition := 0;
      end;
      fView.WindowBeginning := vPosition;
    end;
  end;

  procedure ScrollInsideBuffer();
  begin
    if fView.WindowBeginning > fView.End1.Position then
      fView.WindowBeginning := fView.End1.Position;    
  end;
  
begin
  vPosition := fView.Caret.Position;
  Result := MoveX() or MoveY();
  if vPosition > fView.End1.Position then
    vPosition := fView.End1.Position;

  ScrollDown();
  ScrollUp();
  ScrollInsideBuffer();
  fView.Caret.Position := vPosition;
end;

procedure TTextController.Close;
var
  VItems : TUndoLogEntryArray;
  VItemIndex : Cardinal;
begin
{$IFDEF DEBUG_UNDO}
  Writeln('Undo log buffer:');
  VItems := fBuffer.UndoLogger.GetItems(100);

  if Length(VItems) > 0 then
    for VItemIndex := 0 to High(VItems) do begin
      Writeln(Format(' item %d %d "%s"', [Integer(VItems[VItemIndex].Action), Integer(VItems[VItemIndex].Position), VItems[VItemIndex].Value]));
    end;  
  Writeln('End undo log buffer.');
{$ENDIF}

  Halt; { FIXME be nicer }
end;

function TTextController.GetFileName : TFileName;
begin
  Result := fFileName;
end;

procedure TTextController.SetFileName(const aValue : TFileName);
begin
  fFileName := aValue;
end;

// FIXME does this even belong here?
procedure TTextController.Load(aStream : TStream);
var
  tBlock : array[0..2049] of Char;
  tReadCount : Longint;
  tBuffer : ITextBuffer;
  tBlockIndex : Longint;
begin
  tBuffer := fView.Buffer;
  tBuffer.DeleteRange(0, tBuffer.End1); // clear buffer.
    
  repeat
    tReadCount := aStream.Read(tBlock, SizeOf(tBlock));
    // TODO error handling? how?
    
    // TODO fix encoding? yes? no?
    
    assert(tReadCount <= SizeOf(tBlock));
    
    if #10 <> Buffers.cLineBreak then begin
      for tBlockIndex := 0 to tReadCount - 1 do begin
        if tBlock[tBlockIndex] = #10 then // UNIX CRLF
          tBlock[tBlockIndex] := Buffers.cLineBreak;
      end;
    end;
    
    tBuffer.Insert(tBuffer.End1, tBlock, tReadCount);
  until tReadCount = 0; // EOF or error, whereas EINTR = error?
  
  tBuffer.UndoLogger := TUndoLogger.Create();

  fView.Caret.Position := 0;
  //fView.Caret := tBuffer.Beginning.Clone as ITextMark;
   
  Self.Idle;
end;

procedure TTextController.Idle;
begin
  fView.Idle;
end;

procedure TTextController.Save;
var
  t : Text;
  tBufferIterator : ITextBufferBlockIterator;
  tBufferBlock : TTextBufferBlockIteratorItem;
begin
  AssignFile(t, '/tmp/dump'); // FIXME
  Rewrite(t);
  
  tBufferIterator := fView.Buffer.Range(fView.Beginning.Position, fView.End1.Position); // TODO or 0, Buffer.Size ?
  repeat
    tBufferBlock := tBufferIterator.Next;
    if tBufferBlock = nil then
      Exit;
      
    // TODO do this without #"TextFromBlockIteratorItem" to allow for bigger strings...
    Write(t, TextFromBlockIteratorItem(tBufferBlock));
  until tBufferBlock = nil;

  // = Write(t, Self.fBuffer.RangeText(Self.fBuffer.Beginning, Self.fBuffer.End1));
  CloseFile(t);
end;

// TODO move this to 'views' and just call #MoveCaret etc from there.  
procedure TTextController.ProcessEvent(aSender : TObject; aEvent : TEvent);
var
  keyEvent1 : events.TKeyEvent;
  mouseEvent1 : events.TMouseEvent;
  characterRectangle : TRect;
begin try
  if aEvent is events.TIdleEvent then begin
    Self.Idle;
    Exit;
  end;
  
  if aEvent is events.TKeyEvent then
    keyEvent1 := aEvent as events.TKeyEvent
  else
    keyEvent1 := nil;
  
  if Assigned(keyEvent1) then begin
    if ord(keyEvent1.Character) = 0 then begin { special key }
      if keyEvent1.Modifiers = [] then
      case keyEvent1.Key of
        kbDelete: Self.DeleteCharacter;
{$IFDEF KEYBOARD_CARET_CONTROL}
        kbDown: Self.MoveCaretBy(0, 1);
        kbUp: Self.MoveCaretBy(0, -1);
        kbLeft: if Self.TextAtCaret(-1, 1) <> buffers.cLineBreak { TODO option } then Self.MoveCaretBy(-1, 0);
        kbRight: if Self.TextAtCaret(0, 1) <> buffers.cLineBreak { TODO option } then Self.MoveCaretBy(1, 0);
        kbPageUp: Self.MoveCaretBy(-fView.BufferWindowSize, 0);
        kbPageDown: Self.MoveCaretBy(fView.BufferWindowSize, 0);
{$ENDIF KEYBOARD_CARET_CONTROL}
        kbF2: Self.Save;
        //kbEscape: Self.Close;
        kbHome: ; // TODO. // TODO Control modifier. ($7700)
        kbEnd: ; // TODO. // TODO Control modifier. ($7500)
        kbInsert: ; // TODO?
        // find: $FF03 (F3)
        else begin
          {Write(StdOut, 'unknown key#');
          Write(StdOut, keyEvent1.Key);}
        end;
      end
      else if (keyEvent1.Modifiers = [kmLeftShift]) or (keyEvent1.Modifiers = [kmRightShift]) or (keyEvent1.Modifiers = [kmLeftShift, kmRightShift]) then
      case keyEvent1.Key of
      kbF3: Self.Insert('='); // Write('search');
      else Writeln(keyEvent1.Key);
      end
    end else if ord(keyEvent1.Character) >= 32 then { normal text } 
      Self.Insert(keyEvent1.Character)
    else begin { old-style ASCII control character }
      case keyEvent1.Character of
        cBackspace: begin
          if Self.MoveCaretLeftOrUp then
            Self.DeleteCharacter;
        end;
        cHorizontalTab: ;
        cReturn: Self.Insert(buffers.cLineBreak);
        
        cEscape: Self.Close;
      end;
        
      //Writeln('???', Ord(keyEvent1.Character), '/ key ', Ord(keyEvent1.Key));
    end;
  end;
  
  if (aEvent is events.TMouseEvent) then begin
    mouseEvent1 := aEvent as events.TMouseEvent;
  end else begin
    mouseEvent1 := nil;
  end;
  
  if Assigned(mouseEvent1) then begin
    if (mouseEvent1.Button = 4) and (mouseEvent1.Action = baPress) then
      MoveCaretBy(0, -5) // TODO configurable?
    else if (mouseEvent1.Button = 5) and (mouseEvent1.Action = baRelease) then
      MoveCaretBy(0, 5); // TODO configurable?
    if ((mouseEvent1.Button = 1) or (1 in mouseEvent1.PressedButtons)) and (mouseEvent1.Action in [baPress, baRelease, baNone]) then begin // "left" button pressed.
      { ask the view to find out the position in the buffer corresponding to the coordinates mentioned in the mouse event (Position[1..AxisCount]). }
      // TODO take care of a mouse-down outside of the view, then dragging the pointer inside the view and then releasing the button.

      if mouseEvent1.Action in [baPress, baRelease] then
        fView.Caret.Position := fView.FindOffsetNearVisualPosition(mouseEvent1.Position[1], mouseEvent1.Position[2], characterRectangle);
      
      case mouseEvent1.Action of
      baPress: fView.BeginSelectingAt(mouseEvent1.Position[1], mouseEvent1.Position[2]);
      baNone: fView.ContinueSelectingTo(mouseEvent1.Position[1], mouseEvent1.Position[2]);
      baRelease: fView.EndSelectingAt(mouseEvent1.Position[1], mouseEvent1.Position[2]);
      end;

    end;
  end;
  
except 
  on e: ERangeError do begin
    Writeln(e.Message);
    raise;
  end;
end; end;

end.