home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l216 / 1.ddi / SCRDEF.PRO < prev    next >
Encoding:
Text File  |  1987-03-23  |  23.3 KB  |  1,024 lines
  1. /****************************************************************
  2.  
  3.      Turbo Prolog Toolbox
  4.      (C) Copyright 1987 Borland International.
  5.  
  6.        Utility Program for screen layout
  7. ****************************************************************/
  8. code=2700
  9. include "tdoms.pro"
  10.  
  11. DOMAINS
  12.   FNAME=SYMBOL
  13.   FNAMELIST = FNAME*
  14.   TYPE = int(); str(); real()
  15.   TYPELIST = TYPE*
  16.   VALUE    = int(INTEGER); str(STRING); real(REAL)
  17.   VALUELIST = VALUE*
  18.   FILE    = textfile
  19.  
  20. DATABASE
  21.   /* Screen definition */
  22.   field(FNAME,TYPE,ROW,COL,LEN)
  23.   txtfield(ROW,COL,LEN,STRING)
  24.   windowsize(ROW,COL)
  25.  
  26.   /* temporary fields under sort */
  27.   tempfield(FNAME,TYPE,ROW,COL,LEN),
  28.   tempminfield(FNAME,TYPE,ROW,COL,LEN),
  29.  
  30.   /* Global status */
  31.   windowstart(ROW,COL)
  32.   mycursord(ROW,COL)
  33.   insmode
  34.  
  35.   /* Definition of the known types */
  36.   types(INTEGER,TYPE,STRING)
  37.   
  38.   filename(STRING)
  39.   continue
  40.  
  41.   dblineno(INTEGER)
  42.  
  43.   lineinpstate(STRING,COL)
  44.   lineinpflag
  45.  
  46.   drawmode(KEY)
  47.  
  48. include "tpreds.pro"
  49. include "menu.pro"
  50. include "status.pro"
  51. include "lineinp.pro"
  52. include "filename.pro"
  53. include "resize.pro"
  54.  
  55. PREDICATES
  56.   /* SCREEN DRIVER */
  57.   scrdef
  58.   endscrdef(KEY)
  59.   scr(KEY)
  60.   createwindow
  61.  
  62.   myfield_attr(ROW,COL,LEN,INTEGER)
  63.   myfield_str(ROW,COL,LEN,STRING)
  64.   wrscr(ROW,ROW,COL,COL)
  65.  
  66.   mycursor(ROW,COL)
  67.   showcursor
  68.   mkheader
  69.   showoverwrite
  70.   juststart(ROW,COL,ROW,COL,ROW,COL)
  71.   newstart(ROW,COL)
  72.  
  73.   insline
  74.   delline
  75.   movetxtfield(ROW,ROW,COL,LEN,STRING)
  76.   movefield(ROW,FNAME,TYPE,ROW,COL,LEN)
  77.   delfield
  78.   deffield
  79.   chkfieldname(FNAME)
  80.   gettype(TYPE)
  81.   deffield2(COL,KEY)
  82.  
  83.  
  84. CLAUSES
  85.  /***********************************************************************/
  86.  /*        Initializing the database                */
  87.  /***********************************************************************/
  88.  
  89.   windowsize(20,77).
  90.   windowstart(0,0).
  91.   mycursord(0,0).
  92.   insmode.
  93.  
  94.   /* The known types */
  95.   types(1,int,"integer").
  96.   types(2,real,"real").
  97.   types(3,str,"string").
  98.  
  99.  
  100.  /***********************************************************************/
  101.  /*        Helping predicates                    */
  102.  /***********************************************************************/
  103.  
  104. CLAUSES
  105.   endscrdef(fkey(10)):-!.
  106.   endscrdef(esc).
  107.  
  108.  /***********************************************************************/
  109.  /*        create the window                    */
  110.  /***********************************************************************/
  111.  
  112.   createwindow:-
  113.     windowsize(R,C),!,
  114.     R1=R+3, C1=C+3,
  115.     makewindow(1,66,23,"Editing screen layout",1,0,R1,C1).
  116.  
  117.  
  118.  /***********************************************************************/
  119.  /*        SCREEN DRIVER                           */
  120.  /* The screen definition/input is repeated until F10 is pressed    */
  121.  /***********************************************************************/
  122.  
  123.   scrdef:-
  124.     shiftwindow(OLD),
  125.     makewindow(85,112,0,"",0,0,1,80),
  126.     makestatus(112,"F1:Hlp F3:Del fld F4:Def fld F5:Box F7:Del line F8:Ins line S-F10:Resize F10:End"),
  127.     createwindow,
  128.     refreshstatus,
  129.     mkheader,
  130.     mycursor(0,0),
  131.     repeat,
  132.     showcursor,
  133.     writescr,
  134.     readkey(KEY),scr(KEY),endscrdef(KEY),!,
  135.     removestatus,
  136.     removewindow,
  137.     removewindow,
  138.     shiftwindow(OLD).
  139.  
  140.  
  141.  /***********************************************************************/
  142.  /*        scr                               */
  143.  /***********************************************************************/
  144.  
  145. PREDICATES
  146.   draw(KEY)
  147.   getch(ROW,COL,CHAR,KEY)
  148.   getdirch(CHAR,KEY)
  149.   drawloop
  150.   decide(KEY,CHAR,INTEGER)
  151.   decidecorner(INTEGER,INTEGER,INTEGER,INTEGER,CHAR)
  152.   fix(ROW,COL,KEY)
  153.   tryfix(ROW,COL,KEY)
  154.  
  155. CLAUSES
  156.   drawloop:-retract(insmode),fail.
  157.   drawloop:-
  158.     makestatus(112," Draw boxes       F10,Esc: End         Arrows: draw"),
  159.     repeat,
  160.     showcursor,
  161.     readkey(KEY),
  162.     draw(KEY),
  163.     endscrdef(KEY),!,
  164.     removestatus.
  165.   
  166.   draw(right):-
  167.     mycursor(R,C),
  168.     scr(right),
  169.     C2=C+1,
  170.     tryfix(R,C,right),
  171.     mycursor(R,C2).
  172.   draw(left):-
  173.     mycursor(R,C),
  174.     scr(left),
  175.     C1=C-1,
  176.     tryfix(R,C,left),
  177.     C1>=0,
  178.     mycursor(R,C1).
  179.   draw(up):-
  180.     mycursor(R,C),
  181.     scr(up),
  182.     R1=R-1,
  183.     tryfix(R,C,up),
  184.     R1>=0,
  185.     mycursor(R1,C).
  186.   draw(down):-
  187.     mycursor(R,C),
  188.     scr(down),
  189.     R2=R+1,
  190.     tryfix(R,C,down),
  191.     mycursor(R2,C).
  192.   draw(esc).
  193.   draw(fkey(10)).
  194.  
  195.   getch(ROW,COL,CH,KEY):-
  196.     mycursor(R,C),ROW=R,COL=C,
  197.     getdirch(CH,KEY),!.
  198.   getch(ROW,COL,CH,_):-
  199.     txtfield(ROW,C,LEN,TXT),
  200.     C<=COL, C+LEN>COL,!,
  201.     DROP=COL-C,
  202.     frontstr(DROP,TXT,_,TXT1),
  203.     frontchar(TXT1,CH,_).
  204.   getch(_,_,' ',_).
  205.  
  206.   getdirch('─',left).
  207.   getdirch('─',right).
  208.   getdirch('│',up).
  209.   getdirch('│',down).
  210.  
  211.   tryfix(R,C,KEY):-fix(R,C,KEY),!.
  212.   tryfix(_,_,_).
  213.  
  214.   fix(ROW,COL,KEY):-
  215.     R1=ROW-1, R2=ROW+1,
  216.     C1=COL-1, C2=COL+1,
  217.     getch(ROW,COL,CH,KEY),
  218.     getch(ROW,C1,CH1,KEY), decide(left,CH1,LEFT),
  219.     getch(R1,COL,CH2,KEY), decide(up,CH2,UP),
  220.     getch(R2,COL,CH3,KEY), decide(down,CH3,DOWN),
  221.     getch(ROW,C2,CH4,KEY), decide(right,CH4,RIGHT),
  222.     decidecorner(UP,DOWN,LEFT,RIGHT,CHOICE),
  223.     CHOICE><CH,
  224.     mycursor(ROW,COL),
  225.     scr(char(CHOICE)).
  226.  
  227.   decidecorner(1,1,1,1,'┼').
  228.   decidecorner(1,1,1,0,'┤').
  229.   decidecorner(1,1,0,1,'├').
  230.   decidecorner(1,0,1,1,'┴').
  231.   decidecorner(0,1,1,1,'┬').
  232.   decidecorner(0,1,0,1,'┌').
  233.   decidecorner(0,1,1,0,'┐').
  234.   decidecorner(1,0,1,0,'┘').
  235.   decidecorner(1,0,0,1,'└').
  236.   decidecorner(0,0,0,1,'─').
  237.   decidecorner(0,0,1,0,'─').
  238.   decidecorner(0,0,1,1,'─').
  239.   decidecorner(1,0,0,0,'│').
  240.   decidecorner(0,1,0,0,'│').
  241.   decidecorner(1,1,0,0,'│').
  242.  
  243.   decide(_,' ',0):-!.
  244.   decide(_,'┼',1):-!.
  245.   decide(DIR,'┤',1):-not(DIR=left),!.
  246.   decide(DIR,'├',1):-not(DIR=right),!.
  247.   decide(DIR,'┴',1):-not(DIR=up),!.
  248.   decide(DIR,'┬',1):-not(DIR=down),!.
  249.   decide(DIR,'┌',1):-DIR=left,!;DIR=up,!.
  250.   decide(DIR,'┐',1):-DIR=right,!;DIR=up,!.
  251.   decide(DIR,'└',1):-DIR=left,!;DIR=down,!.
  252.   decide(DIR,'┘',1):-DIR=right,!;DIR=down,!.
  253.   decide(DIR,'─',1):-DIR=left,!;DIR=right,!.
  254.   decide(DIR,'│',1):-DIR=up,!;DIR=down,!.
  255.   decide(_,_,0).
  256.  
  257.  
  258. PREDICATES
  259.   hndstr(ROW,COL,LEN,STRING)
  260.  
  261. CLAUSES
  262.   hndstr(ROW,COL,LEN,TXT):-
  263.     txtfield(ROW,C,LEN1,TXT1),
  264.     C=COL+LEN,!,
  265.     retract(txtfield(ROW,C,_,_)),!,
  266.     concat(TXT,TXT1,TXT2),LEN2=LEN1+LEN,
  267.     assert(txtfield(ROW,COL,LEN2,TXT2)).
  268.  
  269.   hndstr(ROW,COL,LEN,TXT):-
  270.     assert(txtfield(ROW,COL,LEN,TXT)).
  271.  
  272.   /* Insert a new character in a field */
  273.   scr(char(T)):-
  274.     mycursor(R,C),
  275.     txtfield(ROW,COL,LEN,TXT),
  276.     ROW=R, COL<=C, C<=COL+LEN,!,
  277.     POS=C-COL,
  278.     lin(char(T),POS,TXT,TXT1),
  279.     retract(txtfield(ROW,COL,_,_)),!,
  280.     str_len(TXT1,LEN1),
  281.     hndstr(ROW,COL,LEN1,TXT1),
  282.     str_char(TSTR,T),
  283.     myfield_str(R,C,1,TSTR),
  284.     scr(right).
  285.  
  286.   /* Make a new text field */
  287.   scr(char(T)):-
  288.     mycursor(ROW,COL), str_char(TXT,T),
  289.     hndstr(ROW,COL,1,TXT),
  290.     myfield_str(ROW,COL,1,TXT),
  291.     scr(right).
  292.  
  293.   /* Delete character under cursor */
  294.   scr(del):-
  295.     mycursor(R,C),
  296.     txtfield(ROW,COL,LEN,TXT),
  297.     ROW=R, COL<=C, C<COL+LEN,!,
  298.     POS=C-COL,
  299.     lin(del,POS,TXT,TXT1),
  300.     str_len(TXT1,LEN1),
  301.     CC=COL+LEN1,
  302.     myfield_str(ROW,CC,1," "),
  303.     retract(txtfield(ROW,COL,LEN,TXT)),!,TXT1><"",
  304.     assert(txtfield(ROW,COL,LEN1,TXT1)),
  305.     myfield_str(ROW,COL,LEN1,TXT1).
  306.  
  307.   /* Delete character before cursor and move cursor to the left */
  308.   scr(bdel):-
  309.     mycursor(R,C),
  310.     txtfield(ROW,COL,LEN,TXT),
  311.     ROW=R, COL<C, C<=COL+LEN,!,
  312.     POS=C-COL-1,
  313.     lin(del,POS,TXT,TXT1),
  314.     str_len(TXT1,LEN1),
  315.     CC=COL+LEN1,
  316.     myfield_str(ROW,CC,1," "),
  317.     scr(left),
  318.     retract(txtfield(ROW,COL,LEN,TXT)),!, TXT1><"",
  319.     assert(txtfield(ROW,COL,LEN1,TXT1)),
  320.     myfield_str(ROW,COL,LEN1,TXT1).
  321.  
  322.   scr(bdel):-scr(left).
  323.  
  324.   /* Goto next field on screen */
  325.   scr(cr):-mycursor(R,_),R1=R+1,windowstart(_,C),!,mycursor(R1,C).
  326.  
  327.   /* Change between insertmode and overwritemode */
  328.   scr(ins):-changemode,showoverwrite.
  329.  
  330.   /* escape */
  331.   scr( esc ).
  332.  
  333.   /* F10: end of definition */
  334.   scr( fkey(10) ).
  335.  
  336.  
  337.   /* crtlpgup: goto 0,0 */
  338.   scr(ctrlpgup):-mycursor(0,0).
  339.  
  340.   /* crtlhome: goto start of window */
  341.   scr(ctrlhome):-
  342.     windowstart(R,C),!,
  343.     mycursor(R,C).
  344.  
  345.  
  346.   /* home: goto start of actual line */
  347.   scr(home):-
  348.     windowstart(_,C),!,
  349.     mycursor(R1,_),
  350.     mycursor(R1,C).
  351.  
  352.  
  353.   /* end: goto end of actual line */
  354.   scr(end):-
  355.     windowstart(_,C), windowsize(_,CS),!,
  356.     mycursor(R1,_),
  357.     COL=C+CS,
  358.     mycursor(R1,COL).
  359.  
  360.  
  361.   /* ctrlend: goto end of screen */
  362.   scr(ctrlend):-
  363.     windowstart(R,C), windowsize(RS,CS),!,
  364.     ROW=R+RS,COL=C+CS,
  365.     mycursor(ROW,COL).
  366.  
  367.  
  368.   /* cursor right */
  369.   scr(right):-
  370.     mycursor(ROW,COL),
  371.     COL1=COL+1,
  372.     mycursor(ROW,COL1).
  373.  
  374.  
  375.   /* cursor ctrlright */
  376.   scr(ctrlright):-
  377.     mycursor(ROW,COL),
  378.     COL1=COL+5,
  379.     mycursor(ROW,COL1).
  380.  
  381.  
  382.   /* cursor left */
  383.   scr(left):-
  384.     mycursor(ROW,COL),
  385.     COL>0,
  386.     COL1=COL-1,
  387.     mycursor(ROW,COL1).
  388.  
  389.  
  390.   /* cursor ctrlleft */
  391.   scr(ctrlleft):-
  392.     mycursor(ROW,COL),
  393.     COL1=COL-5, COL1>=0,!,
  394.     mycursor(ROW,COL1).
  395.  
  396.  
  397.   /* cursor ctrlleft */
  398.   scr(ctrlleft):-
  399.     mycursor(ROW,COL),
  400.     COL1=COL-5, COL1<0,
  401.     mycursor(ROW,0).
  402.  
  403.  
  404.   /* cursor up */
  405.   scr(up):-
  406.     mycursor(ROW,COL),
  407.     ROW>0,
  408.     ROW1=ROW-1,
  409.     mycursor(ROW1,COL).
  410.  
  411.  
  412.   /* cursor pgup */
  413.   scr(pgup):-
  414.     mycursor(ROW,COL),
  415.     windowsize(RS,_),!,
  416.     ROW1=ROW-RS,
  417.     max(ROW1,0,ROW2),
  418.     mycursor(ROW2,COL).
  419.  
  420.  
  421.   /* cursor down */
  422.   scr(down):-
  423.     mycursor(ROW,COL),
  424.     ROW1=ROW+1,
  425.     mycursor(ROW1,COL).
  426.  
  427.  
  428.   /* cursor pgdown */
  429.   scr(pgdn):-
  430.     mycursor(ROW,COL),
  431.     windowsize(RS,_),!,
  432.     ROW1=ROW+RS,
  433.     mycursor(ROW1,COL).
  434.  
  435.   /* Define window size */
  436.   scr(fkey(20)):-
  437.     resizewindow,
  438.     makewindow(_,_,_,_,_,_,ROWS,COLS),
  439.     RR=ROWS-3, CC=COLS-3,
  440.     retract(windowsize(_,_)),!,assert(windowsize(RR,CC)),
  441.     refreshstatus,
  442.     mkheader,
  443.     mycursor(R,C),mycursor(R,C).
  444.  
  445.   /* Help information */
  446.   scr(fkey(1)):-
  447.     makewindow(9,23,66,"HELP",5,5,15,60),
  448.     file_str("scrdef.hlp",X),
  449.     display(X),
  450.     mkheader,
  451.     fail.
  452.   scr(fkey(1)):-removewindow,refreshstatus.
  453.  
  454.  
  455. /* ............... Start to define screen ................................ */
  456.  
  457.   /* Delete field */
  458.   scr(fkey(3)):-delfield.
  459.  
  460.   /* Define field */
  461.   scr(fkey(4)):-deffield.
  462.  
  463.   /* Delete line */
  464.   scr(fkey(7)):-delline,cursor(R,C),clearwindow,cursor(R,C).
  465.  
  466.   /* Insert line */
  467.   scr(fkey(8)):-insline,cursor(R,C),clearwindow,cursor(R,C).
  468.  
  469.   scr(fkey(5)):-drawloop.
  470.  
  471.  
  472.  
  473.  
  474.  /***********************************************************************/
  475.  /*        insert line                            */
  476.  /***********************************************************************/
  477.  
  478.   insline:-
  479.     mycursor(ROW,_),
  480.     field(FN,TY,R,C,L),
  481.     R>=ROW,
  482.     movefield(1,FN,TY,R,C,L),
  483.     fail.
  484.   insline:-
  485.     mycursor(ROW,_),
  486.     txtfield(R,C,L,TXT),
  487.     R>=ROW,
  488.     movetxtfield(1,R,C,L,TXT),
  489.     fail.
  490.   insline:-mycursor(RR,CC),mycursor(RR,CC).
  491.  
  492.   delline:-
  493.     mycursor(ROW,_),
  494.     retract(field(_,_,ROW,_,_)),
  495.     fail.
  496.   delline:-
  497.     mycursor(ROW,_),
  498.     retract(txtfield(ROW,_,_,_)),
  499.     fail.
  500.   delline:-
  501.     mycursor(ROW,_),
  502.     field(FN,TY,R,C,L),
  503.     R>=ROW,
  504.     movefield(-1,FN,TY,R,C,L),
  505.     fail.
  506.   delline:-
  507.     mycursor(ROW,_),
  508.     txtfield(R,C,L,TXT),
  509.     R>ROW,
  510.     movetxtfield(-1,R,C,L,TXT),
  511.     fail.
  512.   delline:-mycursor(RR,CC),mycursor(RR,CC).
  513.  
  514.   movetxtfield(ROWS,R,C,L,TXT):-
  515.     R1=R+ROWS,
  516.     retract(txtfield(R,C,L,TXT)),!,
  517.     asserta(txtfield(R1,C,L,TXT)).
  518.  
  519.   movefield(ROWS,FN,TY,R,C,L):-
  520.     R1=R+ROWS,
  521.     retract(field(FN,TY,R,C,L)),!,
  522.     asserta(field(FN,TY,R1,C,L)).
  523.  
  524.  
  525.  
  526.  /***********************************************************************/
  527.  /*    DEFINE NEW FIELD                            */
  528.  /***********************************************************************/
  529.  
  530.   deffield:-
  531.       mycursor(MYROW,MYCOL),
  532.     cursor(ROW,COL1),
  533.     lineinput(ROW,COL1,30,23,23,"Field name: ","",TXT),TXT><"",FNAME=TXT,
  534.     chkfieldname(FNAME),
  535.     gettype(TYPE),
  536.     myfield_attr(MYROW,MYCOL,1,112),
  537.     readkey(KEY),
  538.     deffield2(MYCOL,KEY),
  539.     mycursor(_,MYCOL2),
  540.     LEN=MYCOL2-MYCOL+1,
  541.     assert(field(FNAME,TYPE,MYROW,MYCOL,LEN)).
  542.  
  543.   deffield2(_,cr):-!.
  544.   deffield2(CMIN,esc):-!,
  545.     mycursor(ROW,COL),
  546.     LEN=COL-CMIN+1,
  547.     myfield_attr(ROW,CMIN,LEN,66),
  548.     fail.
  549.   deffield2(CMIN,right):-!,
  550.     mycursor(ROW,COL),
  551.     COL1=COL+1,
  552.     mycursor(ROW,COL1),
  553.     myfield_attr(ROW,COL1,1,112),
  554.     showcursor,
  555.     readkey(KEY),
  556.     deffield2(CMIN,KEY).
  557.   deffield2(CMIN,left):-
  558.     mycursor(ROW,COL), COL>CMIN,!,
  559.     COL1=COL-1,
  560.     mycursor(ROW,COL1),
  561.     myfield_attr(ROW,COL,1,66),
  562.     showcursor,
  563.     readkey(KEY),
  564.     deffield2(CMIN,KEY).
  565.   deffield2(CMIN,_):-
  566.     readkey(KEY),
  567.     deffield2(CMIN,KEY).
  568.  
  569.   chkfieldname(FNAME):-
  570.     field(FNAME,_,_,_,_),!,
  571.     makewindow(6,23,66,"ERROR",5,5,4,30),
  572.     write("Field name already exist"),
  573.     readchar(_),
  574.     removewindow,fail.
  575.   chkfieldname(_).
  576.  
  577.  
  578.   gettype(TYPE):-
  579.     cursor(ROW,COL),
  580.     findall(X,types(_,_,X),LIST),
  581.     menu(ROW,COL,23,23,LIST,"Select type",0,CH),
  582.     types(CH,TYPE,_),!.
  583.  
  584.  
  585.  /************************************************************************/
  586.  /*        DELETE FIELD                            */
  587.  /************************************************************************/
  588.  
  589.   delfield:-
  590.     mycursor(R,C),
  591.     field(FNAME,_,ROW,COL,LEN),
  592.     ROW=R, COL<=C, C<COL+LEN,
  593.     myfield_attr(ROW,COL,LEN,66),
  594.     myfield_str(ROW,COL,LEN,""),
  595.     retract(field(FNAME,_,ROW,COL,_)),
  596.     fail.
  597.  
  598.   delfield:-
  599.     mycursor(R,C),
  600.     txtfield(ROW,COL,LEN,_),
  601.     ROW=R, COL<=C, C<COL+LEN,
  602.     retract(txtfield(ROW,COL,_,_)),
  603.     myfield_str(ROW,COL,LEN,""),
  604.     fail.
  605.  
  606. /* ................. End define screen ................................... */
  607.  
  608.  
  609.  
  610.  /************************************************************************/
  611.  /*         MYCURSOR                            */
  612.  /************************************************************************/
  613.  
  614.   mycursor(R,C):-free(R),free(C),mycursord(R,C),!.
  615.  
  616.   mycursor(R,C):-bound(R),bound(C),
  617.      windowstart(RR,CC),
  618.      R>=RR, C>=CC,
  619.      windowsize(RS,CS),
  620.      R<=RR+RS, C<=CC+CS,!,
  621.      retract(mycursord(_,_)),!,
  622.      assert(mycursord(R,C)),
  623.      R1=R-RR, C1=C-CC,
  624.      cursor(R1,C1).
  625.  
  626.   mycursor(R,C):-bound(R),bound(C),
  627.      windowstart(RR,CC),
  628.      windowsize(RS,CS),!,
  629.      juststart(R,C,RR,CC,RS,CS),
  630.      mycursor(R,C).
  631.  
  632.   /* juststart( ACTCURSOR, WINDSTART, WINDSIZE ) */
  633.   juststart(R,_,RR,CC,_,_):-R<RR,!,newstart(R,CC).
  634.   juststart(_,C,RR,CC,_,_):-C<CC,!,newstart(RR,C).
  635.   juststart(R,_,RR,CC,RS,_):-R>RR+RS,!,R1=R-RS,newstart(R1,CC).
  636.   juststart(_,C,RR,CC,_,CS):-C>CC+CS,!,C1=C-CS,newstart(RR,C1).
  637.  
  638.  PREDICATES
  639.   check_update(ROW,ROW,COL,COL)
  640.  
  641. CLAUSES
  642.  
  643.   newstart(R,C):-retract(windowstart(OLDR,OLDC)),!,
  644.           assert(windowstart(R,C)),
  645.           SCROLLROW=R-OLDR,SCROLLCOL=C-OLDC,
  646.           scroll(SCROLLROW,SCROLLCOL),
  647.           check_update(R,SCROLLROW,C,SCROLLCOL).
  648.  
  649.   check_update(R,ROWS,C,0):-
  650.         ROWS>0,!,
  651.           windowsize(NOOFROWS,NOOFCOLS),!,
  652.           ENDROW=R+NOOFROWS,STARTROW=ENDROW-ROWS+1,
  653.           ENDCOL=C+NOOFCOLS,
  654.           wrscr(STARTROW,ENDROW,C,ENDCOL).
  655.   check_update(R,ROWS,C,0):-
  656.         ROWS<0,!,
  657.           windowsize(_,NOOFCOLS),!,
  658.           STARTROW=R, ENDROW=STARTROW-ROWS-1,
  659.           ENDCOL=C+NOOFCOLS,
  660.           wrscr(STARTROW,ENDROW,C,ENDCOL).
  661.   check_update(R,0,C,COLS):-
  662.         COLS>0,!,
  663.           windowsize(NOOFROWS,NOOFCOLS),!,
  664.           ENDROW=R+NOOFROWS, STARTROW=R,
  665.           ENDCOL=C+NOOFCOLS, STARTCOL=ENDCOL-COLS,
  666.           wrscr(STARTROW,ENDROW,STARTCOL,ENDCOL).
  667.   check_update(R,0,C,COLS):-
  668.         COLS<0,!,
  669.           windowsize(NOOFROWS,_),!,
  670.           ENDROW=R+NOOFROWS, STARTROW=R,
  671.           ENDCOL=C, STARTCOL=C+COLS,
  672.           wrscr(STARTROW,ENDROW,STARTCOL,ENDCOL).
  673.   check_update(_,_,_,_).
  674.  
  675.  /***********************************************************************/
  676.  /*    Predicates maintaining the top messages line                */
  677.  /***********************************************************************/
  678.  
  679.   mkheader:-!,
  680.     shiftwindow(OLD),
  681.     gotowindow(85),
  682.     field_str(0,0,30,"ROW:      COL:"),
  683.     showoverwrite, showcursor,
  684.     gotowindow(OLD).
  685.  
  686. PREDICATES
  687.   get_overwritestatus(STRING)
  688.   showfield
  689.   show_str(COL,LEN,STRING)
  690.  
  691. CLAUSES
  692.   get_overwritestatus("insert"):-insmode,!.
  693.   get_overwritestatus("overwrite").
  694.  
  695.   show_str(C,L,STR):-
  696.     C<80,!,
  697.     MAXL=80-C,
  698.     min(L,MAXL,LL),
  699.     field_str(0,C,LL,STR).
  700.   show_str(_,_,_).
  701.  
  702.   showoverwrite:-
  703.     shiftwindow(OLD),
  704.     gotowindow(85),
  705.     get_overwritestatus(OV),
  706.     show_str(20,9,OV),
  707.     gotowindow(OLD).
  708.  
  709.   showfield:-keypressed,!.
  710.   showfield:-
  711.     mycursor(R,C),
  712.     field(FNAME,TYP,ROW,COL,LEN),
  713.     ROW=R, COL<=C, C<COL+LEN,
  714.     types(_,TYP,TYPE),!,
  715.     show_str(30,8,TYPE),
  716.     STR=FNAME, show_str(38,42,STR).
  717.   showfield:-keypressed,!.
  718.   showfield:-
  719.     mycursor(R,C),
  720.     txtfield(ROW,COL,LEN,TXT),
  721.     ROW=R, COL<=C, C<=COL+LEN,!,
  722.     show_str(30,1,"\""),
  723.     show_str(31,49,TXT),
  724.     str_len(TXT,L),NewC=31+L,
  725.     show_str(NewC,1,"\"").
  726.   showfield:-show_str(30,50,"").
  727.  
  728.  
  729.   showcursor:-keypressed,!.
  730.   showcursor:-
  731.     shiftwindow(OLD),
  732.     gotowindow(85),
  733.     mycursor(R,C),!,
  734.     str_int(RSTR,R), str_int(CSTR,C), 
  735.     show_str(4,4,RSTR), show_str(14,4,CSTR),
  736.     showfield,
  737.     gotowindow(OLD),
  738.     cursor(RR,CC),
  739.     cursor(RR,CC).
  740.      
  741.  
  742.  /***********************************************************************/
  743.  /*     myfield_attr                               */
  744.  /* Sets only the attribute for fields inside the actual screen        */
  745.  /***********************************************************************/
  746.  
  747.   myfield_attr(R,C,LEN,ATTR):-
  748.     windowstart(RS,CS),windowsize(RR,CC),
  749.     R>=RS, R<=RS+RR,
  750.     C<=CS+CC, C+LEN>CS,!,
  751.     R1=R-RS,
  752.     max(C,CS,C1),
  753.     HH1=C+LEN, HH2=1+CS+CC,
  754.     min(HH1,HH2,HH),
  755.     L1=HH-C1,
  756.     C2=C1-CS,
  757.     field_attr(R1,C2,L1,ATTR).
  758.   myfield_attr(_,_,_,_).
  759.  
  760.  /***********************************************************************/
  761.  /*     myfield_str                               */
  762.  /* Prints only text inside the actual screen                */
  763.  /***********************************************************************/
  764.  
  765. PREDICATES
  766.   check_drop(INTEGER,STRING,STRING)
  767.  
  768. CLAUSES
  769.   check_drop(N,STR,STR):-N<=0,!.
  770.   check_drop(N,STR,STR1):-frontstr(N,STR,_,STR1).
  771.  
  772.   myfield_str(R,C,LEN,STR):-
  773.     windowstart(RS,CS),windowsize(RR,CC),
  774.     R>=RS, R<=RS+RR,
  775.     C+LEN>CS, C<=CS+CC, !,
  776.     R1=R-RS,
  777.     max(C,CS,C1),
  778.     HH1=C+LEN, HH2=1+CS+CC,
  779.     min(HH1,HH2,HH),
  780.     L1=HH-C1,
  781.     C2=C1-CS, MINUSLEN=CS-C,
  782.     check_drop(MINUSLEN,STR,STR1),
  783.     field_str(R1,C2,L1,STR1).
  784.   myfield_str(_,_,_,_).
  785.  
  786.   
  787.  /***********************************************************************/
  788.  /*    update all fields on the screen                        */
  789.  /***********************************************************************/
  790.  
  791.   writescr:-
  792.     windowstart(SR,SC), windowsize(RR,CC),!,
  793.     RS=SR+RR, CS=SC+CC,
  794.     wrscr(SR,RS,SC,CS).
  795.  
  796.   wrscr(_,_,_,_):-keypressed,!.
  797.   wrscr(SR,RS,SC,CS):-
  798.     txtfield(ROW,COL,LEN,STR),
  799.     ROW>=SR,ROW<=RS,COL<=CS,COL+LEN>SC,
  800.     myfield_str(ROW,COL,LEN,STR),
  801.     keypressed,!.
  802.   wrscr(SR,RS,SC,CS):-
  803.     field(_,_,ROW,COL,LEN),
  804.     ROW>=SR,ROW<=RS,COL<=CS,COL+LEN>SC,
  805.     myfield_attr(ROW,COL,LEN,112),
  806.     keypressed,!.
  807.   wrscr(_,_,_,_).
  808.  
  809.  
  810.  /***********************************************************************/
  811.  /*        MAIN PREDICATES                        */
  812.  /***********************************************************************/
  813.  
  814.  
  815. PREDICATES
  816.   run
  817.   myconsult
  818.   proces(INTEGER)
  819.   delete_scr
  820.   save_scr(STRING)
  821.   save_all
  822.   wr(DBASEDOM)
  823.   oldfilename(STRING)
  824.   newfilename(STRING)
  825.  
  826.   minfield(FNAME,TYPE,ROW,COL,LEN)
  827.   checkmin(FNAME,TYPE,ROW,COL,LEN)
  828.   chngminfield(FNAME,TYPE,ROW,COL,LEN)
  829.   nondeterm rep_field
  830.   mininit
  831.   ltfield(ROW,COL,ROW,COl)
  832.  
  833. CLAUSES
  834.   run:-
  835.     repeat,
  836.     clearwindow,
  837.     cursor(9,25),
  838.     menu(9,25,7,23,
  839.         ["Define screen layout",
  840.          "Save screen layout",
  841.          "Load screen layout",
  842.          "Edit layout definition file"],
  843.          "Screen definition",0,Choice),
  844.     proces(Choice),
  845.     Choice=0,!.
  846.  
  847.  
  848.   proces(0):-!.
  849.   proces(1):-!,scrdef.
  850.   proces(2):-
  851.     oldfilename(OLD),
  852.     readfilename(10,10,23,23,"scr",OLD,FILENAME),
  853.     newfilename(FILENAME),
  854.     save_scr(FILENAME),!.
  855.   proces(3):-
  856.     readfilename(10,10,23,23,"scr","",FILENAME),
  857.     newfilename(FILENAME),
  858.     delete_scr,
  859.     myconsult.
  860.   proces(4):-
  861.     readfilename(10,10,23,23,"scr","",FILENAME),
  862.     file_str(FILENAME,TXT),
  863.     editmsg(TXT,TXT1,"screen definition",FILENAME,"",0,"",RET),
  864.     RET><1,
  865.     readfilename(10,10,23,23,"scr",FILENAME,NEW),
  866.     file_str(NEW,TXT1).
  867.  
  868.  
  869.   oldfilename(X):-filename(X),!.
  870.   oldfilename("").
  871.  
  872.   newfilename(_):-retract(filename(_)),fail.
  873.   newfilename(X):-assert(filename(X)).
  874.  
  875.  
  876.   save_scr(FILENAME):-
  877.     existfile(FILENAME),
  878.     newext(FILENAME,".bak",BACKNAME),
  879.     deletefile(BACKNAME),
  880.     renamefile(FILENAME,BACKNAME),fail.
  881.   save_scr(FILENAME):-
  882.     openwrite(textfile,FILENAME),
  883.     writedevice(textfile),
  884.     save_all,
  885.     closefile(textfile),!.
  886.   save_scr(_):-closefile(textfile),write(">> File error"),readkey(_).
  887.  
  888.   save_all:-
  889.     rep_field,
  890.     mininit,
  891.     minfield(FNAME,TYPE,ROW,COL,LEN),
  892.     wr(field(FNAME,TYPE,ROW,COL,LEN)),
  893.     fail.
  894.   save_all:-save("dd.dat"),fail.
  895.   save_all:-
  896.     retract(tempfield(FNAME,TYPE,ROW,COL,LEN)),
  897.     assert(field(FNAME,TYPE,ROW,COL,LEN)),
  898.     fail.
  899.   save_all:-
  900.     txtfield(TEXT,ROW,COL,LEN),
  901.     wr(txtfield(TEXT,ROW,COL,LEN)),
  902.     fail.
  903.   save_all:-
  904.     windowsize(R,C),
  905.     wr(windowsize(R,C)),
  906.     fail.
  907.   save_all.
  908.  
  909.   wr(X):-write(X),nl.
  910.  
  911.   rep_field.
  912.   rep_field:-field(_,_,_,_,_),!,rep_field.
  913.  
  914.   mininit:-retract(tempminfield(_,_,_,_,_)),fail.
  915.   mininit:-
  916.     retract(field(FNAME,TYPE,ROW,COL,LEN)),!,
  917.     assert(tempminfield(FNAME,TYPE,ROW,COL,LEN)).
  918.  
  919.   minfield(_,_,_,_,_):-
  920.     field(FNAME,TYPE,ROW,COL,LEN),
  921.     checkmin(FNAME,TYPE,ROW,COL,LEN),
  922.     fail.
  923.   minfield(FNAME,TYPE,ROW,COL,LEN):-
  924.     retract(tempminfield(FNAME,TYPE,ROW,COL,LEN)),!,
  925.     assert(tempfield(FNAME,TYPE,ROW,COL,LEN)).
  926.  
  927.   checkmin(FNAME,TYPE,ROW,COL,LEN):-
  928.     tempminfield(_,_,ROW1,COL1,_),!,
  929.     ltfield(ROW,COL,ROW1,COL1),
  930.     chngminfield(FNAME,TYPE,ROW,COL,LEN).
  931.  
  932.   ltfield(ROW,_,ROW1,_):-ROW<ROW1,!.
  933.   ltfield(ROW,COL,ROW,COL1):-COL<COL1.
  934.  
  935.   chngminfield(FNAME,TYPE,ROW,COL,LEN):-
  936.     retract(tempminfield(FNAME1,TYPE1,ROW1,COL1,LEN1)),!,
  937.     asserta(field(FNAME1,TYPE1,ROW1,COL1,LEN1)),
  938.     retract(field(FNAME,TYPE,ROW,COL,LEN)),!,
  939.     assert(tempminfield(FNAME,TYPE,ROW,COL,LEN)).
  940.  
  941.   delete_scr:-retract(windowsize(_,_)),fail.
  942.   delete_scr:-retract(field(_,_,_,_,_)),fail.
  943.   delete_scr:-retract(txtfield(_,_,_,_)),fail.
  944.   delete_scr.
  945.  
  946.  
  947. PREDICATES
  948.   openrd(STRING)
  949.   nondeterm repfile(FILE)
  950.   myconsult1
  951.   editfile(STRING,INTEGER)
  952.   inconsistent(DBASEDOM,STRING)
  953.   inconsistentline(STRING)
  954.   lineno(INTEGER)
  955.  
  956. CLAUSES
  957.  
  958.   openrd(FILE):-
  959.     openread(textfile,FILE),readdevice(textfile),!.
  960.   openrd(_):-closefile(textfile),write(">> File error"),readkey(_).
  961.  
  962.   myconsult:-retract(continue),fail.
  963.   myconsult:-retract(dblineno(_)),fail.
  964.   myconsult:-
  965.     assert(continue),
  966.     assert(dblineno(0)),
  967.     filename(FILE),
  968.     openrd(FILE),
  969.     myconsult1,!.
  970.   myconsult.
  971.  
  972.   repfile(_).
  973.   repfile(F):-continue,!,not(eof(F)),repfile(F).
  974.  
  975.   lineno(X):-retract(dblineno(X)),!,X1=X+1,assert(dblineno(X1)).
  976.  
  977.   myconsult1:-
  978.     repfile(textfile),
  979.     filepos(textfile,POS,0),
  980.     lineno(LINENO),
  981.     inconsistentline(TXT),
  982.     ERRORPOS=POS-LINENO,
  983.     editfile(TXT,ERRORPOS),
  984.     fail.
  985.   myconsult1:-closefile(textfile),retract(continue),!.
  986.  
  987.   inconsistentline(TXT):-
  988.     readterm(DBASEDOM,X),!,inconsistent(X,TXT).
  989.   inconsistentline("Syntax error in line").
  990.  
  991.  
  992.   inconsistent(field(N,_,_,_,_),"This fieldname is previously defined"):-
  993.         field(N,_,_,_,_),!.
  994.   inconsistent(field(_,_,R,C1,L1),MSG):-
  995.       field(F2,_,R,C2,L2),
  996.       C1<=C2+L2,C1+L1>=C2,
  997.       concat("This field overlaps with ",F2,MSG),!.
  998.   inconsistent(txtfield(Row,Col,Len,_),"Overlapping textfields"):-
  999.       txtfield(Row,C2,Len2,_),
  1000.       Col<C2+Len2,C2<Col+Len,!.
  1001.   inconsistent(txtfield(R,L,_,Str),""):-
  1002.     str_len(Str,Len),
  1003.       assertz(txtfield(R,L,Len,Str)),!,fail.
  1004.   inconsistent(Fact,""):-
  1005.       assertz(Fact),!,fail.
  1006.  
  1007.   editfile(_,_):-closefile(textfile),retract(continue),fail.
  1008.   editfile(MSG,POS):-
  1009.     filename(FILE),!,
  1010.     file_str(FILE,TXT),
  1011.     editmsg(TXT,TXT1,"screen definition",FILE,MSG,POS,"",RET),
  1012.     RET><1,
  1013.     file_str(FILE,TXT1),
  1014.     openread(textfile,FILE),
  1015.     readdevice(textfile),
  1016.     assert(continue),
  1017.     retract(dblineno(_)),!,
  1018.     assert(dblineno(0)),
  1019.     delete_scr.
  1020.  
  1021. GOAL
  1022.   makewindow(11,7,0,"",0,0,25,80),
  1023.   run.
  1024.