mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 13:37:47 +02:00
* Turtle graphics web compiler demo
This commit is contained in:
Michaël Van Canneyt
parent
c4401f9886
commit
b0dfc31b05
1
demo/turtlecompiler/bulma.min.css
vendored
Normal file
1
demo/turtlecompiler/bulma.min.css
vendored
Normal file
File diff suppressed because one or more lines are too long
57
demo/turtlecompiler/index.html
Normal file
57
demo/turtlecompiler/index.html
Normal file
@ -0,0 +1,57 @@
|
||||
|
||||
<HTML>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<Title>Pas2JS web compiler demo</Title>
|
||||
<link href="bulma.min.css" rel="stylesheet">
|
||||
<script SRC="turtlecompile.js" type="application/javascript"></script>
|
||||
<!-- We use bulma for the GUI -->
|
||||
</head>
|
||||
<body>
|
||||
<div class="container is-fluid">
|
||||
<div class="columns">
|
||||
<div class="column is-half">
|
||||
<h1 class="is-title is-6">Your program</h1>
|
||||
<div class="block">
|
||||
<textarea id="memSource" rows="24" cols="80">
|
||||
program main;
|
||||
|
||||
begin
|
||||
// Some example code. Replace with your code...
|
||||
blank(red);
|
||||
point;
|
||||
forward(100);
|
||||
point;
|
||||
right(90);
|
||||
forward(100);
|
||||
point;
|
||||
right(90);
|
||||
forward(100);
|
||||
point;
|
||||
right(90);
|
||||
forward(100);
|
||||
end.
|
||||
</textarea>
|
||||
</div>
|
||||
<div class="block">
|
||||
<button id="btnRun" class="button is-primary is-loading" disabled >Run</button>
|
||||
</div>
|
||||
<div class="notification is-danger is-hidden" id="pnlLog">
|
||||
<button class="delete" id="btnCloseNotification"></button>
|
||||
<span id="lblCompilerOutput">
|
||||
compiler error output
|
||||
</span>
|
||||
</div> <!-- .notification -->
|
||||
</div> <!-- .column -->
|
||||
<div class="column is-half">
|
||||
<div class="block">
|
||||
<iframe id="runarea" src="run.html" height="100%" width="100%"></iframe>
|
||||
</div>
|
||||
</div> <!-- /column -->
|
||||
</div> <!-- .columns -->
|
||||
</div> <!-- .container -->
|
||||
<script>
|
||||
rtl.run();
|
||||
</script>
|
||||
</body>
|
||||
</HTML>
|
||||
20
demo/turtlecompiler/run.html
Normal file
20
demo/turtlecompiler/run.html
Normal file
@ -0,0 +1,20 @@
|
||||
<HTML>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<Title>Pas2JS web compiler Program output</Title>
|
||||
<!--
|
||||
<script SRC="webcompiler.js" type="application/javascript"></script>
|
||||
-->
|
||||
<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" rel="stylesheet">
|
||||
</head>
|
||||
<body>
|
||||
<div class="container">
|
||||
<div class="panel panel-info">
|
||||
<div class="panel-heading">Run program output</div>
|
||||
<div class="panel-body">Compile and run your program first.</div>
|
||||
<div id="pasjsconsole" style="width: 640px; height: 200px;">
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</body>
|
||||
</HTML>
|
||||
454
demo/turtlecompiler/sources/turtlegraphics.pas
Normal file
454
demo/turtlecompiler/sources/turtlegraphics.pas
Normal file
@ -0,0 +1,454 @@
|
||||
unit turtlegraphics;
|
||||
|
||||
{$mode ObjFPC}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
{ Commands & constants taken from the turtle graphics at
|
||||
https://www.turtle.ox.ac.uk/documentation/reference
|
||||
}
|
||||
|
||||
const
|
||||
green = $228B22;
|
||||
red = $FF0000;
|
||||
blue = $0000FF;
|
||||
yellow = $FFFF00;
|
||||
violet = $8A2BE2;
|
||||
lime = $00FF00;
|
||||
orange = $FFAA00;
|
||||
skyblue = $00B0FF;
|
||||
brown = $964B00;
|
||||
pink = $EE1289;
|
||||
darkgreen = $006400;
|
||||
darkred = $B22222;
|
||||
darkblue = $000080;
|
||||
ochre = $C0B030;
|
||||
indigo = $4B0082;
|
||||
olive = $808000;
|
||||
orangered = $FF6600;
|
||||
teal = $008080;
|
||||
darkbrown = $5C4033;
|
||||
magenta = $FF00FF;
|
||||
lightgreen = $98FB98;
|
||||
lightred = $CD5C5C;
|
||||
lightblue = $99BBFF;
|
||||
cream = $FFFFBB;
|
||||
lilac = $B093FF;
|
||||
yellowgreen = $AACC33;
|
||||
peach = $FFCCB0;
|
||||
cyan = $00FFFF;
|
||||
lightbrown = $B08050;
|
||||
lightpink = $FFB6C0;
|
||||
seagreen = $3CB371;
|
||||
maroon = $800000;
|
||||
royal = $4169E1;
|
||||
gold = $FFC800;
|
||||
purple = $800080;
|
||||
emerald = $00C957;
|
||||
salmon = $FA8072;
|
||||
turquoise = $00BEC1;
|
||||
coffee = $926F3F;
|
||||
rose = $FF88AA;
|
||||
greengrey = $709070;
|
||||
redgrey = $B08080;
|
||||
bluegrey = $8080A0;
|
||||
yellowgrey = $909070;
|
||||
darkgrey = $404040;
|
||||
midgrey = $808080;
|
||||
lightgrey = $A0A0A0;
|
||||
silver = $C0C0C0;
|
||||
white = $FFFFFF;
|
||||
black = $000000;
|
||||
|
||||
// Relative movement
|
||||
procedure forward(n : integer);
|
||||
procedure back(n : integer);
|
||||
procedure left(n : integer);
|
||||
procedure right(n : integer);
|
||||
procedure drawxy(x,y : integer);
|
||||
procedure movexy(x,y : integer);
|
||||
|
||||
// Absolute movement
|
||||
procedure home;
|
||||
procedure setx(x : integer);
|
||||
procedure sety(y : integer);
|
||||
procedure setxy(x,y : integer);
|
||||
procedure direction(n : integer);
|
||||
procedure angles(degrees : integer);
|
||||
procedure turnxy(x,y : integer);
|
||||
|
||||
// Other
|
||||
procedure point;
|
||||
procedure setpointsize(aSize : Integer);
|
||||
procedure penup;
|
||||
procedure pendown;
|
||||
procedure colour(aColor : Integer);
|
||||
procedure color(aColor : Integer);
|
||||
procedure randcol(n: integer);
|
||||
function rgb(i : integer) : Integer;
|
||||
procedure thickness(i : integer);
|
||||
|
||||
procedure box(x,y,color : integer; border : Boolean);
|
||||
procedure circle(radius : integer);
|
||||
procedure blot(radius : integer);
|
||||
procedure ellipse(xRadius,yRadius : integer);
|
||||
procedure ellblot(xRadius,yRadius : integer);
|
||||
|
||||
procedure blank(acolor : integer);
|
||||
|
||||
// Not part of the API, but needed to set up stuff.
|
||||
// Maybe it should be moved to another unit ?
|
||||
procedure _initcanvas(aID : string);
|
||||
|
||||
// Variables that can be set directly.
|
||||
var
|
||||
turtc, turtd, turtx, turty, turtt : integer;
|
||||
|
||||
implementation
|
||||
|
||||
uses web;
|
||||
|
||||
const
|
||||
colours : array[1..50] of integer = (
|
||||
green,
|
||||
red,
|
||||
blue,
|
||||
yellow,
|
||||
violet,
|
||||
lime,
|
||||
orange,
|
||||
skyblue,
|
||||
brown,
|
||||
pink,
|
||||
darkgreen,
|
||||
darkred,
|
||||
darkblue,
|
||||
ochre,
|
||||
indigo,
|
||||
olive,
|
||||
orangered,
|
||||
teal,
|
||||
darkbrown,
|
||||
magenta,
|
||||
lightgreen,
|
||||
lightred,
|
||||
lightblue,
|
||||
cream,
|
||||
lilac,
|
||||
yellowgreen,
|
||||
peach,
|
||||
cyan,
|
||||
lightbrown,
|
||||
lightpink,
|
||||
seagreen,
|
||||
maroon,
|
||||
royal,
|
||||
gold,
|
||||
purple,
|
||||
emerald,
|
||||
salmon,
|
||||
turquoise,
|
||||
coffee,
|
||||
rose,
|
||||
greengrey,
|
||||
redgrey,
|
||||
bluegrey,
|
||||
yellowgrey,
|
||||
darkgrey,
|
||||
midgrey,
|
||||
lightgrey,
|
||||
silver,
|
||||
white,
|
||||
black
|
||||
);
|
||||
|
||||
var
|
||||
turtAngles : integer = 360;
|
||||
drawing : boolean;
|
||||
pointSize : Integer = 4;
|
||||
canvas : TJSCanvasRenderingContext2D;
|
||||
|
||||
Function ToRad(aDirection : Integer) : Double;
|
||||
|
||||
begin
|
||||
Result:=(aDirection/turtAngles)*2*Pi;
|
||||
end;
|
||||
|
||||
Function ToDegrees(aAngle : Double) : Integer;
|
||||
begin
|
||||
Result:=Round((aAngle*turtAngles)/(2*Pi));
|
||||
end;
|
||||
|
||||
procedure forward(n : integer);
|
||||
|
||||
var
|
||||
deltaX,deltaY : integer;
|
||||
|
||||
begin
|
||||
DeltaX:=round(n * cos(ToRad(turtd)));
|
||||
DeltaY:=round(n * sin(ToRad(turtd)));
|
||||
DrawXY(DeltaX,DeltaY)
|
||||
end;
|
||||
|
||||
procedure back(n : integer);
|
||||
var
|
||||
deltaX,deltaY : integer;
|
||||
|
||||
begin
|
||||
DeltaX:=-round(n * cos(ToRad(turtd)));
|
||||
DeltaY:=-round(n * sin(ToRad(turtd)));
|
||||
DrawXY(DeltaX,DeltaY)
|
||||
end;
|
||||
|
||||
procedure left(n : integer);
|
||||
begin
|
||||
TurtD:=TurtD-N;
|
||||
end;
|
||||
|
||||
procedure right(n : integer);
|
||||
begin
|
||||
TurtD:=TurtD+N;
|
||||
end;
|
||||
|
||||
procedure applycolor(acolor: integer);
|
||||
var
|
||||
r,g,b : Integer;
|
||||
col : string;
|
||||
|
||||
begin
|
||||
col:=format('%.6x',[aColor]);
|
||||
B:=aColor and $FF;
|
||||
G:=(aColor shr 8) and $FF;
|
||||
R:=(aColor shr 16) and $FF;
|
||||
col:=Format('rgb(%d,%d,%d)',[R,G,B]);
|
||||
canvas.strokestyle:=col;
|
||||
canvas.fillstyle:=col;
|
||||
end;
|
||||
|
||||
procedure setcanvasparams;
|
||||
begin
|
||||
Canvas.lineWidth:=turtt;
|
||||
applycolor(turtc);
|
||||
end;
|
||||
|
||||
procedure drawxy(x,y : integer);
|
||||
|
||||
begin
|
||||
if Drawing then
|
||||
begin
|
||||
Canvas.BeginPath;
|
||||
setcanvasparams;
|
||||
Canvas.MoveTo(TurtX,TurtY);
|
||||
Canvas.Lineto(TurtX+X,TurtY+Y);
|
||||
Canvas.Stroke;
|
||||
end;
|
||||
MoveXY(X,Y);
|
||||
end;
|
||||
|
||||
procedure movexy(x,y : integer);
|
||||
|
||||
begin
|
||||
TurtX:=TurtX+X;
|
||||
TurtY:=TurtY+Y;
|
||||
end;
|
||||
|
||||
// Absolute movement
|
||||
procedure home;
|
||||
begin
|
||||
TurtX:=0;
|
||||
TurtY:=0;
|
||||
TurtD:=0;
|
||||
end;
|
||||
|
||||
procedure setx(x : integer);
|
||||
begin
|
||||
TurtX:=X;
|
||||
end;
|
||||
|
||||
procedure sety(y : integer);
|
||||
begin
|
||||
TurtY:=Y;
|
||||
end;
|
||||
|
||||
procedure setxy(x,y : integer);
|
||||
|
||||
begin
|
||||
TurtX:=X;
|
||||
TurtY:=Y;
|
||||
end;
|
||||
|
||||
procedure direction(n : integer);
|
||||
begin
|
||||
TurtD:=N;
|
||||
end;
|
||||
|
||||
procedure angles(degrees : integer);
|
||||
|
||||
begin
|
||||
TurtAngles:=Degrees;
|
||||
end;
|
||||
|
||||
procedure turnxy(x,y : integer);
|
||||
|
||||
begin
|
||||
TurtD:= ToDegrees(ArcTan2(x,y));
|
||||
end;
|
||||
|
||||
procedure point;
|
||||
|
||||
begin
|
||||
blot(pointsize);
|
||||
end;
|
||||
|
||||
procedure setpointsize(aSize: Integer);
|
||||
begin
|
||||
pointSize:=aSize;
|
||||
end;
|
||||
|
||||
procedure penup;
|
||||
begin
|
||||
Drawing:=False;
|
||||
end;
|
||||
|
||||
procedure pendown;
|
||||
|
||||
begin
|
||||
Drawing:=True;
|
||||
end;
|
||||
|
||||
procedure circle(radius: integer);
|
||||
begin
|
||||
setcanvasparams;
|
||||
Canvas.arc(TurtX,TurtY,radius,0,2*pi);
|
||||
end;
|
||||
|
||||
procedure box(x,y,color : integer; border : Boolean);
|
||||
|
||||
var
|
||||
c : integer;
|
||||
|
||||
begin
|
||||
c:=turtc;
|
||||
turtc:=color;
|
||||
setcanvasparams;
|
||||
Canvas.fillrect(TurtX,TurtY,X,Y);
|
||||
turtc:=c;
|
||||
if border then
|
||||
begin
|
||||
setcanvasparams;
|
||||
Canvas.rect(TurtX,TurtY,X,Y);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure blot(radius: integer);
|
||||
var
|
||||
P : TJSPath2D;
|
||||
begin
|
||||
P:=TJSPath2D.new;
|
||||
P.arc(TurtX,TurtY,radius,0,2*pi);
|
||||
setcanvasparams;
|
||||
canvas.beginpath;
|
||||
canvas.fill(P);
|
||||
canvas.stroke;
|
||||
end;
|
||||
|
||||
procedure ellipse(xRadius,yRadius: integer);
|
||||
begin
|
||||
setcanvasparams;
|
||||
Canvas.ellipse(TurtX,TurtY,xRadius,yRadius,0,0,2*pi);
|
||||
end;
|
||||
|
||||
procedure ellblot(xRadius,yRadius : integer);
|
||||
var
|
||||
P : TJSPath2D;
|
||||
begin
|
||||
P:=TJSPath2D.new;
|
||||
P.ellipse(TurtX,TurtY,xRadius,yRadius,0,0,2*pi);
|
||||
setcanvasparams;
|
||||
canvas.beginpath;
|
||||
canvas.fill(P);
|
||||
canvas.stroke;
|
||||
end;
|
||||
|
||||
procedure blank(acolor: integer);
|
||||
|
||||
var
|
||||
c : integer;
|
||||
|
||||
begin
|
||||
c:=turtc;
|
||||
turtc:=acolor;
|
||||
setcanvasparams;
|
||||
canvas.FillRect(-500,-500,1000,1000);
|
||||
turtc:=c;
|
||||
end;
|
||||
|
||||
procedure _initcanvas(aID : string);
|
||||
|
||||
var
|
||||
cEl : TJSHTMLCanvasElement;
|
||||
D,w,h : double;
|
||||
|
||||
begin
|
||||
cEl:=TJSHTMLCanvasElement(Document.getElementById(aID));
|
||||
if cEl=Nil then exit;
|
||||
W := cEl.getBoundingClientRect().width;
|
||||
H := cEl.getBoundingClientRect().height;
|
||||
if H<W then
|
||||
D:=H
|
||||
else
|
||||
D:=W;
|
||||
cEl.width:=Round(D);
|
||||
cEl.height:=Round(D);
|
||||
canvas:=TJSCanvasRenderingContext2D(cel.getContext('2d'));
|
||||
if not assigned(Canvas) then
|
||||
exit;
|
||||
// Transform so middle point is 0,0
|
||||
// Up is zero degrees...
|
||||
canvas.transform(0,-D/1000,D/1000,0,D/2,D/2);
|
||||
|
||||
colour(black);
|
||||
thickness(2);
|
||||
|
||||
drawing:=true;
|
||||
end;
|
||||
|
||||
procedure colour(aColor : Integer);
|
||||
|
||||
begin
|
||||
turtc:=aColor;
|
||||
end;
|
||||
|
||||
procedure color(aColor: Integer);
|
||||
begin
|
||||
colour(aColor);
|
||||
end;
|
||||
|
||||
procedure randcol(n : integer);
|
||||
begin
|
||||
if n>50 then n:=50;
|
||||
if n<1 then n:=1;
|
||||
color(rgb(1+random(n)));
|
||||
end;
|
||||
|
||||
function rgb(i : integer) : integer;
|
||||
|
||||
begin
|
||||
if (I>=1) and (I<=50) then
|
||||
Result:=colours[i];
|
||||
end;
|
||||
|
||||
procedure thickness(i : integer);
|
||||
|
||||
begin
|
||||
if I<=0 then exit;
|
||||
turtt:=i;
|
||||
end;
|
||||
|
||||
initialization
|
||||
_initCanvas('cnvTurtle');
|
||||
end.
|
||||
|
||||
91
demo/turtlecompiler/turtlecompile.lpi
Normal file
91
demo/turtlecompiler/turtlecompile.lpi
Normal file
@ -0,0 +1,91 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<Runnable Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="turtlecompile"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="4">
|
||||
<Item0 Name="MaintainHTML" Value="1"/>
|
||||
<Item1 Name="Pas2JSProject" Value="1"/>
|
||||
<Item2 Name="PasJSLocation" Value="turtlecompiler"/>
|
||||
<Item3 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="turtlecompile.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="index.html"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CustomData Count="1">
|
||||
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
|
||||
</CustomData>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="turtlecompile"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir);../../compiler/utils/pas2js;../../compiler/packages/pastojs/src"/>
|
||||
<OtherUnitFiles Value="../../compiler/utils/pas2js;../../compiler/packages/pastojs/src;../../compiler/packages/fcl-passrc/src;../../compiler/packages/fcl-json/src;../../compiler/packages/fcl-js/src"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="browser"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
245
demo/turtlecompiler/turtlecompile.lpr
Normal file
245
demo/turtlecompiler/turtlecompile.lpr
Normal file
@ -0,0 +1,245 @@
|
||||
program turtlecompile;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
Math, Classes, SysUtils, browserapp, Web, webfilecache, pas2jswebcompiler;
|
||||
|
||||
Type
|
||||
|
||||
{ TWebCompilerDemo }
|
||||
|
||||
TWebCompilerDemo = Class(TBrowserApplication)
|
||||
Private
|
||||
btnCloseNotification,
|
||||
BRun : TJSHTMLButtonElement;
|
||||
MSource : TJSHTMLTextAreaElement;
|
||||
MLog: TJSHTMLElement;
|
||||
pnlLog : TJSHTMLElement;
|
||||
RFrame : TJSHTMLIFrameElement;
|
||||
FCompiler : TPas2JSWebCompiler;
|
||||
procedure ClearResult;
|
||||
procedure DoLog(Sender: TObject; const Msg: String);
|
||||
function HideNotification(aEvent: TJSMouseEvent): boolean;
|
||||
procedure LogError(const aMsg: string);
|
||||
procedure OnUnitsLoaded(Sender: TObject; aFileName: String; aError: string);
|
||||
function Prepare(aSource: string): string;
|
||||
function RunClick(aEvent: TJSMouseEvent): boolean;
|
||||
procedure RunResult;
|
||||
Protected
|
||||
function CompileClick(aEvent: TJSMouseEvent): boolean;
|
||||
Procedure LinkElements;
|
||||
Property Compiler : TPas2JSWebCompiler Read FCompiler;
|
||||
Public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
Procedure Execute;
|
||||
end;
|
||||
|
||||
Const
|
||||
// Default run HTML page, shown in IFrame.
|
||||
|
||||
SHTMLHead =
|
||||
'<HTML>'+LineEnding+
|
||||
'<head>'+LineEnding+
|
||||
' <meta charset="UTF-8">'+LineEnding+
|
||||
' <Title>Pas2JS Turtle graphics program output</Title>'+LineEnding+
|
||||
' <script type="application/javascript">'+LineEnding;
|
||||
|
||||
SHTMLTail =
|
||||
' </script>'+LineEnding+
|
||||
' <link href="bulma.min.css" rel="stylesheet">'+LineEnding+
|
||||
'</head>'+LineEnding+
|
||||
'<body>'+LineEnding+
|
||||
' <div class="container is-fluid">'+LineEnding+
|
||||
' <div class="box">'+LineEnding+
|
||||
' <h1 class="is-title">Run program output</h1>'+LineEnding+
|
||||
' <div class="block" style="min-height: 75hv;">'+LineEnding+
|
||||
' <canvas id="cnvTurtle" style="width: 100%; height: 100%;"></canvas>'+LineEnding+
|
||||
' </div> <!-- .block --> '+LineEnding+
|
||||
' </div> <!-- .box -->'+LineEnding+
|
||||
' </div> <!-- .container -->'+LineEnding+
|
||||
'<script>'+LineEnding+
|
||||
' rtl.run();'+LineEnding+
|
||||
'</script>'+LineEnding+
|
||||
'</body>'+LineEnding+
|
||||
'</HTML>';
|
||||
|
||||
|
||||
{ TWebCompilerDemo }
|
||||
|
||||
procedure TWebCompilerDemo.LogError(const aMsg : string);
|
||||
|
||||
begin
|
||||
MLog.InnerText:=aMsg;
|
||||
pnlLog.classList.remove('is-hidden');
|
||||
end;
|
||||
|
||||
procedure TWebCompilerDemo.OnUnitsLoaded(Sender: TObject; aFileName: String; aError: string);
|
||||
begin
|
||||
BRun.classList.remove('is-loading');
|
||||
if aError='' then
|
||||
BRun.disabled:=False
|
||||
else
|
||||
begin
|
||||
LogError('Error Loading "'+aFileName+'": '+AError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWebCompilerDemo.LinkElements;
|
||||
begin
|
||||
BRun:=TJSHTMLButtonElement(GetHTMLElement('btnRun'));
|
||||
BRun.onClick:=@CompileClick;
|
||||
btnCloseNotification:=TJSHTMLButtonElement(GetHTMLElement('btnCloseNotification'));
|
||||
btnCloseNotification.onClick:=@HideNotification;
|
||||
MSource:=TJSHTMLTextAreaElement(GetHTMLElement('memSource'));
|
||||
MLog:=GetHTMLElement('lblCompilerOutput');
|
||||
pnlLog:=GetHTMLElement('pnlLog');
|
||||
RFrame:=TJSHTMLIFrameElement(Document.getElementById('runarea'));
|
||||
end;
|
||||
|
||||
constructor TWebCompilerDemo.Create(aOwner : TComponent);
|
||||
begin
|
||||
Inherited;
|
||||
FCompiler:=TPas2JSWebCompiler.Create;
|
||||
Compiler.Log.OnLog:=@DoLog;
|
||||
end;
|
||||
|
||||
function TWebCompilerDemo.RunClick(aEvent: TJSMouseEvent): boolean;
|
||||
|
||||
Var
|
||||
Src : String;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
procedure TWebCompilerDemo.DoLog(Sender: TObject; const Msg: String);
|
||||
begin
|
||||
MLog.InnerHTML:=MLog.InnerHTML+'<BR>'+Msg;
|
||||
end;
|
||||
|
||||
function TWebCompilerDemo.HideNotification(aEvent: TJSMouseEvent): boolean;
|
||||
begin
|
||||
pnlLog.classList.Add('is-hidden');
|
||||
end;
|
||||
|
||||
|
||||
Procedure TWebCompilerDemo.ClearResult;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
function TWebCompilerDemo.Prepare(aSource : string) : string;
|
||||
|
||||
var
|
||||
Src,un : String;
|
||||
p, pu, pp, ps : Integer;
|
||||
doinsert,withcomma : boolean;
|
||||
|
||||
begin
|
||||
Result:=aSource;
|
||||
Src:=LowerCase(aSource);
|
||||
p:=pos('begin',Src);
|
||||
p:=Min(P,pos('function ',Src));
|
||||
p:=Min(P,pos('procedure ',Src));
|
||||
doinsert:=true;
|
||||
withcomma:=false;
|
||||
pu:=Pos('uses',Src);
|
||||
// No uses
|
||||
if (pu=0) then
|
||||
begin
|
||||
pp:=pos('program',src);
|
||||
if pp=0 then
|
||||
pu:=1
|
||||
else
|
||||
pu:=pos(';',Src,pp+6)+1;
|
||||
System.Insert(#10'uses ;',result,pu);
|
||||
pu:=pu+6;
|
||||
end
|
||||
else
|
||||
begin
|
||||
pu:=pu+5;
|
||||
ps:=pos(';',Src,pu);
|
||||
if pos('turtlegraphics',Src,pu)<ps then
|
||||
doinsert:=False;
|
||||
withcomma:=true;
|
||||
end;
|
||||
if doInsert then
|
||||
begin
|
||||
un:=' turtlegraphics';
|
||||
if Withcomma then
|
||||
un:=un+', ';
|
||||
System.insert(un,result,pu);
|
||||
end;
|
||||
Writeln('Final code : ',Result);
|
||||
end;
|
||||
|
||||
Procedure TWebCompilerDemo.RunResult;
|
||||
|
||||
var
|
||||
Src : String;
|
||||
|
||||
begin
|
||||
Src:=Compiler.WebFS.GetFileContent('main.js');
|
||||
if Src='' then
|
||||
begin
|
||||
Window.Alert('No source available');
|
||||
exit;
|
||||
end;
|
||||
Src:=SHTMLHead+Src+LineEnding+SHTMLTail;
|
||||
RFrame['srcdoc']:=Src;
|
||||
end;
|
||||
|
||||
function TWebCompilerDemo.CompileClick(aEvent: TJSMouseEvent): boolean;
|
||||
|
||||
Procedure ShowResult(success : boolean);
|
||||
|
||||
begin
|
||||
ClearResult;
|
||||
BRun.classList.remove('is-loading');
|
||||
if not Success then
|
||||
pnlLog.classList.remove('is-hidden');
|
||||
BRun.Disabled:=False;
|
||||
end;
|
||||
|
||||
Var
|
||||
args : TStrings;
|
||||
Res : Boolean;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
BRun.classList.add('is-loading');
|
||||
// BRun.disabled:=True;
|
||||
ClearResult;
|
||||
MLog.InnerHTML:='';
|
||||
Compiler.WebFS.SetFileContent('main.pp',Prepare(MSource.value));
|
||||
args:=TStringList.Create;
|
||||
try
|
||||
Args.Add('-Tbrowser');
|
||||
Args.Add('-Jc');
|
||||
Args.Add('-Jirtl.js');
|
||||
Args.Add('main.pp');
|
||||
RFrame.Src:='run.html';
|
||||
Compiler.Run('','',Args,True);
|
||||
Res:=Compiler.ExitCode=0;
|
||||
ShowResult(Res);
|
||||
if Res then
|
||||
RunResult;
|
||||
finally
|
||||
Args.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TWebCompilerDemo.Execute;
|
||||
begin
|
||||
LinkElements;
|
||||
Compiler.WebFS.LoadBaseURL:='sources';
|
||||
BRun.classList.add('is-loading');
|
||||
Compiler.WebFS.LoadFiles(['rtl.js','system.pas','p2jsres.pas','sysutils.pas','types.pas','typinfo.pas','classes.pas','rtlconsts.pas','js.pas','simplelinkedlist.pas','web.pas','weborworker.pas','browserconsole.pas','turtlegraphics.pas'],@OnUnitsLoaded);
|
||||
|
||||
end;
|
||||
|
||||
begin
|
||||
With TWebCompilerDemo.Create(Nil) do
|
||||
Execute;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user