Announcement

Collapse
No announcement yet.

Gary Barnes' Life

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Gary Barnes' Life

    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.


    '
    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
    '
    '
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

  • #2
    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

    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
    Last edited by Gary Barnes; 16 Sep 2008, 12:50 PM. Reason: Fixed up error in comments
    Gary Barnes
    The Control Key

    If you are not part of the solution
    then you are either a gas, solid, plasma or some other form of matter.

    Comment


    • #3
      Originally posted by Gary Barnes View Post
      See ABBA is not necessarily the best thing to come out of Sweden
      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)
      =======================================================
      Last edited by Gösta H. Lovgren-2; 16 Sep 2008, 03:23 PM.
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment


      • #4
        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 - [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 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
         
        '
        It's a pretty day. I hope you enjoy it.

        Gösta

        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

        Comment


        • #5
          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
          ===========================
          It's a pretty day. I hope you enjoy it.

          Gösta

          JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
          LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

          Comment


          • #6
            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.
            =========================================
            It's a pretty day. I hope you enjoy it.

            Gösta

            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

            Comment


            • #7
              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
              ==========================================================
              It's a pretty day. I hope you enjoy it.

              Gösta

              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

              Comment


              • #8
                Oops, forgot to attach the .bas
                It's a pretty day. I hope you enjoy it.

                Gösta

                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                Comment


                • #9
                  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
                  =======================================
                  It's a pretty day. I hope you enjoy it.

                  Gösta

                  JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                  LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                  Comment


                  • #10
                    Sweet Gosta
                    It is looking good so far.
                    Gary Barnes
                    The Control Key

                    If you are not part of the solution
                    then you are either a gas, solid, plasma or some other form of matter.

                    Comment


                    • #11
                      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)
                      =====================================
                      Last edited by Gösta H. Lovgren-2; 26 Sep 2008, 10:08 AM.
                      It's a pretty day. I hope you enjoy it.

                      Gösta

                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                      Comment


                      • #12
                        oops

                        Hello,

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

                        Dominique
                        Dominique

                        Comment


                        • #13
                          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
                          =======================================
                          It's a pretty day. I hope you enjoy it.

                          Gösta

                          JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                          LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                          Comment


                          • #14
                            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
                            Last edited by Gösta H. Lovgren-2; 27 Sep 2008, 12:49 PM. Reason: Lord, Let me count the ways ...
                            It's a pretty day. I hope you enjoy it.

                            Gösta

                            JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                            LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                            Comment


                            • #15
                              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.
                              It's a pretty day. I hope you enjoy it.

                              Gösta

                              JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                              LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                              Comment


                              • #16
                                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-)
                                ============================================
                                It's a pretty day. I hope you enjoy it.

                                Gösta

                                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                Comment


                                • #17
                                  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"

                                  Engineer's Motto: If it aint broke take it apart and fix it

                                  "If at 1st you don't succeed... call it version 1.0"

                                  "Half of Programming is coding"....."The other 90% is DEBUGGING"

                                  "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                                  Comment


                                  • #18
                                    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
                                    ========================================
                                    It's a pretty day. I hope you enjoy it.

                                    Gösta

                                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                    Comment


                                    • #19
                                      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)
                                      ===================================================
                                      Last edited by Gösta H. Lovgren-2; 13 Oct 2008, 10:11 AM.
                                      It's a pretty day. I hope you enjoy it.

                                      Gösta

                                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                      Comment


                                      • #20
                                        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
                                        =================================================
                                        Last edited by Gösta H. Lovgren-2; 17 Oct 2008, 11:24 AM.
                                        It's a pretty day. I hope you enjoy it.

                                        Gösta

                                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                        Comment

                                        Working...
                                        X