in #lang "qb" dialect
'OPTION _EXPLICIT
'started by me ron77 on 6-15-2019 saturday night...
'one boring lonley weekend night i started to feel sad with no one to talk to...
'so i started this on my own so i won't feel lonely and sad all night
'by morning i got it right as a begining of a it was a white-night coding thing
'5-6-7 cups of coffee and a few cigarettes and relaxing music was all that it took
'by sun rise i felt better
'7 AM - add possiblemoves function
'10:30 AM - added a counter named turns to count turns and stop after 9 moves in case there is a tie and nobody wins
'9 PM - had a lesson with my teacher and we added a human vs. computer play with basic AI :) we also made some design modification
'6-17-2019 - more design modification to the board and to the code - added Bplus GetKey$ function and now no need for INPUT command to get user input added another loop to keep playing after first finished
'me and my teacher are working on a second harder AI alogarithem to beat in HUMAN VS. COMPUTER called INVICTUS MODE which will hopefully be very hard to beat next lesson on WED this week...
'6-18-2019 - in the meanwhile i am posting this short version 1 of tic tac toe in QB64 FORUM without level 2 INVICTUS MODE AI alogarithem: ENJOY! :)
'6-19-2019 - final version! thanks to all how helped!
'6-19-2019 - Bplus makeover reduce to less than 200 lines
'04-01-2020 stuck at home making a freebasic version
#Lang"qb"
'#Include "fbgfx.bi"
'_TITLE "MIDNIGHT TIC TAC TOE"
DIM SHARED game(8) AS STRING, numPlayer AS INTEGER, greetings AS STRING, code$, turns AS INTEGER
DIM SHARED scoreX AS INTEGER, scoreO AS INTEGER, scoreComp AS INTEGER
DIM i AS INTEGER, again$
Screen 0
FUNCTION GetKey$ (keysToCatch$)
DIM k$
DO
k$ = INKEY$
WHILE LEN(k$) = 0
k$ = INKEY$
'_LIMIT 60
Sleep 1
WEND
LOOP UNTIL INSTR(keysToCatch$, k$)
GetKey$ = k$
END FUNCTION
SUB cp (row, s$) 'print text centered on screen row
LOCATE row, (80 - LEN(s$)) / 2: PRINT s$;
END Sub
SUB board
CLS
cp 1, "Welcome to MIDNIGHT TIC TAC TOE GAME!"
cp 3, greetings
cp 5, "ÚÄÄÄÂÄÄÄÂÄÄÄ¿"
cp 6, "³ ³ ³ ³"
cp 7, "³ " + game(0) + " ³ " + game(1) + " ³ " + game(2) + " ³"
cp 8, "³(0)³(1)³(2)³"
cp 9, "ÃÄÄÄÅÄÄÄÅÄÄÄ´"
cp 10, "³ ³ ³ ³"
cp 11, "³ " + game(3) + " ³ " + game(4) + " ³ " + game(5) + " ³"
cp 12, "³(3)³(4)³(5)³"
cp 13, "ÃÄÄÄÅÄÄÄÅÄÄÄ´"
cp 14, "³ ³ ³ ³"
cp 15, "³ " + game(6) + " ³ " + game(7) + " ³ " + game(8) + " ³"
cp 16, "³(6)³(7)³(8)³"
cp 17, "ÀÄÄÄÁÄÄÄÁÄÄÄÙ"
END Sub
SUB opening
DIM k$
cp 3, DATE$ + " " + TIME$
cp 5, "WELCOME FRIEND TO:"
cp 7, "MIDNIGHT TIC TAC TOE GAME!"
cp 9, "WINS = 10 POINTS: TIES = 5 POINTS EACH"
cp 11, "A SMALL GAME TO PLAY BEFORE BED-TIME"
cp 13, "BY RON77, ITAY and BPLUS"
cp 18, "PRESS ENTER TO CONTINUE OR ESC TO QUIT"
k$ = GetKey$(CHR$(27) + Chr$(13))
IF k$ = CHR$(27) THEN END
cp 20, "Press 1 for One Player or 2 for Two Players?"
numPlayer = VAL(GetKey$("12"))
'cp 22, "PLAY IN FULL SCREEN MODE? - y/n"
'k$ = GetKey$("yn")
'IF k$ = "y" THEN GFX_FULLSCREEN
END Sub
FUNCTION AI
DIM i AS INTEGER, rndNumber AS INTEGER
FOR i = 0 TO 8 'computer seeks win
IF game(i) = " " THEN
game(i) = "O"
IF Winner$ = "O" THEN
AI = -1: EXIT FUNCTION 'signal win
ELSE
game(i) = " "
END IF
END IF
NEXT
FOR i = 0 TO 8 'computer seeks spoiler
IF game(i) = " " THEN
game(i) = "X"
IF Winner$ = "X" THEN
game(i) = "O": EXIT FUNCTION
ELSE
game(i) = " "
END IF
END IF
NEXT
IF game(4) = " " THEN game(4) = "O": EXIT FUNCTION
rndNumber = INT(RND * 9) 'computers picks random open space
WHILE game(rndNumber) <> " "
rndNumber = INT(RND * 9)
WEND
game(rndNumber) = "O"
END FUNCTION
FUNCTION Winner$
IF game(0) = game(1) AND game(1) = game(2) AND game(0) <> " " THEN
Winner$ = game(0)
ELSEIF game(3) = game(4) AND game(4) = game(5) AND game(3) <> " " THEN
Winner$ = game(3)
ELSEIF game(6) = game(7) AND game(7) = game(8) AND game(6) <> " " THEN
Winner$ = game(6)
ELSEIF game(0) = game(3) AND game(3) = game(6) AND game(0) <> " " THEN
Winner$ = game(0)
ELSEIF game(1) = game(4) AND game(4) = game(7) AND game(1) <> " " THEN
Winner$ = game(1)
ELSEIF game(2) = game(5) AND game(5) = game(8) AND game(2) <> " " THEN
Winner$ = game(2)
ELSEIF game(0) = game(4) AND game(4) = game(8) AND game(0) <> " " THEN
Winner$ = game(0)
ELSEIF game(6) = game(4) AND game(4) = game(2) AND game(6) <> " " THEN
Winner$ = game(6)
ELSE
Winner$ = ""
END IF
END FUNCTION
SUB ending
CLS
cp 7, "G O O D - N I G H T !"
cp 9, "AND SWEET DREAMS!"
cp 11, "HUMAN PLAYER X HAS" + STR$(scoreX) + " points"
IF numPlayer = 2 THEN
cp 13, "HUMAN PLAYER O HAS" + STR$(scoreO) + " points"
ELSE
cp 13, "COMPUTER PLAYER O HAS" + STR$(scoreComp) + " points"
END IF
SLEEP
END
END Sub
SUB player (sign$) 'replace 3 repeated code blocks with this
DIM k$, inpt AS INTEGER
code$ = ""
board
cp 19, "Where to mark " + sign$ + "? press 0-8 or ESC to stop:"
k$ = GetKey$(CHR$(27) + "012345678")
IF ASC(k$) = 27 THEN ending ELSE inpt = VAL(k$)
IF game(inpt) = " " THEN
game(inpt) = sign$
board
IF Winner$ = sign$ THEN
code$ = "win": cp 19, sign$ + " wins!"
ELSE
turns = turns + 1
IF turns = 9 THEN
code$ = "tie": cp 19, "Tie nobody wins!"
END IF
END IF
ELSE
board
cp 19, "The square is occupied choose another."
Sleep 1.5
player sign$ ' recursive do this again!
END IF
END SUB
opening
DO
FOR i = 0 TO 8: game(i) = " ": NEXT 'clear last board
turns = 0 'reset count
IF numPlayer = 2 THEN
greetings = "TWO PLAYERS X AND O"
DO
player "X"
IF code$ = "win" THEN scoreX = scoreX + 10: EXIT DO
IF code$ = "tie" THEN scoreX = scoreX + 5: scoreO = scoreO + 5: EXIT DO
player "O"
IF code$ = "win" THEN scoreO = scoreO + 10: EXIT DO
IF code$ = "tie" THEN scoreX = scoreX + 5: scoreO = scoreO + 5: EXIT DO
LOOP
ELSE
greetings = "HUMAN PLAYER AS X VS. COMPUTER AS O"
DO
player "X"
IF code$ = "win" THEN scoreX = scoreX + 10: EXIT DO
IF code$ = "tie" THEN scoreX = scoreX + 5: scoreComp = scoreComp + 5: EXIT DO
IF AI = -1 THEN
board
cp 19, "O is winner."
scoreComp = scoreComp + 10
EXIT DO
ELSE
turns = turns + 1
END IF
LOOP
END IF
cp 21, "play again y/n?"
again$ = UCASE$(GetKey$("yn"))
LOOP UNTIL again$ = "N"
ending
(https://i.imgur.com/cYWfV25.png)