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