home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FFA.ZIP / TIMER.SEQ < prev    next >
Encoding:
Text File  |  1987-11-26  |  2.8 KB  |  84 lines
  1. \ TIMER.SEQ      Time measurment words for PF.
  2.  
  3. : GETDATE       ( --- Y MD ) 0 0 42 OS2 DROP ;
  4.  
  5. : SETDATE       ( NM Y --- ) SWAP 43 OS2 NIP NIP 255 =
  6.                 IF      CR ." Invalid DATE " THEN ;
  7.  
  8. : GETTIME       ( --- HM Sh ) 0 0 44 OS2 DROP ;
  9.  
  10. : SETTIME       ( HM Sh --- ) SWAP 45 OS2 NIP NIP 255 =
  11.                 IF      CR ." Invalid TIME " THEN ;
  12.  
  13. : .##           ( N1 --- )      \ Print two low digits of n1.
  14.                 0 <# # # #> TYPE ;
  15.  
  16. : <.HM>         ( D1 --- N1 )
  17.                 SWAP 0 256 UM/MOD .## ." :" .## ;
  18.  
  19. : <.SH>         ( N1 --- )
  20.                 ." :" 0 256 UM/MOD .## ." ." .## ;
  21.  
  22. : <.TIME>       BASE @ >R DECIMAL SWAP 0 256 UM/MOD .## ." :" .##
  23.                                  ." :" 0 256 UM/MOD .## ." ." .##
  24.                 R> BASE ! SPACE ;
  25.  
  26. : .TIME         GETTIME <.TIME> ;
  27.  
  28. : <.DATE>       ( D1 --- )
  29.                 BASE @ >R DECIMAL
  30.                 0 256 UM/MOD .## ." /" .## ." /" 1900 - .##
  31.                 R> BASE ! ;
  32.  
  33. : .DATE         GETDATE <.DATE> ;
  34.  
  35. VARIABLE STIME 0 ,
  36. VARIABLE TTIME 0 ,
  37.  
  38. : T>B           0 256 UM/MOD 100 * + SWAP 0 SWAP
  39.                 0 256 UM/MOD >R 6000 *D D+ R> 1000 * 360 *D D+ ;
  40.  
  41. : B>T           0 100 UM/MOD >R 100 UM/MOD SWAP TTIME C!
  42.                              R>  60 UM/MOD SWAP TTIME 1+ C!
  43.                                  60   /MOD      TTIME 3 + C!
  44.                                                 TTIME 2+ C! ;
  45.  
  46. : TIME-RESET    GETTIME T>B STIME 2! ;  \ RESET TIMER
  47.  
  48. : TIME-ELAPSED  GETTIME T>B STIME 2@ D- ; ( - D1 ) \ BINARY
  49.  
  50. : B>SEC         ( D1 - N1 )      \ CONVERT DOUBLE BINARY TO
  51.                 0 100 UM/MOD DROP   \ SECONDS, OVERFLOW AT 18 HRS
  52.                   100 UM/MOD NIP ;
  53.  
  54. : .ELAPSED      CR ." Elapsed time = " TIME-ELAPSED B>T TTIME 2@ <.TIME> ;
  55.  
  56. : TIMER         TIME-RESET INTERPRET .ELAPSED ;
  57.  
  58. : SEC-ELAPSED   ( --- N1 )    \ RETURN ELAPSED SECONDS < 18 HRS
  59.                 TIME-ELAPSED B>SEC ; ( -- N1 )
  60.  
  61. : 10TH-ELAPSED  ( --- N1 )
  62.                 TIME-ELAPSED 0 100 UM/MOD DROP 10 UM/MOD NIP ;
  63.  
  64. DEFER PAUSE-FUNC        ' NOOP IS PAUSE-FUNC
  65.  
  66. : SECONDS       ( N1 --- )   \ PAUSE FOR N1 SECONDS
  67.                 STIME 2@ >R >R >R TIME-RESET
  68.                 BEGIN   PAUSE  PAUSE-FUNC
  69.                         R@ SEC-ELAPSED > 0=
  70.                 UNTIL   R> DROP R> R> STIME 2! ;
  71.  
  72. : TENTHS        ( N1 --- )       \ PAUSE FOR N1 SECONDS
  73.                 STIME 2@ >R >R >R TIME-RESET
  74.                 BEGIN   PAUSE  PAUSE-FUNC
  75.                         R@ 10TH-ELAPSED > 0=
  76.                 UNTIL   R> DROP R> R> STIME 2! ;
  77.  
  78. : MINUTES       ( N1 --- )   \ PAUSE FOR N1 MINUTES
  79.                 0 MAX   0 ?DO   60 SECONDS      LOOP ;
  80.  
  81. : HOURS         ( N1 --- )       \ PAUSE FOR N1 HOURS
  82.                 0 MAX   0 ?DO   60 MINUTES      LOOP ;
  83.  
  84.