Liren Large Software Subsidy 5/05.iso/a/a012/1.ddi/APPENDIX.EXE/MAXIBROW.PRG

Text File | 1991-05-01 | 45.7 KB | 1,458 lines

/*
   File: MAXIBROW.PRG
   Author: Craig Yellick
   Excerpted from "Clipper 5: A Developer's Guide"
   Copyright (c) 1991 M&T Books
                      501 Galveston Drive
                      Redwood City, CA 94063-4728
                      [phone]

   This is a general purpose database browser which attempts to use ALL
   of the TBrowse features in a single program. Yikes. The result is not
   intended to be a real routine that you'd implement in your
   applications. It goes to sometimes ridiculous lengths to incorporate
   TBrowse functions. It's intended to be a TBrowse playground of sorts
   where you can see various instance variables and methods in action
   and in the context of a large application rather than in small,
   isolated examples. Use it to experiment-- make code changes, add new
   features, change constants, do whatever you find interesting. The
   more time you spend playing with TBrowse the better you'll understand
   it.

   The use of color and the formatting of the various status messages is
   deliberately spartan. I didn't want colorful and graphical things to
   get in the way of the underlying concepts. Plus, there's enough code
   as it is! The screen is by design very blah until you start fiddling
   around with highlighting and selection functions, or supply a
   database with dates, negative numbers, logical values or memo fields.
   Then you'll probably wish there weren't so many colors. I predict
   the incredibly flexible TBrowse color scheme will be responsible for
   a whole new generation of garish application screens. See the
   following comments for more details.

   ------------------------------------------------------------------------

   All the features of this program are tied to various keystrokes. The
   source code comments surrounding the features describe the techniques
   being used. Briefly, here's what MaxiBrow can do:


   Navigation Keys
   ===============

   Up, Down, Left, Right: Move one cell in any direction, will scroll
   rows up/down and pan columns left/right as needed.

   Home, End: Jump to first or last visible column.

   Control-Home, Control-End: Jump to very first or very last column.

   PageUp, PageDown: Scroll one screenful up or down.

   Control-PageUp, Control-PageDown: Jump to very top or very bottom of
   database.

   Tab, Shift-Tab: Pan the screen left or right to see more columns.


   Function Keys
   =============

   F1   Display record numbers/columns visited during "help". Each time
        you press F1 the current record number is added to a list. A
        column-based counter is also incremented. Press F1 periodically
        as you move through the database.  F1 also displays a brief
        summary of what most the other keystrokes do.

   F2   Toggle between color and monochrome color schemes.

   F3   Insert a copy of current column.

   F4   Delete current column. Can't delete the last non-frozen column.

   F5   Move window. Up/Down/Left/Right work as expected. Press any
        other key to finish the move. Built-in logic will prevent you
        from moving the window completely off the screen. Press
        backspace to restore coordinates to initial settings.

   F6   Resize window. Up/Left make window larger, Down/Right make it
        smaller. Press any other key to finish the sizing. Built-in
        logic will prevent you from making window too small to be
        useful. Press backspace to restore coordinates to initial
        settings.

   F7   Rotate column positions. Non-frozen columns are shifted to the
        left, first column is moved to the far right. Can press F7
        repeatedly to cycle through as many columns as you wish.  Press
        Shift-F7 to rotate columns in the other direction.

   F8   Toggle drag-highlight navigation mode. After pressing F8 all
        cursor movements will enlarge a highlight box on the screen. Due
        to limitations inherent in TBrowse's colorRect() method the
        highlighted box is for the visible screen, only.

   F9   Highlight current column. Due to aforementioned colorRect()
        limitation the highlight extends only for the rows currently
        visible.

   F10  Highlight the current row.  Entire row is highlighted, including
        columns that are not currently visible.

   ESC  Finished browsing, you'll be asked to confirm that you want to
        exit. Press Y to exit or any other key to remain in MaxiBrow.


   Editing Keys
   ============

   Alt-U           Toggle the global SET DELETED flag on/off.
   Control-U       Toggle the individual record deletion flag on/off.

   Enter           Edit current cell (including memo fields).
   Control-Enter   Clear contents of current cell then edit (but not memo).
   !..chr(255)     Edit current cell, start with current keystroke.


   Other Misc Keys
   ===============

   Control-Left   Make current column more narrow.  Can't make column
                  smaller than one character wide.

   Control-Right  Make current column more wide.  Can't make column
                  wider than width of original field in database.

   Backspace      Clear all highlights and selections, reset all cargo
                  instance variables, refresh entire screen. Used
                  primarily to recover after making a mess.

   Spacebar       Toggle record selection check-mark on and off. Counter
                  at bottom of screen indicates how many have been
                  selected. Unlike the F8, F9 and F10 highlighting
                  functions, the check-marks are not limited to the
                  currently visible screen. Backspace clears all
                  selections.


   Other Automatic Things
   ======================

   Other things will happen automatically depending on the contents of
   the database being browsed.

   *  Negative numbers will be in red.

   *  Logically false values will also be in red.

   *  All date columns will be in magenta.

   *  "Thud" sounds will be heard when you attempt to scroll or pan
      beyond the physical boundaries of the database.

   *  A relative position indicator, or "elevator", will be displayed on
      the left side of the window if the database contains more records
      than can fit in the window. Important note: The indicator is
      maintained independent of the index, if one is being used. This is
      implemented very elegantly thanks to the wonderful concept
      of TBrowse "skipBlocks".

   ------------------------------------------------------------------------

   Compiling and Running
   =====================

       Compile with: /n /w

       Usage (from DOS): maxibrow datafile [indexfile]

   ------------------------------------------------------------------------

   Comments
   ========

   There's a tremendous amount of fancy browsing going on in here and to
   help keep it all straight I've included lots of comments. Block-style
   comments, like the ones you're reading here, are used to describe
   large sections of code and also are used as headers to functions.
   Single line comments are used when the comments are directed at the
   next line (or small number of lines). Two blank lines separate
   logical groups of source code, single blank lines separate small runs
   of related source code within a major group.

   Other helpful conventions:  If a function name is in all lowercase
   letters then it's part of the built-in Clipper functions. If a
   function name is in "proper" case it's a user-defined function and
   can be found in this source code file. Array names end with a
   trailing underscore. Manifest constants are in all upper case.

   ------------------------------------------------------------------------

   File Contents
   =============

   Main(cFilename [, cIndexname])
     Main browsing program. From DOS, send database filename and option
     index filename.

   Proper(cString)
     Given string, returns "properized" string where first character is
     made uppercase. Used in this program to make the database
     fieldnames look better.

   YesNo(cMsg [, nSeconds])
     Given a message to display and optional maximum number of seconds
     to wait, return .t. if "Y" or "y" is pressed, .f. if not.

   HelpStat(oBrowse)
     Given a browse object, use browse and current column cargo
     variables to display stats about how often the F1-HELP key was
     pressed and which records were visited. (Not a general purpose
     help function, it's specific to this goofy program.)

   FitInBox(nTop, nLeft, nBottom, nRight, aMessage)
     Draw a box at specified coordinates and display array of message
     lines within the boundaries of the box, trim to fit if needed.

   RecPosition([cHow] [, nHowmany])
     This is a single function used for all three TBrowse data
     positioning blocks. Given the type of movement required (top,
     bottom or skip) and how many records to skip, function performs all
     the necessary database movements. If called without any parameters
     the function returns the current record's position within the
     database. The position is maintained independent of the index, if
     any.

   RecDisplay(nRec, aList, lDeleted)
     This function is used by the record-# column data retrieval block
     to format the record number for display. It handles the check-mark.
     The current record number is passed along with an array containing
     record numbers that should be displayed with check-marks. Records
     marked for deletion have an asterisk in the column.

   aCount(aX, bCountBlock [, nStart] [, nCount])
     Given an array, use the supplied code block to count the number
     of elements that match a condition. Optional starting element
     number and number of elements to evaluate. Returns count.

   aInsert(aX, nPos [, xValue])
     Increase size of array by inserting new value in specified
     position. This function combines the effects of the ains() and
     asize() functions.

   aDelete(aX, nPos)
     Decrease size of array by deleting element in specified position.
     This function combines the effects of the adel() and asize()
     functions.

   aRotate(aX [,lDir])
     Rotates elements in array passed as parameter. Elements are shifted
     up one. First element is shifted to last element. Optional
     direction to shift, default is .t. and implies shift up, .f. is
     down. Returns nil.

   ColumnColor(xValue)
     Given a value of any type, returns a color-selection array based on
     the type and value. Used to install logic for displaying certain
     data types or values in special colors. For example, negative
     numbers in red. Any number of cases can be installed.

   Navigate(objBrowse, nKey)
     Given a browse object and a potential navigation key, function
     searches its internal list of keystrokes and associated browse
     navigation methods. If key is found the method is sent to the
     browse and the function returns .t., if not found, function
     returns .f. and no action is taken.

   EditCell(objBrowse, cFieldName, cColor)
     A general-purpose browse cell contents editor, works with all
     database field types including memo fields. All editing, including
     memo-edit, occurs within the browse window regardless of its
     current size or position. On exit from cell the function passes
     along browse navigation when appropriate.

   ------------------------------------------------------------------------
*/


/*
   Establish some helpful preprocessor directives.
*/
#include "INKEY.CH"
#include "DBSTRUCT.CH"

#define K_SPACE      32
#define K_CTRL_ENTER 10

#define THUD     tone(60, 0.5)
#define BADKEY   tone(480, 0.25); tone(240, 0.25)
#define lstr(n)  ltrim(str(n))

#define INIT_R1   4
#define INIT_R2  (maxrow() -4)
#define INIT_C1  10
#define INIT_C2  (maxcol() -10)

#define FREEZE_COL  1


/*
    Default color scheme for all columns.
    (Used with instance variable browse:colorSpec.)

    1: Regular cell
    2: Highlighted regular cell
    3: Block-selection cell
    4: Highlighted block-selection cell
    5: Checked record-#
    6: Highlighted, checked record-#
    7: Regular negative numbers and .F. values
    8: Highlighted negative numbers and .F. values
    9: Regular dates
   10: Highlighted dates

                    1    2     3    4      5    6     7     8      9    10
*/
#define COL_COLOR "W/N, N/W, W+/B, B/W, W+/G, B+/G, R+/N, W+/R, RB+/N, W+/RB"
#define COL_MONO  "W/N, N/W, N/W,  W*/N, W/N, W+/N, W+/N, N/W,  W+/N,  N/W"

/*
   The following make it easier to use the browse:colorSpec.
   They correspond to the color scheme defined above.
*/
#define REGULAR_CELL  {1,2}
#define BLOCKED_CELL  {3,4}
#define CHECKED_CELL  {5,6}
#define NEGVAL_CELL   {7,8}
#define DATE_CELL     {9,10}

//  This next one is for the GET/READ feature,
//  defined here for consistency with rest of browse.
#define EDIT_COLOR    "W+/G"

/*-----------------------------------------------------------------------*/

function Main(filename, indexname)
/*
   Main browsing function.
*/

local r1, r2, c1, c2, scr, fileDescr
local column, browse, key
local stru_, recs_
local s, n, w
local hiRow, hiCol, hiRow2, hiCol2
local dragMode := .f., delSwitch := .f.
local temp, useColor, relPos


  //  Check that command line parameters are kosher.
  if filename = nil
    ? "Must specify a database filename and optionally an index filename."
    quit
  elseif .not. (file(filename) .or. file(filename +".DBF"))
    ? "Database file does not exist."
    quit
  endif


  //  Get rid of the cursor and start with a clean slate.
  setcursor(0)
  @ 0,0 clear
  set scoreboard off


  //  Open the database and index.
  use (filename) new
  fileDescr := "File: " +upper(filename)
  if (indexname <> nil) .and. (file(indexname) ;
                          .or. file(indexname +".NTX"))
    set index to (indexname)
    fileDescr += ", Index: " +upper(indexname)
  endif


  //  Assign initial browse window coordinates.
  r1 := INIT_R1
  r2 := INIT_R2
  c1 := INIT_C1
  c2 := INIT_C2
  @ r1 -2, c1 +((c2 -(c1 +len(fileDescr))) /2) say fileDescr
  @ r1 -1, c1 -1, r2 +1, c2 +1 box "▄▄▄█▀▀▀█ "


  //  Create a new browse object.
  browse := TBrowseNew()


  /*
     Things that affect the entire browse.
  */
  //  Assign window coordinates.
  browse:nTop := r1
  browse:nBottom := r2
  browse:nLeft := c1
  browse:nRight := c2
  //  Assign heading, footing and column separators.
  browse:headSep := "═╤═"
  browse:colSep  := " │ "
  browse:footSep := "═╧═"
  //  Cargo will be used later, associated with the F1 key.
  browse:cargo := {}


  //  Assign default color scheme according to adapter card.
  useColor := iscolor()
  browse:colorSpec := if(useColor, COL_COLOR, COL_MONO)


  //  All three position blocks get routed through a single function.
  //  This allows us to do some amazing things, later.
  browse:goTopBlock    := { | | RecPosition("top")     }
  browse:goBottomBlock := { | | RecPosition("bottom")  }
  browse:skipBlock     := { |n| RecPosition("skip", n) }


  /*
     First column will be the record number.
     We're going to do some tricky things with this column
     so setting it up is more complex than normally necessary.
  */
  //  This array will keep track of the records visited each
  //  time the F1-HELP key is pressed.
  recs_ := {}

  //  Create a new column object.
  column := TBColumnNew()

  //  The RecDisplay() function provides the check-mark toggle
  //  that's associated with the spacebar key.
  column:block := { || RecDisplay(recno(), recs_, deleted()) }

  //  The footing line will be used to display field type and width.
  column:heading := " Rec-#"
  column:footing := "  Type:; Col-#:"

  //  We want this column to have a different color when "checked".
  column:colorBlock := { |r| if("√" $ r, CHECKED_CELL, REGULAR_CELL) }

  //  Column cargo is used later store a count of how many times
  //  the F1-HELP key was pressed in each column.
  column:cargo := 0

  //  Add the record-# column just defined to the main browse object.
  browse:addColumn(column)


  /*
     The remainder of the columns in the browse will be comprised
     of the fields in the current database.
  */

  //  For each field in the database...
  //    (See documentation for the dbstruct() function and
  //    details about what the stru_ array contains.)
  stru_ := dbstruct()
  for n := 1 to len(stru_)

    //  Create a column object for each field.
    column := TBColumnNew()

    //  Heading is the field name, footing is the type and width.
    //  For example, a 12 character field would be "C:12".
    //  Columns are numbered in a second line in the footing, (n).
    column:heading := Proper(lower(stru_[n, DBS_NAME]))
    column:footing := stru_[n, DBS_TYPE] +":" +lstr(stru_[n, DBS_LEN]) ;
                      +";(" +lstr(n) +")"

    //  Date-type columns get special color scheme.
    if stru_[n, DBS_TYPE] = "D"
      column:defColor := DATE_CELL
    else
      //  Make some of the colors depend on cell value.
      column:colorBlock := { |v| ColumnColor(v) }
    endif


    //  Data-retrieval blocks based simply on the field value.
    //  Don't create a block for memo fields.
    if stru_[n, DBS_TYPE] <> "M"
      column:block := fieldblock(stru_[n, DBS_NAME])
      column:width := stru_[n, DBS_LEN]
    else
      column:block := { || " memo " }
      column:width := 6
    endif


    //  Initialize cargo, we'll be using it later.
    column:cargo := 0


    //  First column after frozen one (in this case, the
    //  record-#) gets a different set of separators to
    //  better divide "frozen" columns from the scrollable ones.
    //
    if n = FREEZE_COL
      column:headSep := "═╦═"
      column:colSep  := " ║ "
      column:footSep := "═╩═"
    endif

    //  Add the new column object to the main browse object.
    browse:addColumn(column)
  next n


  //  Freeze the first column (the record-#).
  browse:freeze := FREEZE_COL


  //  Move cell pointer beyond frozen column(s).
  browse:colPos := browse:freeze +1


  //  We'll handle our own highlighting, thank you.
  browse:autoLite := .f.


  //  Used later to mark relative pointer position on left edge of window.
  relPos := 1


  /*
     Finally!  We're done getting everything set up.
     Allow user to play with the browse until exit is confirmed.
  */
  do while .t.


    //  Can't move beyond last column.
    //  This condition will be fixed up by stabilize(),
    //  so we must check for it prior to stabilization.
    if browse:colPos > browse:colCount
      THUD
    endif


    //  Can't move into frozen column.
    if browse:colPos <= browse:freeze
      THUD
      browse:colPos := browse:freeze +1
    endif


    //  Stabilize the display, if it needs to be. Use of the nextkey()
    //  function allows us to exit the loop if a keystroke occurs, but
    //  without disturbing the contents of the keyboard buffer.
    if .not. browse:stable
      @ 0,0 say "STABILIZING..."
      do while .not. browse:stabilize()
        if nextkey() <> 0
          exit
        endif
      enddo
      @ 0,0
    endif


    //  These get updated during the stabilize,
    //  so they can't be checked until after stabilize finishes.
    if browse:hitTop .or. browse:hitBottom
      THUD
    endif


    //  If in "drag the highlight around" mode, update
    //  the rectangle coordinates and display it.
    if dragMode
      hiRow  := min(hiRow,  browse:rowPos)
      hiCol  := min(hiCol,  browse:colPos)
      hiRow2 := max(hiRow2, browse:rowPos)
      hiCol2 := max(hiCol2, browse:colPos)
      browse:colorRect({hiRow, hiCol, hiRow2, hiCol2}, BLOCKED_CELL)
    endif


    //  Update relative position indicator, but only if
    //  there are more records in database than can fit on the screen.
    if lastrec() > browse:rowCount
      @ browse:nTop +2 +relPos, browse:nLeft -1 say "█"
      relPos := min((RecPosition()/lastrec()) *browse:rowCount, ;
                     browse:rowCount -1)
      @ browse:nTop +2 +relPos, browse:nLeft -1 say chr(18) color "I"
    endif

    //  Update the "more columns left" and "more columns right" indicators.
    //  Start by clearing existing indicator arrows, if any.
    @ browse:nTop, browse:nLeft  -1 say " " color "I"
    @ browse:nTop, browse:nRight +1 say " " color "I"
    if browse:leftVisible > (browse:freeze +1)
      @ browse:nTop, browse:nLeft  -1 say chr(27) color "I"
    endif
    if browse:rightVisible < browse:colCount
      @ browse:nTop, browse:nRight +1 say chr(26) color "I"
    endif


    /*
       The bottom three rows of the screen are used to display status
       information about various pieces of the browse and column
       objects. Watch these lines as you navigate in the database.
    */

    //  Display info about the browse window.
    @ maxrow() -2, 0
    ?? "Browse: Row " +lstr(browse:rowPos)
    ?? ", Col " +lstr(browse:colPos)

    @ maxrow() -1, 0
    ?? "Absolute DBF position: " +lstr(RecPosition())
    ?? "  (" +lstr( round((RecPosition()/lastrec()) *100, 0)) +"%)"

    @ maxrow(), 0
    column := browse:getColumn(browse:colPos)
    ?? "Record " +lstr(recno()) +": " +column:heading +" = "
    //
    //  Use of @..SAY will allow long strings to display off
    //  the edge of the screen, rather than wrapping around.
    //
    @ row(), col() say eval(column:block)


    s := "[ F1:HELP ]"
    @ maxrow() -2, (maxcol() -len(s)) /2 say s


    s := "Records √-Marked: " +lstr(aCount(recs_, { | e | (e <> nil) }) )
    @ maxrow() -2, maxcol() -len(s) say s
    s := "LastKey = " +lstr(lastkey())
    @ maxrow() -1, maxcol() -len(s) say s
    s := "NextKey = " +lstr(nextkey())
    @ maxrow(), maxcol() -len(s) say s


    //  Highlight cell pointer and wait for keystroke.
    browse:hilite()
    key := inkey(0)

    /*
       Take action on the keystroke. Could be cursor navigation
       or any of a large number of browse-modification features.
    */
    do case


    //  If the general browse navigation function returns .t.
    //  it means it handled the key for us.
    //
    case Navigate(browse, key)


    case key = K_CTRL_LEFT  //  Decrease column width (if we can).
      //
      //  stru_[colPos -1] because first column is record number.
      //
      w := browse:getcolumn(browse:colPos):width
      if w > 1
        browse:getcolumn(browse:colPos):width--
        //  Update the footing to reflect the new width.
        browse:getcolumn(browse:colPos):footing ;
         := stru_[browse:colPos -1, DBS_TYPE] +":" +lstr(--w) ;
         +";(" +lstr(browse:colPos) +")"
        browse:configure()
      else
        THUD
      endif


    case key = K_CTRL_RIGHT  //  Increase column width (if we can).
      //
      //  stru_[colPos -1] because first column is record number.
      //
      w := browse:getcolumn(browse:colPos):width
      if w < stru_[browse:colPos -1, DBS_LEN]
        browse:getcolumn(browse:colPos):width++
        //  Update the footing to reflect the new width.
        browse:getcolumn(browse:colPos):footing ;
         := stru_[browse:colPos -1, DBS_TYPE] +":" +lstr(++w) ;
         +";(" +lstr(browse:colPos) +")"
        browse:configure()
      else
        THUD
      endif


    case key = K_F1          //  Display help/cargo status.
      //
      HelpStat(browse)


    case key = K_F2          //  Toggle colorSpec between color and mono.
      //
      useColor := .not. useColor
      browse:colorSpec := if(useColor, COL_COLOR, COL_MONO)
      browse:configure()


    case key = K_F3          //  Insert copy of current column.
      //
      //  stru_[colPos -1] because first column is record number.
      //
      //  Must adjust the stru_ array so it stays accurate.
      //
      aInsert(stru_, browse:colPos -1, stru_[browse:colPos -1])
      browse:insColumn(browse:colPos, browse:getColumn(browse:colPos))


    case key = K_F4          //  Delete current column.
      //
      //  stru_[colPos -1] because first column is record number.
      //
      //  Don't allow deletion of last non-frozen column.
      //  Must adjust the stru_ array so it stays accurate.
      //
      if browse:colCount > (browse:freeze +1)
        aDelete(stru_, browse:colPos -1)
        browse:delColumn(browse:colPos)
      else
        THUD
      endif


    case key = K_F5          //  Move the window.
      //
      //  Don't allow window to be pushed completely off the screen,
      //  force atleast a few rows and columns to say visible, TBrowse
      //  is capable of hanging the computer under certain oddball
      //  situations.
      //
      scr := savescreen(0,0,maxRow(),maxCol())
      @ 0,0
      @ 0,0 say "Move window: " +chr(18) +" " +chr(29)
      do while .t.
        @ r1 -1, c1 -1, r2 +1, c2 +1 box replicate("·", 8)
        key := inkey(0)
        restscreen(0,0,maxRow(),maxCol(), scr)
        do case
        case key = K_UP
          if r2 > 4
            r1--
            r2--
          else ; THUD; endif
        case key = K_DOWN
          if r1 < (maxRow() -4)
            r1++
            r2++
          else ; THUD; endif
        case key = K_LEFT
          if c2 > 10
            c1--
            c2--
          else ; THUD; endif
        case key = K_RIGHT
          if c1 < (maxCol() -10)
            c1++
            c2++
          else ; THUD; endif
        case key = K_BS  // Restore initial values
          r1 := INIT_R1
          r2 := INIT_R2
          c1 := INIT_C1
          c2 := INIT_C2
        otherwise
          exit
        endcase
      enddo
      restscreen(0,0,maxRow(),maxCol(), scr)
      @ browse:nTop -2, browse:nLeft -1 ;
        clear to browse:nBottom +1, browse:nRight +1
      @ r1 -2, c1 +((c2 -(c1 +len(fileDescr))) /2) say fileDescr
      @ r1 -1, c1 -1, r2 +1, c2 +1 box "▄▄▄█▀▀▀█ "
      browse:nTop := r1
      browse:nBottom := r2
      browse:nLeft := c1
      browse:nRight := c2


    case key = K_F6         //   Resize the window.
      //
      //  Don't allow resize unless entire window is visible,
      //  TBrowse might hang the computer if things get too wierd.
      //  Also, don't let size get too small or too large.
      //
      if (r1 < 0) .or. (c1 < 0) ;
         .or. (r2 > maxRow()) .or. (c2 > maxCol())
         BADKEY
      else
        scr := savescreen(0,0,maxRow(),maxCol())
        @ 0,0
        @ 0,0 say "Resize window: " +chr(18) +" " +chr(29)
        do while .t.
          @ r1 -1, c1 -1, r2 +1, c2 +1 box replicate("·", 8)
          key := inkey(0)
          restscreen(0,0,maxRow(),maxCol(), scr)
          do case
          case key = K_UP
            if (r2 -r1) < (maxRow() -1)
              r1--
              r2++
            else ; THUD; endif
          case key = K_DOWN
            if (r2 -r1) > 4
              r1++
              r2--
            else ; THUD; endif
          case key = K_LEFT
            if (c2 -c1) < (maxCol() -3)
              c1--
              c2++
            else ; THUD; endif
          case key = K_RIGHT
            if (c2 -c1) > 8
              c1++
              c2--
            else ; THUD; endif
          case key = K_BS  // Restore initial values
            r1 := INIT_R1
            r2 := INIT_R2
            c1 := INIT_C1
            c2 := INIT_C2
          otherwise
            exit
          endcase
        enddo
        restscreen(0,0,maxRow(),maxCol(), scr)
        @ browse:nTop -2, browse:nLeft -1 ;
          clear to browse:nBottom +1, browse:nRight +1
        @ r1 -2, c1 +((c2 -(c1 +len(fileDescr))) /2) say fileDescr
        @ r1 -1, c1 -1, r2 +1, c2 +1 box "▄▄▄█▀▀▀█ "
        browse:nTop := r1
        browse:nBottom := r2
        browse:nLeft := c1
        browse:nRight := c2
      endif


    case key = K_F7 .or. ;   //  Rotate non-frozen column positions +/-.
         key = K_SH_F7
      //
      @ 0,0 say "ROTATING COLUMNS..."
      if key = K_F7
        temp := browse:getColumn(browse:freeze +1)
        for n := (browse:freeze +1) to (browse:colCount -1)
          browse:setcolumn(n, browse:getColumn(n +1))
        next n
        browse:setcolumn(browse:colCount, temp)
      else
        temp := browse:getcolumn(browse:colCount)
        for n := browse:colCount to (browse:freeze +2) step -1
          browse:setcolumn(n, browse:getcolumn(n -1))
        next n
        browse:setcolumn(browse:freeze +1, temp)
      endif
      //
      //  Also rotate database structure array so
      //  anything that depends on it remains accurate.
      //
      aRotate(stru_, key == K_F7)
      @ 0,0


    case key = K_F8         //  Drag-highlight mode.
      //
      //  Initialize only if not already in drag-highlight mode.
      //
      if .not. dragMode
        hiRow := hiRow2 := browse:rowPos
        hiCol := hiCol2 := browse:colPos
      endif
      dragMode := .not. dragMode


    case key = K_F9         //  Highlight current column.
      //
      browse:colorRect({1, browse:colPos, ;
                        browse:rowCount, browse:colPos}, ;
                        BLOCKED_CELL)

      //  Move over one column, a convenience feature.
      if browse:colPos > browse:colCount
        *  Wrap to first column?
      else
        browse:right()
      endif


    case key = K_F10        //  Highlight current row.
      //
      browse:colorRect({browse:rowPos, browse:freeze +1, ;
                        browse:rowPos, browse:colCount}, ;
                        {3,4})

      //  Move down one row, a convenience feature.
      if browse:hitBottom
        *  Wrap to top?
      else
        browse:down()
      endif


    case key = K_BS        //  Clear, zero and refresh everything in sight.
      //
      //  stru_[n -1] because first column is record number.
      //
      @ 0,0 say "CLEANING UP..."
      dragMode := .f.
      recs_ := {}
      for n := (browse:freeze +1) to browse:colCount
        browse:getcolumn(n):cargo := 0
        browse:getcolumn(n):width := stru_[n -1, DBS_LEN]
        browse:getcolumn(n):footing := stru_[n -1, DBS_TYPE] ;
                            +":" +lstr(stru_[n -1, DBS_LEN]) ;
                            +";(" +lstr(n) +")"
      next n
      browse:cargo := {}
      browse:configure()
      @ 0,0


    case key = K_SPACE    //  Toggle record marker on/off.
      //
      n := ascan(recs_, recno())
      if n = 0
        n := ascan(recs_, nil)
        if n = 0
          aadd(recs_, recno())
        else
          recs_[n] := recno()
        endif
      else
        adel(recs_, n)
      endif

      //  Force this row to be refreshed. If user marked it
      //  we want to be certain they're seeing the most up-to-date data.
      browse:refreshCurrent()

      //  Move down to next row as a convenience for user.
      browse:down()


    case key = K_ALT_U    //  Toggle SET DELETED on/off.
      //
      if (delSwitch := .not. delSwitch)
        set deleted on
      else
        set deleted off
      endif
      browse:refreshAll()


    case key = K_CTRL_U   //  Toggle the record deletion flag.
      //
      if deleted()
        recall
      else
        delete
      endif
      browse:refreshCurrent()


    case (key = K_ENTER) ;       //  Open current cell for editing.
    .or. (key = K_CTRL_ENTER) ;  //  Clear cell contents and edit.
    .or. (key > K_SPACE)         //  Edit by starting to type.
      //
      EditCell(browse, ;
               stru_[browse:colPos -1, DBS_NAME], ;  //  Field name
               EDIT_COLOR)


    case key = K_ESC      //  Done browsing.
      //
      //  Turn off hilite, user's attention should be at y/n prompt.
      //
      browse:deHilite()
      if YesNo("Exit? Are you sure?")
        exit
      endif


    //  Undefined key, be-boop to let user
    //  know that we heard but can't obey.
    //
    otherwise
      BADKEY
    endcase

  enddo  //  While browsing.

  setcursor(1)
  @ maxrow(), 0

return nil


/*-----------------------------------------------------------------------*/


function Proper(s)
/*
   Return "properized" version of string, first letter made uppercase.
   Used in column headings to make the field names look more nice.
*/
return upper(left(s, 1)) +substr(s, 2)


/*-----------------------------------------------------------------------*/


function YesNo(msg, time)
/*
    Display yes/no question message in box centered on screen, wait up
    to so many seconds before assuming "no". This function takes pains
    not to disturb the calling routine's screen/color/cursor settings.
*/
local k, scr, curs, clr
  scr := savescreen(11,0,13,maxCol())
  msg := " " +msg +" "
  curs := setcursor(0)
  clr := setcolor( if(iscolor(), "GR+/R", "W+*/N") )
  @ 11, (maxCol()/2) -(len(msg)/2) -1 ;
    to 13, (maxCol()/2) +(len(msg) /2) double
  @ 12, (maxCol()/2) -(len(msg)/2) say msg
  k := inkey(if(time = nil, 0, time))
  restscreen(11,0,13,maxCol(), scr)
  setcolor(clr)
  setcursor(curs)
return (chr(k) $ "Yy")


/*-----------------------------------------------------------------------*/


function HelpStat(b)
/*
   Display help and status screen. You can do pretty well anything you
   want for "help". In this case we're displaying some interesting
   stats about where the cell pointer was sitting when help was pressed.
*/
local clr, scr := savescreen(0, 0, maxrow(), maxcol())

  //  Look for current record number in the browse cargo,
  //  add it to list of records if not found.
  if ascan(b:cargo, recno()) = 0
    aadd(b:cargo, recno())
  endif

  @ 0, 0 clear
  @ 0, 0 to 4, maxCol()
  @ 1, 2 say "Browse and Column Cargo..."

  //  Display list of record numbers maintained in browse cargo.
  @ 2, 2 say "  Record-#s visited when HELP was pressed:"
  aeval(b:cargo, { |rec| qqout(" " +lstr(rec)) } )

  //  Display current column cargo count, then increment it.
  @ 3, 2 say "  Prior times HELP pressed in this column: " ;
             +lstr(b:getColumn(b:colPos):cargo++)

  FitInBox(5, 0, 16, 35, ;
           {"         Navigation Keys        ", "", ;
            "Up·Dn·Lt·Rt         Take a guess", ;
            "Home·End       First/last column", ;
            "^Home·^End   Very first/last col", ;
            "PgUp·PgDn            See up/down", ;
            "^PgUp·^PgDn    First/last record", ;
            "Tab·Shf-Tab  Pan cols left/right", "", ;
            "           ESC Exits            "})

  FitInBox(maxrow() -19, maxcol() -42, maxrow(), maxcol(), ;
           {"F2   Toggle between color/mono", ;
            "F3   Insert copy of current column", ;
            "F4   Delete current column", ;
            "F5   Move window (BS=reset)", ;
            "F6   Resize window (BS=reset)", ;
            "F7   Rotate column positions (Shift-F7)", ;
            "F8   Toggle drag-highlight on/off", ;
            "F9   Highlight current column", ;
            "F10  Highlight current row", "", ;
            "Alt-U      Toggle SET DELETED on/off", ;
            "^U         Toggle record delete on/off", ;
            "Enter      Edit current cell (incl memo)", ;
            "^Enter     Clear cell then edit", ;
            "^Left      Make column more narrow", ;
            "^Right     Make column more wide", ;
            "Spacebar   Toggle √-record", ;
            "Backspace  Clear and reset everything"})


  @ maxrow() -4, 0 say "See Detailed Comments in Source Code"
  clr := setcolor("I")
  @ maxrow() -3, 0 say replicate("▀", 36)
  @ maxrow() -2, 0 say "     MaxiBrow by Craig Yellick      "
  @ maxrow() -1, 0 say "     Ver 1.4a        20-Apr-91      "
  @ maxrow(),    0 say replicate("▄", 36)
  setcolor(clr)

  inkey(0)
  restscreen(0, 0, maxrow(), maxcol(), scr)

return nil


/*-----------------------------------------------------------------------*/

function FitInBox(r1, c1, r2, c2, msg_)
/*
   Draw a box of specified dimensions and display the contents
   of an array of message lines in it. Display only what will
   fit within the box boundaries.
*/
local i

  @ r1, c1 clear to r2, c2
  @ r1, c1 to r2, c2 double
  for i := 1 to min(len(msg_), r2 -r1 -1)
    @ r1 +i, c1 +2 say left(msg_[i], c2 -c1 -1)
  next i

return nil

/*-----------------------------------------------------------------------*/


function RecPosition(how, howMany)
/*
   General-purpose record positioning function, called by TBrowse goTop,
   goBottom and skip blocks. Returns number of record actually moved if
   in "skip" mode.

   Also can be called with no parameters to get record position within
   database independent of presence of index.
*/

//  Assume no movement was possible
local actual := 0

local i
static where := 1

  do case
  case how = "top"
    where := 1
    goto top

  case how = "bottom"
    where := lastrec()
    goto bottom

  case how = "skip"
    do case
    //  Moving backwards
    case howMany < 0
      do while (actual > howMany) .and. (.not. bof())
        skip -1
        if .not. bof()
          actual--
        endif
      enddo

    //  Moving forwards
    case howMany > 0
      do while (actual < howMany) .and. (.not. eof())
        skip +1
        if .not. eof()
          actual++
        endif
      enddo
      if eof()
        skip -1
      endif

    //  No movement requested, re-read current record
    otherwise
      skip 0
    endcase

  //  No parameters passed, return current position.
  otherwise
    return where
  endcase

  //  Update position tracker and prevent boundary wrap.
  where += actual
  where := min(max(where, 1), lastrec())

return actual


/*-----------------------------------------------------------------------*/


function RecDisplay(rec, list_, del)
/*
  Returns specified record number plus indicator if record has been
  placed in list_ array. Intended for use in TBColumn retrieval block.
*/
return if(del, " *","  ") +str(rec,4) ;
      +if(ascan(list_, rec) = 0, "  ", " √")


/*-----------------------------------------------------------------------*/


function aCount(a_, countBlock, start, count)
/*
  Given array and code block, return number of elements that evaluate
  true.
*/
local howMany := 0
  aeval(a_, ;
    { |elem| howMany += if(eval(countBlock, elem), 1, 0) }, ;
    start, count)
return howMany


/*-----------------------------------------------------------------------*/


function aInsert(a_, pos, value)
/*
   Increase size of array by inserting new value in specified position.
*/
  asize(a_, len(a_) +1)
  ains(a_, pos)
  a_[pos] := value
return nil


/*-----------------------------------------------------------------------*/


function aDelete(a_, pos)
/*
   Decrease size of array by removing element at specified position.
*/
  adel(a_, pos)
  asize(a_, len(a_) -1)
return nil


/*-----------------------------------------------------------------------*/


function aRotate(a_, up)
/*
   Rotate array elements such that first is last, last is first, and all
   others shift up one position. If UP is passed and is false, the shift
   direction is reversed.
*/
local temp
  if (up = nil) .or. up
    temp := a_[1]
    aeval(a_, { |e,n| a_[n] := a_[n +1] }, 1, len(a_) -1)
    a_[len(a_)] := temp
  else
    //
    //  Yes, it's possible to traverse an array backwards with aeval()!
    //
    temp := a_[len(a_)]
    aeval(a_, { |e,n| a_[len(a_) -(n-1)] := a_[len(a_) -n] }, ;
              1, len(a_) -1)
    a_[1] := temp
  endif
return nil


/*-----------------------------------------------------------------------*/


function ColumnColor(value)
/*
   Color selection used in TBColumn colorBlock. Allows each data type to
   have it's own color scheme.
*/
local type, clr
  type := valtype(value)
  do case
  case (type = "N") .and. (value < 0)
    clr := NEGVAL_CELL
  case (type = "L") .and. (.not. value)
    clr := NEGVAL_CELL
  otherwise
    clr := REGULAR_CELL
  endcase
return clr


/*-----------------------------------------------------------------------*/

function Navigate(b, k)
/*
   Establish array of navigation keystrokes and the cursor movement
   method to associate with each key. The array is comprised of
   two-element arrays containing the inkey() value of the key and a
   codeblock to execute when the key is pressed.

   This function gets passed a browse object and a potential
   navigation key. If the key is found in the array it's
   associated navigation message is sent to the browse.
   Function returns .t. if navigation was handled, .f. if not.
*/
local n

//  Made static so it doesn't get re-initialized on every call.
//  Due to Clipper bug of some sort it's not possible to directly
//  assign this array on the static statement line.  Perhaps this
//  will be fixed by the time you read this, if so you can eliminate
//  the if..endif and assign the array directly on the static
//  statement line.
//
static keys_
  if keys_ = nil
    keys_ := { ;
      {K_UP,        {|| b:up()       } }, ;  //  Up one row
      {K_DOWN,      {|| b:down()     } }, ;  //  Down one row
      {K_LEFT,      {|| b:left()     } }, ;  //  Left one column
      {K_RIGHT,     {|| b:right()    } }, ;  //  Right one column
      {K_PGUP,      {|| b:pageUp()   } }, ;  //  Up on page
      {K_PGDN,      {|| b:pageDown() } }, ;  //  Down one page
      {K_CTRL_PGUP, {|| b:goTop()    } }, ;  //  Up to the first record
      {K_CTRL_PGDN, {|| b:goBottom() } }, ;  //  Down to the last record
      {K_HOME,      {|| b:home()     } }, ;  //  First visible column
      {K_END,       {|| b:end()      } }, ;  //  Last visible column
      {K_CTRL_HOME, {|| b:panHome()  } }, ;  //  First column
      {K_CTRL_END,  {|| b:panEnd()   } }, ;  //  Last column
      {K_TAB,       {|| b:panRight() } }, ;  //  Pan to the right
      {K_SH_TAB,    {|| b:panLeft()  } }  ;  //  Pan to the left
    }
  endif

  //  Search for the inkey() value in the cursor movement array.
  //  If one is found, evaluate the code block associated with it.
  //  Remember these are paired in arrays: {key, block}.
  //
  n := ascan(keys_, { | pair | k == pair[1] })
  if n <> 0
    eval(keys_[n, 2])
  endif

return (n <> 0)

/*-----------------------------------------------------------------------*/

function EditCell(b, fieldName, editColor)
/*
   General-purpose browse cell editing function, can handle all database
   field types including memo fields. If you want the edits to "stick"
   you must assign fieldblock()-style column:block instance variables.
   All editing, including memo-edit, is done within the boundaries of
   the browse window. On exit any appropriate browse cursor navagation
   messages are passed along.
*/
local c, k, clr, crs, rex, block, cell


  //  Retrieve the column object for the current cell.
  c := b:getcolumn(b:colPos)


  //  Create a field block used to check for a memo field
  //  and later used to store the edited memo back. It's
  //  done this way so you can have the browse window display
  //  a notation like "memo" rather than displaying a small
  //  hunk of the real memo field.
  //
  block := fieldblock(fieldName)


  //  Can't just "get" a memo, need a memo-edit.
  if valtype(eval(block)) = "M"

    //  Tell the user what's going on.
    //
    @ b:nTop, b:nLeft clear to b:nBottom, b:nRight

    @ b:nTop, b:nLeft say ;
      padc("Memo Edit: Record " +lstr(recno()) ;
          +', "'+ c:heading +'" Field', b:nRight -b:nLeft)

    @ row() +1, b:nLeft say replicate("─", b:nRight -b:nLeft +1)


    //  Turn cursor on and perform the memo edit
    //  using the specified color.
    crs := setcursor(1)
    clr := setcolor(editColor)
    cell := memoedit(eval(block), b:nTop +2, b:nLeft, b:nBottom, b:nRight)
    setcursor(crs)
    setcolor(clr)


    //  If they didn't abandon the edit, save changes.
    //  When passed a parameter, fieldblock-style code
    //  blocks store the value back to the database.
    //  Handiest darn thing they ever stuck in this language.
    if lastkey() <> K_ESC
      eval(block, cell)
    endif


    //  We mussed up the entire window, tell TBrowse to clean it up.
    b:invalidate()

    //  Re-read from database, since we edited it.
    b:refreshCurrent()


  //  Regular data type, do a GET/READ.
  else

    //  Pass along any additional keystrokes.
    if lastkey() = K_CTRL_ENTER
      keyboard(chr(K_CTRL_Y))
    elseif (lastkey() > K_SPACE) .and. (lastkey() < 256)
      keyboard(chr(lastkey()))
    endif


    //  Create a get object for the field.
    cell := getnew(row(), col(), c:block, fieldName,, "W/N,"+editColor)


    //  Allow up/down to exit the read, and turn the cursor off.
    rex := readexit(.t.)
    crs := setcursor(1)

     //  Perform the read.
    readmodal({cell})

    //  Restore original cursor and read-exit states.
    setcursor(crs)
    readexit(rex)


    //  If user hit a navigation key to exit, do it.
    if Navigate(b, lastkey())

    //  If they pressed Enter, advance to next column.
    elseif lastkey() = K_ENTER
      if b:colPos < b:colCount
        b:right()
      else
        b:down()
        b:colPos := b:freeze +1
      endif
    endif


    //  We changed the field value and TBrowse doesn't know it.
    //  So we must force a re-read for the current row.
    b:refreshCurrent()
  endif

return nil

/*-----------------------------------------------------------------------*/
// eof MaxiBrow.Prg