%==============================================================================
% Project:	Course "Logic Programming and Deductive Databases"
% Version:	Summer 2024, University of Halle
% Module:	template.pl
% Purpose:	Part of a Solution for the Connect4 Exercise
% Last Change:	21.06.2024
% Language:	Prolog (Tested with SWI Prolog)
% Authors:	Stefan Brass
% Email:	brass@informatik.uni-halle.de
% Address:	Universitaet Halle, Inst. f. Informatik, D-06099 Halle, Germany
% Copyright:	(c) 2021-2024 by Stefan Brass
% Copying:	You may do what you want with this, but you cannot make me
%       	responsible for anything. Please mark changed versions.
%==============================================================================

% This program gives a start for programming the "Connect 4" exercise.
% In particular, it contains the code for bookeeping the current state
% with the gamestate module.
% The strategy part must still be programmed.

% Rename the file and the module from "template" to your name
% (or any name that is probably unique in the course).

:- module(template, [init_yellow/1, init_red/1,
		choose_move_yellow/3, choose_move_red/3,
		opponent_move_red/3, opponent_move_yellow/3]).

:- use_module(gamestate,
		[init_state/1, move/4, won/2, board_full/1, disc/4]).

%==============================================================================
% Return Initial State:
%==============================================================================

% We use the state representation from module 'gamestate'.

%------------------------------------------------------------------------------
% init_yellow(-State):
%------------------------------------------------------------------------------

init_yellow(State) :-
	init_state(State).

%------------------------------------------------------------------------------
% init_red(-State):
%------------------------------------------------------------------------------

init_red(State) :-
	init_state(State).

%==============================================================================
% Choose Move:
%==============================================================================

%------------------------------------------------------------------------------
% choose_move_yellow(+State, -Col, -NewState):
%------------------------------------------------------------------------------

choose_move_yellow(State, Col, NewState) :-
	choose_move(State, yellow, Col),
	move(State, yellow, Col, NewState).

%------------------------------------------------------------------------------
% choose_move_red(+State, -Col, -NewState):
%------------------------------------------------------------------------------

choose_move_red(State, Col, NewState) :-
	choose_move(State, red, Col),
	move(State, red, Col, NewState).

%==============================================================================
% Record Opponent Move In State:
%==============================================================================

%------------------------------------------------------------------------------
% opponent_move_yellow(+State, +YellowCol, -NewState):
%------------------------------------------------------------------------------

% We are playing Red. This informs us about the column Yellow has chosen.

opponent_move_yellow(State, YellowCol, NewState) :-
	move(State, yellow, YellowCol, NewState).

%------------------------------------------------------------------------------
% opponent_move_red(+State, +RedCol, -NewState):
%------------------------------------------------------------------------------

% We are playing Yellow. This informs us about the column Red has chosen.

opponent_move_red(State, RedCol, NewState) :-
	move(State, red, RedCol, NewState).

%==============================================================================
% Computation of Possible Moves:
%==============================================================================

%------------------------------------------------------------------------------
% choose_move(+State, +Player, -Col): Choose move for Player in State.
%------------------------------------------------------------------------------

choose_move(State, Player, Col) :-
	possible_moves(State, Player, Moves),
	choose_best_move(Moves, Player, Col),
	!.

%------------------------------------------------------------------------------
% col(ColNo): Possible Column Numbers.
%------------------------------------------------------------------------------

col(1).
col(2).
col(3).
col(4).
col(5).
col(6).
col(7).

%------------------------------------------------------------------------------
% possible_moves(State, Player, Moves):
%------------------------------------------------------------------------------

possible_moves(State, Player, Moves) :-
	findall(Move,
		possible_move(State, Player, Move),
		Moves).

%------------------------------------------------------------------------------
% possible_move(State, Player, Move): Column must not be full.
%------------------------------------------------------------------------------

possible_move(State, Player, move(ColNo,NextState)) :-
	col(ColNo),
	\+ disc(State, 6, ColNo, _Player),
	move(State, Player, ColNo, NextState).

%------------------------------------------------------------------------------
% opponent(Player, Opponent):
%------------------------------------------------------------------------------

opponent(red, yellow).
opponent(yellow, red).

%==============================================================================
% Game Strategy:
%==============================================================================

%------------------------------------------------------------------------------
% choose_best_move(+ListOfMoves, +Player, -ColNo):
%------------------------------------------------------------------------------

% This is your part (the strategy).
% The given list always contains pairs of the column number, into which one
% can throw a disc, and the resulting state.

% The simple version given here chooses always the first possible move.
% You must improve this (e.g., with some evaluation how good is the resulting
% state and possibly looking ahead a few moves with the MinMax Algorithm).

% The module gamestate contains useful functions,
% e.g. a predicate won(State, Player).

choose_best_move([move(ColNo,_State)|_MoreMoves], _Player, ColNo).

