\ Collected Algorithms from ACM, Volume 1 Algorithms 1-220,
\ 1980; Association for Computing Machinery Inc., New York,
\ ISBN 0-89791-017-6

\ (c) Copyright 1994 Everett F. Carter.  Permission is granted by the
\ author to use this software for any application provided this
\ copyright notice is preserved.
\ (c) Copyright 2008 Hans L. Bezemer, 4tH version

[UNDEFINED] today [IF]
VARIABLE da                            \ temporary variable day
VARIABLE mo                            \ temporary variable month
VARIABLE yr                            \ temporary variable year

86400 CONSTANT s/day                   \ seconds per day
 3600 CONSTANT s/hour                  \ seconds per hour
   60 CONSTANT s/min                   \ seconds per minute

[UNDEFINED] tz [IF]
1 3600 [*] +CONSTANT tz                \ Middle European Timezone
[THEN]

: JDAY ( d m y -- jd)                  \ day, month, year to Julian date
  swap dup 2 > if 3 - swap else 9 + swap 1- then rot >r swap >r 100 /mod >r
  1461 * 2/ 2/ r> 146097 * 2/ 2/ + r> 153 * 1+ 1+ 5 / + r> + 1721119 +
;

: JDATE ( jd -- d m y)                 \ Julian date to day, month, year
  1721119 - 2* 2* 1- dup 146097 / dup yr ! 146097 * - 2/ 2/ 2* 2* 3 + 1461 /mod
  swap 4 + 2/ 2/ 5 * 3 - 153 /mod mo ! 5 + 5 / da ! yr @ 100 * + yr !
  mo @ 10 < if 3 mo +! else -9 mo +! 1 yr +! then da @ mo @ yr @
;
                                       \ POSIX conversions
: POSIX>JDAY s/day / 2440588 + ;       ( n1 -- n2)
: POSIX>TIME s/day mod s/hour /mod >r s/min /mod r> ;
: WEEKDAY jday 7 mod ;                 ( d m y -- n)
                                       \ quick access to current date/time
: TODAY time tz posix>jday jdate ;     ( -- d m y)
: NOW time tz posix>time ;             ( -- h m s)

[DEFINED] 4TH# [IF]
hide da
hide mo
hide yr
[THEN]
[THEN]