Ada 95 :: 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]