Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Life with pointers

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

  • Life with pointers

    This is my small, speedy implementation of Conways game of life.
    I became obsessed with speed while writing this and this is the result.
    The only rule that I set myself was 'no assembler', all PB.

    Code:
    ' Conway's Game of Life
    
    #COMPILE EXE "lifepbw8.exe"
    #DIM ALL
    #REGISTER ALL
    
    DECLARE FUNCTION IsWindow LIB "USER32.DLL" ALIAS "IsWindow" (BYVAL hWnd AS DWORD) AS LONG
    
    FUNCTION PBMAIN() AS LONG
    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
    
    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
    
    GRAPHIC COLOR %WHITE,RGB(0,0,64)
                                  ' main program loop
    FOR y = w+1 TO totpixel - w   ' seed this generation array randomly
            z = RND(1,17)         ' 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 = totpixel - w   
    ngptr = VARPTR(ng(0))
    tgptr = VARPTR(tg(0))
    DO
       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 = 0
    
       MAT tg()=ng()
       MAT ng() = ZER
    
       GRAPHIC REDRAW                                              ' all done display the new page and return
       GRAPHIC CLEAR
    LOOP
    END FUNCTION
    As far as life itself is concerned, the rules can be found in other posts.
    I offer this up for your amusement.

    By the way, it is quite CPU intensive

    Cheers
    Last edited by Gary Barnes; 23 Feb 2008, 05:18 AM.
    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.

  • #2
    [deleted - Didn't notice it was in the Source code forum]
    Last edited by Marco Pontello; 23 Feb 2008, 07:18 AM.
    -- The universe tends toward maximum irony. Don't push it.

    File Extension Seeker - Metasearch engine for file extensions / file types
    Online TrID file identifier | TrIDLib - Identify thousands of file formats

    Comment


    • #3
      Code Correction

      Many thanks to Jordi Vallès who pointed out an error in the code.
      The corrected source is below.
      He found that the program crashed every now and then because of an out of bounds array error.
      The fix is in the inner do loop terminating conditions.
      A small side effect is that the program is slightly faster


      Code:
      ' Conway's Game of Life
      
      #COMPILE EXE "lifepbw8.exe"
      #DIM ALL
      #REGISTER ALL
      
      DECLARE FUNCTION IsWindow LIB "USER32.DLL" ALIAS "IsWindow" (BYVAL hWnd AS DWORD) AS LONG
      
      FUNCTION PBMAIN() AS LONG
      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
      
      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
      
      GRAPHIC COLOR %WHITE,RGB(0,0,64)
                                    ' main program loop
      FOR y = w+1 TO totpixel - w   ' seed this generation array randomly
              z = RND(1,17)         ' 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 = totpixel - w   
      ngptr = VARPTR(ng(0))
      tgptr = VARPTR(tg(0))
      DO
         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
      END FUNCTION
      Thanks again Jordi.
      Regards
      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


      • #4
        Stasis

        Thanks for the Life reminder, Gary. I've been intrigued by it ever since I copied an asm version out of a Basic mag some 30 years ago.

        Anyway I doodled around your code a little and added a progression timer and Stasis Achieved state and some other clutter. It checks for changes every 100 generations and if changes are within a certain range, it achieves "Stasis". (It's not a perfect check, it may take 3 or 4 iterations to get true stability.) but fun anyway.

        Next I'll think I'll pay around with using colors.

        Code:
        'http://www.powerbasic.com/support/pbforums/showthread.php?t=36499&highlight=life
        ' by Gary Barnes
        #Dim All
        Declare Function IsWindow Lib "USER32.DLL" Alias "IsWindow" (ByVal hWnd As Dword) As Long
        #Include "WIN32API.INC"
         
         
        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$ 
         
        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
         
         
        '<< ************* Set starting ranges here ***********>>
        Stasis_Range = totpixel * .00001 ' point at which the population appears stable
         Seed = 17 ' change from 10 to whatever you like - 2 is too crowded
          tmr = Timer
         
         
        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
         
         
         
        Graphic Color %White,RGB(0,0,64)
                                      ' main program loop
        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 = totpixel - w   
        ngptr = VarPtr(ng(0))
        tgptr = VarPtr(tg(0))
        Do
           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
         
           Stasis
           Set_Header
         
        Loop                              
         
        Graphic Window End 'otherwise could stay in mem                           
        End Function
        '
        Macro Stasis                   
          'tG(totpixel)
          Reset gen_total
         For ctr1 = 0 To TotPixel
             gen_total = gen_total + @tgptr[ctr1] 'is pixel lit?
         Next ctr1        
         
        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)                  
         
          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
                SndPlaySound  "TaDa.wav", 0
         
               If secs Then disp$ = Using$("Look - #, alive and Stasis (+- # planets) reached after #, Generations took # seconds",  gen_total, Stasis_Range, Generations, secs)                  
               If mins Then disp$ = Using$("Look - #, alive and Stasis (+- # planets) reached after #, Generations took # minutes and # seconds",  gen_total, Stasis_Range, Generations, mins, secs)                  
               If hrs  Then disp$ = Using$("Look - #, alive and Stasis (+- # planets) reached after #, Generations took # hours # mins and # seconds",  gen_total, Stasis_Range, Generations, hrs, mins, secs)                  
         
               Dialog Set Text gwin, Disp$ 
               Graphic waitkey$
            End If   
         
            Last_gen_total = gen_Total 'not yet so keep going
         End If                       
        End Macro
        '
        Last edited by Gösta H. Lovgren-2; 15 Sep 2008, 11:50 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


        • #5
          Code:
           
          REGISTER x as LONG, w AS LONG
          better for this then #REGISTER ALL
          which will put "Seed" and "Stasis" into the Registers.
          --Theo Gottwald
          ------------------------------------------------
          76706 Dettenheim * Germany * [email protected]
          ------------------------------------------------
          Joses Forum * Theo's Link Site * IT-Berater.org

          Comment


          • #6
            Discussion (and code updates) on this thread:
            http://www.powerbasic.com/support/pb...ad.php?t=38601
            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