Rosetta Code

Sierpinski curve: Difference between revisions

Page Discussion

Sierpinski curve (view source)

Revision as of 21:09, 28 April 2024

9,278 bytes added ,  20 days ago
→‎{{header|BASIC}}: Added QuickBASIC.
(Added 11l)
(→‎{{header|BASIC}}: Added QuickBASIC.)
(9 intermediate revisions by 6 users not shown)
Line 16:
.x += .length * cos(theta)
.y -= .length * sin(theta)
out.write(f:‘ L{gconvfmtL’gconvfmt(.x)}‘,{gconvfmt’gconvfmt(.y)}’)
 
. F execute(out, s)
out.write(f:‘M{gconvfmt‘M’gconvfmt(.x)}‘,{gconvfmt’gconvfmt(.y)}’)
L(c) s
S c
Line 52:
out.write("'/>\n</svg>\n")
 
V out = File(‘sierpinski_curve.svg’, ‘w’WRITE)
SierpinskiCurve().write(out, 545, 7, 5)</syntaxhighlight>
 
Line 225:
{{out}}
[https://gitlab.com/amarok8bit/action-rosetta-code/-/raw/master/images/Sierpinski_curve.png Screenshot from Atari 8-bit computer]
 
=={{header|ALGOL W}}==
Using code from the [[Sierpinski arrowhead curve]] task.<br>
Curve algorithm based on the XPL0 sample.
<syntaxhighlight lang="algolw">
begin % draw sierpinski curves using ascii art %
integer CANVAS_WIDTH;
CANVAS_WIDTH := 200;
begin
% the ascii art canvas and related items %
string(1) array canvas ( 1 :: CANVAS_WIDTH, 1 :: CANVAS_WIDTH );
integer heading, asciiX, asciiY, width, maxX, maxY, minX, minY;
% draw a line using ascii art - the length is ignored and the heading determines the %
% character to use %
% the position is updated %
procedure drawLine( real value length ) ;
begin
% stores the min and max coordinates %
procedure updateCoordinateRange ;
begin
if asciiX > maxX then maxX := asciiX;
if asciiY > maxY then maxY := asciiY;
if asciiX < minX then minX := asciiX;
if asciiY < minY then minY := asciiY
end updateCoordinateRange ;
if heading = 0 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "_";
asciiX := asciiX + 1
end
else if heading = 45 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "/";
asciiY := asciiY - 1;
asciiX := asciiX + 1
end
else if heading = 90 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "|";
asciiY := asciiY - 1
end
else if heading = 135 then begin
asciiX := asciiX - 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "\";
asciiY := asciiY - 1
end
else if heading = 180 then begin
asciiX := asciiX - 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "_"
end
else if heading = 225 then begin
asciiX := asciiX - 1;
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "/"
end
else if heading = 270 then begin
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX - 1, asciiY ) := "|";
end
else if heading = 315 then begin
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX, asciiY ) := "\";
asciiX := asciiX + 1
end if_various_headings
end drawLine ;
% changes the heading by the specified angle ( in degrees ) - angle must be +/- 45 %
procedure turn( integer value angle ) ;
if angle > 0
then heading := ( heading + angle ) rem 360
else begin
heading := heading + angle;
if heading < 0 then heading := heading + 360
end tuen ;
% initialises the ascii art canvas %
procedure initArt ;
begin
heading := 0;
asciiX := CANVAS_WIDTH div 2;
asciiY := asciiX;
maxX := asciiX;
maxY := asciiY;
minX := asciiX;
minY := asciiY;
for x := 1 until CANVAS_WIDTH do for y := 1 until CANVAS_WIDTH do canvas( x, y ) := " "
end initArt ;
% shows the used parts of the canvas %
procedure drawArt ;
begin
for y := minY until maxY do begin
write();
for x := minX until maxX do writeon( canvas( x, y ) )
end for_y ;
write()
end drawIArt ;
% draws a sierpinski curve of the specified order and line length %
procedure sierpinskiCurve( integer value order ) ;
begin
% recursively draws a segment of the sierpinski curve %
procedure curve( integer value order; integer value angle ) ;
if 0 not = order then begin
turn( + angle );
curve( order - 1, - angle );
turn( - angle );
drawline( 1 );
if heading rem 180 = 0 then drawline( 1 );
turn( - angle );
curve( order - 1, - angle );
turn( + angle );
end curve ;
for Quad := 1 until 4 do begin
curve( order * 2, 45 );
turn( 45 );
drawline( 1 );
if heading rem 180 = 0 then drawline( 1 );
turn( 45 );
end for_Quad
end sierpinskiCurve ;
% draw curves %
i_w := 1; s_w := 0; % set output formatting %
for order := 3 do begin
write( "Sierpinski curve of order ", order );
write( "===========================" );
write();
initArt;
sierpinskiCurve( order );
drawArt
end for_order
end
end.
</syntaxhighlight>
{{out}}
<pre>
Sierpinski curve of order 3
===========================
 
/\__/\ /\__/\ /\__/\ /\__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \__/ __ \ / __ \__/ __ \
\/ \ / \/ \/ \ / \/
| | | |
/\__/ __ \__/\ /\__/ __ \__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \ / __ \__/ __ \ / __ \
\/ \/ \/ \ / \/ \/ \/
| |
/\__/\ /\__/ __ \__/\ /\__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \__/ __ \ / __ \__/ __ \
\/ \ / \/ \/ \ / \/
| | | |
/\__/ __ \__/\ /\__/ __ \__/\
\ / \ / \ / \ /
| | | | | | | |
/ __ \ / __ \ / __ \ / __ \
\/ \/ \/ \/ \/ \/ \/ \/
</pre>
 
=={{header|AutoHotkey}}==
Line 385 ⟶ 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 472 ⟶ 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 523 ⟶ 845:
{{FormulaeEntry|page=https://formulae.org/?script=examples/Sierpi%C5%84ski_curve}}
 
'''Solution'''
=={{header|FreeBASIC}}==
{{trans|XPL0}}
<syntaxhighlight lang="vb">#define pi 4 * Atn(1)
#define yellow Rgb(255,255,0)
 
=== Recursive ===
Dim Shared As Integer posX, posY
Dim Shared As Single direc
 
[[File:Fōrmulæ - Sierpiński curve 01.png]]
Sub Dibuja(largo As Integer)
posX += Fix(largo * Cos(direc))
posY -= Fix(largo * Sin(direc))
Line - (posX, posY), yellow
End Sub
 
'''Test cases'''
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
 
[[File:Fōrmulæ - Sierpiński curve 02.png]]
Screenres 640, 480, 32
 
[[File:Fōrmulæ - Sierpiński curve 03.png]]
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)
 
=== L-system ===
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
 
There are generic functions written in Fōrmulæ to compute an L-system in the page [[L-system#Fōrmulæ | L-system]].
Windowtitle "Hit any key to end program"
 
Sleep</syntaxhighlight>
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,665 ⟶ 1,963:
{{trans|Go}}
{{libheader|DOME}}
<syntaxhighlight lang="ecmascriptwren">import "graphics" for Canvas, Color
import "dome" for Window
 
Line 1,794 ⟶ 2,092:
 
var Game = SierpinskiCurve.new(770, 770, 5, Color.blue, Color.yellow)</syntaxhighlight>
 
{{out}}
[[File:Wren-Sierpinski_curve.png|400px]]
 
=={{header|XPL0}}==
Line 1,833 ⟶ 2,134:
];
]</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|zkl}}==
Christophoro S
511

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/354099...364059"