RosettaCodeData/Task/Wireworld/FreeBASIC/wireworld.basic

71 lines
2.1 KiB
Plaintext

#define MAXX 319
#define MAXY 199
enum state
E=0, C=8, H=9, T=4 'doubles as colours: black, grey, bright blue, red
end enum
dim as uinteger world(0 to 1, 0 to MAXX, 0 to MAXY), active = 0, buffer = 1
dim as double rate = 1./3. 'seconds per frame
dim as double tick
dim as uinteger x, y
function turn_on( world() as unsigned integer, x as uinteger, y as uinteger, a as uinteger ) as boolean
dim as ubyte n = 0
dim as integer qx, qy
for qx = -1 to 1
for qy = -1 to 1
if qx=0 andalso qy=0 then continue for
if world(a,(x+qx+MAXX+1) mod (MAXX+1), (y+qy+MAXY+1) mod (MAXY+1))=H then n=n+1 'handles wrap-around
next qy
next qx
if n=1 then return true
if n=2 then return true
return false
end function
'generate sample map
for x=20 to 30
world(active, x, 20) = C
world(active, x, 24) = C
next x
world(active, 24, 24 ) = E
world(active, 20, 21 ) = C
world(active, 20, 23 ) = C
world(active, 24, 21 ) = C
world(active, 23, 22 ) = C
world(active, 24, 22 ) = C
world(active, 25, 22 ) = C
world(active, 24, 23 ) = C
world(active, 20, 20 ) = T
world(active, 21, 20 ) = H
world(active, 21, 24 ) = T
world(active, 20, 24 ) = H
screen 12
do
tick = timer
for x = 0 to 319
for y = 0 to 199
pset (x,y), world(active, x, y)
if world(active,x,y) = E then world(buffer,x,y) = E 'empty cells stay empty
if world(active,x,y) = H then world(buffer,x,y) = T 'electron heads turn into electron tails
if world(active,x,y) = T then world(buffer,x,y) = C 'electron tails revert to conductors
if world(active,x,y) = C then
if turn_on(world(),x,y,active) then
world(buffer,x,y) = H 'maybe electron heads spread
else
world(buffer,x,y) = C 'otherwise condutor remains conductor
end if
end if
next y
next x
while tick + rate > timer
wend
cls
buffer = 1 - buffer
active = 1 - buffer
loop