;Conway's Life: experiments by Matt Merkulov
SeedRnd MilliSecs ()
Const xres=800, yres=600, fsiz=10, cell=30
; dst - a flag of the detector of stabilization, dstperiod - the greatest distinguished(recognized) period
; Configurations, dstpasses - quantity of checks, rep - a flag of recurrences, bnd - a flag of
; restrictions of a field, visible - display of an organism to the screen, explo - a mode of
; periodic "explosion", xper - frequency of "explosion" in generations, loadorg$ -
; - loading of an organism from a file, search - a mode of search of long-livers (0 - off,
; any positive number - minimal quantity of generations for record in a file)
Const dstperiod=3, dstpasses=5, xper=256, bnd=1, visible=1
Const explo=1, xrect=150, yrect=100
; Const dst=1, search=2000, xrect=7, yrect=7
; Const dst=1, loadorg $ = "locomot.png", xrect=0, yrect=0
; Const dst=1, loadorg $ = "virus.png", xrect=0, yrect=0
Const fsiz0=1 Shl fsiz, fsiz1=fsiz0-1, fsiz2 = (fsiz0 Shl fsiz), fsiz3=fsiz2-1
Const xc = (fsiz0-xres) Shr 1, yc = (fsiz0-yres) Shr 1
Const x1 = (xres-xrect) Shr 1, x2 = ((xres+xrect) Shr 1)-1
Const y1 = (yres-yrect) Shr 1, y2 = ((yres+yrect) Shr 1)-1
Global ib, bnk, dbnk, dend, cellq
Graphics xres, yres, 32
SetFont LoadFont (" Arial cyr ", 14)
buf=CreateImage (xres, yres)
ib=ImageBuffer (buf)
bnk=CreateBank (fsiz2)
dbnk=CreateBank (fsiz2 Shl 2)
Dim neig (8)
k =-fsiz0-1
For n=0 To 7
If n=3 Then k =-1
If n=5 Then k=fsiz0-1
neig (n) =k
k=k+1 + (n=3)
Next
Dim change (64)
For n=0 To 3
Read m $
For nn=0 To 8
change (n*16+nn) =Sgn (Instr (m $, nn))
Next
Next
Data "3", "0145678"; key rules
Data "23", "0245678"; rules for "explosion"
; A file for storage of the generated organism
Dim org (xrect, yrect)
If search Then f=WriteFile ("longlife.txt")
Repeat
LockBuffer ib
dend =-4
If loadorg $ = "" Then
For x=x1 To x2
For y=y1 To y2
If Rand (0,99) <cell Then putcell x, y: org (x-x1, y-y1) =1 Else org (x-x1, y-y1) =0
Next
Next
Else
i=LoadImage (loadorg $)
ii=ImageBuffer (i)
xsiz=ImageWidth (i)
ysiz=ImageHeight (i)
xx = (xres-xsiz) Shr 1
yy = (yres-ysiz) Shr 1
For x=0 To xsiz-1
For y=0 To ysiz-1
If ReadPixel (x, y, ii) =-1 Then putcell x+xx, y+yy
Next
Next
FreeImage i
End If
; An auxiliary file of the detector of stabilization: the first value - quantity of cells
; at the previous stage, the second - the counter of concurrences quantity of cells
Dim dstcq (dstperiod, 1)
Repeat
UnlockBuffer ib
If visible Then
; To exclude blinking, we print the text not on the screen, and in the buffer
SetBuffer ib
Color 0,0,0
Rect 0,0,100,36
Color 255,255,255
Text 0,0, " FPS: " +1000.0 / (MilliSecs ()-fps)
; A conclusion kol-ва cells(cages) and generations on the screen
Text 0,12, " Cells(Cages): " +cellq
Text 0,24, " Generation: " +gen
SetBuffer FrontBuffer ()
DrawBlock buf, 0,0
End If
; The counter of generations
gen=gen+1
; "Explosion"
If explo And (gen Mod xper) =0 Then add=32 Else add=0
; The detector of stabilization
If dst Then
; A cycle on all periods
For n=2 To dstperiod
If gen Mod n=0 Then
If cellq=dstcq (n, 0) Then
; If кол-in cells(cages) coincides with former - the counter of checks increases
dstcq (n, 1) =dstcq (n, 1) +1
; If кол-in checks has reached(achieved) a limit - the organism was stabilized,
; The flag of an output(exit) joins
If dstcq (n, 1) =dstpasses Then ex=1
Else
; If кол-in cells(cages) differs - the counter is nulled
dstcq (n, 0) =cellq
dstcq (n, 1) =0
End If
End If
Next
End If
; If a flag of an output(exit) the key of a blank is included or pressed - is nulled it(him) and we leave
; From a cycle of development
If ex Or KeyHit (57) Then ex=0:Exit
fps=MilliSecs ()
LockBuffer ib
n=0
While n <=dend
pos=PeekInt (dbnk, n)
k=PeekByte (bnk, pos)
If change ((k And 31) +add) Then PokeByte bnk, pos, k Or 32
If (k And 31) =0 Then
PokeInt dbnk, n, PeekInt (dbnk, dend)
PokeByte bnk, pos, 0
dend=dend-4
Else
n=n+4
End If
Wend
n=0
dend2=dend
While n <=dend2
pos=PeekInt (dbnk, n)
k=PeekByte (bnk, pos)
If k And 32 Then
If bnd=0 Or (pos> fsiz1 And (pos And fsiz1)> 0) Then
v = (k And 16) Shr 4
If visible Then
x = (pos And fsiz1)-xc
y = (pos Shr fsiz)-yc
If x>=0 And x <xres And y>=0 And y <yres Then WritePixelFast x, y, v-1, ib
End If
v=1-(v Shl 1)
; If the cell was cleared, the counter of cells(cages) decreases on 1 if it was filled-
; Increases on 1
cellq=cellq+v
For nn=0 To 7
addr = (neig (nn) +pos) And fsiz3
p=PeekByte (bnk, addr)
If p=0 Then
dend=dend+4
PokeInt dbnk, dend, addr
PokeByte bnk, addr, 65
Else
PokeByte bnk, addr, p+v
End If
Next
PokeByte bnk, pos, k Xor 48
End If
End If
n=n+4
Wend
If KeyHit (1) Then End
Forever
; Record of a long-liver in a file
If search> 0 And search <=gen Then
WriteLine f, gen
For x=0 To xrect-1
m $ = ""
For y=0 To yrect-1
If org (x, y) Then m $ = m $ + "0" Else m $ = m $ + "-"
Next
WriteLine f, m $
Next
WriteLine f, " "
End If
; Before generation of a new organism the screen and the buffer of attributes is cleared, and also
; Counters of generations, cells(cages) and the index of a file "interesting" are nulled
; Cells
SetBuffer ib
Cls
SetBuffer FrontBuffer ()
FreeBank bnk
bnk=CreateBank (fsiz2)
gen=0
cellq=0
Forever
Function putcell (x, y)
pos=x+xc + ((y+yc) Shl fsiz)
For nn=0 To 8
addr = (neig (nn) +pos) And fsiz3
p=PeekByte (bnk, addr)
If p=0 Then
dend=dend+4
PokeInt dbnk, dend, addr
PokeByte bnk, addr, 65
Else
PokeByte bnk, addr, p+1
End If
Next
PokeByte bnk, pos, PeekByte (bnk, pos) + 15
If visible Then WritePixel x, y,-1, ib
; Increase in the counter of cells(cages) at unit
cellq=cellq+1
End Function |
