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