DECLARE SUB INTERRUPTQB (intnum AS INTEGER, InReg AS ANY, OutReg AS ANY)
DECLARE FUNCTION NUMOFNEIGHBORS% (a%(), I%, J%)
DECLARE SUB ASSIGNLOGARRAY (a%(), B%())
DECLARE SUB DISPLAYARRAY (B%(), GEN%, DONEXTGEN%)
DECLARE SUB DETBIRTHORDEATH (AIJ%, N%, B%(), I%, J%)
DEFINT A-Z
DECLARE SUB GETINITCONFIG (a())
TYPE RegType
  AX AS INTEGER
  BX AS INTEGER
  CX AS INTEGER
  DX AS INTEGER
  BP AS INTEGER
  SI AS INTEGER
  DI AS INTEGER
  FLAGS AS INTEGER
  DS AS INTEGER
  ES AS INTEGER
END TYPE
DIM SHARED REGS AS RegType
CONST ROWS = 50
CONST COLS = 80
CONST CELLS = ROWS * COLS
CONST GENS = 100
DIM a(ROWS, COLS), B(ROWS, COLS)
WIDTH 80, 50
'Instructions
'============
'
'1) Run the program below to see a display. Cancel out
'
'2) Fix the numbers given and number of lines as required to make your program do something. To do that,
'   In sub GETINITCONFIG after CLS, find a block of instructions like this
' LOCATE 15, 33: PRINT "A"
' LOCATE 12, 18: PRINT "B"
' LOCATE 7, 47: PRINT "C"
' LOCATE 1, 46: PRINT "D"
' LOCATE 17, 43: PRINT "E"
' LOCATE 1, 25: PRINT "F"
' LOCATE 18, 48: PRINT "G"
' LOCATE 8, 58: PRINT "H"
' LOCATE 18, 4: PRINT "I"
' LOCATE 19, 22: PRINT "J"
'
'3) Tell the user how to EXC (just hit "x" in top-right of DOS Window?)'
'
'4) Now you can make it run. Give instructions to user by including something like this at the top
'
PRINT "***********"
PRINT "Instructions"
PRINT "============"
PRINT "1) Start program. Click to replace letters with asterisks"
PRINT "2) On the last letter, use right-click"
PRINT "3) Wait about x minutes. You should see this:"
PRINT SPACE$(10); "* * *"
PRINT SPACE$(10); " * "
PRINT SPACE$(10); "     *"
' qbguy: fix this so that it shows what the user should see
PRINT "4) When satisfied with the demo, go to SUB GETINITCONFIG and remove block of code that looks like this:"
PRINT "        LOCATE 15, 33: PRINT chr$(34);Achr$(34)"
PRINT "        LOCATE 12, 18: PRINT chr$(34);Bchr$(34)"
PRINT "        LOCATE 7, 47: PRINT chr$(34)C;chr$(34)"
PRINT "        etc."
LINE INPUT "Press Enter to get started"; e$: CLS

CALL GETINITCONFIG(a())
CALL ASSIGNLOGARRAY(a(), B())
CALL DISPLAYARRAY(a(), GEN, DONEXTGEN)
GEN = GEN + 1
DO WHILE GEN <= GENS AND DONEXTGEN
  FOR J = 2 TO COLS - 1
    FOR I = 2 TO ROWS - 1
      N = NUMOFNEIGHBORS(a(), I, J)
      CALL DETBIRTHORDEATH(a(I, J), N, B(), I, J)
    NEXT
  NEXT
  CALL DISPLAYARRAY(B(), GEN, DONEXTGEN)
  CALL ASSIGNLOGARRAY(B(), a())
  GEN = GEN + 1
LOOP

' Given two arrays, assign all cells of a to b
SUB ASSIGNLOGARRAY (a(), B())
  FOR J = 1 TO COLS
    FOR I = 1 TO ROWS
      B(I, J) = a(I, J)
    NEXT
  NEXT
END SUB

SUB DETBIRTHORDEATH (AIJ, N, B(), I, J)
  IF NOT AIJ AND N = 3 THEN
    B(I, J) = -1
  ELSEIF AIJ AND (N < 2 OR N > 3) THEN
    B(I, J) = 0
  END IF
END SUB

' Display all cells in array
SUB DISPLAYARRAY (B(), GEN, DONEXTGEN)
  DIM T AS SINGLE
  CLS
  FOR I = 1 TO ROWS
    FOR J = 1 TO COLS
      IF B(I, J) THEN PRINT "*";  ELSE PRINT " ";
    NEXT
  NEXT
  T = TIMER
  DO WHILE T > TIMER - .2
    KEY$ = INKEY$
    REGS.AX = 3
    CALL INTERRUPTQB(&H33, REGS, REGS)
    IF REGS.BX <> 0 OR KEY$ <> "" THEN EXIT DO
  LOOP
  IF KEY$ = CHR$(27) THEN END
  DONEXTGEN = -1
END SUB

' Get initial configuration
SUB GETINITCONFIG (a())
  DIM T AS SINGLE
  REGS.AX = 0
  CLS
LOCATE 15, 33: PRINT "A"
LOCATE 12, 18: PRINT "B"
LOCATE 7, 47: PRINT "C"
LOCATE 1, 46: PRINT "D"
LOCATE 17, 43: PRINT "E"
LOCATE 1, 25: PRINT "F"
LOCATE 18, 48: PRINT "G"
LOCATE 8, 58: PRINT "H"
LOCATE 18, 4: PRINT "I"
LOCATE 19, 22: PRINT "J"
  CALL INTERRUPTQB(&H33, REGS, REGS) 'Initialize mouse driver
  REGS.AX = 1
  CALL INTERRUPTQB(&H33, REGS, REGS) 'Show cursor
  DO
    REGS.AX = 3
    CALL INTERRUPTQB(&H33, REGS, REGS)
    IF REGS.BX = 1 THEN
      ROW = REGS.DX \ 8 + 1
      COL = REGS.CX \ 8 + 1
      a(ROW, COL) = NOT a(ROW, COL)
      REGS.AX = 2
      CALL INTERRUPTQB(&H33, REGS, REGS)
      LOCATE ROW, COL
      IF a(ROW, COL) THEN PRINT "*";  ELSE PRINT " ";
      REGS.AX = 1
      CALL INTERRUPTQB(&H33, REGS, REGS)
      T = TIMER: WHILE T > TIMER - .5: WEND
    END IF
  LOOP UNTIL REGS.BX = 2
END SUB

SUB INTERRUPTQB (intnum AS INTEGER, InReg AS RegType, OutReg AS RegType)
'standard INTERRUPTQB call compatibility with QBasic
'some static variables
STATIC a() AS LONG, bReady AS INTEGER
'If assembler array not created, create it
IF NOT bReady THEN
'don't change anything
I = 50: DIM a(1 TO I) AS LONG
a(1) = &H53EC8B55: a(2) = &H1E575651: a(3) = &H5E8B9C06: a(4) = &HA078B0E
a(5) = &HC70774E4: a(6) = &HE9FFFF07: a(7) = &HEC8300A1: a(8) = &HB3F88A0A
a(9) = &HE85E89CD: a(10) = &HCBEA46C7: a(11) = &H74253C90: a(12) = &H75263C04
a(13) = &HEA46C714: a(14) = &H46C701E8: a(15) = &HC7CB00EC: a(16) = &H2C2EE46
a(17) = &HF046C7: a(18) = &H85E8B90: a(19) = &H5E8B37FF: a(20) = &HE37FF06
a(21) = &H50008FB8: a(22) = &HE85E8D16: a(23) = &H8BDA8C53: a(24) = &H378B0A5E
a(25) = &H8E0C5E8B: a(26) = &H10448B1F: a(27) = &H75FFFF3D: a(28) = &H50C28B02
a(29) = &H3D12448B: a(30) = &H275FFFF: a(31) = &HC08EC28B: a(32) = &H5C8B048B
a(33) = &H44C8B02: a(34) = &H8B06548B: a(35) = &H748B0C7C: a(36) = &H9CCB1F0A
a(37) = &H83EC8B55: a(38) = &H1E5620C5: a(39) = &H89E476C5: a(40) = &H25C8904
a(41) = &H89044C89: a(42) = &H7C890654: a(43) = &H12448C0C: a(44) = &H8F10448F
a(45) = &H448F0A44: a(46) = &HE448F08: a(47) = &H9D0EC483: a(48) = &H5E5F1F07
a(49) = &HCA5D5B59: a(50) = &H9165000A
'Checksum, can be ommited
S1 = 0: S2 = 0: p = VARPTR(a(1)): DEF SEG = VARSEG(a(1))
FOR I = 0 TO 199
S1 = (S1 + PEEK(p + I)) MOD 255: S2 = (S2 + S1) MOD 255
NEXT I
IF S1 OR S2 THEN ERROR 2: intnum = -1: EXIT SUB ' Checksum Error
'End of the checksum
bReady = -1
END IF
'This is where we call our assembler INTERRUPTQB calling function
DEF SEG = VARSEG(a(1))
CALL ABSOLUTE(intnum, VARSEG(InReg), VARPTR(InReg), VARSEG(OutReg), VARPTR(OutReg), 0)
END SUB

FUNCTION NUMOFNEIGHBORS (a(), I, J)
  N = 0
  FOR C = J - 1 TO J + 1
    FOR R = I - 1 TO I + 1
      IF a(R, C) THEN N = N + 1
    NEXT
  NEXT
  IF a(I, J) THEN N = N - 1
  NUMOFNEIGHBORS = N
END FUNCTION