home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l217 / 2.ddi / PROGRAMS / TPREDS.PRO < prev    next >
Encoding:
Prolog Source  |  1990-03-26  |  5.1 KB  |  183 lines
  1.  
  2. /****************************************************************/
  3. /* This module includes some routines which are used in nearly  */
  4. /* all menu and screen tools.                    */
  5. /****************************************************************/
  6.  
  7. /****************************************************************/
  8. /*        repeat                        */
  9. /****************************************************************/
  10.  
  11. PREDICATES
  12.   nondeterm repeat
  13.  
  14. CLAUSES
  15.   repeat.
  16.   repeat:-repeat.
  17.  
  18.  
  19. /****************************************************************/
  20. /*        miscellaneous                    */
  21. /****************************************************************/
  22.  
  23. PREDICATES
  24.   maxlen(STRINGLIST,COL,COL)        /* The length of the longest string */
  25.   listlen(STRINGLIST,ROW)        /* The length of a list            */
  26.   writelist(ROW,COL,STRINGLIST)        /* used in the menu predicates        */
  27.   reverseattr(ATTR,ATTR)        /* Returns the reversed attribute   */
  28.   min(ROW,ROW,ROW) min(COL,COL,COL) min(LEN,LEN,LEN) min(INTEGER,INTEGER,INTEGER)
  29.   max(ROW,ROW,ROW) max(COL,COL,COL) max(LEN,LEN,LEN) max(INTEGER,INTEGER,INTEGER)
  30.  
  31. CLAUSES
  32.   maxlen([H|T],MAX,MAX1) :-
  33.     str_len(H,LENGTH),
  34.     LENGTH>MAX,!,
  35.     maxlen(T,LENGTH,MAX1).
  36.   maxlen([_|T],MAX,MAX1) :- maxlen(T,MAX,MAX1).
  37.   maxlen([],LENGTH,LENGTH).
  38.  
  39.   listlen([],0).
  40.   listlen([_|T],N):-
  41.     listlen(T,X),
  42.     N=X+1.
  43.  
  44.   writelist(_,_,[]).
  45.   writelist(LI,ANTKOL,[H|T]):-
  46.     field_str(LI,0,ANTKOL,H),
  47.     LI1=LI+1,
  48.     writelist(LI1,ANTKOL,T).
  49.  
  50.   min(X,Y,X):-X<=Y,!.
  51.   min(_,X,X).
  52.  
  53.   max(X,Y,X):-X>=Y,!.
  54.   max(_,X,X).
  55.  
  56.   reverseattr(A1,A2):-
  57.     bitand(A1,$07,H11),
  58.     bitleft(H11,4,H12),
  59.     bitand(A1,$70,H21),
  60.     bitright(H21,4,H22),
  61.     bitand(A1,$08,H31),
  62.     A2=H12+H22+H31.
  63.  
  64.  
  65. /****************************************************************/
  66. /*    Find letter selection in a list of strings        */
  67. /*      Look initially for first uppercase letter.        */
  68. /*      Then try with first letter of each string.        */
  69. /****************************************************************/
  70.  
  71. PREDICATES
  72.   upc(CHAR,CHAR)  lowc(CHAR,CHAR)
  73.   try_upper(CHAR,STRING)
  74.   tryfirstupper(CHAR,STRINGLIST,ROW,ROW)
  75.   tryfirstletter(CHAR,STRINGLIST,ROW,ROW)
  76.   tryletter(CHAR,STRINGLIST,ROW)
  77.  
  78. CLAUSES
  79.   upc(CHAR,CH):-
  80.     CHAR>='a',CHAR<='z',!,
  81.     char_int(CHAR,CI), CI1=CI-32, char_int(CH,CI1).
  82.   upc(CH,CH).
  83.  
  84.   lowc(CHAR,CH):-
  85.     CHAR>='A',CHAR<='Z',!,
  86.     char_int(CHAR,CI), CI1=CI+32, char_int(CH,CI1).
  87.   lowc(CH,CH).
  88.  
  89.   try_upper(CHAR,STRING):-
  90.     frontchar(STRING,CH,_),
  91.     CH>='A',CH<='Z',!,
  92.     CH=CHAR.
  93.   try_upper(CHAR,STRING):-
  94.     frontchar(STRING,_,REST),
  95.     try_upper(CHAR,REST).
  96.  
  97.   tryfirstupper(CHAR,[W|_],N,N) :-
  98.     try_upper(CHAR,W),!.
  99.   tryfirstupper(CHAR,[_|T],N1,N2) :-
  100.     N3 = N1+1,
  101.     tryfirstupper(CHAR,T,N3,N2).
  102.  
  103.   tryfirstletter(CHAR,[W|_],N,N) :-
  104.     frontchar(W,CHAR,_),!.
  105.   tryfirstletter(CHAR,[_|T],N1,N2) :-
  106.     N3 = N1+1,
  107.     tryfirstletter(CHAR,T,N3,N2).
  108.  
  109.   tryletter(CHAR,LIST,SELECTION):-
  110.     upc(CHAR,CH),tryfirstupper(CH,LIST,0,SELECTION),!.
  111.   tryletter(CHAR,LIST,SELECTION):-
  112.     lowc(CHAR,CH),tryfirstletter(CH,LIST,0,SELECTION).
  113.  
  114.  
  115.  
  116. /*****************************************************************/
  117. /* adjustwindow takes a windowstart and a windowsize and adjusts */
  118. /* the windowstart so the window can be placed on the screen.     */
  119. /* adjframe looks at the frameattribute: if it is different from */
  120. /* zero, two is added to the size of the window             */
  121. /****************************************************************/
  122.  
  123. PREDICATES
  124.   adjustwindow(ROW,COL,ROW,COL,ROW,COL)
  125.   adjframe(ATTR,ROW,COL,ROW,COL)
  126.  
  127. CLAUSES
  128.   adjustwindow(LI,KOL,DLI,DKOL,ALI,AKOL):-
  129.         LI<25-DLI,KOL<80-DKOL,!,ALI=LI,AKOL=KOL.
  130.   adjustwindow(LI,_,DLI,DKOL,ALI,AKOL):-
  131.         LI<25-DLI,!,ALI=LI,AKOL=80-DKOL.
  132.   adjustwindow(_,KOL,DLI,DKOL,ALI,AKOL):-
  133.         KOL<80-DKOL,!,ALI=25-DLI, AKOL=KOL.
  134.   adjustwindow(_,_,DLI,DKOL,ALI,AKOL):-
  135.         ALI=25-DLI, AKOL=80-DKOL.
  136.  
  137.   adjframe(0,R,C,R,C):-!.
  138.   adjframe(_,R1,C1,R2,C2):-R2=R1+2, C2=C1+2.
  139.  
  140.  
  141. /****************************************************************/
  142. /*             Readkey                    */
  143. /* Returns a symbolic key from the KEY domain                */
  144. /****************************************************************/
  145.  
  146. PREDICATES
  147.   readkey(KEY)
  148.   readkey1(KEY,CHAR,INTEGER)
  149.   readkey2(KEY,INTEGER)
  150.  
  151. CLAUSES
  152.   readkey(KEY):-readchar(T),char_int(T,VAL),readkey1(KEY,T,VAL).
  153.  
  154.   readkey1(KEY,_,0):-!,readchar(T),char_int(T,VAL),readkey2(KEY,VAL).
  155.   readkey1(cr,_,13):-!.
  156.   readkey1(esc,_,27):-!.
  157.   readkey1(break,_,3):-!.
  158.   readkey1(tab,_,9):-!.
  159.   readkey1(bdel,_,8):-!.
  160.   readkey1(ctrlbdel,_,127):-!.
  161.   readkey1(char(T),T,_) .
  162.   
  163.   readkey2(btab,15):-!.
  164.   readkey2(del,83):-!.
  165.   readkey2(ins,82):-!.
  166.   readkey2(up,72):-!.
  167.   readkey2(down,80):-!.
  168.   readkey2(left,75):-!.
  169.   readkey2(right,77):-!.
  170.   readkey2(pgup,73):-!.
  171.   readkey2(pgdn,81):-!.
  172.   readkey2(end,79):-!.
  173.   readkey2(home,71):-!.
  174.   readkey2(ctrlleft,115):-!.
  175.   readkey2(ctrlright,116):-!.
  176.   readkey2(ctrlend,117):-!.
  177.   readkey2(ctrlpgdn,118):-!.
  178.   readkey2(ctrlhome,119):-!.
  179.   readkey2(ctrlpgup,132):-!.
  180.   readkey2(fkey(N),VAL):- VAL>58, VAL<70, N=VAL-58, !.
  181.   readkey2(fkey(N),VAL):- VAL>=84, VAL<104, N=11+VAL-84, !.
  182.   readkey2(otherspec,_).
  183.