'******************************************************************************
'Subject: John H. Conway's Game of Life:
'         reads lifepatterns in interactive file golife.lif
'Author : Sjoerd.J.Schaper - vspickelen
'Date   : 11-21-2005
'Code   : all QBasic's, FreeBasic extendable
'Keys   : [Space] freeze
' [Enter] re-read current pattern after an edit of the .LIF file
'         [Esc] quit program
'         press any key to read the next pattern
'******************************************************************************
'This program is copyright (c) 2005 by the author. It is made available as is,
'and no warranty - about the program, its performance, or its conformity to any
'specification - is given or implied. It may be used, modified, and distributed
'freely, as long as the original author is credited as part of the final work.
'******************************************************************************
REM $STATIC
DEFINT A-Z

DECLARE FUNCTION ingrid ()
'input a Life-pattern
DECLARE SUB inita ()
'initialize arrays
DECLARE SUB populate (t)
'display the World at time t
DECLARE SUB evaluate ()
'apply the Rule of Life (23/3)

CONST TMX = 0
' set delay < 1 second
CONST MODE = 12, dW = 640, dH = 480
' set screenmode, width, height
'CONST MODE = 19, dW = 800, dH = 600 ' FreeBasic only
'CONST MODE = 20, dW = 1024, dH = 768

CONST MAX = 87
' maximum grid size 87 for QBasic 1.0,
' 111 using the QB /Ah switch
'CONST MAX = dH \ 2 - 1 ' FreeBasic only

DIM SHARED n, nn, sw
'  gridsize, cells, generation switch
nn = MAX * MAX - 1
DIM SHARED c(nn, 1), a(nn, 3), b(nn, 3)
'     cell indices, adjacency list -
' split in view of the QB 64kB array maxsize.

OPEN ".\golife.lif" FOR INPUT SHARED AS #1

DO
   t = 0: p& = SEEK(1)
   IF NOT ingrid THEN EXIT DO
   DO
      populate t
      t = t + 1
      evaluate
      '
      g$ = INKEY$
      IF g$ <> "" THEN
         SELECT CASE ASC(g$)
         CASE 13
            SEEK #1, p&
            EXIT DO '                 re-read pattern
         CASE 27
            GOTO eind
         CASE 32
            LOCATE 4, 3: PRINT t; " ";
            LOCATE 8, 4: PRINT "0   ";
            SLEEP '                   freeze
            WHILE INKEY$ <> "": WEND
         CASE ELSE
            EXIT DO '                 read next pattern
         END SELECT
      END IF
   LOOP
LOOP

eind:
CLOSE
SYSTEM

SUB evaluate
   FOR k = 0 TO nn
      tl = 0
      FOR t = 0 TO 3 '                count alive neighbours
         tl = tl + c(a(k, t), sw) + c(b(k, t), sw)
      NEXT t
      '
      t = c(k, sw) '                  implied survival
      IF t = 0 THEN
         IF tl = 3 THEN t = 1 '         birth
      ELSE
         IF tl < 2 OR tl > 3 THEN t = 0 ' death
      END IF
      c(k, 1 - sw) = t '              next generation
   NEXT k

   sw = 1 - sw '                      switch generations
END SUB

FUNCTION ingrid
ingrid = 0: n = 0
   DO
      IF EOF(1) THEN
         ingrid = n > 0: EXIT DO
      END IF
      LINE INPUT #1, g$

      SELECT CASE LEFT$(g$, 2)
      CASE "#C", "#D", "#L" '         comments
         IF n THEN
            ingrid = -1: EXIT DO '    go!
         END IF
      CASE "#N", "#R" '         NOTE: not the rule specification,
         n = VAL(MID$(g$, 3)) '       but the size of the grid!
         IF n < 3 OR n > MAX THEN n = MAX
         inita
      CASE "#P" '                     cell block position
         g$ = LTRIM$(RTRIM$(MID$(g$, 3)))
         t = INSTR(g$, " ")
         r = 0: m = (n - 1) \ 2
         x = m + VAL(LEFT$(g$, t))
         y = m + VAL(MID$(g$, t + 1))
      CASE ELSE '                     read pattern
         FOR s = 0 TO LEN(g$) - 1
            IF MID$(g$, s + 1, 1) = "*" THEN
               k = (r + y) * n + s + x
               IF k >= 0 AND k <= nn THEN
                  c(k, sw) = 1 '      mark alive cell
               END IF
            END IF
         NEXT s: r = r + 1
      END SELECT
   LOOP
END FUNCTION

SUB inita
   FOR r = 0 TO n - 1
      FOR s = 0 TO n - 1
         k = r * n + s '              cell number
         c(k, 0) = 0: c(k, 1) = 0 '   clear
         '
         x0 = s: y0 = r - 1 '         northern neighbour
         FOR t = 0 TO 3
            x = (x0 + n) MOD n '      toroidal world
            y = (y0 + n) MOD n
            v = y * n + x
            a(k, t) = v: b(v, t) = k ' build adjacency lists
            IF t = 0 THEN '           move counterclockwise
               x0 = x0 - 1
            ELSE
               y0 = y0 + 1
            END IF
         NEXT t
      NEXT s
   NEXT r

   nn = n * n - 1 '                   number of cells
   sw = 0 '                           reset global switch
END SUB

SUB populate (gen)
STATIC fl, g0, t0!
IF gen = 0 THEN
   IF NOT fl THEN
      SCREEN MODE
      PALETTE 0, &H180000
      PALETTE 1, &H303030
      PALETTE 2, &H0: COLOR 1
      r = 1 + dW * .25 * .618
      s = r + dW * .75 - 1: fl = -1
      VIEW (r, 1)-(s, dH - 2), , 1
      LOCATE 3, 2: PRINT "generation"
      LOCATE 7, 2: PRINT "speed * 10"
   END IF

   g0 = 0: t0! = TIMER
   dn! = n - .5
   WINDOW SCREEN (-.5, -.5)-(dn!, dn!)
   LINE (-1, -1)-(n, n), 0, BF '      clear viewport
   FOR r = 0 TO n
      dt! = r - .5
      LINE (dt!, -.5)-(dt!, dn!), 2 ' draw grid
      LINE (-.5, dt!)-(dn!, dt!), 2
   NEXT r
END IF

   FOR k = 0 TO nn
      IF c(k, sw) XOR c(k, 1 - sw) THEN
         r = k \ n
         s = k - r * n
         PAINT (s, r), c(k, sw), 2 '  update cells
      END IF
   NEXT k

   dt! = TIMER - t0!
   IF dt! > 1 THEN
      LOCATE 4, 3: PRINT gen; " ";
      LOCATE 8, 3: PRINT CINT(10 * (gen - g0) / dt!); " ";
      g0 = gen: t0! = TIMER
   END IF
   IF TMX THEN
      dt! = TIMER
      WHILE TMX > TIMER - dt!: WEND ' delay
   END IF
END SUB