home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_alert.prg < prev    next >
Text File  |  1994-08-29  |  6KB  |  217 lines
  1. /*
  2.  * GT CLIPPER STANDARD HEADER
  3.  *
  4.  * File......: gt_alert.prg
  5.  * Author....: Andy M Leighton
  6.  * BBS.......: The Dark Knight Returns
  7.  * Net/Node..: 050/069
  8.  * User Name.: Andy Leighton
  9.  * Date......: 21-05-93
  10.  * Revision..: 1.1
  11.  *
  12.  * This is an original work by Andy Leighton and is placed in the
  13.  * public domain.
  14.  *
  15.  * Modification history:
  16.  * ---------------------
  17.  *
  18.  * $Log$
  19.  *
  20.  */
  21.  
  22. /*  $DOC$
  23.  *  $FUNCNAME$
  24.  *       GT_ALERT()
  25.  *  $CATEGORY$
  26.  *       Video
  27.  *  $ONELINER$
  28.  *       Alert() replacement
  29.  *  $SYNTAX$
  30.  *       GT_Alert(<aMss>, <aOpts>, <lSave>, <aColour>) --> nChoice
  31.  *  $ARGUMENTS$
  32.  *       <aMss>     - An array of messages
  33.  *       <aOpts>    - An array of prompts / choices for the alert
  34.  *       <lSave>    - .T. if we need the screen saving and restoring
  35.  *       <aColour>  - Colour Spec Array
  36.  *                      1st element, border & normal text & unselected prompt
  37.  *                      2nd element, selected prompt
  38.  *  $RETURNS$
  39.  *       nPos       - The prompt/choice selected otherwise 0 if escape was
  40.  *                    pressed
  41.  *  $DESCRIPTION$
  42.  *       The GT_Alert() function creates a slightly less simple dialog
  43.  *       than the standard Alert() function.  Use it wherever you would
  44.  *       Alert().
  45.  *
  46.  *       It has a number of differences / advantages over the standard
  47.  *       alert().
  48.  *
  49.  *       These are
  50.  *          ■  Optional saving/restoring of the screen area.
  51.  *          ■  The message is passed as an array of character strings
  52.  *          ■  GT_Alert() can check the setkey handler.
  53.  *
  54.  *       KNOWN PROBLEMS
  55.  *          Does not check setkey handler yet - read the code
  56.  *          Spacing of prompts look poor in some cases.
  57.  *          These problems are known and will be fixed RSN
  58.  *
  59.  *          These problems have now been fixed.
  60.  *          If you find any more please report the,
  61.  *
  62.  *       CAVEATS
  63.  *       ■  Does not check that the elements in the arrays are character
  64.  *          strings
  65.  *       ■  Does not check that the prompts will fit on the machine
  66.  *
  67.  *  $EXAMPLES$
  68.  *          .
  69.  *          .
  70.  *          nChoice := GT_Alert( { "GT Example System",              ;
  71.  *                                 "Do You Want To Quit" },          ;
  72.  *                               { "Yes", "No", "Not Sure"}, TRUE)
  73.  *
  74.  *          do case
  75.  *             case nChoice == 1
  76.  *                ? "You have chosen to quit"
  77.  *             case nChoice == 2
  78.  *                ? "You have chosen not to quit"
  79.  *             case nChoice == 3
  80.  *                ? "Make up your mind"
  81.  *             otherwise
  82.  *                ? "Escape pressed"
  83.  *          endcase
  84.  *
  85.  *  $SEEALSO$
  86.  *  $END$
  87.  */
  88.  
  89. #include "gt_lib.ch"
  90.  
  91. // translate for aMaxStrLen()
  92. // works like the one in FuncKy
  93.  
  94. #translate aMaxStrLen(<a>)      =>     len(GT_AComp(<a>, AC_MAXLEN))
  95.  
  96.  
  97. function GT_Alert(aMss, aOpts, lSave, aColour)
  98.  
  99.    local nLines
  100.    local nWidth
  101.    local nWideCh
  102.    local nWidePr
  103.     local i
  104.    local nLeft
  105.    local nTop
  106.    local nRight
  107.    local nBottom
  108.    local nChoice
  109.    local nPos
  110.    local nLKey    := 0
  111.    local aPos     := array(len(aOpts))
  112.    local oldPos
  113.    local lFinish  := FALSE
  114.    local svScr
  115.  
  116.    default aColour to {'W+/R', 'W+/B'}
  117.    default lSave   to TRUE
  118.  
  119.    nLines  := len(aMss) + 3
  120.    nWidth  := aMaxStrLen(aMss) + 3
  121.    nTop    := (maxrow() - nLines) / 2
  122.    nBottom := (maxrow() + nLines) / 2
  123.    nWideCh := 4
  124.  
  125.    for i := 1 to len(aOpts)
  126.       nWideCh += len(aOpts[i]) + 2
  127.    next
  128.    nWidth  := max(nWidth, nWideCh)
  129.    nLeft   := (maxcol() - nWidth) / 2
  130.    nRight  := (maxcol() + nWidth) / 2
  131.  
  132.    if lSave
  133.       svScr := GT_SaveScr(nTop, nLeft, nBottom, nRight)
  134.    endif
  135.  
  136.    dispbegin()
  137.  
  138.    // draw the box
  139.  
  140.    @ nTop, nLeft, nBottom, nRight box B_SINGLE + " " color aColour[1]
  141.  
  142.    // draw the message strings
  143.  
  144.    for i := 1 to len(aMss)
  145.       @ nTop + i + 1, nLeft + 2 say ;
  146.                      strcenter(aMss[i], nWidth - 3) color aColour[1]
  147.    next
  148.  
  149.    // work out spacing between prompts to make it look more
  150.    // sexy than the original
  151.  
  152.    if nWideCh < aMaxStrLen(aMss) + 3
  153.       nWidePr := -2
  154.       for i := 1 to len(aOpts)
  155.          nWidePr := nWidePr + len(aOpts[i]) + 2
  156.       next
  157.       nPos := 1 + int(max(nWidth - nWidePr, 2) / 2)
  158.    else
  159.       nPos := 3
  160.    endif
  161.  
  162.    // draw the prompts
  163.  
  164.    for i := 1 to len(aOpts)
  165.       @ nBottom - 1, nLeft + nPos say aOpts[i] color aColour[1]
  166.       aPos[i] := nLeft + nPos
  167.       nPos    := nPos + len(aOpts[i]) + 2
  168.    next
  169.    dispend()
  170.  
  171.    nChoice := 1
  172.    oldPos  := 0
  173.  
  174.    do while !lFinish
  175.       if oldPos != nChoice
  176.          // we have moved so move the highlight bar
  177.  
  178.          dispbegin()
  179.          if oldPos != 0
  180.             @ nBottom - 1, aPos[oldPos] say aOpts[oldPos] color aColour[1]
  181.          endif
  182.          @ nBottom - 1, aPos[nChoice] say aOpts[nChoice] color aColour[2]
  183.          oldPos := nChoice
  184.          dispend()
  185.       endif
  186.  
  187.       nLKey := GT_inkey(0)
  188.  
  189.       do case
  190.          case nLKey == K_ESC              // ESC pressed, quit
  191.             lFinish := TRUE
  192.             nChoice := 0
  193.          case nLKey == K_RETURN           // CR pressed, choose current
  194.             lFinish := TRUE
  195.          case nLKey == K_HOME             // HOME pressed, go to first prompt
  196.             nChoice := 1
  197.          case nLKey == K_END              // END pressed, go to last prompt
  198.             nChoice := len(aPos)
  199.          case nLKey == K_RIGHT            // RIGHT pressed, right a prompt
  200.             nChoice++
  201.             if nChoice > len(aPos)        // handle wraparound
  202.                nChoice := len(aPos)
  203.             endif
  204.          case nLKey == K_LEFT             // LEFT pressed, left a prompt
  205.             nChoice--
  206.             if nChoice < 1
  207.                nChoice := 1
  208.             endif
  209.       endcase
  210.    enddo
  211.  
  212.    if lSave                               // Restore screen before leaving
  213.       GT_RestScr(svScr)
  214.    endif
  215.  
  216. return nChoice
  217.