RosettaCodeData/Task/Sierpinski-carpet/FreeBASIC/sierpinski-carpet-2.basic
2023-07-01 13:44:08 -04:00

33 lines
1 KiB
Text

Screenres 500, 545, 8
Windowtitle "Sierpinski Carpet"
Cls
Color 1, 15
Sub carpet (x As Integer, y As Integer, size As Integer, order As Integer)
Dim As Integer ix, iy, isize, iorder, side, newX, newY
ix = x: iy = y: isize = size: iorder = order
Line (ix, iy)-(ix + isize - 1, iy + isize - 1), 1, BF
side = Int(isize / 3)
newX = ix + side
newY = iy + side
Line (newX, newY)-(newX + side - 1, newY + side - 1), 15, BF
iorder -= 1
If iorder >= 0 Then
carpet(newX - side, newY - side + 1, side, iorder)
carpet(newX, newY - side + 1, side, iorder)
carpet(newX + side, newY - side + 1, side, iorder)
carpet(newX + side, newY, side, iorder)
carpet(newX + side, newY + side, side, iorder)
carpet(newX, newY + side, side, iorder)
carpet(newX - side, newY + side, side, iorder)
carpet(newX - side, newY, side, iorder)
End If
End Sub
carpet(5, 20, 243, 0)
carpet(253, 20, 243, 1)
carpet(5, 293, 243, 2)
carpet(253, 293, 243, 3)
Sleep