News:

Welcome to RetroCoders Community

Main Menu

tic-tac-toe game

Started by ron77_db, Apr 01, 2022, 12:00 PM

Previous topic - Next topic

ron77_db

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