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