Announcement

**Gary Barnes** · 16 Sep 2008, 01:48 PM

Hi Gosta,
I have been researching conways life quite a bit recently, and I have learned quite a lot.
Anyway, I would like to add to this thread the code for a glider generator.
As I mentioned in our private discussions this was reassuring because it re-affirmed that I had implemented the rules correctly.
My next post will include functionality for quite a few really interesting life based creatures, including what are called spaceships and various other constructs, some of which fascinating to watch in action.
Apparently, some of these constructs last for millions of iterations.
In any case I will be submitting code that is based around what appears to be a standard way of dealing with life constructs.
So if you are interested, keep an eye on this thread.
Thanks to Gosta for his enormous enthusiasm.
See ABBA is not necessarily the best thing to come out of Sweden :laugh:

Enough, here is the sub routine for generating gliders.

Code:

' This code sort of acts like the graphic box command.
' The parameters are as follows.
 ' Xpos and Ypos set the top left co-ordinates of the generator.
' w is the width of the display screen in pixels
' tarr is your target array - the current generation as it were
' dirn is the direction with 0 and 1 sending gliders downwards at 45 degrees and 2 and 3 sending them upwards.


SUB makegun (xpos AS LONG, ypos AS LONG, w AS LONG, BYREF tarr() AS LONG, dirn AS LONG)
LOCAL c,x,y,offset AS LONG
offset = xpos + ypos * w      ' Need to calculate start position of generator

    c = 1                            ' Character index used by read
    DO
        x = VAL(READ$(c))     ' fetch x and y and increment data counter
        INCR c
        y = VAL(READ$(c))
        INCR c
        SELECT CASE dirn     ' Choose direction 
               CASE 1 : x = 35-x                  ' Because the generator is 35 pixels wide ... should be obvious how this works
               CASE 2 : y = 8-y
               CASE 3 : x = 35-x : y = 8-y
        END SELECT
        tarr(offset + x+y*w) = 1
    LOOP UNTIL c > DATACOUNT              ' All done exit


DATA 0,4,0,5
DATA 1,4,1,5
DATA 10,4,10,5,10,6
DATA 11,3,11,7
DATA 12,2,12,8
DATA 13,2,13,8
DATA 14,5
DATA 15,3,15,7
DATA 16,4,16,5,16,6
DATA 17,5
DATA 20,2,20,3,20,4
DATA 21,2,21,3,21,4
DATA 22,1,22,5
DATA 24,0,24,1,24,5,24,6
DATA 34,2,34,3
DATA 35,2,35,3
END SUB

To use the generator, you need to either clear an area of the screen, or start with a blank one. The easiest way to manage this is to comment out the random pixel routine.
Then place your generators in the following way, or any way that you want actually.

Code:

FOR z = 0 TO 12
    makegun 40*z,10+z,w,tg(),0
NEXT z

FOR z = 6 TO 19
    makegun 40*z,570-z,w,tg(),2
NEXT z

Anyway, the results are quite spectacular.

Have fun
Cheers

**Gösta H. Lovgren-2** · 16 Sep 2008, 04:13 PM

Originally posted by Gary Barnes View Post

See ABBA is not necessarily the best thing to come out of Sweden :laugh:

Actually my old man used to call me a "Second Hand Swede". He was from Sweden, not me. (Mother from Scotland) {grin}

{Deleted fixed it myself.}

Looks really promising Gary. Will post an updated version later.

=======================================================
"Everyone is a genius at least once a year;
a real genius has his original ideas closer together."
Georg Lichtenberg (1742-1799)
=======================================================

**Gösta H. Lovgren-2** · 16 Sep 2008, 09:55 PM

Here's the latest version with Gary's Gliders as an option to start.

I tried a #Register All (Theo's suggesttion?) but it didn't seem to speed up any, not that I think any more speed is needed. In Random Distribution my machine runs about 10 generations a second.

The interface needs a little cleaning up but ... it's getting late for this old man. One curiosity I haven't figured out yet is why the first screen is blank until sa key is pressed.

'

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
'
'Modifications by Gösta H. Lovgren.
 
' 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 neighbors, it will die Of loneliness.
'2. If it has too many neighbors - 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"
'
'All variables are Global. Not good programming practice but this is a standalone program
'  so there's no concern of "cross contamination" and what it does do is allow for more liberal use
'  of Subs and Functions to ease program readability. GHL
 
Global Seed, Stasis_Range, tmr, ctr, ctr1, ctr2, gen_total, Last_gen_total, gen_check As Long                             
Global tmr1, secs, mins, hrs, flag As Long   
Global disp$, k$, fHndl As Dword, fhght!, fwdth!  
Global Row&, Col&, Spce&, Start_Flag&, Rules$(), Stasis_Results$(), s$
Global hdr$, Generations&
 
Global w,h,ncw,nch,gwin,z,sum,rsx,rsy,x,y,w1,h1,gdc, totpixel As Long
Global tg(), ng() As Byte
Global tgptr, ngptr As Byte Ptr
 
 
'
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 neighbors - 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) = "A to add random settlers"
   Rules$(7) = "G to Add colonies"
   Rules$(7) = "H or R to repost this message"
   Rules$(8) = "S to show Stasis points"
   Rules$(10) = "Q  or Escape to quit living"
   End Macro
''
Macro Stasis
'
'                   
End Macro
'
Macro Set_Header  
  Incr Generations         
  tmr1 = Timer - tmr
  hrs = tmr1 \ 3600
  mins = (tmr1  - (hrs * 3600)) \ 60
  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)                  
 
       s$ = Disp$ 'for  Stasis_Ranges$
          GoSub Stasis_Accumulate
       Disp$ = Disp$ & "   (Space Bar to continue looking)"
       Dialog Set Text gwin, Disp$ 
        SndPlaySound  "TaDa.wav", 0
    End If   
 
    Last_gen_total = gen_Total 'not yet so keep going
 End If                       
End Macro
'
Macro Set_Font
  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
 
End Macro
 
Function Rules_Print As Long
   Row = 10
   Col = 120
   Spce = fwdth +5
   For ctr = LBound(Rules$()) To UBound(Rules$())
      Row = Row + Spce
      Row = Row + Spce
      Graphic Set Pos (Col, Row)
       Graphic Print Rules$(ctr) 
   Next ctr
 
   If Start_Flag = 0 Then
      Start_Flag = 1
      GoSub Starting
   End If 
   
   Graphic ReDraw 
   Graphic waitkey$ 
   Exit Function
 
Starting:           
   Row = Row + Spce
     Row = Row + Spce
     Graphic Set Pos (Col, Row)
     Graphic Print "R = Start Life with a Random distribution"
   Row = Row + Spce
  '   Row = Row + Spce
     Graphic Set Pos (Col, Row)
     Graphic Print "S = Start Life with a Straight distribution"
     Graphic ReDraw
Starting1:
   Graphic inkey$ To k$
     If k$ = "" Then GoTo Starting1
     If k$ = "r" Then Start_Flag = 2
Return
   
End Function  
'
Function Add_Glider As Long
For z = 0 To 12
    makegun 40*z,10+z,w, tg(),0
Next z
 
For z = 6 To 19
    makegun 40*z,570-z,w, tg(), 2
Next z
End Function
'
Function Add_Random_Colonies As Long
   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 spirals, but I don't know how yet. 
     tG(ctr1) = Rnd(0, 1)
     tG(ctr1 + 1) = Rnd(0, 1) 'right neighbor
     tG(ctr1-1) = Rnd(0, 1)   'Lefty neighbor
     tG(ctr1-w) = Rnd(0, 1)   'Above
     tG(ctr1-w - 1) = Rnd(0, 1)   'Above left
     tG(ctr1-w + 1) = Rnd(0, 1)   'Above right
     tG(ctr1+w) = Rnd(0, 1)   'Below
     tG(ctr1+w - 1) = Rnd(0, 1) 'Below left
     tG(ctr1+w + 1) = Rnd(0, 1)   'Below right
   Next ctr
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Start here             
 
Function PBMain() As Long
 
  Dim  Stasis_Results$(20) 'should be enough
    Stasis_Results$(0) = "      Stasis Points" 'header
'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               
 
Graphic Window "Look! - It's alive",(ncw-w)/2,(nch-h)/2,w,h To gwin
Graphic Attach gwin,0,ReDraw
  
  Set_Font 'Macro to set the font
 
  Rules_Set 'Macro to fill the the rules and instruction array
  Rules_Print 'print the rules
 
                              ' main program loop
 Seed = 7 ' change to whatever you like - 2 is too crowded
 
 If Start_Flag = 2 Then 'random distribution
   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 y
  Else
    Add_Glider 'create gliders
 End If
 
 ' Stasis_Range = point at which the population appears stable
  tmr = Timer 'start timing
 
  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))
 
  
Graphic Color %White,RGB(0,0,64) 
 
Do
 'GHL  added
  Reset gen_total
  For ctr =  LBound(tG()) To UBound(tG()) 
       gen_total = gen_total + tg(ctr) 
  Next ctr                
 
   Set_Header
 
   Graphic inkey$ To k$
     If k$ = "a" Then Add_Random_Colonies
     If k$ = "g" Then Add_Glider
     If k$ = "h" Then Rules_Print
     If k$ = "q" Then Exit Do 'quit
     If k$ = "r" Then Rules_Print
     If k$ = "s" Then GoSub Stasis_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       
        
'        
 
'
        
 
'
 
 
Stasis_Accumulate:
   Reset Flag 
   For ctr = LBound(Stasis_Results$()) + 1 To UBound(Stasis_Results$()) 
      If Len(Stasis_Results$(ctr)) < 10 Then 'empty
        Incr flag 'no need to bump up
        Stasis_Results$(ctr) = s$ 
        Exit For 
      End If
   Next ctr     
   If Flag = 0 Then 'araay filled so bump 'em all up one
     For ctr = LBound(Stasis_Results$()) + 1 To UBound(Stasis_Results$()) - 1 
         Stasis_Results$(ctr) = Stasis_Results$(ctr + 1)
     Next ctr                                     
     Stasis_Results$(UBound(Stasis_Results$())) = s$ 'add it to end
   End If
Return
 
Stasis_Print:
   Row = 10
   Col = 120
   Spce = fwdth + 10
   For ctr = LBound(Stasis_Results$()) To UBound(Stasis_Results$())
      Row = Row + Spce
      Graphic Set Pos (Col, Row): Graphic Print Stasis_Results$(ctr) 
   Next ctr
   Graphic ReDraw 
   Graphic waitkey$ 
Return
                                                    
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 
'''''''' Gliders
'to generate a glider
'For z = 0 To 12
'    makegun 40*z,10+z,w,tg(),0
'Next z
'
'For z = 6 To 19
'    makegun 40*z,570-z,w,tg(),2
'Next z
'       
' This code sort of acts like the graphic box command.
' The parameters are as follows.
 ' Xpos and Ypos set the top left co-ordinates of the generator.
' w is the width of the display screen in pixels
' tarr is your target array - the current generation as it were
' dirn is the direction with 0 and 1 sending gliders downwards at 45 degrees and 2 and 3 sending them upwards.
 
Sub makegun (xpos As Long, ypos As Long, w As Long, ByRef tarr() As Byte, dirn As Long)
Global c,x,y,offset As Long
' makegun 40*z,570-z,w, tg(), 2
offset = xpos + ypos * w      ' Need to calculate start position of generator
 
    c = 1                            ' Character index used by read
    Do
        x = Val(Read$(c))     ' fetch x and y and increment data counter
        Incr c
        y = Val(Read$(c))
        Incr c
        Select Case dirn     ' Choose direction 
               Case 1 : x = 35-x                  ' Because the generator is 35 pixels wide 
               Case 2 : y = 8-y                   ' ... should be obvious how this works
               Case 3 : x = 35-x : y = 8-y
        End Select
        tarr(offset + x+y*w) = 1
    Loop Until c > DataCount              ' All done exit
 
 
Data 0,4,0,5
Data 1,4,1,5
Data 10,4,10,5,10,6
Data 11,3,11,7
Data 12,2,12,8
Data 13,2,13,8
Data 14,5
Data 15,3,15,7
Data 16,4,16,5,16,6
Data 17,5
Data 20,2,20,3,20,4
Data 21,2,21,3,21,4
Data 22,1,22,5
Data 24,0,24,1,24,5,24,6
Data 34,2,34,3
Data 35,2,35,3
End Sub
 
'

**Gösta H. Lovgren-2** · 17 Sep 2008, 11:19 AM

Attached (I hope, never tried attaching here before) is the latest incantation (Life.Zip). It adds new swarms whenever stasis is reached rather than just staying stable.

Gary, would it be possible to create larger gliders? the ones on my screen (1024x768) look awful small (about te size of 1 pixel

Also if those that go off the top/bottom could re-enter bottom/top like the sides it would be neat(er).

A friend pointed out the mouse wheel exits Life, so I fixed that (cleverly I think).

And I'm having one problem, while Life will start with gliders, trying to add them mid stream (press "g") GPF's.

Dunno about anyone else but I'm having fun {grin}.

===========================
“You take my life
when you do take the means
whereby I live.”
Shylock
===========================

Attached Files

Life.zip (4.4 KB, 21 views)

**Gösta H. Lovgren-2** · 17 Sep 2008, 04:21 PM

Attached is the latest incantation (zip includes .exe & .bas) of Gary's Life.

Or just http://www.swedesdock.com/powerbasic/Life.exe (let it run a few seconds before cursing).

Man, ain't Life grand?

=========================================
"Anybody can become angry; that is easy.
But to be angry with the right person,
and to the right degree,
and at the right time,
and for the right purpose,
and in the right way
that is not within everybody's power;
that is not easy."
Aristotle.
=========================================

Attached Files

Life.zip (33.5 KB, 28 views)

**Gösta H. Lovgren-2** · 19 Sep 2008, 10:52 PM

Gary's Life is now in Living Color

Attached is the later latest incantation ( .bas) of Gary's Sparkling Life.

Or just http://www.swedesdock.com/powerbasic/Life.exe (let it run a few seconds before cursing).

Man, ain't Life just grand?

==========================================================
Every war when it comes, or before it comes,
is represented not as a war
but as an act of self-defense
against a homicidal maniac.
George Orwell
==========================================================

**Gösta H. Lovgren-2** · 20 Sep 2008, 12:25 AM

Oops, forgot to attach the .bas

Attached Files

Life.bas (18.1 KB, 17 views)

**Gösta H. Lovgren-2** · 24 Sep 2008, 12:56 PM

Attached is the later latest incarnation ( .bas) of Gary's Sparkling Life.

Or just http://www.swedesdock.com/powerbasic/Life.exe (let it run a few seconds before cursing).

Man, ain't Life just grand? (And now in Color)

=======================================
“Time is very slow for those who wait,
very fast for those who are scared,
very long for those who lament,
very short for those who celebrate.
But, for those who love,
time is eternity"
William Shakespeare
=======================================

Attached Files

Life.zip (6.3 KB, 17 views)

**Gary Barnes** · 24 Sep 2008, 01:25 PM

Sweet Gosta
It is looking good so far.

**Gösta H. Lovgren-2** · 26 Sep 2008, 11:00 AM

Originally posted by Gary Barnes View Post

Sweet Gosta
It is looking good so far.

Yup, I think so. Wait until you see the latest. I've been trying to join it vertically but no luck so far, though. Here's what I've been playing with:

Code:

'
Function Join_Top_To_Bottom As Long
      'maybe swap 8 rows?
   Local Rows&
   Rows = w * 1   
   For ctr = 0 To Rows Step stp 'can be either 1 or -1 set at call
      'tg(ctr) = tg(totpixel - Rows + ctr)  'top = bottom
      tg(totpixel - Rows + ctr) = tg(ctr)  'bottom = top
   Next ctr
'   ? "Swapped" & Str$(stp)
End Function

Attached is the late later latest incarnation ( .bas) of Gary's Twinkling (or not) Life.

Or just http://www.swedesdock.com/powerbasic/Life.exe (let it run a few seconds before cursing).

Man, ain't Life just grand?

=====================================
"Human history becomes more and more a race
between education and catastrophe."
H. G. Wells (1866-1946)
=====================================

Attached Files

Life.bas (24.6 KB, 20 views)

**Dominique Bodin** · 26 Sep 2008, 02:24 PM

oops

Hello,

when using mouse wheel, the prog just crash ! ! !

Dominique

**Gösta H. Lovgren-2** · 26 Sep 2008, 08:05 PM

Originally posted by Dominique Bodin View Post

Hello,

when using mouse wheel, the prog just crash ! ! !

Dominique

It doesn't crash. It just exits (stops). That's a feature {grin}. In the "manual"

Q or Escape or Mouse Wheel to quit living.

. Not quite a spiffy one for sure but until I (or Gary or ...) get around to handling the mouse wheel differently ... It's part of the operating system (same as Alt F4), not set by the program.

=======================================
Let each man exercise the art he knows.
Aristophanes
=======================================

**Gösta H. Lovgren-2** · 27 Sep 2008, 11:28 AM

1,000,000+ Generation

I let Life run for something over 9 actual hours last night:

The Graphic Window was set for 1016 x 703 pixels (714,000+) which leaves room for the Taskbar and borders to show on my 1068 x 768 screen setting.

1) The onboard time calculator (Using TIMER to check every generation) had something over 14 hours as passing though only 9 had actually passed. No biggie, just an observation.

2) Over 1,000,000 Life generations.

3) About 10,000 Stasis points reached (calculated every 100 generations). A Stasis point is generated if the population is remains within (gen_Total * .001) over 100 generations.

If a Stasis point is reached then additional ("colonies" or a "glider") are added randomly.

3) Going from 40+ generations per second (first minutes) to a about 20 or so after getting to the point of general stability (Note - when composing this missive, I found I had stopped adding (Colonies or Glider) after 50 Stasis_Points for some reason. (In Stasis_Check) Limitation now removed. That would have affected the still impressive numbers. No doubt (considerably?) less Stasis Points reached.)

4) It didn't respond to the keyboard this morning, though the mouse pointer worked (moved). Dunno if the mouse wheel "feature" still worked because I ACDed before trying it {sigh}. Dunno why but expect the quadrazillion Graphic Inkey$ checks, 1,000,000+ Graphic Clears & Redraws, 36,705,312,000,000 array element checks and compares (give or take a couple), 1,000,000+ Mat operations on two 768,000 element arrays, ...

5) WOW! I don't care who you are, you gotta call them pretty impressive numbers. (Now of course there will be "instantiated" a flurry of "Oh yeah? Well take a look at this ..." 's)

(Note I have a Dell XPS 710 with a higher end Graphics Board and using XP SP3. YMMV. Am curious what others do (gens per second)).

I've seen no definite long living patterns forming yet but that may change when when we (Gary or I or ... you?) can figure out how to wrap the arrays top and bottom (see Function Join_Top_To_Bottom As Long) so a moving "life" moving off the top/bottom appears on the bottom/top as it does on the sides. (In DDT if possible)

Just for curiosity, I tried setting each pixel without the pointers Gary is using, ... Boy, talk about slogging through mud ...

And oh yeah, check the very clever use of using the Dialog Caption for declogging (checking variables during testing):

Code:

 
   Working_Flag    = 0 'set to 4 to see variables here
   If Working_Flag = 4 Then
      Caption$ = Using$(" bgColorChgsperDay = #,   bgColorChgs_Today = #,     BgColorDir = #" , _
                       bg_Color_Chgs_per_Day,      bg_Color_Chgs_Today,       Bg_Color_Dir) & _
                      " --- " & Hour_in_Day$ 
     Header_Print                 
   End If

Anytime it's wanted to check progress, just set Caption$ to Foo (Hi M) and the flag to a unique number. (Boy, some guys are just .... oh I don't know ... well ... oh ... hem ... haw ...uh ... brilliant, ya know. {laughing here is expected)

I'm really having fun with this. Thanks Gary. Can't wait until you get the "formations" designed.

OOps, time for football. Gotta go ... Was 13 & 3 last week (who could expext New England to lose?)

Note - rather than further clog up PB's servers with the extraordinary demand this code is generating (see View numbers on previously attached files), the latest files are now on my site.:

http://www.swedesdock.com/powerbasic/Life.bas '<<< (27k) File exists - Link doesn't work
http://www.swedesdock.com/powerbasic/Life.txt '<<< (27k) File exists - Link doesn't work
http://www.swedesdock.com/powerbasic/Life.zip '<<< (8k) Zipped bas - Link Works
http://www.swedesdock.com/powerbasic/Life.exe '<<< (60k) Oh man .... It's positively estatic

**Gösta H. Lovgren-2** · 30 Sep 2008, 12:20 AM

Okay, the program wraps side to side (pixels go off one side appear on the other one) but try as I might (and I have mighted, believe me) I can't get them to to wrap top to bottom.

The RL wrap is because the array is contiguous(?) (except at the bounds)and I (we?) need to make the array "join" at the bounds.

Here's the relevant snip of my latest effort. Can anyone see what I'm doing wrong logically ? Or have a better idea?

Code:

       'totpixel = window size
     'x = random position on screen 
   Do
     If x < 0 Then 'w - 1 Then 
'        x = TotPixel - w + x   '<0 then must be at top so go to bottom
        'Exit Loop
     End If  
 
    If x >= LBound(tg()) And _
       x <= UBound(tg()) Then
      If @tgptr[x] Then Graphic Set Pixel (x Mod w, x\w), Pixel_Color 
    End If
      c1 = x - 1 - w 'above left                   
        If c1 < 0 Then c1 = TotPixel - w - 1
      c2 = x - w     'above
        If c2 < 0 Then c2 = TotPixel - w 
      c3 = x + 1 - w 'above right
        If c3 < 0 Then c3 = TotPixel + 1 - w
     c4 = x - 1     'left
        If c4 < 0 Then c4 = TotPixel - w - 1
     c5 = x + 1     'right
        If c5 > Totpixel Then c5 = w + 1
     c6 = x - 1 + w 'below left
        If c6 > Totpixel Then c6 = TotPixel - 1 - w
     c7 = x + w     'below
        If c7 > Totpixel Then c7 = w 
     c8 = x + 1 + w 'below right
        If c8 > Totpixel Then c8 = w + 1
        
      'Had GPF'ing typos and logic errors in above and found them with this:
     If c1 < 0 Or c1 > totpixel Or _
        c2 < 0 Or c2 > totpixel Or _
        c3 < 0 Or c3 > totpixel Or _
        c4 < 0 Or c4 > totpixel Or _
        c5 < 0 Or c5 > totpixel Or _
        c6 < 0 Or c6 > totpixel Or _
        c7 < 0 Or c7 > totpixel Or _
        c8 < 0 Or c8 > totpixel Then
        s$ = Using$("w=#,", w) & $CrLf & _
             Using$("Origx=#,", Orig_x) & $CrLf & _
             Using$("totpixel=#,",totpixel) & $CrLf & _
             Using$("  x= #,",x) & $CrLf & _
             Using$("  c1=#,",c1) & $CrLf & _
             Using$("  c2=#,",c2) & $CrLf & _
             Using$("  c3=#,",c3) & $CrLf & _
             Using$("  c4=#,",c4) & $CrLf & _
             Using$("  c5=#,",c5) & $CrLf & _
             Using$("  c6=#,",c6) & $CrLf & _
             Using$("  c7=#,",c7) & $CrLf & _
             Using$("  c8=#,",c8)
              
        ClipBoard Set Text S$ To ctr                                                              
        ? s$
       Exit Function 
     End If      
        sum = @tgptr[c1] + @tgptr[c2] + @tgptr[c3] + _
              @tgptr[c4] + @tgptr[c5] + _                ' this routine just adds up the number of occupied cells
              @tgptr[c6] + @tgptr[c7] + @tgptr[c8]   ' around the one of interest - tg(x,y)
'        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] 'lonely so die
      If sum = 3 Then Incr @ngptr[x]        'content
      Decr x
   Loop Until x = 0 'w + 1 'at top

Entire code is attached. After starting, hold the b key down to to launch a bunch of forms that will send out scouts. As the scouts hit top/bottom they just sit there until a following scout hits it and they are both destroyed. At the sides the scouts continue on the other side.

I am really stumped.

======================================================
"Sleep is an excellent way of listening to an opera."
James Stephens (1882-1950)
======================================================

and, I hope, solving programming problems too. {sigh}. Note these sayings at the bottom of my posts are completely random, but surprisingly often seem very relevant. At least to me.

Attached Files

Life_2.bas (31.5 KB, 15 views)

**Gösta H. Lovgren-2** · 1 Oct 2008, 12:03 AM

Come on guys. I'm goin into brain freeze here. The deeper I get into this, the lower the temperature gets the more brain cells are getting knocked off. There HAS to be some simple obvious to "marry" the Lbound to the Ubound. I've just lost too many brain cells to see it.

I got a sort of semi appearing maybe but not really vertical wrap (see attached code. The action is all in PBMain inside the Do Loops). Not nearly a true wrap though. Scouts going SE & SW enter at the top (sort of),but scouts going NE & NW just hit the upper boundry and just stop.

Actually the horizontal wrap is not *really* true, the scouts drop one row, but that's okay for now.

Does make a kind of cool display though.

http://www.swedesdock.com/powerbasic/Life.exe '

Hold "b" down a second or two after the blank "Universe" comes up.
To activate Patrice's Goldfish you'll have to have Goldfish.exe (see Goldfish thread) in the Life folder.

(Note to Gary, it would be cool if makegun could produce N S scouts to go along with the NE, NW, SE, SW. I just can't get my head around it enough to play with it myself. Am obsessed with the vertical wrap problem, and getting distracted adding more 'features" {grin}

============================================
"Your manuscript is both good and original,
but the part that is good is not original
and the part that is original is not good."
Samuel Boswell (1709-)
============================================

Attached Files

Life.bas (33.0 KB, 17 views)

**Cliff Nichols** · 1 Oct 2008, 07:09 PM

Gosta,

I will try to not use the bullhorn but

"Step AWAYYYYYYYYyyyy from the keyboard"

Give it a bit of non-thought, and I am sure it will come to you

(modified from the "Emergency Broadcast Channel")

"Life is a test, it is only a test....if it were real, you would be told where to go, and what to do"

**Gösta H. Lovgren-2** · 2 Oct 2008, 12:25 AM

Originally posted by Cliff Nichols View Post

Gosta,

I will try to not use the bullhorn but

"Step AWAYYYYYYYYyyyy from the keyboard"

Give it a bit of non-thought, and I am sure it will come to you

Oh it came to me all right (finally) sort of kinda maybe (but not perfect yet) but good enough to pass for government work. Eureka! Praise the lord!

See http://www.swedesdock.com/powerbasic/Life.exe '

(Hold "b" down a second or two after the blank "Universe" comes up to speed things up.)

I was getting desperate, not so much because of wrapping Life code, but because I had an additional puzzle to figue out: No one here was offering any help for more than a week (2?, months?, years?, lifetime? Long time anyway). I felt like Gabby Hayes saying to Roy in Death Valley "Podner, if'n we don't find some water soon, we're gonna be goners."). {you have to be of an age {grin}

Hmmm... let's see ...

1) Could it be because no one wanted to help a mere "hobbyist" (as I, and others here, have been sort of dismissed as)?

Nah ...., Can't be that. Anytime I posted a programming question, no matter how stupid or Newby, it was always answered in hours, minutes sometimes. And most times by more than one guy. And Invariably educational, often by the "dismissers" (names only released by court order {grin})

2) Could it be the code I posted was just SO good, it couldn't be improved on?

Nah ..., Can't be that. That's if anything even more unlikely than #1. (Almost?) every time I've posted code, someone posts something cleaner, better, quicker, easier, faster, less codey, ... More "professional".

3) The Life Lbound Ubound wrapping problem is insoluble?

Nah ... Can't be that because I did solve it (sort of, maybe, ... yadayada ...), at least for Life display purposes. And if I did it, virtually (almost) everyone here can do it cleaner, better, quicker, easier, faster, less codey, More "professionally", ....

4) Could the non responsive nature on this thread be because everyone else is too busy?

Eeehhh .. I don't think *everyone* is that busy. After all it's been a (relatively) long time in PB time (see Death Valley above).

5) Are there other possibilities?

Well none that occur to the rapidly expiring brain cells of this old dog.

So you see, Cliff, I've been in quite a quandry (And there's been this Sarah Palin thing to ya know ....)

"Life is a test, it is only a test....if it were real, you would be told where to go,

Oh, I've been told that MANY times

and what to do"

That too.

========================================
"And I looked,
and behold a pale horse:
and his name that sat on him was Death,
and Hell followed with him."
Revelations 6:8
========================================

**Gösta H. Lovgren-2** · 13 Oct 2008, 11:05 AM

Gary has adapted the Life algo so that now Life scrolls vertically as well as horozontally. (And far better /smoother than my efforts at scrolling).

And I've added a host of new features:

Code:

Data "         The 3 Rules of Life"                                                            
Data "If a cell has one or no living neighbors, it will die of loneliness."                    
Data "If it has too many neighbors - four or more - it will die From overcrowding."            
Data "New cells are 'born' whenever an empty square has exactly three living neighbors."       
Data " "                                            
Data " "                                            
Data "Your Screen Size is set to # x #"                                            
Data "Start Life in this screen:"
Data "(1) 640 x 480" 
Data "(2) 800 x 600" 
Data "(3) 1024 x 768" 
Data "(4) 1280 x 1024" 
Data "(5) 1600 x 1200" 
Data "(6) 1920 x 1200" 
Data "(7) 3400 x 1700" 
Data " "                                            
Data " "                                            
Data "(A) = Start Life with a Straight distribution (Default)"
Data "(B) = Start Life with a Glider distribution"
'''''''''''''''''''
''''''''''''''
Data "Active Keys"                                                                                       
Data "(A) - to add random swarms (Hold it down)"                                                   
Data "(B) - to add colonies (Hold it down) Or Click the Mouse"                                                        
Data "(C) - Title Scroll On/Off (Starts OFF)"                                                        
Data "(E) - Empty the Clipboard to collect data."                                                        
Data "(F) - Freeze/Thaw the Sky color. (Starts 'Thawed')" 
data         "(Just tap it. Don't hold it down.) "                                                       
Data "(G) - Goldfish" 
Data "(H) - Horizontal Scroll On/Off (Starts On)" 
Data "(K) - Knock Off Everybody (New Start)"                                                                 
Data "(L) - Living Color On/Off (Starts ON)"                                                                 
Data "(M) - Slow Motion On/Off (Cycles through 5 speeds)"                                                                 
Data "(P) - Pause Life"                                                                
Data "(R) - to show this message"                                                                
Data "(S) - to show Stasis points" 
Data "(When a Stasis Point is reached new swarms are randomly added (see (U))"  
Data "(T) - turn Twinkle On/Off (Starts ON)"                                                       
Data "(Arrows adjust Twinkle rate)"
Data "(U) -  Stasis population upgrade (Starts off)"                                                       
Data "(X) - Rub out half the population (When too crowded)"
Data " "
Data "Escape or Mouse Wheel to quit living"            
 
'Plus not shown while working on them
     Case ".": Crown_Flag = Crown_Flag Xor 1 'creates a crown pattern
     Case "/": Pattern_Jelly_Fish

See attached for code and

http://www.SwedesDock.com/powerbasic/Life.exe for exe

===================================================
"I'm not going to get into the ring with Tolstoy."
Ernest Hemingway (1899-1961)
===================================================

Attached Files

Life.bas (45.6 KB, 14 views)

**Gösta H. Lovgren-2** · 17 Oct 2008, 12:18 PM

Okay, am now attempting to adapt/clone Gary's updating routine using pointers in a different manner.

My forst problem is I can't get by a Declaration Error when compiling.

Code:

 
..
Global tRC(), nRC() As Byte 
Global tRcPtr, nRCPtr As Byte Ptr
...
'Gary's stuff
Global tg(), ng() As Byte
Global tgptr, ngptr As Byte Ptr
...
'Okay so far
 
  totpixel = (w-1) * (h-1)
  Dim tG(totpixel)             ' current generation
  Dim nG(totpixel)             ' next generation
 
  Dim tRC(h - 1, w - 1) 'better?
...
'Okay so far
 
   ngptr = VarPtr(ng(0))
   tgptr = VarPtr(tg(0))
   tRcPtr = VarPtr(tRC(0,0))
'Okay so far
....
'
'Here is the problem
Function TotPixel_to_RC_Array As Long
  ctr2 = -1 'so to start at 0
  For Row = 0 To h - 2  '-2 because of 0 based array instead of 1 based
    For col = 0 To w - 1          
      ctr2 = (Row * (w-1)) + col
 
       If ctr2 < LBound(tg()) Or _
          ctr2 > UBound(tg()) Then
           Function = ctr2
           Exit Function
       End If         
      tRC(Row, Col) = tg(ctr2) '<< works fine but slow
 
'      'this should be faster but  yields declaration error
     @tRcPtr(Row, Col) = @tgPtr(ctr2) '
     @tgPtr(ctr2) = @tgPtr(ctr2)  'yields declaration error too (testing)

    Next col
  Next row   
  Function = ctr2
End Function

My attempt at using a pointer above gives a "Missing Declaration for tRcPtr". I tried moving the Function to the end of the code but no difference.

The compleat code is attached below.

=================================================
"It is better to be quotable than to be honest."
Tom Stoppard
=================================================

Attached Files

Life_1.bas (47.7 KB, 12 views)

Announcement

Gary Barnes' Life

Gary Barnes' Life

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment