home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / MIND.ZIP / MIND.PRO < prev   
Encoding:
Prolog Source  |  1986-06-07  |  11.8 KB  |  363 lines
  1.  
  2. domains
  3.         colors_list = color*
  4.         color = symbol
  5.         code = integer
  6.         row, column, keycode, attribute, displa = integer
  7. database
  8.         guess_colors(colors_list)
  9.         to_guess(colors_list)
  10.         my_guess(colors_list)
  11.  
  12. predicates
  13.         member(color, colors_list)
  14.         append(colors_list, colors_list, colors_list)
  15.         extract_element(color, colors_list, colors_list, integer)
  16.         check_color(integer, integer,colors_list)
  17.         colors(code, color)
  18.         select_colors(colors_list)
  19.         is_random(color)
  20.         check_pos(integer,integer,colors_list, colors_list)
  21.         check_guess(integer, integer, colors_list)
  22.         showGuess(colors_list,column)
  23.         get_element(color,integer,colors_list)
  24.         final(integer)
  25.         run
  26.         inform
  27.         putcolor(keycode, row, column,column)
  28.         attrib(color,keycode,attribute, displa)
  29.         readKey(keycode, row, column)
  30.         new_cur(column, displa, column)
  31.         getEntry(row,column)
  32.         ireadchar(char, row, column)
  33.         fakekey(char, row, column)
  34.         init_line(row, column,char)
  35.         read_line(row,column,colors_list,colors_list)
  36.         blink(row,column)
  37.         delay(integer)
  38.         play_game(integer)
  39.         play_line(row,integer,integer)
  40.         allcolors
  41. goal
  42.         makewindow(8,40,0,"",0,0,25,80),
  43.         inform,
  44.         not(run),
  45.         makewindow(8,7,0,"",0,0,25,80).
  46.  
  47. clauses
  48.  
  49.                                 /* some "facts" (tables, just tables) */
  50.         colors(1,"Blue").
  51.         colors(2,"Green").
  52.         colors(3,"Cyan").
  53.         colors(4,"Magenta").
  54.         colors(5,"Red").
  55.         colors(6,"Orange").
  56.  
  57.         attrib("Blue",98,113,0).   attrib("Green",103,114,0).
  58.         attrib("Cyan",99,115,0).   attrib("Red",114,116,0).
  59.         attrib("Magenta",109,117,0). attrib("Orange",111,118,0).
  60.         attrib(left,75,0,-7).      attrib(right,77,0,7).
  61.  
  62.                                 /* Main module (goal)                 */
  63.  
  64.         run :-  !,
  65.                 play_game(Result),
  66.                 final(Result),
  67.                 nl,nl,
  68.                 write("Another game (Y/N)?"),
  69.                 readchar(Another),
  70.                 Another = 'y',
  71.                 removewindow,
  72.                 removewindow,
  73.                 removewindow,
  74.                 removewindow,
  75.                 run, !.
  76.  
  77.  
  78.         inform :-
  79.                 makewindow(6,113,31,"INSTRUCTIONS",0,1,25,34),
  80.                 write("(c) 1986 by Israel del Rio"),
  81.                 nl,nl,
  82.                 write("Guess the 4 hidden colors from\nthe following: "),
  83.                 nl,
  84.                 allcolors.
  85.  
  86.         inform  :-
  87.                 nl,nl,
  88.                 write("  Type the first letter of the \ncolor name to be selected."),
  89.                 nl,
  90.                 write("  Use the left and right arrows\nto change columns."),
  91.                 nl,
  92.                 write("  Press ENTER when you are\nsatisfied with your guess."),
  93.                 nl,nl,
  94.                 write("\01 = Right Position & Color"),
  95.                 nl,
  96.                 write("\05 = Right Color, wrong position"),
  97.                 nl,nl,
  98.                 write("  Press any key to start game"),
  99.                 readchar(_).
  100.  
  101.         allcolors :-
  102.                 attrib(Name,_,Attr,_),
  103.                 Attr <> 0,
  104.                 nl,
  105.                 cursor(Row, Col),
  106.                 write("\219\219 = ",Name),
  107.                 field_attr(Row,Col,16,Attr),
  108.                 fail.
  109.  
  110.         play_game(Result) :-
  111.  
  112.                 makewindow(12,0,0,"",7,36,16,39),
  113.                 makewindow(2,31,116,"Hints",3,61,16,8),
  114.                 cursor(0,1),
  115.                 write("\01","  ","\05"),
  116.                 makewindow(1,112,116,"Master Mind",3,30,16,31),
  117.                 select_colors(Y),
  118.                 clearwindow,
  119.                 init_line(0,1,'?'),
  120. /*              showGuess(Y,1),*/
  121.                 play_line(2,0,Result),
  122.                 retract(guess_colors(_)),
  123.                 showGuess(Y, 1), !.
  124.  
  125.  
  126.         final(0) :-
  127.                 sound(10,5000),
  128.                 makewindow(3,87,87,"Sorry!",16,0,8,20),
  129.                 clearwindow,
  130.                 write(" Maximum number of guesses is 12"), !.
  131.  
  132.         final(Result) :-
  133.                 sound(10,5000),
  134.                 makewindow(3,106,6,"Congratulations!",17,59,8,20),
  135.                 clearwindow,
  136.                 write(" You guessed the  colors in ",Result," moves"), !.
  137.  
  138.  
  139.                                 /* randomly selects 4 colors out of 6*/
  140.  
  141.         select_colors([A,B,C,D]) :- retract(guess_colors(_)), !,
  142.                                     select_colors([A,B,C,D]).
  143.  
  144.         select_colors([A,B,C,D]) :- is_random(A), is_random(B),
  145.                                  is_random(C), is_random(D),
  146.                                  asserta(guess_colors([A,B,C,D])).
  147.  
  148.  
  149.         is_random(X) :- random(Y), Z = (Y * 6) + 0.5, colors(Z,X).
  150.  
  151.  
  152.                                 /* Evaluates how good the List guess was */
  153.  
  154.         check_guess(Good_pos, Good_col, List) :-
  155.                 retract(to_guess(_)),
  156.                 retract(my_guess(_)),
  157.                 check_guess(Good_pos, Good_col, List), !.
  158.  
  159.         check_guess(Good_pos, Good_col, List) :-
  160.                 guess_colors(Glist),
  161.                 asserta(to_guess([])),
  162.                 asserta(my_guess([])),
  163.                 check_pos(Good_pos,0,List, Glist),
  164.                 my_guess(Mlist),
  165.                 check_color(Good_col,0,Mlist), !.
  166.  
  167.                                 /* checks how many exact matches occurred*/
  168.  
  169.         check_pos(X,Y,[],_) if X = Y, !.
  170.         check_pos(X,Y,[H|Tail],[G|Gtail]) if H = G, Z = Y + 1,
  171.                                 check_pos(X,Z,Tail, Gtail), !.
  172.  
  173.         check_pos(X,Y,[H|Tail],[Z|Gtail]) :-
  174.                         W=Z, to_guess(GC),
  175.                         append([W], GC,NGC),
  176.                         retract(to_guess(_)),
  177.                         asserta(to_guess(NGC)),
  178.                         HH=H, my_guess(GG),
  179.                         append([HH],GG,NGG),
  180.                         retract(my_guess(_)),
  181.                         asserta(my_guess(NGG)),
  182.                         check_pos(X,Y,Tail,Gtail).
  183.  
  184.                                 /* Checks if color ok, but not right pos  */
  185.  
  186.         check_color(X,Count,[]) :- X = Count, !.
  187.  
  188.         check_color(X,Count,[H|Tail]) :-
  189.                 to_guess(Newlist),
  190.                 extract_element(H,Newlist,[], Success),
  191.                 Success = 1,
  192.                 Count2 = Count + 1,
  193.                 check_color(X,Count2, Tail), !.
  194.  
  195.         check_color(X,Count,[_|Tail]) :-
  196.                 check_color(X, Count, Tail).
  197.  
  198.                                 /* extracts an element from a list      */
  199.  
  200.         extract_element(_,[],NewNew,X) :-
  201.                 X = 0,
  202.                 retract(to_guess(_)),
  203.                 asserta(to_guess(NewNew)), !.
  204.  
  205.         extract_element(X,[Y|List],Newlist,F) :-
  206.                 X<>Y, append(Newlist,[Y],NewNew),
  207.                 extract_element(X,List,NewNew,F), !.
  208.  
  209.  
  210.         extract_element(_,[_|List],Newlist,X) :-
  211.                 X = 1,
  212.                 append(Newlist,List,NewNew),
  213.                 retract(to_guess(_)),
  214.                 asserta(to_guess(NewNew)), !.
  215.  
  216.  
  217.  
  218.                                 /* Performs & verifies one move     */
  219.         play_line(Row,4,Res) :- Res = Row - 2, !.
  220.  
  221.         play_line(14,_,Res) :- Res = 0, !.
  222.  
  223.         play_line(Row,_,Res) :-
  224.                 init_line(Row,1,'\178'),
  225.                 cursor(Row,1),
  226.                 getEntry(Row,1),
  227.                 read_line(Row,1,[],Selection),
  228.                 check_guess(M,C,Selection),
  229.                 shiftwindow(2),
  230.                 cursor(Row,1),
  231.                 write(M,"  ",C),
  232.                 shiftwindow(1),
  233.                 NewRow = Row + 1,
  234.                 play_line(NewRow,M,Res), !.
  235.  
  236.         play_line(Row,_,Res) :-
  237.                 sound(10,100),
  238.                 makewindow(3,64,64,"ERROR",9,26,4,48),
  239.                 clearwindow,
  240.                 write("You must select 4 colors before presing ENTER"),
  241.                 nl,write("       Press any key to continue"),
  242.                 readchar(_),
  243.                 removewindow,
  244.                 play_line(Row,0,Res), !.
  245.  
  246.         init_line(_,29,_) :-!.
  247.         init_line(Row, Col,V) :-
  248.                 cursor(Row, Col),
  249.                 write(V,V,V,V,V,V),
  250.                 NewCol = Col + 7,
  251.                 init_line(Row, NewCol,V), !.
  252.  
  253.         read_line(_,29, PrevList, List) :- List = PrevList, !.
  254.         read_line(Row, Col, PrevList, List) :-
  255.                 scr_attr(Row, Col, Attr),
  256.                 attrib(X, _, Attr, _),
  257.                 append(PrevList,[X],NewList),
  258.                 NewCol = Col + 7,
  259.                 read_line(Row, NewCol, NewList, List), !.
  260.  
  261.                                 /* Reads player entry                   */
  262.  
  263.         getEntry(Row, Column) :-
  264.                 readKey(K, Row, Column),
  265.                 K <> 13,
  266.                 putcolor(K, Row, Column, NewCol),
  267.                 getEntry(Row,NewCol), !.
  268.  
  269.         getEntry(_, _) :- !.
  270.  
  271.  
  272.         showGuess([],_) :- !.
  273.  
  274.         showGuess([C|List],Column) :-
  275.                 cursor(0,Column),
  276.                 attrib(C,Code,_,_),
  277.                 putcolor(Code, 0, Column, _),
  278.                 Newcol = Column + 7,
  279.                 showGuess(List,Newcol), !.
  280.  
  281.                                 /* Reads typed keys                     */
  282.  
  283.         readKey(K, Row, Col) :-
  284.                 fakekey(X, Row, Col),
  285.                 X <> '\0',
  286.                 frontchar(Y,X,""),
  287.                 upper_lower(Y,Z),
  288.                 frontchar(Z,C,_),
  289.                 char_int(C,K), !.
  290.  
  291.         readKey(K, Row, Col) :-
  292.                 fakekey(C, Row, Col),
  293.                 char_int(C,K), !.
  294.  
  295.  
  296.         fakekey(K,Row,Col) :- ireadchar(K,Row,Col), !.
  297.         fakekey(K,Row,Col) :- fakekey(K,Row,Col).
  298.  
  299.         ireadchar(K,_,_) :- inkey(L), !, K = L.
  300.  
  301.         ireadchar(_, Row, Col) :-
  302.                 blink(Row, Col), fail.
  303.  
  304.         blink(Row, Col) :- !,
  305.                 scr_attr(Row, Col,Attr),
  306.                 delay(600),
  307.                 field_attr(Row, Col, 6, 0),
  308.                 delay(100),
  309.                 field_attr(Row, Col, 6, Attr).
  310.  
  311.  
  312.         putcolor(K, Row, Col,NewCol) :-
  313.                 attrib(_, K, Attr, _),
  314.                 Attr <> 0,
  315.                 NewCol = Col,
  316.                 write('\219','\219','\219','\219','\219','\219'),
  317.                 field_attr(Row,NewCol,6,Attr),
  318.                 cursor(Row, NewCol), !.
  319.  
  320.         putcolor(K, Row, Col, Newcol) :-
  321.                 attrib(_, K, _, Disp),
  322.                 new_cur(Col, Disp, NewCol),
  323.                 cursor(Row, Newcol), !.
  324.  
  325.         putcolor(_, _, OldCol, NewCol) :-
  326.                 sound(2,50), NewCol = OldCol.
  327.  
  328.  
  329.  
  330.         new_cur(Old_col, Disp, New_col) :-
  331.                 New_col = Old_col + Disp,
  332.                 New_col < 23,
  333.                 New_col > 0, !.
  334.  
  335.         new_cur(_, Disp, New_col) :-
  336.                 Disp < 0,
  337.                 New_col = 22, !.
  338.  
  339.         new_cur(_, _, New_col) :-
  340.                 New_col = 1.
  341.  
  342.  
  343. /****************  GENERAL  PURPOSE   ROUTINES    ***************/
  344.  
  345.  
  346.                         /* appends 2 lists to a third list      */
  347.        append([],List,List).
  348.        append([X|L1], List2, [X|L3]) if
  349.                  append(L1,List2,L3).
  350.  
  351.                         /* Gets element #n from a list           */
  352.         get_element(X,1,[Z|_]) if ! and X=Z.
  353.         get_element(X,Y,[_|Tail]) :- Counter = Y -1, !,
  354.                                      get_element(X,Counter,Tail).
  355.  
  356.                         /* Verifies if an entry is member of list */
  357.        member(Name,[Name|_]) :- !.
  358.        member(Name,[_|Tail]) if member(Name,Tail).
  359.  
  360.         delay(0) :- !.
  361.         delay(N) :- NN = N - 1, delay(NN).
  362.  
  363.