home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / GFREADER.PRG < prev    next >
Encoding:
Text File  |  1991-08-25  |  8.9 KB  |  256 lines
  1. /*
  2.    Program: GFReader()
  3.    Purpose: Alternate modal read of a single GET.
  4.    System: GRUMPFISH LIBRARY
  5.    Author: Greg Lief
  6.    Copyright (c) 1988-91, Greg Lief
  7.    Clipper 5.01 Version
  8.    Compile instructions: clipper gfreader /n/w/a
  9. */
  10.  
  11. #include "getexit.ch"
  12. #include "grump.ch"
  13. #include "inkey.ch"
  14.  
  15. #define  MESSAGE        1
  16. #define  PASSWORD       cargo[2, 1]
  17. #define  PASSWIDTH      cargo[2, 2]
  18. #define  PASSCHAR       substr(oget:picture, 3)
  19.  
  20. #define  LISTVALUES     oGet:cargo[3]
  21. #define  LISTPOINTER    oGet:cargo[4]
  22.  
  23. #xtranslate UsingPassword() => ;
  24.             oGet:picture != NIL .and. substr(oGet:picture, 1, 2) == "@P"
  25.  
  26. #xtranslate ClearWarning() => ;
  27.             restscreen(maxrow(), 0, maxrow(), maxcol(), warning) ; ;
  28.             warning := ''
  29.  
  30. //───── manifest constants for GFTimeout()
  31. #define TIMEOUT       1
  32. #define EXIT_EVENT    2
  33. #define WARNING       3
  34. #define WARN_EVENT    4
  35.  
  36. #define WARN_COLOR    "+w/r"             // used for default warning message
  37. #define WARNING_ON    ! empty(warning)   // for readability
  38. #define WARNING_OFF   empty(warning)     // for readability
  39.  
  40. function GFReader( oGet, bKeyproc )
  41. local mess_row, oldcursor, nkey, xx
  42. local nstart, ntimeout          // used for warning/timeout testing
  43. local warning := ''             // holds screen buffer when warning is issued
  44. local list_, ptr                // used in conjunction with LIST clause
  45. local getlist                   // used for validating all GETs (VALIDATION)
  46.  
  47. //───── read the GET if the WHEN condition is satisfied
  48. if ( GetPreValidate(oGet) )
  49.    // activate the GET for reading
  50.    mess_row := set(_SET_MESSAGE)
  51.    if oGet:cargo != NIL .and. ! empty(oGet:cargo[MESSAGE])
  52.       @ mess_row, 0 say padc( oGet:cargo[MESSAGE], maxcol() + 1)
  53.    endif
  54.    if UsingPassword()
  55.  
  56.       //───── if we have already been in this GET,
  57.       //───── the cargo array will already contain 2 items
  58.       if oGet:cargo != NIL .and. len(oGet:cargo) == 2
  59.          oGet:varPut(padr(replicate(PASSCHAR, len(oGet:PASSWORD)), ;
  60.                      oGet:PASSWIDTH))
  61.       else
  62.          //───── determine if cargo is an array or not
  63.          if oGet:cargo == NIL
  64.             oGet:cargo := { NIL }            // account for message slot
  65.          endif
  66.  
  67.          //───── add subarray to cargo holding the following items:
  68.          //─────    1) empty string to hold the contents of the password
  69.          //─────    2) width of GET for padding later
  70.          aadd(oGet:cargo, { '', len(oGet:varGet()) } )
  71.  
  72.       endif
  73.  
  74.    //───── test for LIST clause
  75.    elseif oGet:cargo != NIL .and. len(oGet:cargo) > 1 .and. ;
  76.           upper(oGet:cargo[2]) != "CALCULATOR"
  77.  
  78.       //───── if validation array has not already been created, do it now
  79.       if len(oGet:cargo) < 3
  80.  
  81.          //───── loop through contents of list, looking for semi-colons
  82.          //───── which serve as delimiters between possible choices
  83.          list_ := {}
  84.          do while ( ptr := at(';', oGet:cargo[2]) ) > 0
  85.             aadd(list_, substr(oGet:cargo[2], 1, ptr - 1))
  86.             oGet:cargo[2] := substr(oGet:cargo[2], ptr + 1)
  87.          enddo
  88.          aadd(list_, oGet:cargo[2])     // grab the rest of the beast
  89.          aadd(oGet:cargo, list_)        // add choices array to cargo
  90.  
  91.          //───── determine maximum length of list choices
  92.          ptr := len(LISTVALUES[1])
  93.          aeval(LISTVALUES, { | a | ptr := max(len(a), ptr) } )
  94.  
  95.          //───── if the GET is empty, stuff first list choice into it
  96.          if empty( oGet:varGet() )
  97.             oGet:varPut(LISTVALUES[1])
  98.          endif
  99.  
  100.          //───── manipulate PICTURE to match longest length
  101.          oGet:picture := replicate("X", ptr)
  102.  
  103.          aadd(oGet:cargo, 1)        // cargo[4] will serve as placeholder
  104.       endif
  105.       //───── perform scan to determine where we are in the list
  106.       //───── array and set the placeholder accordingly
  107.       LISTPOINTER := ascan(LISTVALUES, ;
  108.                         { | ele | trim(ele) == trim(oGet:varGet()) } )
  109.  
  110.    endif
  111.  
  112.    oGet:SetFocus()
  113.  
  114.    //───── force cursor to end of the GET for password-style
  115.    //───── if there is already data in this GET
  116.    if UsingPassword()
  117.       if ! empty(oGet:buffer)
  118.          oGet:end()
  119.       endif
  120.    //───── check cargo for calculator style entry
  121.    elseif oGet:cargo != NIL .and. len(oGet:cargo) > 1 .and. ;
  122.           upper(oGet:cargo[2]) == "CALCULATOR"
  123.       oldcursor := setcursor(0)           // shut off cursor for cosmetics
  124.       asize(oGet:cargo, 2)
  125.       /*
  126.           add subarray to cargo containing the following:
  127.              1) maximum number of decimals (use default picture clause
  128.                 if none provided with this GET)
  129.              2) running tab of decimal places used
  130.              3) flag indicating whether or not GET was already visited
  131.                 (.T. = already visited, .F. = not already visited). If
  132.                 when in GKCALC(), any key will clear out current entry
  133.       */
  134.       if oGet:picture == NIL
  135.          oGet:picture := "#######.##"
  136.          oGet:updatebuffer()
  137.       endif
  138.       aadd(oGet:cargo, {                                             ;
  139.                         len(oGet:picture) - at('.', oGet:picture),   ;
  140.                                                                 0,   ;
  141.                                               oGet:varGet() != 0   } )
  142.    endif
  143.    do while ( oGet:exitState == GE_NOEXIT )
  144.       // check for initial typeout (no editable positions)
  145.       if ( oGet:typeOut )
  146.          oGet:exitState := GE_ENTER
  147.       endif
  148.  
  149.       // apply keystrokes until exit
  150.       do while ( oGet:exitState == GE_NOEXIT )
  151.          nstart := seconds()
  152.          if WARNING_OFF
  153.             ntimeout := min( gftimeout(TIMEOUT), gftimeout(WARNING) )
  154.          endif
  155.          do while ( nkey := inkey() ) == 0 .and. seconds() - nstart < ntimeout
  156.             if WARNING_ON
  157.                gfsaveenv(, 0)               // shut off cursor
  158.                @ maxrow(), (maxcol() / 2) + 17 say ;
  159.                  ntimeout - seconds() + nstart picture '###' color WARN_COLOR
  160.                gfrestenv()
  161.             endif
  162.          enddo
  163.          do case
  164.  
  165.             //───── if we broke the loop with a keystroke, process it
  166.             case nkey != 0
  167.                eval(bKeyproc, oGet, nkey)
  168.                if WARNING_ON
  169.                   ClearWarning()
  170.                endif
  171.  
  172.             //───── check for warning
  173.             case gftimeout(WARNING) == ntimeout .and. WARNING_OFF
  174.                //───── save bottom row of screen and reset timeout seconds
  175.                warning := savescreen(maxrow(), 0, maxrow(), maxcol())
  176.                ntimeout := gftimeout(TIMEOUT) - gftimeout(WARNING)
  177.                //───── run warning event if one was specified
  178.                if ! empty(gftimeout(WARN_EVENT))
  179.                   eval(gftimeout(WARN_EVENT))
  180.                else
  181.                   //───── default warning action
  182.                   gfsaveenv(, 0)               // shut off cursor
  183.                   SCRNCENTER(maxrow(), ;
  184.                       padc("Seconds remaining before timeout:", maxcol()+1), ;
  185.                       WARN_COLOR)
  186.                   gfrestenv()
  187.                endif
  188.  
  189.             //───── no warning -- process exit event if one was specified
  190.             case ! empty(gftimeout(EXIT_EVENT))
  191.                eval(gftimeout(EXIT_EVENT))
  192.                if WARNING_ON
  193.                   ClearWarning()
  194.                endif
  195.  
  196.             //───── timed out, no exit event, just stuff an ESC
  197.             otherwise
  198.                keyboard chr(K_ESC)
  199.                if WARNING_ON
  200.                   ClearWarning()
  201.                endif
  202.  
  203.          endcase
  204.       enddo
  205.  
  206.       //───── if we were using a list...
  207.       if oGet:cargo != NIL .and. len(oGet:cargo) > 3
  208.          //───── because we padded the buffer for aesthetics,
  209.          //───── we must now trim it before value is assigned
  210.          oGet:varPut(trim(oGet:varGet()))
  211.       endif
  212.  
  213.       // disallow exit if VALID condition is not satisfied
  214.       if ( !GetPostValidate(oGet) )
  215.          oGet:exitState := GE_NOEXIT
  216.       endif
  217.  
  218.    enddo
  219.  
  220.    // remove message for this GET if there was one
  221.    if oGet:cargo != NIL .and. ! empty(oGet:cargo[MESSAGE])
  222.       scroll(mess_row, 0, mess_row, maxcol(), 0)
  223.    endif
  224.  
  225.    // de-activate the GET
  226.    oGet:KillFocus()
  227.  
  228.    //───── if password style entry was used, time to actually assign the value
  229.    if UsingPassword()
  230.       oGet:varPut(padr(oGet:PASSWORD, oGet:PASSWIDTH))
  231.    endif
  232. endif
  233. setcursor(oldcursor)
  234. return nil
  235.  
  236.  
  237. /*
  238.     Function: GFTimeOut()
  239.     Purpose:  Retrieve/assign values for warnings/timeouts/etc
  240. */
  241. function gftimeout(nitem, val)
  242. static settings_ := { 600000, , 600000, }
  243. local ret_val
  244. //───── if no parameters were passed, simply reset array
  245. if nitem == NIL
  246.    settings_ := { 600000, , 600000, }
  247. else
  248.    ret_val := settings_[nitem]
  249.    if val != NIL
  250.       settings_[nitem] := val
  251.    endif
  252. endif
  253. return ret_val
  254.  
  255. * eof GFREADER.PRG
  256.