home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / DEMO / X_ZEBRA.LF < prev    next >
Text File  |  1996-06-04  |  11KB  |  452 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2.  
  3. % The "who owns the zebra puzzle", done in Wild-Life with a graphical
  4. % interface for triggerring the solving and also animate the constraint
  5. % solving process.
  6.  
  7. % The traditional problem has "smokes" as one of the clue categories.
  8. % In the name of improving the nation's health, we have substituted
  9. % various sports...
  10.  
  11. module("x_zebra")?
  12. public(x_zebra)?
  13.  
  14. %%%%%%%%%%%%%%%%%%%
  15. % THE PUZZLE SOLVER
  16. %%%%%%%%%%%%%%%%%%%
  17.  
  18. % The main idea of this solver is to specify a relation 'house' with the
  19. % appropriate slots, and make the value of these slots (yet to be assigned
  20. % from the clues) be the features of global objects that represent the
  21. % assignments of elements in each category (i.e., nationality, number,
  22. % etc...) to a particular house. This is done by constraining the values
  23. % of the features of the global terms of each of the feature categories to
  24. % be that same house. Thus, the projections on yet unknown features of
  25. % these global terms residuate until features are assigned from the clues,
  26. % at which point they fire enforcing assignments that are unique per
  27. % house.
  28.  
  29. global(nums, nats, spts, drks, pets, cols)?
  30.  
  31. X:house(number      => Num,
  32.     nationality => Nat,
  33.     sport       => Spt,
  34.     drink       => Drk,
  35.     pet         => Pet,
  36.     color       => Col)
  37.     
  38.     :-
  39.       
  40.     nums.Num=X,
  41.     nats.Nat=X,
  42.     spts.Spt=X,
  43.     drks.Drk=X,
  44.     pets.Pet=X,
  45.     cols.Col=X,
  46.     Num={1;2;3;4;5}.
  47.  
  48. % Here are the clues.  We build a list of houses, and assign their names.
  49. % Then, we encode each clue by simply stating the conditions that must
  50. % be true of the 'house' relation. From this straightforward specification
  51. % everything falls into place.
  52.  
  53. clues([H1,H2,H3,H4,H5]) :-
  54.     H1:house(number=>1),
  55.     H2:house(number=>2),
  56.     H3:house(number=>3),
  57.     H4:house(number=>4),
  58.     H5:house(number=>5),
  59.     
  60.     %%  1: The Englishman lives in the 'Red' house
  61.     house(nationality=>'English',color=>'Red'),
  62.  
  63.     %%  2: The Spaniard owns a dog
  64.     house(nationality=>'Spanish',pet=>dog),
  65.  
  66.     %%  3: The man in the green house drinks coffee
  67.     house(color=>'Green',drink=>coffee),
  68.  
  69.     %%  4: The Ukrainian drinks tea
  70.     house(nationality=>'Ukrainian',drink=>tea),
  71.  
  72.     %%  5: The green house is to the right of the ivory house
  73.     A5:house(color=>'Green'),
  74.     B5:house(color=>'Ivory'),
  75.     right_of(A5,B5),
  76.  
  77.     %%  6: The Go player owns snails
  78.     house(sport=>'Go',pet=>snails),
  79.     
  80.     %%  7: The man in the yellow house plays cricket
  81.     house(color=>'Yellow',sport=>cricket),
  82.  
  83.     %%  8: Milk is drunk in the middle house
  84.     house(number=>3,drink=>milk),
  85.  
  86.     %%  9: The Norwegian lives at the end
  87.     house(number=>{1;5},nationality=>'Norwegian'),
  88.  
  89.     %% 10: The Judoka lives next to the man who has a fox
  90.     A10:house(sport=>judo),
  91.     B10:house(pet=>fox),
  92.     next_door(A10,B10),
  93.  
  94.     %% 11: The cricket player lives next to the man who has a horse
  95.     A11:house(sport=>cricket),
  96.     B11:house(pet=>horse),
  97.     next_door(A11,B11),
  98.  
  99.     %% 12: The poker player drinks orange juice
  100.     house(sport=>poker, drink=>'orange juice'),
  101.     
  102.     %% 13: The Japanese plays polo
  103.     house(nationality=>'Japanese',sport=>polo),
  104.  
  105.     %% 14: The Norwegian lives next to the blue house
  106.     A14:house(nationality=>'Norwegian'),
  107.     B14:house(color=>'Blue'),
  108.     next_door(A14,B14).
  109.  
  110. % Neighboring constraints:
  111.  
  112. next_door(H1,H2) :- H1.number=H2.number+{1;-1}.
  113. right_of(H1,H2) :- H2.number=H1.number+1.
  114.  
  115. % That's it!!!
  116.  
  117. %%%%%%%%%%%%%%%%%%%%%%%%%
  118. % THE GRAPHICAL INTERFACE
  119. %%%%%%%%%%%%%%%%%%%%%%%%%
  120.  
  121.     
  122. import("xtools") ?
  123. import("xtools_utils")?
  124.  
  125. % The necessary widgets:
  126.  
  127. s_box <| frame.
  128. s_box <| field.
  129. s_box <| text_box.
  130.  
  131. :: s_box(frame_state => true,
  132.      text => " ",
  133.      font_id => z_font).
  134.  
  135. slot_box := s_box(offset => d_border).
  136.  
  137. time_box := s_box(text_color_id => z_color).
  138.  
  139. color_box <| frame.
  140. color_box <| field.
  141.  
  142. :: color_box(frame_state => true).
  143.  
  144. l_box := text_box(offset => -d_border,
  145.           text_color_id => z_color,
  146.           font_id => z_font).
  147.  
  148. p_button := push_button(font_id => z_font).
  149.  
  150. house_box(N:int) -> B
  151.     |
  152.     Nat = slot_box,
  153.     Spt = slot_box,
  154.     Drk = slot_box,
  155.     Pet = slot_box,
  156.     Clr = color_box,
  157.     Num = text_box(font_id => title_font, text => psi2str(N)),
  158.  
  159.     same_size([Nat,Spt,Drk,Pet,Clr]),
  160.  
  161.     same_width([Nat,Num]),
  162.  
  163.     B = vc_list [Nat,Spt,Drk,Pet,Clr,v_box(20),Num],
  164.  
  165.     B = @(num => N, nat => Nat, spt => Spt, drk => Drk, pet => Pet, clr => Clr).
  166.  
  167. % The control and display panel:
  168.  
  169. x_zebra :-
  170.     (
  171.         C = get_choice,
  172.         Q = p_button(text => "QUIT",
  173.              action => (set_choice(C),fail)),
  174.  
  175.         G = p_button(text => "SOLVE",
  176.              action => (solve(Hs),
  177.                     reset_state(M,false))),
  178.  
  179.         M = p_button(text => "MORE",
  180.              action => (reset_text(TB,"Retrying..."),
  181.                     reset_boxes(Hs),
  182.                     try_more,
  183.                     beep,
  184.                     reset_text(TB,"No more!"))),
  185.  
  186.         A = p_button(text => "ANIMATE",
  187.              action => (animate(Hs),
  188.                     reset_state(S,false),
  189.                     reset_state(M,false))),
  190.  
  191.         S = p_button(text => "STOP",
  192.              action => stop(Stop)),
  193.  
  194.         R = p_button(text => "RESET",
  195.              action => reset_all(Hs)),
  196.  
  197.         B1 = l_box(text => "Nationality"),
  198.         B2 = l_box(text => "Sport"),
  199.         B3 = l_box(text => "Drink"),
  200.         B4 = l_box(text => "Pet"),
  201.         B5 = l_box(text => "Color"),
  202.         
  203.         same_size([Q,G,M,A,S,R|Bs:[B1,B2,B3,B4,B5]]),
  204.  
  205.         Legend = padded_box(vc_list Bs, padding => 10),
  206.  
  207.         H1 = house_box(1),
  208.         H2 = house_box(2),
  209.         H3 = house_box(3),
  210.         H4 = house_box(4),
  211.         H5 = house_box(5),
  212.  
  213.         same_width([Q,H1,H2,H3,H4,H5]),
  214.  
  215.         Houses = frame_box(ht_list [H1,H2,H3,H4,H5], padding => 10),
  216.  
  217.         TitleBox = fancy_text_box(text => "Who owns the zebra?",
  218.                       font => title_font,
  219.                       colors => [i,r,b,g,y]),
  220.         
  221.         TimeBox = hc_list [text_box(text => "Total Time:",
  222.                     font_id => z_font),
  223.                    frame_box(TB:time_box(width => 120,
  224.                              height => 50,
  225.                              text => " "),
  226.                      padding => 3)
  227.                   ],
  228.         
  229.         Panel = panel(title => "The Zebra Puzzle")
  230.           containing
  231.           padded_box(padding => 17,
  232.              vr_list [
  233.                      ht_list [vl_list [Q, v_box(10),
  234.                                G, v_box(10),
  235.                                M, v_box(10),
  236.                                A, v_box(10),
  237.                                S, v_box(10),
  238.                                R
  239.                               ],
  240.                           h_box(20),
  241.                           Legend,h_box(10),Houses
  242.                          ],
  243.                      v_box(30),
  244.                      hc_list [TimeBox,h_box(10),TitleBox]
  245.                  ]),
  246.  
  247.         create_box(Panel),
  248.  
  249.         Hs = @(timebox => TB,morebox=>M, stopbox=>S, stop=>Stop),
  250.  
  251.         Hs = [@(box=>H1),@(box=>H2),@(box=>H3),@(box=>H4),@(box=>H5)]
  252.     ;
  253.         succeed
  254.     ).
  255.     
  256. % Displaying the solutions:
  257.  
  258. display_houses([H|Hs]) :- !, display_house(H), display_houses(Hs).
  259. display_houses([]).
  260.  
  261. display_house(@(box=>@(nat=>Nat_box,
  262.                spt=>Spt_box,
  263.                drk=>Drk_box,
  264.                pet=>Pet_box,
  265.                clr=>Clr_box),
  266.         nationality => Nat,
  267.         sport => Spt,
  268.         drink => Drk,
  269.         pet => Pet,
  270.         color => Clr))
  271.     :-
  272.  
  273.     set_slot(Nat_box,Nat),
  274.     set_slot(Spt_box,Spt),
  275.     set_slot(Drk_box,Drk),
  276.     set_slot(Pet_box,Pet),
  277.     set_color(Clr_box,Clr).
  278.  
  279. % The categories of values for the slot assignments are declared as
  280. % sorts to be used in the triggering of the displaying demons. Basically,
  281. % displaying a house's slot needs to wait for the slot to have an actual
  282. % value.
  283.  
  284. category := {citizenship; activity; beverage; animal; tint}.
  285.  
  286. citizenship := {'English'; 'Spanish'; 'Japanese'; 'Ukrainian'; 'Norwegian'}.
  287.  
  288. activity := {polo; 'Go'; judo; poker; cricket}.
  289.  
  290. beverage := {coffee; 'orange juice'; tea; water; milk}.
  291.  
  292. animal := {dog; snails; horse; fox; zebra}.
  293.  
  294. tint := {'Ivory'; 'Red'; 'Blue'; 'Yellow'; 'Green'}.
  295.  
  296. set_slot(B,Value:category)
  297.     -> true
  298.     |
  299.     (
  300.         reset_text(B,psi2str(Value))
  301.     ;   % Erase this string slot upon backtracking
  302.         reset_text(B," "),
  303.         fail
  304.     ).
  305.     
  306. set_color(B:@(X,Y,W,H),Value:tint)
  307.     -> true
  308.     |
  309.     (
  310.         xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
  311.                color => color(Value))
  312.     ;   % Erase this color slot upon backtracking
  313.         xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
  314.                color => light_grey),
  315.         fail
  316.     ).
  317.         
  318. global(light_grey <- new_color(210,210,210))?
  319.  
  320. % Actions for the control panel buttons:
  321.  
  322. persistent(is_reset)?
  323. is_reset <<- true?
  324.  
  325. solve(Hs) :-
  326.     cond(is_reset,
  327.          succeed,
  328.          reset(Hs)),
  329.     is_reset <<- false,
  330.     reset_text(Hs.timebox,"Solving..."),
  331.     solution(Hs),
  332. %    play("clink", 60),
  333.     display_houses(Hs).
  334.  
  335. animate(Hs:@(timebox=>TB,
  336.          morebox=>M,
  337.          stop=>Stop))
  338.     :-
  339.     cond(is_reset, succeed, reset(Hs)),
  340.     reset_text(TB,"Animating..."),
  341.     (
  342.         Stop = get_choice,
  343.         display_houses(Hs),
  344.         solution(Hs)
  345.     ;
  346.         reset(Hs) % reached by STOP only
  347.     ).
  348.  
  349. stop(Stop) :-
  350.     cond(is_value(Stop),
  351.          (set_choice(Stop),fail),
  352.          succeed).
  353.  
  354. reset_all(Hs) :- cond(is_reset,succeed,reset(Hs)).
  355.  
  356. reset(Hs:[@(box=>H1),
  357.       @(box=>H2),
  358.       @(box=>H3),
  359.       @(box=>H4),
  360.       @(box=>H5)]
  361.     (timebox => TB,morebox=>M,stopbox=>S,stop=>Stop))
  362.     :-
  363.     nums <- @,
  364.     nats <- @,
  365.     spts <- @,
  366.     drks <- @,
  367.     pets <- @,
  368.     cols <- @,
  369.     reset_text(TB," "),
  370.     reset_boxes(Hs),
  371.     Hs <- [@(box=>H1),@(box=>H2),@(box=>H3),@(box=>H4),@(box=>H5)],
  372.     Hs = @(timebox => TB,morebox=>M,stopbox=>S,stop=>Stop),
  373.     is_reset <<- true.
  374.  
  375. reset_boxes([H|Hs]) :- !, reset_box(H), reset_boxes(Hs).
  376. reset_boxes([]).
  377.  
  378. reset_box(@(box=>@(nat=>Nat_box,
  379.            spt=>Spt_box,
  380.            drk=>Drk_box,
  381.            pet=>Pet_box,
  382.            clr=>Clr_box)))
  383.  
  384.     :-
  385.  
  386.     reset_text(Nat_box," "),
  387.     reset_text(Spt_box," "),
  388.     reset_text(Drk_box," "),
  389.     reset_text(Pet_box," "),
  390.     reset_color(Clr_box).
  391.  
  392. reset_color(B:@(X,Y,W,H)) :-
  393.     xFillRectangle(B.mother.window,X+1,Y+1,W-2,H-2,
  394.                color => light_grey).
  395. % Colors and fonts
  396.  
  397. color('Blue') -> blue.
  398. color('Green') -> green.
  399. color('Ivory') -> wheat.
  400. color('Red') -> red.
  401. color('Yellow') -> yellow.
  402.  
  403. def_color(main_colors,i,white)?
  404. def_color(main_colors,r,red)?
  405. def_color(main_colors,b,blue)?
  406. def_color(main_colors,y,yellow)?
  407. def_color(main_colors,g,green)?
  408.  
  409. def_color(main_colors,z_color,'blue violet')?
  410.  
  411. def_font(z_font,
  412.      new_font(cond(life_demo#using_demo_fonts,
  413.                "terminal_bold_narrow18",
  414.                "-adobe-helvetica-bold-r-narrow--17-120-100-100-p-72-*")))?
  415.  
  416. def_font(title_font,
  417.      new_font(cond(life_demo#using_demo_fonts,
  418.                "terminal_bold_narrow28",
  419.                "-adobe-helvetica-bold-r-narrow--25-180-100-100-p-116-*")))?
  420.  
  421. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  422. % PUTTING THE SOLVER AND THE GRAPHICAL INTERFACE TOGETHER
  423. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  424.  
  425. % The usual question is who owns the zebra and who drinks water.  So, we
  426. % let the clues constrain themselves, then find the zebra and water
  427. % houses.
  428.  
  429. % And here we go ...
  430.  
  431. persistent(try_more)?
  432. try_more <<- succeed?
  433.  
  434. solution(Hs:@(timebox => B))
  435.  
  436.     :-
  437.     try_more <<- fail,
  438.     A=cpu_time,
  439.     clues(Hs),
  440.     house(pet => zebra),
  441.     house(drink => water),
  442.     Time = cpu_time-A,
  443.     reset_text(B,strcon(psi2str(Time)," s")).
  444.  
  445. solution(list(timebox => B))
  446.     :-
  447.     reset_text(B,"No more!"),
  448.     beep,
  449.     try_more <<- succeed.
  450.  
  451. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  452.