home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XCLUB.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  5.1 KB  |  199 lines
  1.  
  2. /****************************************************************
  3.  
  4.      Turbo Prolog Toolbox
  5.      (C) Copyright 1987 Borland International.
  6.  
  7.         Common interest group
  8. ****************************************************************/
  9.  
  10. code=3000
  11.  
  12. include "tdoms.pro"
  13.  
  14. DOMAINS
  15.   FNAME=SYMBOL
  16.   FNAMELIST = FNAME*
  17.   TYPE = int(); str(); real()
  18.  
  19. DOMAINS
  20.   /* Domains for the  demo */
  21.   Name, Address = STRING
  22.   Age        = INTEGER
  23.   Sex        = m or f
  24.   Interest    = symbol
  25.   Interests    = Interest*
  26.   FILE    = textfile
  27.  
  28. DATABASE
  29.   /* Database declarations used in SCRHND */
  30.   insmode            /* Global insertmode */
  31.   actfield(FNAME)        /* Actual field */
  32.   screen(SYMBOL,DBASEDOM)    /* Saving different screens */
  33.   value(FNAME,STRING)        /* value of a field */
  34.   field(FNAME,TYPE,ROW,COL,LEN) /* Screen definition */
  35.   txtfield(ROW,COL,LEN,STRING)
  36.   windowsize(ROW,COL).
  37.   notopline
  38.  
  39.   /* Database predicates used in VSCRHND */
  40.   windowstart(ROW,COL)
  41.   mycursord(ROW,COL)
  42.  
  43.   /* Database declarations used in LINEINP */
  44.   lineinpstate(STRING,COL)
  45.   lineinpflag
  46.  
  47.   /* Local database */
  48.   person(Name,Address,Age,Sex,Interests)
  49.  
  50. include "tpreds.pro"
  51. include "menu.pro"
  52. include "status.pro"
  53. include "lineinp.pro"
  54. include "filename.pro"
  55. include "scrhnd.pro"
  56.  
  57. /*******************************************************************
  58.             D E M O                     
  59. *******************************************************************/
  60.  
  61. PREDICATES
  62.   /* Predicates for the people demo */
  63.   gsex(STRING,Sex)
  64.   ginterests(STRING,Interests)
  65.   gperson(Dbasedom)
  66.   wperson(Dbasedom)
  67.   listdba
  68.   wr(DBASEDOM)
  69.   process(INTEGER)
  70.   nondeterm member(INTEREST,INTERESTS)  
  71.  
  72. GOAL
  73.     makewindow(77,36,0,"",0,0,24,80),
  74.     makestatus(112,""),
  75.     consult("xclub.scr"),
  76.     consult("xclub.dba"),
  77.     repeat,
  78.     changestatus(" Select an option."),
  79.     menu(10,25,71,23,
  80.         ["Save new database",
  81.          "Input new person",
  82.          "Update an entry",
  83.          "Find people with your interests",
  84.          "List database"],
  85.          "CHOICE",
  86.          4,Ch),
  87.      process(CH),CH=0,!.
  88.  
  89.  
  90. CLAUSES
  91.   member(X,[X|_]).
  92.   member(X,[_|L]):-member(X,L).
  93.  
  94.   field_action(_):-fail.
  95.   field_value(FNAME,VALUE):-value(FNAME,VALUE),!.
  96.   noinput(_):-fail.
  97.           
  98.   process(0).
  99.   process(1):-
  100.     changestatus("Type in a name for the database."),
  101.     readfilename(10,10,7,7,dba,"xclub.dba",FILE),
  102.     openwrite(textfile,FILE),
  103.     writedevice(textfile),
  104.     listdba,
  105.     closefile(textfile).
  106.   process(2):-
  107.     retract(value(_,_)),fail.
  108.   process(2):-
  109.     createwindow(off),
  110.     changestatus(" Input new person's details.   Move cursor with arrows.      F10:end"),
  111.     scrhnd(off,KEY),not(KEY=esc),
  112.     gperson(P),assert(P),fail.
  113.   process(2):-
  114.     removewindow.
  115.   process(3):-
  116.     retract(value(_,_)),fail.
  117.   process(3):-
  118.     createwindow(off),
  119.     changestatus(" To find old record, give a name and press F10."),
  120.     scrhnd(off,KEY1),not(KEY1=esc),
  121.     value(f1,N),
  122.     Name=N,
  123.     person(Name,Ad,Al,K,I),
  124.     wperson(person(Name,Ad,Al,K,I)),
  125.     changestatus("Now you can modify the data. Press F10 to finish."),
  126.     scrhnd(off,KEY2),not(KEY2=esc),
  127.     retract(person(Name,Ad,Al,K,I)),
  128.     gperson(P),
  129.     asserta(P),
  130.     removewindow,!.
  131.   process(3):-
  132.     removewindow.
  133.   process(4):-
  134.     retract(value(_,_)),fail.
  135.   process(4):-
  136.     createwindow(off),
  137.     changestatus(" Type some interest and then press F10."),
  138.     scrhnd(off,KEY1),not(KEY1=esc),
  139.     value(f5,S5), ginterests(S5,Interests),
  140.     person(Name,Ad,Al,K,I),
  141.     member(X,Interests),member(X,I),
  142.     wperson(person(Name,Ad,Al,K,I)),
  143.     changestatus(" To inspect each matching entry, press F10 repeatedly."),
  144.     scrhnd(off,KEY2),not(KEY2=esc),
  145.     fail.
  146.   process(4):-
  147.     removewindow.
  148.   process(5):-
  149.     clearwindow,listdba.
  150.  
  151.  
  152. /**********************************************************************
  153.     Write and get data to and from the "value" predicate
  154. **********************************************************************/
  155.  
  156.   wperson(_):-retract(value(_,_)),fail.
  157.   wperson(person(Name,Address,Age,Sex,Interests)):-
  158.     Name=S1,    assert(value(f1,S1)),
  159.     Address=S2,    assert(value(f2,S2)),
  160.     str_int(S3,Age),assert(value(f3,S3)), 
  161.     gsex(S4,Sex),    assert(value(f4,S4)),
  162.     ginterests(S5,Interests),assert(value(f5,S5)).
  163.  
  164.  
  165.   gperson(person(Name,Address,Age,Sex,Interests)):-
  166.     value(f1,S1), Name=S1,
  167.     value(f2,S2), Address=S2,
  168.     value(f3,S3), str_int(S3,Age),
  169.     value(f4,S4), gsex(S4,Sex),
  170.     value(f5,S5), ginterests(S5,Interests),!.
  171.  
  172. /**********************************************************************
  173.     Conversions between a string and the corresponding domain
  174. **********************************************************************/
  175.  
  176.   gsex("m",m).
  177.   gsex("f",f).
  178.   
  179.   ginterests("",[]):-!.
  180.   ginterests(S,L):-bound(S),fronttoken(S,",",S1),!,ginterests(S1,L).
  181.   ginterests(S,[H|T]):-bound(S),!,fronttoken(S,H,S1),ginterests(S1,T).
  182.   ginterests(S,[H]):-bound(H),!,H=S.
  183.   ginterests(S,[H|T]):-bound(H),
  184.         ginterests(SS,T),concat(H,",",SSS),
  185.         concat(SSS,SS,S).
  186.  
  187.  
  188. /**********************************************************************
  189.         List the database
  190. **********************************************************************/
  191.  
  192.   wr(X):-write(X),nl.
  193.  
  194.   listdba:-
  195.     person(A,B,C,D,E),
  196.     wr(person(A,B,C,D,E)),
  197.     fail.
  198.   listdba.
  199.