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