Sierpinski curve: Difference between revisions
→{{header|BASIC}}: Added QuickBASIC.
(Added Algol W) |
(→{{header|BASIC}}: Added QuickBASIC.) |
||
| (6 intermediate revisions by 5 users not shown) | |||
Line 52:
out.write("'/>\n</svg>\n")
V out = File(‘sierpinski_curve.svg’,
SierpinskiCurve().write(out, 545, 7, 5)</syntaxhighlight>
Line 549:
Return
</syntaxhighlight>
=={{header|BASIC}}==
==={{header|FreeBASIC}}===
{{trans|XPL0}}
<syntaxhighlight lang="vb">#define pi 4 * Atn(1)
#define yellow Rgb(255,255,0)
Dim Shared As Integer posX, posY
Dim Shared As Single direc
Sub Dibuja(largo As Integer)
posX += Fix(largo * Cos(direc))
posY -= Fix(largo * Sin(direc))
Line - (posX, posY), yellow
End Sub
Sub Curva(orden As Integer, angulo As Single, long1 As Single, long2 As Single)
If orden <> 0 Then
direc += angulo
Curva(orden-1, -angulo, long1, long2)
direc -= angulo
Dibuja(long1)
direc -= angulo
Curva(orden-1, -angulo, long1, long2)
direc += angulo
End If
End Sub
Screenres 640, 480, 32
Dim As Single ang45 = pi / 4
Dim As Byte orden = 3
Dim As Byte tam = 20
direc = 0
posX = 640/4
posY = 3*480/4
Pset (posX, posY)
For c As Byte = 1 To 4
Curva(orden*2, ang45, tam/Sqr(2), 5*tam/6)
direc += ang45
Dibuja(tam/Sqr(2))
direc += ang45
Next
Windowtitle "Hit any key to end program"
Sleep</syntaxhighlight>
==={{header|QuickBASIC}}===
{{trans|XPL0}}
<syntaxhighlight lang="qbasic">
REM Sierpinski curve
DECLARE SUB Curve (Lev%, Ang!, L1!, L2!)
DECLARE SUB DrawLine (L!)
CONST Order = 3, Pi = 3.141592654#, Ang45 = Pi / 4!, Size = 20!
CONST Sqr2 = 1.4142135623731#
DIM SHARED Dir, PosX%, PosY%
SCREEN 12
PosX% = 640 \ 4: PosY% = 3 * 480 \ 4
PSET (PosX%, PosY%)
Dir = 0!
FOR Quad% = 1 TO 4
CALL Curve(Order * 2, Ang45, Size / Sqr2, 5! * Size / 6!)
Dir = Dir + Ang45
CALL DrawLine(Size / Sqr2)
Dir = Dir + Ang45
NEXT Quad%
END
SUB Curve (Lev%, Ang, L1, L2)
IF Lev% <> 0 THEN
Dir = Dir + Ang
CALL Curve(Lev% - 1, -Ang, L1, L2)
Dir = Dir - Ang
CALL DrawLine(L1)
Dir = Dir - Ang
CALL Curve(Lev% - 1, -Ang, L1, L2)
Dir = Dir + Ang
END IF
END SUB
SUB DrawLine (L)
PosX% = PosX% + INT(L * COS(Dir) + .5)
PosY% = PosY% - INT(L * SIN(Dir) + .5)
LINE -(PosX%, PosY%), 15
END SUB
</syntaxhighlight>
==={{header|Yabasic}}===
<syntaxhighlight lang="yabasic">// Rosetta Code problem: http://rosettacode.org/wiki/Sierpinski_curve
// Adapted from https://www.ocg.at/sites/ocg.at/files/EuroLogo2001/P74Batagelj.pdf to Yabasic by Galileo, 01/2022
import turtle
sub Sierp(n, a, h, k)
if n = 0 move(k) : return
turn(a) : Sierp(n - 1, -a, h, k) : turn(-a) : move(h)
turn(-a) : Sierp(n - 1, -a, h, k) : turn(a)
end sub
sub Sierpinski(n, d)
local i
pen(false)
goxy(10, 680)
pen(true)
color 255, 255, 0
for i = 1 to 4
Sierp(n, 45, d/sqrt(2), 5*d/6)
turn(45)
move(d/sqrt(2))
turn(45)
next
end sub
startTurtle()
Sierpinski(9, 12) </syntaxhighlight>
=={{header|C++}}==
Line 636 ⟶ 754:
{{out}}
[[Media:Sierpinski_curve_cpp.svg]]
=={{header|EasyLang}}==
[https://easylang.online/show/#cod=jZJNbsIwEIX3PsWTFXXRKBa0RSoLb+EQKAs3GLBqnMhOiXP7akgcIGXRle15n+fnaRpfV7ChDzo2sPqiLQRUNPU5g/+xOmS7EoIBONQeFm09UBQBoFwGCc7HJzFVBuMQWl+dlA9jrlEfEQOJJUKrG7wNGd1U7EYCMIcUNyUkquxBBaiYnBDkWJZz4str9Y3lQ1iwZ1ea5eWuSJJCp5pkiXJXVTDBmuTc3qsu6RE9lDvCuiPEkMEapzuzb09YiHcKnOuLJpD9wzBzGEbkG44BleBbfms6Ipeo6oC98XilujetJy0Y90yjrlITALSdKhV32eljIWmiv1w+4/J7TiSXRl9ogqKIm6K4HpxNuyWxA48cPG7ybT4RdOcoWVrN1Xwp2dz61QLrT3yssBBrxn4B Run it]
<syntaxhighlight>
proc lsysexp level . axiom$ rules$[] .
for l to level
an$ = ""
for c$ in strchars axiom$
for i = 1 step 2 to len rules$[]
if rules$[i] = c$
c$ = rules$[i + 1]
break 1
.
.
an$ &= c$
.
swap axiom$ an$
.
.
proc lsysdraw axiom$ x y ang lng . .
linewidth 0.3
move x y
for c$ in strchars axiom$
if c$ = "F" or c$ = "G"
x += cos dir * lng
y += sin dir * lng
line x y
elif c$ = "-"
dir -= ang
elif c$ = "+"
dir += ang
.
.
.
axiom$ = "F--xF--F--xF"
rules$[] = [ "x" "xF+G+xF--F--xF+G+x" ]
lsysexp 5 axiom$ rules$[]
lsysdraw axiom$ 50 98 45 0.9
</syntaxhighlight>
=={{header|Factor}}==
Line 688 ⟶ 846:
'''Solution'''
=== Recursive ===
[[File:Fōrmulæ - Sierpiński curve 01.png]]
Line 697 ⟶ 857:
[[File:Fōrmulæ - Sierpiński curve 03.png]]
=== L-system ===
There are generic functions written in Fōrmulæ to compute an L-system in the page [[L-system#Fōrmulæ | L-system]].
The program that creates a Sierpiński curve is:
[[File:Fōrmulæ - L-system - Sierpiński curve 01.png]]
[[File:Fōrmulæ - L-system - Sierpiński curve 02.png]]
=={{header|Go}}==
Line 1,839 ⟶ 1,963:
{{trans|Go}}
{{libheader|DOME}}
<syntaxhighlight lang="
import "dome" for Window
Line 1,968 ⟶ 2,092:
var Game = SierpinskiCurve.new(770, 770, 5, Color.blue, Color.yellow)</syntaxhighlight>
{{out}}
[[File:Wren-Sierpinski_curve.png|400px]]
=={{header|XPL0}}==
Line 2,007 ⟶ 2,134:
];
]</syntaxhighlight>
=={{header|zkl}}==
| |||