68 lines
1.7 KiB
Forth
Executable File
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 -
|
|
;
|