Gary Barnes' Life

[Gösta H. Lovgren-2]

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.


'

'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 - http://www.abc.net.au/science/holo/lablife.htm
'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
'
'