home *** CD-ROM | disk | FTP | other *** search
/ Power Programming / powerprogramming1994.iso / progtool / borland / jnfb88.arc / PDOWN.ARC / SPULLDWN.PRO next >
Text File  |  1987-10-09  |  11KB  |  386 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.           modified by KJ Weiskamp to support:
  6.           
  7.            1) Automatic status bar update
  8.            2) Continuos scroll inside pull-down menus
  9.  
  10.         PULL DOWN MENU
  11.  
  12.   
  13.   The parameters are:
  14.     spulldown(ATTRIBUTE,MENULIST,STATLIST,CHOICE,SUBCHOICE)
  15.  
  16.   where 
  17.     ATTRIBUTE is used in all the windows
  18.     MENULIST is the text for the menus
  19.     STATLIST is the text for the status strings
  20.     CHOICE is the selection from the horizontal menu
  21.     SUBCHOICE is the selection from the vertical menu
  22.            (or zero if there is no vertical menu for
  23.             the CHOICE horizontal item)
  24. ****************************************************************/
  25.  
  26. /* ----- Include this database in your program ----
  27. DATABASE
  28.     pdwstate(ROW,COL,SYMBOL,ROW,COL)
  29.  
  30. include tooldom and toolpred
  31.  
  32. And provide the clauses for the pdwaction predicate
  33.  
  34. */
  35.  
  36.  
  37. DOMAINS
  38.  
  39.  /* data structure for pull-down menu strings */ 
  40.  MENUELEM=  curtain(COL,STRING,STRINGLIST)
  41.  MENULIST=  MENUELEM*
  42.  
  43.  /* data structure for status bar strings */
  44.  STATITEM= stat(STRING,STRINGLIST)
  45.  STATLIST= STATITEM*
  46.  
  47.  STOP     =  stop(); cont()
  48.  
  49. PREDICATES
  50.  
  51.   /* the modified pulldown predicate */
  52.   spulldown(ATTR,MENULIST,STATLIST,INTEGER,INTEGER)
  53.   pdwaction(INTEGER,INTEGER)
  54.  
  55.   pdwkeyact(KEY,ROW,COL,SYMBOL,ROW,COL,COL,ATTR,MENULIST,
  56.             STATLIST,STOP)
  57.   pdwmovevert(COL,COL,ATTR,MENULIST)
  58.   pdwindex(COL,MENULIST,MENUELEM)
  59.   pdwindex(ROW,STRINGLIST,STRING)
  60.  
  61.   /* add this predicate to support status bar strings */
  62.   pdwindex(COL,STATLIST,STATITEM)
  63.  
  64.   makepdwwindow1(ROW,COL,ROW,COL,ATTR,STRINGLIST,ROW)
  65.   makepdwwindow(COL,ATTR,MENULIST,ROW,COL,ROW)
  66.   writelistp(ROW,COL,ATTR,STRINGLIST)
  67.   line_ver(ROW,ROW,COL)
  68.   line_hor(COL,COL,ROW)
  69.   lcorn(COL,CHAR)
  70.   rcorn(COL,CHAR)
  71.   pdwlistlen(MENULIST,COL)
  72.   pdwlistlen(STATLIST,COL)     /* supports status strings */
  73.   pdwlistlen(STRINGLIST,COL)   /* suuports general string lists */
  74.   writepdwlist(ATTR,MENULIST)
  75.   changepdwstate(DBASEDOM)
  76.   check_removewindow(ROW)
  77.   is_up(SYMBOL,ROW)
  78.   nextcol(COL,COL,COL,COL)
  79.   intense(ATTR,ATTR)
  80.   intensefirstupper(ROW,COL,ATTR,STRING)
  81.   intenseletter(ROW,COL,ATTR,STRING)
  82.   pdwlist_strlist(MENULIST,STRINGLIST)
  83.   setstatus(COL,ROW,STATLIST,SYMBOL)     /* update status  message*/
  84.   checkargs(MENULIST, STATLIST)          /* test arguments */
  85.  
  86. CLAUSES
  87.  
  88. /* draw pulldown window */
  89.   line_ver(R1,R2,C):-
  90.     R2>R1,!, R=R1+1,
  91.     scr_char(R1,C,'│'),
  92.     line_ver(R,R2,C).
  93.   line_ver(_,_,_).
  94.  
  95.   line_hor(C1,C2,R):-
  96.     C2>C1,!, C=C1+1,
  97.     scr_char(R,C1,'─'),
  98.     line_hor(C,C2,R).
  99.   line_hor(_,_,_).
  100.  
  101. /* Make the pulldown window */
  102.   makepdwwindow(NO,ATTR,MENULIST,LISTLEN,MAXLEN,FIRSTROW):-
  103.     pdwindex(NO,MENULIST,curtain(CCOL,_,LIST)),COL=CCOL,
  104.     ROW=2,
  105.     listlen(LIST,LISTLEN1),LISTLEN=LISTLEN1,
  106.     maxlen(LIST,0,MAXLEN),
  107.     makepdwwindow1(ROW,COL,LISTLEN,MAXLEN,ATTR,LIST,FIRSTROW).
  108.  
  109. /*  makepdwwindow1(_,_,_,_,_,_,0):-keypressed,!. */
  110.   makepdwwindow1(_,_,0,_,_,_,0):-!.
  111.   makepdwwindow1(ROW,COL,LISTLEN,MAXLEN,ATTR,LIST,1):-
  112.     NOOFROWS=LISTLEN+2, NOOFCOLS=MAXLEN+2,
  113.     adjustwindow(ROW,COL,NOOFROWS,NOOFCOLS,AROW,ACOL),
  114.     makewindow(81,ATTR,0,"",AROW,ACOL,NOOFROWS,NOOFCOLS),
  115.     writelistp(1,MAXLEN,ATTR,LIST),
  116.     cursor(1,1),reverseattr(ATTR,REV), field_attr(1,1,MAXLEN,REV),
  117.     ENDROW=NOOFROWS-1,
  118.     ENDCOL=NOOFCOLS-1,
  119.     line_hor(1,ENDCOL,0),
  120.     line_hor(1,ENDCOL,ENDROW),
  121.     line_ver(1,ENDROW,0),
  122.     line_ver(1,ENDROW,ENDCOL),
  123.     scr_char(ENDROW,0,'└'),
  124.     scr_char(ENDROW,ENDCOL,'┘'),
  125.     lcorn(COL,LCORN), scr_char(0,0,LCORN),
  126.     RCOL=ACOL+ENDCOL,
  127.     rcorn(RCOL,RCORN), scr_char(0,ENDCOL,RCORN).
  128.  
  129. /* draw pulldown window corners */
  130.   lcorn(0,'├') :- !.
  131.   lcorn(_,'┬').
  132.  
  133.   rcorn(79,'┤') :- !.
  134.   rcorn(_,'┬').
  135.  
  136.   check_removewindow(0):-!.
  137.   check_removewindow(_):-removewindow.
  138.  
  139.   is_up(up,_):-!.
  140.   is_up(_,0).
  141.  
  142.   intense(ATTR,ATTR1):-
  143.     bitxor(ATTR,$08,ATTR1).
  144.  
  145.   intensefirstupper(ROW,COL,ATTR,WORD):-
  146.     frontchar(WORD,CH,_),
  147.     CH>='A', CH<='Z',!,scr_attr(ROW,COL,ATTR).
  148.   intensefirstupper(ROW,COL,ATTR,WORD):-
  149.     frontchar(WORD,_,REST),COL1=COL+1,
  150.     intensefirstupper(ROW,COL1,ATTR,REST).
  151.  
  152.   intenseletter(ROW,COL,ATTR,WORD):-
  153.     intense(ATTR,INTENS),
  154.     intensefirstupper(ROW,COL,INTENS,WORD),!.
  155.   intenseletter(ROW,COL,ATTR,_):-
  156.     intense(ATTR,INTENS),
  157.     scr_attr(ROW,COL,INTENS).
  158.  
  159.   pdwlist_strlist([],[]).
  160.   pdwlist_strlist([curtain(_,H,_)|RESTPDW],[H|RESTSTR]):-
  161.     pdwlist_strlist(RESTPDW,RESTSTR).
  162.  
  163.   pdwmovevert(COL1,COL2,ATTR,LIST):-
  164.     pdwindex(COL1,LIST,curtain(POS1,WORD1,_)),str_len(WORD1,LEN1),
  165.     pdwindex(COL2,LIST,curtain(POS2,WORD2,_)),str_len(WORD2,LEN2),
  166.     field_attr(0,POS1,LEN1,ATTR),
  167.     intenseletter(0,POS1,ATTR,WORD1),
  168.     reverseattr(ATTR,REV),
  169.     field_attr(0,POS2,LEN2,REV),
  170.     intenseletter(0,POS2,REV,WORD2),
  171.     cursor(0,POS2).
  172.   
  173.   setstatus(COL1,_, SLIST,up):-
  174.       pdwindex(COL1, SLIST, stat(STR,_)),
  175.       changestatus(STR).
  176.       
  177.   setstatus(COL1,_, SLIST,down):-
  178.       pdwindex(COL1, SLIST, stat(_,LIST)),
  179.       listlen(LIST,LISTLEN),
  180.       LISTLEN=0,
  181.       pdwindex(COL1,SLIST, stat(STR,_)),
  182.       changestatus(STR),!.
  183.      
  184.   setstatus(COL1,ROW, SLIST,down):-
  185.       pdwindex(COL1, SLIST, stat(_,LIST)),
  186.       pdwindex(ROW,LIST,STR),
  187.       changestatus(STR). 
  188.  
  189.   checkargs(LIST,SLIST):-
  190.      pdwlistlen(LIST,SZ1),
  191.      pdwlistlen(SLIST,SZ2),
  192.      SZ1=SZ2,!.
  193.      
  194.   checkargs(_,_):-
  195.      makewindow(80,7,7,"Error Window",5,15,4,45),
  196.      window_str("Menu list does not match with Status list"),
  197.      readkey(_),
  198.      removewindow,
  199.      exit.   
  200.   
  201.   pdwlistlen([],0).
  202.   pdwlistlen([_|T],N):-
  203.     pdwlistlen(T,X),
  204.     N=X+1.
  205.  
  206.   writepdwlist(_,[]).
  207.   writepdwlist(ATTR,[curtain(POS,WORD,_)|T]):-
  208.     str_len(WORD,LEN),
  209.     field_str(0,POS,LEN,WORD),
  210.     intenseletter(0,POS,ATTR,WORD),
  211.     writepdwlist(ATTR,T).
  212.  
  213.   writelistp(_,_,_,[]).
  214.   writelistp(ROW,LEN,ATTR,[H|T]):-
  215.     field_str(ROW,1,LEN,H),
  216.     intenseletter(ROW,1,ATTR,H),
  217.     ROW1=ROW+1,
  218.     writelistp(ROW1,LEN,ATTR,T).
  219.  
  220.   pdwindex(0,[H|_],H):-!.
  221.   pdwindex(N,[_|T],X):-N1=N-1,pdwindex(N1,T,X).
  222.  
  223.   changepdwstate(_):-retract(pdwstate(_,_,_,_,_)),fail.
  224.   changepdwstate(T):-assert(T).
  225.  
  226.   nextcol(0,-1,COL1,MAX):-COL1=MAX-1,!.
  227.   nextcol(COL,1,0,MAX):-COL=MAX-1,!.
  228.   nextcol(COL,DD,COL1,_):-COL1=COL+DD.
  229.  
  230.   spulldown(ATTR,LIST,SLIST,CH1,CH2):-
  231.         checkargs(LIST,SLIST),
  232.     makewindow(81,ATTR,ATTR,"",0,0,3,80),
  233.     pdwlistlen(LIST,MAXCOL),
  234.     writepdwlist(ATTR,LIST),
  235.     pdwmovevert(0,0,ATTR,LIST),
  236.     changepdwstate(pdwstate(0,0,up,0,0)),
  237.     setstatus(0,0,SLIST,up),
  238.     repeat,
  239.     pdwstate(ROW,COL,DOWN,MAXROW,LEN),
  240.     readkey(KEY),
  241.     pdwkeyact(KEY,ROW,COL,DOWN,MAXROW,MAXCOL,LEN,ATTR,LIST,
  242.            SLIST,CONTINUE),
  243.     CONTINUE=stop,removewindow,
  244.     pdwstate(ROW1,COL1,_,_,_),!,
  245.     CH1=COL1+1,
  246.     CH2=ROW1.
  247.  
  248. /*  Pulldown window action corresponding to input key and Pulldown
  249.     window state */
  250.   pdwkeyact(right,ROW,COL,up,MAXROW,MAXCOL,LEN,ATTR,LIST,SLIST,cont):-
  251.     nextcol(COL,1,COL1,MAXCOL),
  252.     pdwmovevert(COL,COL1,ATTR,LIST),
  253.     setstatus(COL1,ROW,SLIST,up), 
  254.     changepdwstate(pdwstate(ROW,COL1,up,MAXROW,LEN)).
  255.  
  256.   pdwkeyact(right,ROW,COL,down,_,MAXCOL,_,ATTR,LIST,SLIST,cont):-
  257.     nextcol(COL,1,COL1,MAXCOL),
  258.     check_removewindow(ROW),
  259.     pdwmovevert(COL,COL1,ATTR,LIST),
  260.     makepdwwindow(COL1,ATTR,LIST,MAXROW1,LEN1,FIRSTROW),
  261.     setstatus(COL1,0,SLIST,down),
  262.     changepdwstate(pdwstate(FIRSTROW,COL1,down,MAXROW1,LEN1)).
  263.  
  264.   pdwkeyact(left,ROW,COL,up,MAXROW,MAXCOL,LEN,ATTR,LIST,SLIST,cont):-
  265.     nextcol(COL,-1,COL1,MAXCOL),
  266.     pdwmovevert(COL,COL1,ATTR,LIST),
  267.     setstatus(COL1,ROW,SLIST,up),
  268.     changepdwstate(pdwstate(ROW,COL1,up,MAXROW,LEN)).
  269.  
  270.   pdwkeyact(left,ROW,COL,down,_,MAXCOL,_,ATTR,LIST,SLIST,cont):-
  271.     nextcol(COL,-1,COL1,MAXCOL),
  272.     check_removewindow(ROW),
  273.     pdwmovevert(COL,COL1,ATTR,LIST),
  274.     makepdwwindow(COL1,ATTR,LIST,MAXROW1,LEN1,FIRSTROW),
  275.     setstatus(COL1,0,SLIST,down), 
  276.     changepdwstate(pdwstate(FIRSTROW,COL1,down,MAXROW1,LEN1)).
  277.  
  278.   pdwkeyact(up,ROW,COL,down,MAXROW,_,LEN,ATTR,PDWLIST,SLIST,cont):-
  279.     ROW>1,!,
  280.     ROW1=ROW-1,
  281.     field_attr(ROW,1,LEN,ATTR),
  282.     pdwindex(COL,PDWLIST,curtain(_,_,LIST)),
  283.     pdwindex(ROW1,LIST,WORD),
  284.     intenseletter(ROW,1,ATTR,WORD),
  285.     reverseattr(ATTR,REV),field_attr(ROW1,1,LEN,REV),
  286.     cursor(ROW1,1),
  287.     R=ROW1-1,
  288.     setstatus(COL,R,SLIST,down), 
  289.     changepdwstate(pdwstate(ROW1,COL,down,MAXROW,LEN)).
  290.     
  291.   pdwkeyact(up,ROW,COL,down,MAXROW,_,LEN,ATTR,PDWLIST,SLIST,cont):-
  292.     ROW=1,!,
  293.     ROW1=ROW-1,
  294.     field_attr(ROW,1,LEN,ATTR),
  295.     pdwindex(COL,PDWLIST,curtain(_,_,LIST)),
  296.     pdwindex(ROW1,LIST,WORD),
  297.     intenseletter(ROW,1,ATTR,WORD),
  298.     pdwlistlen(LIST,LEN1),
  299.     reverseattr(ATTR,REV),field_attr(LEN1,1,LEN,REV),
  300.     cursor(LEN1,1),
  301.     R=LEN1-1,
  302.     ROW2=LEN1,
  303.     setstatus(COL,R,SLIST,down), 
  304.     changepdwstate(pdwstate(ROW2,COL,down,MAXROW,LEN)).    
  305.  
  306.   pdwkeyact(down,ROW,COL,down,MAXROW,_,LEN,ATTR,PDWLIST,SLIST,cont):-
  307.     ROW<MAXROW,!,
  308.     ROW1=ROW+1,
  309.     field_attr(ROW,1,LEN,ATTR),
  310.     pdwindex(COL,PDWLIST,curtain(_,_,LIST)),
  311.     INDX=ROW-1,pdwindex(INDX,LIST,WORD),
  312.     intenseletter(ROW,1,ATTR,WORD),
  313.     reverseattr(ATTR,REV),field_attr(ROW1,1,LEN,REV),
  314.     cursor(ROW1,1),
  315.     setstatus(COL,ROW,SLIST,down), 
  316.     changepdwstate(pdwstate(ROW1,COL,down,MAXROW,LEN)).
  317.     
  318.   pdwkeyact(down,ROW,COL,down,MAXROW,_,LEN,ATTR,PDWLIST,SLIST,cont):-
  319.     ROW=MAXROW,!,
  320.     ROW1=1,
  321.     field_attr(ROW,1,LEN,ATTR),
  322.     pdwindex(COL,PDWLIST,curtain(_,_,LIST)),
  323.     INDX=ROW-1,pdwindex(INDX,LIST,WORD),
  324.     intenseletter(ROW,1,ATTR,WORD),
  325.     reverseattr(ATTR,REV),field_attr(ROW1,1,LEN,REV),
  326.     cursor(ROW1,1),
  327.     setstatus(COL,0,SLIST,down), 
  328.     changepdwstate(pdwstate(ROW1,COL,down,MAXROW,LEN)).    
  329.  
  330.   pdwkeyact(down,_,COL,up,_,_,_,ATTR,LIST,SLIST,cont):-
  331.     makepdwwindow(COL,ATTR,LIST,MAXROW1,LEN1,FIRSTROW),
  332.     setstatus(COL,0,SLIST,down),
  333.     changepdwstate(pdwstate(FIRSTROW,COL,down,MAXROW1,LEN1)).
  334.  
  335.   pdwkeyact(cr,_,COL,up,_,_,_,ATTR,LIST,SLIST,stop):-
  336.     makepdwwindow(COL,ATTR,LIST,MAXROW1,LEN1,FIRSTROW),
  337.     setstatus(COL,0,SLIST,down),
  338.     changepdwstate(pdwstate(FIRSTROW,COL,down,MAXROW1,LEN1)),
  339.     FIRSTROW=0,
  340.     CH=COL+1, SUBCH=0,
  341.     not(pdwaction(CH,SUBCH)).
  342.  
  343.   pdwkeyact(cr,ROW,COL,down,_,_,_,_,_,_,stop):-
  344.     CH=COL+1, SUBCH=ROW,
  345.     not(pdwaction(CH,SUBCH)),
  346.     check_removewindow(ROW).
  347.  
  348.   pdwkeyact(char(CHAR),ROW,COL,UP,_,_,_,ATTR,PDWLIST,SLIST,stop):-
  349.     is_up(UP,ROW),!,
  350.     pdwlist_strlist(PDWLIST,STRLIST),
  351.     tryletter(CHAR,STRLIST,SEL),NEWCOL=SEL,
  352.     pdwmovevert(COL,NEWCOL,ATTR,PDWLIST),
  353.     makepdwwindow(NEWCOL,ATTR,PDWLIST,MAXROW1,LEN1,FIRSTROW),
  354.     setstatus(NEWCOL,ROW,SLIST,up),
  355.     setstatus(NEWCOL,0,SLIST,down),
  356.     changepdwstate(pdwstate(FIRSTROW,NEWCOL,down,MAXROW1,LEN1)),
  357.     FIRSTROW=0,
  358.     CH=NEWCOL+1, SUBCH=0,
  359.     not(pdwaction(CH,SUBCH)).
  360.  
  361.   pdwkeyact(char(CHAR),ROW,COL,down,MAXROW,_,LEN,ATTR,PDWLIST,
  362.             SLIST,stop):-
  363.     ROW><0,
  364.     pdwindex(COL,PDWLIST,curtain(_,_,LIST)),
  365.     tryletter(CHAR,LIST,SEL),ROW1=SEL+1,
  366.     field_attr(ROW,1,LEN,ATTR),
  367.     R=ROW-1,
  368.     pdwindex(R,LIST,OLDWORD),
  369.     intenseletter(ROW,1,ATTR,OLDWORD),
  370.     reverseattr(ATTR,REV),field_attr(ROW1,1,LEN,REV),
  371.     cursor(ROW1,1),
  372.     CH=COL+1, SUBCH=ROW1,
  373.     R2=ROW1-1,
  374.     setstatus(COL,R2,SLIST,down),
  375.     changepdwstate(pdwstate(ROW1,COL,down,MAXROW,LEN)),
  376.     not(pdwaction(CH,SUBCH)),
  377.     removewindow.
  378.  
  379.   pdwkeyact(esc,ROW,COL,down,_,_,_,_,_,SLIST,cont):-
  380.     check_removewindow(ROW),
  381.     setstatus(COL,ROW,SLIST,up),
  382.     changepdwstate(pdwstate(0,COL,up,0,0)).
  383.  
  384. /* pdwkeyact(fkey(1),_,_,_,_,_,_,_,_,cont):- help.
  385.    If a help system is used*/
  386.