home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l217 / 2.ddi / PROGRAMS / SCRHND.PRO < prev    next >
Encoding:
Text File  |  1990-03-26  |  11.7 KB  |  503 lines
  1. /****************************************************************
  2.             SCRHND
  3.             ======
  4.  
  5.  This module implements a screen handler called by:
  6.                
  7.                  scrhnd(TOPLINE,ENDKEY)
  8.  
  9.     TOPLINE = on/off  - determines if there should be a top line
  10.     ENDKEY            - Bound to Esc or F10 on return
  11. ****************************************************************/
  12.  
  13. /* GLOBAL DECLARATION
  14.   field(FNAME,TYPE,ROW,COL,LEN)
  15.   txtfield(ROW,COL,LEN,STRING)
  16.   windowsize(ROW,COL).
  17. */
  18.  
  19. DATABASE - scrhnd  /* LOCAL DATABASE PREDICATES USED BY SCRHND (and VSCRHND) */
  20.   notopline            /* Global flag for the precense of a topline */
  21.   actfield(FNAME)        /* Actual field */
  22.   insmode            /* insert or overwrite mode */
  23.  
  24. PREDICATES
  25.   /* SCREEN DRIVER */
  26. ifndef globdecl
  27.   scrhnd(SYMBOL,KEY)
  28.   field_action(FNAME)
  29.   field_value(FNAME,STRING)
  30.   noinput(FNAME)
  31.   createwindow(SYMBOL)
  32.   writescr
  33. enddef
  34.  
  35.   endkey(KEY)
  36.   scr(KEY)
  37.   showcursor
  38.   mkheader
  39.   showoverwrite
  40.  
  41.   ass_val(FNAME,STRING)
  42.   valid(FNAME,TYPE,STRING)
  43.   typeerror
  44.   chng_actfield(FNAME)
  45.   types(INTEGER,TYPE,STRING)    /* Definition of the known types */
  46.  
  47.  
  48.  /***********************************************************************/
  49.  /*        Create the window                    */
  50.  /* This can be used to create the window automatically from the    */
  51.  /* windowsize predicate.                        */
  52.  /***********************************************************************/
  53.  
  54. CLAUSES
  55.   createwindow(off):-
  56.     windowsize(R,C),!,
  57.     R1=R+3, C1=C+3,
  58.     makewindow(81,23,66,"",0,0,R1,C1).
  59.   createwindow(on):-
  60.     windowsize(R,C),!,
  61.     R1=R+3, C1=C+3,
  62.     makewindow(85,112,0,"",0,0,1,C1),
  63.     makewindow(81,23,66,"",1,0,R1,C1).
  64.  
  65.  /***********************************************************************/
  66.  /*        Intermediate predicates                    */
  67.  /***********************************************************************/
  68.  
  69. PREDICATES
  70.   trunc_(LEN,STRING,STRING)
  71.   oldstr(FNAME,STRING)
  72.   settopline(SYMBOL)
  73.  
  74. CLAUSES
  75.   endkey(fkey(10)):-!.
  76.   endkey(esc).
  77.  
  78. trunc_(LEN,STR1,STR2):-str_len(STR1,L1),L1>LEN,!,frontstr(LEN,STR1,STR2,_).
  79.   trunc_(_,STR,STR).
  80.  
  81.   settopline(_):-retract(notopline),fail.
  82.   settopline(off):-!,assert(notopline).
  83.   settopline(_).
  84.  
  85.   oldstr(FNAME,S):-    value(FNAME,S),!.
  86.   oldstr(_,"").
  87.  
  88.   ass_val(FNAME,_):- retract(value(FNAME,_)),fail.
  89.   ass_val(FNAME,VAL):-VAL><"",assert(value(FNAME,VAL)),fail.
  90.   ass_val(_,_).
  91.  
  92.   chng_actfield(_):-typeerror,!,fail.
  93.   chng_actfield(_):-
  94.     retract(actfield(_)),fail.
  95.   chng_actfield(FNAME):-
  96.     assert(actfield(FNAME)).
  97.  
  98.   typeerror:-
  99.     actfield(FNAME),
  100.     field(FNAME,TYPE,_,_,_),
  101.     value(FNAME,VAL),
  102.     not(valid(FNAME,TYPE,VAL)),
  103.     beep,!.
  104.  
  105.   valid(_,str,_).
  106.   valid(_,int,STR):-str_int(STR,_).
  107.   valid(_,real,STR):-str_real(STR,_).
  108.  
  109.   /* The known types */
  110.   types(1,int,"integer").
  111.   types(2,real,"real").
  112.   types(3,str,"string").
  113.  
  114.  
  115.  /***********************************************************************/
  116.  /*        SCREEN DRIVER                           */
  117.  /* Screen definition/input is repeated until F10 is pressed        */
  118.  /***********************************************************************/
  119.  
  120.   scrhnd(STATUSON,KEY):-
  121.     settopline(STATUSON),
  122.     mkheader,
  123.     writescr,
  124.     field(FNAME,_,R,C,_),!,cursor(R,C),
  125.     chng_actfield(FNAME),
  126.     showcursor,
  127.     repeat,
  128.     writescr,
  129.     keypressed,/*Continuation until keypress means that time dependent
  130.              user functions can be updated*/
  131.     readkey(KEY),
  132.     scr(KEY),
  133.     showcursor,
  134.     endkey(KEY),!.
  135.  
  136.  
  137.  /*******************************************************************/
  138.  /*             Find the next field                */
  139.  /*******************************************************************/
  140.  
  141. PREDICATES
  142.   /* The predicates should be called with:
  143.     ACTROW, ACTCOL, MAXROW, MAXCOL, NEWROW, NEWCOL   */
  144.   best_right(ROW,COL,ROW,COL,ROW,COL)
  145.   best_left(ROW,COL,ROW,COL,ROW,COL)
  146.   best_down(ROW,COL,ROW,COL,LEN,ROW,COL)
  147.   best_up(ROW,COL,ROW,COL,LEN,ROW,COL)
  148.   better_right(ROW,COL,ROW,COL,ROW,COL)
  149.   better_left(ROW,COL,ROW,COL,ROW,COL)
  150.   better_field(ROW,COL,ROW,COL,LEN,ROW,COL,LEN)
  151.   calcdist(ROW,COL,ROW,COL,LEN,LEN)
  152.   move_left
  153.   move_right
  154.   nextfield(ROW,COL)
  155.   gtfield(ROW,ROW,COL,COL)
  156.   prevfield(ROW,COL)
  157.   chk_found(FNAME,ROW,COL,ROW,COL)
  158.   setlastfield
  159.  
  160. CLAUSES
  161.   best_right(R0,C0,R1,C1,ROW,COL):-
  162.     field(_,_,R2,C2,_), C2>C0,
  163.     better_right(R0,C0,R1,C1,R2,C2),!,
  164.     best_right(R0,C0,R2,C2,ROW,COL).
  165.   best_right(_,_,R,C,R,C).
  166.  
  167.   better_right(R0,_,R1,_,R2,_):-abs(R2-R0)<abs(R1-R0),!.
  168.   better_right(R0,_,R1,C1,R2,C2):-abs(R2-R0)=abs(R1-R0),C2<C1.
  169.  
  170.   best_left(R0,C0,R1,C1,ROW,COL):-
  171.     field(_,_,R2,C2,_), C2<C0,
  172.     better_left(R0,C0,R1,C1,R2,C2),!,
  173.     best_left(R0,C0,R2,C2,ROW,COL).
  174.   best_left(_,_,R,C,R,C).
  175.  
  176.   better_left(R0,_,R1,_,R2,_):-abs(R2-R0)<abs(R1-R0),!.
  177.   better_left(R0,_,R1,C1,R2,C2):-abs(R2-R0)=abs(R1-R0),C2>C1.
  178.  
  179.   best_down(R0,C0,R1,C1,L1,ROW,COL):-
  180.     field(_,_,R2,C2,L2), R2>R0,
  181.     better_field(R0,C0,R1,C1,L1,R2,C2,L2),!,
  182.     best_down(R0,C0,R2,C2,L2,ROW,COL).
  183.   best_down(_,_,R,C,_,R,C).
  184.  
  185.   best_up(R0,C0,R1,C1,L1,ROW,COL):-
  186.     field(_,_,R2,C2,L2), R2<R0,
  187.     better_field(R0,C0,R1,C1,L1,R2,C2,L2),!,
  188.     best_up(R0,C0,R2,C2,L2,ROW,COL).
  189.   best_up(_,_,R,C,_,R,C).
  190.  
  191.   better_field(R0,C0,R1,C1,L1,R2,C2,L2):-
  192.     calcdist(R0,C0,R1,C1,L1,DIST1),
  193.     calcdist(R0,C0,R2,C2,L2,DIST2),
  194.     DIST2<DIST1.
  195.  
  196.   calcdist(R0,C0,R1,C1,L1,DIST):-
  197.     C11=C1+L1,
  198.     max(C0,C1,H1),
  199.     min(H1,C11,H2),
  200.     DIST=3*abs(R1-R0)+abs(H2-C0).
  201.  
  202.   move_left:-
  203.     not(typeerror),
  204.     actfield(FNAME),
  205.     field(FNAME,_,R,C,_),!,
  206.     best_left(R,C,-100,-100,ROW,COL),
  207.     field(F1,_,ROW,COL,_),
  208.     chng_actfield(F1),!,
  209.     cursor(ROW,COL).
  210.  
  211.   move_right:-
  212.     not(typeerror),
  213.     actfield(FNAME),
  214.     field(FNAME,_,R,C,_),!,
  215.     best_right(R,C,-100,-100,ROW,COL),
  216.     field(F1,_,ROW,COL,_),
  217.     chng_actfield(F1),!,
  218.     cursor(ROW,COL).
  219.  
  220.   prevfield(_,_):-typeerror,!,fail.
  221.   prevfield(R,C):-
  222.     field(FNAME,_,ROW,COL,_),
  223.     chk_found(FNAME,R,C,ROW,COL),!,
  224.     actfield(F1),
  225.     field(F1,_,RR,CC,_),!,
  226.     cursor(RR,CC).
  227.  
  228.   chk_found(_,R,C,R,C):-!.
  229.   chk_found(FNAME,_,_,_,_):-chng_actfield(FNAME),fail.
  230.  
  231.  
  232.   nextfield(_,_):-typeerror,!,fail.
  233.   nextfield(R,C):-
  234.     field(FNAME,_,ROW,COL,_),gtfield(ROW,R,COL,C),
  235.     chng_actfield(FNAME),!,
  236.     cursor(ROW,COL).
  237.   nextfield(_,_).
  238.  
  239.   gtfield(R1,R2,_,_):-R1>R2,!.
  240.   gtfield(R,R,C1,C2):-C1>C2.
  241.  
  242.   setlastfield:-
  243.     field(FNAME,_,_,_,_),
  244.     chng_actfield(FNAME),
  245.     fail.
  246.   setlastfield.
  247.  
  248.  
  249. PREDICATES
  250.   linedit(KEY,COL,STRING,STRING)
  251.   myfrontstr(COL,STRING,STRING,STRING)
  252.   dropchar(STRING,STRING)
  253.   changemode
  254.  
  255. CLAUSES
  256.   changemode:-retract(insmode),!.
  257.   changemode:-assert(insmode).
  258.  
  259.   myfrontstr(N,STR,S1,S2):-frontstr(N,STR,S1,S2),!.
  260.   myfrontstr(N,STR,S1,""):-
  261.     str_len(STR,NN),
  262.     LEN=N-NN,
  263.     str_len(SS,LEN),
  264.     concat(STR,SS,S1).
  265.  
  266.   linedit(char(T),POS,STR,STR1):-
  267.     insmode,!,
  268.     myfrontstr(POS,STR,S1,S2),
  269.     frontchar(S22,T,S2),
  270.     concat(S1,S22,STR1).
  271.  
  272.   linedit(char(T),POS,STR,STR1):-
  273.     myfrontstr(POS,STR,S1,S2),
  274.     dropchar(S2,S21),
  275.     frontchar(S22,T,S21),
  276.     concat(S1,S22,STR1).
  277.  
  278.   linedit(del,POS,STR,STR1):-
  279.     frontstr(POS,STR,S1,S2),
  280.     frontchar(S2,_,S22),!,
  281.     concat(S1,S22,STR1).
  282.   linedit(del,_,S,S).
  283.  
  284.   dropchar(S,S1):-frontchar(S,_,S1),!.
  285.   dropchar(S,S).
  286.  
  287.  
  288.  /***********************************************************************/
  289.  /*        scr                               */
  290.  /***********************************************************************/
  291.  
  292.   /* Insert a new character in a field */
  293.   scr(char(T)):-actfield(FNAME),
  294.         not(noinput(FNAME)),
  295.         cursor(_,C),
  296.         field(FNAME,_,ROW,COL,LEN),!,
  297.         POS=C-COL,
  298.         oldstr(FNAME,STR),
  299.         linedit(char(T),POS,STR,STR1),
  300.         trunc_(LEN,STR1,STR2),
  301.         ass_val(FNAME,STR2),
  302.         field_str(ROW,COL,LEN,STR2),
  303.         scr(right).
  304.         
  305.  
  306.   /* Delete character under cursor */
  307.   scr(del):-    actfield(FNAME),
  308.         not(noinput(FNAME)),
  309.         cursor(_,C),
  310.         field(FNAME,_,ROW,COL,LEN),!,
  311.         POS=C-COL,
  312.         oldstr(FNAME,STR),
  313.         linedit(del,POS,STR,STR1),
  314.         ass_val(FNAME,STR1),
  315.         field_str(ROW,COL,LEN,STR1).
  316.         
  317.   /* Delete character before cursor and move cursor to the left */
  318.   scr(bdel):-    actfield(FNAME),
  319.         not(noinput(FNAME)),
  320.         cursor(_,C),
  321.         field(FNAME,_,ROW,COL,LEN),!,
  322.         POS=C-COL-1,
  323.         oldstr(FNAME,STR),
  324.         linedit(del,POS,STR,STR1),
  325.         ass_val(FNAME,STR1),
  326.         field_str(ROW,COL,LEN,STR1),
  327.         scr(left).
  328.  
  329.  /*If there is an action - do it. Otherwise, go to next field*/
  330.   scr(cr):-
  331.     actfield(FNAME),
  332.     field_action(FNAME),
  333.     cursor(RR,CC),cursor(RR,CC),!.
  334.   scr(cr):-cursor(RR,CC),cursor(RR,CC),scr(tab).
  335.  
  336.  
  337.   /* Change between insertmode and overwritemode */
  338.   scr(ins):-changemode,showoverwrite.
  339.  
  340.   /* escape */
  341.   scr( esc ).
  342.  
  343.   /* F10: end of definition */
  344.   scr( fkey(10) ):-not(typeerror).
  345.  
  346.   scr(right):-
  347.     actfield(FNAME),
  348.     not(noinput(FNAME)),
  349.     field(FNAME,_,_,C,L),
  350.     cursor(ROW,COL), COL<C+L-1,!,
  351.     COL1=COL+1,
  352.     cursor(ROW,COL1).
  353.  
  354.   scr(right):-move_right.
  355.  
  356.   scr(ctrlright):-
  357.     actfield(FNAME),
  358.     not(noinput(FNAME)),
  359.     field(FNAME,_,_,C,L),
  360.     cursor(ROW,COL),
  361.     COL1=COL+5, COL1<C+L-1,!,
  362.     cursor(ROW,COL1).
  363.  
  364.   scr(ctrlright):-move_right.
  365.  
  366.   scr(left):-
  367.     actfield(FNAME), field(FNAME,_,_,C,_),
  368.     cursor(ROW,COL),
  369.     COL>C,!,
  370.     COL1=COL-1,
  371.     cursor(ROW,COL1).
  372.  
  373.   scr(left):-move_left.
  374.  
  375.   scr(ctrlleft):-
  376.     actfield(FNAME), field(FNAME,_,_,C,_),
  377.     cursor(ROW,COL),
  378.     COL1=COL-5, COL1>C,!,
  379.     cursor(ROW,COL1).
  380.  
  381.   scr(ctrlleft):-move_left.
  382.  
  383.   scr(tab):-
  384.     cursor(R,C),
  385.     nextfield(R,C).
  386.  
  387.   scr(btab):-
  388.     cursor(R,C),
  389.     prevfield(R,C).
  390.  
  391.   scr(up):-
  392.     not(typeerror),
  393.     cursor(R,C),
  394.     best_up(R,C,-100,-100,1,ROW,COL),
  395.     field(F1,_,ROW,COL,_),
  396.     chng_actfield(F1),!,
  397.     cursor(ROW,COL).
  398.  
  399.   scr(down):-
  400.     not(typeerror),
  401.     cursor(R,C),
  402.     best_down(R,C,100,100,1,ROW,COL),
  403.     field(F1,_,ROW,COL,_),
  404.     chng_actfield(F1),!,
  405.     cursor(ROW,COL).
  406.  
  407.   scr(home):-
  408.     not(typeerror),
  409.     field(F1,_,ROW,COL,_),
  410.     chng_actfield(F1),!,
  411.     cursor(ROW,COL).
  412.  
  413.   scr(end):-
  414.     not(typeerror),
  415.     setlastfield,
  416.     actfield(FNAME),
  417.     field(FNAME,_,ROW,COL,_),!,
  418.     cursor(ROW,COL).
  419.  
  420. /* scr(fkey(1)):-help.  If helpsystem is used. */
  421.  
  422.  
  423.  /***********************************************************************/
  424.  /*    Predicates maintaining the top messages line                */
  425.  /***********************************************************************/
  426.  
  427.   mkheader:-notopline,!.
  428.   mkheader:-
  429.       shiftwindow(OLD),
  430.     gotowindow(85),
  431.     field_str(0,0,30,"ROW:      COL:"),
  432.     gotowindow(OLD).
  433.  
  434. PREDICATES
  435.   get_overwritestatus(STRING)
  436.   show_str(COL,LEN,STRING)
  437.   showfield(ROW,COL)
  438.  
  439. CLAUSES
  440.   get_overwritestatus(insert):-insmode,!.
  441.   get_overwritestatus(overwrite).
  442.  
  443.   show_str(C,L,STR):-
  444.     windowsize(_,COLS),
  445.     C<COLS,!,
  446.     MAXL=COLS-C,
  447.     min(L,MAXL,LL),
  448.     field_str(0,C,LL,STR).
  449.   show_str(_,_,_).
  450.  
  451.   showoverwrite:-notopline,!.
  452.   showoverwrite:-
  453.     shiftwindow(OLD),
  454.     gotowindow(85),
  455.     get_overwritestatus(OV),
  456.     show_str(20,9,OV),
  457.     gotowindow(OLD).
  458.  
  459.   showfield(_,_):-keypressed,!.
  460.   showfield(R,C):-
  461.     field(FNAME,TYP,ROW,COL,LEN),
  462.     ROW=R, COL<=C, C<COL+LEN,
  463.     types(_,TYP,TYPE),!,
  464.     show_str(30,8,TYPE),
  465.     STR=FNAME, show_str(38,42,STR).
  466.   showfield(_,_):-keypressed,!.
  467.   showfield(R,C):-
  468.     txtfield(ROW,COL,LEN,TXT),
  469.     ROW=R, COL<=C, C<=COL+LEN,!,
  470.     show_str(30,1,"\""),
  471.     show_str(31,49,TXT).
  472.   showfield(_,_):-show_str(30,50,"").
  473.  
  474.   showcursor:-keypressed,!.
  475.   showcursor:-notopline,!.
  476.   showcursor:-
  477.     shiftwindow(OLD),
  478.     cursor(R,C),
  479.     str_int(RSTR,R), str_int(CSTR,C), 
  480.     gotowindow(85),
  481.     show_str(4,4,RSTR), show_str(14,4,CSTR),
  482.     showfield(R,C),
  483.     gotowindow(OLD),
  484.     cursor(R,C).
  485.  
  486.  
  487.  /***********************************************************************/
  488.  /*    update all fields on the screen                        */
  489.  /***********************************************************************/
  490.  
  491.   writescr:-
  492.     field(FNAME,_,ROW,COL,LEN),
  493.     field_attr(ROW,COL,LEN,112),
  494.     field_value(FNAME,STR),
  495.     field_str(ROW,COL,LEN,STR),
  496.     keypressed,!.
  497.   writescr:-
  498.     txtfield(ROW,COL,LEN,STR),
  499.     field_str(ROW,COL,LEN,STR),
  500.     keypressed,!.
  501.   writescr.
  502.  
  503.