品尝 GNU Prolog （2）

    五、GNU Prolog 程序制作 GUI 界面的方式比较新颖、合理。

它本身轻便小巧，没有专门的 GUI 功能机制，但它可以调用 GTK-Server ，使其程序实现 GUI 界面。

GTK-Server 需要另行下载安装。地址是：http://www.gtk-server.org/

下面，以程序 tictactoe.pl 为例，介绍 GNU Prolog 生成 GUI 界面的“借用式”机制。

:-dynamic(x/1, o/1, signals/5, 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

gtk(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):-

% Initialize GTK

gtk(Pin, Pout, [' gtk_init NULL NULL'], _),

% Define window

gtk(Pin, Pout, [' gtk_window_new 0'], WIN),

gtk(Pin, Pout, [' gtk_window_set_title ', WIN, ' "GNU Prolog TicTacToe"'], _),

gtk(Pin, Pout, [' gtk_widget_set_usize ', WIN, ' 250 200'], _),

gtk(Pin, Pout, [' gtk_window_set_position ', WIN, ' 1'], _),

% Define Table

gtk(Pin, Pout, [' gtk_table_new 50 65 1'], TABLE),

gtk(Pin, Pout, [' gtk_container_add ', WIN, ' ', TABLE], _),

% Define DIALOG

gtk(Pin, Pout, [' gtk_message_dialog_new ', WIN, ' 0 0 1 "GNU Prolog TicTacToe using the GTK-server./r/rFor more info see http://www.gtk-server.org." ""'], DIALOG),

% Define NEW button

gtk(Pin, Pout, [' gtk_button_new_with_label "New"'], BUTTON2),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUTTON2, ' 50 62 3 13'], _),

% Define ABOUT button

gtk(Pin, Pout, [' gtk_button_new_with_label About'], BUTTON3),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUTTON3, ' 50 62 14 24'], _),

% Define EXIT button

gtk(Pin, Pout, [' gtk_button_new_with_label Exit'], BUTTON1),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUTTON1, ' 50 62 30 40'], _),

% Define frame

gtk(Pin, Pout, [' gtk_frame_new NULL'], FRAME),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', FRAME, ' 48 64 1 42'], _),

% Remember all widgets with callbacks for mainloop

asserta(signals(WIN, BUTTON2, BUTTON1, BUTTON3, DIALOG)),

% Define status bar

gtk(Pin, Pout, [' gtk_statusbar_new'], STATUS),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', STATUS, ' 0 65 44 50'], _),

gtk(Pin, Pout, [' gtk_statusbar_get_context_id ', STATUS, ' main_window'], CID),

gtk(Pin, Pout, [' gtk_statusbar_push ', STATUS, ' ', CID, ' "Start by pressing the squares..."'], _),

% Define labels

gtk(Pin, Pout, [' gtk_button_new " "'], BUT1),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT1, ' 1 16 1 14'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT2),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT2, ' 16 31 1 14'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT3),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT3, ' 31 46 1 14'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT4),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT4, ' 1 16 14 28'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT5),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT5, ' 16 31 14 28'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT6),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT6, ' 31 46 14 28'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT7),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT7, ' 1 16 28 42'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT8),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT8, ' 16 31 28 42'], _),

gtk(Pin, Pout, [' gtk_button_new " "'], BUT9),

gtk(Pin, Pout, [' gtk_table_attach_defaults ', TABLE, ' ', BUT9, ' 31 46 28 42'], _),

% Remember labels

asserta(labels([BUT1, BUT2, BUT3, BUT4, BUT5, BUT6, BUT7, BUT8, BUT9, STATUS, CID])),

% Show widgets

gtk(Pin, Pout, [' gtk_widget_show_all ', WIN], _),

gtk(Pin, Pout, [' gtk_widget_grab_focus ', BUTTON3], _).

% Retrieve callback

callback(Pin, Pout):-

% Wait for callback signal

gtk(Pin, Pout, [' gtk_server_callback wait'], EVENT),

loop(Pin, Pout, EVENT).

% Check on callback for EXIT button

loop(Pin, Pout, EVENT):-

% Retrieve callback widget

signals(_, _, BUTTON, _, _),

% Was the EXIT button pressed?

EVENT == BUTTON, leave(Pin, Pout), !.

% Check on callback for WINDOW

loop(Pin, Pout, EVENT):-

% Retrieve data needed for callback

signals(WIN, _, _, _, _),

% Find out if coordinates were entered

EVENT == WIN, leave(Pin, Pout), !.

% 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, DIALOG),

% Yes pressed, show dialog

EVENT == BUTTON, gtk(Pin, Pout, [' gtk_widget_show ', DIALOG], _), fail.

% Check on callback for DIALOG

loop(Pin, Pout, EVENT):-

% Retrieve data needed for callback

signals(_, _, _, _, DIALOG),

% Yes pressed, hide dialog

EVENT == DIALOG, gtk(Pin, Pout, [' gtk_widget_hide ', DIALOG], _), 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(Pin, Pout):-

% Exit GTK

gtk(Pin, Pout, [' gtk_exit 0'], _),

% 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

gtk(Pin, Pout, [' gtk_button_set_label ', Button, ' X'], _),

% Computer plays

not(end_game(Pin, Pout)), move(A), asserta(o(A)),

% Find the correct label

nth(A, Labels, Compu),

% Set correct label

gtk(Pin, Pout, [' gtk_button_set_label ', Compu, ' O'], _),

end_game(Pin, Pout).

restart(Pin, Pout):-

% Retrieve data

labels([BUT1, BUT2, BUT3, BUT4, BUT5, BUT6, BUT7, BUT8, BUT9, STATUS, CID]),

% Empty all labels

gtk(Pin, Pout, [' gtk_button_set_label ', BUT1, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT2, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT3, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT4, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT5, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT6, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT7, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT8, ' " "'], _),

gtk(Pin, Pout, [' gtk_button_set_label ', BUT9, ' " "'], _),

gtk(Pin, Pout, [' gtk_statusbar_pop ', STATUS, ' ', CID], _),

gtk(Pin, Pout, [' gtk_statusbar_push ', STATUS, ' ', CID, ' "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, CID]),

gtk(Pin, Pout, [' gtk_statusbar_pop ', STATUS, ' ', CID], _),

gtk(Pin, Pout, [' gtk_statusbar_push ', STATUS, ' ', CID, ' "You have won!"'], _).

tictactoe(Pin, Pout):- 

o(A), o(B), o(C), line(A, B, C),

labels([_, _, _, _, _, _, _, _, _, STATUS, CID]),

gtk(Pin, Pout, [' gtk_statusbar_pop ', STATUS, ' ', CID], _),

gtk(Pin, Pout, [' gtk_statusbar_push ', STATUS, ' ', CID, ' "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, CID]),

gtk(Pin, Pout, [' gtk_statusbar_pop ', STATUS, ' ', CID], _),

gtk(Pin, Pout, [' gtk_statusbar_push ', STATUS, ' ', CID, ' "Even game."'], _).

full(X) :- x(X).

full(X) :- o(X).