home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / BROW.PRG < prev    next >
Encoding:
Text File  |  1991-08-28  |  70.7 KB  |  1,972 lines
  1. /*
  2.     Program: GRUMPBROW()
  3.     System: GRUMPFISH LIBRARY
  4.     Author: Greg Lief
  5.     Copyright (c) 1988-90, Greg Lief
  6.     Clipper 5.01 Version
  7.     Compile instructions: clipper brow /n/w/a
  8.  
  9.     Awesome generic database browser
  10.  
  11.     Syntax:  GRUMPBROW([<security>, <top>, <left>, <bottom>, <right>, ;
  12.              <box>, <fields>, <heads>, <pictures>, <alternates>,      ;
  13.              <low value>, <high value>])
  14. */
  15.  
  16. //───── begin preprocessor directives
  17.  
  18. #include "grump.ch"
  19. #include "inkey.ch"
  20. #include "dbstruct.ch"
  21. #include "error.ch"
  22.  
  23. //───── remove the next statement if you do not need the screen painter
  24. #define REMBRANDT
  25.  
  26. //───── remove the next statement if you do not need the code generator
  27. #define CODEGEN
  28.  
  29. //───── shorthand
  30. #translate TextAt(<r>, <c>) => substr(savescreen(<r>, <c>, <r>, <c>), 1, 1)
  31. #translate ColorAt(<r>, <c>) => substr(savescreen(<r>, <c>, <r>, <c>), 2, 1)
  32.  
  33. /*
  34.    GETs will be shown on screen in inverse, so all we need to do is save
  35.    a chunk of the screen and look at the color attribute if the color
  36.    attribute is 112 (inverse), then we must be in a GET
  37. */
  38. #translate IsItAGet(<r>, <c>) => ;
  39.         substr(savescreen(<r>, <c>, <r>, <c>), 2, 1) == chr(112)
  40.  
  41. //───── manifest constants for main browse window coordinates
  42. #define TopRow      boxcoords[1]
  43. #define LeftColumn  boxcoords[2]
  44. #define BottomRow   boxcoords[3]
  45. #define RightColumn boxcoords[4]
  46.  
  47. //───── manifest constants for get "objects" (no, this isn't OOPS)
  48. #translate GetRow(<xx>)       =>  gets_\[<xx>, 1]
  49. #translate GetCol(<xx>)       =>  gets_\[<xx>, 2]
  50. #translate GetLength(<xx>)    =>  gets_\[<xx>, 3]
  51. #translate GetName(<xx>)      =>  gets_\[<xx>, 4]
  52. #translate GetPicture(<xx>)   =>  gets_\[<xx>, 5]
  53.  
  54. //───── manifest constants for drawn box "objects" (again, this isn't OOPS)
  55. #translate BoxTop(<xx>)       =>  boxes_\[<xx>, 1]
  56. #translate BoxLeft(<xx>)      =>  boxes_\[<xx>, 2]
  57. #translate BoxBottom(<xx>)    =>  boxes_\[<xx>, 3]
  58. #translate BoxRight(<xx>)     =>  boxes_\[<xx>, 4]
  59. #translate BoxString(<xx>)    =>  boxes_\[<xx>, 5]
  60. #translate BoxColor(<xx>)     =>  boxes_\[<xx>, 6]
  61. #translate BoxFill(<xx>)      =>  boxes_\[<xx>, 7]
  62.  
  63. //───── indentation of generated source code (my preference is three)
  64. #define INDENT(x) space(x * 3)
  65.  
  66. //───── end preprocessor directives
  67.  
  68. //───── begin global declarations
  69.  
  70. static qrystring, ;            // used for query-by-example
  71.        num_flds,  ;
  72.        num_boxes, ;
  73.        boxcoords, ;            // array holding main box coordinates
  74.        gets_ := {}, ;          // array to hold info for GET fields
  75.        boxes_ := {}, ;         // array to hold info for boxes
  76.        maincolor, ;            // primary color throughout
  77.        piclens_ := {}          // array holding lengths of PICTURE clauses
  78.  
  79. static hival, lowval                      // for viewing data subsets
  80. static oldskip, oldgotop, oldgobott       // original movement blocks
  81.  
  82. /*
  83.    the following three items are used in the add/edit/view (GFBRECVIEW),
  84.    but must be declared as external static because they must be visible in
  85.    two hot-key routines (GFBSKIPAGET and GFBBACKAGET)
  86. */
  87. static goingdown, firstfield, curr_get
  88.  
  89. //───── end global declarations
  90.  
  91. function GrumpBrow(sec_level, ntop, nleft, nbottom, nright, mbox, ;
  92.       tfields_, heads_, pics_, alternate_, hi, lo)
  93. local security[7], mid, xx, options, mfield, buffer, lreadexit, ;
  94.       mtype, paintok, key, browse, mget, column, marker, ;
  95.       oldscore := set(_SET_SCOREBOARD, .F.), keepgoing, mrow, mcol, ;
  96.       searchstr, fields_, stru_, scrnbuff
  97.  
  98. GFSaveEnv(.t., 0)                           // shut off cursor
  99.  
  100. //───── reset high and low values for data subsets
  101. hival := hi
  102. lowval := lo
  103.  
  104. default sec_level to ''
  105. default ntop to 0
  106. default nleft to 0
  107. default nbottom to maxrow() - 1
  108. default nright to maxcol()
  109. default mbox to .t.
  110. default alternate_ to ARRAY(7)
  111. nbottom := min(nbottom, maxrow() - 1)
  112.  
  113. //───── initialize external STATICs
  114. boxcoords := if(mbox, { ntop, nleft, nbottom, nright }, ;
  115.              { 0, 0, maxrow(), maxcol() } )
  116. maincolor := ColorSet(C_GRUMPBROW_SAY, .T.) + ',' + ;
  117.              ColorSet(C_GRUMPBROW_GET, .T.) + ',,,'+ ;
  118.              ColorSet(C_GRUMPBROW_SAY, .T.)
  119.  
  120. options := []
  121. afill(security, .f.)
  122. if "A" $ upper(sec_level)
  123.    security[1] := .t.
  124.    options += "[A]dd  "
  125. endif
  126. if "D" $ upper(sec_level)
  127.    security[2] := .t.
  128.    options += "[D]elete  "
  129. endif
  130. if "E" $ upper(sec_level)
  131.    security[3] := .t.
  132.    options += "[E]dit  "
  133.    /*
  134.       Determine if user will be able to edit the cell by pressing Enter.
  135.       By default, if you pass "E" so that they can edit, they will be able
  136.       to edit an individual cell.  However, if you don't want them to be able
  137.       to do this, pass an "N" as part of the security string (thanks: Imad)
  138.    */
  139.    security[7] := ! ("N" $ upper(sec_level))
  140. endif
  141. if "Q" $ upper(sec_level)
  142.    security[4] := .t.
  143.    options += "[Q]uery  "
  144. endif
  145. if "S" $ upper(sec_level) .and. type(indexkey(0)) == "C"
  146.    security[5] := .t.
  147.    options += "[S]earch  "
  148. endif
  149. if "V" $ upper(sec_level)
  150.    security[6] := .t.
  151.    options += "[V]iew  "
  152. endif
  153. options += "[Esc]=quit"
  154.  
  155. //───── must pass a "P" in the security parameter to allow screen painting
  156. paintok := ("P" $ upper(sec_level))
  157.  
  158. //───── create multi-dimensional FIELDS array based on the fields
  159. //───── array you passed as a parameter
  160. if tfields_ != NIL
  161.    fields_ := aclone(tfields_)
  162.    //───── create array TFIELDS_ containing all fields in this database
  163.    stru_ := dbstruct()
  164.    num_flds := len(fields_)
  165.    for xx := 1 to num_flds
  166.       //───── find this field in the database
  167.       if (mfield := ascan(stru_, { | a | ;
  168.                     upper(a[DBS_NAME]) == upper(fields_[xx]) } ) )  > 0
  169.          fields_[xx] := stru_[mfield]
  170.       //───── uh oh, you called for a field that's not in the .dbf - boom!
  171.       else
  172.          return .f.
  173.       endif
  174.    next
  175. else
  176.    fields_ := dbstruct()
  177.    num_flds := len(fields_)
  178. endif
  179.  
  180. //───── create array heads_ (column headings) if necessary
  181. if heads_ == NIL
  182.    //───── dump all field names from array FIELDS_ into HEADS_
  183.    heads_ := {}
  184.    aeval(fields_, { | a | aadd(heads_, a[1]) } )
  185. endif
  186.  
  187. //───── create array pics_ (picture clauses) if necessary
  188. if pics_ == NIL
  189.    /*
  190.       okay - create the array and fill it with garbage hi bit ASCII
  191.       why?  because we must go through the following FOR..NEXT to
  192.       establish the array holding PICTURE lengths, regardless of
  193.       whether or not they passed the PICS_ array.  I didn't want to
  194.       duplicate the code because that is totally wasteful, so I resorted
  195.       to CHR(254) as an indicator that we had to create the array here.
  196.    */
  197.    pics_ := ARRAY(num_flds)
  198.    afill(pics_, chr(254))
  199. endif
  200.  
  201. /*
  202.    create PICLENS_ array to hold the length of each GET.
  203.    NOTE: because PICLENS_ is an external STATIC, it might still
  204.    have something in it from the last time we visited GrumpBrow().
  205.    Therefore, we will clean it out before proceeding.
  206. */
  207. asize(piclens_, 0)
  208. for xx = 1 to num_flds
  209.    do case
  210.  
  211.       case fields_[xx][DBS_TYPE] == 'D'
  212.          if pics_[xx] == chr(254)
  213.             pics_[xx] := "@D"
  214.          endif
  215.          aadd(piclens_, 8)
  216.  
  217.       case fields_[xx][DBS_TYPE] == 'M'
  218.          pics_[xx] := "<memo>"
  219.          aadd(piclens_, 6)
  220.  
  221.       case fields_[xx][DBS_TYPE] == 'C'
  222.          if pics_[xx] == chr(254)
  223.             //───── limit maximum width to 35 characters
  224.             if fields_[xx][DBS_LEN] > 35
  225.                pics_[xx] := "@S35"
  226.                aadd(piclens_, 35)
  227.             else
  228.                pics_[xx] := replicate("X", aadd(piclens_, fields_[xx][DBS_LEN]))
  229.             endif
  230.          else
  231.             aadd(piclens_, fields_[xx][DBS_LEN])
  232.          endif
  233.  
  234.       case fields_[xx][DBS_TYPE] == 'L'
  235.          if pics_[xx] == chr(254)
  236.             pics_[xx] := "Y"
  237.             aadd(piclens_, 1)
  238.          else
  239.             mid := pics_[xx]
  240.             aadd(piclens_, len(mid))
  241.          endif
  242.  
  243.       otherwise
  244.          if pics_[xx] == chr(254)
  245.             mid := str(fieldget(fieldpos(fields_[xx][DBS_NAME])))
  246.             if "." $ mid
  247.                pics_[xx] := replicate('9', at(".", mid) - 1) + "."
  248.                pics_[xx] += replicate('9', len(mid) - len(pics_[xx]))
  249.             else
  250.                pics_[xx] := replicate('9', len(mid))
  251.             endif
  252.          endif
  253.          aadd(piclens_, len(pics_[xx]))
  254.    endcase
  255. next
  256.  
  257. ColorSet(C_GRUMPBROW_BOX)
  258.  
  259. //───── create a browse object
  260. browse := TBrowseDB(ntop + 1, nleft + 1, nbottom - 1, nright - 1)
  261.  
  262. //───── save original movement blocks in case they need to be reset later
  263. oldgotop := browse:goTopBlock
  264. oldgobott := browse:goBottomBlock
  265. oldskip := browse:skipBlock
  266.  
  267. //───── set up movement blocks if hi/low values were passed as parameters
  268. if (hival != NIL .or. lowval != NIL) .and. ! empty(indexkey(0))
  269.    pseudofilt(browse, .f.)
  270. endif
  271.  
  272. browse:colorSpec := setcolor()
  273. browse:headSep := "═╤═"
  274. browse:colSep  := " │ "
  275. for xx = 1 to num_flds
  276.    /* memos must be treated differently */
  277.    if fields_[xx][DBS_TYPE] == "M"
  278.       column := TBColumnNew(heads_[xx], { | | "<memo>" } )
  279.    else
  280.       column := TBColumnNew(heads_[xx])
  281.       //───── handle picture clause for this column (if there is one)
  282.       if pics_[xx] == chr(254)               // no picture
  283.          column:block := fieldblock(fields_[xx][DBS_NAME])
  284.       else
  285.          //───── use TRANSFORM() to simulate PICTURE.
  286.          column:block := &("{ | | transform(" + fields_[xx][DBS_NAME] + ;
  287.                            ", '" + pics_[xx] + "') }")
  288.         /*
  289.            Now load cargo with a two element array.  Element 1
  290.            contains the "un-transformed" retrieval code block
  291.            for this field, and element 2 contains the desired
  292.            PICTURE clause.  These are used by GETNEW() when
  293.            editing a cell directly (see below).
  294.         */
  295.         column:cargo := { &("{ | x | if( pcount() == 0, " + ;
  296.                alias() + "->" + fields_[xx][DBS_NAME] + ", " + ;
  297.                alias() + "->" + fields_[xx][DBS_NAME] + " := x) }"), pics_[xx] }
  298.       endif
  299.    endif
  300.    * column:width := piclens_[xx]
  301.    browse:AddColumn( column )
  302. next
  303. if mbox
  304.    ShadowBox(ntop, nleft, nbottom, nright, 1)
  305.    mid := nleft + (int(nright - nleft) / 2)   // calculate midpoint
  306.    @ nbottom, mid - INT(LEN(options) / 2) ssay options
  307. else
  308.    @ maxrow(), int((maxcol() - LEN(options))/2) ssay options
  309. endif
  310. setcolor(maincolor)
  311. do while .t.
  312.    //───── do not allow cursor to move into frozen columns
  313.    if browse:colPos <= browse:freeze
  314.       browse:colPos := browse:freeze + 1
  315.    endif
  316.    dispbegin()
  317.    do while ! browse:stabilize() .and. (key := inkey()) == 0
  318.    enddo
  319.    dispend()
  320.    if browse:stable
  321.       //───── draw arrows if data off to left or right
  322.       //───── must take frozen columns into account
  323.       mrow := row()
  324.       mcol := col()
  325.       if browse:leftvisible > browse:freeze + 1
  326.          @ nbottom, nleft say chr(17) + chr(196) ;
  327.                           color colorset(C_GRUMPBROW_GET, .t.)
  328.       else
  329.          @ nbottom, nleft say if(mbox, chr(200)+chr(205), space(2)) ;
  330.                           color colorset(C_GRUMPBROW_BOX, .t.)
  331.       endif
  332.       if browse:rightvisible < browse:colCount
  333.          @ nbottom, nright - 1 say chr(196) + chr(16) ;
  334.                           color colorset(C_GRUMPBROW_GET, .t.)
  335.       else
  336.          @ nbottom, nright - 1 say if(mbox, chr(205)+chr(188), space(2)) ;
  337.                           color colorset(C_GRUMPBROW_BOX, .t.)
  338.       endif
  339.       setpos(mrow, mcol)
  340.       key := ginkey(0)
  341.    endif
  342.    do case
  343.  
  344.       case key == K_LEFT
  345.          browse:left()
  346.  
  347.       case key == K_RIGHT
  348.          browse:right()
  349.  
  350.       case key == K_UP
  351.          browse:up()
  352.  
  353.       case key == K_DOWN
  354.          browse:down()
  355.  
  356.       case key == K_PGUP .or. key == K_HOME
  357.          browse:pageUp()
  358.  
  359.       case key == K_PGDN .or. key == K_END
  360.          browse:pageDown()
  361.  
  362.       case key == K_CTRL_PGUP
  363.          browse:goTop()
  364.  
  365.       case key == K_CTRL_PGDN
  366.          browse:goBottom()
  367.  
  368.       case key == K_CTRL_LEFT
  369.          browse:panLeft()
  370.  
  371.       case key == K_CTRL_RIGHT
  372.          browse:panRight()
  373.  
  374.       case key == K_ESC
  375.          exit
  376.  
  377.       case key == K_ENTER .and. security[7] .and. browse:stable  // direct edit
  378.          //───── if they are on a memo, display it for viewing only
  379.          if fields_[browse:colPos][DBS_TYPE] == "M"
  380.             buffer := ShadowBox(8, 20, 16, 60, 2, ;
  381.                       fields_[browse:colPos][DBS_NAME])
  382.             memoedit(fieldget(fieldpos(fields_[browse:colPos][DBS_NAME])), ;
  383.                      9, 21, 15, 59, .F.)
  384.             ByeByeBox(buffer)
  385.          elseif security[3]        // must have Edit access to do this
  386.             if Rec_Lock()
  387.                //───── yank the current column object out of the browse object
  388.                column := browse:getColumn(browse:colPos)
  389.                //───── create a corresponding GET
  390.                setcursor(1)
  391.                //───── enable up/down arrow keys to exit the read
  392.                lreadexit := readexit(.t.)
  393.                /*
  394.                   Create corresponding GET object with GETNEW() and
  395.                   read it now. Note the use of the TBcolumn cargo instance
  396.                   variable.  Cargo is a two-element array.  The first
  397.                   element contains the retrieval code block for this
  398.                   data item.  The second contains the PICTURE clause.
  399.                   This was initialized above.
  400.                */
  401.                readmodal( { getnew(Row(), Col(), column:cargo[1], ;
  402.                         column:heading, column:cargo[2], browse:colorSpec) } )
  403.                setcursor(0)
  404.                readexit(lreadexit)
  405.                //───── check if this field is part of an active filter
  406.                if upper(column:heading) $ upper(dbfilter())
  407.                   //───── if so, see if filter condition is still fulfilled
  408.                   //───── if not, bounce record pointer so edited record
  409.                   //───── will no longer be displayed
  410.                   if ! eval( &("{ || " + dbfilter() + "}"))
  411.                      skip
  412.                      browse:refreshAll()
  413.                   else
  414.                      browse:refreshCurrent()
  415.                   endif
  416.                endif
  417.                //───── if this field is part of the active index, repaint
  418.                if upper(column:heading) $ upper(indexkey(0))
  419.                   browse:refreshAll()
  420.                else
  421.                   browse:refreshCurrent()
  422.                endif
  423.                //───── if we exited with an arrow key, pass it through
  424.                //───── and start editing same field in the next record
  425.                xx := lastkey()
  426.                if xx == K_UP .or. xx == K_DOWN
  427.                   keyboard chr(xx) + chr(K_ENTER)
  428.                endif
  429.                unlock
  430.             endif
  431.          endif
  432.  
  433.       case (key == 76 .or. key == 108)                 // lock columns
  434.          xx := browse:freeze
  435.          boxget xx prompt "Lock how many columns" picture '##'
  436.          if lastkey() != K_ESC
  437.             browse:freeze := xx
  438.             browse:invalidate()
  439.          endif
  440.  
  441.       case (key == 115 .or. key == 83) .and. security[5] .and. ;
  442.             type(indexkey(0)) == "C"                    // search
  443.          if ! override(alternate_[5], browse)
  444.             //───── save affected portion of top row of box
  445.             scrnbuff := savescreen(ntop, (maxcol() + 1)/2 - 11, ;
  446.                                    ntop, (maxcol() + 1)/2 +  10)
  447.             @ ntop, (maxcol() + 1) / 2 - 11 ssay "[" + space(20) + "]"
  448.             key := ginkey(0, "KEY")
  449.             searchstr := ''
  450.             do while ( (key > 31 .and. key < 255) .or. key == K_BS )
  451.                marker := recno()
  452.                if key == K_BS
  453.                   searchstr := substr(searchstr, 1, len(searchstr) - 1)
  454.                   if len(searchstr) > 0
  455.                      seek searchstr
  456.                   else
  457.                      searchstr := NIL
  458.                      exit
  459.                   endif
  460.                else
  461.                   seek searchstr + chr(key)
  462.                endif
  463.                if eof()
  464.                   go marker
  465.                else
  466.                   if key != K_BS
  467.                      searchstr += chr(key)
  468.                   endif
  469.                   @ ntop, (maxcol() + 1) / 2 - 10 ssay padc(searchstr, 20)
  470.                   //───── only refresh screen if record pointer moved
  471.                   if recno() != marker
  472.                      //───── save current record number... see below
  473.                      marker := recno()
  474.                      //───── force a redisplay
  475.                      dispbegin()
  476.                      browse:refreshAll()
  477.                      do while ! browse:stabilize()
  478.                      enddo
  479.                      /*
  480.                         Sometimes the refreshAll() method will not leave
  481.                         us on the correct record.  If this was the case,
  482.                         we'll move up until we get to the right record.
  483.                      */
  484.                      do while recno() != marker
  485.                         browse:up()
  486.                         skip -1
  487.                      enddo
  488.                      dispend()
  489.                   endif
  490.                endif
  491.                key := ginkey(0, "KEY")
  492.             enddo
  493.             restscreen(ntop, (maxcol() + 1)/2 - 11, ntop, ;
  494.                        (maxcol() + 1)/2 + 10, scrnbuff)
  495.             searchstr := NIL
  496.          else
  497.             browse:refreshAll()
  498.          endif
  499.  
  500.       case (key == 97 .or. key == 65) .and. security[1]    // Add record
  501.          if ! override(alternate_[1], browse)
  502.             gfbrecview('A', fields_, heads_, pics_)
  503.          endif
  504.          browse:refreshAll()
  505.  
  506.       case (key == 100 .or. key == 68) .and. security[2]  // delete record
  507.          if ! override(alternate_[2], browse)
  508.             if yes_no('This record will be deleted from the file',;
  509.                   'Do you want to do this')
  510.                if rec_lock()
  511.                   delete
  512.                   skip -1
  513.                   browse:refreshall()
  514.                   unlock
  515.                else
  516.                   err_msg(NETERR_MSG)
  517.                endif
  518.             endif
  519.          else
  520.             browse:refreshall()
  521.          endif
  522.       
  523.       case (key == 101 .or. key == 69) .and. security[3]  // edit record
  524.          if ! override(alternate_[3], browse)
  525.             gfbrecview('E', fields_, heads_, pics_)
  526.             browse:refreshCurrent()
  527.          else
  528.             browse:refreshAll()
  529.          endif
  530.       
  531. #ifdef REMBRANDT
  532.  
  533.       case (key == 112 .or. key == 80) .and. paintok      // screen painter
  534.          gfbrecview('S', fields_, heads_, pics_)
  535.  
  536. #endif
  537.  
  538.       case (key == 113 .or. key == 81) .and. security[4]  // query
  539.          if ! override(alternate_[4], browse)
  540.             keepgoing := .t.
  541.             if ! empty(qrystring)
  542.                if yes_no("Use most recent query search criteria")
  543.                   keepgoing := .f.
  544.                   marker := recno()
  545.                   continue
  546.                   if eof()
  547.                      err_msg("No more matches")
  548.                      go marker
  549.                   else
  550.                      browse:refreshAll()
  551.                   endif
  552.                endif
  553.             endif
  554.             if keepgoing
  555.                gfbrecview('Q', fields_, heads_, pics_)
  556.                browse:refreshAll()
  557.             endif
  558.          else
  559.             browse:refreshAll()
  560.          endif
  561.  
  562.       case (key == 118 .or. key == 86) .and. security[6]  // view
  563.          if ! override(alternate_[6], browse)
  564.             gfbrecview('V', fields_, heads_, pics_)
  565.          else
  566.             browse:refreshAll()
  567.          endif
  568.  
  569.       case key == K_ALT_I                          // switch index order
  570.          //───── first make sure that there is a second index!
  571.          if ! empty(indexkey(2))
  572.             set order to if(indexord() == 1, 2, 1)
  573.          endif
  574.          browse:refreshAll()
  575.  
  576.       case key == K_ALT_S                          // view subset
  577.          //───── first make sure there is an open index!
  578.          if ! empty(indexkey(0))
  579.             pseudofilt(browse, .t.)
  580.          endif
  581.  
  582.    endcase
  583. enddo
  584. GFRestEnv()
  585. set(_SET_SCOREBOARD, oldscore)
  586. return NIL
  587.  
  588. * end function GrumpBrow()
  589. *--------------------------------------------------------------------*
  590.  
  591.  
  592. /*
  593.    Override(): See if a procedure/function name was passed to override
  594.                the generic add/edit/delete/search routines -- if so,
  595.                and if it exists in the application, run that instead
  596.                of the generic routine
  597. */
  598. static function Override(melement, browse)
  599. local mproc, ret_val := .f., xx
  600. if ! empty(melement)
  601.    //───── first check if they specified a code block, and if so, evaluate
  602.    //───── the block passing the browse object as a parameter
  603.    if valtype(melement) == "B"
  604.       ret_val := .t.
  605.       eval(melement, browse)
  606.    else
  607.       if ! type(melement) $ 'UE'
  608.          ret_val := .t.
  609.          eval( &("{ | | " + melement + "}") )
  610.       endif
  611.    endif
  612. endif
  613. return ret_val
  614.  
  615. * end static function Override()
  616. *--------------------------------------------------------------------*
  617.  
  618. /*
  619.     GfbRecView(): The heart of the order, so to speak.  This is
  620.                   where all SAYs and GETs are SAID and GOTTEN
  621. */
  622. static function GfbRecView(mode, fields_, heads_, pics_)
  623. local scatter[len(fields_)], picstring, mstring, mfield, mrow, handle, ;
  624.       pic_len, xx, yy, marker, buffer, oldcolor, is_memo, mtype, key, ;
  625.       oldscrn := savescreen(0, 0, maxrow(), maxcol()), picclause, ;
  626.       getlist := {}, mscrnfile := alias() + '.gfs', mainloop := .t., ;
  627.       curr_fld, bytes := (maxrow() + 1) * (maxcol() + 1) * 2
  628. num_boxes := 0
  629. firstfield := 1
  630. setcolor(maincolor)
  631. cls
  632. if mode != "S"
  633.    @ 0, 2 ssay '[ ' + if(mode == 'Q', "Query database", ;
  634.             if(mode == 'A', "Add" , if(mode == "E", "Edit", "View")) + ;
  635.             "ing record") + ' ]'
  636. endif
  637. if mode $ "AEQ"
  638.    @ maxrow(), 25 ssay 'save edits'
  639.    @ maxrow(), 43 ssay 'exit without saving'
  640.    @ maxrow(), 18 ssay 'Ctrl-W' color 'I'
  641.    @ maxrow(), 39 ssay 'Esc' color 'I'
  642. endif
  643.  
  644. asize(gets_, 0)
  645.  
  646. //───── if we have a pre-saved screen file, read it in now
  647. if file(mscrnfile)
  648.    if ( handle := fopen(mscrnfile) ) == -1
  649.       err_msg("could not open " + mscrnfile)
  650.    else
  651.       buffer := space(bytes)
  652.       //───── first paint the static text by restoring the saved screen
  653.       fread(handle, @buffer, bytes)
  654.       restscreen(0, 0, maxrow(), maxcol(), buffer)
  655.       buffer := [ ]
  656.       //───── then read next byte, which will tell us how many fields
  657.       //───── are stored in this file
  658.       fread(handle, @buffer, 1)
  659.       num_flds := bin2i(buffer)
  660.       //───── now read in that number of fields - dynamically growing GETS_ array
  661.       for yy = 1 to num_flds
  662.          gfreadline(@buffer, handle)
  663.          aadd(gets_, { bin2i(substr(buffer, 1, 1)), ;   // row position
  664.                        bin2i(substr(buffer, 2, 1)), ;   // column position
  665.                        bin2i(substr(buffer, 3, 1)), ;   // row position
  666.                              substr(buffer, 4, 10), ;   // field name
  667.                              substr(buffer, 14)   } )   // PICTURE clause
  668.       next
  669.       num_flds := len(gets_)
  670.       //───── okay, now read next byte, which will tell us how many boxes
  671.       //───── are stored in this file  -- note that we are limited to 20
  672.       buffer := [ ]
  673.       fread(handle, @buffer, 1)
  674.       num_boxes := min(bin2i(buffer), 20)
  675.       buffer := space(14)
  676.       //───── now read in that number of boxes - dynamically growing BOXES_ array
  677.       asize(boxes_, 0)
  678.       for xx = 1 to num_boxes
  679.          fread(handle, @buffer, 14)
  680.          aadd(boxes_, { bin2i(substr(buffer, 1, 1)),  ;   // top row
  681.                         bin2i(substr(buffer, 2, 1)),  ;   // left column
  682.                         bin2i(substr(buffer, 3, 1)),  ;   // bottom row
  683.                         bin2i(substr(buffer, 4, 1)),  ;   // right column
  684.                               substr(buffer, 5, 8) ,  ;   // box string
  685.                         bin2i(substr(buffer, 13, 1)), ;   // box color
  686.                               substr(buffer, 14, 1) } )   // fill box? Y/N
  687.       next
  688.       fclose(handle)
  689.    endif
  690. endif
  691.  
  692. //───── determine topmost row at which to paint SAYs and GETs
  693. mrow := max(12 - int(num_flds / 2), 1)
  694. curr_fld := 1
  695. do while curr_fld <= num_flds .and. mainloop
  696.    if file(mscrnfile)
  697.       mfield := GetName(curr_fld)
  698.       pic_len := GetLength(curr_fld)
  699.       picclause := GetPicture(curr_fld)
  700.    else
  701.       mfield := fields_[curr_fld][DBS_NAME]
  702.       pic_len := piclens_[curr_fld]
  703.       picclause := pics_[curr_fld]
  704.    endif
  705.    mtype := type(mfield)
  706.  
  707.    //───── determine initial value for each get field
  708.    do case
  709.       //───── if you went nuts and changed the structure on me, there might
  710.       //───── be a field that is undefined.  Fortunately for you, Mr. Grump
  711.       //───── is here to protect you from the deadly DOS drop (but cut out
  712.       //───── your monkey business, because next time I might not be around)
  713.       case mtype == 'U'
  714.          err_msg(trim(mfield) + " is undefined - please delete the " + ;
  715.                  mscrnfile + " file")
  716.          restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  717.          return .f.
  718.  
  719.       case mtype == 'D'
  720.          scatter[curr_fld] := if(mode == "S", padr(mfield, 8), ;
  721.                         if(mode $ "AQ", ctod(''), fieldget(fieldpos(mfield))))
  722.       case mtype == 'M'
  723.          //───── embed an ascii 255 at the front of this -- we need this when
  724.          //───── in the get loop down below so that we know that this is a memo!
  725.          scatter[curr_fld] := if(mode == "S", padr(mfield, 6), chr(255) + ;
  726.                               if(mode $ "AMQ", [], fieldget(fieldpos(mfield))))
  727.       case mtype == 'C'
  728.          scatter[curr_fld] := if(mode == "S", padr(mfield, pic_len), ;
  729.                               if(mode $ "AQ", space(pic_len), ;
  730.                               fieldget(fieldpos(mfield))))
  731.       case mtype == 'L'
  732.          scatter[curr_fld] := if(mode == "S", substr(mfield, 1, 1), ;
  733.                               if(mode $ "AQ", .f., fieldget(fieldpos(mfield))))
  734.       otherwise
  735.          scatter[curr_fld] := if(mode == "S", padr(mfield, pic_len), ;
  736.                               if(mode $ "AQ", 0, fieldget(fieldpos(mfield))))
  737.    endcase
  738.  
  739.    //───── do generic says and gets only if we didn't use a pre-saved screen file
  740.    if ! file(mscrnfile)
  741.       @ curr_fld + mrow, 37 - len(heads_[curr_fld]) say heads_[curr_fld]
  742.       if mode == "S"
  743.          aadd(gets_, { curr_fld + mrow, 39, pic_len, mfield, picclause } )
  744.          setcolor("i")
  745.       endif
  746.       //───── if this is a memo field, we want to simply display the
  747.       //───── word "<memo>" (defined above as picstring) rather than
  748.       //───── showing the memo.  the memo will be displayed when they
  749.       //───── cursor to it.
  750.       if type(mfield) == "M"
  751.          @ curr_fld + mrow, 39 say "<memo>"
  752.       else
  753.          //───── truncate character fields that would spill off the right side
  754.          if type(mfield) == "C" .and. len(scatter[curr_fld]) > 40
  755.             @ curr_fld + mrow, 39 say substr(scatter[curr_fld], 1, 40) ;
  756.                                       picture picclause
  757.          else
  758.             @ curr_fld + mrow, 39 say scatter[curr_fld] picture picclause
  759.          endif
  760.       endif
  761.       if mode == "S"
  762.          setcolor(maincolor)
  763.       endif
  764.    else
  765.       //───── gotta display the fields in inverse for maintenance mode
  766.       if mode == "S"
  767.          setcolor("i")
  768.       endif
  769.       //───── pull get coordinates and info out of the GETS_ array
  770.       //───── note: if this is a memo field, we want to simply display the
  771.       //───── word "<memo>" rather than the memo
  772.       if type(mfield) == "M"
  773.          @ GetRow(curr_fld), GetCol(curr_fld) say "<memo>"
  774.       else
  775.          @ GetRow(curr_fld), GetCol(curr_fld) say scatter[curr_fld] ;
  776.                              picture picclause
  777.       endif
  778.       if mode == "S"
  779.          setcolor(maincolor)
  780.       endif
  781.    endif
  782.  
  783.    //───── we have either reached the last field or the bottom of the screen
  784.    //───── whichever came first -- time to stop for the pause that refreshes
  785.    if row() == maxrow() - 1 .or. curr_fld == num_flds
  786.       /*
  787.          GOINGDOWN is a flag that indicates in which direction we are
  788.          moving through the gets.  if it is true, then we are indeed
  789.          moving downward.  if false, we are moving upward.  it is
  790.          important only because when we escape from editing a memo,
  791.          we will not know where to go unless we have such a flag.
  792.          trust me -- i went through all kinds of gyrations on this one.
  793.       */
  794.       goingdown := .t.
  795.       do case
  796.  
  797. #ifdef REMBRANDT
  798.          case mode == "S"
  799.             gfbmaint()
  800.             //───── we must force an exit from the main loop or else
  801.             //───── the sucker will bomb horribly
  802.             mainloop := .f.
  803. #endif
  804.  
  805.          case mode != "V"
  806.             setcursor(1)
  807.             setkey(K_UP, {|p, l, v| gfbackaget(p, l, v) } )
  808.             setkey(K_DOWN, {|p, l, v| gfskipaget(p, l, v) } )
  809.             for curr_get = firstfield to curr_fld
  810.                /*
  811.                   now for the tricky part - figuring out if this is a memo.
  812.                   memos will look like character strings, but since we were
  813.                   thoughtful enough to embed the chr(255), that will assist
  814.                   us in making the determination now
  815.                */
  816.                is_memo := if(valtype(scatter[curr_get]) != "C", .f., ;
  817.                           substr(scatter[curr_get], 1, 1) == chr(255))
  818.                if ! is_memo
  819.                   if ! file(mscrnfile)
  820.                      //───── truncate characters that would spill off right side
  821.                      if valtype(scatter[curr_get]) == "C" .and. ;
  822.                                        len(pics_[curr_get]) > 40
  823.                         @ curr_get + mrow, 39 get scatter[curr_get] ;
  824.                                       picture "@S40 " + pics_[curr_get]
  825.                      else
  826.                         @ curr_get + mrow, 39 get scatter[curr_get] ;
  827.                                                 picture pics_[curr_get]
  828.                      endif
  829.                   else
  830.                      @ GetRow(curr_get), GetCol(curr_get) get ;
  831.                             scatter[curr_get] picture GetPicture(curr_get)
  832.                   endif
  833.                   read
  834.                   //───── check last keypress
  835.                   key := lastkey()
  836.                   do case
  837.  
  838.                      /* proceed downward */
  839.                      case key == K_ENTER .and. goingdown
  840.                         goingdown := .t.
  841.  
  842.                      /* jump to end of this screen */
  843.                      case key == K_PGDN
  844.                         curr_get := curr_fld
  845.  
  846.                      /* back to first get */
  847.                      case key == K_PGUP
  848.                         curr_get := firstfield - 1
  849.  
  850.                      /* (save and then) fall out */
  851.                      case key == K_CTRL_W .or. key == K_ESC
  852.                         mainloop := .f.          // force exit from main loop
  853.                         curr_get := curr_fld     // force exit from this loop
  854.                   endcase
  855.                else
  856.                   buffer := shadowbox(mrow + curr_get, 20, ;
  857.                                       mrow + curr_get + 4, 60, 2)
  858.                   @ mrow+curr_get+4, 25 ssay "Ctrl-W to save, or Esc to exit"
  859.                   //───── undefine left and right arrows for the memoedit
  860.                   setkey(K_UP, NIL)
  861.                   setkey(K_DOWN, NIL)
  862.                   scatter[curr_get] := chr(255) + ;
  863.                       memoedit(substr(scatter[curr_get], 2), mrow + ;
  864.                       curr_get + 1, 21, mrow + curr_get + 3, 59, .t.)
  865.                   //───── okay, now define them again
  866.                   setkey(K_UP, {|p, l, v| gfbackaget(p, l, v) } )
  867.                   setkey(K_DOWN, {|p, l, v| gfskipaget(p, l, v) } )
  868.                   if lastkey() == K_ESC .and. ! goingdown
  869.                      gfbackaget()
  870.                   endif
  871.                   byebyebox(buffer)
  872.                endif
  873.             next
  874.             setcursor(0)
  875.             //───── undefine left and right arrows for the memoedit
  876.             setkey(K_UP, NIL)
  877.             setkey(K_DOWN, NIL)
  878.          otherwise
  879.             ginkey(0)
  880.       endcase
  881.       mrow -= (BottomRow - TopRow) - 1
  882.       //───── if we still have another pageful of gets to get,
  883.       //───── then by all means clear out the previous bunch
  884.       if mainloop .and. curr_fld != num_flds
  885.          firstfield := curr_fld + 1
  886.          scroll(TopRow + 1, LeftColumn + 1, BottomRow - 1, RightColumn - 1, 0)
  887.       endif
  888.    endif
  889.    curr_fld++
  890. enddo
  891. clear gets
  892. if lastkey() != K_ESC .and. mode $ "AEQ"
  893.    if mode == 'Q'                                 // query-by-example
  894.       //───── loop through all fields and build the query string
  895.       qrystring := []
  896.       for xx = 1 to curr_fld - 1
  897.          mfield := if(file(mscrnfile), GetName(xx), fields_[xx][DBS_NAME])
  898.          mtype := type(mfield)
  899.          //───── first get rid of the dratted chr(255) littering the front of a memo
  900.          if ( mtype := type(mfield) ) == "M"
  901.             scatter[xx] := substr(scatter[xx], 2)
  902.          endif
  903.          if ! empty(scatter[xx])
  904.             do case
  905.                case mtype == "N"
  906.                   picstring := mfield + " == " + ltrim(str(scatter[xx]))
  907.                case mtype == "L"
  908.                   picstring := if(! scatter[xx], "! ", "") + mfield
  909.                case mtype == "D"
  910.                   picstring := mfield + " == ctod('" + dtoc(scatter[xx]) + "')"
  911.                otherwise
  912.                   /*
  913.                      if user specified "..whatever.." in character field,
  914.                      then they want to find the first occurrence containing
  915.                      wwhatever; consequently, we must first check for this
  916.                      situation by looking for two periods
  917.                   */
  918.                   if substr(scatter[xx], 1, 2) == '..'
  919.                      picstring := 'upper([' + ;
  920.                                   trim(strtran(scatter[xx], '..', '')) + ;
  921.                                   ']) $ upper(' + mfield + ')'
  922.                   else
  923.                      //───── note the case-insensitive search - feel free to
  924.                      //───── change this if you need to by stripping out the
  925.                      //───── references to "UPPER("
  926.                      picstring := "upper(" + mfield + ") = [" + ;
  927.                                    upper(trim(scatter[xx])) + "]"
  928.                   endif
  929.             endcase
  930.             qrystring += if(! empty(qrystring), " .and. ", "") + picstring
  931.          endif
  932.       next
  933.       marker := recno()
  934.       if ! empty(qrystring)
  935.          //───── compile this string to a code block, which will speed up the
  936.          //───── process a tad over the traditional macro expansion rigmarole
  937.          qrystring := MakeBlock(qrystring)
  938.          locate for eval(qrystring) while inkey() == 0
  939.          if eof()
  940.             err_msg("No match found")
  941.             go marker
  942.          endif
  943.       endif
  944.    else     && add/edit mode: gather memory variables back into fields
  945.       if yes_no(if(mode == "A", "Add this new record", "Save your edits"))
  946.          if if(mode == "A", Add_Rec(), Rec_Lock())
  947.             for xx = 1 to curr_fld - 1
  948.                mfield := if(file(mscrnfile), GetName(xx), fields_[xx][DBS_NAME])
  949.                //───── note: memos will still have a chr(255) stuck on the front
  950.                //───── and we do not want to save that, so let's act accordingly
  951.                if type(mfield) == "M"
  952.                   fieldput(fieldpos(mfield), substr(scatter[xx], 2))
  953.                else
  954.                   fieldput(fieldpos(mfield), scatter[xx])
  955.                endif
  956.             next
  957.          endif
  958.       endif
  959.    endif
  960. endif
  961. unlock
  962. restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  963. return NIL
  964.  
  965. * end static function GFBRecView()
  966. *--------------------------------------------------------------------*
  967.  
  968.  
  969. /*
  970.    GfBackAGet(): trap up arrow in the READ to
  971.                  move back up by one GET
  972. */
  973. static function gfbackaget(p, l, v)
  974. curr_get := max(curr_get - 2, firstfield - 1)
  975. /*
  976.    we might have gotten here in one of two ways:
  977.    (a) up arrow, in which case there would have
  978.        been three parameters passed
  979.    (b) direct call when escaping from a memofield
  980.        and moving upwards through the get list
  981.    we only need to stuff the keyboard in the first situation
  982. */
  983. if pcount() == 3
  984.    keyboard chr(K_ENTER)
  985. endif
  986. goingdown := .f.
  987. return NIL
  988.  
  989. * end static function GFBackAGet()
  990. *--------------------------------------------------------------------*
  991.  
  992.  
  993. /*
  994.    GfSkipAGet(): trap down arrow in the READ to
  995.                  move down one GET
  996. */
  997. static function gfskipaget(p, l, v)
  998. keyboard chr(K_ENTER)
  999. goingdown := .t.
  1000. return NIL
  1001.  
  1002. * end static function GFSkipAGet()
  1003. *--------------------------------------------------------------------*
  1004.  
  1005.  
  1006. #ifdef REMBRANDT
  1007.  
  1008. /*
  1009.    GfbMaint(): The Long-Awaited Screen Painter
  1010. */
  1011. static function gfbmaint
  1012. local key := 0, mrow := 0, mcol := 0, mfile, buffer, xx, yy, zz, mstart, ;
  1013.       nleft, nbottom, nright, oldf1, handle, mfield, mstring, mtype, ngets, ;
  1014.       oldinsert := readinsert(.f.), mcolor, oldprintf, oldconsole, ;
  1015.       firstfield, bytes := (maxrow() + 1) * (maxcol() + 1) * 2, getlist := {}
  1016.  
  1017. //───── disable f1 key so that they will only get my help screen!
  1018. oldf1 := setkey(K_F1, nil)
  1019. setcursor(1)
  1020. do while key != K_F10
  1021.    //───── show current screen position at top right corner
  1022.    @ 0, maxcol() - 6 ssay padr(ltrim(str(mrow, 2)) + ', ' + ;
  1023.                          ltrim(str(mcol, 3)), 7)
  1024.    setpos(mrow, mcol)
  1025.    key := ginkey(0)
  1026.    do case
  1027.  
  1028.       //───── help!
  1029.       case key == K_ALT_H .or. key == K_F1
  1030.          gfbhelpme()
  1031.  
  1032.       //───── alphanumeric or something printable
  1033.       case key > 31 .and. key < 255
  1034.          if isitaget(mrow, mcol)
  1035.             err_msg("You cannot type over a GET")
  1036.          else
  1037.             //───── if insert mode is on, push everything else on this row over
  1038.             if readinsert()
  1039.                /*
  1040.                   we don't want to move any gets, but how to do this?
  1041.                   simple... we jump merrily through every character on
  1042.                   this row and check for its color.  if its color is
  1043.                   inverse (112), then we know it must be a get and we
  1044.                   skip it.
  1045.                */
  1046.                mstart := 0
  1047.                for xx = 0 to maxcol() - mcol
  1048.                   if isitaget(mrow, mcol + xx)
  1049.                      restscreen(mrow, mcol + mstart + 1, mrow, mcol + xx - 1, ;
  1050.                           savescreen(mrow, mcol + mstart, mrow, mcol + xx - 2))
  1051.                      //───── now loop through until we find the next non-get
  1052.                      do while xx++ < maxcol() + 1 - mcol .and. ;
  1053.                                      isitaget(mrow, mcol+xx)
  1054.                      enddo
  1055.                      mstart := xx
  1056.                   endif
  1057.                next
  1058.  
  1059.                //───── if there were no gets, mstart will still be zero.
  1060.                if mstart == 0
  1061.                   restscreen(mrow, mcol + 1, mrow, maxcol(), ;
  1062.                              savescreen(mrow, mcol, mrow, maxcol() - 1))
  1063.                endif
  1064.             endif
  1065.             @ mrow, mcol ssay chr(key)
  1066.             if mcol == maxcol()
  1067.                /*
  1068.                    Because Clipper 5 doesn't assume a fixed screen of
  1069.                    25 rows x 80 columns, it allows you to keep typing
  1070.                    off the right side of the screen.  Therefore, we
  1071.                    must restrict this sort of nonsense ourselves by
  1072.                    forcing a wrap from the bottom row to the top.
  1073.                */
  1074.                if mrow == maxrow()
  1075.                   mrow := 0
  1076.                else
  1077.                   mrow++
  1078.                endif
  1079.                mcol := 0
  1080.             else
  1081.                mcol++
  1082.             endif
  1083.          endif
  1084.  
  1085.       //───── move a field or resize a box
  1086.       case key == K_ENTER
  1087.          if isitaget(mrow, mcol)
  1088.             if gfbmovefld()
  1089.                mrow := row()
  1090.                mcol := col()
  1091.                //───── let's re-sort the gets_ array so that they will fall in the
  1092.                //───── order that they appear on the screen (rather than how they
  1093.                //───── appear in the .dbf)
  1094.                asort(gets_,,, { | x, y | if(x[1] == y[1], ;
  1095.                                x[2] < y[2], x[1] < y[1] ) } )
  1096.             endif
  1097.          else
  1098.             //───── are we on a box outline?? only the shadow knows
  1099.             if num_boxes > 0
  1100.                if ( xx := isitabox() ) > 0
  1101.                   boxes_[xx] := gfbsizebox(xx)
  1102.                endif
  1103.             endif
  1104.          endif
  1105.  
  1106.       case key == K_BS .and. mcol > 0
  1107.          mcol--
  1108.          //───── wipe out this space if we are not on a get
  1109.          if ! isitaget(mrow, mcol)
  1110.             @ mrow, mcol ssay [ ]
  1111.          endif
  1112.          setpos(mrow, mcol)
  1113.  
  1114.       case key == K_DEL
  1115.          //───── first check if we are on a box outline
  1116.          if ( xx := isitabox() ) > 0
  1117.             if yes_no("Are you sure you want to delete this box")
  1118.                //───── wipe it off the screen
  1119.                @ BoxTop(xx), BoxLeft(xx), BoxBottom(xx), BoxRight(xx) ;
  1120.                  box space(8)
  1121.                //───── then blast it from the array
  1122.                adel(boxes_, xx)
  1123.                //───── finally, resize box array and decrement box counter
  1124.                asize(boxes_, --num_boxes)
  1125.             endif
  1126.          //───── next check if we are on a get field
  1127.          elseif isitaget(mrow, mcol)
  1128.             if yes_no("Are you sure you want to delete this field")
  1129.                //───── first find this element
  1130.                xx := gfbwhichget(mrow, mcol)
  1131.                if xx > 0
  1132.                   //───── wipe it off the screen
  1133.                   scroll(GetRow(xx), GetCol(xx), GetRow(xx), GetCol(xx) + ;
  1134.                          GetLength(xx) - 1, 0)
  1135.                   //───── blast it out of the array
  1136.                   adel(gets_, xx)
  1137.                   //───── finally, resize box array and decrement box counter
  1138.                   asize(gets_, --num_flds)
  1139.                endif
  1140.             endif
  1141.          else
  1142.             /*
  1143.                note that we don't want to move any gets, so we must check
  1144.                each character on this row to see if it is part of a get.
  1145.                however, so that we do not have to go through this loop
  1146.                on lines without gets, we do a quick scan of the array
  1147.                to see if there is a get on this row
  1148.             */
  1149.             xx := ascan(gets_, { | a | a[1] == mrow} )
  1150.             if xx > 0      // yes, there is at least one get on this row
  1151.                mstart := 0
  1152.                for xx = 0 to maxcol() - mcol
  1153.                   if isitaget(mrow, mcol + xx)
  1154.                      restscreen(mrow, mcol + mstart, mrow, mcol + xx - 2, ;
  1155.                        savescreen(mrow, mcol + mstart + 1, mrow, mcol + xx - 1))
  1156.                      @ mrow, mcol + xx - 1 ssay [ ]
  1157.                      //───── now loop through until we find the next non-get
  1158.                      do while xx++ < maxcol() + 1 - mcol .and. ;
  1159.                                      isitaget(mrow, mcol+xx)
  1160.                      enddo
  1161.                      mstart := xx
  1162.                   endif
  1163.                next
  1164.             else       // no gets on this row
  1165.                restscreen(mrow, mcol, mrow, maxcol() - 1, ;
  1166.                           savescreen(mrow, mcol + 1, mrow, maxcol()))
  1167.                @ mrow, maxcol() ssay [ ]
  1168.             endif
  1169.          endif
  1170.  
  1171.       //───── toggle insert mode
  1172.       case key == K_INS
  1173.          setcursor( if( readinsert(! readinsert()), 1, 3) )
  1174.  
  1175.       //───── color palette to change active color
  1176.       case key == K_ALT_P
  1177.          setcolor(colorpal())
  1178.  
  1179.       //───── draw box
  1180.       case key == K_ALT_B
  1181.          gfbdrawbox(mrow, mcol)
  1182.  
  1183.  
  1184. #ifdef CODEGEN
  1185.  
  1186.       //───── generate code
  1187.       case key == K_SH_F10
  1188.                mfile := upper(alias()) + ".prg"
  1189.          if if(! file(mfile), .t., yes_no(mfile + " already exists", "Overwrite it"))
  1190.             buffer := savescreen(0, 0, maxrow(), maxcol())
  1191.             dispbegin()
  1192.             gfbcleanup()
  1193.             oldprintf := set(_SET_PRINTFILE, mfile)
  1194.             set print on
  1195.  
  1196.             //───── first, get rid of position indicator so it doesn't get
  1197.             //───── stuck in the generated code (gasp!)
  1198.             scroll(0, maxcol() - 6, 0, maxcol(), 0)
  1199.  
  1200.             //───── next, let's get rid of the boxes so that they don't get
  1201.             //───── displayed as part of the text
  1202.             for xx = 1 to num_boxes
  1203.                @ BoxTop(xx), BoxLeft(xx), BoxBottom(xx), BoxRight(xx) box space(8)
  1204.             next
  1205.             oldconsole := set(_SET_CONSOLE, .F.)
  1206.             //───── next, get rid of
  1207.             //───── standard header -- change it as you see fit
  1208.             QOut("/*")
  1209.             QOut(INDENT(1) + "Program: " + mfile)
  1210.             QOut(INDENT(1) + "Date:    " + dtoc(date()))
  1211.             QOut(INDENT(1) + "Time:    " + time())
  1212.             QOut(INDENT(1) + "Dialect: Clipper 5.01")
  1213.             QOut(INDENT(1) + "Generated by GrumpBrow()")
  1214.             QOut(INDENT(1) + "Copyright (c) 1990 Greg Lief")
  1215.             QOut(INDENT(1) + "Notes: data entry screen for " + alias() + ".dbf")
  1216.             QOut(INDENT(1) + "expects to be passed a parameter (mode),")
  1217.             QOut(INDENT(1) + "which could be either [A]dd, [E]dit, [V]iew")
  1218.             QOut("*/")
  1219.             QOut()
  1220.             QOut('#include "inkey.ch"')
  1221.             //───── must maintain a counter separate from XX, because
  1222.             //───── if we skip any memos the counter value will be off
  1223.             //───── in the generated code, and chaos will ensue...
  1224.             yy := 0
  1225.             ngets := len(gets_)
  1226.             for xx = 1 to ngets
  1227.                if type(GetName(xx)) != "M"
  1228.                   QOut("#define m" + padr(GetName(xx), 12) + " scatter_[" + ;
  1229.                        ltrim(str(++yy)) + "]")
  1230.                endif
  1231.             next
  1232.             QOut()
  1233.             QOut("function addedit(mode)")
  1234.             QOut("memvar getlist")
  1235.             QOut("local scatter_ := {}, oldcurs, marker")
  1236.             QOut("local fieldnames_ := { ")
  1237.             firstfield := .t.
  1238.             for xx = 1 to ngets
  1239.                if type(GetName(xx)) != "M"
  1240.                   if firstfield
  1241.                      firstfield := .f.
  1242.                   else
  1243.                      QQOut(", ;")
  1244.                      QOut(space(23))
  1245.                   endif
  1246.                   QQOut("'" + trim(GetName(xx)) + "'")
  1247.                endif
  1248.             next
  1249.             QQOut("}")
  1250.             QOut("use " + alias())
  1251.             QOut()
  1252.             QOut("//───── static text")
  1253.             //───── draw the boxes, dude (in Saudi Arabia, "dude" means "worm",
  1254.             //───── so that was not necessarily a term of endearment)
  1255.             for xx = 1 to num_boxes
  1256.                QOut("@ " + ltrim(str(BoxTop(xx)))  + ", " + ;
  1257.                            ltrim(str(BoxLeft(xx))) + ", " + ;
  1258.                            ltrim(str(BoxBottom(xx))) + ", " + ;
  1259.                            ltrim(str(BoxRight(xx))) + " box '" + BoxString(xx) + ;
  1260.                            if(BoxFill(xx) == "Y", " ", "") + ;
  1261.                            "' color '" + color_n2s(BoxColor(xx)) + "'")
  1262.             next
  1263.             //───── now draw all other text
  1264.             QOut("setcolor('" + maincolor + "')")
  1265.             for xx = 0 to maxrow()
  1266.                mstring := [ ]
  1267.                yy := 0
  1268.                do while yy <= maxcol() .and. asc(TextAt(xx, yy)) < 33
  1269.                   yy++
  1270.                enddo
  1271.                if yy <= maxcol()
  1272.                   do while yy <= maxcol()
  1273.                      mstring := TextAt(xx, yy)
  1274.                      mcolor := ColorAt(xx, yy)
  1275.                      zz := yy + 1
  1276.                      do while ColorAt(xx, zz) == mcolor .and. zz <= maxcol()
  1277.                         mstring += TextAt(xx, zz)
  1278.                         zz++
  1279.                      enddo
  1280.                      if ! empty(mstring)
  1281.                         if color_s2n(maincolor) != bin2i(mcolor)
  1282.                            maincolor := color_n2s(mcolor)
  1283.                            QOut("setcolor('" + maincolor + "')")
  1284.                         endif
  1285.                         QOut("@ " + str(xx, 2) + ", " + str(yy, 2) + ;
  1286.                                   " say [" + trim(mstring) + "]")
  1287.                      endif
  1288.                      yy := zz
  1289.                   enddo
  1290.                endif
  1291.             next
  1292.  
  1293.             QOut()
  1294.             QOut("//───── use phantom record to grab initial values if adding")
  1295.             QOut("if mode == 'A'")
  1296.             QOut(INDENT(1) + "marker := recno()")
  1297.             QOut(INDENT(1) + "go 0")
  1298.             QOut("endif")
  1299.             QOut()
  1300.             QOut("//───── initialize memory variables")
  1301.             QOut("aeval(fieldnames_, { | a | aadd(scatter_, " + ;
  1302.                  "fieldget(fieldpos(a))) } )")
  1303.  
  1304.             /* do the gets */
  1305.             QOut()
  1306.             QOut("//───── go GET 'em")
  1307.             for xx = 1 to ngets
  1308.                if type(GetName(xx)) != "M"
  1309.                   QOut("@ " + str(GetRow(xx), 2) + ", " + ;
  1310.                        str(GetCol(xx), 2) + " get m" + GetName(xx) + ;
  1311.                        " picture '" + GetPicture(xx) + "'")
  1312.                endif
  1313.             next
  1314.  
  1315.             /* basic stuff */
  1316.             QOut("oldcurs := setcursor(if(mode == 'V', 0, 1))")
  1317.             QOut("if mode != 'V'")
  1318.             QOut(INDENT(1) + "read")
  1319.             /* do the replaces */
  1320.             QOut(INDENT(1) + "//───── do the replaces if they didn't escape out")
  1321.             QOut(INDENT(1) + "if lastkey() != K_ESC")
  1322.             QOut(INDENT(2) + "if mode == 'A'")
  1323.             QOut(INDENT(3) + "append blank")
  1324.             QOut(INDENT(2) + "endif")
  1325.             QOut(INDENT(2) + "aeval(fieldnames_, { | a, x | " + ;
  1326.                           "fieldput(fieldpos(a), scatter_[x]) } )")
  1327.             QOut(INDENT(1) + "//───── if in add mode, reset record pointer")
  1328.             QOut(INDENT(1) + "elseif mode == 'A'")
  1329.             QOut(INDENT(2) + "go marker")
  1330.             QOut(INDENT(1) + "endif")
  1331.             QOut("else")
  1332.             QOut(INDENT(1) + "getlist := {}")
  1333.             QOut(INDENT(1) + "inkey(0)")
  1334.             QOut("endif")
  1335.             QOut("setcursor(oldcurs)")
  1336.             QOut("return NIL")
  1337.             QOut()
  1338.             QOut("* end of file " + mfile)
  1339.  
  1340.             set print off
  1341.             set(_SET_PRINTFILE, oldprintf)
  1342.             set(_SET_CONSOLE, oldconsole)
  1343.             restscreen(0, 0, maxrow(), maxcol(), buffer)
  1344.             dispend()
  1345.             waiton("Code successfully generated to " + mfile)
  1346.             inkey(1)
  1347.             waitoff()
  1348.          endif
  1349.  
  1350. #endif // CODEGEN
  1351.  
  1352.       case key == K_ESC
  1353.          if yes_no('Your changes will be lost','Are you sure you want to exit')
  1354.             exit
  1355.          endif
  1356.  
  1357.       otherwise
  1358.          gfarrowkey(key, maxcol(), @mrow, @mcol)
  1359.  
  1360.    endcase
  1361. enddo
  1362. setkey(K_F1, oldf1)     // re-enable f1 key to whatever it was before this
  1363. readinsert(oldinsert)
  1364.  
  1365. if key != K_ESC
  1366.    gfbcleanup()
  1367.    mfile := alias() + ".gfs"
  1368.    if ( handle := fcreate(mfile) ) == -1
  1369.       err_msg("Could not create " + mfile)
  1370.    else
  1371.       if fwrite(handle, ;
  1372.                 savescreen(0, 0, maxrow(), maxcol()), bytes) != bytes
  1373.          err_msg("Error writing to " + mfile)
  1374.       endif
  1375.       //───── save number of fields
  1376.       fwrite(handle, chr(num_flds))
  1377.       ngets := len(gets_)
  1378.       for xx = 1 to ngets
  1379.          fwrite(handle, chr(GetRow(xx)) + chr(GetCol(xx)) + ;
  1380.                         chr(GetLength(xx)) + padr(GetName(xx), 10)  + ;
  1381.                         GetPicture(xx) + CRLF)
  1382.       next
  1383.       //───── save number of boxes
  1384.       fwrite(handle, chr(num_boxes))
  1385.       if num_boxes > 0
  1386.          for xx = 1 to num_boxes
  1387.             fwrite(handle, chr(BoxTop(xx)) + chr(BoxLeft(xx)) + ;
  1388.                     chr(BoxBottom(xx)) + chr(BoxRight(xx)) + ;
  1389.                     BoxString(xx) + chr(BoxColor(xx)) + BoxFill(xx) )
  1390.          next
  1391.       endif
  1392.       fclose(handle)
  1393.    endif
  1394. endif
  1395. setcursor(0)
  1396. return NIL
  1397.  
  1398. * end static function GFBMaint()
  1399. *--------------------------------------------------------------------*
  1400.  
  1401.  
  1402. /*
  1403.    GfbCleanup(): clear GET fields in preparation for
  1404.                  saving .GFS file or generating code
  1405. */
  1406. static function gfbcleanup
  1407. local xx, ngets := len(gets_)
  1408. //───── we must go through the gets_ array and wipe all inverse
  1409. //───── gets off the screen -- if we leave them here, they will be
  1410. //───── restored when adding/editing only to be wiped out again,
  1411. //───── which creates an annoying little visual blip.
  1412. setcolor(maincolor)
  1413. for xx = 1 to ngets
  1414.    //───── if we have more than one screen of gets, we must add error-
  1415.    //───── trapping here so that the thing don't crash!!
  1416.    if valtype(gets_[xx]) == "U"
  1417.       exit
  1418.    else
  1419.       scroll(GetRow(xx), GetCol(xx), GetRow(xx), GetCol(xx) + ;
  1420.              GetLength(xx) - 1, 0)
  1421.    endif
  1422. next
  1423. //───── get rid of the coordinates at the top right corner
  1424. scroll(0, maxcol() - 6, 0, maxcol(), 0)
  1425. return nil
  1426.  
  1427. * end static function GFBCleanUp()
  1428. *--------------------------------------------------------------------*
  1429.  
  1430.  
  1431. /*
  1432.    GfbHelpMe(): help screen for screen painting module
  1433. */
  1434. static function gfbhelpme
  1435. gfsaveenv(.t., 0, '+w/b')          // shut off cursor & change color
  1436. @ 0, 0, maxrow(), maxcol() box BOXFRAMES[5] color "+gr/b"
  1437. @ 1, 19 ssay "GRUMPBROWSE() SCREEN PAINTER - ACTIVE KEYS" color "+gr/b"
  1438. @ 2, 16 ssay "draw box"
  1439. @ 3, 16 ssay "change color"
  1440. @ 4, 16 ssay "toggle insert mode on/off"
  1441. @ 5, 16 ssay "destructive backspace"
  1442. @ 6, 16 ssay "delete from cursor position"
  1443. @ 7, 16 ssay "exit without saving changes"
  1444. @ 8, 16 ssay "save screen file (.gfs) and exit"
  1445. @ 9, 16 ssay "generate code for this screen and exit"
  1446. @11, 16 ssay "move left one column"
  1447. @11, 54 ssay "move right one column"
  1448. @12, 16 ssay "move to top left"
  1449. @12, 54 ssay "move to bottom right"
  1450. @13, 16 ssay "move right five columns"
  1451. @13, 54 ssay "move left five columns"
  1452. @14, 16 ssay "move to top row"
  1453. @14, 54 ssay "move to bottom row"
  1454. @15, 16 ssay "move to left column"
  1455. @15, 54 ssay "move to right column"
  1456. @17, 4 ssay "Boxes may be filled or unfilled.  If you create a filled box, any text"
  1457. @18, 4 ssay "underneath it will be pulled in, and will be displayed in the color of"
  1458. @19, 4 ssay "the box.  To delete a box, place the cursor on it outline and press"
  1459. @20, 4 ssay "delete. to resize a box, place the cursor on it and press Enter.  To"
  1460. @21, 4 ssay "delete a GET, place the cursor on it and press Delete.  To move a get,"
  1461. @22, 4 ssay "place the cursor on it and press Enter."
  1462. @23, 20 ssay "press any key to return to screen painter"
  1463. setcolor("i")
  1464. @ 2,  4 ssay "Alt-B"
  1465. @ 3,  4 ssay "Alt-P"
  1466. @ 4,  4 ssay "Insert"
  1467. @ 5,  4 ssay "Backspace"
  1468. @ 6,  4 ssay "Delete"
  1469. @ 7,  4 ssay "Esc"
  1470. @ 8,  4 ssay "F10"
  1471. @ 9,  4 ssay "Shift-F10"
  1472. @11,  4 ssay "LtArrow"
  1473. @11, 42 ssay "RtArrow"
  1474. @12,  4 ssay "Home"
  1475. @12, 42 ssay "End"
  1476. @13,  4 ssay "Tab"
  1477. @13, 42 ssay "Shift-Tab"
  1478. @14,  4 ssay "PgUp"
  1479. @14, 42 ssay "PgDn"
  1480. @15,  4 ssay "Ctrl-Left"
  1481. @15, 42 ssay "Ctrl-Right"
  1482. ginkey(0)
  1483. gfrestenv()
  1484. return nil
  1485.  
  1486. * end static function GFBHelpMe()
  1487. *--------------------------------------------------------------------*
  1488.  
  1489.  
  1490. /*
  1491.    GfbMoveFld(): logic to drag a field around on the screen
  1492. */
  1493. static function gfbmovefld
  1494. local oldcolor, xx, mrow, mcol, mlength, key, yy, buffer,  ;
  1495.       buffer2, ret_val := .f.
  1496. oldcolor := setcolor()
  1497. xx := gfbwhichget(row(), col())
  1498. if xx > 0
  1499.    mrow  := GetRow(xx)
  1500.    mcol  := GetCol(xx)
  1501.    mlength := GetLength(xx)
  1502.    key := 0
  1503.    //───── initialize a scrap buffer which will hold the underlying
  1504.    //───── screen area as we drag the field around.  if we did not
  1505.    //───── do this, then the field would act as a giant erase,
  1506.    //───── annihilating static text (and other fields) in its wake!
  1507.    buffer := []
  1508.    for yy = 2 to mcol + mlength
  1509.       buffer += chr(32) + chr(23)
  1510.    next
  1511.    buffer2 := savescreen(mrow, mcol, mrow, mcol + mlength - 1)
  1512.    do while key != K_ENTER .and. key != K_ESC
  1513.       @ 0, maxcol() - 6 ssay padr(ltrim(str(mrow, 2)) + ', ' + ;
  1514.                          ltrim(str(mcol, 3)), 7)
  1515.       setpos(mrow, mcol)
  1516.       key := ginkey(0)
  1517.       if key != K_ENTER .and. key != K_ESC
  1518.          setcolor(oldcolor)
  1519.          dispbegin()
  1520.          restscreen(mrow, mcol, mrow, mcol + mlength - 1, buffer)
  1521.          gfarrowkey(key, maxcol() + 1 - mlength, @mrow, @mcol)
  1522.          buffer := savescreen(mrow, mcol, mrow, mcol + mlength - 1)
  1523.          restscreen(mrow, mcol, mrow, mcol + mlength - 1, buffer2)
  1524.          dispend()
  1525.          buffer2 := savescreen(mrow, mcol, mrow, mcol + mlength - 1)
  1526.       endif
  1527.    enddo
  1528.    dispbegin()
  1529.    restscreen(mrow, mcol, mrow, mcol + mlength - 1, buffer)
  1530.    if key == K_ENTER
  1531.       ret_val := .t.
  1532.       //───── make sure that we are not plopping this get down over
  1533.       //───── another one!
  1534.       for yy = mcol to mcol + mlength - 1
  1535.          if isitaget(mrow, yy)
  1536.             dispend()
  1537.             Err_Msg("You cannot place a get on top of a get")
  1538.             ret_val := .f.
  1539.             exit
  1540.          endif
  1541.       next
  1542.    endif
  1543.    if ret_val
  1544.       //───── change this array element to reflect the new position
  1545.       GetRow(xx) := mrow
  1546.       GetCol(xx) := mcol
  1547.       restscreen(mrow, mcol, mrow, mcol + mlength - 1, buffer2)
  1548.       dispend()
  1549.    else
  1550.       //───── either they escaped, or they tried to place this get
  1551.       //───── on top of another one -- in either case we must now
  1552.       //───── redraw the original get
  1553.       @ GetRow(xx), GetCol(xx) ssay padr(GetName(xx), GetLength(xx)) color 'I'
  1554.    endif
  1555. endif
  1556. setcolor(oldcolor)
  1557. return ret_val
  1558.  
  1559. * end static function GFBMoveFld()
  1560. *--------------------------------------------------------------------*
  1561.  
  1562.  
  1563.  
  1564. /*
  1565.    IsItABox(): determine whether or not we are on a box outline
  1566.                useful for resizing and deleting boxes
  1567. */
  1568. static function isitabox
  1569. local ret_val := 0, xx, temprow := row(), tempcol := col()
  1570. for xx = 1 to num_boxes
  1571.    if ((BoxTop(xx) == temprow .or. BoxBottom(xx) == temprow) .and.   ;
  1572.         BoxLeft(xx) <= tempcol .and. BoxRight(xx) >= tempcol) .or.   ;
  1573.         ((BoxLeft(xx) == tempcol .or. BoxRight(xx) == tempcol) .and. ;
  1574.            BoxTop(xx) <= temprow .and. BoxBottom(xx) >= temprow)
  1575.       ret_val := xx
  1576.       exit
  1577.    endif
  1578. next
  1579. return ret_val
  1580.  
  1581. * end static function IsItABox()
  1582. *--------------------------------------------------------------------*
  1583.  
  1584.  
  1585. /*
  1586.    GFBWhichGet(): locate current get in get array
  1587. */
  1588. static function gfbwhichget(mrow, mcol)
  1589. local mget := 0, xx
  1590. //───── figure out which field it is by scanning the array
  1591. //───── for the value of the row we are currently on
  1592. xx := ascan(gets_, { | a | a[1] == mrow} )
  1593. do while xx > 0 .and. mget == 0
  1594.    //───── now check the length of this field (character 3 in
  1595.    //───── the array element) to see if we are actually on it
  1596.    if xx > 0
  1597.       if mcol < GetCol(xx) + GetLength(xx)
  1598.          mget := xx
  1599.       else
  1600.          xx := ascan(gets_, { | a | a[1] == mrow }, xx + 1)
  1601.       endif
  1602.    endif
  1603. enddo
  1604. return mget
  1605.  
  1606. * end static function GFBWhichGet()
  1607. *--------------------------------------------------------------------*
  1608.  
  1609.  
  1610. /*
  1611.    GfbDrawBox(): logic to drag a field around on the screen
  1612. */
  1613. static function gfbdrawbox(mrow, mcol)
  1614. local buffer, mbox, key, ntop, nleft, oldscrn, mfill, mwidth, fillbuff, xx
  1615. local scrnbuff := savescreen(0, maxcol() - 16, 0, maxcol())
  1616. static boxtypes := {}
  1617. //───── only load boxtypes array if it is empty (i.e., first time through)
  1618. if empty(boxtypes)
  1619.    for xx = 1 to 5
  1620.       aadd(boxtypes, substr(BOXFRAMES[xx], 1, 8))
  1621.    next
  1622. endif
  1623.  
  1624. /*
  1625.    even though it seems wasteful, we must make a safety copy of
  1626.    the entire screen because you might decide not to keep the
  1627.    box, right?  remember the old maxim: users change their mind
  1628.    as often as Cher changes costumes
  1629. */
  1630. oldscrn := savescreen(0, 0, maxrow(), maxcol())
  1631. setpos(mrow, mcol)
  1632. buffer := shadowbox(9, 35, 15, 44, 2, "Boxes")
  1633. mbox := achoice(10, 36, 14, 43, boxtypes)
  1634. byebyebox(buffer)
  1635. if mbox > 0
  1636.    mfill := yes_no("Would you like this box to be filled")
  1637.    key := 0
  1638.    ntop := mrow
  1639.    nleft := mcol
  1640.    buffer := savescreen(ntop, nleft, mrow, mcol)
  1641.    do while key != K_ENTER .and. key != K_ESC
  1642.       //───── display current box coordinates at top right corner
  1643.       //───── but only if the box is not in the top right corner!!
  1644.       if ntop > 0 .or. mcol < maxcol() - 16
  1645.          @ 0, maxcol() - 16 ssay padr(ltrim(str(ntop, 2)) + ', '  + ;
  1646.                                       ltrim(str(nleft, 3)) + ', ' + ;
  1647.                                       ltrim(str(mrow, 2)) + ', '  + ;
  1648.                                       ltrim(str(mcol, 3)), 16)
  1649.       endif
  1650.       setpos(mrow, mcol)
  1651.       key := ginkey(0)
  1652.       if ! ((mrow == maxrow() .and. key == K_DOWN) .or. ;
  1653.             (mrow == ntop .and. key == K_UP) .or. ;
  1654.             (mcol == nleft .and. key == K_LEFT) .or. ;
  1655.             (mcol > 78 .and. key == K_RIGHT))
  1656.          dispbegin()
  1657.          restscreen(ntop, nleft, mrow, mcol, buffer)
  1658.          gfarrowkey(key, maxcol(), @mrow, @mcol)
  1659.          buffer := savescreen(ntop, nleft, mrow, mcol)
  1660.          @ ntop, nleft, mrow, mcol box boxtypes[mbox] + if(mfill, " ", "")
  1661.          dispend()
  1662.       endif
  1663.    enddo
  1664.    if key == K_ESC
  1665.       restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  1666.       //───── restore original cursor position too
  1667.       setpos(ntop, nleft)
  1668.    else
  1669.       //───── restore screen contents under the coordinates area (top right)
  1670.       restscreen(0, maxcol() - 16, 0, maxcol(), scrnbuff)
  1671.       //───── only fill the box if there is at least one row inside it!
  1672.       if mfill .and. mrow > ntop + 1
  1673.          gfbfillbox(ntop, nleft, mrow, mcol, buffer)
  1674.       endif
  1675.       num_boxes++
  1676.       aadd(boxes_, { ntop, nleft, mrow, mcol, boxtypes[mbox], ;
  1677.                      color_s2n(), if(mfill, "Y", "N") } )
  1678.    endif
  1679. endif
  1680. return NIL
  1681.  
  1682. * end static function GFBDrawBox()
  1683. *--------------------------------------------------------------------*
  1684.  
  1685.  
  1686. /*
  1687.    GfbSizeBox(): logic to resize a box
  1688. */
  1689. static function gfbsizebox(xx)
  1690. local oldscrn, key := 0, buffer, oldcolor, ntop, nleft, nbottom, nright, ret_val
  1691. ntop    := BoxTop(xx)
  1692. nleft   := BoxLeft(xx)
  1693. nbottom := BoxBottom(xx)
  1694. nright  := BoxRight(xx)
  1695. //───── once again, we must make a safety copy of the entire screen
  1696. //───── because you might decide to leave the box size as is.  picky users!
  1697. oldscrn := savescreen(0, 0, maxrow(), maxcol())
  1698. //───── get rid of the box for a split second and save the underlying screen
  1699. //───── otherwise, we are going to have a real mess on our hands!
  1700. @ ntop, nleft, nbottom, nright box space(8)
  1701. buffer := savescreen(ntop, nleft, nbottom, nright)
  1702. oldcolor := setcolor(color_n2s(BoxColor(xx)))
  1703. @ ntop, nleft, nbottom, nright box BoxString(xx) + ;
  1704.                        if(BoxFill(xx) == "Y", " ", "")
  1705. do while key != K_ENTER .and. key != K_ESC
  1706.    setpos(nbottom, nright)
  1707.    key := ginkey(0)
  1708.    if ! ((nbottom == maxrow() .and. key == 24) .or. ;
  1709.          (nbottom == ntop .and. key == 5) .or. ;
  1710.          (nright == nleft .and. key == 19) .or. ;
  1711.          (nright > 78 .and. key == 4))
  1712.       dispbegin()
  1713.       restscreen(ntop, nleft, nbottom, nright, buffer)
  1714.       gfarrowkey(key, maxcol(), @nbottom, @nright)
  1715.       buffer := savescreen(ntop, nleft, nbottom, nright)
  1716.       @ ntop, nleft, nbottom, nright box BoxString(xx) + ;
  1717.                      if(BoxFill(xx) == "Y", " ", "")
  1718.       dispend()
  1719.    endif
  1720. enddo
  1721. if key == K_ESC
  1722.    restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  1723.    ret_val := boxes_[xx]
  1724. else
  1725.    if BoxFill(xx) == "Y"
  1726.       gfbfillbox(ntop, nleft, nbottom, nright, buffer)
  1727.    endif
  1728.    ret_val := { ntop, nleft, nbottom, nright, BoxString(xx), BoxColor(xx), ;
  1729.                 BoxFill(xx) }
  1730. endif
  1731. setcolor(oldcolor)
  1732. return ret_val
  1733.  
  1734. * end static function GFBSizeBox()
  1735. *--------------------------------------------------------------------*
  1736.  
  1737.  
  1738. /*
  1739.    GfbFillBox(): fill box with underlying screen
  1740. */
  1741. static function gfbfillbox(ntop, nleft, nbottom, nright, buffer)
  1742. /*
  1743.    we have just drawn a filled box.  there is every likelihood
  1744.    that we have some relevant information underneath this box.
  1745.    therefore, we must pull the information from the underlying
  1746.    screen into the box.  but not so fast!  we must make this
  1747.    information conform to the color specification of the box.
  1748.    one more thing, leave the gets in inverse.  got all that?  good.
  1749. */
  1750. local mwidth := (nright - nleft + 1) * 2, fillbuff := [], xx, yy, ;
  1751.       mcolor := chr(color_s2n())
  1752. buffer := substr(buffer, mwidth + 1, len(buffer) - mwidth * 2)
  1753. for xx = 0 to (nbottom - ntop - 2)
  1754.    for yy = 2 to nright - nleft
  1755.       fillbuff += substr(buffer, xx * mwidth + yy * 2 - 1, 1)
  1756.       if substr(buffer, xx * mwidth + yy * 2, 1) != chr(112)
  1757.          fillbuff += mcolor
  1758.       else
  1759.          fillbuff += chr(112)
  1760.       endif
  1761.    next
  1762. next
  1763. restscreen(ntop + 1, nleft + 1, nbottom - 1, nright - 1, fillbuff)
  1764. return NIL
  1765.  
  1766. * end static function GFBFillBox()
  1767. *--------------------------------------------------------------------*
  1768.  
  1769.  
  1770. /*
  1771.    GfbArrowKey(): process arrow keypresses etcetera
  1772. */
  1773. static function gfarrowkey(key, maxlength, mrow, mcol)
  1774. do case
  1775.    case key == K_UP
  1776.       if mrow == 0
  1777.          mrow := maxrow()
  1778.       else
  1779.          mrow--
  1780.       endif
  1781.  
  1782.    case key == K_DOWN
  1783.       if mrow == maxrow()
  1784.          mrow := 0
  1785.       else
  1786.          mrow++
  1787.       endif
  1788.  
  1789.    case key == K_LEFT .and. mcol > 0
  1790.       mcol--
  1791.  
  1792.    case key == K_RIGHT .and. mcol < maxlength
  1793.       mcol++
  1794.  
  1795.    case key == K_HOME
  1796.       mrow := mcol := 0
  1797.  
  1798.    case key == K_END
  1799.       mrow := maxrow()
  1800.       mcol := maxlength
  1801.  
  1802.    case key == K_PGUP
  1803.       mrow := 0
  1804.  
  1805.    case key == K_PGDN
  1806.       mrow := maxrow()
  1807.  
  1808.    case key == K_CTRL_LEFT
  1809.       mcol := 0
  1810.  
  1811.    case key == K_CTRL_RIGHT
  1812.       mcol := maxlength
  1813.  
  1814.    case key == K_TAB
  1815.       mcol := min(mcol + 5, maxlength)
  1816.  
  1817.    case key == K_SH_TAB
  1818.       mcol := max(mcol - 5, 0)
  1819.  
  1820. endcase
  1821. return NIL
  1822.  
  1823. * end static function GFBArrowKey()
  1824. *--------------------------------------------------------------------*
  1825.  
  1826. #endif // REMBRANDT
  1827.  
  1828.  
  1829. //───── the next five functions are for viewing subsets with the
  1830. //───── three TBrowse navigation blocks... you
  1831.  
  1832. static function pseudofilt(b, needinput)
  1833. local oldhandler, newhandler, newblock, getlist := {}
  1834. local oldscrn, initval := { space(40), 0.00, ctod('') } ;
  1835.                [at(valtype(eval( &("{||" + indexkey(0) + "}"))),"CND")]
  1836. if needinput
  1837.    oldscrn := shadowbox(7, 9, 10, 70, 1, "View Subset")
  1838.    hival := if(empty(hival), initval, ;
  1839.             if(valtype(hival) != "C", hival, padr(hival, 40)))
  1840.    lowval := if(empty(lowval), initval, ;
  1841.              if(valtype(lowval) != "C", lowval, padr(lowval, 40)))
  1842.    @ 8, 11 say "Enter low value:  " get hival
  1843.    @ 9, 11 say "Enter high value: " get lowval
  1844.    setcursor(1)
  1845.    read
  1846.    setcursor(0)
  1847.    byebyebox(oldscrn)
  1848. endif
  1849.  
  1850. //───── trim if character type
  1851. if valtype(initval) == "C"
  1852.    hival := trim(hival)
  1853.    lowval := trim(lowval)
  1854. endif
  1855.  
  1856. if lastkey() != K_ESC .or. ! needinput
  1857.    if ! empty(hival) .and. ! empty(lowval)
  1858.       newhandler = { | e | blockhead(e, oldhandler) }
  1859.       oldhandler = errorblock(newhandler)
  1860.       begin sequence
  1861.          b:goTopBlock := &(" { | | dbseek(" + convertit(hival) + ", .t.) }")
  1862.          b:goBottomBlock := &(" { | | dbseek(" + ;
  1863.                             convertit(lowval, .t.) + ", .t.) , dbskip(-1) }")
  1864.          b:skipBlock := { | SkipCnt | Gilligan(SkipCnt, ;
  1865.                         &("{ || " + indexkey(0) + "}")) }
  1866.          //───── force "filter" to be set by "going top"
  1867.          b:goTop()
  1868.       end
  1869.       errorblock(oldhandler)            /* reset previous error handler */
  1870.    else
  1871.       //───── reset original movement blocks
  1872.       b:goTopBlock := oldgotop
  1873.       b:goBottomBlock := oldgobott
  1874.       b:skipBlock := oldskip
  1875.       b:goTop()
  1876.    endif
  1877. endif
  1878. return nil
  1879.  
  1880. * end static function PseudoFilt()
  1881. *--------------------------------------------------------------------*
  1882.  
  1883.  
  1884. static function gilligan(skipcnt, val)
  1885. local movement := 0
  1886. do case
  1887.    /* no movement */
  1888.    case skipcnt == 0
  1889.       skip 0
  1890.    /* moving forward */
  1891.    case skipcnt > 0
  1892.       do while movement < skipcnt .and. eval(val) <= lowval .and. ! eof()
  1893.          skip 1
  1894.          movement++
  1895.       enddo
  1896.       // make sure that we are within range - if not, move backward
  1897.       do while (eval(val) > lowval .or. eof()) .and. ! bof()
  1898.          skip -1
  1899.          movement--
  1900.       enddo
  1901.       if bof()         // no data in range... fall out
  1902.          keyboard chr(K_ESC)
  1903.       endif
  1904.    /* moving backward */
  1905.    case skipcnt < 0
  1906.       do while movement > skipcnt .and. eval(val) >= hival
  1907.          skip -1
  1908.          if bof()
  1909.             exit
  1910.          endif
  1911.          movement--
  1912.       enddo
  1913.       // make sure that we are within range -- if not, move forward
  1914.       do while eval(val) < hival .and. ! eof()
  1915.          skip
  1916.          movement++
  1917.       enddo
  1918.       if eof()         // no data within range... fall out
  1919.          keyboard chr(K_ESC)
  1920.       endif
  1921. endcase
  1922. return movement
  1923.  
  1924. * end static function Gilligan()
  1925. *--------------------------------------------------------------------*
  1926.  
  1927.  
  1928. /*
  1929.    do type conversion for character/numeric/date index keys
  1930.    in preparation for compiling goTopBlock and goBottomBlock
  1931.    2nd parameter passed to increment low value for SOFTSEEK
  1932. */
  1933. static function convertit(val, lo)
  1934. local ret_val := valtype(val)
  1935. do case
  1936.    case ret_val == "D"
  1937.       ret_val := "CTOD('" + dtoc(val + if(lo != NIL, 1, 0)) + "')"
  1938.    case ret_val == "N"
  1939.       ret_val := ltrim(str(val + if(lo != NIL, 1, 0)))
  1940.    case ret_val == "C"
  1941.       //───── if 2nd parameter was passed, then use CHR(255) instead
  1942.       //───── of last character in the string.  This is required for
  1943.       //───── proper placement of the record pointer.
  1944.       if lo != NIL
  1945.          ret_val := "'" + left(val, len(val) - 1) + "' + chr(255)"
  1946.       else
  1947.          ret_val := "'" + val + "'"
  1948.       endif
  1949. endcase
  1950. return ret_val
  1951.  
  1952. * end static function ConvertIt()
  1953. *--------------------------------------------------------------------*
  1954.  
  1955.  
  1956. /*
  1957.    BlockHead(): custom error handler for code block syntax bombs
  1958. */
  1959. static function blockhead(e, oldhandler)
  1960. if e:gencode() == EG_SYNTAX .or. e:gencode() == EG_ARG
  1961.    dispend()
  1962.    err_msg("Error in code block syntax")
  1963.    break
  1964.    return .t.
  1965. endif
  1966. return eval(oldhandler, e)
  1967.  
  1968. * end static function BlockHead()
  1969. *--------------------------------------------------------------------*
  1970.  
  1971. * eof brow.prg
  1972.