Conway's Game of Life
Following is a Fortran program to generate a SVG animation to display Conway's Game of Life.
The Fortran program was used to generate a SVG file which is embedded below.
Program in Fortran 95
===================================================================================
Program to generate a SVG animation of Conway's Game of Life
LANGUAGE :: FORTRAN 95
Compiler :: GNU Fortran
Program By:: www.numericalmethods.in
===================================================================================
PROGRAM automata_svg
IMPLICIT NONE
INTEGER :: game(12,12)=0,i,j,k
INTEGER :: nei(12,12)=0,ne(3,3)=0 ! nei=no of neighbours matrix, ne=neighbourhood matrix
INTEGER ::lh(12,12,30)=0
PRINT *,'enter the matrix'
DO i=2,11
READ *,(game(j,i),j=2,11)
END DO
WRITE (*,*)'THE INITIAL POPULATION IS : ',COUNT(game==1)
OPEN (UNIT=12,FILE='c:\\users\\piku\\desktop\\autoo.svg', &
& STATUS='replace',ACTION='write')
WRITE(12,'(TL1,A)')'<?xml version="1.0" standalone="no"?>'
WRITE(12,*)'<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"'
WRITE(12,*)'<"http://www.w3.org/Graphics/ SVG / 1.1 /DTD/svg11.dtd"> '
WRITE(12,*)'<svg width="500" height="500"'
WRITE(12,*)'xmlns="http://www.w3.org/2000/ svg">'
DO i=1,12
DO j=1,12
lh(i,j,1)=game(i,j)
END DO
END DO
DO k=2,30 !GETTING THE NEW GENERATION
DO i=2,11
DO j=2,11
ne=game((i-1):(i+1) , (j-1):(j+1))
ne(2,2)=0
nei(i,j)=COUNT(ne==1) !count(ne==H) = no. of live neighbours
END DO
END DO
WHERE ((game==0).AND.(nei==3)) !birth
game=1
ELSE WHERE ((game==0).AND.(nei<3)) !stasis
game=0
ELSE WHERE ((game==1).AND.((nei>3).OR.(nei<2))) !death by crowding or ageing
game=0
ELSE WHERE ((game==1).AND.((nei==2).OR.(nei==3))) !stasis
game=1
END WHERE
DO i=1,12
DO j=1,12
game(i,1)=0
game(i,12)=0
game(1,j)=0
game(12,j)=0
END DO
END DO
DO i=1,12
DO j=1,12
lh(i,j,k)=game(i,j)
END DO
END DO
END DO
DO j=2,11
DO k=2,11
WRITE(12,*)'<rect x="',(50*(j-2)),'" y="',(50*(k-2)),'" width="50" height="50"'
WRITE(12,*)' stroke="yellow" fill="white">'
DO i=1,30
IF ((i==1).AND.(lh(j,k,i)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="white" to="black" fill="freeze"/>'
ENDIF
IF ((i/=1).AND.(lh(j,k,i)==1).AND.(lh(j,k,i-1)==0)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="white" to="black" fill="freeze"/>'
ELSE IF ((i/=1).AND.(lh(j,k,i)==1).AND.(lh(j,k,i-1)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="black" to="black" fill="freeze"/&ht;'
ELSE IF ((i/=1).AND.(lh(j,k,i)==0).AND.(lh(j,k,i-1)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="black" to="white" fill="freeze"/>'
END IF
END DO
WRITE(12,*)'</rect>'
END DO
END DO
WRITE(12,*)'</svg>'
CLOSE (UNIT=12)
END PROGRAM
!------------------------OUTPUT----------------
! enter the matrix
!0 0 1 1 0 0 1 1 0 0
!1 1 1 1 1 1 1 1 1 1
!0 1 0 1 0 1 0 1 0 0
!0 0 0 0 1 1 1 1 0 0
!0 0 1 1 0 1 1 0 0 0
!0 0 1 1 0 0 1 1 0 1
!0 1 0 1 0 1 0 0 1 0
!1 1 1 1 0 1 0 1 0 1
!0 1 0 1 0 1 0 1 0 1
!0 1 0 1 0 1 0 1 0 1
! THE INITIAL POPULATION IS : 52
Following is a Fortran program to generate a SVG animation to display Conway's Game of Life. The Fortran program was used to generate a SVG file which is embedded below.
PROGRAM automata_svg
IMPLICIT NONE
INTEGER :: game(12,12)=0,i,j,k
INTEGER :: nei(12,12)=0,ne(3,3)=0 ! nei=no of neighbours matrix, ne=neighbourhood matrix
INTEGER ::lh(12,12,30)=0
PRINT *,'enter the matrix'
DO i=2,11
READ *,(game(j,i),j=2,11)
END DO
WRITE (*,*)'THE INITIAL POPULATION IS : ',COUNT(game==1)
OPEN (UNIT=12,FILE='c:\\users\\piku\\desktop\\autoo.svg', &
& STATUS='replace',ACTION='write')
WRITE(12,'(TL1,A)')'<?xml version="1.0" standalone="no"?>'
WRITE(12,*)'<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"'
WRITE(12,*)'<"http://www.w3.org/Graphics/ SVG / 1.1 /DTD/svg11.dtd"> '
WRITE(12,*)'<svg width="500" height="500"'
WRITE(12,*)'xmlns="http://www.w3.org/2000/ svg">'
DO i=1,12
DO j=1,12
lh(i,j,1)=game(i,j)
END DO
END DO
DO k=2,30 !GETTING THE NEW GENERATION
DO i=2,11
DO j=2,11
ne=game((i-1):(i+1) , (j-1):(j+1))
ne(2,2)=0
nei(i,j)=COUNT(ne==1) !count(ne==H) = no. of live neighbours
END DO
END DO
WHERE ((game==0).AND.(nei==3)) !birth
game=1
ELSE WHERE ((game==0).AND.(nei<3)) !stasis
game=0
ELSE WHERE ((game==1).AND.((nei>3).OR.(nei<2))) !death by crowding or ageing
game=0
ELSE WHERE ((game==1).AND.((nei==2).OR.(nei==3))) !stasis
game=1
END WHERE
DO i=1,12
DO j=1,12
game(i,1)=0
game(i,12)=0
game(1,j)=0
game(12,j)=0
END DO
END DO
DO i=1,12
DO j=1,12
lh(i,j,k)=game(i,j)
END DO
END DO
END DO
DO j=2,11
DO k=2,11
WRITE(12,*)'<rect x="',(50*(j-2)),'" y="',(50*(k-2)),'" width="50" height="50"'
WRITE(12,*)' stroke="yellow" fill="white">'
DO i=1,30
IF ((i==1).AND.(lh(j,k,i)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="white" to="black" fill="freeze"/>'
ENDIF
IF ((i/=1).AND.(lh(j,k,i)==1).AND.(lh(j,k,i-1)==0)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="white" to="black" fill="freeze"/>'
ELSE IF ((i/=1).AND.(lh(j,k,i)==1).AND.(lh(j,k,i-1)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="black" to="black" fill="freeze"/&ht;'
ELSE IF ((i/=1).AND.(lh(j,k,i)==0).AND.(lh(j,k,i-1)==1)) THEN
WRITE(12,*)'<animate attributeName="fill" begin="',i*2,'" dur="1" &
& from="black" to="white" fill="freeze"/>'
END IF
END DO
WRITE(12,*)'</rect>'
END DO
END DO
WRITE(12,*)'</svg>'
CLOSE (UNIT=12)
END PROGRAM
!------------------------OUTPUT----------------
! enter the matrix
!0 0 1 1 0 0 1 1 0 0
!1 1 1 1 1 1 1 1 1 1
!0 1 0 1 0 1 0 1 0 0
!0 0 0 0 1 1 1 1 0 0
!0 0 1 1 0 1 1 0 0 0
!0 0 1 1 0 0 1 1 0 1
!0 1 0 1 0 1 0 0 1 0
!1 1 1 1 0 1 0 1 0 1
!0 1 0 1 0 1 0 1 0 1
!0 1 0 1 0 1 0 1 0 1
! THE INITIAL POPULATION IS : 52