unit ide_editor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SynEdit, SynEditHighlighter, SynHighlighterPas,
  Menus, uPSCompiler, uPSRuntime, uPSDisassembly, uPSUtils, ExtCtrls,
  StdCtrls, ComCtrls, uPSComponent_COM, uPSComponent_StdCtrls,
  uPSComponent_Forms, uPSComponent_Default, uPSComponent_Controls, uPSComponent,
  uPSDebugger;

type
  Teditor = class(TForm)
    ce: TPSScriptDebugger;
    IFPS3DllPlugin1: TPSDllPlugin;
    pashighlighter: TSynPasSyn;
    ed: TSynEdit;
    PopupMenu1: TPopupMenu;
    BreakPointMenu: TMenuItem;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Run1: TMenuItem;
    StepOver1: TMenuItem;
    StepInto1: TMenuItem;
    N1: TMenuItem;
    Reset1: TMenuItem;
    N2: TMenuItem;
    Run2: TMenuItem;
    Exit1: TMenuItem;
    messages: TListBox;
    Splitter1: TSplitter;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    N3: TMenuItem;
    N4: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    Saveas1: TMenuItem;
    StatusBar1: TStatusBar;
    Decompile1: TMenuItem;
    N5: TMenuItem;
    IFPS3CE_Controls1: TPSImport_Controls;
    IFPS3CE_DateUtils1: TPSImport_DateUtils;
    IFPS3CE_Std1: TPSImport_Classes;
    IFPS3CE_Forms1: TPSImport_Forms;
    IFPS3CE_StdCtrls1: TPSImport_StdCtrls;
    IFPS3CE_ComObj1: TPSImport_ComObj;
    procedure edSpecialLineColors(Sender: TObject; Line: Integer;
      var Special: Boolean; var FG, BG: TColor);
    procedure BreakPointMenuClick(Sender: TObject);
    procedure ceLineInfo(Sender: TObject; const FileName: String; Position, Row, Col: Cardinal);
    procedure Exit1Click(Sender: TObject);
    procedure StepOver1Click(Sender: TObject);
    procedure StepInto1Click(Sender: TObject);
    procedure Reset1Click(Sender: TObject);
    procedure ceIdle(Sender: TObject);
    procedure Run2Click(Sender: TObject);
    procedure ceExecute(Sender: TPSScript);
    procedure ceAfterExecute(Sender: TPSScript);
    procedure ceCompile(Sender: TPSScript);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    procedure Saveas1Click(Sender: TObject);
    procedure edStatusChange(Sender: TObject; Changes: TSynStatusChanges);
    procedure Decompile1Click(Sender: TObject);
    function ceNeedFile(Sender: TObject; const OrginFileName: String;
      var FileName, Output: String): Boolean;
    procedure ceBreakpoint(Sender: TObject; const FileName: String; Position, Row, Col: Cardinal);
    procedure FormClick(Sender: TObject);
  private
    FActiveLine: Longint;
    FResume: Boolean;
    FActiveFile: string;
    function Compile: Boolean;
    function Execute: Boolean;

    procedure Writeln(const s: string);
    procedure Readln(var s: string);
    procedure SetActiveFile(const Value: string);

    property aFile: string read FActiveFile write SetActiveFile;
  public
    function SaveCheck: Boolean;
  end;

var
  editor: Teditor;

implementation

uses ide_debugoutput;

{$R *.dfm}

procedure Teditor.edSpecialLineColors(Sender: TObject; Line: Integer;
  var Special: Boolean; var FG, BG: TColor);
begin
  if ce.HasBreakPoint(ce.MainFileName, Line) then
  begin
    Special := True;
    if Line = FActiveLine then
    begin
      BG := clWhite;
      FG := clRed;
    end else
    begin
      FG := clWhite;
      BG := clRed;
    end;
  end else
  if Line = FActiveLine then
  begin
    Special := True;
    FG := clWhite;
    bg := clBlue;
  end else Special := False;
end;

procedure Teditor.BreakPointMenuClick(Sender: TObject);
var
  Line: Longint;
begin
  Line := Ed.CaretY;
  if ce.HasBreakPoint(ce.MainFileName, Line) then
    ce.ClearBreakPoint(ce.MainFileName, Line)
  else
    ce.SetBreakPoint(ce.MainFileName, Line);
  ed.Refresh;
end;

procedure Teditor.ceLineInfo(Sender: TObject; const FileName: String; Position, Row,
  Col: Cardinal);
begin
  if ce.Exec.DebugMode <> dmRun then
  begin
    FActiveLine := Row;
    if (FActiveLine < ed.TopLine +2) or (FActiveLine > Ed.TopLine + Ed.LinesInWindow -2) then
    begin
      Ed.TopLine := FActiveLine - (Ed.LinesInWindow div 2);
    end;
    ed.CaretY := FActiveLine;
    ed.CaretX := 1;

    ed.Refresh;
  end;
end;

procedure Teditor.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure Teditor.StepOver1Click(Sender: TObject);
begin
  if ce.Exec.Status = isRunning then
    ce.StepOver
  else
  begin
    if Compile then
    begin
      ce.StepInto;
      Execute;
    end;
  end;
end;

procedure Teditor.StepInto1Click(Sender: TObject);
begin
  if ce.Exec.Status = isRunning then
    ce.StepInto
  else
  begin
    if Compile then
    begin
      ce.StepInto;
      Execute;
    end;
  end;
end;

procedure Teditor.Reset1Click(Sender: TObject);
begin
  if ce.Exec.Status = isRunning then
    ce.Stop;
end;

function Teditor.Compile: Boolean;
var
  i: Longint;
begin
  ce.Script.Assign(ed.Lines);
  Result := ce.Compile;
  messages.Clear;
  for i := 0 to ce.CompilerMessageCount -1 do
  begin
    Messages.Items.Add(ce.CompilerMessages[i].MessageToString);
  end;
  if Result then
    Messages.Items.Add('Succesfully compiled');
end;

procedure Teditor.ceIdle(Sender: TObject);
begin
  Application.HandleMessage;
  if FResume then
  begin
    FResume := False;
    ce.Resume;
    FActiveLine := 0;
    ed.Refresh;
  end;
end;

procedure Teditor.Run2Click(Sender: TObject);
begin
  if CE.Running then
  begin
    FResume := True
  end else
  begin
    if Compile then
      Execute;
  end;
end;

procedure Teditor.ceExecute(Sender: TPSScript);
begin
  ce.SetVarToInstance('SELF', Self);
  ce.SetVarToInstance('APPLICATION', Application);
  Caption := 'Editor - Running';
end;

procedure Teditor.ceAfterExecute(Sender: TPSScript);
begin
  Caption := 'Editor';
  FActiveLine := 0;
  ed.Refresh;
end;

function Teditor.Execute: Boolean;
begin
  debugoutput.Output.Clear;
  if CE.Execute then
  begin
    Messages.Items.Add('Succesfully Execute');
    Result := True; 
  end else
  begin
    messages.Items.Add('Runtime Error: '+ce.ExecErrorToString + ' at ['+IntToStr(ce.ExecErrorRow)+':'+IntToStr(ce.ExecErrorCol)+'] bytecode pos:'+inttostr(ce.ExecErrorProcNo)+':'+inttostr(ce.ExecErrorByteCodePosition));
    Result := False;
  end;
end;

procedure Teditor.Writeln(const s: string);
begin
  debugoutput.output.Lines.Add(S);
  debugoutput.Visible := True;
end;

procedure Teditor.ceCompile(Sender: TPSScript);
begin
  Sender.AddMethod(Self, @TEditor.Writeln, 'procedure Writeln(s: string)');
  Sender.AddMethod(Self, @TEditor.Readln, 'procedure readln(var s: string)');
  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Application', 'TApplication');
end;

procedure Teditor.Readln(var s: string);
begin
  s := InputBox('Script', '', '');
end;

procedure Teditor.New1Click(Sender: TObject);
begin
  if SaveCheck then
  begin
    ed.ClearAll;
    ed.Lines.Text := 'Program test;'#13#10'begin'#13#10'end.';
    ed.Modified := False;
    aFile := '';
  end;
end;

procedure Teditor.Open1Click(Sender: TObject);
begin
  if SaveCheck then
  begin
    if OpenDialog1.Execute then
    begin
      ed.ClearAll;
      ed.Lines.LoadFromFile(OpenDialog1.FileName);
      ed.Modified := False;
      aFile := OpenDialog1.FileName;
    end;
  end;
end;

procedure Teditor.Save1Click(Sender: TObject);
begin
  if aFile <> '' then
  begin
    ed.Lines.SaveToFile(aFile);
    ed.Modified := False;
  end else
    SaveAs1Click(nil);
end;

procedure Teditor.Saveas1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    aFile := SaveDialog1.FileName;
    ed.Lines.SaveToFile(aFile);
    ed.Modified := False;
  end;
end;

function Teditor.SaveCheck: Boolean;
begin
  if ed.Modified then
  begin
    case MessageDlg('File has not been saved, save now?', mtConfirmation, mbYesNoCancel, 0) of
      idYes:
        begin
          Save1Click(nil);
          Result := aFile <> '';
        end;
      IDNO: Result := True;
      else
        Result := False;
    end;
  end else Result := True;
end;

procedure Teditor.edStatusChange(Sender: TObject;
  Changes: TSynStatusChanges);
begin
  StatusBar1.Panels[0].Text := IntToStr(ed.CaretY)+':'+IntToStr(ed.CaretX)
end;

procedure Teditor.Decompile1Click(Sender: TObject);
var
  s: string;
begin
  if Compile then
  begin
    ce.GetCompiled(s);
    IFPS3DataToText(s, s);
    debugoutput.output.Lines.Text := s;
    debugoutput.visible := true;
  end;
end;

function Teditor.ceNeedFile(Sender: TObject; const OrginFileName: String;
  var FileName, Output: String): Boolean;
var
  path: string;
  f: TFileStream;
begin
  if aFile <> '' then
    Path := ExtractFilePath(aFile)
  else
    Path := ExtractFilePath(ParamStr(0));
  Path := Path + FileName;
  try
    F := TFileStream.Create(Path, fmOpenRead or fmShareDenyWrite);
  except
    Result := false;
    exit;
  end;
  try
    SetLength(Output, f.Size);
    f.Read(Output[1], Length(Output));
  finally
    f.Free;
  end;
  Result := True;
end;

procedure Teditor.ceBreakpoint(Sender: TObject; const FileName: String; Position, Row,
  Col: Cardinal);
begin
  FActiveLine := Row;
  if (FActiveLine < ed.TopLine +2) or (FActiveLine > Ed.TopLine + Ed.LinesInWindow -2) then
  begin
    Ed.TopLine := FActiveLine - (Ed.LinesInWindow div 2);
  end;
  ed.CaretY := FActiveLine;
  ed.CaretX := 1;

  ed.Refresh;
end;

procedure Teditor.SetActiveFile(const Value: string);
begin
  FActiveFile := Value;
  ce.MainFileName := ExtractFileName(FActiveFile);
  if Ce.MainFileName = '' then
    Ce.MainFileName := 'Unnamed';
end;

procedure Teditor.FormClick(Sender: TObject);
begin
  ShowMessage('BLA');
end;

end.