RosettaCodeData/Task/Elementary-cellular-automaton/GFA-Basic/elementary-cellular-automat...

126 lines
2.3 KiB
Plaintext

'
' Elementary One-Dimensional Cellular Automaton
'
' World is cyclic, and rules are defined by a parameter
'
' start$="01110110101010100100" ! start state for world
' rules%=104 ! number defining rule-set to use
start$="00000000000000000000100000000000000000000"
rules%=18
max_cycles%=20 ! give a maximum depth to world
'
' Global variables hold the world, with two rows
' world! is treated as cyclical
' cur% gives the row for current world,
' new% gives the row for the next world.
'
size%=LEN(start$)
DIM world!(size%,2)
cur%=0
new%=1
clock%=0
'
@setup_world(start$)
OPENW 1
CLEARW 1
DO
@display_world
@update_world
EXIT IF @same_state
clock%=clock%+1
EXIT IF clock%>max_cycles% ! safety net
LOOP
~INP(2)
CLOSEW 1
'
' parse given string to set up initial states in world
' -- assumes world! is of correct size
'
PROCEDURE setup_world(defn$)
LOCAL i%
' clear out the array
ARRAYFILL world!(),FALSE
' for each 1 in string, set cell to true
FOR i%=1 TO LEN(defn$)
IF MID$(defn$,i%,1)="1"
world!(i%-1,0)=TRUE
ENDIF
NEXT i%
' set references to cur and new
cur%=0
new%=1
RETURN
'
' Display the world
'
PROCEDURE display_world
LOCAL i%
FOR i%=1 TO size%
IF world!(i%-1,cur%)
PRINT "#";
ELSE
PRINT ".";
ENDIF
NEXT i%
PRINT ""
RETURN
'
' Create new version of world
'
PROCEDURE update_world
LOCAL i%
FOR i%=1 TO size%
world!(i%-1,new%)=@new_state(@get_value(i%-1))
NEXT i%
' reverse cur/new
cur%=1-cur%
new%=1-new%
RETURN
'
' Test if cur/new states are the same
'
FUNCTION same_state
LOCAL i%
FOR i%=1 TO size%
IF world!(i%-1,cur%)<>world!(i%-1,new%)
RETURN FALSE
ENDIF
NEXT i%
RETURN TRUE
ENDFUNC
'
' Return new state of cell given value
'
FUNCTION new_state(value%)
RETURN BTST(rules%,value%)
ENDFUNC
'
' Compute value for cell + neighbours
'
FUNCTION get_value(cell%)
LOCAL result%
result%=0
IF cell%-1<0 ! check for wrapping at left
IF world!(size%-1,cur%)
result%=result%+4
ENDIF
ELSE ! no wrapping
IF world!(cell%-1,cur%)
result%=result%+4
ENDIF
ENDIF
IF world!(cell%,cur%)
result%=result%+2
ENDIF
IF cell%+1>size% ! check for wrapping at right
IF world!(0,cur%)
result%=result%+1
ENDIF
ELSE ! no wrapping
IF world!(cell%+1,cur%)
result%=result%+1
ENDIF
ENDIF
RETURN result%
ENDFUNC