PROGRAM ca2
LIBRARY "csgraphics"
DIM update(0 to 511),cell(50,50)
CALL setrule(update(),L)
LET flag$ = ""
DO
   CALL initial(cell(,),L)
   DO
      CALL iterate(cell(,),update(),L)
      IF key input then
         GET KEY k
         IF (k = ord("s")) or (k = ord("S")) then
            LET flag$ = "stop"
         END IF
      END IF
   LOOP UNTIL k <> 0
   LET k = 0
LOOP until flag$ = "stop"
END

SUB setrule(update(),L)
    ! rule for Game of Life
    FOR i = 0 to 511
        LET update(i) = 0
    NEXT i
    ! three neighbors alive
    FOR nn1 = 0 to 5
        FOR nn2 = nn1+1 to 6
            FOR nn3 = nn2+1 to 7
                LET index = 2^nn1 + 2^nn2 + 2^nn3
                LET update(index) = 1  ! center dead
                LET update(index+256) = 1   ! center alive
            NEXT nn3
        NEXT nn2
    NEXT nn1
    ! two neighbors and center alive
    FOR nn1 = 0 to 6
        FOR nn2 = nn1+1 to 7
            LET index = 256 + 2^nn1 + 2^nn2
            LET update(index) = 1
        NEXT nn2
    NEXT nn1
    SET BACKGROUND COLOR "black"
    SET COLOR "white"
    INPUT prompt "lattice size = ": L
    CALL compute_aspect_ratio(L,xwin,ywin)
    SET WINDOW -0.2*xwin,1.2*xwin,-0.2*ywin,1.2*ywin
END SUB

SUB initial(cell(,),L)
    FOR i = 1 to L
        FOR j = 1 to L
            LET cell(i,j) = 0
            SET COLOR "yellow"
            BOX AREA i,i+1,j,j+1
            SET COLOR "black"
            BOX LINES i,i+1,j,j+1
        NEXT j
    NEXT i
    SET CURSOR 1,1
    ! click on cell to change its state or outside of lattice
    ! to update cells
    SET COLOR "white"
    PRINT "click on cell to toggle or outside of lattice to continue."
    DO
       GET POINT x,y
       IF x > 1 and x < L and y > 1 and y < L then
          LET i = truncate(x,0)
          LET j = truncate(y,0)
          IF cell(i,j) = 0 then
             SET COLOR "black"
             BOX AREA i,i+1,j,j+1
             LET cell(i,j) = 1
          ELSE
             SET COLOR "yellow"
             BOX AREA i,i+1,j,j+1
             LET cell(i,j) = 0
             SET COLOR "black"
             BOX LINES i,i+1,j,j+1
          END IF
       END IF
    LOOP until x < 1 or x > L or y < 1 or y > L
    SET CURSOR 1,1
    SET COLOR "white"
    PRINT "Hit any key for new lattice, 's' to stop";
    PRINT "                                 "
END SUB

SUB iterate(cell(,),update(),L)
    DIM cellnew(50,50)
    FOR i = 1 to L
        FOR j = 1 to L
            CALL neighborhood(cell(,),i,j,sum,L)
            LET cellnew(i,j) = update(sum)
            IF cell(i,j) = 1 and cellnew(i,j) = 0 then
               SET COLOR "yellow"
               BOX AREA i,i+1,j,j+1
               SET COLOR "black"
               BOX LINES i,i+1,j,j+1
            ELSE IF cell(i,j) = 0 and cellnew(i,j) = 1 then
               SET COLOR "black"
               BOX AREA i,i+1,j,j+1
            END IF
        NEXT j
    NEXT i
    MAT cell = cellnew
END SUB

SUB neighborhood(cell(,),i,j,sum,L)
    LET ip = i + 1
    LET im = i - 1
    LET jp = j + 1
    LET jm = j - 1
    IF i = 1 then
       LET im = L
    ELSE IF i = L then
       LET ip = 1
    END IF
    IF j = 1 then
       LET jm = L
    ELSE IF j = L then
       LET jp = 1
    END IF
    LET sum = cell(i,jp) + 2*cell(i,jm) + 4*cell(im,j)
    LET sum = sum + 8*cell(ip,j)+ 16*cell(ip,jp) + 32*cell(ip,jm)
    LET sum = sum + 64*cell(im,jp) + 128*cell(im,jm) + 256*cell(i,j)
END SUB