::
x72_t3.ada
with Class_window;
use Class_window;
package Class_board is
type Board is private;
type Game_state is ( WIN, PLAYABLE, DRAW );
function valid( the:in Board; pos:in Integer ) return Boolean;
procedure add(the:in out Board; pos:in Integer;
piece:in Character);
function state( the:in Board ) return Game_state;
procedure display_board( the:in Board; win:in P_Window );
procedure update( the:in Board; win:in P_Window );
procedure reset( the:in out Board );
private
SIZE_TTT: CONSTANT := 9; -- Must be 9
subtype Board_index is Integer range 1 .. SIZE_TTT;
subtype Board_range is Board_index;
type Board_grid is array( Board_range ) of Character;
type Board is record
sqrs : Board_grid := ( others => ' '); -- Initialize
last : Board_index := 1; -- Last move
moves : Natural := 0;
end record;
end Class_board;
package body Class_board is
function valid(the:in Board; pos:in Integer) return Boolean is
begin
return pos in Board_range and then the.sqrs( pos ) = ' ';
end valid;
procedure add( the:in out Board; pos:in Integer;
piece:in Character ) is
begin
the.last := pos;
the.sqrs( pos ) := piece;
the.moves := the.moves + 1;
end add;
function state( the:in Board ) return Game_state is
type Win_line is array( 1 .. 3 ) of Positive;
type All_win_lines is range 1 .. 8;
cells: CONSTANT array ( All_win_lines ) of Win_line :=
( (1,2,3), (4,5,6), (7,8,9), (1,4,7),
(2,5,8), (3,6,9), (1,5,9), (3,5,7) ); -- All win lines
first : Character;
begin
for pwl in All_win_lines loop -- All Pos Win Lines
first := the.sqrs( cells(pwl)(1) ); -- First cell in line
if first /= ' ' then -- Looks promising
if first = the.sqrs(cells(pwl)(2)) and then
first = the.sqrs(cells(pwl)(3)) then return WIN;
end if;
end if;
end loop;
if the.moves >= 9 -- Check for draw
then return DRAW; -- Board full
else return PLAYABLE; -- Still playable
end if;
end state;
procedure reset( the:in out Board ) is
begin
the.sqrs := ( others => ' '); -- All spaces
the.last := 1; -- Last move
the.moves := 0; -- No of moves
end reset;
procedure display_board( the:in Board; win:in P_Window ) is
begin
position( win.all, 1, 2 );
put(win.all, " 7 | 8 | 9" ); new_line( win.all );
put(win.all, " ---------" ); new_line( win.all );
put(win.all, " 4 | 5 | 6" ); new_line( win.all );
put(win.all, " ---------" ); new_line( win.all );
put(win.all, " 1 | 2 | 3" ); new_line( win.all );
end display_board;
-- Note mapping for squares
procedure update( the:in Board; win:in P_Window ) is
type Co_ordinate is ( X , Y );
type Cell_pos is array ( Co_ordinate ) of Positive;
type Board is array ( 1 .. SIZE_TTT ) of Cell_pos;
pos: CONSTANT Board := ( (2,6), (6,6), (10,6),
(2,4), (6,4), (10,4),
(2,2), (6,2), (10,2) );
begin
position( win.all, pos(the.last)(X), pos(the.last)(Y) );
put( win.all, the.sqrs( the.last ) ); -- Display counter;
end update;
end Class_board;
with Class_board, Class_window;
use Class_board, Class_window;
package Pack_globals is
game : Board; -- The board
p_win_brd : P_Window; -- Window to display OXO board in
p_win_bnr : P_Window; -- Window to display Banner in
p_win_r : P_Window; -- Window to display commentary in
player : Character; -- Either 'X' or 'O'
end Pack_globals;
with Simple_io, Class_window, Class_board, Pack_globals;
use Simple_io, Class_window, Class_board, Pack_globals;
function user_input( cb_mes:in String ) return String is
move: Integer; last: Positive;
begin
clear( p_win_r.all ); -- Clear
get( cb_mes, move, last ); -- to int
if valid( game, move ) then -- Valid
add( game, move, player ); -- to board
update( game, p_win_brd );
case state( game ) is -- Game is
when Win =>
put(p_win_r.all, " " & player & " wins");
when PLAYABLE =>
case player is -- Next player
when 'X' => player := 'O'; -- 'X' => 'O'
when 'O' => player := 'X'; -- 'O' => 'X'
when others => null; --
end case;
put( p_win_r.all, " Player " & player );
when DRAW =>
put( p_win_r.all, " It's a draw ");
end case;
else
put(p_win_r.all, " " & player & " Square invalid");
end if;
return "";
exception
when others =>
put(p_win_r.all, " " & player & " re-enter move");
return "";
end user_input;
with Class_window, Class_board, Pack_globals;
use Class_window, Class_board, Pack_globals;
procedure re_start( first_player:in Character ) is
begin
player := first_player; -- Start with
reset( game ); -- Reset Board
display_board(game, p_win_brd ); -- Display
clear( p_win_r.all ); -- Status info
put( p_win_r.all, " Player " & player ); -- Player name
end re_start;
with re_start;
function reset_x( cb_mes:in String ) return String is
begin
re_start('X'); return "";
end reset_x;
with re_start;
function reset_o( cb_mes:in String ) return String is
begin
re_start('O'); return "";
end reset_o;
with Class_window, Pack_globals;
use Class_window, Pack_globals;
function about( cb_mes:in String ) return String is
begin
clear( p_win_bnr.all ); position( p_win_bnr.all, 17, 1 );
put( p_win_bnr.all, "Written in Ada 95");
return "";
end about;
with Class_input_manager, Class_board, Class_window,
Class_dialog, Class_menu, Class_menu_title,
Pack_globals, reset_x, reset_o, about, user_input;
use Class_input_manager, Class_board, Class_window,
Class_dialog, Class_menu, Class_menu_title,
Pack_globals;
procedure play is
begin
window_prologue; -- Setup window system
declare
win_brd : aliased Window; -- Board Window
win_r : aliased Window; -- Result Window
win_bnr : aliased Window; -- title Window
win_usr : aliased Dialog; -- Input Window
ttt_reset: aliased Menu; -- Reset menu
ttt_menu : Menu_title; -- Title menu
begin
framework( win_bnr, 1, 4, 52, 3 ); -- Banner
framework( win_brd, 32, 8, 13, 9 ); -- OXO board
framework( win_r, 9, 14, 22, 3 ); -- Results
framework( ttt_reset,
"X start", null, reset_x'Access,
"O start", null, reset_o'Access );
framework( ttt_menu,
"About", null, about'Access,
"Reset", ttt_reset'Unchecked_Access, null );
position( win_bnr, 17, 1 );
put( win_bnr, "Noughts and crosses" );
framework( win_usr, 9, 8, 22,
"Move (1-9)", user_input'Access );
player := 'X'; -- Set player
p_win_brd := win_brd'Unchecked_Access; -- OXO Board
p_win_bnr := win_bnr'Unchecked_Access; -- Banner
p_win_r := win_r'Unchecked_Access; -- Commentary
display_board( game, p_win_brd ); -- Empty board
new_line( win_r ); -- Clear
put( win_r, " Player " & player ); -- Players turn is
put( win_usr, "" ); -- Cursor
window_start; -- Start the user interaction
end;
window_epilogue; -- Close window system
end play;
© M.A.Smith University of Brighton.
Created September 1995 last modified May 1997.
Comments, suggestions, etc.
M.A.Smith@brighton.ac.uk
*
[Home page]