Code: (Select All)

Option _Explicit
_Title "Mandala Life trans from sb" 'b+ 2023-01-15
'Mandala life.bas SmallBASIC (not MS) B+ for Bpf 2015-03-25
Screen _NewImage(600, 600, 12)
Dim As Long an, s, bigblock, g, x, y, pc, lc, cl
an = 60: s = 10: bigblock = 600: g = 0
Dim As Long a(1 To an, 1 To an), ng(1 To an, 1 To an), ls(1 To an, 1 To an)
Dim r$

While _KeyDown(27) = 0
    'If g Mod 2 = 0 Then ' keep a pulsing border
    For x = 1 To an
        a(x, 1) = 1: a(x, an) = 1: a(1, x) = 1: a(an, x) = 1
    Next
    'End If
    For x = 2 To an - 1
        For y = 2 To an - 1
            pc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
            ls(x, y) = pc: r$ = _Trim$(Str$(pc))
            If a(x, y) Then
                If InStr("2346", r$) Then ng(x, y) = 1 Else ng(x, y) = 0
            Else 'birth?
                If InStr("34", r$) Then ng(x, y) = 1 Else ng(x, y) = 0
            End If
        Next
    Next
    Line (1, 1)-(bigblock, bigblock), 15, BF
    For y = 1 To an
        For x = 1 To an
            If a(x, y) Then
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), 0, BF
            Else
                lc = ls(x, y)
                Select Case lc
                    Case 0: cl = 15 'br white
                    Case 1: cl = 11 'cyan
                    Case 2: cl = 7 'low white, br gray
                    Case 3: cl = 10 'light green
                    Case 4: cl = 9 'blue
                    Case 5: cl = 13 'violet
                    Case 6: cl = 12 'br red
                    Case 7: cl = 4 'dark red
                    Case 8: cl = 1 'indigo
                End Select
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), cl, BF
            End If
        Next
    Next
    For y = 1 To an
        For x = 1 To an
            a(x, y) = ng(x, y)
        Next
    Next
    g = g + 1
    If g > 60 Then _Delay .25

Wend

   

Quote:Update: This runs in QBJS but it is slow compared to QB64pe straight up, also modified to work in QBJS

Code: (Select All)

_Title "Digital Plasmatic Clock   press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.

Const xmax = 850, ymax = 200, sq = 25
Const dat = "1110111000001101111100011111100101110111011101101001001111111111011011"

Type xy
    x As Single
    y As Single
    dx As Single
    dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40

Dim c(360) As _Unsigned Long, p(6) As xy, f(6)
restart:
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To 5
    r1 = r: g1 = g: b1 = b
    Do: r = Rnd: Loop Until Abs(r - r1) > .2
    Do: g = Rnd: Loop Until Abs(g - g1) > .2
    Do: b = Rnd: Loop Until Abs(g - g1) > .2
    For m = 0 To 17: m1 = 17 - m
        f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
    For m = 0 To 17: m1 = 17 - m
        f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
    Next
Next

For n = 0 To 5
    p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
    f(n) = Rnd * .1
Next

While _KeyDown(27) = 0
    If InKey$ = " " Then GoTo restart
    For i = 0 To 5
        p(i).x = p(i).x + p(i).dx
        If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
        p(i).y = p(i).y + p(i).dy
        If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
    Next
    For y = 0 To ymax - 1 Step 2
        For x = 0 To xmax - 1 Step 2
            d = 0
            For n = 0 To 5
                dx = x - p(n).x: dy = y - p(n).y
                k = Sqr(dx * dx + dy * dy)
                d = d + (Sin(k * f(n)) + 1) / 2
            Next n: d = d * 60
            Line (x, y)-Step(2, 2), c(d), BF
        Next
    Next
    For j = 1 To 3
        If j = 1 Then
            c~& = &HFFFFFFFF: offset = -2
        ElseIf j = 2 Then
            c~& = &HFF555555: offset = 2
        Else
            c~& = &HFFAAAAAA: offset = 0
        End If
        For n = 1 To 8 'clock digits over background
            If Mid$(Time$, n, 1) = ":" Then
                Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + sq + offset)-Step(sq, sq), c~&, BF
                Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + 4 * sq + offset)-Step(sq, sq), c~&, BF
            Else
                drawC (n - 1) * 4 * sq + sq + offset, sq + offset, Mid$(dat$, Val(Mid$(Time$, n, 1)) * 7 + 1, 7), c~&
            End If
        Next
    Next
    _Display
Wend

Function rgbf~& (n1, n2, n3)
    rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function

Sub drawC (x, y, c$, c As _Unsigned Long)
    For m = 1 To 7
        If Val(Mid$(c$, m, 1)) Then
            Select Case m
                Case 1: Line (x, y)-Step(sq, 3 * sq), c, BF
                Case 2: Line (x, y + 2 * sq)-Step(sq, 4 * sq), c, BF
                Case 3: Line (x, y)-Step(3 * sq, sq), c, BF
                Case 4: Line (x, y + 2 * sq)-Step(3 * sq, sq), c, BF
                Case 5: Line (x, y + 5 * sq)-Step(3 * sq, sq), c, BF
                Case 6: Line (x + 2 * sq, y)-Step(sq, 3 * sq), c, BF
                Case 7: Line (x + 2 * sq, y + 2 * sq)-Step(sq, 4 * sq), c, BF
            End Select
        End If
    Next
End Sub