forth/date.fs

68 lines
1.7 KiB
Forth
Executable File

\ date.fs - Date arithmetic Forth module
\
\ Copyright 2015 David Meyer <papa@sdf.org> +JMJ
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
\
\ Source for Julian Day calculation algorithms:
\ "Julian day". Wikipedia The Free Encyclopedia. Modified 2015/9/21.
\ Wikimedia Foundation. Accessed 2015/9/26
\ <https://en.wikipedia.org/wiki/Julian_day>
variable a
variable jy
variable jm
variable n2
variable f
variable e
variable g
variable h
\ jdn - Convert Gregorian date y m d to Julian Day Number
: jdn { y m d -- n }
14 m - 12 / a !
y 4800 + a @ - jy !
m 12 a @ * + 3 - jm !
d
jm @ 153 * 2 + 5 / +
jy @ 365 * +
jy @ 4 / +
jy @ 100 / -
jy @ 400 / +
32045 -
;
\ j>ymd - Convert Julian Day Number to Gregorian date y m d
: j>ymd { j -- y m d }
j 1401 +
j 4 * 274277 + 146097 / 3 * 4 / +
-38 + f !
f @ 4 * 3 + e !
e @ 1461 mod 4 / g !
g @ 5 * 2 + h !
h @ 153 / 2 + 12 mod 1+ ( month -- )
dup 14 swap - 12 / e @ 1461 / + 4716 - swap ( year month -- )
h @ 153 mod 5 / 1+
;
\ j>w1 - Day of week W1 (Sun=0) for JDN
: j>w1 ( n -- w1 )
1+ 7 mod
;
\ dtdiff - Compute difference in days between two Gregorian dates
: dtdiff ( y1 m1 d1 y2 m2 d2 -- n )
jdn n2 !
jdn n2 @ swap -
;