Option _Explicit

_ControlChr Off



Const true = -1, false = 0



Dim ruleValue As _Unsigned _Byte

Dim Shared ruleSet$

Dim nav$, newValue$

Dim As Long w, total, i, x, y, k

Dim As _Byte l, r, state, newState, firstTime, done

Dim As _Unsigned Long c

Dim As _MEM m1, m2



firstTime = true

ruleValue = 99

w = 2



'setup

Screen _NewImage(1000, 800, 32)

_Display

Color _RGB32(0), _RGB32(255)

total = _Width / w



'main loop

Do

    ruleSet$ = Right$(String$(8, "0") + _Bin$(ruleValue), 8)

    ReDim As _Byte cells(total - 1), nextCells(total - 1)

    cells(Int(total / 2)) = 1

    y = _FontHeight

    Cls



    'draw loop

    Do

        For i = 0 To total - 1

            x = i * w

            If cells(i) Then

                If x < _Width / 2 Then

                    c = _RGB32(map(x, 0, _Width / 2, 200, 0))

                Else

                    c = _RGB32(map(x, _Width / 2, _Width, 0, 200))

                End If

            Else

                _Continue

            End If

            Line (x, y)-Step(w, w), c, BF

        Next



        y = y + w

        If y > _Height Then Exit Do



        'calculate next generation

        For i = 0 To total - 1

            l = cells((i - 1 + total) Mod total)

            r = cells((i + 1) Mod total)

            state = cells(i)

            newState = calculateState(l, state, r)

            nextCells(i) = newState

        Next



        m1 = _Mem(cells())

        m2 = _Mem(nextCells())

        _MemCopy m2, m2.OFFSET, m2.SIZE To m1, m1.OFFSET

    Loop



    If ruleValue > 0 Then nav$ = Chr$(27) + " " Else nav$ = Space$(2)

    nav$ = nav$ + "Rule " + Right$(String$(3, "0") + _Trim$(Str$(ruleValue)), 3)

    If ruleValue < 255 Then nav$ = nav$ + " " + Chr$(26)

    nav$ = nav$ + "; w =" + Str$(w)

    _PrintString (_Width / 2 - _PrintWidth(nav$) / 2, 0), nav$

    If firstTime Then

        Locate 3, 1

        Print "use left/right arrows to change rule set or"

        Print "enter a rule number directly (0-255);"

        Print "up/down arrows to change box width."

        firstTime = false

    End If



    _Display

    _KeyClear

    done = false

    Do

        k = _KeyHit

        Select Case k

            Case 27: System

            Case 19200: If ruleValue > 0 Then ruleValue = ruleValue - 1: Exit Do

            Case 19712: If ruleValue < 255 Then ruleValue = ruleValue + 1: Exit Do

            Case 18432: w = w + 2: total = _Width / w: Exit Do

            Case 20480: If w > 2 Then w = w - 2: total = _Width / w: Exit Do

            Case 13, 48 To 57

                'insert mode

                If k > 13 Then newValue$ = Chr$(k) Else newValue$ = ""

                _KeyClear

                Do

                    Locate 2, 1

                    Print "Enter new rule (0-255): "; newValue$; "_ ";

                    _Display

                    k = _KeyHit

                    Select Case k

                        Case 48 To 57

                            newValue$ = newValue$ + Chr$(k)

                        Case 8

                            If Len(newValue$) Then newValue$ = Left$(newValue$, Len(newValue$) - 1)

                        Case 13

                            If Val(newValue$) >= 0 And Val(newValue$) <= 255 Then

                                ruleValue = Val(newValue$)

                                done = true

                                Exit Do

                            Else

                                Beep

                            End If

                        Case 27

                            done = true

                            Exit Do

                    End Select

                    _Limit 30

                Loop

        End Select

        _Limit 30

    Loop Until done

Loop



Function calculateState%% (a As _Byte, b As _Byte, c As _Byte)

    Dim neighborhood$

    Dim value As _Byte



    neighborhood$ = _Trim$(Str$(a)) + _Trim$(Str$(b)) + _Trim$(Str$(c))

    value = 8 - Val("&B" + neighborhood$)

    calculateState%% = Val(Mid$(ruleSet$, value, 1))

End Function



Function map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)

    map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!

End Function

(01-13-2024, 05:48 AM)Sprezzo Wrote: Look who it is. You lost weight.