ttt.t

tic-tac-toe

%
% A simple game of tic-tac-toe adapted from Dr. Dobb's Journal,
% December 1994, p.132
%

% ---- board markers ----
const PLAYER : char := 'X'
const COMPUTER : char := 'O'
const FREE : char := ' '

% --- game position on screen --- 
const LEFT : int := 18
const TOP : int := 5
% --- game board ---
var board : string := "           "
% --- winning combinations --- 
var wins : array( 8, 3 ) of int

program

    var mv, mv_c, mv_p, moves : int

    init_wins

    loop

        cursor( 0 )
        displayboard
        
        % --- get player's first move ---
        mv := getmove
        exit when mv = 0
      
        % --- set computer's first move --- 
        if mv ~= 5 then
            setpiece( 15, 5, COMPUTER )     % center if available 
        else
            setpiece( 15, 1, COMPUTER )     % upper left otherwise 
        end if

        moves := 2
      
        loop

            exit when moves >= 9
                  
            mv := getmove                   % player's next move 
            moves := moves + 1

            watch( board )
            
            if won then
                message( 1, "You win" )
                exit
            end if

            if moves = 9 then
                message( 1, "Tie" )
            else                            % find computer's next move
                mv_c := canwin( COMPUTER )
                mv_p := canwin( PLAYER )

                if mv_c ~= 0 then           % win if possible 
                    setpiece( 15, mv_c, COMPUTER ) 
                elsif mv_p ~= 0 then        % block player's win potential
                    setpiece( 15, mv_p, COMPUTER )
                else
                    nextmove
                end if

                if won then
                    message( 1, "I win" )
                    exit
                end if

                moves := moves + 1
            end if

        end loop
      
        cursor( 1 )

        put ""
        put "Play again? (y/n) "...
        exit when getkey = ord( 'n' )
        board := "           "

    end loop

    scroll( 0, 24, 0, 79, 7, 0, 0 )

end program

%
% initialize wins array
%
procedure init_wins
    % --- winning rows --- 
    wins( 0, 0 ) := 1
    wins( 0, 1 ) := 2
    wins( 0, 2 ) := 3
    wins( 1, 0 ) := 4
    wins( 1, 1 ) := 5
    wins( 1, 2 ) := 6
    wins( 2, 0 ) := 7
    wins( 2, 1 ) := 8
    wins( 2, 2 ) := 9
    % --- winning columns --- 
    wins( 3, 0 ) := 1
    wins( 3, 1 ) := 4
    wins( 3, 2 ) := 7
    wins( 4, 0 ) := 2
    wins( 4, 1 ) := 5
    wins( 4, 2 ) := 8
    wins( 5, 0 ) := 3
    wins( 5, 1 ) := 6
    wins( 5, 2 ) := 9
    % --- winning diagonals --- 
    wins( 6, 0 ) := 1
    wins( 6, 1 ) := 5
    wins( 6, 2 ) := 9
    wins( 7, 0 ) := 3
    wins( 7, 1 ) := 5
    wins( 7, 2 ) := 7

end init_wins

%
% find next available open space 
%
procedure nextmove

    label nextmove_exit :
    var i : int
    var j : int 

    for i := 0 ... 8 do

        if board( i ) = FREE then           % try for win

            j := i                          % save last free space

            board( i ) := COMPUTER          % trial

            if canwin( COMPUTER ) > 0 then
                setpiece( 15, i + 1, COMPUTER )
                goto nextmove_exit   
            end if

            board( i ) := FREE 

        end if

    end for

    setpiece( 15, j + 1, COMPUTER )

    nextmove_exit :

end nextmove

%
% get the player's next move and display it
%
function getmove : int

    var mv : int := 0

    loop
   
        exit when mv ~= 0
      
        message( 0, "Move (1-9)?" )
        mv := getkey
        mv := mv - ord( '0' )

        if mv < 1 or mv > 9 then 
            message( 1, "invalid, re-enter" )        
            mv := 0
        elsif board( mv - 1 ) ~= FREE then
            message( 1, "invalid, re-enter" )        
            mv := 0
        end if

    end loop

    message( 1, "                 " )       % clear error message
    setpiece( 15, mv, PLAYER )

    return mv

end getmove

%
% test to see if the game has been won
%
function won : boolean

    var i, pl0, pl1, pl2 : int
    var r : boolean

    for i := 0 ... 7 do

        pl0 := wins( i, 0 ) - 1
        pl1 := wins( i, 1 ) - 1
        pl2 := wins( i, 2 ) - 1

        if board( pl0 ) ~= FREE then

            if board( pl0 ) = board( pl1 ) and 
               board( pl0 ) = board( pl2 ) then
                r := true
                exit
            else
                r := false
            end if

        end if

    end for

    return r

end won

%
% test to see if a player (n) can win this time
% return 0 or winning position
%
function canwin( n : char ) : int

    var i, w : int

    for i := 0 ... 7 do

        w := trywin( n, i )

        if w ~= 0 then
            return w
        end if

    end for

    return 0

end canwin

%
% test a row, column, or diagonal for a win
% return 0 or winning board position 
%
function trywin( n : char, wn : int ) : int

    var nct, zct : int := 0
    var i, pl : int

    for i := 0 ... 2 do

        pl := wins( wn, i ) - 1

        if board( pl ) = FREE then
            zct := i + 1
        elsif board( pl ) = n then
            nct := nct + 1
        end if

    end for

    if nct = 2 and zct > 0 then
        return wins( wn, zct-1 )
    end if

    return 0

end trywin

%
% display the tic-tac-toe board 
%
procedure displayboard

    var ln0 : string := "---|---|---"
    var ln1 : string := " 1 | 2 | 3 "
    var ln2 : string := " 4 | 5 | 6 "
    var ln3 : string := " 7 | 8 | 9 "

    scroll( 0, 24, 0, 79, 7, 0, 0 )
    locate( TOP + 0, LEFT )
    putstr( ln1, 7, 0 )
    locate( TOP + 1, LEFT )
    putstr( ln0, 7, 0 )
    locate( TOP + 2, LEFT )
    putstr( ln2, 7, 0 )
    locate( TOP + 3, LEFT )
    putstr( ln0, 7, 0 )
    locate( TOP + 4, LEFT )
    putstr( ln3, 7, 0 )

end displayboard

%
% set a players mark (O or X) on the board 
%
procedure setpiece( color, pos : int, mark : char )

    var col, row : int

    pos := pos - 1
    board( pos ) := mark
    col := pos div 3
    row := pos mod 3
    locate( TOP + col*2, LEFT + row*4 + 1 )
    putch( mark, color, 0 )

end setpiece 

%
% message to opponent 
%
procedure message( y : int, msg : string )

    locate( TOP + 8 + y, LEFT ) 
    putstr( msg, 7, 0 )

end message