home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 2.ddi / XSHOP.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  5.1 KB  |  184 lines
  1. /*******************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.         Demo of screen handler
  7.         Completing a pro-forma invoice
  8. *******************************************************************/
  9.  
  10. code=3000
  11.  
  12. include "tdoms.pro"
  13.  
  14. DOMAINS
  15.   FNAME=SYMBOL
  16.   TYPE = int(); str(); real()
  17.   FILE = myprinter
  18.  
  19. DATABASE
  20.   /* Database declarations used in scrhnd */
  21.   insmode            /* Global insertmode */
  22.   actfield(FNAME)        /* Actual field */
  23.   screen(SYMBOL,DBASEDOM)    /* Saving different screens */
  24.   value(FNAME,STRING)        /* value of a field */
  25.   field(FNAME,TYPE,ROW,COL,LEN) /* Screen definition */
  26.   txtfield(ROW,COL,LEN,STRING)
  27.   windowsize(ROW,COL).
  28.   notopline
  29.  
  30.   /* Database declarations used in vscrhnd */
  31.   windstart(ROW,COL)
  32.   mycursord(ROW,COL)
  33.  
  34.   /* Database declarations used in lineinp */
  35.   lineinpstate(STRING,COL)
  36.   lineinpflag
  37.  
  38.   /* SPECIFIC FOR THIS APPLICATION */
  39.   payment(STRING)
  40.   delivery
  41.   warranty
  42.  
  43. CLAUSES
  44.   payment(cash).
  45.  
  46. include "tpreds.pro"
  47. include "menu.pro"
  48. include "lineinp.pro"
  49. include "status.pro"
  50. include "scrhnd.pro"
  51.  
  52. GOAL    consult("xshop.scr"),
  53.     makewindow(1,66,66,"Sales Transaction Record",0,0,24,80),
  54.     makestatus(112," Fill in the sales record and press F10 when finished."),
  55.     scrhnd(off,_).
  56.  
  57. PREDICATES
  58.   index(INTEGER,STRINGLIST,STRING)
  59.   concatlist(STRINGLIST,STRING)
  60.  
  61. CLAUSES
  62.   index(1,[H|_],H):-!.
  63.   index(N,[_|T],X):-N>1,N1=N-1,index(N1,T,X).
  64.  
  65.   concatlist([],"").
  66.   concatlist([H|T],S):-
  67.     concatlist(T,S1),concat(H,S1,S).
  68.  
  69. PREDICATES
  70.   nondeterm product(STRING,STRING,REAL)
  71.  
  72. CLAUSES
  73.   product("1111","Washing Machine",200.35).
  74.   product("2222","Dishwasher",239.67).
  75.   product("3333","Fridge and Freezer",456.78).  
  76.   product("4444","Radio",456.78).  
  77.   product("5555","Television",456.78).  
  78.  
  79. CLAUSES
  80. /*******************************************************************
  81.              Main routines
  82. *******************************************************************/
  83.  
  84.   noinput(payment).    noinput(delivery).    noinput(warranty).
  85.   noinput(date).    noinput(time).        noinput(total).
  86.   noinput(change).    noinput(make1).        noinput(make2).
  87.   noinput(make3).    noinput(price1).    noinput(price2).
  88.   noinput(price3).
  89.  
  90. /*******************************************************************
  91.             Field action
  92. *******************************************************************/
  93.  
  94. PREDICATES
  95.   make(FNAME)
  96.  
  97. CLAUSES
  98.   field_action(delivery):-retract(delivery),!.
  99.   field_action(delivery):-assert(delivery).
  100.   field_action(warranty):-retract(warranty),!.
  101.   field_action(warranty):-assert(warranty).
  102.   field_action(payment):-retract(payment(_)),fail.
  103.   field_action(payment):-
  104.     cursor(R,C),
  105.     LIST=["Cash","Check","Credit card"],
  106.     menu(R,C,23,23,LIST,"Please select method of payment",1,PayNo),
  107.     index(Payno,LIST,STR),
  108.     assert(payment(STR)). 
  109.   field_action(item1):-!,make(item1).
  110.   field_action(item2):-!,make(item2).
  111.   field_action(item3):-!,make(item3).
  112.  
  113.   make(FNAME):-retract(value(FNAME,_)),fail.
  114.   make(FNAME):-
  115.     cursor(R,C),
  116.     findall(X,product(X,_,_),CODELIST),
  117.     findall(X,product(_,X,_),LIST),
  118.     menu(R,C,23,23,LIST,"Please select the product",1,Prod),
  119.     index(Prod,CODELIST,CODE),
  120.     assert(value(FNAME,CODE)).
  121.  
  122. /*******************************************************************
  123.              Field_value
  124. *******************************************************************/
  125.  
  126. PREDICATES
  127.   price(FNAME,REAL)
  128.  
  129. CLAUSES
  130.   price(FNAME,PRICE):-
  131.     value(FNAME,CODE),product(CODE,_,PRICE),!.
  132.   price(_,0).
  133.  
  134.   field_value(time,TIME):-!,
  135.     time(H,M,S,_),
  136.     str_int(HS,H),str_int(MS,M),str_int(SS,S),
  137.     concatlist([HS,":",MS,":",SS],TIME).
  138.  
  139.   field_value(date,DATE):-!,
  140.          date(D,M,Y),
  141.          str_int(DS,D),str_int(MS,M),str_int(YS,Y),
  142.          concatlist([DS,":",MS,":",YS],DATE).
  143.  
  144.   field_value(total,TotalS):-!,
  145.         price(item1,P1),
  146.         price(item2,P2),
  147.         price(item3,P3),
  148.         Total=P1+P2+P3,
  149.         str_real(TotalS,Total).
  150.  
  151.   field_value(change,CS):-!,
  152.     value(money,MM),!,str_real(MM,M),
  153.         price(item1,P1),
  154.         price(item2,P2),
  155.         price(item3,P3),
  156.         Total=M-(P1+P2+P3),
  157.         str_real(CS,Total).
  158.  
  159.   field_value(item1,CODE):-!,value(item1,CODE),!.
  160.   field_value(item2,CODE):-!,value(item2,CODE),!.
  161.   field_value(item3,CODE):-!,value(item3,CODE),!.
  162.  
  163.   field_value(make1,DESC):-!,value(item1,Code),product(Code,Desc,_),!.
  164.   field_value(make2,DESC):-!,value(item2,Code),product(Code,Desc,_),!.
  165.   field_value(make3,DESC):-!,value(item3,Code),product(Code,Desc,_),!.
  166.  
  167.   field_value(price1,PRICEs):-!,
  168.     value(item1,Code),product(Code,_,PRICE),!,str_real(PRICEs,PRICE).
  169.   field_value(price2,PRICEs):-!,
  170.     value(item2,Code),product(Code,_,PRICE),!,str_real(PRICEs,PRICE).
  171.   field_value(price3,PRICEs):-!,
  172.     value(item3,Code),product(Code,_,PRICE),!,str_real(PRICEs,PRICE).
  173.  
  174.   field_value(payment,P):- payment(P),!.
  175.  
  176.   field_value(delivery,yes):-delivery,!.
  177.   field_value(delivery,no):-!.
  178.  
  179.   field_value(warranty,yes):-warranty,!. 
  180.   field_value(warranty,no):-!. 
  181.  
  182.   /* Catch other values from the database */
  183.   field_value(Fn,X):-value(Fn,X),!.
  184.