Sierpinsky in Space
Code: (Select All)
_Title "Sierpinski in Space" 'b+ 2025-02-07 ported from:
'Sierpinski in Space.bas SmallBASIC 0.12.6 [B+=MGA] 2016-05-28
'From screen saver number 1.bas 2016-02-11 SmallBASIC 0.12.0 [B+=MGA]
'this version replaces solid triangle with Sierpinski line traingles.
Randomize Timer
Const XMax = 1200, YMax = 700
Screen _NewImage(XMax, YMax, 32): _FullScreen
Const xtop = XMax + 100
Const ytop = YMax + 100
Type tri
As Single x1, x2, x3, y1, y2, y3, dx1, dx2, dx3, dy1, dy2, dy3
As _Unsigned Long c
End Type
restart:
ntri = rand%(1, 5)
ReDim t(ntri) As tri 'setup new set of triangles
For i = 1 To ntri
t(i).x1 = rand%(-100, xtop): t(i).x2 = rand%(-100, xtop): t(i).x3 = rand%(-100, xtop)
t(i).y1 = rand%(-100, ytop): t(i).y2 = rand%(-100, ytop): t(i).y3 = rand%(-100, ytop)
t(i).dx1 = rand%(0, 10) * rdir: t(i).dx2 = rand%(0, 10) * rdir: t(i).dx3 = rand%(0, 10) * rdir
t(i).dy1 = rand%(0, 10) * rdir: t(i).dy2 = rand%(0, 10) * rdir: t(i).dy3 = rand%(0, 10) * rdir
t(i).c = _RGB32(rand%(55, 255) * rand%(0, 1), rand%(55, 255) * rand%(0, 1), rand%(55, 255) * rand%(0, 1))
If t(i).c = 0 Then t(i).c = _RGB32(rand%(60, 255), rand%(60, 255), rand%(60, 255))
Next
For count = 1 To 500
If _KeyDown(27) Then End
If Len(InKey$) Then GoTo restart
Cls
For i = 1 To ntri
Color t(i).c
SierLineTri t(i).x1, t(i).y1, t(i).x2, t(i).y2, t(i).x3, t(i).y3, 0
t(i).x1 = t(i).x1 + t(i).dx1
If t(i).x1 < -100 Then t(i).dx1 = t(i).dx1 * -1
If t(i).x1 > xtop Then t(i).dx1 = t(i).dx1 * -1
t(i).x2 = t(i).x2 + t(i).dx2
If t(i).x2 < -100 Then t(i).dx2 = t(i).dx2 * -1
If t(i).x2 > xtop Then t(i).dx2 = t(i).dx2 * -1
t(i).x3 = t(i).x3 + t(i).dx3
If t(i).x3 < -100 Then t(i).dx3 = t(i).dx3 * -1
If t(i).x3 > xtop Then t(i).dx3 = t(i).dx3 * -1
t(i).y1 = t(i).y1 + t(i).dy1
If t(i).y1 < -100 Then t(i).dy1 = t(i).dy1 * -1
If t(i).y1 > ytop Then t(i).dy1 = t(i).dy1 * -1
t(i).y2 = t(i).y2 + t(i).dy2
If t(i).y2 < -100 Then t(i).dy2 = t(i).dy2 * -1
If t(i).y2 > ytop Then t(i).dy2 = t(i).dy2 * -1
t(i).y3 = t(i).y3 + t(i).dy3
If t(i).y3 < -100 Then t(i).dy3 = t(i).dy3 * -1
If t(i).y3 > ytop Then t(i).dy3 = t(i).dy3 * -1
Next
_Display
_Limit 15
Next
GoTo restart
'Given 3 points of a triangle draw the Sierpinsky traiangle
'within from the midpoints of each line forming the outer
'triangle. This is the basic Sierpinski Unit that is repeated
'at greater depths.
Sub SierLineTri (x1, y1, x2, y2, x3, y3, depth)
If depth = 0 Then 'draw out triangle if level 0
Line (x1, y1)-(x2, y2)
Line (x2, y2)-(x3, y3)
Line (x1, y1)-(x3, y3)
End If
'find midpoints
If x2 < x1 Then mx1 = (x1 - x2) / 2 + x2 Else mx1 = (x2 - x1) / 2 + x1
If y2 < y1 Then my1 = (y1 - y2) / 2 + y2 Else my1 = (y2 - y1) / 2 + y1
If x3 < x2 Then mx2 = (x2 - x3) / 2 + x3 Else mx2 = (x3 - x2) / 2 + x2
If y3 < y2 Then my2 = (y2 - y3) / 2 + y3 Else my2 = (y3 - y2) / 2 + y2
If x3 < x1 Then mx3 = (x1 - x3) / 2 + x3 Else mx3 = (x3 - x1) / 2 + x1
If y3 < y1 Then my3 = (y1 - y3) / 2 + y3 Else my3 = (y3 - y1) / 2 + y1
Line (mx1, my1)-(mx2, my2) ' 'draw all inner triangles
Line (mx2, my2)-(mx3, my3)
Line (mx1, my1)-(mx3, my3)
If depth < 5 Then 'not done so call me again
SierLineTri x1, y1, mx1, my1, mx3, my3, depth + 1
SierLineTri x2, y2, mx1, my1, mx2, my2, depth + 1
SierLineTri x3, y3, mx3, my3, mx2, my2, depth + 1
End If
End Sub
Function rdir
If Rnd < .5 Then rdir = 1 Else rdir = -1
End Function
Function rand% (lo, hi)
rand% = (Rnd * (hi - lo + 1)) \ 1 + lo
End Function
Spacebar will reset triangle set number and colors.
b = b + ...