130 lines
3.2 KiB
Plaintext
130 lines
3.2 KiB
Plaintext
WindowWidth = 840
|
|
WindowHeight = 600
|
|
|
|
dim p$( 40, 25), q$( 40, 25)
|
|
|
|
empty$ = " " ' white
|
|
tail$ = "t" ' yellow
|
|
head$ = "H" ' black
|
|
conductor$ = "." ' red
|
|
|
|
jScr = 0
|
|
|
|
nomainwin
|
|
|
|
menu #m, "File", "Load", [load], "Quit", [quit]
|
|
|
|
open "wire world" for graphics_nf_nsb as #m
|
|
#m "trapclose [quit]"
|
|
'timer 1000, [tmr]
|
|
wait
|
|
|
|
end
|
|
|
|
[quit]
|
|
close #m
|
|
end
|
|
|
|
[load]
|
|
'timer 0
|
|
filedialog "Open WireWorld File", "*.ww", file$
|
|
open file$ for input as #in
|
|
y =0
|
|
while not( eof( #in))
|
|
line input #in, lijn$
|
|
' print "|"; lijn$; "|"
|
|
for x =0 to len( lijn$) -1
|
|
p$( x, y) =mid$( lijn$, x +1, 1)
|
|
|
|
select case p$( x, y)
|
|
case " "
|
|
clr$ ="white"
|
|
case "t"
|
|
clr$ ="yellow"
|
|
case "H"
|
|
clr$ ="black"
|
|
case "."
|
|
clr$ ="red"
|
|
end select
|
|
|
|
#m "goto " ; 4 +x *20; " "; 4 +y *20
|
|
#m "backcolor "; clr$
|
|
#m "down"
|
|
#m "boxfilled "; 4 +x *20 +19; " "; 4 +y *20 +19
|
|
#m "up ; flush"
|
|
next x
|
|
y =y +1
|
|
wend
|
|
close #in
|
|
'notice "Ready to run."
|
|
timer 1000, [tmr]
|
|
wait
|
|
|
|
[tmr]
|
|
timer 0
|
|
scan
|
|
|
|
for x =0 to 40 ' copy temp array /current array
|
|
for y =0 to 25
|
|
q$( x, y) =p$( x, y)
|
|
next y
|
|
next x
|
|
|
|
for y =0 to 25
|
|
for x =0 to 40
|
|
select case q$( x, y)
|
|
case head$ ' heads ( black) become tails ( yellow)
|
|
p$( x, y ) =tail$
|
|
clr$ ="yellow"
|
|
|
|
case tail$ ' tails ( yellow) become conductors ( red)
|
|
p$( x, y ) =conductor$
|
|
clr$ ="red"
|
|
|
|
case conductor$ '
|
|
hCnt =0
|
|
|
|
xL =x -1: if xL < 0 then xL =40 ' wrap-round edges at all four sides
|
|
xR =x +1: if xR >40 then xR = 0
|
|
yA =y -1: if yA < 0 then yA =25
|
|
yB =y +1: if yB >40 then yB = 0
|
|
|
|
if q$( xL, y ) =head$ then hCnt =hCnt +1 ' Moore environment- 6 neighbours
|
|
if q$( xL, yA) =head$ then hCnt =hCnt +1 ' count all neighbours currently heads
|
|
if q$( xL, yB) =head$ then hCnt =hCnt +1
|
|
|
|
if q$( xR, y ) =head$ then hCnt =hCnt +1
|
|
if q$( xR, yA) =head$ then hCnt =hCnt +1
|
|
if q$( xR, yB) =head$ then hCnt =hCnt +1
|
|
|
|
if q$( x, yA) =head$ then hCnt =hCnt +1
|
|
if q$( x, yB) =head$ then hCnt =hCnt +1
|
|
|
|
if ( hCnt =1) or ( hCnt =2) then ' conductor ( red) becomes head ( yellow) in this case only
|
|
p$( x, y ) =head$ ' otherwise stays conductor ( red).
|
|
clr$ ="black"
|
|
else
|
|
p$( x, y ) =conductor$
|
|
clr$ ="red"
|
|
end if
|
|
|
|
case else
|
|
clr$ ="white"
|
|
end select
|
|
|
|
#m "goto " ; 4 +x *20; " "; 4 +y *20
|
|
#m "backcolor "; clr$
|
|
#m "down"
|
|
#m "boxfilled "; 4 +x *20 +19; " "; 4 +y *20 +19
|
|
#m "up"
|
|
next x
|
|
next y
|
|
#m "flush"
|
|
#m "getbmp scr 0 0 400 300"
|
|
|
|
'bmpsave "scr", "R:\scrJHF" +right$( "000" +str$( jScr), 3) +".bmp"
|
|
jScr =jScr+1
|
|
if jScr >20 then wait
|
|
timer 1000, [tmr]
|
|
wait
|