01-13-2024, 04:21 AM
Adapted from Coding Challenge 179: Elementary Cellular Automata (youtube.com)
Original javascript code: Wolfram CA / The Coding Train
More on it at Elementary Cellular Automaton -- from Wolfram MathWorld
Original javascript code: Wolfram CA / The Coding Train
More on it at Elementary Cellular Automaton -- from Wolfram MathWorld
Code: (Select All)
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
