home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff239.lzh / JGoodies / Brunjes / Date&Time < prev    next >
Text File  |  1989-08-21  |  4KB  |  124 lines
  1. \
  2. \  Date and Time words (uses AmigaDOS DateStamp facility)
  3. \
  4. \  Author:  Roy E. Brunjes          17 August 1988
  5. \
  6. \ Load this code then to test, enter:
  7. \          .TIME$   ( to show formatted time )
  8. \          .DATE$   ( to show formatted date )
  9.  
  10. Anew TASK-Date&Time
  11.  
  12. CREATE MONTHS        ( # days per month in bytes )
  13.        HEX  1F1C1F1E , 1F1E1F1F , 1E1F1E1F ,
  14.        DECIMAL
  15.  
  16.  
  17.    50                 CONSTANT Ticks/Sec     ( # Ticks   in  1 Second )
  18.    60                 CONSTANT Secs/Min      ( # Seconds in  1 Minute )
  19. Secs/Min      60 *    CONSTANT Secs/Hour     ( # Seconds in  1 Hour   )
  20. Secs/Hour     12 *    CONSTANT Secs/12Hours  ( # Seconds in 12 Hours  )
  21. Secs/12Hours   2 *    CONSTANT Secs/Day      ( # Seconds in  1 Day    )
  22.  
  23. Variable Current.Time 0 , 0 ,                \ Note this is 3 32-bit words
  24.  
  25. : MyLoadTime ( adr -- ) >ABS CALL dos_lib datestamp DROP ;
  26.  
  27. : @CLOCK  ( -- ticks minutes days )  \ Return time since 01 Jan 78
  28.        Current.Time myloadtime
  29.        Current.Time cell+ cell+ @    ( ticks   since last minute )
  30.        Current.Time cell+ @          ( minutes since midnight    )
  31.        Current.Time @                ( days    since 01/01/78    )
  32. ;
  33.  
  34. : DAYS>  ( # of days since 01 Jan 78 -- Year Day Month )
  35.       730 -                                 ( Jump to leap year 1980 )
  36.       1461 /MOD  4 *  1980 +                ( Stack: Day Year )
  37.       SWAP  DUP 60 <                        ( Is this a leap year? )
  38.       IF                                    ( If so, a special case )
  39.           DUP 31 <
  40.           IF   1
  41.           ELSE 31 - 2
  42.           THEN
  43.       ELSE
  44.           1-  365 /MOD  ROT +  SWAP
  45.           13 1
  46.           DO
  47.              I  1- Months + C@  2DUP <
  48.              IF   DROP  I  LEAVE
  49.              ELSE -
  50.              THEN
  51.           LOOP
  52.       THEN                                  ( Year Day-1 Month )
  53.       SWAP 1+ SWAP  ;
  54.  
  55. : Hold.Month  ( month# --  formats month into date string )
  56.      1- 4 *
  57.      " -Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-"  ( length = 49 )
  58.      1+  + dup 4 + -do i c@ hold -1 +loop ;
  59.  
  60. : Fmt.Date$  ( #Days -- addr\cnt )
  61.      No-Commas Days> >R                   \ Put month on return stack
  62.      100 *                                \ Prepare to create ddyy string
  63.                                           \ (shift dd 2 places to left)
  64.      SWAP 1900 -                          \ Convert to 2-digit year
  65.      +                                    \ Convert to ddyy numeric string
  66.      S->D <# # #                          \ Convert yy portion
  67.      R> Hold.Month                        \ Convert to string-based month
  68.      # # #>                               \ Convert date to string
  69.      Commas ;
  70.  
  71. : Get.Date$  ( addr -- )      \ Put date string at addr (no count byte set)
  72.                               \ (date string is 9 bytes long).
  73.     >R  @CLOCK
  74.     Fmt.Date$
  75.     R>  SWAP
  76.     CMOVE  2DROP  ;
  77.  
  78. : .Date$  ( --- )  @Clock Fmt.Date$  TYPE 2DROP  ;
  79.  
  80.  
  81. \  Words for handling time-related things
  82.  
  83.  
  84. : (:00)  ( d -- )             \ Internal word used for formatting times
  85.   #  6 BASE !  #  DECIMAL  ASCII : HOLD  ;
  86.  
  87. : Fmt.Time$  ( #seconds -- addr\cnt )
  88. \
  89. \ This confusing word builds an ASCII string for typing that will be the
  90. \ time.  It builds the string from right to left.
  91. \
  92.      No-Commas
  93.      BASE @ >R                               ( Save existing BASE )
  94.      DECIMAL
  95.      <#  ASCII m  HOLD                       ( Rightmost char is a 'm'    )
  96.          DUP  Secs/12Hours < NOT             ( Is it AM or PM? TRUE if PM )
  97.          IF   ASCII p  HOLD                  ( Put the 'p' before the 'm' )
  98.               Secs/12Hours 2DUP
  99.               Secs/Hour +
  100.               1- WITHIN? NOT                 ( If past noon: - 12 hrs     )
  101.               IF   Secs/12Hours -  THEN
  102.          ELSE                                ( It is am, not pm )
  103.               ASCII a  HOLD                  ( Put the 'a' before the 'm' )
  104.          THEN
  105.      BL  HOLD
  106.      S->D (:00)   (:00)  # #                 ( Finish up the formatting )
  107.      #>                                      ( Push string addr & count )
  108.      R> BASE !                               ( Restore old BASE )
  109.      Commas
  110. ;
  111.  
  112. : Seconds  ( -- #Seconds )
  113.     @CLOCK  DROP
  114.     60 * SWAP
  115.     Ticks/Sec 2/
  116.     +                                        ( Round up to next second )
  117.     Ticks/Sec W/ +  ;
  118.  
  119. : Get.Time$  ( addr -- )      \ Note:  Time string is 11 characters
  120.     Seconds Fmt.Time$  ROT SWAP CMOVE  ;
  121.  
  122. : .Time$  ( --- )  Seconds  Fmt.Time$  TYPE ;
  123.  
  124.