paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 03:37:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Turtle graphics web compiler demo

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-09-18 18:54:17 +02:00
parent c4401f9886
commit b0dfc31b05
6 changed files with 868 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
demo/turtlecompiler/bulma.min.css vendored Normal file
View File

File diff suppressed because one or more lines are too long

57
demo/turtlecompiler/index.html Normal file
View 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
View 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
View 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
View 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
View 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.