品尝 GNU Prolog （2）

http://blog.csdn.net/lawme/archive/2008/10/15/3081870.aspx

 

  五、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).

本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/lawme/archive/2008/10/15/3081870.aspx