unit ide_editor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IFPS3CompExec, SynEdit, SynEditHighlighter, SynHighlighterPas,
  Menus, ifps3, ifpscomp, ExtCtrls, StdCtrls, ComCtrls, ifps3disasm, ifps3debug,
  ifps3CEImp_StdCtrls, ifps3CEImp_Forms, ifps3CEImp_Default,
  ifps3CEImp_Controls;

type
  Teditor = class(TForm)
    ce: TIFPS3DebugCompExec;
    IFPS3DllPlugin1: TIFPS3DllPlugin;
    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: TIFPS3CE_Controls;
    IFPS3CE_DateUtils1: TIFPS3CE_DateUtils;
    IFPS3CE_Std1: TIFPS3CE_Std;
    IFPS3CE_Forms1: TIFPS3CE_Forms;
    IFPS3CE_StdCtrls1: TIFPS3CE_StdCtrls;
    procedure edSpecialLineColors(Sender: TObject; Line: Integer;
      var Special: Boolean; var FG, BG: TColor);
    procedure BreakPointMenuClick(Sender: TObject);
    procedure ceLineInfo(Sender: TObject; 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: TIFPS3CompExec);
    procedure ceAfterExecute(Sender: TIFPS3CompExec);
    procedure ceCompile(Sender: TIFPS3CompExec);
    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);
  private
    FActiveLine: Longint;
    FResume: Boolean;
    FFile: string;
    function Compile: Boolean;
    function Execute: Boolean;

    procedure Writeln(const s: string);
    procedure Readln(var s: string);
  public
    function SaveCheck: Boolean;
  end;

var
  editor: Teditor;

implementation

uses ide_debugoutput,
ifpiir_std,
ifpiir_classes,
ifpiir_graphics,
ifpiir_controls,
ifpiir_forms,
ifpiir_stdctrls,
ifpiir_extctrls,
ifpiir_buttons,

ifpii_std,
ifpii_classes,
ifpii_graphics,
ifpii_controls,
ifpii_forms,
ifpii_stdctrls,
ifpii_extctrls,
ifpii_buttons;

{$R *.dfm}

procedure Teditor.edSpecialLineColors(Sender: TObject; Line: Integer;
  var Special: Boolean; var FG, BG: TColor);
begin
  if ce.HasBreakPoint(Line) then
  begin
    Special := True;
    FG := clWhite;
    BG := clRed;
  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(Line) then
    ce.ClearBreakPoint(Line)
  else
    ce.SetBreakPoint(Line);
  ed.Refresh;
end;

procedure Teditor.ceLineInfo(Sender: TObject; Position, Row,
  Col: Cardinal);
begin
  if ce.Exec.DebugMode = dmRun then
    FActiveLine := -1
  else
  begin
    FActiveLine := Row;
    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: TIFPS3CompExec);
begin
  ce.SetVarToInstance('SELF', Self);
  ce.SetVarToInstance('APPLICATION', Application);
  Caption := 'Editor - Running';
end;

procedure Teditor.ceAfterExecute(Sender: TIFPS3CompExec);
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: TIFPS3CompExec);
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;
    FFile := '';
  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;
      FFile := OpenDialog1.FileName;
    end;
  end;
end;

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

procedure Teditor.Saveas1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    FFile := SaveDialog1.FileName;
    ed.Lines.SaveToFile(FFile);
    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 := FFile <> '';
        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;

end.
