Sierpinski square curve: Difference between revisions

(→‎{{header|Wren}}: Added image)
(8 intermediate revisions by 5 users not shown)
Line 13:
V angle = 0.0
 
V outfile = File(fname, ‘w’WRITE)
outfile.write(‘<svg xmlns='http://www.w3.org/2000/svg' width='’size‘' height='’size"'>\n")
outfile.write("<rect width='100%' height='100%' fill='white'/>\n")
Line 39:
{{out}}
Output is similar to C++.
 
=={{header|ALGOL 68}}==
Generates an SVG file. The SVG generating code is translated from the FreeBASIC sample (which is a translation of the 11l sample which is translated from the C++). Uses the Algol 68 library for L-System related Tasks on Rosetta Code.
{{libheader|ALGOL 68-l-system}}
Note: The source of the Algol 68 L-System library is available on a separate page on Rosetta Code - see the above link and follow the link to the Talk (Discussion) page.
<syntaxhighlight lang="algol68">
BEGIN # Sierpinski Square Curve in SVG - SVG generation translated from the #
# FreeBASIC sample (which is a translation of C++) #
# uses the RC Algol 68 L-System library for the L-System evaluation & #
# interpretation #
 
PR read "lsystem.incl.a68" PR # include L-System utilities #
 
PROC sierpinski square curve = ( STRING fname, INT size, length, order )VOID:
IF FILE svg file;
BOOL open error := IF open( svg file, fname, stand out channel ) = 0
THEN
# opened OK - file already exists and #
# will be overwritten #
FALSE
ELSE
# failed to open the file #
# - try creating a new file #
establish( svg file, fname, stand out channel ) /= 0
FI;
open error
THEN # failed to open the file #
print( ( "Unable to open ", fname, newline ) );
stop
ELSE # file opened OK #
 
REAL x := ( size - length ) / 2;
REAL y := length;
INT angle := 0;
put( svg file, ( "<svg xmlns='http://www.w3.org/2000/svg' width='"
, whole( size, 0 ), "' height='", whole( size, 0 ), "'>"
, newline, "<rect width='100%' height='100%' fill='white'/>"
, newline, "<path stroke-width='1' stroke='black' fill='none' d='"
, newline, "M", whole( x, 0 ), ",", whole( y, 0 ), newline
)
);
 
LSYSTEM ssc = ( "F+XF+F+XF"
, ( "X" -> "XF-F+F-XF+F+XF-F+F-X"
)
);
STRING curve = ssc EVAL order;
curve INTERPRET ( ( CHAR c )VOID:
IF c = "F" THEN
x +:= length * cos( angle * pi / 180 );
y +:= length * sin( angle * pi / 180 );
put( svg file, ( " L", whole( x, 0 ), ",", whole( y, 0 ), newline ) )
ELIF c = "+" THEN
angle +:= 90 MODAB 360
ELIF c = "-" THEN
angle +:= 270 MODAB 360
FI
);
put( svg file, ( "'/>", newline, "</svg>", newline ) );
close( svg file )
FI # sierpinski square # ;
 
sierpinski square curve( "sierpinski_square.svg", 635, 5, 5 )
 
END
</syntaxhighlight>
{{out}}
Similar to FreeBasic, 11l, C++, etc.
 
=={{header|ALGOL W}}==
Draws an ASCII art Sierpinski square curve. For orders greater than 6, the value of CANVAS_WIDTH must be increased.<br>
The resolution of the canvas is, of course fairly small, so for orders > 4, to avoid the curve overwriting itself, the connecting lines between the segments of the curve are made longer.
<syntaxhighlight lang="algolw">
begin % draw a Sierpinski curve 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
asciiX := asciiX + 1;
canvas( asciiX, asciiY ) := "_";
updateCoordinateRange;
end
else if heading = 90 then begin
updateCoordinateRange;
canvas( asciiX, asciiY ) := "|";
asciiY := asciiY - 1;
end
else if heading = 180 then begin
asciiX := asciiX - 1;
canvas( asciiX, asciiY ) := "_";
updateCoordinateRange;
end
else if heading = 270 then begin
asciiY := asciiY + 1;
updateCoordinateRange;
canvas( asciiX - 1, asciiY ) := "|";
end if_various_headings
end drawLine ;
% changes the heading by the specified angle ( in degrees ) - angle must be +/- 90 %
% the position is updated, if necessary as the horizontal lines are at the bottom %
% of a character but the vertical lines are in the middle pf a character %
procedure turn( integer value angle ) ;
begin
integer prevHeading;
prevHeading := heading;
heading := heading + angle;
while heading < 0 do heading := heading + 360;
heading := heading rem 360;
if heading = 0 and prevHeading = 270 then asciiX := asciiX - 1
else if heading = 90 then begin
if prevHeading = 180 then asciiX := asciiX - 1
else if prevHeading = 0 then asciiX := asciiX + 1
end
else if heading = 180 and prevHeading = 270 then asciiX := asciiX - 1
else if heading = 270 and prevHeading = 0 then asciiX := asciiX + 2
end turn ;
% initialises the ascii art canvas %
procedure initArt ( integer value initHeading ) ;
begin
heading := initHeading;;
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 square curve of the specified order %
procedure sierpinskiSquareCurve( integer value order ) ;
begin
% draw a line connecting segments %
procedure extendedLine ;
if actualOrder > 4 then begin
% for higher orders, the segments can touch %
% so space the segments further apart %
if heading rem 180 = 0 then drawline( 1 );
drawline( 1 );
drawline( 1 )
end extendedLine ;
% draw a corner of an element of the curve %
procedure corner ;
begin
drawline( 1 );
turn( - 90 );
drawline( 1 )
end corner ;
% recursively draws a part of a sierpinski square curve %
procedure subCurve( integer value order; logical value threeSubCurves ) ;
begin
corner;
turn( + 90 );
drawline( 1 );
if order < 1 then begin
turn( - 90 );
drawline( 1 );
turn( - 90 )
end
else begin
extendedLine;;
turn( + 90 );
curve( order, threeSubCurves );
turn( + 90 );
extendedLine
end if_order_lt_1 ;
drawline( 1 );
turn( + 90 )
end subCurve;
% recursively draws a segment of the sierpinski curve %
procedure curve( integer value order; logical value threeSubCurves ) ;
begin
subCurve( if threeSubCurves then order - 1 else 0, not threeSubCurves );
subCurve( order - 1, not threeSubCurves );
subCurve( if threeSubCurves then order - 1 else 0, not threeSubCurves );
corner
end curve ;
integer actualOrder;
actualOrder := order;
if order = 1 then begin
for c := 1 until 4 do corner
end
else if order = 2 then begin
for c := 1 until 4 do subCurve( 0, false )
end
else begin
for c := 1 until 4 do subCurve( ( 2 * order ) - 5, false )
end if_order_eq_1__2__
end sierpinskiSquareCurve ;
% draw curves %
begin
integer order;
i_w := 1; s_w := 0; % set output formatting %
write( "order> " );
read( order );
write( "Sierpinski curve of order ", order );
write( "===========================" );
write();
initArt( 0 );
sierpinskiSquareCurve( order );
drawArt
end
end
end.
</syntaxhighlight>
{{out}}
<pre>
order> 4
 
Sierpinski square curve of order 4
==================================
 
_
_| |_
_| |_
|_ _|
_ |_ _| _
_| |_ _| |_ _| |_
_| |_| |_| |_
|_ _ _ _|
_ |_ _| |_ _| |_ _| _
_| |_ |_| _| |_ |_| _| |_
_| |_ _| |_ _| |_
|_ _| |_ _| |_ _|
_ |_ _| _ |_ _| _ |_ _| _
_| |_ _| |_ _| |_ _| |_ _| |_ _| |_ _| |_
_| |_| |_| |_| |_| |_| |_| |_
|_ _ _ _ _ _ _ _|
|_ _| |_ _| |_ _| |_ _| |_ _| |_ _| |_ _|
|_| _| |_ |_| _| |_ |_| _| |_ |_|
_| |_ _| |_ _| |_
|_ _| |_ _| |_ _|
|_ _| _ |_ _| _ |_ _|
|_| _| |_ _| |_ _| |_ |_|
_| |_| |_| |_
|_ _ _ _|
|_ _| |_ _| |_ _|
|_| _| |_ |_|
_| |_
|_ _|
|_ _|
|_|
</pre>
 
=={{header|C++}}==
Line 125 ⟶ 393:
{{out}}
[[Media:Sierpinski_square_cpp.svg]]
 
=={{header|EasyLang}}==
[https://easylang.online/show/#cod=jZK9bsMgFIV3nuIIWR2KjOw2HTKw+hkiRR6oQxJUgi1wE+ftq1sbJ3EzdEFwz8f9ObpdaBu4eI1m6ODM2ThI6MG2pwzh25mYbWtIBmDfBjj07UhRBID2GRQ4n57ENBmsR+xDc9QhTrkmfUIsFErE3nR4GzP6udiNBGD3KW5rKDTZgwpQMTUjECjrJfEZjP5C+RCW7NmVZnm5K5KkeNFdskT7X1Uyybrk3C7oS9IHXKH9Ac4fIMcMznpzsbv+iEK+U+DUng2B7B+G2f04Iq/4rdEBQqFpI3Y24JVq3bQradH6Zxp1kgoDMG7Ont9lp4+5oin+cmLBiXtOJmcmL6hrsakEHZzNy6SwBd9w8E2VV6LKJ2K8c9QsbeNquYds6fZHgbLAukApV4z9AA== 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"
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-F+F-XF+F+XF-F+F-X" ]
lsysexp 4 axiom$ rules$[]
lsysdraw axiom$ 50 10 90 1.4
</syntaxhighlight>
 
=={{header|Factor}}==
Line 173 ⟶ 481:
| x || iterate L-system
|}
 
=={{header|FreeBASIC}}==
{{trans|11l}}
Output is a file in SVG format.
<syntaxhighlight lang="vbnet">#define pi 4 * Atn(1)
 
Sub sierpinski_square(fname As String, size As Integer, length As Integer, order As Integer)
Dim As Single x = (size - length) / 2
Dim As Single y = length
Dim As Single angle = 0.0
Dim As Integer i, j
Dim As String t, s = "F+XF+F+XF"
For i = 1 To order
t = ""
For j = 1 To Len(s)
Select Case Mid(s, j, 1)
Case "X"
t += "XF-F+F-XF+F+XF-F+F-X"
Case Else
t += Mid(s, j, 1)
End Select
Next j
s = t
Next i
Open fname For Output As #1
Print #1, "<svg xmlns='http://www.w3.org/2000/svg' width='" ; size ; "' height='" ; size ; "'>"
Print #1, "<rect width='100%' height='100%' fill='white'/>"
Print #1, "<path stroke-width='1' stroke='black' fill='none' d='";
Print #1, "M" ; x ; "," ; y;
For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case "F"
x += length * Cos(angle * pi / 180)
y += length * Sin(angle * pi / 180)
Print #1, " L" ; x ; "," ; y;
Case "+"
angle = (angle + 90) Mod 360
Case "-"
angle = (angle - 90 + 360) Mod 360
End Select
Next i
Print #1, "'/>"
Print #1, "</svg>"
Close #1
End Sub
 
sierpinski_square("sierpinski_square.svg", 635, 5, 5)
Windowtitle "Hit any key to end program"</syntaxhighlight>
{{out}}
<pre>Output is similar to C++.</pre>
 
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/L-system}}
 
'''Solution'''
 
It can be done using an [[wp:L-system|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's square curve is:
 
[[File:Fōrmulæ - L-system - Sierpiński's square curve 01.png]]
 
[[File:Fōrmulæ - L-system - Sierpiński's square curve 02.png]]
 
=={{header|Go}}==
3,021

edits