%**********************************************************************
%
% Demo application for the GTK-server with Gnu PROLOG by STDIN.
% Tested with Gnu PROLOG 1.2.16 on Slackware Linux 9.0, 9.1, 10
%
% December 31, 2003 by Peter van Eerten.
%
% Revised at July 25, 2004 - New communication interface - PvE
% 2nd revision at august 8, 2004 - Improved user interface and intelligence - PvE
% Adapted for GTK-server 1.2 at October 10, 2004 - PvE
% Adapted for GTK-server 1.3 at December 6, 2004 - PvE
% Adapted for new STDIN interface at June 6, 2005 - PvE
% Changed to standard PROLOG 'read' predicate at june 18, 2006 - PvE
% Adapted for Xforms at august 31, 2006 - PvE.
%
% Run with gprolog and GTK-server 2.1.1 or higher compiled for XForms.
% Compile with 'gplc demo.pl'.
%
% Board is:
%
% 1 2 3
% 4 5 6
% 7 8 9
%
% The program is unbeatable... ;-)
%
%**********************************************************************

:-dynamic(x/1, o/1, signals/4, labels/1).

:-initialization(start).

start:-
    init(Pin, Pout),
    gui(Pin, Pout),
    callback(Pin, Pout).

init(Pin, Pout):-
    % Start server in STDIN mode, let it return answer ending with '.'
    exec('gtk-server stdin post=.', Pout, Pin, _, _),
    % Switch to line buffering
    set_stream_buffering(Pout, line).

% Communicate with GTK-server
api(Pin, Pout, Txt, Result):-
    % Write string to stdin, terminate with newline
    write(Pout, Txt), write(Pout, '\n'),
    % Flush buffers
    flush_output(Pout),
    % Read info
    read(Pin, Result).

% This is the concatenate predicate
cat([], _).
cat([H|T], Stream):-
    write(Stream, H),
    cat(T, Stream).

% Concatenate list and communicate
xf(Pin, Pout, List, Result):-
    open_output_atom_stream(Stream),
    cat(List, Stream),
    close_output_atom_stream(Stream, Text),
    api(Pin, Pout, Text, Result).

%********************************* GUI definition
%
% Define the GUI using the gtk-server
%

gui(Pin, Pout):-
    % Define window
    xf(Pin, Pout, [' fl_bgn_form 1 250 200'], WIN),
    % Define frame
    xf(Pin, Pout, [' fl_add_frame 5 170 10 70 150 ""'], _),
    % Define NEW button
    xf(Pin, Pout, [' fl_add_button 0 180 20 50 30 New'], BUTTON2),
    % Define ABOUT button
    xf(Pin, Pout, [' fl_add_button 0 180 60 50 30 About'], BUTTON3),
    % Define EXIT button
    xf(Pin, Pout, [' fl_add_button 0 180 120 50 30 Exit'], BUTTON1),
    % Remember all widgets with callbacks for mainloop
    asserta(signals(WIN, BUTTON2, BUTTON1, BUTTON3)),
    % Define labels
    xf(Pin, Pout, [' fl_add_button 0 10 10 50 50 " "'], BUT1),
    xf(Pin, Pout, [' fl_add_button 0 60 10 50 50 " "'], BUT2),
    xf(Pin, Pout, [' fl_add_button 0 110 10 50 50 " "'], BUT3),
    xf(Pin, Pout, [' fl_add_button 0 10 60 50 50 " "'], BUT4),
    xf(Pin, Pout, [' fl_add_button 0 60 60 50 50 " "'], BUT5),
    xf(Pin, Pout, [' fl_add_button 0 110 60 50 50 " "'], BUT6),
    xf(Pin, Pout, [' fl_add_button 0 10 110 50 50 " "'], BUT7),
    xf(Pin, Pout, [' fl_add_button 0 60 110 50 50 " "'], BUT8),
    xf(Pin, Pout, [' fl_add_button 0 110 110 50 50 " "'], BUT9),
    % Define semi-statusbar
    xf(Pin, Pout, [' fl_add_frame 5 10 170 230 20 ""'], _),
    xf(Pin, Pout, [' fl_add_text 0 10 170 230 20 "Start by pressing the squares..."'], STATUS),
    xf(Pin, Pout, [' fl_set_object_lsize ', STATUS, ' 12'], _),
    % Remember labels
    asserta(labels([BUT1, BUT2, BUT3, BUT4, BUT5, BUT6, BUT7, BUT8, BUT9, STATUS])),
    % Show widgets
    xf(Pin, Pout, [' fl_end_form '], _),
    xf(Pin, Pout, [' fl_show_form ', WIN, ' 2 1 "GNU Prolog TicTacToe"'], _),
    xf(Pin, Pout, [' fl_set_focus_object ', WIN, ' ', BUTTON3], _).

% Retrieve callback
callback(Pin, Pout):-
	% Wait for callback signal
	xf(Pin, Pout, [' gtk_server_callback wait'], EVENT),
	loop(Pin, Pout, EVENT).

% Check on callback for EXIT button
loop(_, _, EVENT):-
	% Retrieve callback widget
	signals(_, _, BUTTON, _),
	% Was the EXIT button pressed?
	EVENT == BUTTON, leave, !.

% Check on callback for WINDOW
loop(_, _, EVENT):-
	% Find out if coordinates were entered
	EVENT == '""', leave, !.

% Check on callback for NEW GAME
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	signals(_, BUTTON, _, _),
	% Yes pressed, start over
	EVENT == BUTTON, restart(Pin, Pout), !.

% Check on callback for ABOUT button
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	signals(_, _, _, BUTTON),
	% Yes pressed, show dialog
	EVENT == BUTTON, xf(Pin, Pout, [' fl_show_message "GNU Prolog TicTacToe using the GTK-server." "" "For more info see http://www.gtk-server.org."'], _), fail.

% Check on callback for playfield1
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([BUTTON, _, _, _, _, _, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield2
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, BUTTON, _, _, _, _, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield3
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, BUTTON, _, _, _, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield4
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, BUTTON, _, _, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield5
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, _, BUTTON, _, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield6
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, _, _, BUTTON, _, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield7
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, _, _, _, BUTTON, _, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield8
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, _, _, _, _, BUTTON, _, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% Check on callback for playfield9
loop(Pin, Pout, EVENT):-
	% Retrieve data needed for callback
	labels([_, _, _, _, _, _, _, _, BUTTON, _]),
	% Yes, generate move
	EVENT == BUTTON, play(Pin, Pout, BUTTON), fail.

% No callbacks found? Goto retrieve a callback
loop(Pin, Pout, _):-
	callback(Pin, Pout).

leave:-
	% Exit Prolog - if you do not want to exit, use a cut (!).
	halt.

%********************************* Parse input
%
% Find out which move was played
%
play(Pin, Pout, Button):-
	% Find the correct playfield
	labels(Labels), nth(Move, Labels, Button),
	% Check if empty and fill in
	empty(Move), asserta(x(Move)),
	% Set correct label
	xf(Pin, Pout, [' fl_set_object_label ', Button, ' @9+'], _),
	xf(Pin, Pout, [' fl_set_object_lcol ', Button, ' 0'], _),
	% Computer plays
	not(end_game(Pin, Pout)), move(A), asserta(o(A)),
	% Find the correct label
	nth(A, Labels, Compu),
	% Set correct label
	xf(Pin, Pout, [' fl_set_object_label ', Compu, ' @circle'], _),
	xf(Pin, Pout, [' fl_set_object_lcol ', Compu, ' 7'], _),
	end_game(Pin, Pout).

restart(Pin, Pout):-
	% Retrieve data
	labels([BUT1, BUT2, BUT3, BUT4, BUT5, BUT6, BUT7, BUT8, BUT9, STATUS]),
	% Empty all labels
	xf(Pin, Pout, [' fl_set_object_label ', BUT1, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT2, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT3, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT4, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT5, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT6, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT7, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT8, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', BUT9, ' " "'], _),
	xf(Pin, Pout, [' fl_set_object_label ', STATUS, ' "New game started..."'], _),
	% Empty dynamic play board
	retractall(x(_)), retractall(o(_)), callback(Pin, Pout).
	
%********************************* Extra support predicates
%
% Define the NOT predicate
%
not(X) :-
	call(X), !, fail.
not(_).

%********************************* The intelligence starts here
%
% Define possible '3 in a rows'.
%
line(1,2,3).
line(4,5,6).
line(7,8,9).
line(1,4,7).
line(2,5,8).
line(3,6,9).
line(1,5,9).
line(3,5,7).
%
% Which move to play (we only need 1 solution, so use the cut '!').
%
move(A) :- good(A), empty(A), !.
%
% Define good move.
%
good(A) :- make_three(A).
good(A) :- block_enemy(A).
good(A) :- split_two(A).
good(A) :- make_two(A).
good(5).
good(1).
good(3).
good(7).
good(9).
good(2).
good(4).
good(6).
good(8).
%
% Check for two white stones in a row
%
make_three(A) :- o(B), o(C), line(A, B, C).
make_three(B) :- o(A), o(C), line(A, B, C).
make_three(C) :- o(A), o(B), line(A, B, C).
%
% Block two black stones
%
block_enemy(A) :- x(B), x(C), line(A, B, C).
block_enemy(B) :- x(A), x(C), line(A, B, C).
block_enemy(C) :- x(A), x(B), line(A, B, C).
%
% Split 2 fields
%
split_two(1) :- x(2), x(4).
split_two(3) :- x(2), x(6).
split_two(7) :- x(4), x(8).
split_two(9) :- x(6), x(8).
%
% Try to attack
%
make_two(A) :- o(B), line(A, B, C), empty(C).
make_two(C) :- o(B), line(A, B, C), empty(A).
make_two(A) :- empty(B), line(A, B, C), o(C).
make_two(C) :- empty(B), line(A, B, C), o(A).
%
% Check on empty place.
%
empty(X) :- not(x(X)), not(o(X)).

%********************************* End of game query's
% Find out if the game is finished
%
end_game(Pin, Pout):-
	tictactoe(Pin, Pout).
end_game(Pin, Pout):-
	filled_board(Pin, Pout).
%
% Is there a 'tictactoe'?
%
tictactoe(Pin, Pout):- 
	x(A), x(B), x(C), line(A, B, C),
	labels([_, _, _, _, _, _, _, _, _, STATUS]),
	xf(Pin, Pout, [' fl_set_object_label ', STATUS, ' "You have won!"'], _).
tictactoe(Pin, Pout):- 
	o(A), o(B), o(C), line(A, B, C),
	labels([_, _, _, _, _, _, _, _, _, STATUS]),
	xf(Pin, Pout, [' fl_set_object_label ', STATUS, ' "I have won!"'], _).
%
% The board is full?
%
filled_board(Pin, Pout):-
	full(1), full(2), full(3), full(4), full(5), full(6), full(7), full(8), full(9),
	labels([_, _, _, _, _, _, _, _, _, STATUS]),
	xf(Pin, Pout, [' fl_set_object_label ', STATUS, ' "Even game."'], _).

full(X) :- x(X).
full(X) :- o(X).

%
%**********************************************************