home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / BOXGET.PRG < prev    next >
Encoding:
Text File  |  1991-06-06  |  5.6 KB  |  150 lines
  1. /*
  2.    Program: BOXGET()
  3.    System:  GRUMPFISH LIBRARY
  4.    Author:  Greg Lief
  5.    Copyright (c) 1988-91, Greg Lief
  6.    Compile instructions: clipper boxget /n/w/a
  7.    Generic GET function
  8. */
  9.  
  10. //───── begin preprocessor directives
  11.  
  12. #include "box.ch"
  13. #include "grump.ch"
  14. #include "setcurs.ch"
  15. #include "inkey.ch"
  16.  
  17. //───── end preprocessor directives
  18.  
  19. //───── begin global declarations
  20.  
  21. #define DELIMITERPAD  if(set(_SET_DELIMITERS), 2, 0)
  22. #define TOP     nrow
  23. #define LEFT    ncol
  24. #define BOTTOM  nrow + 2
  25. #define RIGHT   ncol + len(cprompt) + 4 + getlength + DELIMITERPAD
  26.  
  27. //───── end global declarations
  28.  
  29. // the following stub program demonstrates how to use this beast
  30. // test code courtesy of Matt Amis and Don Bayne - thanks guys
  31.  
  32. #ifdef TEST      // it's not defined unless you defined it
  33.  
  34. function main
  35. local nx := 0, cx := Space(6), dx := Ctod(""), phone := "5035881815"
  36. set delimiters to "││"
  37. set delimiters on
  38. @ 0, 0, maxrow(), maxcol() box replicate(chr(178), 9)
  39. boxget nx prompt "Numeric nrest r1 c0" row 1 column 0 norestore
  40. boxget nx prompt "Numeric, pic 9999 nrest r4 c0" picture "9999" ;
  41.           norestore row 4 column 0 title "Pick a number"
  42. boxget nx prompt "Numeric, pic 9999, val > 20 nrest r7 c0" picture "9999" ;
  43.           valid nX > 20 norestore row 7 column 0
  44. boxget nx prompt "Numeric, pic #### nrest r10 c0" picture '####' double ;
  45.           norestore row 10 column 0
  46. boxget nx prompt "Numeric nrest r16 c0" boxcolor "+W/R" ;
  47.           color "+W/RB, +GR/N" norestore row 16 column 0
  48. boxget nx prompt "Numeric nrest r19 c0" boxcolor "+W/R" ;
  49.           norestore row 19 column 0
  50. boxget cx prompt "Character, restoreall nrest r22 c0" ;
  51.           boxcolor "*+gr/n" restoreall row 22 column 0
  52. boxget cx prompt "Character, double" double
  53. boxget cx prompt "Character, nothing"
  54. boxget dx prompt "Date, pic 99/99/99" picture "99/99/99"
  55. boxget dx prompt "Date, pic 99/99/99, not empty valid" picture "99/99/99" ;
  56.           valid (! empty(dx))
  57. boxget cx prompt "Character, this is going to be a really long message that "+;
  58.           "will automatically get truncated by BOXGET()" boxcolor "*+gr/n"
  59. boxget cx prompt "Character, pic @!" picture "@!"
  60. boxget cx prompt "Character, pic !!!!!!" picture "!!!!!!"
  61. boxget phone prompt "Phone #" picture "@R (999) 999-9999"
  62. return nil
  63.  
  64. #endif
  65.  
  66.  
  67. function boxget(cprompt, nrow, ncol, oget, cvalid, cboxcolor, ;
  68.                 norestore, restall, double, ctitle)
  69. static boxstack_ := {}       // to store screen shots
  70. local x, getlength, oldscore := set(_SET_SCOREBOARD, .f.), oldscrn
  71. //───── set insert key to toggle both insert mode & cursor
  72. local oldins := setkey( K_INS, {|| setcursor( ;
  73.          if(readinsert(! readInsert()), SC_NORMAL, SC_SPECIAL1))} )
  74. GFSaveEnv(, , cboxcolor)   // switch to box color
  75. //───── initial cursor setting based on current mode
  76. setcursor( if(readInsert(), SC_SPECIAL1, SC_NORMAL) )
  77. /*
  78.   Determine length of GET variable by verifying the length of the GET
  79.   buffer.  This is necessary not only in the event that no PICTURE
  80.   clause was used, but also because we cannot always trust the PICTURE
  81.   clause (e.g., "@!" and "@R"). Note that the GET must be activated with
  82.   the setFocus() method, because the g:buffer instance variable only exists
  83.   when the GET is active.  Also notice that although the GET is activated,
  84.   it will not appear on the screen.  Why is this??  Look carefully at the
  85.   BOXGET user-defined command in GRUMP.CH -- there lies the answer.
  86. */
  87. oget:setFocus()
  88.  
  89. //───── determine length of GET buffer but check first for @S Picture
  90. //───── special thanks to Kevin Farley for his comments in this regard
  91. //───── note: this assumes that the scroll length will be two digits
  92. if oget:picture != NIL .and. (x := at("S", oget:picture) ) > 0
  93.    getlength := val(substr(oget:picture, x + 1, 2))
  94. else
  95.    getlength := len(oget:buffer)
  96. endif
  97. oget:killFocus()
  98.  
  99. //───── truncate long prompts to fit on screen
  100. cprompt := substr(cprompt, 1, maxcol() - 4 - DELIMITERPAD - getlength)
  101.  
  102. //───── establish defaults for box title, row, and column positions
  103. default ctitle to ''
  104. default nrow to int( maxrow() / 2) - 1
  105. default ncol to int( maxcol() - 3 - len(cprompt) - DELIMITERPAD - ;
  106.                      getlength ) / 2
  107.  
  108. oldscrn := shadowbox(TOP, LEFT, BOTTOM, RIGHT, if(double, 1, 2), ctitle)
  109.  
  110. //───── if NORESTORE was specified, add the affected portion of screen
  111. //───── to box stack so we can restore it later
  112. if norestore
  113.    aadd(boxstack_, oldscrn )
  114. endif
  115. setpos(TOP + 1, LEFT + 2)
  116. oget:postBlock := cvalid       // set up VALID clause manually
  117. dispout( cprompt )
  118. oget:row := row()              // set up GET row manually
  119.  
  120. //───── if delimiters are set ON, we must display them manually
  121. //───── because GETNEW() does not respect the rascally things!
  122. if set(_SET_DELIMITERS)
  123.    oget:col := col() + 2
  124.    dispout(' ' + left(set(_SET_DELIMCHARS), 1) + ;
  125.            space(getlength) + right(set(_SET_DELIMCHARS), 1))
  126. else
  127.    oget:col := col() + 1
  128. endif
  129. readmodal( { oget } )
  130.  
  131. //───── restore all screens if RESTOREALL was specified
  132. if restall
  133.    ByeByeBox(oldscrn)
  134.    if ! empty(boxstack_)
  135.       for x := len(boxstack_) to 1 step -1
  136.          restscreen(boxstack_[x, 1], boxstack_[x, 2], boxstack_[x, 3], ;
  137.                     boxstack_[x, 4], boxstack_[x, 5])
  138.       next
  139.       asize(boxstack_, 0)
  140.    endif
  141. elseif ! norestore
  142.    ByeByeBox(oldscrn)
  143. endif
  144.  
  145. //───── restore all other environmental aspects
  146. GFRestEnv()
  147. setkey(K_INS, oldins)                // reset INSERT key
  148. set(_SET_SCOREBOARD, oldscore)       // argh... does anybody use this?
  149. return nil
  150.