'/title Game of Life, Conway's
'/type for fun

'Controls:
' when the animation is being performed... ESC to go back to main menu

'=========================================================================
'Conway's Game of Life (written in QB64 by PaulEL)
'=========================================================================
'......................................................................
'Conway's Game of Life
'https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
'The universe of the Game of Life is an infinite, two-dimensional
'orthogonal grid of square cells, each of which is in one of two possible
'states, alive or dead, (or populated and unpopulated, respectively).
'Every cell interacts with its eight neighbours, which are the cells that
'are horizontally, vertically, or diagonally adjacent. At each step in
'time, the following transitions occur:
'
'1.Any live cell with fewer than two live neighbors dies, as if by under
'population.
'2.Any live cell with two or three live neighbors lives on to the next
'generation.
'3.Any live cell with more than three live neighbors dies, as if by
'overpopulation.
'4.Any dead cell with exactly three live neighbors becomes a live cell,
'as if by reproduction.
'
'The initial pattern constitutes the seed of the system. The first
' generation is created by applying the above rules simultaneously to every
'cell in the seed; births and deaths occur simultaneously, and the discrete
'moment at which this happens is sometimes called a tick. Each generation
'is a pure function of the preceding one. The rules continue to be applied
'repeatedly to create further generations.
'===========================================================================

DIM SHARED PgmTitle$: PgmTitle$ = "Conway's Game of Life (by PaulEL)"
DIM SHARED ConfigFile$: ConfigFile$ = "GameOfLife.ini"
DIM SHARED GridRows, GridCols, TotalSpots, GridBefore$, GridAfter$
DIM SHARED ShowAfterGrid, AutoFill, squareSize, MasterDelay
DIM SHARED ColorDead, ColorAlive

'+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'* load ASCII color RGB values
DIM SHARED ASCIIclrRd(15), ASCIIclrGr(15), ASCIIclrBl(15)
ff = FREEFILE: OPEN "ASCII_RGB.ini" FOR INPUT AS #ff
FOR clr = 0 TO 15
    INPUT #ff, clr, ASCIIclrRd(clr), ASCIIclrGr(clr), ASCIIclrBl(clr)
NEXT
CLOSE ff
'+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

RANDOMIZE TIMER

_TITLE PgmTitle$

top:

MainMenu

''TotalSpots = GridRows * GridCols
GridBefore$ = SPACE$(TotalSpots)
GridAfter$ = SPACE$(TotalSpots)

'-------------------------------------------------------------------------
IF AutoFill THEN
    IF AutoFill > TotalSpots THEN AutoFill = TotalSpots - 1
    FOR lp = 1 TO AutoFill
        limit = TotalSpots
        PickRandomNumber limit, n
        MID$(GridBefore$, n, 1) = "A"
    NEXT
ELSE ' - - - -  - - - - - - - - - - - - - - - - - - - - - - - -
    xy = 0
    OPEN ConfigFile$ FOR INPUT AS #1
    DO UNTIL EOF(1)
        LINE INPUT #1, x$
        x$ = LTRIM$(RTRIM$(x$))
        IF LEFT$(x$, 1) = "'" THEN x$ = ""
        IF x$ <> "" THEN
            IF LEFT$(x$, 3) = "/xy" THEN
                xy = 1
            ELSE
                IF xy THEN
                    IF x$ = "/" THEN EXIT DO
                    p = INSTR(x$, ",")
                    IF p > 0 AND p < LEN(x$) THEN
                        x = VAL(LEFT$(x$, p - 1))
                        y = VAL(RIGHT$(x$, LEN(x$) - p))
                        PRINT x; y
                        ChangeGridXY GridBefore$, x, y, "A"
                    END IF
                END IF
            END IF
        END IF
    LOOP
    CLOSE 1
END IF
'--------------------------------------------------------------------------

''SCREEN 12

'GetLabelValue ConfigFile$, "rows", x$: GridRows = VAL(x$)
'GetLabelValue ConfigFile$, "columns", x$: GridCols = VAL(x$)
'GetLabelValue ConfigFile$, "ShowAfterGrid", x$
'ShowAfterGrid = VAL(x$)
'GetLabelValue ConfigFile$, "squareSize", x$: squareSize = VAL(x$)

w = GridCols * (squareSize + 1) + 10
h = GridRows * (squareSize + 1) + 20
SCREEN _NEWIMAGE(w, h, 32)

CLS

FOR MainLoop = 1 TO 99999

    ShowGrid "B"
    IF ShowAfterGrid THEN ShowGrid "A"

    ScanBeforeGrid

    'LOCATE 1, 70
    'asciiCOLOR 6, -1
    'PRINT MainLoop

    IF 1 = 1 THEN
        FOR dly = 1 TO MasterDelay
        NEXT
        k$ = INKEY$
    ELSE
        LOCATE 26: PRINT "new Before/After"
        PRINT ""
        PausePgm k$
    END IF
    IF k$ = CHR$(27) THEN
        CLS
        SYSTEM
    END IF

    IF k$ = CHR$(8) THEN EXIT FOR

    IF MasterDelay = 0 THEN
        LOCATE 26: PRINT SPACE$(80)
    END IF

    GridBefore$ = GridAfter$
    GridAfter$ = SPACE$(TotalSpots)

NEXT

GOTO top

SUB RemoveDecimal (n) '###################################################
    x$ = LTRIM$(STR$(n))
    P = INSTR(x$, ".")
    IF P = 0 THEN EXIT SUB
    n = VAL(LEFT$(x$, P - 1))
END SUB


SUB MainMenu '############################################################

    SCREEN _NEWIMAGE(80 * 8, 25 * 16, 32)

    DO
        GetLabelValue ConfigFile$, "rows", x$: GridRows = VAL(x$)
        GetLabelValue ConfigFile$, "columns", x$: GridCols = VAL(x$)
        GetLabelValue ConfigFile$, "ShowAfterGrid", x$
        ShowAfterGrid = VAL(x$)
        GetLabelValue ConfigFile$, "squareSize", x$: squareSize = VAL(x$)
        GetLabelValue ConfigFile$, "delay", x$: MasterDelay = VAL(x$)
        GetLabelValue ConfigFile$, "ColorAlive", x$: ColorAlive = VAL(x$)
        GetLabelValue ConfigFile$, "ColorDead", x$: ColorDead = VAL(x$)

        IF squareSize > 0 THEN
            IF GridRows = 0 AND GridCols = 0 THEN
                GridRows = (480 - 15) / (squareSize + 1)
                GridCols = (640 - 3) / (squareSize + 1)
                RemoveDecimal GridRows
                RemoveDecimal GridCols
            END IF
        END IF

        TotalSpots = GridRows * GridCols

        asciiCOLOR 7, 0: CLS
        ShowPgmTitle
        PRINT "             Rows:"; GridRows
        PRINT "          Columns:"; GridCols
        PRINT "Show 'After' Grid:"; ShowAfterGrid
        PRINT "      Square size:"; squareSize
        PRINT "   (total squares:"; TotalSpots; ")"
        PRINT "            Delay:"; MasterDelay
        PRINT "Color, Alive:"; ColorAlive
        PRINT " Color, Dead:"; ColorDead
        PRINT STRING$(80, CHR$(196))
        asciiCOLOR 14, -1: PRINT er$
        PRINT
        asciiCOLOR 15, -1
        PRINT "  E = edit Parms file"
        IF er$ = "" THEN PRINT "  R = run"
        PRINT "  ? = auto pick random XY's"
        PRINT "ESC = exit program"

        V$ = "E?" + CHR$(27)
        IF er$ = "" THEN V$ = V$ + "R"
        GetResp V$, k$

        SELECT CASE k$

            CASE CHR$(27): CLS: SYSTEM

            CASE "E": EditWithNotepad ConfigFile$

            CASE "R": EXIT SUB

            CASE "?"
                AutoFill = 0
                RandomPick max
                IF max > 0 THEN EXIT SUB

        END SELECT

    LOOP


END SUB

SUB RandomPick (max) '###########################################################

    LOCATE 23, 1
    INPUT "Start with how many live spots? ", x$
    max = VAL(x$)
    IF max > 0 THEN AutoFill = max

END SUB

SUB PickRandomNumber (limit, n) '############################################
    q% = INT(RND * limit) + 1
    n = q%
END SUB

SUB EditWithNotepad (f$) '################################################
    x$ = "file open for editing! ... " + f$
    x$ = LEFT$(x$, 80)
    x$ = x$ + SPACE$(80 - LEN(x$))
    asciiCOLOR 4, 7
    LOCATE 23, 1
    PRINT x$
    SHELL "notepad.exe " + f$
    asciiCOLOR 7, 0
    LOCATE 23, 1: PRINT SPACE$(80)
END SUB


SUB GetResp (v$, k$) '####################################################
    DO
        k$ = UCASE$(INKEY$)
        IF k$ <> "" THEN
            IF INSTR(v$, k$) THEN
                EXIT DO
            END IF
        END IF
    LOOP
END SUB

SUB ShowPgmTitle '#########################################################
    P = (80 - LEN(PgmTitle$)) / 2
    asciiCOLOR 15, 1
    LOCATE 1, 1: PRINT SPACE$(80)
    LOCATE 1, P: PRINT PgmTitle$
    asciiCOLOR 7, 0
END SUB

SUB ScanBeforeGrid '########################################################

    g$ = GridBefore$
    pp = 1

    FOR down = 2 TO GridRows - 1

        FOR across = 2 TO GridCols - 1

            GetGridXY g$, across, down, thisCell$

            GOSUB CheckTheSpot

            IF thisCell$ <> " " AND 1 = 11 THEN
                LOCATE 1, pp
                asciiCOLOR 10, -1
                PRINT across; down; alive; dead
                pp = pp + 15
            END IF

            newStatus = 0

            IF thisCell$ <> " " THEN
                '--ALIVE
                IF alive = 2 OR alive = 3 THEN
                    newStatus = 1 'cell lives on
                ELSE
                    newStatus = 0 'cell dies
                END IF
            ELSE
                '-- Dead
                IF alive = 3 THEN newStatus = 1 'cell comes back to life
            END IF

            a$ = " ": IF newStatus THEN a$ = "A"
            ChangeGridXY GridAfter$, across, down, a$
            ShowGrid "A" '* show After Grid

            IF 1 = 11 THEN
                LOCATE 26
                PRINT "Checked "; across; down, thisCell$; newStatus
                PausePgm ""
                LOCATE 26: PRINT SPACE$(80)
            END IF

        NEXT

    NEXT

    EXIT SUB

    '=======================================================================
    CheckTheSpot:
    '=======================================================================
    alive = 0

    FOR lp = 1 TO 8

        SELECT CASE lp
            CASE 1: xa = -1: ya = -1
            CASE 2: xa = 0: ya = -1
            CASE 3: xa = 1: ya = -1
            CASE 4: xa = -1: ya = 0
            CASE 5: xa = 1: ya = 0
            CASE 6: xa = -1: ya = 1
            CASE 7: xa = 0: ya = 1
            CASE 8: xa = 1: ya = 1
        END SELECT

        x = across + xa
        y = down + ya
        GetGridXY g$, x, y, x$

        IF x$ <> " " THEN alive = alive + 1

    NEXT

    dead = 8 - alive

    RETURN
END SUB

SUB PausePgm (k$) '##############################################################
    LOCATE 28: PRINT "paused..."
    DO
        k$ = INKEY$
        IF k$ <> "" THEN EXIT DO
    LOOP
    LOCATE 28: PRINT SPACE$(80)
END SUB

SUB ChangeGridXY (g$, x, y, a$) '###################################################

    p = (y - 1) * GridCols
    p = p + x
    MID$(g$, p, 1) = a$

END SUB

SUB GetGridXY (g$, x, y, a$) '###################################################

    p = (y - 1) * GridCols
    p = p + x
    a$ = MID$(g$, p, 1)

END SUB


SUB ShowGrid (opt$) '##########################################################

    'opt : (B)efore grid / (A)fter grid
    opt$ = UCASE$(opt$)

    IF opt$ = "B" THEN
        g$ = GridBefore$
        t$ = "" '"Before"
        p = 1
    ELSE
        IF ShowAfterGrid = 0 THEN EXIT SUB
        g$ = GridAfter$
        t$ = "After"
        p = 40
    END IF
    asciiCOLOR 11, -1
    LOCATE 1, p: PRINT t$

    sz = squareSize

    y = 15

    FOR down = 1 TO GridRows

        x = 1
        IF opt$ = "A" THEN x = 320

        FOR across = 1 TO GridCols

            GetGridXY g$, across, down, v$

            clr = ColorDead
            IF v$ <> " " THEN clr = ColorAlive
            asciiCOLOR clr, -1
            LINE (x, y)-(x + sz - 1, y + sz - 1), , BF

            x = x + sz + 1

        NEXT

        y = y + sz + 1

    NEXT

END SUB

SUB GetLabelValue (lblfile$, lbl$, v$) '#######################################################
    v$ = "": n = FREEFILE: OPEN lblfile$ FOR INPUT AS #n
    DO UNTIL EOF(n)
        LINE INPUT #n, dta$: dta$ = RTRIM$(LTRIM$(dta$))
        IF LEFT$(dta$, 1) = "'" THEN dta$ = ""
        P = INSTR(dta$, "=")
        IF P THEN
            l$ = RTRIM$(LEFT$(dta$, P - 1))
            IF LCASE$(l$) = LCASE$(lbl$) THEN
                v$ = LTRIM$(RIGHT$(dta$, LEN(dta$) - P))
                EXIT DO
            END IF
        END IF
    LOOP: CLOSE #n
END SUB

SUB asciiCOLOR (fc, bc) '###############################################
    rd = ASCIIclrRd(fc)
    gr = ASCIIclrGr(fc)
    bl = ASCIIclrBl(fc)
    Fclr& = _RGB32(rd, gr, bl)
    IF bc < 0 THEN
        COLOR Fclr&
        EXIT SUB
    END IF
    rd = ASCIIclrRd(bc)
    gr = ASCIIclrGr(bc)
    bl = ASCIIclrBl(bc)
    Bclr& = _RGB32(rd, gr, bl)
    COLOR Fclr&, Bclr&
END SUB