mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-11-15 07:29:32 +01:00
* Turtle graphics demo
This commit is contained in:
Michaël Van Canneyt
parent
53569c9ee9
commit
c4401f9886
38
demo/turtle/index.html
Normal file
38
demo/turtle/index.html
Normal file
@ -0,0 +1,38 @@
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
|
||||
<title>Project1</title>
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<script src="turtledemo.js"></script>
|
||||
<style>
|
||||
#divCanvas {
|
||||
display: inline-block;
|
||||
min-width: 45hv
|
||||
min-height: 80hv
|
||||
}
|
||||
#pasjsconsole {
|
||||
display: inline-block;
|
||||
min-width: 45hv
|
||||
}
|
||||
#cnvTurtle {
|
||||
width: 640px;
|
||||
height: 640px;
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<script>
|
||||
rtl.showUncaughtExceptions=true;
|
||||
window.addEventListener("load", rtl.run);
|
||||
</script>
|
||||
<div>
|
||||
<div id="divCanvas" >
|
||||
<canvas id="cnvTurtle">
|
||||
|
||||
</canvas>
|
||||
</div>
|
||||
<div id="pasjsconsole" ></div>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
95
demo/turtle/turtledemo.lpi
Normal file
95
demo/turtle/turtledemo.lpi
Normal file
@ -0,0 +1,95 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="turtledemo"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="6">
|
||||
<Item0 Name="BrowserConsole" Value="1"/>
|
||||
<Item1 Name="MaintainHTML" Value="1"/>
|
||||
<Item2 Name="Pas2JSProject" Value="1"/>
|
||||
<Item3 Name="PasJSLocation" Value="$NameOnly($(ProjFile))"/>
|
||||
<Item4 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
<Item5 Name="RunAtReady" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="turtledemo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="index.html"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CustomData Count="1">
|
||||
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
|
||||
</CustomData>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="turtlegraphics.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="turtledemo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
<CPPInline 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>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
41
demo/turtle/turtledemo.lpr
Normal file
41
demo/turtle/turtledemo.lpr
Normal file
@ -0,0 +1,41 @@
|
||||
program turtledemo;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
BrowserConsole, BrowserApp, JS, Classes, SysUtils, Web, turtlegraphics;
|
||||
|
||||
type
|
||||
TMyApplication = class(TBrowserApplication)
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
end;
|
||||
|
||||
procedure TMyApplication.DoRun;
|
||||
begin
|
||||
blank(yellow);
|
||||
point;
|
||||
forward(100);
|
||||
point;
|
||||
direction(90);
|
||||
// right(90);
|
||||
forward(100);
|
||||
point;
|
||||
direction(180);
|
||||
// right(90);
|
||||
forward(100);
|
||||
point;
|
||||
// right(90);
|
||||
direction(270);
|
||||
forward(100);
|
||||
end;
|
||||
|
||||
var
|
||||
Application : TMyApplication;
|
||||
|
||||
begin
|
||||
Application:=TMyApplication.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
end.
|
||||
454
demo/turtle/turtlegraphics.pas
Normal file
454
demo/turtle/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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user