Rosetta Code

Sierpinski curve: Difference between revisions

Page Discussion

Sierpinski curve (view source)

Revision as of 21:09, 28 April 2024

12,245 bytes added ,  20 days ago
→‎{{header|BASIC}}: Added QuickBASIC.
m (Uploaded C++ output file)
(→‎{{header|BASIC}}: Added QuickBASIC.)
(18 intermediate revisions by 11 users not shown)
Line 4:
 
Produce a graphical or ASCII-art representation of a [[wp:Sierpiński_curve|Sierpinski curve]] of at least order 3.
 
=={{header|11l}}==
{{trans|C++}}
 
<syntaxhighlight lang="11l">T SierpinskiCurve
. Float x, y
. Int angle, length
 
. F line(out)
V theta = radians(Float(.angle))
.x += .length * cos(theta)
.y -= .length * sin(theta)
out.write(‘ L’gconvfmt(.x)‘,’gconvfmt(.y))
 
. F execute(out, s)
out.write(‘M’gconvfmt(.x)‘,’gconvfmt(.y))
L(c) s
S c
‘F’, ‘G’
.line(out)
‘+’
.angle = (.angle + 45) % 360
‘-’
.angle = (.angle - 45) % 360
 
. F :rewrite(s)
V t = ‘’
L(c) s
I c == ‘X’
t ‘’= ‘XF+G+XF--F--XF+G+X’
E
t ‘’= c
R t
 
F write(out, size, length, order)
.length = length
.x = length / sqrt(2)
.y = .x * 2
.angle = 45
out.write(‘<svg xmlns='http://www.w3.org/2000/svg' width='’size‘' height='’size"'>\n")
out.write("<rect width='100%' height='100%' fill='white'/>\n")
out.write(‘<path stroke-width='1' stroke='black' fill='none' d='’)
V s = ‘F--XF--F--XF’
L 0 .< order
s = .:rewrite(s)
.execute(out, s)
out.write("'/>\n</svg>\n")
 
V out = File(‘sierpinski_curve.svg’, WRITE)
SierpinskiCurve().write(out, 545, 7, 5)</syntaxhighlight>
 
{{out}}
Same as C++ output.
 
=={{header|Action!}}==
Line 172 ⟶ 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 332 ⟶ 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 419 ⟶ 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 468 ⟶ 843:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Sierpi%C5%84ski_curve}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
=== Recursive ===
In '''[https://formulae.org/?example=Sierpi%C5%84ski_curve this]''' page you can see the program(s) related to this task and their results.
 
[[File:Fōrmulæ - Sierpiński curve 01.png]]
 
'''Test cases'''
 
[[File:Fōrmulæ - Sierpiński curve 02.png]]
 
[[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 692 ⟶ 1,085:
 
{{out}}
[[Media:Sierpinski_curve_java.svg]]
See: [https://slack-files.com/T0CNUL56D-F016J6Q8W78-4a6e0291c9 sierpinski_curve.svg] (offsite SVG image)
 
=={{header|jq}}==
Line 803 ⟶ 1,196:
preview()
</syntaxhighlight>
[[File:sierpinski-curve--drawing.png]]
===LSystem version===
<syntaxhighlight lang="julia">using Lindenmayer # https://github.com/cormullion/Lindenmayer.jl
Line 1,365 ⟶ 1,759:
5 times expand
 
turtle 1 8 turn
[ $ "turtleduck.qky" loadfile ] now!
[ stack ] is switch.arg ( --> [ )
[ switch.arg put ] is switch ( x --> )
[ switch.arg release ] is otherwise ( --> )
[ switch.arg share
!= iff ]else[ done
otherwise ]'[ do ]done[ ] is case ( x --> )
[ $ "" swap witheach
[ nested quackery join ] ] is expand ( $ --> $ )
[ $ "L" ] is L ( $ --> $ )
[ $ "R" ] is R ( $ --> $ )
[ $ "F" ] is F ( $ --> $ )
 
[ $ "G" ] is G ( $ --> $ )
[ $ "AFLGLAFRRFRRAFLGLA" ] is A ( $ --> $ )
$ "FRRAFRRFRRAF"
4 times expand
turtle
10 frames
1 8 turn
witheach
[ switch
Line 1,372 ⟶ 1,798:
char A case [ ( ignore ) ]
otherwise [ 5 1 walk ] ] ]
-1 8 turn</syntaxhighlight>
1 frames</syntaxhighlight>
 
{{output}}
 
[[File:Quackery Sierpinski curve.png]]
https://imgur.com/bDBjJzb
 
=={{header|Raku}}==
Line 1,510 ⟶ 1,937:
 
{{out}}
[[Media:Sierpinski_curve_rust.svg]]
See: [https://slack-files.com/T0CNUL56D-F016A6G6Q5D-9e16463547 sierpinski_curve.svg] (offsite SVG image)
 
=={{header|Sidef}}==
Line 1,536 ⟶ 1,963:
{{trans|Go}}
{{libheader|DOME}}
<syntaxhighlight lang="ecmascriptwren">import "graphics" for Canvas, Color
import "dome" for Window
 
Line 1,666 ⟶ 2,093:
var Game = SierpinskiCurve.new(770, 770, 5, Color.blue, Color.yellow)</syntaxhighlight>
 
{{out}}
=={{header|Yabasic}}==
[[File:Wren-Sierpinski_curve.png|400px]]
<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
 
=={{header|XPL0}}==
import turtle
[[File:SierpenXPL0.gif|200px|thumb|right]]
<syntaxhighlight lang "XPL0">int PosX, PosY;
sub Sierp(n, a, h, k)
real Dir;
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
 
proc Draw(Len);
sub Sierpinski(n, d)
real Len;
local i
[PosX:= PosX + fix(Len*Cos(Dir));
PosY:= PosY - fix(Len*Sin(Dir));
pen(false)
Line(PosX, PosY, $E \yellow\);
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
 
proc Curve(Lev, Ang, Len1, Len2);
startTurtle()
int Lev; real Ang, Len1, Len2;
Sierpinski(9, 12) </syntaxhighlight>
[if Lev # 0 then
[Dir:= Dir + Ang;
Curve(Lev-1, -Ang, Len1, Len2);
Dir:= Dir - Ang;
Draw(Len1);
Dir:= Dir - Ang;
Curve(Lev-1, -Ang, Len1, Len2);
Dir:= Dir + Ang;
];
];
 
def Order=3, Pi=3.141592654, Ang45=Pi/4.0, Size=20.;
int Quad;
[SetVid($12); \VGA graphics: 640x480x8
PosX:= 640/4; PosY:= 3*480/4;
Move(PosX, PosY);
Dir:= 0.;
for Quad:= 1 to 4 do
[Curve(Order*2, Ang45, Size/Sqrt(2.), 5.*Size/6.);
Dir:= Dir + Ang45;
Draw(Size/Sqrt(2.));
Dir:= Dir + Ang45;
];
]</syntaxhighlight>
 
=={{header|zkl}}==
Christophoro S
511

edits

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