home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XIQ.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  2.7 KB  |  95 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.         Demo of    menu_mult
  7. ****************************************************************/
  8.  
  9. include "tdoms.pro"
  10. include "tpreds.pro"
  11. include "menu.pro"
  12.  
  13. DOMAINS
  14.   numberlist=integer*
  15.  
  16. PREDICATES
  17.   solution(integer,integerlist)
  18.   ask(numberlist,integer)
  19.   append(integerlist,integerlist,integerlist)
  20.   member(integer,integerlist)
  21.   q(integer,string,stringlist)
  22.   same(integerlist,integerlist)
  23.   allelts(integerlist,integerlist)
  24.   message(integer)
  25.   checkanswer(integer,integerlist,integerlist,integer)
  26.  
  27. GOAL
  28.     makewindow(1,32,66,"Professor Blanketbrain's Intelligence Test",
  29.                                 0,0,25,80),
  30.     write("\n\n\tMake any number of selections using the RETURN key."),
  31.     write("\n\tWhen all selections have been made, press F10."),
  32.     nl,nl,ask([4,3,2,1],Totalok),
  33.     nl,nl,write("    - The puzzle is over. "),nl,nl,
  34.     message(Totalok),nl,nl,
  35.     write("    Please press the space bar."),
  36.     readchar(_).
  37.  
  38. CLAUSES
  39.   q(1,"Question 1: Which animal(s) are the odd ones out?",
  40.     [dog,cat,duck,rabbit,whale,swan]).
  41.  
  42.   q(2,"Question 2: Which number(s) are the odd ones out?",
  43.     ["2","3","4","5","6","7" ]).
  44.  
  45.   q(3,"Question 3: Which colors are the odd ones out?",
  46.     [red,orange,yellow,pink,green,brown,black]).
  47.  
  48.   q(4,"Question 4: Which name(s) are the odd ones out?",
  49.     [kim,tom,george,alison,mary,martha]).
  50.  
  51.   solution(1,[3,6]).
  52.   solution(2,[3,5]).
  53.   solution(3,[4,6,7]).
  54.   solution(4,[1,2]).
  55.  
  56.   message(4):-
  57.     write("    You got all 4 correct."),nl,
  58.     write("    Professor Blanketbrain thinks you are a genius.").
  59.  
  60.   message(0):-
  61.     write("    You got none of them correct."),nl,
  62.     write("    Professor Blanketbrain thinks you could improve your knowledge.").
  63.  
  64.   message(Totalok):-
  65.     write("     You got ",Totalok," correct. "),nl,
  66.     write("    Not bad but not good either.").
  67.  
  68.   ask([],0).
  69.   ask([X | Y],Newscore):-
  70.     ask(Y,Oldscore),q(X,Title,Choicelist),
  71.     menu_mult(10,10,7,23,Choicelist,Title,[],Oddlist),
  72.     solution(X,L),checkanswer(X,L,Oddlist,Score),
  73.     Newscore=Oldscore+Score.
  74.               
  75.   checkanswer(X,L,Oddlist,1):-
  76.     same(L,Oddlist),
  77.     write("     You have got question  ",X),
  78.     write(" correct. Please press the space bar."),
  79.     nl,readchar(_).
  80.   checkanswer(X,_,_,0):-
  81.     write("    Sorry, but you have got question ",X),
  82.     write(" wrong  - Please press the space bar."),
  83.     nl,readchar(_).
  84.      
  85.   same(A,B):-allelts(A,B),allelts(B,A).
  86.  
  87.   allelts([],_).
  88.   allelts([X | Y],B):-member(X,B),allelts(Y,B).
  89.  
  90.   member(X,[X|_]).
  91.   member(X,[_|Y]):-member(X,Y).
  92.          
  93.   append([],X,X).
  94.   append([X|L1],L2,[X|L3]):-append(L1,L2,L3).
  95.