pas2js/demo/fpcunit/frmrunform.pp

unit frmrunform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, js, web, hotreloadclient, browserTestRunner, fpcunitreport;

Type

  { TTestRunForm }

  TTestRunForm = Class(TRunForm)
  private
    FElementID: String;
    BOutput : TJSHTMLInputElement;
    BRebuild : TJSHTMLInputElement;
    BRun : TJSHTMLInputElement;
    BuildID : TJSHTMLElement;
    FLastReq : TJSXMLHttpRequest;
    POutput: TJSElement;
    function RecompileClick(Event{%H-}: TJSMouseEvent): boolean;
    procedure CreatePanel(aParent: TJSElement);
    function DoReloadChange(Event{%H-}: TEventListenerEvent): boolean;
    function doResponse(Event{%H-}: TEventListenerEvent): boolean;
    function RunClick(aEvent{%H-}: TJSMouseEvent): boolean;
    function ToggleOutput(aEvent{%H-}: TJSMouseEvent): boolean;
  Public
    Constructor create(AOwner : TComponent); override;
    Procedure Initialize; override;
    // Where to place the control. Default fpcunit-control
    Property ElementID : String Read FElementID Write FElementID;
  end;

implementation

function TTestRunForm.doResponse(Event: TEventListenerEvent): boolean;

Var
  Data : TJSObject;
  S : String;

begin
  Result:=True;
  console.warn('Compile request response received');
  try
     Data:=TJSJSON.parseObject(FLastReq.responseText);
     if data['success'] then
       begin
       if isInteger(data['compileID']) then
         begin
         S:=String(data['compileID']);
         BuildID.innerText:=S;
         end;
       end
     else
       BuildID.innerText:='no build yet';
  except
    console.error('Compile request response received non-json response: '+FLastReq.ResponseText);
  end;
  FreeAndNil(FLastReq);
end;

function TTestRunForm.RunClick(aEvent: TJSMouseEvent): boolean;
begin
  Result:=True;
  if Assigned(OnRun) then
    OnRun(Self);
end;

function TTestRunForm.ToggleOutput(aEvent: TJSMouseEvent): boolean;

Var
  S : String;
  P : Integer;

begin
  Result:=True;
  S:=POutput.className;
  P:=Pos(' in',S);
  if P>0 then
    S:=Copy(S,1,P-1)
  else
    S:=S+' in';
  POutput.className:=S;
end;

function TTestRunForm.RecompileClick(Event: TJSMouseEvent): boolean;

Var
  Req : TJSXMLHttpRequest;

begin
  Result:=True;
   console.info('Recompile requested');
   Req:=TJSXMLHttpRequest.new;
   Req.addEventListener('load',@DoResponse);
   Req.open('POST','$sys/compile');
   Req.send;
   FLastReq:=Req;
end;


Procedure TTestRunForm.CreatePanel(aParent : TJSElement);

Var
  Panel : TJSElement;
  BG,D,PanelContent : TJSElement;
  CB : TJSHTMLInputElement;

begin
  Panel:=aParent;
  // attrs are default array property...
  Panel['class']:='panel panel-default';
  // Innner panel
  PanelContent:=document.createElement('div');
  Panel.appendChild(PanelContent);
  PanelContent['class']:='panel-heading';
  BG:=document.createElement('div');
  BG['class']:='btn-group';
  PanelContent.appendChild(BG);
  // Run Button
  BRun:=TJSHTMLInputElement(document.createElement('button'));
  BRun['id']:=ElementID+'-BRun';
  BRun['type']:='button';
  BRun['class']:='btn btn-primary';
  BRun.appendChild(document.createTextNode('Re-Run'));
  BRun.onclick:=@RunClick;
  BG.appendChild(BRun);

  // Rebuild Button
  BRebuild:=TJSHTMLInputElement(document.createElement('button'));
  BRebuild['id']:=ElementID+'-BRebuild';
  BRebuild['type']:='button';
  BRebuild['class']:='btn btn-primary';
  BRebuild.appendChild(document.createTextNode('Recompile'));
  BRebuild.onclick:=@RecompileClick;
  BG.appendChild(BRebuild);
  // Output Button
  BOutput:=TJSHTMLInputElement(document.createElement('button'));
  BOutput['id']:=ElementID+'-BRebuild';
  BOutput['type']:='button';
  BOutput['class']:='btn btn-primary';
  BOutput.appendChild(document.createTextNode('Output'));
  BOutput.onclick:=@ToggleOutput;
  BG.appendChild(BOutput);
  // Span for build ID
  D:=Document.createElement('span');
  D.id:='buildlabel';
  D['style']:='margin-left: 15px; margin-right: 15px';
  D.appendChild(Document.createTextNode('Build ID:'));

  PanelContent.appendChild(D);
  BuildID:=TJSHTMLElement(document.createElement('span'));
  BuildID['id']:='recompileID';
  BuildID['class']:='badge';
  BuildID.appendChild(document.createTextNode('no build yet'));
  PanelContent.appendChild(BuildID);
  // Combo box to trigger onload
  D:=Document.createElement('label');
  D['class']:='checkbox-inline';
  D['style']:='margin-left: 15px';
  cb:=TJSHTMLInputElement(document.createElement('input'));
  cb['id']:='cbautoreload';
  cb['type']:='checkbox';
  cb.onchange:=@DoReloadChange;
  // Sync with hotreload
  cb.checked:=THotReload.getglobal.options.Reload;
  D.AppendChild(cb);
  D.appendChild(Document.createTextNode('Reload page on build/sync'));
  PanelContent.appendChild(D);
  // Collapsible panel For compiler output
  POutput:=document.createElement('div');
  POutput['class']:='panel-collapse collapse';
  D:=Document.createElement('div');
  D['class']:='panel-body';
  D['id']:=ElementID+'-output';
  // Tell it to hotreload.
  THotReload.getglobal.options.OverlayElementID:=ElementID+'-output';
  POutput.appendChild(D);
  Panel.appendChild(POutput);
  // Hint
end;

constructor TTestRunForm.Create(aOwner : TComponent);
begin
  inherited;
  ElementID:='fpcunit-controller'
end;

procedure TTestRunForm.Initialize;

Var
  Panel : TJSElement;
begin
  inherited Initialize;
  THotReload.StartHotReload;
  Panel:=document.getElementById(Self.ElementID);
  if Panel<>Nil then
    CreatePanel(Panel);
  // Start hotreload
end;

function TTestRunForm.DoReloadChange(Event: TEventListenerEvent): boolean;

begin
  Result:=True;
  THotReload.getglobal.options.Reload:=not THotReload.getglobal.options.Reload;
end;

end.