home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / clipper / timer / ontick / ontick.prg < prev    next >
Encoding:
Text File  |  1992-05-12  |  3.8 KB  |  159 lines
  1. /*
  2. **    Program..: ontick.prg
  3. **    Author...: Brenton Farmer
  4. **    Date.....: 10/10/91
  5. **
  6. **    Purpose..: Set of routines to indirectly attach a Clipper function to the
  7. **            system clock interrupt int 8 in order to evaluate the function
  8. **            on a timed interval.
  9. **
  10. */
  11. #include "inkey.ch"
  12. #define TRUE  .T.
  13. #define FALSE .F.
  14.  
  15. Static bFunction
  16.  
  17. #define _TEST
  18. #ifdef _TEST
  19. Function Main()
  20. Local cString0 := "Now Is the Time ...     "
  21. Local cString1 := "Get Test                "
  22. Local nCount, nInt8Key := 255
  23.  
  24.     cls
  25.     onTick( 1, "ShowTime")
  26.  
  27.     @10,00 say "Type some stuff:" get cString0
  28.     @11,00 say "Type some more :" get cString1
  29.     read
  30.  
  31.    DevPos(13,00)
  32.    qout()
  33.    qout("For Loop Tests.  (Press any key to terminate each test)")
  34.    qout("-------------------------------------------------------")
  35.  
  36.    qout("Inkey()    Test (NO WAIT-STATE)   ")
  37.    nRow := row()
  38.    nCol := col()
  39.     for nCount := 20000 to 1 step -1
  40.       DevPos( nRow, nCol)
  41.       DevOut( nCount)
  42.         nKey := Inkey()
  43.         if ( nKey != 0 .and. nKey != nInt8Key)    // ignore hotkey
  44.             exit
  45.         endif
  46.     next
  47.  
  48.    qout("HotInkey() Test (WAIT-STATE)      ")
  49.    nRow := row()
  50.    nCol := col()
  51.     for nCount := 20000 to 1 step -1
  52.       DevPos( nRow, nCol)
  53.       DevOut( nCount)
  54.  
  55.         if ( HotInkey() != 0)
  56.             exit
  57.         endif
  58.     next
  59.    qout()
  60.  
  61.     onTick()
  62.  
  63. Return ( NIL)
  64.  
  65. Function ShowTime()
  66. Local nRow, nCol, nCursor, cColor
  67.  
  68.     nCursor := setcursor( 0)
  69.     cColor := setcolor("w/n")
  70.     nRow := row()
  71.     nCol := col()
  72.     DevPos( 10,70)
  73.     DevOut( time())
  74.     setpos( nRow, nCol)
  75.     setcolor( cColor)
  76.     setcursor( nCursor)
  77.  
  78. Return ( NIL)
  79.  
  80.  
  81. /*
  82. ** Inkey() replacement that is wait-state aware
  83. **
  84. */
  85. Function HotInkey( nSeconds)
  86. Local nInkey, bHotKey
  87.  
  88.    While ( TRUE)
  89.         if (( nInkey := if( nSeconds == NIL, inkey(), inkey( nSeconds))) != 0;
  90.             .and. ( bHotKey := setkey( nInKey)) != NIL)
  91.           eval( bHotKey, procname(2), procline(2), "")
  92.          loop
  93.       endif
  94.         exit
  95.     enddo
  96.  
  97. Return ( nInKey)
  98. #endif
  99.  
  100.  
  101. /*
  102. **    Void onTick( nTime, cUserFunc, [ nHotKey])
  103. **
  104. ** Attach/UnAttach a Clipper function to the system time interrupt.
  105. **
  106. **    If the function was called with nTime and cUserFunc values attempt
  107. **    to attach ( cUserFunc) to the system timer so that it is executed
  108. ** every nTime seconds.  The system timer is hit 18.2 times ( ticks)
  109. ** a second so nTime must be converted into ticks ( int( nTime * 18.2)).
  110. ** If ontick() is called without parameters and we have previously attached
  111. ** a function unattach it and restore the original int 8 interrupt
  112. ** vector.
  113. **
  114. ** Arguments:
  115. ** nTime            = Time interval to call ( cUserFunc) expressed in seconds.
  116. **    cUserFunc    = Name of Clipper function to execute every nTime seconds
  117. ** nHotKey     = Inkey value to be stuffed into the keyboard buffer
  118. **
  119. */
  120. Function onTick( nTime, cUserFunc, nHotKey)
  121. Static lActive := FALSE
  122.  
  123.     nHotKey := if( valtype( nHotKey) != "N", 255, nHotKey)
  124.  
  125.     /*
  126.     ** If we have previously redirected the int 8 interrupt vector to our
  127.     ** own routine restore it to its original value.  Unlatch our error
  128.     ** handler
  129.     */  
  130.     if ( lActive)
  131.         setkey( nHotKey, NIL)
  132.         C10ckSet( 0, 0)
  133.         lActive := FALSE
  134.     endif
  135.  
  136.     /*
  137.     **    If the onTick() was called with nTime and cUserFunc values attempt
  138.     **    to attach ( cUserFunc) to the system timer.  Do the following:
  139.     **
  140.     ** 1.  Ensure that ( cUserFunc) has been linked in.
  141.     ** 2.  Compile cUserFunc into code block bFunction in order to
  142.     **     cut down runtime overhead.
  143.     ** 3.  Convert nTime into timer ticks and call the C C10ckSet() function.
  144.     **    4.  Set the lActive flag true.
  145.     */
  146.     if ( nTime != NIL .and. cUserFunc != NIL)
  147.         if !( type( alltrim( cUserFunc)+"()") == "U")
  148.             bFunction := &("{||" + cUserFunc + "()}")
  149.             setkey( nHotKey, bFunction)
  150.             C10ckSet( int( nTime * 18.2), nHotKey)
  151.             lActive := TRUE
  152.         endif
  153.     endif
  154.  
  155. Return ( NIL)
  156.  
  157.  
  158.  
  159.