Tweet
I've been playing around with Gary's Life simulation. Some more stuff I'd like to add (or see added) is a front end where the user could choose what size the Life window is. As it is now, it automatically uses the entire screen.
This is my first foray into PB Graphics. Please note EVERYTHING (so far) is in DDT. Note I used a lot of Macros here so as to try not to clutter up Gary's code and keep the code more readable.
'
This is my first foray into PB Graphics. Please note EVERYTHING (so far) is in DDT. Note I used a lot of Macros here so as to try not to clutter up Gary's code and keep the code more readable.
'
Code:
'PBWIN 9.00 - WinApi 05/2008 - XP Pro SP3
'http://www.powerbasic.com/support/pbforums/showthread.php?t=36499&highlight=life
' by Gary Barnes
' rules - [URL]http://www.abc.net.au/science/holo/lablife.htm[/URL]
'The rules which determine it's fate are very simple:
'
'1. If a cell has one Or no living neighbours, it will die Of loneliness.
'2. If it has too many neighbours - four Or more - it will die From overcrowding.
'3. New cells are "born" whenever an Empty square has exactly three living neighbors.
#Dim All
Declare Function IsWindow Lib "USER32.DLL" Alias "IsWindow" (ByVal hWnd As Dword) As Long
#Include "WIN32API.INC"
'
Macro Rules_Set
Dim Rules$(1 To 10)
Rules$(1) = " The Rules of Life"
Rules$(2) = "1. If a cell has one or no living neighbors, it will die of loneliness."
Rules$(3) = "2. If it has too many neighbours - four or more - it will die From overcrowding."
Rules$(4) = "3. New cells are 'born' whenever an empty square has exactly three living neighbors."
Rules$(6) = "Q or Escape to quit living"
Rules$(7) = "A to introduce 100 new entities"
Rules$(8) = "H or R to repost this message"
End Macro
''
Macro Stasis
Reset gen_total
For ctr = LBound(tG()) To UBound(tG())
gen_total = gen_total + tg(ctr)
Next ctr
End Macro
'
Macro Set_Header
Incr Generations
tmr1 = Timer - tmr
hrs = tmr1 \ 3600
mins = tmr1 \ 60 - (hrs * 3600)
secs = tmr1 - - (hrs * 3600) - (mins * 60)
If secs Then disp$ = Using$("Look - #, still live after #, Generations taking # seconds", gen_total, Generations, secs)
If mins Then disp$ = Using$("Look - #, still live after #, Generations taking # minutes and # seconds", gen_total, Generations, mins, secs)
If hrs Then disp$ = Using$("Look - #, still live after #, Generations taking # hours # minutes and # seconds", gen_total, Generations, hrs, mins, secs)
Disp$ = Disp$ & " (R to see Rules)"
Dialog Set Text gwin, disp$
'If population stays within Stasis_Range for 100 generations than Stasis is considered reached.
If Generations \ 100 = Generations / 100 Then
If gen_Total => Last_gen_total - Stasis_Range And _
gen_Total =< Last_gen_total + Stasis_Range Then
If secs Then disp$ = Using$("#, still alive and Stasis (+- # planets) reached after #, Generations taking # seconds", gen_total, Stasis_Range, Generations, secs)
If mins Then disp$ = Using$("#, still alive and Stasis (+- # planets) reached after #, Generations taking # minutes and # seconds", gen_total, Stasis_Range, Generations, mins, secs)
If hrs Then disp$ = Using$("#, still alive and Stasis (+- # planets) reached after #, Generations taking # hours # mins and # seconds", gen_total, Stasis_Range, Generations, hrs, mins, secs)
Disp$ = Disp$ & " (Space Bar to continue looking)"
Dialog Set Text gwin, Disp$
SndPlaySound "TaDa.wav", 0
Waiting:
Graphic inkey$ To k$
If k$ = "" Then GoTo waiting 'nuttin pressed yet
If k$ <> " " Then Exit Loop 'Space bar continues, anything else exits
End If
Last_gen_total = gen_Total 'not yet so keep going
End If
End Macro
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Start here
Function PBMain() As Long
Local Seed, Stasis_Range, tmr, ctr, ctr1, ctr2, gen_total, Last_gen_total, gen_check As Long
Local tmr1, secs, mins, hrs As Long
Local disp$, k$, fHndl As Dword, fhght!, fwdth!
Local Row&, Col&, Spce&, Rules$()
Local w,h,ncw,nch,gwin,z,sum,rsx,rsy,x,y,w1,h1,gdc, totpixel As Long
Local tg(), ng() As Byte
Local tgptr, ngptr As Byte Ptr
'w = 800
'h = 600
Desktop Get Size To W, h 'set to max size
totpixel = (w-1) * (h-1)
Dim tG(totpixel) ' current generation
Dim nG(totpixel) ' next generation
Randomize Timer ' reset the random number generator
Desktop Get Client To ncw,nch
Local hdr$, Generations&
Graphic Window "Look! - It's alive",(ncw-w)/2,(nch-h)/2,w,h To gwin
Graphic Attach gwin,0,ReDraw
Font New "Comic Sans MS", 13 To fhndl
If fhndl = 0 Then 'no comic resident
Font New "Arial", 12 To fHndl
End If
Graphic Set Font fhndl
k$ = "K"
Graphic Text Size k$ To fwdth, fhght 'fwdth used in "Rules" spacing
fwdth = fwdth + 10
' main program loop
Seed = 10 ' change to whatever you like - 2 is too crowded
For y = w+1 To totpixel - w ' seed this generation array randomly
z = Rnd(1, Seed) ' change from 10 to whatever you like - 2 is too crowded
If z=1 Then tG(y) = 1 ' between 10 and 50 odd gives a pleasing result
Next
'<< ************* Set starting ranges here
' Stasis_Range = point at which the population appears stable
tmr = Timer
For ctr = LBound(tG()) To UBound(tG())
If tg(ctr) = 1 Then Stasis_Range = Stasis_Range + tg(ctr) 'add if set
Next ctr
'starting population
ctr = Stasis_Range 'hold it
Stasis_Range = Stasis_Range * .0001 ' point at which the population appears stable
'<<****************************************
y = totpixel - w
ngptr = VarPtr(ng(0))
tgptr = VarPtr(tg(0))
Rules_Set
GoSub Rules_Print
Graphic Color %White,RGB(0,0,64)
Do
'GHL added
Stasis
Set_Header
Graphic inkey$ To k$
If k$ = "q" Then Exit Do 'quit
If k$ = "a" Then GoSub Add_Lives'Introduce new lives
If k$ = "r" Then GoSub Rules_Print
If k$ = "h" Then GoSub Rules_Print
If Asc(k$) = 27 Then Exit Do
'GHL done
If IsWindow(gwin) = 0 Then Exit Do
x = y
Do
If @tgptr[x] Then Graphic Set Pixel (x Mod w , x\w)
sum = @tgptr[x-1-w] + @tgptr[x-w] + @tgptr[x+1-w] +_
@tgptr[x-1] + @tgptr[x+1] +_ ' this routine just adds up the number of occupied cells
@tgptr[x-1+w] + @tgptr[x+w] + @tgptr[x+1+w] ' around the one of interest - tg(x,y)
If sum = 2 Then @ngptr[x] = @tgptr[x]
If sum = 3 Then Incr @ngptr[x]
Decr x
Loop Until x = w + 1
Mat tg()=ng()
Mat ng() = Zer
Graphic ReDraw ' all done display the new page and return
Graphic Clear
Loop
Graphic Window End 'JIC Q or Esc exit
Exit Function
'
Add_Lives:
For ctr = 1 To 100
ctr1 = Rnd(W + 1, totPixel-W)'start at 2nd row to next to last row
'This fill could be a lot better, maybe add gliders or sppirals, but I don't know how yet.
tG(ctr1) = 1
tG(ctr1 + 1) = 1 'right neighbor
tG(ctr1-1) = 1 'Lefty neighbor
tG(ctr1-w) = 1 'Above
tG(ctr1-w - 1) = 1 'Above left
tG(ctr1-w + 1) = 1 'Above right
tG(ctr1+w) = 1 'Below
tG(ctr1+w - 1) = 1 'Below left
tG(ctr1+w + 1) = 1 'Below right
Next ctr
Return
'
'
Rules_Print:
Row = 10
Col = 120
Spce = fwdth +5
For ctr = LBound(Rules$()) To UBound(Rules$())
Row = Row + Spce
Graphic Set Pos (Col, Row): Graphic Print Rules$(ctr)
Next ctr
Graphic ReDraw
Graphic waitkey$
Return
End Function
'
'
Comment