I found this in an old folder while getting source code for the TAS utilities I wrote a while ago (I gave them to Raiscan so they should be on his emulator site at some point).
It's Connect 4. It was fun programming the AI, but I've since learned that this game is "solved" and player 1 can always win if playing perfectly, and the AI here is not that good.
Sorry for the long code.
Edit: Some of the code didn't paste the first time.
Edit: Trying again, now with HTML disabled. I sure don't miss this forum markup crap!
DECLARE SUB assigndifficulty ()
DECLARE SUB updatecursor ()
DECLARE SUB updateboardinfo ()
DECLARE FUNCTION checkwin! ()
DECLARE FUNCTION getplayermove! ()
DECLARE FUNCTION getcomputermove! ()
DECLARE SUB introscreen ()
DECLARE SUB setcolors ()
DECLARE SUB showcolors ()
DECLARE SUB drawboard ()
' JXQ
' Winter 2005
' Connect Four Program
'(6,1) (6,7)
'
'
'
'
'(1,1) (1,7)
' Declare variables
TYPE gamedata
colour AS INTEGER 'Represents the color of the checker
'in a particular spot.
'0 - no checker
'1 - red
'2 - black
red AS INTEGER 'Used to keep track of spots that are
'potential winning spaces for red.
'0 - no potential
'1 - red 3-in-a-row
'2 - red 2-in-a-row
black AS INTEGER 'Used to keep track of spots that are
'potential winning spaces for black.
'0 - no potential
'1 - black 3-in-a-row
'2 - black 2-in-a-row
END TYPE
TYPE boarddata
height AS INTEGER 'Keeps track of each column's height.
'If x checkers have been placed in a column,
'height = x.
red2win AS INTEGER 'Boolean value if a column has a two-way-win
'in a particular column for red.
black2win AS INTEGER 'Boolean value if a column has a two-way-win
'in a particular column for black.
movevalue AS SINGLE 'Used in computer AI, representing the value
'of making the move in a particular column.
END TYPE
DIM SHARED board(1 TO 6, 1 TO 7) AS gamedata 'gamedata TYPE, one for each space
DIM SHARED boardinfo(1 TO 7) AS boarddata 'boardata TYPE, one for each column
DIM SHARED computermove(1 TO 7) AS INTEGER 'computer's priority of moves
DIM SHARED temp(1 TO 6, 1 TO 7) AS gamedata 'another gamedata TYPE, used for
'testing moves in AI
DIM SHARED tempinfo(1 TO 7) AS boarddata 'another boarddata TYPE, used for
'testing moves in AI
DIM SHARED playertypes AS INTEGER '0 - replay, 1 - 1 player, 2 - 2 player
playertypes = 1 '1 player mode is default
DIM SHARED whosturn AS INTEGER '1 - black's turn, 2 - red's turn
DIM SHARED whoisfirstmethod AS INTEGER 'Configurable option.
'0 - black always first
'1 - black, then winner always first
'2 - black, then loser always first
'3 - red always first
'4 - red, then winner always first
'5 - red, then loser always first
whoisfirstmethod = 6 '6 - random always first (DEFAULT)
'7 - random, then winner always first
'8 - random, then loser always first
DIM SHARED difficulty AS INTEGER '1----2----3----4----5
difficulty = 3 'easy <-default-> hard
DIM SHARED diffvalue(1 TO 7) AS SINGLE 'table of difficulty values
DIM SHARED stillplaying AS INTEGER '0 - not playing, 1 - still playing
stillplaying = 1
DIM SHARED cursorcolumn AS INTEGER 'Keeps track of the moving cursor
cursorcolumn = 4
DIM SHARED soundon AS INTEGER '0 - no sound, 1 - sound
soundon = 1
DIM SHARED movelist(1 TO 42) AS INTEGER
DIM SHARED skycolor(1 TO 17) AS INTEGER
RANDOMIZE TIMER
DO
CALL introscreen
'Here is the main title screen, selecting from:
'1-player game, 2-player game, options menu, and exit
CALL setcolors
'numberofmoves is used as an indicator for being the first game or not
numberofmoves = 0
stillplaying = 1
CALL assigndifficulty
DO WHILE stillplaying = 1
CLS
CALL drawboard
'Clear board data
FOR i = 1 TO 6
FOR j = 1 TO 7
board(i, j).colour = 0
board(i, j).red = 0
board(i, j).black = 0
boardinfo(j).height = 0
boardinfo(j).red2win = 0
boardinfo(j).black2win = 0
boardinfo(j).movevalue = 0
NEXT j
NEXT i
'Based on options, assign who's turn is first for the first game
'If this is the first game:
IF numberofmoves = 0 THEN
SELECT CASE whoisfirstmethod
CASE 0, 1, 2
whosturn = 1
CASE 3, 4, 5
whosturn = 2
CASE 6, 7, 8
whosturn = INT(RND + .5) + 1
END SELECT
'if this is not the first game
ELSE
SELECT CASE whoisfirstmethod
CASE 0
whosturn = 1
CASE 3
whosturn = 2
CASE 6
whosturn = INT(RND + .5) + 1
CASE 1, 4, 7
IF whosturn = 2 THEN whosturn = 1 ELSE whosturn = 2
END SELECT
END IF
numberofmoves = 0
DO
SELECT CASE playertypes
CASE 1
IF whosturn = 2 THEN
nextmove = getplayermove
IF soundon = 1 THEN PLAY "mfo4l32dd"
END IF
IF whosturn = 1 THEN
nextmove = getcomputermove
IF soundon = 1 THEN PLAY "mfo4p2l32ff" ELSE PLAY "mfp2p32"
END IF
CASE 2
nextmove = getplayermove
IF whosturn = 2 THEN
IF soundon = 1 THEN PLAY "mfo4l32ddp8" ELSE PLAY "mfp8p32"
END IF
IF whosturn = 1 THEN
IF soundon = 1 THEN PLAY "mfo4l32ffp8" ELSE PLAY "mfp8p32"
END IF
END SELECT
'Clear keyboard buffer
DO
a$ = INKEY$
LOOP UNTIL a$ = ""
'Fill the correct colored checker in
'Add highlighted border to show it was the last move made
IF numberofmoves > 0 THEN CIRCLE (48 + INT(37.4 * (movelist(numberofmoves) - 1)), 144.5 - INT(24.2 * (boardinfo(movelist(numberofmoves)).height - 1))), 13, 0
PAINT (48 + INT(37.4 * (nextmove - 1)), 145.2 - INT(24.2 * boardinfo(nextmove).height)), (whosturn - 1) * 16 + 16, 0
CIRCLE (48 + INT(37.4 * (nextmove - 1)), 144.5 - INT(24.2 * boardinfo(nextmove).height)), 13, 80
'Update simple board data
'Increase the height of the column played
board(boardinfo(nextmove).height + 1, nextmove).colour = whosturn
boardinfo(nextmove).height = boardinfo(nextmove).height + 1
'Update more advanced board information for 1-player game
IF playertypes = 1 THEN CALL updateboardinfo
'Enable these next lines to show 2-in-a-rows, 3-in-a-rows,
'and two-way-wins
' FOR i = 1 TO 7
' FOR j = 1 TO 6
' IF board(j, i).red <> 0 THEN LINE (43 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (j - 1)))-(48 + INT(37.4 * (i - 1)), 150.2 - INT(24.2 * (j - 1))), 32, BF
' IF board(j, i).red = 1 THEN LINE (43 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (j - 1)))-(48 + INT(37.4 * (i - 1)), 150.2 - INT(24.2 * (j - 1))), 250, B
'
' IF board(j, i).black <> 0 THEN LINE (48 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (j - 1)))-(53 + INT(37.4 * (i - 1)), 150.2 - INT(24.2 * (j - 1))), 48, BF
' IF board(j, i).black = 1 THEN LINE (48 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (j - 1)))-(53 + INT(37.4 * (i - 1)), 150.2 - INT(24.2 * (j - 1))), 250, B
'
' NEXT j
'
' IF boardinfo(i).red2win > 0 THEN PAINT (48 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (boardinfo(i).red2win - 1))), 64, 0
' IF boardinfo(i).black2win > 0 THEN PAINT (48 + INT(37.4 * (i - 1)), 140.2 - INT(24.2 * (boardinfo(i).black2win - 1))), 64, 0
' NEXT i
'Increase the number of total moves by 1
numberofmoves = numberofmoves + 1
'Add the current move to the move list
movelist(numberofmoves) = nextmove
'Switch who's turn it is for the next move
IF whosturn = 2 THEN whosturn = 1 ELSE whosturn = 2
'Clear the dialog box
LOCATE 23, 1
PRINT SPACE$(38)
'Check the board for a win, and break the loop if found
IF checkwin = 1 THEN EXIT DO
LOOP UNTIL numberofmoves = 42
LOCATE 23, 1
IF checkwin = 0 THEN
PRINT "it's a tie"
ELSE
IF playertypes = 1 THEN
PRINT "You ";
IF whosturn = 2 THEN
PRINT "lose"
IF soundon = 1 THEN PLAY "mfo3l16eedp16l8c"
ELSE
PRINT "win!"
IF soundon = 1 THEN PLAY "mfo4l16ffgp16l8o5c"
END IF
ELSE
IF whosturn = 1 THEN PRINT "Red"; ELSE PRINT "Black";
PRINT " wins!"
IF soundon = 1 THEN PLAY "mfo4l16ffgp16l8o5c"
END IF
END IF
'Routine asking to play again. If yes, determine who is
'first based on who is current and first procedure from options
LOCATE 23, 20: PRINT "Play again? (Y/N)"
DO UNTIL a$ = "Y" OR a$ = "N"
a$ = UCASE$(INKEY$)
LOOP
IF a$ = "N" THEN stillplaying = 0
LOOP
'If not playing again, return to the title screen
LOOP
SUB assigndifficulty
IF difficulty = 1 THEN
diffvalue(1) = .5
diffvalue(2) = .7
diffvalue(3) = .8
diffvalue(4) = .88
diffvalue(5) = .95
diffvalue(6) = .98
diffvalue(7) = 1
END IF
IF difficulty = 2 THEN
diffvalue(1) = .65
diffvalue(2) = .85
diffvalue(3) = .95
diffvalue(4) = .98
diffvalue(5) = 1
diffvalue(6) = 1
diffvalue(7) = 1
END IF
IF difficulty = 3 THEN
diffvalue(1) = .8
diffvalue(2) = .95
diffvalue(3) = .985
diffvalue(4) = 1
diffvalue(5) = 1
diffvalue(6) = 1
diffvalue(7) = 1
END IF
IF difficulty = 4 THEN
diffvalue(1) = .95
diffvalue(2) = .99
diffvalue(3) = 1
diffvalue(4) = 1
diffvalue(5) = 1
diffvalue(6) = 1
diffvalue(7) = 1
END IF
IF difficulty = 5 THEN
diffvalue(1) = 1
diffvalue(2) = 1
diffvalue(3) = 1
diffvalue(4) = 1
diffvalue(5) = 1
diffvalue(6) = 1
diffvalue(7) = 1
END IF
END SUB
'This program checks board for a win (four checkers
'in a row horizontally, vertically, or diagonally)
'and returns integer value of 1 if a win is found.
'
FUNCTION checkwin
FOR i = 1 TO 6
FOR j = 1 TO 7
'check win to the right
IF board(i, j).colour <> 0 THEN
IF j <= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 1, j + 1).colour = board(i + 2, j + 2).colour AND board(i + 2, j + 2).colour = board(i + 3, j + 3).colour THEN checkwin = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 1, j + 1).colour = board(i - 2, j + 2).colour AND board(i - 2, j + 2).colour = board(i - 3, j + 3).colour THEN checkwin = 1
END IF
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 1).colour = board(i, j + 2).colour AND board(i, j + 2).colour = board(i, j + 3).colour THEN checkwin = 1
END IF
IF j >= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 1, j - 1).colour = board(i + 2, j - 2).colour AND board(i + 2, j - 2).colour = board(i + 3, j - 3).colour THEN checkwin = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 1, j - 1).colour = board(i - 2, j - 2).colour AND board(i - 2, j - 2).colour = board(i - 3, j - 3).colour THEN checkwin = 1
END IF
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 1).colour = board(i, j - 2).colour AND board(i, j - 2).colour = board(i, j - 3).colour THEN checkwin = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j).colour AND board(i - 1, j).colour = board(i - 2, j).colour AND board(i - 2, j).colour = board(i - 3, j).colour THEN checkwin = 1
END IF
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j).colour AND board(i + 1, j).colour = board(i + 2, j).colour AND board(i + 2, j).colour = board(i + 3, j).colour THEN checkwin = 1
END IF
END IF
NEXT j
NEXT i
END FUNCTION
'Subroutine called at the beginning of each game to draw the new board
'
'
SUB drawboard
SCREEN 13
CLS
'draw layered sky
FOR j = 170 TO 11 STEP -15
LINE (0, 0)-(320, j), 65 - (j \ 10), BF
NEXT j
'draw individual checker spaces
LINE (30, 10)-(290, 160), 0, B
FOR i = 0 TO 6
FOR j = 0 TO 5
CIRCLE (48 + INT(37.4 * i), 24 + INT(24.18 * j)), 13, 0
NEXT j
NEXT i
PAINT (31, 11), 14, 0
END SUB
'Artificial Intelligence function used for the computer
'to determine which column to move, based on the status
'of board & boardinfo. Returns column to move in.
'
FUNCTION getcomputermove
LOCATE 23, 1
COLOR 25
PRINT "Computer is thinking..."
'reset the base values for each column's movement value
'add in slight degree of randomness for equal values
FOR i = 1 TO 7
boardinfo(i).movevalue = ((3 - ABS(4 - i) + (6 - boardinfo(i).height)) / 10) + (RND / 20)
NEXT i
FOR i = 1 TO 7
IF boardinfo(i).height < 6 THEN
'First check for a computer-win
IF board(boardinfo(i).height + 1, i).black = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 300: LOCATE 2, 1
'Then check for a human-win to block
IF board(boardinfo(i).height + 1, i).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 150: LOCATE 3, 1
'Then check for a human-win creation to avoid
IF boardinfo(i).height < 5 THEN
IF board(boardinfo(i).height + 2, i).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue - 150
END IF
'Now check for an existing 2-way win to build toward
IF boardinfo(i).black2win > 0 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 50 + boardinfo(i).black2win
'Now check for an existing 2-way loss to avoid
IF boardinfo(i).red2win > 0 THEN boardinfo(i).movevalue = boardinfo(i).movevalue - 50 - boardinfo(i).black2win
'Copy board info into a dummy array
FOR j = 1 TO 7
FOR k = 1 TO 6
temp(k, j) = board(k, j)
NEXT k
tempinfo(j) = boardinfo(j)
NEXT j
'Now place a red checker in column i of this data structure
board(boardinfo(i).height + 1, i).colour = 2
boardinfo(i).height = boardinfo(i).height + 1
CALL updateboardinfo
FOR j = 1 TO 7
'If a new 2-way-win exists for red in any column, block this move
IF boardinfo(j).red2win <> tempinfo(j).red2win AND boardinfo(j).red2win <> 0 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 12
'If a new 3-in-a-row win exists for red, block this move
IF boardinfo(j).height < 6 AND boardinfo(j).height > 0 THEN
IF temp(boardinfo(j).height + 1, j).red <> 1 AND board(boardinfo(j).height + 1, j).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 10: LOCATE 8, 1
END IF
'If a new 3-in-a-row non-win exists for red, block this move
FOR k = 1 TO 6
IF temp(k, j).red <> 1 AND board(k, j).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 3: : LOCATE 9, 1
NEXT k
NEXT j
'change the placed red checker to black
board(boardinfo(i).height, i).colour = 1
CALL updateboardinfo
FOR j = 1 TO 7
'If a new 2-way-win exists for black in any column, make this move
IF boardinfo(j).black2win <> tempinfo(j).black2win AND boardinfo(j).black2win <> 0 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 12
'If a new 3-in-a-row win exists for black, make this move
IF boardinfo(j).height < 6 AND boardinfo(j).height > 0 THEN
IF temp(boardinfo(j).height + 1, j).black <> 1 AND board(boardinfo(j).height + 1, j).black = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 15
END IF
FOR k = 1 TO 6
'If a new 3-in-a-row non-win exists for black, make this move
IF temp(k, j).black <> 1 AND board(k, j).black = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 4
'If a new 2-in-a-row non-win exists for black, make this move
IF temp(k, j).black <> 2 AND board(k, j).black = 2 THEN boardinfo(i).movevalue = boardinfo(i).movevalue + 1
NEXT k
NEXT j
'if there is space above the placed black checker
IF boardinfo(i).height < 6 THEN
'place a red checker above it
board(boardinfo(i).height + 1, i).colour = 2
boardinfo(i).height = boardinfo(i).height + 1
CALL updateboardinfo
FOR j = 1 TO 7
'If moving here creates a new 2-way-win for red in any column, avoid this move
IF boardinfo(j).red2win <> tempinfo(j).red2win AND boardinfo(j).red2win <> 0 THEN boardinfo(i).movevalue = boardinfo(i).movevalue - 12
'If moving here creates a new 3-in-a-row win for red, avoid this move
IF boardinfo(j).height < 6 AND boardinfo(j).height > 0 THEN
IF board(boardinfo(j).height + 1, j).red <> temp(boardinfo(j).height + 1, j).red AND board(boardinfo(j).height + 1, j).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue - 10
END IF
'If moving here creates a new 3-in-a-row non-win for red, avoid this move
FOR k = 1 TO 6
IF temp(k, j).red <> 1 AND board(k, j).red = 1 THEN boardinfo(i).movevalue = boardinfo(i).movevalue - 3
NEXT k
NEXT j
'remove the top red checker
board(boardinfo(i).height, i).colour = 0
boardinfo(i).height = boardinfo(i).height - 1
CALL updateboardinfo
END IF
'remove the top black checker, returning the board
'to its original state
board(boardinfo(i).height, i).colour = 0
boardinfo(i).height = boardinfo(i).height - 1
CALL updateboardinfo
ELSE
boardinfo(i).movevalue = -1000
END IF
NEXT i
currentmaximum = -500
currentmove = 4
LOCATE 1, 1
FOR i = 1 TO 7
computermove(i) = i
'Uncomment this line to see computer AI values
' PRINT boardinfo(i).movevalue; " ";
NEXT i
'Bubble Sort computer's moves - computermove(1) > ... > computermove(7)
FOR i = 6 TO 1 STEP -1
FOR j = 6 TO i STEP -1
IF boardinfo(computermove(j)).movevalue < boardinfo(computermove(j + 1)).movevalue THEN
temp = computermove(j)
computermove(j) = computermove(j + 1)
computermove(j + 1) = temp
END IF
NEXT j
NEXT i
'Computermove(7) is the best move. Depending on the difficulty,
'each move has a predetermined probability of being selected
temp = RND
selectedmove = 0
'Cycle through the chart values and assign the appropriate move
FOR i = 7 TO 1 STEP -1
IF temp < diffvalue(i) THEN currentmove = computermove(i)
'In case an illegal move is selected, change it
IF boardinfo(currentmove).movevalue = -1000 THEN currentmove = computermove(i - 1)
NEXT i
getcomputermove = currentmove
END FUNCTION
'This function will get input from the keyboard determining
'which column the human player chooses to move in.
'
FUNCTION getplayermove
DO 'Clear the keyboard buffer
a$ = INKEY$
LOOP UNTIL a$ = ""
LOCATE 23, 1
COLOR 47
IF playertypes = 2 THEN
IF whosturn = 2 THEN
PRINT "Red's turn: ";
ELSEIF whosturn = 1 THEN
COLOR 25
PRINT "Black's turn: ";
END IF
END IF
PRINT "Make your move "
moveconfirmed = 0 'Player is asked for a move until
'moveconfirmed = 1. This is to
'stop players from choosing columns
'that are already full.
DO
CALL updatecursor
DO
a$ = INKEY$
IF a$ = "" THEN a$ = "0"
IF a$ = CHR$(0) + "K" AND cursorcolumn > 1 THEN
cursorcolumn = cursorcolumn - 1
CALL updatecursor
END IF
IF a$ = CHR$(0) + "M" AND cursorcolumn < 7 THEN
cursorcolumn = cursorcolumn + 1
CALL updatecursor
END IF
'Escape key to end at any time
IF a$ = CHR$(27) THEN SYSTEM
LOOP UNTIL ASC(a$) > 48 AND ASC(a$) < 56 OR ASC(a$) = 13
IF ASC(a$) <> 13 THEN loopmove = ASC(a$) - 48 ELSE loopmove = cursorcolumn
IF boardinfo(loopmove).height < 6 THEN
moveconfirmed = 1
ELSE
PLAY "mfo3l8c"
END IF
LOOP UNTIL moveconfirmed = 1
getplayermove = loopmove
END FUNCTION
SUB introscreen
SCREEN 12
COLOR 15
CLS
'Basic menu system, to adjust options and so forth
LOCATE 6, 25: PRINT "Connect 4 by JXQ"
LOCATE 10, 20: PRINT "Begin 1-player game"
LOCATE 12, 20: PRINT "Begin 2-player game"
LOCATE 14, 20: PRINT "Difficulty: "
LOCATE 16, 20: PRINT "Who goes first: "
LOCATE 18, 20: PRINT "Sound: "
LOCATE 20, 20: PRINT "Quit"
COLOR 7
LOCATE 14, 50: PRINT "Up and down arrows to"
LOCATE 15, 50: PRINT "select options"
LOCATE 17, 50: PRINT "Left and right arrows"
LOCATE 18, 50: PRINT "to adjust options"
LOCATE 20, 50: PRINT "Enter to begin a game"
LOCATE 21, 50: PRINT "ESC to quit program"
COLOR 15
breakloop = 0
menucursor = 1
DO UNTIL breakloop = 1
COLOR 15
LOCATE 14, 32
SELECT CASE difficulty
CASE 1
PRINT "Very Easy "
CASE 2
PRINT "Easy "
CASE 3
PRINT "Average "
CASE 4
PRINT "Difficult "
CASE 5
PRINT "Very Difficult"
END SELECT
LOCATE 16, 36
SELECT CASE whoisfirstmethod
CASE 0
PRINT "Black always "
CASE 1
PRINT "Black, then winner "
CASE 2
PRINT "Black, then loser "
CASE 3
PRINT "Red always "
CASE 4
PRINT "Red, then winner "
CASE 5
PRINT "Red, then loser "
CASE 6
PRINT "Random always "
CASE 7
PRINT "Random, then winner"
CASE 8
PRINT "Random, then loser "
END SELECT
LOCATE 18, 27
IF soundon = 0 THEN PRINT "Off" ELSE PRINT "On "
LOCATE 10, 17: PRINT " "
LOCATE 12, 17: PRINT " "
LOCATE 14, 17: PRINT " "
LOCATE 16, 17: PRINT " "
LOCATE 18, 17: PRINT " "
LOCATE 20, 17: PRINT " "
LOCATE (menucursor * 2) + 8, 17
COLOR 14
PRINT "->"
DO
a$ = INKEY$
IF a$ = CHR$(0) + "H" AND menucursor > 1 THEN
menucursor = menucursor - 1
END IF
IF a$ = CHR$(0) + "P" AND menucursor < 6 THEN
menucursor = menucursor + 1
END IF
IF a$ = CHR$(0) + "M" THEN
IF menucursor = 3 AND difficulty < 5 THEN difficulty = difficulty + 1
IF menucursor = 4 AND whoisfirstmethod < 8 THEN whoisfirstmethod = whoisfirstmethod + 1
IF menucursor = 5 AND soundon = 0 THEN soundon = 1: PLAY "mfl16o2c"
END IF
IF a$ = CHR$(0) + "K" THEN
IF menucursor = 3 AND difficulty > 1 THEN difficulty = difficulty - 1
IF menucursor = 4 AND whoisfirstmethod > 0 THEN whoisfirstmethod = whoisfirstmethod - 1
IF menucursor = 5 AND soundon = 1 THEN soundon = 0
END IF
IF a$ = CHR$(13) THEN
IF menucursor = 1 THEN playertypes = 1: EXIT SUB
IF menucursor = 2 THEN playertypes = 2: EXIT SUB
IF menucursor = 6 THEN SYSTEM
END IF
IF a$ = CHR$(27) THEN SYSTEM
LOOP UNTIL a$ = CHR$(0) + "H" OR a$ = CHR$(0) + "K" OR a$ = CHR$(0) + "M" OR a$ = CHR$(0) + "P" OR a$ = CHR$(13)
LOOP
END SUB
'Subroutine used to test color schemes.
'
'
SUB setcolors
SCREEN 13
'sky colors (48-63)
FOR i = 16 TO 31
PALETTE (i + 32), (65536 * i * 2)
NEXT i
' red checker colors (32-47)
FOR i = 16 TO 31
PALETTE i + 16, (i * 2)
NEXT i
' black checker colors already colors 16 - 31
END SUB
SUB showcolors
SCREEN 13
FOR i = 1 TO 16
FOR j = 1 TO 16
LINE (0 + (20 * (i - 1)), 0 + (12.5 * (j - 1)))-(0 + (20 * i), 0 + (12.5 * j)), 16 * (i - 1) + j - 1, BF
NEXT j
NEXT i
END SUB
'right, upright, up, upleft do NOT WORK
'
'This subroutine will update parts of the board and boardinfo
'array / structure.
'
'board(i, j).red and board(i, j).black are updated for each spot
'to keep track of potential winning spaces for red and black.
'
'boardinfo(n).red2way and boardinfo(n).black2way represent
'the height of the lower space of any 2-way wins that are
'in place for red or black.
'
'Since this information is used primarily for computer AI,
'this subroutine is ran only in one-player mode.
'(row, col)
SUB updateboardinfo
FOR i = 1 TO 6
FOR j = 1 TO 7
board(i, j).red = 0
board(i, j).black = 0
NEXT j
NEXT i
FOR j = 1 TO 7
boardinfo(j).red2win = 0
boardinfo(j).black2win = 0
NEXT j
FOR i = 1 TO 6
FOR j = 1 TO 7
'check 2-in-a-row for red
IF board(i, j).colour = 2 THEN
IF j <= 5 THEN
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 2, j + 2).colour = 0 THEN board(i + 2, j + 2).red = 2
END IF
IF i >= 3 THEN
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 2, j + 2).colour = 0 THEN board(i - 2, j + 2).red = 2
END IF
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 2).colour = 0 THEN board(i, j + 2).red = 2
END IF
IF j >= 3 THEN
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 2, j - 2).colour = 0 THEN board(i + 2, j - 2).red = 2
END IF
IF i >= 3 THEN
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 2, j - 2).colour = 0 THEN board(i - 2, j - 2).red = 2
END IF
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 2).colour = 0 THEN board(i, j - 2).red = 2
END IF
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j).colour AND board(i + 2, j).colour = 0 THEN board(i + 2, j).red = 2
END IF
END IF
'Check 2-in-a-row for black
IF board(i, j).colour = 1 THEN
IF j <= 5 THEN
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 2, j + 2).colour = 0 THEN board(i + 2, j + 2).black = 2
END IF
IF i >= 3 THEN
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 2, j + 2).colour = 0 THEN board(i - 2, j + 2).black = 2
END IF
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 2).colour = 0 THEN board(i, j + 2).black = 2
END IF
IF j >= 3 THEN
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 2, j - 2).colour = 0 THEN board(i + 2, j - 2).black = 2
END IF
IF i >= 3 THEN
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 2, j - 2).colour = 0 THEN board(i - 2, j - 2).black = 2
END IF
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 2).colour = 0 THEN board(i, j - 2).black = 2
END IF
IF i <= 4 THEN
IF board(i, j).colour = board(i + 1, j).colour AND board(i + 2, j).colour = 0 THEN board(i + 2, j).black = 2
END IF
END IF
NEXT j
NEXT i
FOR i = 1 TO 6
FOR j = 1 TO 7
'check 3-in-a-row for red
IF board(i, j).colour = 2 THEN
IF j <= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 1, j + 1).colour = board(i + 2, j + 2).colour AND board(i + 3, j + 3).colour = 0 THEN board(i + 3, j + 3).red = 1
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 1, j + 1).colour = board(i + 3, j + 3).colour AND board(i + 2, j + 2).colour = 0 THEN board(i + 2, j + 2).red = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 1, j + 1).colour = board(i - 2, j + 2).colour AND board(i - 3, j + 3).colour = 0 THEN board(i - 3, j + 3).red = 1
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 1, j + 1).colour = board(i - 3, j + 3).colour AND board(i - 2, j + 2).colour = 0 THEN board(i - 2, j + 2).red = 1
END IF
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 1).colour = board(i, j + 2).colour AND board(i, j + 3).colour = 0 THEN board(i, j + 3).red = 1
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 1).colour = board(i, j + 3).colour AND board(i, j + 2).colour = 0 THEN board(i, j + 2).red = 1
END IF
IF j >= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 1, j - 1).colour = board(i + 2, j - 2).colour AND board(i + 3, j - 3).colour = 0 THEN board(i + 3, j - 3).red = 1
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 1, j - 1).colour = board(i + 3, j - 3).colour AND board(i + 2, j - 2).colour = 0 THEN board(i + 2, j - 2).red = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 1, j - 1).colour = board(i - 2, j - 2).colour AND board(i - 3, j - 3).colour = 0 THEN board(i - 3, j - 3).red = 1
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 1, j - 1).colour = board(i - 3, j - 3).colour AND board(i - 2, j - 2).colour = 0 THEN board(i - 2, j - 2).red = 1
END IF
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 1).colour = board(i, j - 2).colour AND board(i, j - 3).colour = 0 THEN board(i, j - 3).red = 1
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 1).colour = board(i, j - 3).colour AND board(i, j - 2).colour = 0 THEN board(i, j - 2).red = 1
END IF
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j).colour AND board(i + 1, j).colour = board(i + 2, j).colour AND board(i + 3, j).colour = 0 THEN board(i + 3, j).red = 1
END IF
END IF
'Check 3-in-a-row for black
IF board(i, j).colour = 1 THEN
IF j <= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 1, j + 1).colour = board(i + 2, j + 2).colour AND board(i + 3, j + 3).colour = 0 THEN board(i + 3, j + 3).black = 1
IF board(i, j).colour = board(i + 1, j + 1).colour AND board(i + 1, j + 1).colour = board(i + 3, j + 3).colour AND board(i + 2, j + 2).colour = 0 THEN board(i + 2, j + 2).black = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 1, j + 1).colour = board(i - 2, j + 2).colour AND board(i - 3, j + 3).colour = 0 THEN board(i - 3, j + 3).black = 1
IF board(i, j).colour = board(i - 1, j + 1).colour AND board(i - 1, j + 1).colour = board(i - 3, j + 3).colour AND board(i - 2, j + 2).colour = 0 THEN board(i - 2, j + 2).black = 1
END IF
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 1).colour = board(i, j + 2).colour AND board(i, j + 3).colour = 0 THEN board(i, j + 3).black = 1
IF board(i, j).colour = board(i, j + 1).colour AND board(i, j + 1).colour = board(i, j + 3).colour AND board(i, j + 2).colour = 0 THEN board(i, j + 2).black = 1
END IF
IF j >= 4 THEN
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 1, j - 1).colour = board(i + 2, j - 2).colour AND board(i + 3, j - 3).colour = 0 THEN board(i + 3, j - 3).black = 1
IF board(i, j).colour = board(i + 1, j - 1).colour AND board(i + 1, j - 1).colour = board(i + 3, j - 3).colour AND board(i + 2, j - 2).colour = 0 THEN board(i + 2, j - 2).black = 1
END IF
IF i >= 4 THEN
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 1, j - 1).colour = board(i - 2, j - 2).colour AND board(i - 3, j - 3).colour = 0 THEN board(i - 3, j - 3).black = 1
IF board(i, j).colour = board(i - 1, j - 1).colour AND board(i - 1, j - 1).colour = board(i - 3, j - 3).colour AND board(i - 2, j - 2).colour = 0 THEN board(i - 2, j - 2).black = 1
END IF
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 1).colour = board(i, j - 2).colour AND board(i, j - 3).colour = 0 THEN board(i, j - 3).black = 1
IF board(i, j).colour = board(i, j - 1).colour AND board(i, j - 1).colour = board(i, j - 3).colour AND board(i, j - 2).colour = 0 THEN board(i, j - 2).black = 1
END IF
IF i <= 3 THEN
IF board(i, j).colour = board(i + 1, j).colour AND board(i + 1, j).colour = board(i + 2, j).colour AND board(i + 3, j).colour = 0 THEN board(i + 3, j).black = 1
END IF
END IF
NEXT j
NEXT i
FOR j = 1 TO 7
FOR i = 5 TO 1 STEP -1
'check two-way-wins for red and black
IF board(i, j).red = 1 AND board(i + 1, j).red = 1 THEN boardinfo(j).red2win = i
IF board(i, j).black = 1 AND board(i + 1, j).black = 1 THEN boardinfo(j).black2win = i
NEXT i
NEXT j
END SUB
'This subroutine updates the position of the cursor used with
'the player to select a column to play.
'
SUB updatecursor
LINE (0, 0)-(320, 10), 63, BF
LINE (7 + INT(37.4 * cursorcolumn), 5)-(14 + INT(37.4 * cursorcolumn), 5), 100
LINE (7 + INT(37.4 * cursorcolumn), 5)-(11 + INT(37.4 * cursorcolumn), 8), 100
LINE (11 + INT(37.4 * cursorcolumn), 8)-(14 + INT(37.4 * cursorcolumn), 5), 100
PAINT (11 + INT(37.4 * cursorcolumn), 6), 100, 100
END SUB
