home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Borland Plateform / Turbo Prolog 2 / GEOBASE.INC < prev    next >
Encoding:
Text File  |  1986-04-25  |  22.0 KB  |  770 lines
  1. /****************************************************************/
  2. /*            Help predicates                */
  3. /****************************************************************/
  4.  
  5. PREDICATES
  6.   maxlen(LIST,INTEGER,INTEGER)        /* Find the length of the longest string */
  7.   listlen(LIST,INTEGER)            /* Find the length of a list */
  8.   writelist(INTEGER,INTEGER,LIST)    /* Used by the menu predicate */
  9.   write_list(INTEGER,LIST)        /* Write the list separated by spaces */
  10.   write_list2(LIST)            /* Display an answer */
  11.   append(LIST,LIST,LIST)        /* append two lists */
  12.   unik(LIST,LIST)            /* Eliminate duplicates in a list */
  13.   repeat                /* Make backtrack points */
  14.   index(LIST,INTEGER,SYMBOL)        /* Select an element from a list */
  15.  
  16. CLAUSES
  17.   index([X|_],1,X):- !.
  18.   index([_|L],N,X):- N>1,N1=N-1,index(L,N1,X).
  19.  
  20.   unik([],[]).
  21.   unik([H|T],L):-member(H,T),!,unik(T,L).
  22.   unik([H|T],[H|L]):-unik(T,L).
  23.  
  24.   append([],L,L).
  25.   append([Ah|At],B,[Ah|C]):-append(At,B,C).
  26.  
  27.   maxlen([H|T],MAX,MAX1):-
  28.         str_len(H,LEN),
  29.         LEN>MAX,!,
  30.         maxlen(T,LEN,MAX1).
  31.   maxlen([_|T],MAX,MAX1):-maxlen(T,MAX,MAX1).
  32.   maxlen([],LEN,LEN).
  33.  
  34.   listlen([],0).
  35.   listlen([_|T],N):-
  36.         listlen(T,X),
  37.         N=X+1.
  38.  
  39.   writelist(_,_,[]).
  40.   writelist(LI,ANTKOL,[H|T]):-field_str(LI,0,ANTKOL,H),
  41.         LI1=LI+1,writelist(LI1,ANTKOL,T).
  42.  
  43.   repeat. repeat:-repeat.
  44.  
  45.   write_list(_,[]).
  46.   write_list(_,[X]):-!,write(X).
  47.   write_list(4,[H|T]):-!,write(H),nl,write_list(0,T).
  48.   write_list(3,[H|T]):-str_len(H,LEN),LEN>13,!,write(H),nl,write_list(0,T).
  49.   write_list(N,[H|T]):-str_len(H,LEN),LEN>13,!,N1=N+2,writef("%-27 ",H),write_list(N1,T).
  50.   write_list(N,[H|T]):-N1=N+1,writef("%-13 ",H),write_list(N1,T).
  51.  
  52.   write_list2([]).
  53.   write_list2([H|T]):-write(H,' '),write_list2(T).
  54.  
  55.  
  56. /************************************************************************/
  57. /*         READING QUERIES                        */
  58. /************************************************************************/
  59.  
  60. DOMAINS
  61.   /* Seven types of questions are recognized */
  62.   QUERY    =    q_e(SYMBOL) ;
  63.         q_eaec(SYMBOL,SYMBOL,SYMBOL,SYMBOL) ;
  64.         q_eaq(SYMBOL,SYMBOL,SYMBOL,QUERY) ;
  65.         q_sel(SYMBOL,SYMBOL,SYMBOL,REAL);
  66.         q_min(SYMBOL,QUERY);
  67.         q_max(SYMBOL,QUERY);
  68.         q_not(SYMBOL,QUERY) ;
  69.         q_or(QUERY,QUERY) ;
  70.         q_and(QUERY,QUERY)
  71.  
  72. PREDICATES
  73.   /* Input-output */
  74.   loop(SYMBOL)            /* Main loop */
  75.   readquery(SYMBOL)
  76.   write_unit(SYMBOL)        /* Write the unit for an entity */
  77.   write_solutions(INTEGER)    /* Write the number of solutions */
  78.  
  79.   /* Scanner */
  80.   scan(SYMBOL,LIST)        /* Convert a string to a list of words */
  81.   filter(LIST,LIST)        /* eliminate commas and periods    */
  82.  
  83.   /* Parser */
  84.   pars(LIST,SYMBOL,QUERY)
  85.  
  86.   /* Evaluation */
  87.   eval(QUERY,SYMBOL)
  88.  
  89.  
  90. CLAUSES
  91.   loop(STR):-    STR >< "",
  92.           scan(STR,LIST),               /* Returns a list of words(symbols)           */
  93.         filter(LIST,LIST1),           /* Removes punctuation and words to be ignored*/
  94.         pars(LIST1,E,Q),              /* Parses querries                            */
  95.         findall(A,eval(Q,A),L),
  96.         unik(L,L1),
  97.         write_list(0,L1),
  98.         write_unit(E),
  99.         listlen(L1,N),
  100.         write_solutions(N),
  101.         fail.
  102.  
  103.   loop(STR):-    STR >< "",readquery(L),loop(L).
  104.  
  105.   readquery(QUERY):-nl,nl,write("Query: "),readln(QUERY).
  106.   
  107.  
  108.   scan(STR,[TOK|LIST]):-
  109.         fronttoken(STR,SYMB,STR1),!,
  110.         upper_lower(SYMB,TOK),
  111.         scan(STR1,LIST).
  112.   scan(_,[]).
  113.  
  114.  
  115.   filter(["."|T],L):-    !,filter(T,L).
  116.   filter([","|T],L):-    !,filter(T,L).
  117.   filter(["?"|T],L):-    !,filter(T,L).
  118.   filter([H|T],L):-    ignore(H),!,filter(T,L).
  119.   filter([H|T],[H|L]):-    filter(T,L).
  120.   filter([],[]).
  121.  
  122.   write_unit(E):-unit(E,UNIT),!,write(' ',UNIT).
  123.   write_unit(_).
  124.  
  125.   write_solutions(0):-!,write("\nNo solutions").
  126.   write_solutions(1):-!.
  127.   write_solutions(N):-!,writef("\n% Solutions",N).
  128.  
  129.  
  130. /************************************************************************/
  131. /*                 ENTITY NAMES                    */
  132. /************************************************************************/
  133.  
  134. PREDICATES
  135.   entn(SYMBOL,SYMBOL)        /* Convert an entity to singularis */
  136.   entity(SYMBOL)        /* Get all entities */
  137.   ent_synonym(SYMBOL,SYMBOL)    /* Synonyms for entities */
  138.   ent_name(SYMBOL,SYMBOL)    /* Convert between an entity 
  139.                    name and an internal entity name */
  140.  
  141. CLAUSES
  142.   ent_synonym(E,ENT):-synonym(E,ENT).
  143.   ent_synonym(E,E).
  144.  
  145.   ent_name(ENT,NAVN):-entn(E,NAVN),ent_synonym(E,ENT),entity(ENT).
  146.  
  147.   entn(E,N):-concat(E,"s",N).
  148.   entn(E,N):-free(E),bound(N),concat(X,"ies",N),concat(X,"y",E).
  149.   entn(E,E).
  150.  
  151.   entity(name).
  152.   entity(continent).
  153.   entity(X):-relat(_,ATTL),member(X,ATTL).
  154.  
  155.  
  156.  
  157. /************************************************************************/
  158. /*            Error detection                    */
  159. /************************************************************************/
  160.  
  161. PREDICATES
  162.   error(LIST)
  163.   known_word(SYMBOL)
  164.  
  165. CLAUSES
  166.   error(LIST):-    write(">> "),member(Y,LIST),not(known_word(Y)),!,
  167.         write("Unknown word: ",Y),nl.
  168.  
  169.   error(_):-    write("Sorry, the sentence can't be recognized").
  170.  
  171.   known_word(X):-str_real(X,_),!.
  172.   known_word("and"):-!.
  173.   known_word("or"):-!.
  174.   known_word("not"):-!.
  175.   known_word("all"):-!.
  176.   known_word("thousand"):-!.
  177.   known_word("million"):-!.
  178.   known_word(X):-min(X),!.
  179.   known_word(X):-max(X),!.
  180.   known_word(X):-big(_,X),!.
  181.   known_word(X):-ignore(X),!.
  182.   known_word(X):-unit(_,X),!.
  183.   known_word(X):-assoc(_,AL),member(X,AL),!.
  184.   known_word(X):-ent_name(_,X),!.
  185.   known_word(X):-entity(X),!.
  186.   known_word(X):-relop(L,_),member(X,L),!.
  187.   known_word(X):-entity(E),not(unit(E,_)),ent(E,X).
  188.  
  189.  
  190. /************************************************************************/
  191. /*                 PARSER                        */
  192. /************************************************************************/
  193.  
  194. PREDICATES            /* Read a compound entity (new york) */
  195.   check(LIST)
  196.   get_ent(LIST,LIST,SYMBOL)
  197.   get_cmpent(LIST,LIST,STRING,STRING)
  198.   ent_end(LIST)
  199.  
  200. CLAUSES
  201.   check([]).    /* Check that the list is empty */
  202.  
  203.   get_ent([E|S],S,E):-ent_end(S),!.
  204.   get_ent(S1,S2,ENT):-get_cmpent(S1,S2," ",E1),frontchar(E1,_,E),ENT=E.
  205.   
  206.   get_cmpent([E|S],S,IND,ENT):-ent_end(S),concat(IND,E,ENT).
  207.   get_cmpent([E|S1],S2,IND,ENT):-
  208.         concat(IND,E,II),concat(II," ",III),
  209.         get_cmpent(S1,S2,III,ENT).
  210.  
  211.   ent_end([]).
  212.   ent_end(["and"|_]).
  213.   ent_end(["or"|_]).
  214.  
  215.  
  216. PREDICATES
  217.   s_rel(LIST,LIST,SYMBOL)
  218.   s_unit(LIST,LIST,SYMBOL)
  219.   s_val(LIST,LIST,REAL)
  220.  
  221. CLAUSES
  222.   s_rel(S1,S2,REL):-relop(RLIST,REL),append(RLIST,S2,S1).
  223.     
  224.   s_unit([UNIT|S],S,UNIT).
  225.   s_val([X,thousand|S],S,VAL):-    !,str_real(X,XX),VAL=1000*XX.
  226.   s_val([X,million|S],S,VAL):-    !,str_real(X,XX),VAL=1000000*XX.
  227.   s_val([X|S],S,VAL):-        str_real(X,VAL).
  228.  
  229.  /* Here begins the parser. The first two parameters for the parsing
  230.    predicates are the inputlist and what remains of the list
  231.    after a part of a query is stripped off. In the last parameter, a
  232.    structure for the query is built up.
  233.  
  234.    This method is called "parsing by difference lists." Once you understand
  235.    how it works, you can easily add new sentence constructions to the language.
  236. */
  237.  
  238. PREDICATES
  239.   s_attr(LIST,LIST,SYMBOL,QUERY)
  240.   s_minmax(LIST,LIST,SYMBOL,QUERY)
  241.   s_rest(LIST,LIST,SYMBOL,QUERY)
  242.   s_or(LIST,LIST,SYMBOL,QUERY)
  243.   s_or1(LIST,LIST,SYMBOL,QUERY,QUERY)
  244.   s_and(LIST,LIST,SYMBOL,QUERY)
  245.   s_and1(LIST,LIST,SYMBOL,QUERY,QUERY)
  246.   s_elem(LIST,LIST,SYMBOL,QUERY)
  247.   s_assoc(LIST,LIST,SYMBOL,QUERY)
  248.   s_assoc1(LIST,LIST,SYMBOL,SYMBOL,QUERY)
  249.   s_nest(LIST,LIST,SYMBOL,QUERY)
  250.   get_assoc(LIST,LIST,SYMBOL) 
  251.  
  252. CLAUSES
  253.   pars(LIST,E,Q):-s_attr(LIST,OL,E,Q),check(OL),!.
  254.   pars(LIST,_,_):-error(LIST),fail.
  255.  
  256.   /* How big is the city new york -- BIG ENTITY CONSTANT */
  257.   s_attr([BIG,ENAME|S1],S2,E1,q_eaec(E1,A,E2,X)):-
  258.         big(E2,BIG),ent_name(E2,ENAME),
  259.         entitysize(E2,E1),schema(E1,A,E2),
  260.         get_ent(S1,S2,X),!.
  261.   
  262.   /* How big is new york -- BIG CONSTANT */
  263.   s_attr([BIG|S1],S2,E1,q_eaec(E1,A,E2,X)):-
  264.         get_ent(S1,S2,X),
  265.         big(E2,BIG),entitysize(E2,E1),
  266.         schema(E1,A,E2),    ent(E2,X),!.
  267.  
  268.   /* How big is the biggest city -- BIG QUERY */
  269.   s_attr([BIG|S1],S2,E1,q_eaq(E1,A,E2,Q)):-
  270.         big(_,BIG),!,s_minmax(S1,S2,E2,Q),
  271.         big(E2,BIG),entitysize(E2,E1),
  272.         schema(E1,A,E2),!.
  273.  
  274.   s_attr(S1,S2,E,Q):-s_minmax(S1,S2,E,Q).
  275.  
  276.  
  277.   /* The smallest city -- MIN QUERY */
  278.   s_minmax([MIN|S1],S2,E,q_min(E,Q)):-min(MIN),!,s_rest(S1,S2,E,Q).
  279.  
  280.   /* The biggest city -- MAX QUERY */
  281.   s_minmax([MAX|S1],S2,E,q_max(E,Q)):-max(MAX),!,s_rest(S1,S2,E,Q).
  282.  
  283.   s_minmax(S1,S2,E,Q):-s_rest(S1,S2,E,Q).
  284.  
  285.  
  286.   /* give me cities -- ENTITY */
  287.   s_rest([ENAME],[],E,q_e(E)):-!,ent_name(E,ENAME).
  288.  
  289.   s_rest([ENAME|S1],S2,E,Q):-ent_name(E,ENAME),s_or(S1,S2,E,Q).
  290.  
  291.  
  292.   /* And has higher priority than or */
  293.   s_or(S1,S2,E,Q):-s_and(S1,S3,E,Q1),s_or1(S3,S2,E,Q1,Q).
  294.   s_or1(["or",ENT|S1],S2,E,Q1,q_or(Q1,Q2)):-ent_name(E,ENT),!,s_or(S1,S2,E,Q2).
  295.   s_or1(["or"|S1],S2,E,Q1,q_or(Q1,Q2)):-!,s_or(S1,S2,E,Q2).
  296.   s_or1(S,S,_,Q,Q).
  297.  
  298.   s_and(S1,S2,E,Q):-s_elem(S1,S3,E,Q1),s_and1(S3,S2,E,Q1,Q).
  299.   s_and1(["and",ENT|S1],S2,E,Q1,q_and(Q1,Q2)):-ent_name(E,ENT),!,s_elem(S1,S2,E,Q2).
  300.   s_and1(["and"|S1],S2,E,Q1,q_and(Q1,Q2)):-!,s_elem(S1,S2,E,Q2).
  301.   s_and1(S,S,_,Q,Q).
  302.  
  303.  
  304.   /* not QUERY */
  305.   s_elem(["not"|S1],S2,E,q_not(E,Q)):-!,s_assoc(S1,S2,E,Q).
  306.   s_elem(S1,S2,E,Q):-s_assoc(S1,S2,E,Q).
  307.  
  308.  
  309.   /* ... longer than 1 thousand miles -- REL VAL UNIT */
  310.   s_assoc(S1,S4,E,q_sel(E,REL,ATTR,VAL)):-
  311.         s_rel(S1,S2,REL),s_val(S2,S3,VAL),
  312.         s_unit(S3,S4,UNIT),!,unit(ATTR,UNIT).
  313.  
  314.   /* ... longer than 1 thousand -- REL VAL */
  315.   s_assoc(S1,S3,E,q_sel(E,REL,ATTR,VAL)):-
  316.         s_rel(S1,S2,REL),s_val(S2,S3,VAL),!,
  317.         entitysize(E,ATTR).
  318.  
  319.   s_assoc(S1,S3,E,Q):-
  320.         get_assoc(S1,S2,A),s_assoc1(S2,S3,E,A,Q).
  321.  
  322.  
  323.   /* Before s_assoc1 is called ENT ASSOC is met */
  324.  
  325.   /* ... the shortest river in texas -- MIN QUERY */
  326.   s_assoc1([MIN|S1],S2,E1,A,q_eaq(E1,A,E2,q_min(E2,Q))):-min(MIN),!,
  327.         s_nest(S1,S2,E2,Q),schema(E1,A,E2).
  328.  
  329.   /* ... the longest river in texas -- MAX QUERY */
  330.   s_assoc1([MAX|S1],S2,E1,A,q_eaq(E1,A,E2,q_max(E2,Q))):-max(MAX),!,
  331.         s_nest(S1,S2,E2,Q),schema(E1,A,E2).
  332.  
  333.   /* ... with a population that is smaller than 1 million citizens --
  334.                                ENT REL VAL UNIT */
  335.   s_assoc1([ATTR|S1],S4,E,A,q_sel(E,REL,ATTR,VAL)):-
  336.     s_rel(S1,S2,REL),s_val(S2,S3,VAL),s_unit(S3,S4,UNIT1),!,
  337.     ent_name(E2,ATTR),schema(E,A,E2),unit(E2,UNIT),
  338.     UNIT=UNIT1,!.
  339.  
  340.   /* ... with a population that are smaller than 1 million -- ENT REL VAL */
  341.   s_assoc1([ATTR|S1],S3,E,A,q_sel(E,REL,ATTR,VAL)):-
  342.     s_rel(S1,S2,REL),s_val(S2,S3,VAL),!,
  343.     ent_name(E2,ATTR),schema(E,A,E2),unit(E2,_).
  344.  
  345.   /* ... that is smaller than 1 million citizens -- REL VAL UNIT */
  346.   s_assoc1(S1,S4,E,A,q_sel(E,REL,E2,VAL)):-
  347.     s_rel(S1,S2,REL),s_val(S2,S3,VAL),s_unit(S3,S4,UNIT1),!,
  348.     schema(E,A,E2),unit(E2,UNIT),
  349.     UNIT=UNIT1,!.
  350.  
  351.   /* ... that is smaller than 1 million -- REL VAL */
  352.   s_assoc1(S1,S3,E,A,q_sel(E,REL,E2,VAL)):-
  353.     s_rel(S1,S2,REL),s_val(S2,S3,VAL),!,
  354.     schema(E,A,E2),unit(E2,_).
  355.  
  356.   /* ... with a population on 1 million citizens -- ENT VAL UNIT */
  357.   s_assoc1([ATTR|S1],S3,E,A,q_sel(E,eq,ATTR,VAL)):-
  358.     s_val(S1,S2,VAL),s_unit(S2,S3,UNIT1),!,
  359.     ent_name(E2,ATTR),schema(E,A,E2),unit(E2,UNIT2),UNIT1=UNIT2,!.
  360.  
  361.   /* ... with a population on 1 million -- ENT VAL */
  362.   s_assoc1([ATTR|S1],S2,E,A,q_sel(E,eq,ATTR,VAL)):-
  363.     s_val(S1,S2,VAL),
  364.     ent_name(E2,ATTR),schema(E,A,E2),unit(E2,_),!.
  365.  
  366.   /* .. the state new york -- ENT CONST */
  367.   s_assoc1([ENAME|S1],S2,E1,A,q_eaec(E1,A,E2,X)):-
  368.         get_ent(S1,S2,X),ent_name(E2,ENAME),
  369.         not(unit(E2,_)),
  370.         schema(E1,A,E2),
  371.         ent(E2,X),!.
  372.  
  373.   s_assoc1(S1,S2,E1,A,q_eaq(E1,A,E2,Q)):-
  374.         s_nest(S1,S2,E2,Q),schema(E1,A,E2),!.
  375.  
  376.   /* .. new york -- CONST */
  377.   s_assoc1(S1,S2,E1,A,q_eaec(E1,A,E2,X)):-
  378.         get_ent(S1,S2,X),schema(E1,A,E2),ent(E2,X),!.
  379.  
  380.  
  381.   /* Parse a nested query */
  382.   s_nest([ENAME|S1],S2,E,Q):-ent_name(E,ENAME),s_elem(S1,S2,E,Q).
  383.   s_nest([ENAME|S],S,E,q_e(E)):-ent_name(E,ENAME).
  384.  
  385.  
  386.   /* ... runs through texas -- ASSOC REST */
  387.   get_assoc(IL,OL,A):-append(ASL,OL,IL),assoc(A,ASL).
  388.  
  389.  
  390.  
  391. /************************************************************************/
  392. /*            EVALUATION OF QUESTIONS                */
  393. /************************************************************************/
  394.  
  395. PREDICATES  /* Help predicates for the parser */
  396.   sel_min(SYMBOL,SYMBOL,REAL,SYMBOL,SYMBOL,LIST)
  397.   sel_max(SYMBOL,SYMBOL,REAL,SYMBOL,SYMBOL,LIST)
  398.  
  399. CLAUSES
  400.   eval(q_min(ENT,TREE),ANS):-
  401.         findall(X,eval(TREE,X),L),
  402.         entitysize(ENT,ATTR),
  403.         sel_min(ENT,ATTR,99e99,"",ANS,L).
  404.  
  405.   eval(q_max(ENT,TREE),ANS):-
  406.         findall(X,eval(TREE,X),L),
  407.         entitysize(ENT,ATTR),
  408.         sel_max(ENT,ATTR,-1,"",ANS,L).
  409.  
  410.   eval(q_sel(E,gt,ATTR,VAL),ANS):-
  411.         schema(ATTR,ASSOC,E),
  412.         db(ATTR,ASSOC,E,SVAL2,ANS),
  413.         str_real(SVAL2,VAL2),
  414.         VAL2>VAL.
  415.  
  416.   eval(q_sel(E,lt,ATTR,VAL),ANS):-
  417.         schema(ATTR,ASSOC,E),
  418.         db(ATTR,ASSOC,E,SVAL2,ANS),
  419.         str_real(SVAL2,VAL2),
  420.         VAL2<VAL.
  421.  
  422.   eval(q_sel(E,eq,ATTR,VAL),ANS):-
  423.         schema(ATTR,ASSOC,E),
  424.         db(ATTR,ASSOC,E,SVAL,ANS),
  425.         str_real(SVAL,VAL).
  426.  
  427.   eval(q_not(E,TREE),ANS):-
  428.         findall(X,eval(TREE,X),L),
  429.         ent(E,ANS),
  430.         not(member(ANS,L)).
  431.  
  432.   eval(q_eaq(E1,A,E2,TREE),ANS):-
  433.         eval(TREE,VAL),db(E1,A,E2,ANS,VAL).
  434.  
  435.   eval(q_eaec(E1,A,E2,C),ANS):-db(E1,A,E2,ANS,C).
  436.  
  437.   eval(q_e(E),ANS):-    ent(E,ANS).
  438.  
  439.   eval(q_or(TREE,_),ANS):- eval(TREE,ANS).
  440.  
  441.   eval(q_or(_,TREE),ANS):- eval(TREE,ANS).
  442.  
  443.   eval(q_and(T1,T2),ANS):- eval(T1,ANS1),eval(T2,ANS),ANS=ANS1.
  444.  
  445.  
  446.   sel_min(_,_,_,RES,RES,[]).
  447.   sel_min(ENT,ATTR,MIN,_,RES,[H|T]):-schema(ATTR,ASSOC,ENT),
  448.     db(ATTR,ASSOC,ENT,VAL,H),
  449.     str_real(VAL,HH),MIN>HH,!,
  450.     sel_min(ENT,ATTR,HH,H,RES,T).
  451.   sel_min(ENT,ATTR,MIN,NAME,RES,[_|T]):-sel_min(ENT,ATTR,MIN,NAME,RES,T).
  452.  
  453.  
  454.   sel_max(_,_,_,RES,RES,[]).
  455.   sel_max(ENT,ATTR,MAX,_,RES,[H|T]):-
  456.     schema(ATTR,ASSOC,ENT),
  457.     db(ATTR,ASSOC,ENT,VAL,H),
  458.     str_real(VAL,HH),MAX<HH,!,
  459.     sel_max(ENT,ATTR,HH,H,RES,T).
  460.   sel_max(ENT,ATTR,MAX,NAME,RES,[_|T]):-sel_max(ENT,ATTR,MAX,NAME,RES,T).
  461.  
  462.  
  463.  
  464. /******************************************************************/
  465. /*        READING THE KEYBORD                  */
  466. /******************************************************************/
  467.  
  468. DOMAINS
  469.   ROW,COL,LEN = INTEGER
  470.  
  471.   KEY    = cr ; esc ; break ; tab ; btab ; del ; bdel ; ins ;
  472.           end ; home ; ftast(INTEGER) ; up ; down ; left ; right ;
  473.           ctrlleft; ctrlright; ctrlend; ctrlhome; pgup; pgdn; 
  474.           chr(CHAR) ; otherspec
  475.  
  476. PREDICATES
  477.   readkey(KEY)
  478.   readkey1(KEY,CHAR,INTEGER)
  479.   readkey2(KEY,INTEGER)
  480.  
  481. CLAUSES
  482.   readkey(KEY):-readchar(T),char_int(T,VAL),readkey1(KEY,T,VAL).
  483.  
  484.   readkey1(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL).
  485.   readkey1(cr,_,13):-!.
  486.   readkey1(esc,_,27):-!.
  487.   readkey1(chr(T),T,_) .
  488.   
  489.   readkey2(up,72):-!.
  490.   readkey2(down,80):-!.
  491.   readkey2(ftast(N),VAL):-VAL>58,VAL<70,N=VAL-58,!.
  492.   readkey2(otherspec,_).
  493.  
  494.  
  495. /****************************************************************/
  496. /*             menu                    */
  497. /* Implements a popup-menu                    */
  498. /* menu(Line,Collum,ListOfChoices,ChoiceNr)            */
  499. /* The following keys can be used:                */
  500. /*    arrows up and down: select choice            */
  501. /*    cr and F10: activate choice                */
  502. /*    Esc: abort                        */
  503. /****************************************************************/
  504.  
  505. PREDICATES
  506.   menu(ROW,COL,STRING,LIST,INTEGER)
  507.   menu1(ROW,LIST,ROW,INTEGER,INTEGER)
  508.   menu2(ROW,LIST,ROW,INTEGER,INTEGER,KEY)
  509.  
  510. CLAUSES
  511.   menu(LI,KOL,TXT,LIST,CHOICE):-
  512.         shiftwindow(21),
  513.         maxlen(LIST,0,ANTKOL),
  514.         listlen(LIST,LEN),ANTLI=LEN,LEN>0,
  515.         HH1=ANTLI+2,HH2=ANTKOL+2,
  516.         makewindow(3,7,7,TXT,LI,KOL,HH1,HH2),
  517.         HH3=ANTKOL,
  518.         writelist(0,HH3,LIST),cursor(0,0),
  519.         menu1(0,LIST,ANTLI,ANTKOL,CH),
  520.         CHOICE=1+CH,
  521.         removewindow,
  522.         shiftwindow(22),
  523.         shiftwindow(2).
  524.  
  525.   menu1(LI,LIST,MAXLI,ANTKOL,CHOICE):-
  526.         field_attr(LI,0,ANTKOL,112),
  527.         cursor(LI,0),
  528.         readkey(KEY),
  529.         menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,KEY).
  530.  
  531.   menu2(_,_,_,_,-1,esc):-!.
  532.   menu2(LI,_,_,_,CH,ftast(10)):-!,CH=LI.
  533.   menu2(LI,_,_,_,CH,cr):-!,CH=LI.
  534.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,up):-
  535.         LI>0,!,
  536.         field_attr(LI,0,ANTKOL,7),
  537.         LI1=LI-1,
  538.         menu1(LI1,LIST,MAXLI,ANTKOL,CHOICE).
  539.  
  540.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,down):-
  541.         LI<MAXLI-1,!,
  542.         field_attr(LI,0,ANTKOL,7),
  543.         LI1=LI+1,
  544.         menu1(LI1,LIST,MAXLI,ANTKOL,CHOICE).
  545.  
  546.   menu2(LI,LIST,MAXLI,ANTKOL,CHOICE,_):-
  547.         menu1(LI,LIST,MAXLI,ANTKOL,CHOICE).
  548.  
  549.  
  550. /************************************************************************/
  551. /*             MAIN MENU                        */
  552. /************************************************************************/
  553.  
  554. PREDICATES
  555.   /* Main loop */
  556.   natlang
  557.   mainmenu
  558.   proces(INTEGER)  
  559.  
  560.   /* View and update the language */
  561.   viewlang viewlang1(INTEGER)
  562.   updatelang updatelang1(INTEGER)
  563.  
  564. GOAL natlang.
  565.  
  566. CLAUSES
  567.   natlang:-
  568.     makewindow(21,112,0,"",24,0,1,80),
  569.     write("ESC: Quit this menu -- Use arrow keys to select and hit RETURN to activate."),
  570.     makewindow(22,112,0,"",24,0,1,80),
  571.     write("Esc: Quit     F8: Last line    Ctrl S: Stop output    End: End of line"),
  572.     makewindow(2,7,7,"GEOBASE: Natural language interface to U.S. geography",0,0,24,80),
  573.     mainmenu.
  574.  
  575.   mainmenu:-    repeat,
  576.           menu(8,49,"Main menu",
  577.             [ "Tutorial",
  578.               "Dos commands",
  579.               "Editor",
  580.               "",
  581.               "Load the database",
  582.             "Save database on file",
  583.             "",
  584.             "Query the database",
  585.             "",
  586.             "View the language",
  587.             "Update the language"],CHOICE),
  588.         proces(CHOICE),
  589.         CHOICE=0,!,
  590.         removewindow,removewindow.
  591.  
  592.   proces(0):-write("\nAre you sure you want to quit? (y/n): "),readchar(T),T='y'.
  593.   proces(1):-file_str("geobase.hlp",TXT),display(TXT),clearwindow,!.
  594.   proces(1):-write(">> geobase.hlp not in default directory\n").
  595.   proces(2):-makewindow(3,7,0,"",0,0,25,80),write("Type EXIT to return\n\n"),
  596.              system(""),!,removewindow.
  597.   proces(2):-write(">> command.com not accessible. press any key"),readchar(_),removewindow.
  598.   proces(3):-makewindow(3,7,112,"",9,5,15,75),edit("",_),removewindow.
  599.   proces(4).
  600.   proces(5):-write("Loading database file - please wait\n"),consult("geobase.dba"),!.
  601.   proces(5):-write(">> geobase.dba not in default directory\n").
  602.   proces(6):-deletefile("geobase.bak"),renamefile("geobase.dba","geobase.bak"),save("geobase.dba").
  603.   proces(7).
  604.   proces(8):-readquery(L),loop(L).
  605.   proces(9).
  606.   proces(10):-viewlang.
  607.   proces(11):-updatelang.
  608.  
  609.  
  610. /************************************************************************/
  611. /*           View and the language                    */
  612. /************************************************************************/
  613.  
  614.   viewlang:-    repeat,
  615.          menu(5,40,"Language",
  616.             [ "1  Schema for relations",
  617.               "2  Schema for the entity network",
  618.               "3  Names of entities",
  619.               "4  Synonyms for entities",
  620.               "5  Alternative names for associations",
  621.               "6  Words to ignore",
  622.               "7  Units for attributes",
  623.               "8  Alternatives for relation operators",
  624.               "9  Words stating minimums",
  625.               "10 Words stating maximum"
  626.             ],CHOICE),
  627.         nl,viewlang1(CHOICE),CHOICE=0,!.
  628.  
  629.  
  630.   viewlang1(0).
  631.  
  632.   viewlang1(1):-
  633.     write("Relations\n*********\n"),
  634.     relat(REL,ATTL),
  635.     write(REL,": "),write_list2(ATTL),nl,fail.
  636.     
  637.   viewlang1(1):-
  638.         write("\n\nPress any key to continue"),
  639.         readchar(_).
  640.  
  641.   viewlang1(2):-
  642.     writef("%-12 %-8 %-12\n","Entity","Assoc","Entity"),
  643.     write("************ ******** ************\n"),
  644.     schema(E1,A,E2),writef("%-12 %-8 %-12\n",E1,A,E2),fail.
  645.     
  646.   viewlang1(2):-
  647.         write("\n\nPress any key to continue"),
  648.         readchar(_).    
  649.  
  650.   viewlang1(3):-
  651.     write("Entities\n********\n"),
  652.     findall(X,entity(X),L),unik(L,L1),write_list(0,L1),nl.
  653.     
  654.   viewlang1(3):-
  655.         write("\n\nPress any key to continue"),
  656.         readchar(_).    
  657.  
  658.   viewlang1(4):-
  659.     writef("%-15 %-15\n","Synonym","Entity"),
  660.     write("*************** ***************\n"),
  661.     synonym(E,S),writef("%-15 %-15\n",E,S),fail.
  662.     
  663.   viewlang1(4):-
  664.         write("\n\nPress any key to continue"),
  665.         readchar(_).    
  666.  
  667.   viewlang1(5):-
  668.     write("Associations\n************\n"),
  669.     assoc(X,L),
  670.     writef("%-8 ",X),write_list2(L),nl,fail.
  671.     
  672.   viewlang1(5):-
  673.         write("\n\nPress any key to continue"),
  674.         readchar(_).    
  675.  
  676.   viewlang1(6):-
  677.     write("Ignore\n******\n"),
  678.     findall(X,ignore(X),L),write_list(0,L),nl.
  679.     
  680.   viewlang1(6):-
  681.         write("\n\nPress any key to continue"),
  682.         readchar(_).    
  683.  
  684.   viewlang1(7):-
  685.     writef("%-0@O╚@F@\n","entity","unit"),
  686.     write("*************** ***************\n"),
  687.     unit(E,U),writef("%-15 %-15\n",E,U),fail.
  688.     
  689.   viewlang1(7):-
  690.         write("\n\nPress any key to continue"),
  691.         readchar(_).    
  692.  
  693.   viewlang1(8):-
  694.     write("Names of relational operators\n*****************************\n"),
  695.     relop(LIST,REL),write(REL,": "),write_list2(LIST),nl,fail.
  696.     
  697.   viewlang1(8):-
  698.         write("\n\nPress any key to continue"),
  699.         readchar(_).    
  700.  
  701.   viewlang1(9):-
  702.     write("Minimum\n*******\n"),
  703.     findall(X,min(X),L),write_list(0,L),nl.
  704.     
  705.   viewlang1(9):-
  706.         write("\n\nPress any key to continue"),
  707.         readchar(_).
  708.       
  709.   viewlang1(10):-
  710.     write("Maximum\n*******\n"),
  711.     findall(X,max(X),L),write_list(0,L),nl.
  712.     
  713.   viewlang1(10):-
  714.         write("\n\nPress any key to continue"),
  715.         readchar(_).    
  716.  
  717.  
  718. /************************************************************************/
  719. /*           Update  the language                    */
  720. /************************************************************************/
  721.  
  722. PREDICATES
  723.   newignore
  724.   newsynonym
  725.   newassoc
  726.   getent(SYMBOL)
  727.   getassoc(SYMBOL)
  728.  
  729. CLAUSES
  730.   updatelang:-    repeat,
  731.          menu(5,40,"Update Language",
  732.             [ "New Synonyms for entities",
  733.               "New Alternatives for associations",
  734.               "New Words to be ignored"
  735.             ],CHOICE),
  736.         nl,updatelang1(CHOICE),CHOICE=0,!.
  737.  
  738.   updatelang1(0).
  739.   updatelang1(1):-newsynonym.
  740.   updatelang1(2):-newassoc.
  741.   updatelang1(3):-newignore.
  742.  
  743.  
  744.   newsynonym:-    getent(E),write("Synonym: "),
  745.         readln(SYNONYM),SYNONYM><"",
  746.         assert(synonym(SYNONYM,E)),newsynonym.
  747.  
  748.   newignore:-    write("Ignore:"),readln(IGNORE),IGNORE><"",
  749.         assert(ignore(IGNORE)),newignore.
  750.  
  751.   newassoc:-
  752.         getassoc(ASSOC),
  753.         write("New form: "),
  754.         readln(FORM),FORM >< "",
  755.         scan(FORM,LIST),
  756.         assert(assoc(ASSOC,LIST)),
  757.         newassoc.
  758.  
  759.   getassoc(A):-
  760.         findall(X,assoc(X,_),L),
  761.         unik(L,L1),
  762.         menu(11,30,"Assoc",L1,C),
  763.         index(L1,C,A).
  764.  
  765.   getent(E):-
  766.         findall(X,entity(X),L),
  767.         unik(L,L1),
  768.         menu(2,49,"Entity",L1,C),
  769.         index(L1,C,E).
  770.