home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 7 / POWERCD7.ISO / prgmming / clipper / gt_inter.prg < prev    next >
Text File  |  1993-10-14  |  3KB  |  84 lines
  1. /*
  2.  File......: GT_INTER.prg
  3.  Author....: Phillip Hamlyn
  4.  BBS.......: The Dark Knight Returns
  5.  Net/Node..: 050/069
  6.  User Name.: Phillip Hamlyn
  7.  Date......: 03/03/93
  8.  Revision..: 1.0
  9.  
  10.  This is an original work by Phillip Hamlyn and is placed in the
  11.  public domain.
  12.  
  13.  Modification history:
  14.  ---------------------
  15.  
  16.  Rev 1.0 03/03/93
  17.  Initial revision.
  18. */
  19.  
  20. /*  $DOC$
  21.  *  $FUNCNAME$
  22.  *      GT_INTERRUPT()
  23.  *  $CATEGORY$
  24.  *      Video
  25.  *  $ONELINER$
  26.  *      GET/SET block for screen saver interrupts
  27.  *  $SYNTAX$
  28.  *      GT_Interrupt([{|| bInterrupt} ]) -> NIL | bOldInterrupt
  29.  *  $ARGUMENTS$
  30.  *      <bInterrupt> This optional parameter replaces the current interrupt
  31.  *                   trapping block. This block should return TRUE or FALSE
  32.  *                   and will be evaluated by other modules in order to
  33.  *                   determine how the user can interrupt their processing.
  34.  *  $RETURNS$
  35.  *      bOldInterrupt - The function returns the currently active interrupt
  36.  *                      block.  When this block is Evaluated, it will return
  37.  *                      TRUE or FALSE indicating whether the user has
  38.  *                      interrupted the current process.
  39.  *  $DESCRIPTION$
  40.  *      Get-Set function that stores and returns a codeblock which is used to
  41.  *      interrupt screen savers and other tasks. Screen savers should
  42.  *      interrogate the functions return to see when they should stop rather
  43.  *      than using inkey(), mouseclick() etc. The default interrupt block
  44.  *      is {|| inkey() > 0 }.
  45.  *  $EXAMPLES$
  46.  *      GT_Interrupt( {|| Inkey() > 0 .or. MouseClick() > 0 } )
  47.  *          --> bOldInterrupt
  48.  *  $SEEALSO$
  49.  *
  50.  *  $INCLUDE$
  51.  *
  52.  *  $END$
  53.  */
  54.  
  55. #INCLUDE "gt_lib.ch"
  56. #include "error.ch"
  57.  
  58. //===================
  59. function GT_Interrupt ( bNewInter )
  60. //===================
  61. static bOldInter := {|| Inkey() != 0 }
  62. local bRet, oError
  63. bRet := bOldInter
  64.  
  65. if bNewInter != NIL
  66.    // only assign the new interrupt if it is a code block
  67.    if valtype(bNewInter) != TYPE_BLOCK
  68.       // major error, the programmer should get to know about this.
  69.       // only check here because other modules rely on this parameter
  70.       // being a code block. Normaly I wouldnt bother and just let them
  71.       // suffer when it eventualy falls over. Kind soul arn't I ?
  72.       oError := ErrorNew()
  73.       oError:description := "Non Codeblock parameter passed"
  74.       oError:subcode := 1
  75.       oError:subsystem := "GT_Interrupt"
  76.       oError:severity := ES_ERROR
  77.       // Fire up the error system
  78.       eval(ErrorBlock(),oError)
  79.    endif
  80.    bOldInter := bNewInter
  81. endif
  82.  
  83. return bRet
  84.