Screen Savers

[bplus]

Sierpinski in Space

Code: (Select All)

_Title "Sierpinski in Space" ' b+ trans 2022-05-19 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
Type triangle
    As Single x1, x2, x3, y1, y2, y3, dx1, dx2, dx3, dy1, dy2, dy3
    As _Unsigned Long c
End Type
xmax = _DesktopWidth: ymax = _DesktopHeight
xtop = xmax + 100: ytop = ymax + 100

Screen _NewImage(xmax, ymax, 32)
_FullScreen

restart:
If _KeyDown(27) Then System
ntri = rand(1, 5)
ReDim t(ntri) As triangle '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).dx2 = rand(0, 10) * rdir
    t(i).dy1 = rand(0, 10) * rdir: t(i).dy2 = rand(0, 10) * rdir: t(i).dy2 = 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

While _KeyDown(27) = 0
    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 20
Wend
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)
    'local mx1, mx2, mx3, my1, my2, my3

    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