ホーム エクスプローラ ヘルプ
サインイン
pascal
/
pas2js
同期ミラー https://gitlab.com/freepascal.org/fpc/pas2js.git
2
0
フォーク 0
ファイル 課題 0 Wiki
ソースを参照

* Turtle graphics demo

Michaël Van Canneyt 10 ヶ月 前
親
53569c9ee9
コミット
c4401f9886
4 ファイル変更、628 行追加、0 行削除
一括表示 差分情報を表示
  1. 38 0
      demo/turtle/index.html
  2. 95 0
      demo/turtle/turtledemo.lpi
  3. 41 0
      demo/turtle/turtledemo.lpr
  4. 454 0
      demo/turtle/turtlegraphics.pas

+ 38 - 0
demo/turtle/index.html
ファイルの表示 

@@ -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 - 0
demo/turtle/turtledemo.lpi
ファイルの表示 

@@ -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 - 0
demo/turtle/turtledemo.lpr
ファイルの表示 

@@ -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 - 0
demo/turtle/turtlegraphics.pas
ファイルの表示 

@@ -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.
 
+