Code archives/Algorithms/"Life" on infinite field
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
From article: Infinite life (rus) Image used: | |||||
;J. H. Conway's Game of Life on nearly infinite field by Matt Merkulov ; The index and simultaneously a cell Type ptr Field nxt.ptr[3]; following indexes in hierarchy Field prev.ptr; the previous index in hierarchy Field prevpos; an arrangement of the previous index Field neig.ptr[7]; addresses of neighbours(for a cell(cage)) Field x, y, nq; coordinates and quantity(amount) of neighbours End Type ; Indexes on cells for which change of a condition is possible(probable) Type chang Field p.ptr End Type Const loadorg$="locomot.png" ; Const loadorg$="virus.png" Const xres=800, yres=600 Global cellq, scrx, scry, ib ; Breakdown of a file of indexes on 3 lists Dim pmark.ptr(3) For n=0 To 3 pmark(n)=New ptr Next Graphics xres, yres SetFont LoadFont(" Arial cyr ", 14) Dim change(24) For n=0 To 1 Read m$ For nn=0 To 8 change(n*16+nn)=Sgn(Instr(m$, nn)) Next Next Data "3", "0145678" i=CreateImage(xres, yres) ib=ImageBuffer(i) i2=LoadImage(loadorg$) ib2=ImageBuffer(i2) xsiz=ImageWidth(i2) ysiz=ImageHeight(i2) For x=0 To xsiz-1 For y=0 To ysiz-1 If ReadPixel(x, y, ib2) And 255 Then ; The first met cell - a starting point for creation of the others If cellq=0 Then cell.ptr=New ptr ptrq=ptrq+1 cell\x=400 cell\y=300 xx=x yy=y End If newborn findcell(cell, x-xx, y-yy) End If Next Next FreeImage i2 Repeat DrawBlock i, 0,0 gen=gen+1 ; The cursor of the mouse moves to the center of the screen(to not cling to edges(territories)) MoveMouse xres Sar 1, yres Sar 1 If cellq=0 Then Exit ; All the cells subject to changes, pereeshchayutsya in the list ¹2 For ch.chang=Each chang If change(ch\p\nq) Then Insert ch\p After pmark(2) Next Delete Each chang ; We change a condition of all cells(cages) from the list ¹2 cell=pmark(2) Repeat cell=After cell If cell=pmark(3) Then Exit If cell\nq <16 Then newborn cell Else ; For all neighbours - reduction of their counter of neighbours For n=0 To 7 cell2.ptr=cell\neig[n] cell2\nq=cell2\nq-1 ; Entering the neighbour in the list of cells which, probably, will change the condition If change(cell2\nq) Then ch.chang=New chang: ch\p=cell2 Next ; Deenergizing a bat zapolnennosti cell\nq=cell\nq And 15 WritePixel scrx+cell\x, scry+cell\y, 0, ib cellq=cellq-1 ; Entering the processed cell in the list of potentially changing cells If change(cell\nq) Then ch.chang=New chang: ch\p=cell End If Forever ; Cells from the list ¹2 pass all in the list ¹1(are stabilized) Insert pmark(2) Before pmark(3) ; Displacement of the cursor of the mouse is defined(determined) dx=MouseX()-xres Sar 1 dy=MouseY()-yres Sar 1 ; If the cursor was displaced, there is a copying of cells(cages)(all 1-st list) If dx <> 0 Or dy <> 0 Then scrx=scrx+dx scry=scry+dy SetBuffer ib Cls SetBuffer FrontBuffer() cell=pmark(1) Repeat cell=After cell If cell=pmark(2) Then Exit If cell\nq And 16 Then WritePixel scrx+cell\x, scry+cell\y,-1, ib Forever End If SetBuffer ib Color 0,0,0 Rect 0,0,100,36 Color 255,255,255 Text 0,0, "FPS: "+1000.0 /(MilliSecs()-fps) Text 0,12, "Cells(Cages): "+cellq Text 0,24, "Generation: "+gen fps=MilliSecs() SetBuffer FrontBuffer() Until KeyHit(1) End ; Function of search of a cell in hierarchy on a starting point and displacement ; If the cell does not exist, it(she) is created together with a chain of indexes Function findcell.ptr(cell.ptr, x, y) ; If displacement zero, result - a starting point If x=0 And y=0 Then Return cell ; We remember coordinates of a required cell(in case it(she) should be created) xx=x+cell\x yy=y+cell\y pmax=1; the Counter of a level in hierarchy ; The first stage - rise upwards Repeat ; Addition of the new index from above if the top of hierarchy is reached(achieved) If cell\prev=Null Then p.ptr=New ptr Insert p After pmark(0) ; The position is defined(determined) by position of a required cell pos=(x <0)+(y <0) Shl 1 p\nxt[pos]=cell cell\prev=p cell\prevpos=pos Else ; Differently - transition to higher level in hierarchy pos=cell\prevpos p.ptr=cell\prev End If ; Change of coordinates according to moving If pos And 1 Then x=x+pmax If pos And 2 Then y=y+pmax ; Increase of a level pmax=pmax Shl 1 cell=p ; An output(exit) if the point is reached(achieved), whence it is possible to go down up to required Until x>=0 And y>=0 And x <pmax And y <pmax ; The second stage - descent(release) Repeat ; Downturn of a level pmax=pmax Shr 1 ; Definition of a direction pos=((x And pmax)=pmax)+((y And pmax)=pmax) Shl 1 ; Creation of the new index if the branch is absent If cell\nxt[pos]=Null Then p.ptr=New ptr Insert p After pmark(0) cell\nxt[pos]=p p\prev=cell p\prevpos=pos ; If we create a cell(cage)(the index of 1-st level) it is moved it(her) to the list ¹1 and ; We appropriate(give) the remembered coordinates If pmax=1 Then Insert p After pmark(1) p\x=xx p\y=yy End If End If cell=cell\nxt[pos] ; If will reach(achieve) a bottom of hierarchy(a level of cells(cages)) - an output(exit) Until pmax=1 Return cell End Function ; Function of a birth of a new cell(cage) Function newborn(cell.ptr) ; Search, storing of neighbours and increase in their counter of quantity(amount) of neighbours For xx=-1 To 1 For yy=-1 To 1 If xx Or yy Then cell2.ptr=findcell(cell, xx, yy) cell2\nq=cell2\nq+1 ; Entering the neighbour in the list of cells which, probably, will change the condition If change(cell2\nq) Then ch.chang=New chang: ch\p=cell2 cell\neig[n]=cell2 n=n+1 End If Next Next ; Inclusion a bat zapolnennosti cell\nq=cell\nq Or 16 ; Entering the processed cell in the list of potentially changing cells If change(cell\nq) Then ch.chang=New chang: ch\p=cell WritePixel cell\x+scrx, cell\y+scry,-1, ib cellq=cellq+1 End Function |
Comments
| ||
Doesn't work: Say's invalid image handle. |
| ||
Image used: [http://blitzetc.boolean.name/code/locomot.png] Download that image, save it to the same directory you save the above source code to, and learn to read before you post. |
| ||
Hehe, this kind of feedback is better than nothing at all. :) So, thanks for attention! |
Code Archives Forum