%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% The "who owns the zebra puzzle", done in Wild-Life with a graphical
% interface for triggerring the solving and also animate the constraint
% solving process.

% The traditional problem has "smokes" as one of the clue categories.
% In the name of improving the nation's health, we have substituted
% various sports...

module("x_zebra")?
public(x_zebra)?

%%%%%%%%%%%%%%%%%%%
% THE PUZZLE SOLVER
%%%%%%%%%%%%%%%%%%%

% The main idea of this solver is to specify a relation 'house' with the
% appropriate slots, and make the value of these slots (yet to be assigned
% from the clues) be the features of global objects that represent the
% assignments of elements in each category (i.e., nationality, number,
% etc...) to a particular house. This is done by constraining the values
% of the features of the global terms of each of the feature categories to
% be that same house. Thus, the projections on yet unknown features of
% these global terms residuate until features are assigned from the clues,
% at which point they fire enforcing assignments that are unique per
% house.

global(nums, nats, spts, drks, pets, cols)?

X:house(number      => Num,
	nationality => Nat,
	sport       => Spt,
	drink       => Drk,
	pet         => Pet,
	color       => Col)
	
	:-
	  
	nums.Num=X,
	nats.Nat=X,
	spts.Spt=X,
	drks.Drk=X,
	pets.Pet=X,
	cols.Col=X,
	Num={1;2;3;4;5}.

% Here are the clues.  We build a list of houses, and assign their names.
% Then, we encode each clue by simply stating the conditions that must
% be true of the 'house' relation. From this straightforward specification
% everything falls into place.

clues([H1,H2,H3,H4,H5]) :-
	H1:house(number=>1),
	H2:house(number=>2),
	H3:house(number=>3),
	H4:house(number=>4),
	H5:house(number=>5),
	
	%%  1: The Englishman lives in the 'Red' house
	house(nationality=>'English',color=>'Red'),

	%%  2: The Spaniard owns a dog
	house(nationality=>'Spanish',pet=>dog),

	%%  3: The man in the green house drinks coffee
	house(color=>'Green',drink=>coffee),

	%%  4: The Ukrainian drinks tea
	house(nationality=>'Ukrainian',drink=>tea),

	%%  5: The green house is to the right of the ivory house
	A5:house(color=>'Green'),
	B5:house(color=>'Ivory'),
	right_of(A5,B5),

	%%  6: The Go player owns snails
	house(sport=>'Go',pet=>snails),
	
	%%  7: The man in the yellow house plays cricket
	house(color=>'Yellow',sport=>cricket),

	%%  8: Milk is drunk in the middle house
	house(number=>3,drink=>milk),

	%%  9: The Norwegian lives at the end
	house(number=>{1;5},nationality=>'Norwegian'),

	%% 10: The Judoka lives next to the man who has a fox
	A10:house(sport=>judo),
	B10:house(pet=>fox),
	next_door(A10,B10),

	%% 11: The cricket player lives next to the man who has a horse
	A11:house(sport=>cricket),
	B11:house(pet=>horse),
	next_door(A11,B11),

	%% 12: The poker player drinks orange juice
	house(sport=>poker, drink=>'orange juice'),
	
	%% 13: The Japanese plays polo
	house(nationality=>'Japanese',sport=>polo),

	%% 14: The Norwegian lives next to the blue house
	A14:house(nationality=>'Norwegian'),
	B14:house(color=>'Blue'),
	next_door(A14,B14).

% Neighboring constraints:

next_door(H1,H2) :- H1.number=H2.number+{1;-1}.
right_of(H1,H2) :- H2.number=H1.number+1.

% That's it!!!

%%%%%%%%%%%%%%%%%%%%%%%%%
% THE GRAPHICAL INTERFACE
%%%%%%%%%%%%%%%%%%%%%%%%%

	
import("xtools") ?
import("xtools_utils")?

% The necessary widgets:

s_box <| frame.
s_box <| field.
s_box <| text_box.

:: s_box(frame_state => true,
	 text => " ",
	 font_id => z_font).

slot_box := s_box(offset => d_border).

time_box := s_box(text_color_id => z_color).

color_box <| frame.
color_box <| field.

:: color_box(frame_state => true).

l_box := text_box(offset => -d_border,
		  text_color_id => z_color,
		  font_id => z_font).

p_button := push_button(font_id => z_font).

house_box(N:int) -> B
    |
	Nat = slot_box,
	Spt = slot_box,
	Drk = slot_box,
	Pet = slot_box,
	Clr = color_box,
	Num = text_box(font_id => title_font, text => psi2str(N)),

	same_size([Nat,Spt,Drk,Pet,Clr]),

	same_width([Nat,Num]),

	B = vc_list [Nat,Spt,Drk,Pet,Clr,v_box(20),Num],

	B = @(num => N, nat => Nat, spt => Spt, drk => Drk, pet => Pet, clr => Clr).

% The control and display panel:

x_zebra :-
	(
	    C = get_choice,
	    Q = p_button(text => "QUIT",
			 action => (set_choice(C),fail)),

	    G = p_button(text => "SOLVE",
			 action => (solve(Hs),
				    reset_state(M,false))),

	    M = p_button(text => "MORE",
			 action => (reset_text(TB,"Retrying..."),
				    reset_boxes(Hs),
				    try_more,
				    beep,
				    reset_text(TB,"No more!"))),

	    A = p_button(text => "ANIMATE",
			 action => (animate(Hs),
				    reset_state(S,false),
				    reset_state(M,false))),

	    S = p_button(text => "STOP",
			 action => stop(Stop)),

	    R = p_button(text => "RESET",
			 action => reset_all(Hs)),

	    B1 = l_box(text => "Nationality"),
	    B2 = l_box(text => "Sport"),
	    B3 = l_box(text => "Drink"),
	    B4 = l_box(text => "Pet"),
	    B5 = l_box(text => "Color"),
	    
	    same_size([Q,G,M,A,S,R|Bs:[B1,B2,B3,B4,B5]]),

	    Legend = padded_box(vc_list Bs, padding => 10),

	    H1 = house_box(1),
	    H2 = house_box(2),
	    H3 = house_box(3),
	    H4 = house_box(4),
	    H5 = house_box(5),

	    same_width([Q,H1,H2,H3,H4,H5]),

	    Houses = frame_box(ht_list [H1,H2,H3,H4,H5], padding => 10),

	    TitleBox = fancy_text_box(text => "Who owns the zebra?",
				      font => title_font,
				      colors => [i,r,b,g,y]),
	    
	    TimeBox = hc_list [text_box(text => "Total Time:",
					font_id => z_font),
			       frame_box(TB:time_box(width => 120,
						     height => 50,
						     text => " "),
					 padding => 3)
			      ],
	    
	    Panel = panel(title => "The Zebra Puzzle")
	      containing
	      padded_box(padding => 17,
			 vr_list [
				     ht_list [vl_list [Q, v_box(10),
						       G, v_box(10),
						       M, v_box(10),
						       A, v_box(10),
						       S, v_box(10),
						       R
						      ],
					      h_box(20),
					      Legend,h_box(10),Houses
					     ],
				     v_box(30),
				     hc_list [TimeBox,h_box(10),TitleBox]
				 ]),

	    create_box(Panel),

	    Hs = @(timebox => TB,morebox=>M, stopbox=>S, stop=>Stop),

	    Hs = [@(box=>H1),@(box=>H2),@(box=>H3),@(box=>H4),@(box=>H5)]
	;
	    succeed
	).
	
% Displaying the solutions:

display_houses([H|Hs]) :- !, display_house(H), display_houses(Hs).
display_houses([]).

display_house(@(box=>@(nat=>Nat_box,
		       spt=>Spt_box,
		       drk=>Drk_box,
		       pet=>Pet_box,
		       clr=>Clr_box),
		nationality => Nat,
		sport => Spt,
		drink => Drk,
		pet => Pet,
		color => Clr))
	:-

	set_slot(Nat_box,Nat),
	set_slot(Spt_box,Spt),
	set_slot(Drk_box,Drk),
	set_slot(Pet_box,Pet),
	set_color(Clr_box,Clr).

% The categories of values for the slot assignments are declared as
% sorts to be used in the triggering of the displaying demons. Basically,
% displaying a house's slot needs to wait for the slot to have an actual
% value.

category := {citizenship; activity; beverage; animal; tint}.

citizenship := {'English'; 'Spanish'; 'Japanese'; 'Ukrainian'; 'Norwegian'}.

activity := {polo; 'Go'; judo; poker; cricket}.

beverage := {coffee; 'orange juice'; tea; water; milk}.

animal := {dog; snails; horse; fox; zebra}.

tint := {'Ivory'; 'Red'; 'Blue'; 'Yellow'; 'Green'}.

set_slot(B,Value:category)
	-> true
    |
	(
	    reset_text(B,psi2str(Value))
	;   % Erase this string slot upon backtracking
	    reset_text(B," "),
	    fail
	).
	
set_color(B:@(X,Y,W,H),Value:tint)
	-> true
    |
	(
	    xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
			   color => color(Value))
	;   % Erase this color slot upon backtracking
	    xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
			   color => light_grey),
	    fail
	).
	    
global(light_grey <- new_color(210,210,210))?

% Actions for the control panel buttons:

persistent(is_reset)?
is_reset <<- true?

solve(Hs) :-
	cond(is_reset,
	     succeed,
	     reset(Hs)),
	is_reset <<- false,
	reset_text(Hs.timebox,"Solving..."),
	solution(Hs),
%	play("clink", 60),
	display_houses(Hs).

animate(Hs:@(timebox=>TB,
	     morebox=>M,
	     stop=>Stop))
	:-
	cond(is_reset, succeed, reset(Hs)),
	reset_text(TB,"Animating..."),
	(
	    Stop = get_choice,
	    display_houses(Hs),
	    solution(Hs)
	;
	    reset(Hs) % reached by STOP only
	).

stop(Stop) :-
	cond(is_value(Stop),
	     (set_choice(Stop),fail),
	     succeed).

reset_all(Hs) :- cond(is_reset,succeed,reset(Hs)).

reset(Hs:[@(box=>H1),
	  @(box=>H2),
	  @(box=>H3),
	  @(box=>H4),
	  @(box=>H5)]
	(timebox => TB,morebox=>M,stopbox=>S,stop=>Stop))
	:-
	nums <- @,
	nats <- @,
	spts <- @,
	drks <- @,
	pets <- @,
	cols <- @,
	reset_text(TB," "),
	reset_boxes(Hs),
	Hs <- [@(box=>H1),@(box=>H2),@(box=>H3),@(box=>H4),@(box=>H5)],
	Hs = @(timebox => TB,morebox=>M,stopbox=>S,stop=>Stop),
	is_reset <<- true.

reset_boxes([H|Hs]) :- !, reset_box(H), reset_boxes(Hs).
reset_boxes([]).

reset_box(@(box=>@(nat=>Nat_box,
		   spt=>Spt_box,
		   drk=>Drk_box,
		   pet=>Pet_box,
		   clr=>Clr_box)))

	:-

	reset_text(Nat_box," "),
	reset_text(Spt_box," "),
	reset_text(Drk_box," "),
	reset_text(Pet_box," "),
	reset_color(Clr_box).

reset_color(B:@(X,Y,W,H)) :-
	xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
		       color => light_grey).
% Colors and fonts

color('Blue') -> blue.
color('Green') -> green.
color('Ivory') -> wheat.
color('Red') -> red.
color('Yellow') -> yellow.

def_color(main_colors,i,white)?
def_color(main_colors,r,red)?
def_color(main_colors,b,blue)?
def_color(main_colors,y,yellow)?
def_color(main_colors,g,green)?

def_color(main_colors,z_color,'blue violet')?

def_font(z_font,
	 new_font(cond(life_demo#using_demo_fonts,
		       "terminal_bold_narrow18",
		       "-adobe-helvetica-bold-r-narrow--17-120-100-100-p-72-*")))?

def_font(title_font,
	 new_font(cond(life_demo#using_demo_fonts,
		       "terminal_bold_narrow28",
		       "-adobe-helvetica-bold-r-narrow--25-180-100-100-p-116-*")))?

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% PUTTING THE SOLVER AND THE GRAPHICAL INTERFACE TOGETHER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% The usual question is who owns the zebra and who drinks water.  So, we
% let the clues constrain themselves, then find the zebra and water
% houses.

% And here we go ...

persistent(try_more)?
try_more <<- succeed?

solution(Hs:@(timebox => B))

	:-
	try_more <<- fail,
	A=cpu_time,
	clues(Hs),
	house(pet => zebra),
	house(drink => water),
	Time = cpu_time-A,
	reset_text(B,strcon(psi2str(Time)," s")).

solution(list(timebox => B))
	:-
	reset_text(B,"No more!"),
	beep,
	try_more <<- succeed.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
