home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / DMSERROR.ZIP / DMSOOPS.PRG < prev    next >
Encoding:
Text File  |  1988-09-16  |  18.1 KB  |  514 lines
  1. *--- Header ---------------------------------------------------------------
  2. *    Procedure DMSOOPS.PRG
  3. *    Version . 1.10
  4. *    Date .... August 18, 1988
  5. *    Author .. Bob Laszko, Data Management Systems
  6. *    Desc .... Displays an error message box in custom or default
  7. *               configuration
  8. *    Notice .. Copyright 1988, Data Management Systems. All Rights Reserved
  9. *--------------------------------------------------------------------------
  10. *
  11. *--- Ops Notes ------------------------------------------------------------
  12. *
  13. *    Requires the following external routines:
  14. *         EXXTEND.OBJ    C routines that return the status of some SET
  15. *                         commands. Written by J. Scott Emerich.
  16. *    Syntax - complete
  17. *         DO DMSOOPS [WITH [title], [frame], [instruction], [location],;
  18. *                    [rest_scrn], [explode, [implode]], [shad_show],;
  19. *                    [shad_char], [shad_side]]
  20. *
  21. *    Syntax - default
  22. *         DO DMSOOPS
  23. *
  24. *    Parameters
  25. *         title          C    title to display on top line of box
  26. *                              default = "OOPS"
  27. *         frame          N    0 = no characters in border
  28. *                             1 = single line box
  29. *                             2 = double line box
  30. *                             3 = double line top/bottom, single line sides
  31. *                             4 = single line top/bottom, double line sides
  32. *                        C    custom frame, include all eight characters as
  33. *                              outlined for @...BOX command
  34. *                              default = 1
  35. *         instruction    C    instructions to display on bottom line of box
  36. *                              default = "Press Any Key to Continue"
  37. *         location       C    UR = upper right corner of screen
  38. *                             UL = upper left corner of screen
  39. *                             LL = lower left corner of screen
  40. *                             LR = lower right corner of screen
  41. *                             C  = center of screen
  42. *                              default = C
  43. *         rest_scrn      L    .T. = restore screen upon RETURN to calling .PRG
  44. *                             .F. = screen not restored
  45. *                              default = .T.
  46. *         explode        L    .T. = exploding box
  47. *                             .F. = no explosion
  48. *                              default = .T.
  49. *         implode        L    .T. = implode screen before restore
  50. *                             .F. = no implosion
  51. *                              default = .T.
  52. *                              must explode box to implode on restore
  53. *         shad_show      L    .T. = shadow
  54. *                             .F. = no shadow
  55. *                              default = .T.
  56. *         shad_char      C    character to use for shadow
  57. *                              default = CHR(177) "▒"
  58. *         shad_side      C    L = shadow on left side of box
  59. *                             R = shadow on right side of box
  60. *                              default = R
  61. *
  62. *    Public memvars
  63. *         OOPS_MSG[]     C    each line of message to display in box
  64. *         OOPS_RESP[]    C    valid responses to instruction line prompts
  65. *         OOPS_ACTION    C    validated response returned to calling prg
  66. *         M_COOPSFR    * C    color for box frame
  67. *         M_COOPSTIT   * C    color for title
  68. *         M_COOPSTXT   * C    color for messages (text)
  69. *         M_COOPSINS   * C    color for instruction
  70. *         M_COOPSSHD   * C    color for shadow
  71. *         OOPS_SCRN    * C    screen saved prior to calling OOPS.
  72. *                      *      if these memvars are not initialized by the
  73. *                              calling prg, they will become PRIVATE
  74. *
  75. *    Private memvars
  76. *         OOPS_TITLE     C    title parameter
  77. *         OOPS_FRAME     C    frame for box derived from frame parameter
  78. *         OOPS_INS       C    instruction parameter
  79. *         OOPS_SCRN      C    screen saved prior to calling OOPS. PRIVATE if
  80. *                              not initialized by calling .PRG
  81. *         OOPS_LEN       N    length of box
  82. *         OOPS_TOP       N    top row of box
  83. *         OOPS_LEFT      N    left column of box
  84. *         OOPS_BOTT      N    bottom row of box
  85. *         OOPS_RIGHT     N    right column of box
  86. *         EXP_TOP        N    top row of exploding box
  87. *         EXP_LEFT       N    left column of exploding box
  88. *         EXP_BOTT       N    bottom row of exploding box
  89. *         EXP_RIGHT      N    right column of exploding box
  90. *         LIMIT_TOP      N    lowest value allowed for OOPS_TOP
  91. *         LIMIT_LEFT     N    lowest value allowed for OOPS_LEFT
  92. *         LIMIT_BOTT     N    highest value allowed for OOPS_BOTT
  93. *         LIMIT_RIGHT    N    highest value allowed for OOPS_RIGHT
  94. *         MSG[]          C    OOPS_MSG[] used in this routine
  95. *         MSG_NO         N    # of messages (LEN(OOPS_MSG))
  96. *         MSG_LEN        N    length of messages
  97. *         EXP_SCRN[]     C    screens of each step of exploding box
  98. *         EXP_NO         N    # of steps in exploding box
  99. *         T_EXP_NO       N    temp used to find EXP_NO
  100. *         COL_POS        N    column position for @...SAY
  101. *         ROW_POS        N    row position for @...SAY
  102. *         ADJUST         N    adjustment factor for COL_POS
  103. *         CURR_COLOR     C    current SETCOLOR() before calling DMSOOPS
  104. *         CURR_ROW       N    current cursor row before calling DMSOOPS
  105. *         CURR_COL       N    current cursor column before calling DMSOOPS
  106. *         CURR_CURSOR    L    current cursor on/off state before calling DMSOOPS
  107. *         VALID_RESP     N    flag to validate OOPS_RESP[]
  108. *         ACTION         N    INKEY(0) for OOPS_RESP[] validation
  109. *         X              N    FOR...NEXT memvar
  110. *
  111. *    Setup example - custom
  112. *
  113. *         DECLARE OOPS_MSG[2]
  114. *         OOPS_MSG[1] = "Printer is not ready. Make sure"
  115. *         OOPS_MSG[2] = "it is on-line and has paper"
  116. *         DECLARE OOPS_RESP[2]
  117. *         OOPS_RESP[1] = "R"
  118. *         OOPS_RESP[2] = "A"
  119. *         OOPS_ACTION = SPACE(1)
  120. *         DO OOPS WITH "Printer Not Ready", 1, "R = Retry   A = Abort", "UL", .T., .T., .T., .T., "▒", "R"
  121. *         RELEASE OOPS_MSG, OOPS_RESP
  122. *
  123. *              ┌──────[ Printer Not Ready ]──────┐
  124. *              │                                 │▒▒
  125. *              │ Printer is not ready. Make sure │▒▒
  126. *              │ it is on-line and has paper     │▒▒
  127. *              │                                 │▒▒
  128. *              └────[ R = Retry   A = Abort ]────┘▒▒
  129. *               ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  130. *
  131. *    Setup example - default
  132. *         DECLARE OOPS_MSG[2]
  133. *         OOPS_MSG[1] = "This customer has sales"
  134. *         OOPS_MSG[2] = "Cannot delete at this time"
  135. *         DO OOPS
  136. *         RELEASE OOPS_MSG
  137. *
  138. *              ┌───────────[ OOPS ]──────────┐
  139. *              │                             │
  140. *              │ This customer has sales     │
  141. *              │ Cannot delete at this time  │
  142. *              │                             │
  143. *              └[ Press Any Key to Continue ]┘
  144. *
  145. *    Misc.
  146. *         All message lengths need not be the same. Widest message
  147. *         is found and spaces added to shorter messages.
  148. *
  149. *--------------------------------------------------------------------------
  150. *
  151. *--- Updates --------------------------------------------------------------
  152. *    09/15/88  Added check for mono systems when setting default colors
  153. *    v.1.10    Added implode parameter & code
  154. *              Added ASCAN() function to validate OOPS_RESP[]
  155. *              Added check for cursor on/off state, restores original state
  156. *               on exit (function GETCURS() from EXXTEND.OBJ)
  157. *              Added save of cursor position, restore on exit
  158. *              Corrected bug in explosion code. Exploding box was sometimes
  159. *               larger than final display box.
  160. *--------------------------------------------------------------------------
  161.  
  162. ** PROCEDURE DMSOOPS          && remove ** to make a procedure
  163.  
  164. IF PCOUNT() <> 0              && check if parameters passed in command line
  165.      PARAMETERS TITLE, FRAME, INSTRUCTION, LOCATION, REST_SCRN, EXPLODE, IMPLODE, SHAD_SHOW, SHAD_CHAR, SHAD_SIDE
  166. ENDIF
  167.  
  168. PRIVATE OOPS_TITLE, OOPS_FRAME, OOPS_INS, OOPS_LEN
  169. PRIVATE OOPS_TOP, OOPS_LEFT, OOPS_BOTT, OOPS_RIGHT
  170. PRIVATE MSG_NO, MSG_LEN, ROW_POS, COL_POS, ADJUST
  171. PRIVATE EXP_TOP, EXP_LEFT, EXP_BOTT, EXP_RIGHT
  172. PRIVATE EXP_NO, T_EXP_NO, EXP_SCRN
  173. PRIVATE CURR_COLOR, CURR_ROW, CURR_COL, CURR_CURSOR
  174. PRIVATE X, VALID_RESP, ACTION
  175. PRIVATE LIMIT_TOP, LIMIT_LEFT, LIMIT_BOTT, LIMIT_RIGHT
  176.  
  177. * Parameter validation & default assignments
  178. IF TYPE("TITLE") = "U"
  179.     TITLE = "OOPS"
  180. ENDIF
  181. IF TYPE("FRAME") = "U"
  182.      FRAME = 1
  183. ENDIF
  184. IF TYPE("INSTRUCTION") = "U"
  185.      INSTRUCTION = "Press Any Key to Continue"
  186.      VALID_RESP = .F.
  187. ENDIF
  188. IF TYPE("LOCATION") = "U"
  189.      LOCATION = "C"
  190. ENDIF
  191. IF TYPE("REST_SCRN") = "U"
  192.      REST_SCRN = .T.
  193. ENDIF
  194. IF TYPE("EXPLODE") = "U"
  195.      EXPLODE = .T.
  196. ENDIF
  197. IF TYPE("IMPLODE") = "U"
  198.      IMPLODE = .T.
  199. ENDIF
  200.  
  201. IF .NOT. EXPLODE
  202.      IMPLODE = .F.                 && cannot implode if not exploding
  203. ENDIF
  204.  
  205. IF TYPE("SHAD_SHOW") = "U"
  206.      SHAD_SHOW = .T.
  207. ENDIF
  208. IF TYPE("SHAD_CHAR") = "U"
  209.      SHAD_CHAR = CHR(177)
  210. ENDIF
  211. IF TYPE("SHAD_SIDE") = "U"
  212.      SHAD_SIDE = "R"
  213. ENDIF
  214.  
  215. * Check other memvars assigned by calling .prg, assign defaults
  216. IF TYPE("OOPS_RESP") = "U"         && no validation required
  217.      VALID_RESP = .F.
  218. ELSE
  219.      IF TYPE("OOPS_RESP") = "A"    && make sure it's an array
  220.           VALID_RESP = .T.
  221.      ELSE
  222.           VALID_RESP = .F.
  223.      ENDIF
  224. ENDIF
  225.  
  226. IF TYPE("M_COOPSFR") = "U"         && box frame color
  227.      M_COOPSFR = IF(ISCOLOR(), "W+/R", "W+/ ")      && hi white on red or high white on black
  228. ENDIF
  229. IF TYPE("M_COOPSTIT") = "U"        && box title color
  230.      M_COOPSTIT = IF(ISCOLOR(), "BG+/R", " /W")     && hi cyan on red or black on white
  231. ENDIF
  232. IF TYPE("M_COOPSTXT") = "U"        && box text (messages) color
  233.      M_COOPSTXT = IF(ISCOLOR(), "W+/R", "W/ ")      && hi white on red or white or white on black
  234. ENDIF
  235. IF TYPE ("M_COOPSINS") = "U"       && box instructions color
  236.      M_COOPSINS = IF(ISCOLOR(), "GR+/R", " /W")     && hi yellow on red or black on white
  237. ENDIF
  238. IF TYPE ("M_COOPSSHD") = "U"       && shadow color
  239.      M_COOPSSHD = IF(ISCOLOR(), "R/ ", "W/ ")       && red on black or white on black
  240. ENDIF
  241.  
  242.  
  243. * Setup for display
  244. CURR_COLOR = SETCOLOR()       && save color setting from calling .prg
  245. CURR_ROW = ROW()              && save current row position from calling .prg
  246. CURR_COL = COL()              && save current column position from calling .prg
  247. CURR_CURSOR = GETCURS()       && save cursor on/off state - routine from GETSTAT.OBJ
  248. SAVE SCREEN TO OOPS_SCRN      && save screen from calling .prg
  249. SET CURSOR OFF
  250.  
  251. * Initialize private memvars
  252. LIMIT_TOP = 4
  253. LIMIT_LEFT = 1
  254. LIMIT_BOTT = 22
  255. LIMIT_RIGHT = 79
  256. ACTION = 0
  257. X = 0
  258.  
  259. * Assign private memvars from parameters passed
  260. OOPS_TITLE = SPACE(1) + TITLE + SPACE(1)
  261. OOPS_INS = SPACE(1) + INSTRUCTION + SPACE(1)
  262.  
  263. MSG_NO = LEN(OOPS_MSG)
  264. DECLARE MSG[MSG_NO]
  265. FOR X = 1 TO MSG_NO
  266.      MSG[X] = OOPS_MSG[X]
  267. NEXT
  268.  
  269. IF TYPE("FRAME") = "N"     && passed a numeric choice for frame
  270.      DO CASE
  271.           CASE FRAME = 0
  272.                OOPS_FRAME = "        "
  273.           CASE FRAME = 2
  274.                OOPS_FRAME = "╔═╗║╝═╚║"
  275.           CASE FRAME = 3
  276.                OOPS_FRAME = "╒═╕│╛═╘│"
  277.           CASE FRAME = 4
  278.                OOPS_FRAME = "╓─╖║╜─╙║"
  279.           OTHERWISE
  280.                OOPS_FRAME = "┌─┐│┘─└│"       && FRAME = 1 or not 0,2,3,4
  281.      ENDCASE
  282. ELSE
  283.      OOPS_FRAME = FRAME                      && char string was passed
  284. ENDIF
  285.  
  286.  
  287. * Find MSG_LEN
  288. MSG_LEN = LEN(MSG[1])
  289. FOR X = 1 TO MSG_NO           && make sure all messages are same len
  290.      IF LEN(MSG[X]) > MSG_LEN
  291.           MSG_LEN = LEN(MSG[X])
  292.      ENDIF
  293. NEXT
  294.  
  295. * Make all MSG[] the same length, add spaces to end of each to match
  296. FOR X = 1 TO MSG_NO
  297.      MSG[X] = MSG[X] + SPACE(MSG_LEN - LEN(MSG[X]))
  298. NEXT
  299.  
  300. * Make sure MSG_LEN >= length of OOPS_TITLE & OOPS_INS
  301. IF MSG_LEN < LEN(OOPS_TITLE)
  302.      MSG_LEN = LEN(OOPS_TITLE)
  303. ENDIF
  304. IF MSG_LEN < LEN(OOPS_INS)
  305.      MSG_LEN = LEN(OOPS_INS)
  306. ENDIF
  307.  
  308. * Pad both ends of all MSG[] with spaces if MSG_LEN has changed
  309. DO WHILE .T.
  310.      IF LEN(MSG[1]) < MSG_LEN
  311.           FOR X = 1 TO MSG_NO
  312.                MSG[X] = SPACE(1) + MSG[X] + SPACE(1)
  313.           NEXT
  314.      ELSE
  315.           EXIT
  316.      ENDIF
  317. ENDDO
  318. MSG_LEN = LEN(MSG[1])
  319. OOPS_LEN = MSG_LEN + 4   && "│ " + " │"
  320.  
  321. * Find screen coordinates for oops box
  322. DO CASE
  323.      CASE LOCATION = "UL"
  324.           OOPS_TOP = LIMIT_TOP
  325.           OOPS_LEFT = LIMIT_LEFT
  326.           IF SHAD_SHOW .AND. SHAD_SIDE = "L"
  327.                OOPS_LEFT = OOPS_LEFT + 2
  328.           ENDIF
  329.           OOPS_BOTT = OOPS_TOP + 1 + MSG_NO + 2
  330.           OOPS_RIGHT = OOPS_LEFT + OOPS_LEN - 1
  331.  
  332.      CASE LOCATION = "UR"
  333.           OOPS_TOP = LIMIT_TOP
  334.           OOPS_LEFT = LIMIT_RIGHT - OOPS_LEN
  335.           IF SHAD_SHOW .AND. SHAD_SIDE = "R"
  336.                OOPS_LEFT = OOPS_LEFT - 2
  337.           ENDIF
  338.           OOPS_BOTT = OOPS_TOP + 1 + MSG_NO + 2
  339.           OOPS_RIGHT = OOPS_LEFT + OOPS_LEN - 1
  340.  
  341.      CASE LOCATION = "LL"
  342.           OOPS_TOP = LIMIT_BOTT - MSG_NO - 4
  343.           IF SHAD_SHOW
  344.                OOPS_TOP = OOPS_TOP - 1
  345.          ENDIF
  346.           OOPS_LEFT = LIMIT_LEFT
  347.           IF SHAD_SHOW .AND. SHAD_SIDE = "L"
  348.                OOPS_LEFT = OOPS_LEFT + 2
  349.           ENDIF
  350.           OOPS_BOTT = OOPS_TOP + 1 + MSG_NO + 2
  351.           OOPS_RIGHT = OOPS_LEFT + OOPS_LEN - 1
  352.  
  353.      CASE LOCATION = "LR"
  354.           OOPS_TOP = LIMIT_BOTT - MSG_NO - 4
  355.           IF SHAD_SHOW
  356.                OOPS_TOP = OOPS_TOP - 1
  357.           ENDIF
  358.           OOPS_LEFT = LIMIT_RIGHT - OOPS_LEN
  359.           IF SHAD_SHOW .AND. SHAD_SIDE = "R"
  360.                OOPS_LEFT = OOPS_LEFT - 2
  361.           ENDIF
  362.           OOPS_BOTT = OOPS_TOP + 1 + MSG_NO + 2
  363.           OOPS_RIGHT = OOPS_LEFT + OOPS_LEN - 1
  364.  
  365.      CASE LOCATION = "C"          && center coord = 12,40
  366.           OOPS_TOP = 12 - INT((MSG_NO + 4) / 2)
  367.           OOPS_LEFT = 40
  368.           IF (OOPS_LEN / 2) <> INT(OOPS_LEN / 2)
  369.                OOPS_LEFT = OOPS_LEFT - (INT(OOPS_LEN / 2) + 1)
  370.           ELSE
  371.                OOPS_LEFT = OOPS_LEFT - (OOPS_LEN / 2)
  372.           ENDIF
  373.           OOPS_BOTT = OOPS_TOP + 1 + MSG_NO + 2
  374.           OOPS_RIGHT = OOPS_LEFT + OOPS_LEN - 1
  375. ENDCASE
  376.  
  377. * Begin display
  378. * Box
  379. SET COLOR TO (M_COOPSFR)
  380.  
  381. * Explode
  382. IF EXPLODE
  383.      EXP_TOP = ROUND((OOPS_BOTT - OOPS_TOP) / 2 + (OOPS_TOP - 1),0)
  384.      EXP_LEFT = ROUND((OOPS_RIGHT - OOPS_LEFT) / 2 + (OOPS_LEFT - 1),0)
  385.      EXP_BOTT = ROUND(EXP_TOP + 1,0)
  386.      EXP_RIGHT = ROUND(EXP_LEFT + 1,0)
  387.  
  388.      * Determine # of steps to explode box (needed for implode, allows explode to occur faster)
  389.      EXP_NO = ROUND((EXP_TOP - OOPS_TOP + 1),0)
  390.      T_EXP_NO = ROUND(((OOPS_RIGHT - EXP_RIGHT + 1) / 3),0)
  391.      EXP_NO = IF(EXP_NO < T_EXP_NO, T_EXP_NO, EXP_NO)
  392.  
  393.      IF IMPLODE
  394.           DECLARE EXP_SCRN[EXP_NO]
  395.      ENDIF
  396.  
  397.      FOR X = 1 TO EXP_NO
  398.           @ EXP_TOP, EXP_LEFT, EXP_BOTT, EXP_RIGHT BOX OOPS_FRAME + SPACE(1)
  399.  
  400.           IF IMPLODE
  401.                EXP_SCRN[X] = SAVESCREEN(OOPS_TOP, OOPS_LEFT, OOPS_BOTT, OOPS_RIGHT)  && save box as explodes for implode
  402.           ENDIF
  403.  
  404.           IF EXP_TOP > OOPS_TOP
  405.                EXP_TOP = EXP_TOP - 1
  406.           ENDIF
  407.           IF (EXP_LEFT - 3) > OOPS_LEFT
  408.                EXP_LEFT = EXP_LEFT - 3
  409.           ENDIF
  410.           IF EXP_BOTT < OOPS_BOTT
  411.                EXP_BOTT = EXP_BOTT + 1
  412.           ENDIF
  413.           IF (EXP_RIGHT + 3) < OOPS_RIGHT
  414.                EXP_RIGHT = EXP_RIGHT + 3
  415.           ENDIF
  416.      NEXT
  417. ENDIF
  418. @ OOPS_TOP, OOPS_LEFT, OOPS_BOTT, OOPS_RIGHT BOX OOPS_FRAME + SPACE(1)
  419.  
  420. * Shadow
  421. IF SHAD_SHOW
  422.      SET COLOR TO (M_COOPSSHD)
  423.      IF SHAD_SIDE = "R"
  424.           COL_POS = OOPS_RIGHT + 1
  425.      ELSE
  426.           COL_POS = OOPS_LEFT - 2
  427.      ENDIF
  428.      FOR X = (OOPS_TOP + 1) TO (OOPS_TOP + 1 + MSG_NO + 2)
  429.           @ X,COL_POS SAY SHAD_CHAR + SHAD_CHAR
  430.      NEXT
  431.      IF SHAD_SIDE = "R"
  432.           COL_POS = OOPS_LEFT + 1
  433.      ELSE
  434.           COL_POS = OOPS_LEFT - 2
  435.      ENDIF
  436.  
  437.      @ X,COL_POS SAY REPLICATE(SHAD_CHAR,(OOPS_LEN + 1))
  438. ENDIF
  439.  
  440. * Title
  441. ADJUST = (OOPS_LEN - LEN(OOPS_TITLE))
  442. ADJUST = INT(ADJUST / 2)
  443.  
  444. SET COLOR TO (M_COOPSFR)
  445. @ OOPS_TOP,(OOPS_LEFT + ADJUST - 1) SAY "["
  446. SET COLOR TO (M_COOPSTIT)
  447. @ OOPS_TOP,(OOPS_LEFT + ADJUST) SAY OOPS_TITLE
  448. SET COLOR TO (M_COOPSFR)
  449. @ OOPS_TOP,(OOPS_LEFT + ADJUST + LEN(OOPS_TITLE)) SAY  "]"
  450.  
  451. * Messages
  452. SET COLOR TO (M_COOPSTXT)
  453. @ (OOPS_TOP + 1),(OOPS_LEFT + 1) SAY SPACE(MSG_LEN + 2)
  454. ROW_POS = OOPS_TOP + 2
  455. FOR X = 1 TO MSG_NO
  456.      @ ROW_POS,(OOPS_LEFT + 1) SAY SPACE(1) + MSG[X] + SPACE(1)
  457.      ROW_POS = ROW_POS + 1
  458. NEXT
  459. @ (OOPS_BOTT - 1),(OOPS_LEFT + 1) SAY SPACE(MSG_LEN + 2)
  460.  
  461. * Instructions
  462. ADJUST = (OOPS_LEN - LEN(OOPS_INS))
  463. ADJUST = INT(ADJUST / 2)
  464.  
  465. SET COLOR TO (M_COOPSFR)
  466. @ OOPS_BOTT,(OOPS_LEFT + ADJUST - 1) SAY "["
  467. SET COLOR TO (M_COOPSINS)
  468. @ OOPS_BOTT,(OOPS_LEFT + ADJUST) SAY OOPS_INS
  469. SET COLOR TO (M_COOPSFR)
  470. @ OOPS_BOTT,(OOPS_LEFT + ADJUST + LEN(OOPS_INS)) SAY  "]"
  471.  
  472.  
  473. * Get response (ACTION)
  474. IF VALID_RESP
  475.      DO WHILE .T.
  476.           TONE(920,3)
  477.           ACTION = INKEY(0)
  478.           OOPS_ACTION = UPPER(CHR(ACTION))   && alpha/numeric
  479.  
  480.           IF ASCAN(OOPS_RESP,OOPS_ACTION) <> 0
  481.                EXIT
  482.           ENDIF
  483.      ENDDO
  484. ELSE
  485.      TONE(920,3)
  486.      INKEY(0)
  487. ENDIF
  488.  
  489.  
  490. * Implode screen if set
  491. IF IMPLODE .AND. REST_SCRN
  492.      FOR X = EXP_NO TO 1 STEP -1
  493.           RESTSCREEN(OOPS_TOP, OOPS_LEFT, OOPS_BOTT, OOPS_RIGHT, EXP_SCRN[X])
  494.      NEXT
  495. ENDIF
  496.  
  497.  
  498. SET COLOR TO (CURR_COLOR)               && restore color setting
  499.  
  500. IF CURR_CURSOR
  501.      SET CURSOR ON                      && turn cursor on if was on
  502. ENDIF
  503.  
  504. @ CURR_ROW, CURR_COL SAY SPACE(0)       && restore cursor positions
  505.  
  506. IF REST_SCRN
  507.      RESTORE SCREEN FROM OOPS_SCRN
  508. ENDIF
  509.  
  510. RETURN
  511.  
  512. *--------------------------------------------------------------------------
  513. *    EOP  DMSOOPS.PRG
  514. *--------------------------------------------------------------------------