home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / amsg.prg < prev    next >
Text File  |  1993-10-14  |  4KB  |  122 lines
  1. /*
  2.  * GT CLIPPER STANDARD HEADER
  3.  *
  4.  * File......: amsg.prg
  5.  * Author....: Andy M Leighton
  6.  * BBS.......: The Dark Knight Returns
  7.  * Net/Node..: 050/069
  8.  * User Name.: Andy Leighton
  9.  * Date......: $Date$
  10.  * Revision..: $Revision$
  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_AMSG()
  25.  *  $CATEGORY$
  26.  *       Video
  27.  *  $ONELINER$
  28.  *       Boxed multi line message
  29.  *  $SYNTAX$
  30.  *       GT_aMsg([<aMss>], [<lWait>], [<cColour>]) --> NIL
  31.  *  $ARGUMENTS$
  32.  *       <nKVal>       - the inkey() value
  33.  *       <cChkLetter>  - the letter to check for
  34.  *  $RETURNS$
  35.  *       NIL
  36.  *  $DESCRIPTION$
  37.  *       This function has 3 modes of operation
  38.  *          1.  if <lWait> is TRUE display the message in a box
  39.  *              and wait for a keypress.  Restire the screen when
  40.  *              complete.
  41.  *          2.  if <lWait> is FALSE or undefined, save the screen
  42.  *              to a stack, display the message and return
  43.  *          3.  if both <lWait> and <aMss> are undefined, restore
  44.  *              the screen from the saved stack.
  45.  *              The positioning information is optional and if it is left
  46.  *              out the screen will restore to the postion it was saved.
  47.  *              If coordinates are passed, they must represent an area
  48.  *              exactly equal to that of the saved screen and in the same
  49.  *              proportion otherwise the function will return .F.
  50.  *  $EXAMPLES$
  51.  *       aMsg( { "Line 1 of Message",              ;
  52.  *               "Line 2 of Message",              ;
  53.  *               "Last Line of Message" }, TRUE)
  54.  *  $CAVEATS$
  55.  *       Assumes every element of the array is a character.
  56.  *       Gets in trouble if the length of an array element is
  57.  *       longer than maxcol() - 3
  58.  *  $END$
  59.  */
  60.  
  61. #include "gt_LIB.ch"
  62.  
  63. // translate for aMaxStrLen()
  64. // works a bit like the one in FuncKy
  65.  
  66. #translate amaxstrlen(<a>)      =>     len(GT_AComp(<a>, AC_MAXLEN))
  67.  
  68. function GT_aMsg(aMss, lWait, cColour)
  69.  
  70.    static aScrs := {}               // inbuilt stack - faster than general
  71.                                     // purpose stack functions
  72.  
  73.    local nLines
  74.    local nWidth
  75.     local i
  76.    local nLeft
  77.    local nTop
  78.    local nRight
  79.    local nBottom
  80.  
  81.    if aMss == NIL .and. lWait == NIL
  82.       if len(aScrs) > 0             // pop last screen from stack
  83.          i := len(aScrs)
  84.          restscreen(aScrs[i][1], aScrs[i][2], aScrs[i][3], aScrs[i][4], ;
  85.                      aScrs[i][5])
  86.          aScrs := aSize(aScrs, i - 1)
  87.       endif
  88.    else
  89.       default lWait   to .F.
  90.       default cColour to 'W+/R'
  91.  
  92.       nLines  := len(aMss) + 3
  93.       nWidth  := aMaxStrLen(aMss) + 3
  94.       nLeft   := (maxcol() - nWidth) / 2
  95.       nTop    := (maxrow() - nLines) / 2
  96.       nRight  := (maxcol() + nWidth) / 2
  97.       nBottom := (maxrow() + nLines) / 2
  98.  
  99.       dispbegin()
  100.       aAdd(aScrs, { nTop, nLeft, nBottom, nRight, ;
  101.                      savescreen(nTop, nLeft, nBottom, nRight) })
  102.  
  103.       @ nTop, nLeft, nBottom, nRight box B_DOUBLE + " " color cColour
  104.  
  105.       for i := 1 to nLines - 3
  106.          @ nTop + i + 1, nLeft + 2 say ;
  107.                       strcenter(aMss[i], nWidth - 3) color cColour
  108.       next
  109.  
  110.       dispend()
  111.  
  112.       if lWait
  113.          waitkey(0)
  114.          i := len(aScrs)
  115.          restscreen(aScrs[i][1], aScrs[i][2], aScrs[i][3], aScrs[i][4], ;
  116.                      aScrs[i][5])
  117.          aScrs := aSize(aScrs, i - 1)
  118.       endif
  119.    endif
  120.  
  121. return NIL
  122.