unit ProgramEditorForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, ZoomControl, Vcl.ComCtrls,
  Types, UITypes, TextEditor, UxPanel, System.Actions, Vcl.ActnList, ExtCtrls,
  SyncObjs, Vcl.AppEvnts, Vcl.Menus, StartMenuPopup;

const
  WM_EXPRPARSED = WM_USER + 1;

  PARSE_OK = 0;
  PARSE_EMPTY = 1;
  PARSE_FAILED = 2;

type
  TProgramEditor = class;

  TBackgroundParser = class(TThread)
  protected
    FEditor: TProgramEditor;
    procedure Execute; override;
  public
    constructor Create(AEditor: TProgramEditor);
    destructor Destroy; override;
  end;

  TProgramEditor = class(TForm)
    teProgram: TTextEditor;
    sbProgram: TStatusBar;
    zcProgram: TZoomControl;
    UxClient1: TUxClient;
    btnExecute: TUxButton;
    ActionList: TActionList;
    aExecute: TAction;
    btnSaveAs: TUxButton;
    aSaveAs: TAction;
    aSave: TAction;
    btnSave: TUxButton;
    aAddIndent: TAction;
    aRemoveIndent: TAction;
    sbParser: TUxClient;
    teAST: TTextEditor;
    aShowAST: TAction;
    UxButton1: TUxButton;
    VSplitter: TUxSplitter;
    ApplicationEvents: TApplicationEvents;
    btnProgram: TUxButton;
    ProgramMenu: TPopupMenu;
    Newprogram1: TMenuItem;
    Openprogram1: TMenuItem;
    N1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    Print1: TMenuItem;
    N2: TMenuItem;
    Showtree1: TMenuItem;
    N3: TMenuItem;
    Execute1: TMenuItem;
    ASFP: TAlgosim3FormattingProcessor;
    procedure zcProgramChange(Sender: TObject);
    procedure sbProgramDblClick(Sender: TObject);
    procedure sbProgramDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
      const Rect: TRect);
    procedure sbProgramResize(Sender: TObject);
    procedure teProgramOverwriteChange(Sender: TObject);
    procedure teProgramSelChange(Sender: TObject);
    procedure teProgramSimpleNotification(Sender: TObject; MsgID: Cardinal;
      const AStr: string);
    procedure teProgramZoomChange(Sender: TObject);
    procedure teProgramKeyPress(Sender: TObject; var Key: Char);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure aExecuteExecute(Sender: TObject);
    procedure aSaveAsExecute(Sender: TObject);
    procedure aSaveExecute(Sender: TObject);
    procedure ActionListUpdate(Action: TBasicAction; var Handled: Boolean);
    procedure aAddIndentExecute(Sender: TObject);
    procedure aRemoveIndentExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure teProgramModified(Sender: TObject);
    procedure teProgramChange(Sender: TObject);
    procedure aExecuteUpdate(Sender: TObject);
    procedure aShowASTUpdate(Sender: TObject);
    procedure aShowASTExecute(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ApplicationEventsHint(Sender: TObject);
    procedure ApplicationEventsModalBegin(Sender: TObject);
    procedure ApplicationEventsModalEnd(Sender: TObject);
    procedure teProgramKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  protected
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  private
    FReparseTimer: TTimer;
    FBackgroundParser: TBackgroundParser;
    FReparseEvent: TEvent;
    FExpressionStringCS: TCriticalSection;
    FExpressionString: string;
    FParseResult: Integer;
    FAST: string;
    FStatusTextBase, FStatusTextPrio: string;
    class var FProgramCounter: UInt64;
    procedure UpdateCaption;
    function SaveFile: Boolean;
    function SaveAs: Boolean;
    procedure ReparseNeeded;
    procedure ScheduleReparse;
    procedure ReparseTimerTimer(Sender: TObject);
    procedure WMExprParsed(var Message: TMessage); message WM_EXPRPARSED;
    procedure SetAST(const AST: string);
    procedure SetStatusText(const AText: string; APrio: Boolean);
  public
    constructor Create(AOwner: TComponent; const AFileName: TFileName = '');
      reintroduce;
    destructor Destroy; override;
  end;

implementation

{$R *.dfm}

uses
  MainForm, MultiInput, Math, StrUtils, DateUtils, IOUtils, ClientDefs, ASNum,
  IdentSearch, ASKernel, FormFader, WinMgrForm, TDMB, ASTokenizer,
  ASParser, ASKernelDefs, Generics.Defaults, Generics.Collections;

constructor TProgramEditor.Create(AOwner: TComponent; const AFileName: TFileName);
begin
  inherited Create(AOwner);
  FExpressionStringCS := TCriticalSection.Create;
  FReparseEvent := TEvent.Create(nil, False, False, '');
  FBackgroundParser := TBackgroundParser.Create(Self);
  FReparseTimer := TTimer.Create(Self);
  FReparseTimer.Interval := 500;
  FReparseTimer.Enabled := False;
  FReparseTimer.OnTimer := ReparseTimerTimer;
  if string(AFileName).IsEmpty then
  begin
    Inc(FProgramCounter);
    teProgram.NewFile;
    teProgram.TextFile.FileName := 'New program ' + FProgramCounter.ToString;
  end
  else
    teProgram.LoadFromFile(AFileName, TEncoding.UTF8);
  UpdateCaption;
end;

destructor TProgramEditor.Destroy;
begin
  FreeAndNil(FReparseTimer);
  if Assigned(FBackgroundParser) then
    FBackgroundParser.Terminate;
  if Assigned(FReparseEvent) then
    FReparseEvent.SetEvent;
  FreeAndNil(FBackgroundParser);
  FreeAndNil(FReparseEvent);
  FreeAndNil(FExpressionStringCS);
  inherited;
end;

procedure TProgramEditor.aAddIndentExecute(Sender: TObject);
begin
  teProgram.AddIndent;
end;

procedure TProgramEditor.ActionListUpdate(Action: TBasicAction;
  var Handled: Boolean);
begin
  if (Action is TCustomAction) and not Assigned(Action.OnUpdate) then
  begin
    TCustomAction(Action).Enabled := Self.Active;
    Handled := True;
  end
end;

procedure TProgramEditor.aExecuteExecute(Sender: TObject);
begin
  if Assigned(AlgosimMainForm) and Assigned(AlgosimMainForm.Kernel)
    and Assigned(teProgram)
  then
    AlgosimMainForm.Kernel.EvaluateAsync(teProgram.PlainText)
end;

procedure TProgramEditor.aExecuteUpdate(Sender: TObject);
begin
  aExecute.Enabled := Self.Active and (FParseResult = 0);
end;

procedure TProgramEditor.ApplicationEventsHint(Sender: TObject);
begin
  SetStatusText(Application.Hint, True);
end;

procedure TProgramEditor.ApplicationEventsModalBegin(Sender: TObject);
begin
  btnProgram.Enabled := False;
  sbParser.SizeGrip := False;
end;

procedure TProgramEditor.ApplicationEventsModalEnd(Sender: TObject);
begin
  sbParser.SizeGrip := True;
  btnProgram.Enabled := True;
end;

procedure TProgramEditor.aRemoveIndentExecute(Sender: TObject);
begin
  teProgram.RemoveIndent;
end;

procedure TProgramEditor.aSaveAsExecute(Sender: TObject);
begin
  SaveAs;
end;

procedure TProgramEditor.aSaveExecute(Sender: TObject);
begin
  SaveFile;
end;

procedure TProgramEditor.aShowASTExecute(Sender: TObject);
begin
  if not teAST.Visible and (ClientWidth < 300) then
    Exit;
  teAST.Visible := not teAST.Visible;
  if teAST.Visible then
  begin
    if teAST.Width < 100 then
      teAST.Width := 150;
    if ClientWidth - teAST.Width < 150 then
      teAST.Width := ClientWidth - 150;
  end;
  VSplitter.Visible := teAST.Visible;
  VSplitter.Left := teAST.Left - 8;
  SetAST(FAST);
end;

procedure TProgramEditor.aShowASTUpdate(Sender: TObject);
begin
  aShowAST.Checked := teAST.Visible;
end;

procedure TProgramEditor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  if Assigned(teProgram) and teProgram.BalloonVisible then
  begin
    teProgram.HideBalloon; // dirty fix
    Action := caNone;
  end;
  if Assigned(teAST) and teAST.BalloonVisible then
  begin
    teAST.HideBalloon; // dirty fix
    Action := caNone;
  end;
  if Action <> caNone then
  begin
    teAST.RemoveSizeHooks;
    teProgram.RemoveSizeHooks;
  end;
end;

procedure TProgramEditor.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if teProgram.TextFile.FileModified then
  begin
    if not Visible or not Active then
    begin
      Show;
      if Visible and CanFocus then
        SetFocus;
    end;
    case
      TD
        .TextFmt('Do you want to save the changes made to "%s"?',
          [ExtractFileName(teProgram.TextFile.FileName)])
        .YesNoCancel
        .Execute(Self)
    of
      mrYes:
        CanClose := SaveFile;
      mrNo:
        CanClose := True;
    else {such as mrCancel}
      CanClose := False;
    end;
  end;
end;

procedure TProgramEditor.FormCreate(Sender: TObject);
begin
  TFormFader.Create(Self);
  TWindowWatcher.Create(Self);
  teProgramSelChange(Self);
  ProgramMenu.SetStartButton(btnProgram);
end;

procedure TProgramEditor.FormResize(Sender: TObject);
begin
  if teAST.Visible and (ClientWidth - teAST.Width < 150) then
    if ClientWidth >= 300 then
      teAST.Width := ClientWidth - 150
    else
    begin
      aShowAST.Execute;
      aShowAST.Update; // modal size loop
    end;
end;

procedure TProgramEditor.FormShow(Sender: TObject);
begin
  zcProgram.Parent := sbProgram;
  teProgram.SetSizeHooks;
  teAST.SetSizeHooks;
end;

procedure TProgramEditor.ReparseNeeded;
begin
  RestartTimer(FReparseTimer);
end;

procedure TProgramEditor.ReparseTimerTimer(Sender: TObject);
begin
  FReparseTimer.Enabled := False;
  ScheduleReparse;
end;

function TProgramEditor.SaveAs: Boolean;
begin
  with TFileSaveDialog.Create(Self) do
    try
      DefaultFolder := TPath.GetHomePath + '\Rejbrand\Algosim';
      with FileTypes.Add do
      begin
        DisplayName := 'Algosim program';
        FileMask := '*.prg';
      end;
      with FileTypes.Add do
      begin
        DisplayName := 'All files';
        FileMask := '*.*';
      end;
      DefaultExtension := 'prg';
      Options := [fdoOverWritePrompt, fdoPathMustExist];
      if Execute then
      begin
        try
          teProgram.SaveToFile(FileName, True);
          Result := True;
        except
          Result := False;
        end;
        UpdateCaption;
      end
      else
        Result := False;
    finally
      Free;
    end;
end;

function TProgramEditor.SaveFile: Boolean;
begin
  if FileExists(teProgram.TextFile.FileName) then
  begin
    try
      teProgram.SaveToFile(teProgram.TextFile.FileName);
      Result := True;
    except
      Result := False;
    end;
    UpdateCaption;
  end
  else
    Result := SaveAs;
end;

procedure TProgramEditor.sbProgramDblClick(Sender: TObject);
var
  v: Integer;
  p: TPoint;
begin

  if not GetCursorPos(p) then Exit;
  p := sbProgram.ScreenToClient(p);

  if InRange(p.X, 0, sbProgram.Panels[STATUS_FILE_POSITION].Width) then
  begin
    v := teProgram.CaretPos.Y + 1;
    if
      TMultiInputBox.NumInputBox(
        Self,
        'Go to',
        'Please enter a line number to go to:',
        v,
        1,
        teProgram.LineCount)
    then
      teProgram.CaretPos := Point(0, v - 1);
  end
  else if InRange(p.X,
    sbProgram.Panels[STATUS_FILE_POSITION].Width,
    sbProgram.Panels[STATUS_FILE_POSITION].Width + sbProgram.Panels[STATUS_OVERWRITE].Width) then
  begin
    teProgram.Overwrite := not teProgram.Overwrite;
  end;

end;

procedure TProgramEditor.sbProgramDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = sbProgram.Panels[STATUS_ZOOM_CONTROL] then
    zcProgram.BoundsRect := System.Classes.Rect(Rect.Left, Rect.Top,
      Rect.Right, Rect.Bottom);
end;

procedure TProgramEditor.sbProgramResize(Sender: TObject);
begin
  sbProgram.Panels[STATUS_MESSAGE].Width := sbProgram.Width -
    sbProgram.Panels[STATUS_FILE_POSITION].Width -
    sbProgram.Panels[STATUS_OVERWRITE].Width -
    sbProgram.Panels[STATUS_ZOOM_CONTROL].Width;
end;

procedure TProgramEditor.ScheduleReparse;
begin
  FExpressionStringCS.Enter;
  try
    FExpressionString := teProgram.PlainText;
  finally
    FExpressionStringCS.Leave;
  end;
  FReparseEvent.SetEvent;
end;

procedure TProgramEditor.SetAST(const AST: string);
begin
  FAST := AST;
  teAST.EditMode := emText;
  teAST.PlainText := AST;
  teAST.EditMode := emReadOnly;
  teAST.TextFile.GotoSOF;
  teAST.TextFile.StrictReadOnly := True;
  teAST.MarginLeft := 12;
end;

procedure TProgramEditor.SetStatusText(const AText: string; APrio: Boolean);
begin
  if APrio then
    FStatusTextPrio := AText
  else
    FStatusTextBase := AText;
  if not FStatusTextPrio.IsEmpty then
    sbParser.Caption := FStatusTextPrio
  else
    sbParser.Caption := FStatusTextBase;
end;

procedure TProgramEditor.teProgramChange(Sender: TObject);
begin
  ReparseNeeded;
end;

procedure TProgramEditor.teProgramKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if (Key = VK_RETURN) and (Shift = [ssCtrl]) then
  begin
    Key := 0;
    Exit;
  end;

end;

procedure TProgramEditor.teProgramKeyPress(Sender: TObject; var Key: Char);
var
  L: string;
  SP, EP: Integer;
  P: TPoint;
  Filter, Res: string;
  DisplayKey: Char;
  S: string;

  procedure Surround(const ALeft, ARight: string);
  begin
    teProgram.SurroundText(ALeft, ARight);
    if ALeft.Length > 0 then
      DisplayKey := ALeft[ALeft.Length];
    Key := #0;
  end;

  procedure InsertBinOp(const AOp: string);
  begin
    if (teProgram.GetCharBeforeCaret = #32) and not teProgram.TextFile.HasSelection then
      teProgram.SelText := AOp + #32
    else
      teProgram.SelText := AOp;
    if AOp.Length > 0 then
      DisplayKey := AOp[AOp.Length];
    Key := #0;
  end;

  procedure InsertUnOp(const AOp: string);
  begin
    teProgram.SelText := AOp;
    if AOp.Length > 0 then
      DisplayKey := AOp[AOp.Length];
    Key := #0;
  end;

begin

  DisplayKey := #0;

  case Key of
    ^W:
      begin
        Close;
        Exit;
      end;
  end;

  if IsKeyDown(VK_CONTROL) and IsKeyDown(VK_SHIFT) then
  begin
    case Key of
      ^S:
        begin
          Surround('{', '}');
          Exit;
        end;
      ^V, ^E:
        begin
          Surround('❨', '❩');
          Exit;
        end;
      ^F:
        begin
          Surround('⌊', '⌋');
          Exit;
        end;
      ^C:
        begin
          Surround('⌈', '⌉');
          Exit;
        end;
      ^L:
        begin
          Surround('''(', ')');
          Exit;
        end;
      ^U:
        begin
          InsertBinOp('∪');
          Exit;
        end;
      ^I:
        begin
          InsertBinOp('∩');
          Exit;
        end;
      ^D:
        begin
          InsertBinOp('∧');
          Exit;
        end;
      ^O:
        begin
          InsertBinOp('∨');
          Exit;
        end;
      ^X:
        begin
          InsertBinOp('⊻');
          Exit;
        end;
      ^N:
        begin
          InsertUnOp('¬');
          Exit;
        end;
      ^T:
        begin
          InsertBinOp('↦');
          Exit;
        end;
    end;
  end;

  if AlgosimMainForm.MathInputMode then
  begin
    case Key of
      '*':
        if
          (teProgram.SelLength = 0) and
          (teProgram.GetCharBeforeCaret = DOT_OPERATOR) and
          (teProgram.CaretPos.X > 0) and
          (teProgram.CaretPos.X <= teProgram.TextFile.PhysicalLineWidths[teProgram.CaretPos.Y])
        then
        begin
          S := teProgram.Lines[teProgram.CaretPos.Y];
          if S[teProgram.CaretPos.X] = DOT_OPERATOR then
            S[teProgram.CaretPos.X] := '*';
          teProgram.Lines[teProgram.CaretPos.Y] := S;
          Key := #0;
          DisplayKey := '*';
        end
        else
          Key := DOT_OPERATOR;
      '-':
        if
          (teProgram.SelLength = 0) and
          (teProgram.GetCharBeforeCaret = MINUS_SIGN) and
          (teProgram.CaretPos.X > 0) and
          (teProgram.CaretPos.X <= teProgram.TextFile.PhysicalLineWidths[teProgram.CaretPos.Y])
        then
        begin
          S := teProgram.Lines[teProgram.CaretPos.Y];
          if S[teProgram.CaretPos.X] = MINUS_SIGN then
            S[teProgram.CaretPos.X] := '-';
          teProgram.Lines[teProgram.CaretPos.Y] := S;
          Key := #0;
          DisplayKey := '-';
        end
        else
          Key := MINUS_SIGN;
    end;
  end;


  case Key of
    Chr(VK_TAB):
      begin
        L := teProgram.Lines[teProgram.CaretPos.Y];
        if teProgram.GetWordBoundary(SP, EP) then
          Filter := Copy(L, SP + 1, teProgram.CaretPos.X - SP)
        else
        begin
          Filter := '';
          SP := -1;
        end;
        Res := ShowIdents(Self, AlgosimMainForm.Kernel, TASKernel.AllIdentTypes, Filter);
        if not Res.IsEmpty then
        begin
          if SP <> -1 then
          begin
            L := Copy(L, 1, SP) + Res + Copy(L, EP + 1);
            teProgram.Lines[teProgram.CaretPos.Y] := L;
            P := teProgram.CaretPos;
            P.X := SP + Res.Length;
            teProgram.CaretPos := P;
          end
          else
            teProgram.SelText := Res;
        end;
        Key := #0;
      end;
  end;


end;

procedure TProgramEditor.teProgramModified(Sender: TObject);
begin
  UpdateCaption;
end;

procedure TProgramEditor.teProgramOverwriteChange(Sender: TObject);
begin
  sbProgram.Panels[STATUS_OVERWRITE].Text := IfThen(teProgram.Overwrite, 'OVER', 'INS');
end;

procedure TProgramEditor.teProgramSelChange(Sender: TObject);
begin

  if teProgram.TextFile.HasSelection then
    if teProgram.CaretPos.Y = teProgram.SelEndPos.Y then
      sbProgram.Panels[STATUS_FILE_POSITION].Text :=
        Format('Line: %d  Cols: %d–%d  Len: %d',
          [teProgram.CaretPos.Y + 1,
           min(teProgram.CaretPos.X, teProgram.SelEndPos.X) + 1,
           max(teProgram.CaretPos.X, teProgram.SelEndPos.X) + 1,
           teProgram.SelLength])
    else
      sbProgram.Panels[STATUS_FILE_POSITION].Text :=
        Format('Lines: %d–%d  Len: %d',
          [min(teProgram.CaretPos.Y, teProgram.SelEndPos.Y) + 1,
           max(teProgram.CaretPos.Y, teProgram.SelEndPos.Y) + 1,
           teProgram.SelLength])
  else
    sbProgram.Panels[STATUS_FILE_POSITION].Text :=
      Format('Line: %d  Col: %d  Chr: %d',
        [teProgram.CaretPos.Y + 1, teProgram.CaretPos.X + 1, teProgram.SelStart + 1]);

end;

procedure TProgramEditor.teProgramSimpleNotification(Sender: TObject;
  MsgID: Cardinal; const AStr: string);
begin
  sbProgram.SimplePanel := not AStr.IsEmpty;
  sbProgram.SimpleText := AStr;
end;

procedure TProgramEditor.teProgramZoomChange(Sender: TObject);
begin
  zcProgram.UpdateZoomLevelSilently(teProgram.Zoom);
end;

procedure TProgramEditor.UpdateCaption;
begin
  Caption := TPath.GetFileNameWithoutExtension(teProgram.TextFile.FileName);
  if teProgram.TextFile.FileModified then
    Caption := Caption + #32'*';
end;

procedure TProgramEditor.WMExprParsed(var Message: TMessage);
begin
  FParseResult := Message.WParam;
  case Message.WParam of
    PARSE_EMPTY:
      begin
        SetStatusText('', False);
        SetAST('');
      end;
    PARSE_OK:
      begin
        SetStatusText('Syntax OK', False);
        SetAST(PChar(Message.LParam));
      end;
    PARSE_FAILED:
      begin
        SetStatusText('Syntax error: ' + PChar(Message.LParam), False);
        SetAST('Syntax error:'#13#10 + PChar(Message.LParam));
      end;
  end;
end;

procedure TProgramEditor.WMNCHitTest(var Message: TWMNCHitTest);
begin
  if
    (WindowState <> wsMaximized)
      and
    (BorderStyle = bsSizeable)
      and
    Rect(
      sbParser.Width - sbParser.SizeGripSize,
      sbParser.Height - sbParser.SizeGripSize,
      sbParser.Width,
      sbParser.Height
    )
    .Contains(sbParser.ScreenToClient(Message.Pos))
  then
    Message.Result := HTBOTTOMRIGHT
  else
    inherited;
end;

procedure TProgramEditor.zcProgramChange(Sender: TObject);
begin
  teProgram.Zoom := Round(zcProgram.ZoomLevel);
end;

{ TBackgroundParser }

constructor TBackgroundParser.Create(AEditor: TProgramEditor);
begin
  if AEditor = nil then
    raise Exception.Create('Background parser: No program editor.');
  inherited Create(False);
  FEditor := AEditor;
end;

destructor TBackgroundParser.Destroy;
begin
  inherited;
end;

procedure TBackgroundParser.Execute;
begin

  inherited;

  if FEditor = nil then
    Exit;

  while not Terminated do
  begin
    try
      FEditor.FExpressionStringCS.Enter;
      var Tokens: TObjectList<TToken>;
      try
        Tokens := TTokenizer.Tokenize(FEditor.FExpressionString);
      finally
        FEditor.FExpressionStringCS.Leave;
      end;
      try
        if Tokens.Count > 0 then
        begin
          var Expr := TParser.Parse(Tokens);
          try
            var LExprStr := Expr.ToString;
            SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_OK, NativeInt(PChar(LExprStr)));
          finally
            Expr.Free;
          end;
        end
        else
          SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_EMPTY, 0);
      finally
        Tokens.Free;
      end;
    except
      on E: Exception do
        SendMessage(FEditor.Handle, WM_EXPRPARSED, PARSE_FAILED, NativeInt(PChar(E.Message)));
    end;
    if FEditor.FReparseEvent.WaitFor(INFINITE) = wrSignaled then
      Continue
    else
      Break;
  end;

end;

end.
