Task: Conway's Game of Life








VB: option explicit
const tlcr=3, tlcc=3
const maxdim=15

dim a(15,15)
dim b(15,15)
dim ans0:ans0=chr(27)&"["
dim gen,n

erase a

a(0,1)=true:a(1,2)=true:a(2,0)=true:a(2,1)=true:a(2,2)=true

a(3,13)=true:a(4,13)=true:a(5,13)=true

a(11,1)=true:a(11,2)=true: a(12,1)=true:a(12,2)=true
a(13,3)=true:a(13,4)=true: a(14,3)=true:a(14,4)=true

gen=0
doframe

do
  display 
  wscript.sleep(100)
  n=newgen
loop until n=0
display 

sub cls()  wscript.StdOut.Write ans0 &"2J"&ans0 &"?25l":end sub 
sub toxy(r,c,s)  wscript.StdOut.Write ans0 & r & ";" & c & "f"  & s :end sub
function iif(a,b,c) if a then iif=b else iif=c end if :end function

sub doframe
  dim r,c,s
	const frame="@"
	cls
	toxy 1,tlcc-1, "Conway
	toxy tlcr-1,tlcc-1,string(maxdim+3,frame)
	s=frame&space(maxdim+1)&frame
	for r=0 to maxdim
		toxy tlcr+r,tlcc-1,s
	next
	toxy tlcr+maxdim+1,tlcc-1,string(maxdim+3,frame)
end sub

sub display 
dim r,c
const pix="#"
for r=0 to maxdim
   for c=0 to maxdim
	   toxy tlcr+r,tlcc+c,iif (a(r,c),pix," ") 
	 next
next
toxy tlcr+maxdim+2,tlcc-1,gen & " " & n
toxy tlcr+maxdim+3,tlcc-1,""
gen=gen+1
end sub

function newgen
  dim r,c,cnt,cp,cm,rp,rm
	for r=0 to maxdim
	  for c=0 to maxdim
			cp=(c+1) and maxdim    
			cm=(c-1) and maxdim
			rp=(r+1) and maxdim
			rm=(r-1) and maxdim
			cnt=0
			cnt=- a(rp,cp) - a(rp,c) - a(rp,cm)  
			cnt=cnt- a(r,cp)-	 a(r,cm)	
			cnt=cnt- a(rm,cp)- a(rm,c) - a(rm,cm)  
			 
			if a(r,c) then 
				b(r,c)=iif (cnt=2 or cnt=3,true,false)
			else
				b(r,c)=iif (cnt=3,true,false)					
			end if
	  next 
	next
	for r=0 to maxdim
	  for c=0 to maxdim
		  a(r,c)=b(r,c)
		  newgen=newgen- b(r,c)
	  next
	next
end function



Fortran:  PROGRAM LIFE_2D
   IMPLICIT NONE
 
   INTEGER, PARAMETER :: gridsize = 10
   LOGICAL :: cells(0:gridsize+1,0:gridsize+1) = .FALSE.
   INTEGER :: i, j, generation=0
   REAL :: rnums(gridsize,gridsize)
 
 
 
 
 
 
    cells(3:5,3:5) = .TRUE. ; cells(6:8,6:8) = .TRUE.                      
 
 
 
   
   CALL Drawgen(cells(1:gridsize, 1:gridsize), generation)
   DO generation = 1, 8
      CALL NextgenV2(cells)
      CALL Drawgen(cells(1:gridsize, 1:gridsize), generation)
   END DO
 
 CONTAINS
 
   SUBROUTINE Drawgen(cells, gen)
     LOGICAL, INTENT(IN OUT) :: cells(:,:)
     INTEGER, INTENT(IN) :: gen
 
     WRITE(*, "(A,I0)") "Generation ", gen 
     DO i = 1, SIZE(cells,1)
        DO j = 1, SIZE(cells,2)
           IF (cells(i,j)) THEN
              WRITE(*, "(A)", ADVANCE = "NO") "#"
           ELSE
              WRITE(*, "(A)", ADVANCE = "NO") " "
           END IF
        END DO
        WRITE(*,*)
     END DO
     WRITE(*,*)
   END SUBROUTINE Drawgen
 
  SUBROUTINE Nextgen(cells)
     LOGICAL, INTENT(IN OUT) :: cells(0:,0:)
     LOGICAL :: buffer(0:SIZE(cells, 1)-1, 0:SIZE(cells, 2)-1)
     INTEGER :: neighbours, i, j
   
     buffer = cells   
     DO j = 1, SIZE(cells, 2)-2
        DO i = 1, SIZE(cells, 1)-2
          if(buffer(i, j)) then
            neighbours = sum(count(buffer(i-1:i+1, j-1:j+1), 1)) - 1
          else
            neighbours = sum(count(buffer(i-1:i+1, j-1:j+1), 1))
          end if
  
          SELECT CASE(neighbours)
            CASE (0:1, 4:8)
               cells(i,j) = .FALSE.
  
            CASE (2)
               
  
            CASE (3)
               cells(i,j) = .TRUE.
          END SELECT
          
        END DO
     END DO
  END SUBROUTINE Nextgen








  PURE SUBROUTINE NextgenV2(cells)
     LOGICAL, INTENT(IN OUT) :: cells(:,:)
     INTEGER(KIND=1) :: buffer(1:SIZE(cells, 1)-2,1:SIZE(cells, 2)-2)
     INTEGER :: gridsize, i, j
     
     gridsize=SIZE(cells, 1)
     buffer=0
     
     DO j=-1, 1
        DO i=-1,1
           IF(i==0 .AND. j==0) CYCLE
           WHERE(cells(i+2:gridsize-i-1,j+2:gridsize-j-1)) buffer=buffer+1
        END DO
     END DO

     WHERE(buffer<2 .or. buffer>3) cells(2:gridsize-1,2:gridsize-1) = .FALSE.
     WHERE(buffer==3) cells(2:gridsize-1,2:gridsize-1) = .TRUE.
  END SUBROUTINE NextgenV2

 END PROGRAM LIFE_2D