Taste GNU Prolog (2)

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

 

5. The gnu prolog program creates a GUI in a novel and reasonable manner.

It is lightweight and small, and does not have a dedicated GUI function mechanism, but it can call GTK-server to enable its program to implement the GUI.

GTK-server needs to be downloaded and installed separately. Address: http://www.gtk-server.org/

 

The following uses the program tictactoe. pl as an example to introduce the "borrow" mechanism for GNU Prolog generation GUI interface.

:-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 '.'
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, '000000'], _),
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 ()),
% 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 (),!.
%
% Define good move.
%
Good (a):-make_three ().
Good (a):-block_enemy ().
Good (a):-split_two ().
Good (a):-make_two ().
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 ().
Make_two (a):-empty (B), line (A, B, C), O (c ).
Make_two (c):-empty (B), line (A, B, C), O ().
%
% Check on empty place.
%
Empty (x):-not (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 'tactoe '?
%
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 ).

This article from the csdn blog, reproduced please indicate the source: http://blog.csdn.net/lawme/archive/2008/10/15/3081870.aspx