\ wareki.fs - Display WAREKI and Anno Domini corresponding years
\ +JMJ 2020 David Meyer
\ 2020/3/31 Add Reiwa era
\ help-wareki - Display module help
: help-wareki ( -- )
cr ." WAREKI" cr
." Display Japanese era years corresponding to A.D. years and" cr
." vice versa." cr
." HEISEI ( u -- ) Display A.D. year corresponding to Heisei era year." cr
." MEIJI ( u -- ) Display A.D. year corresponding to Meiji era year." cr
." NENGO ( u -- ) Display Japanese year in Meiji, Taishou, Shouwa," cr
." Heisei, or Reiwa eras corresponding to A.D. year." cr
." REIWA ( u -- ) Display A.D. year corresponding to Reiwa era year." cr
." SHOWA ( u -- ) Display A.D. year corresponding to Shouwa era year." cr
." TAISHO ( u -- ) Display A.D. year corresponding to Taishou era year." cr
;
\ nengo - Display NENGO for A.D. (Meiji, Taishou, Shouwa,
\ Heisei, Reiwa eras only)
: nengo ( u -- )
dup 1868 < if
." ERROR: Year precedes MEIJI era " drop
else
dup 1868 = if
." MEIJI GANNEN (Sep 8 -) " drop
else
dup 1912 < if
." MEIJI " 1867 - .
else
dup 1912 = if
." MEIJI 45/TAISHO GANNEN (Jul 30-) " drop
else
dup 1926 < if
." TAISHO " 1911 - .
else
dup 1926 = if
." TAISHO 15/SHOWA GANNEN (Dec 25-) " drop
else
dup 1989 < if
." SHOWA " 1925 - .
else
dup 1989 = if
." SHOWA 64/HEISEI GANNEN (Jan 8-) " drop
else
dup 2019 < if
." HEISEI " 1988 - .
else
dup 2019 = if
." HEISEI 31/REIWA GANNEN (May 1-) " drop
else
." REIWA " 2018 - .
then
then
then
then
then
then
then
then
then
then
;
\ meiji - Display A.D. for Meiji era NENGO.
: meiji ( u -- )
dup 0= if
." ERROR: NENGO < 1 " drop
else
dup 45 > if
." ERROR: NENGO > 45 " drop
else
." AD " 1867 + .
then
then
;
\ taisho - Display A.D. for Taishou era NENGO.
: taisho ( u -- )
dup 0= if
." ERROR: NENGO < 1 " drop
else
dup 15 > if
." ERROR: NENGO > 15 " drop
else
." AD " 1911 + .
then
then
;
\ showa - Display A.D. for Shouwa era NENGO.
: showa ( u -- )
dup 0= if
." ERROR: NENGO < 1 " drop
else
dup 64 > if
." ERROR: NENGO > 64 " drop
else
." AD " 1925 + .
then
then
;
\ heisei - Display A.D. for Heisei era NENGO.
: heisei ( u -- )
dup 0= if
." ERROR: NENGO < 1 " drop
else
." AD " 1988 + .
then
;
\ reiwa - Display A.D. for Reiwa era NENGO.
: reiwa ( u -- )
dup 0= if
." ERROR: NENGO < 1 " drop
else
." AD " 2018 + .
then
;
cr ." Type 'help-wareki' for help"
|
001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050
051
052
053
054
055
056
057
058
059
060
061
062
063
064
065
066
067
068
069
070
071
072
073
074
075
076
077
078
079
080
081
082
083
084
085
086
087
088
089
090
091
092
093
094
095
096
097
098
099
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
\ wareki.fs - Display WAREKI and Anno Domini corresponding years
\ +JMJ 2022 David Meyer
\ 2020/3/31 Add Reiwa era
\ 2022/2/9 Refactor and convert to data-driven
\ help-wareki - Display module help
: help-wareki ( -- )
cr ." WAREKI" cr
." Display Japanese era years corresponding to A.D. years and" cr
." vice versa." cr
." HEISEI ( u -- ) Display A.D. year corresponding to Heisei era year." cr
." MEIJI ( u -- ) Display A.D. year corresponding to Meiji era year." cr
." NENGO ( u -- ) Display Japanese year in Meiji, Taishou, Shouwa," cr
." Heisei, or Reiwa eras corresponding to A.D. year." cr
." REIWA ( u -- ) Display A.D. year corresponding to Reiwa era year." cr
." SHOWA ( u -- ) Display A.D. year corresponding to Shouwa era year." cr
." TAISHO ( u -- ) Display A.D. year corresponding to Taishou era year." cr
;
0 constant ERAM \ MEIJI era index
1 constant ERAT \ TAISHO era index
2 constant ERAS \ SHOWA era index
3 constant ERAH \ HEISEI era index
4 constant ERAR \ REIWA era index
create ERALFGY \ Era last full Gregorian year (M/T/S/H/R)
1867 , 1911 , 1925 , 1988 , 2018 ,
create ERALYR \ Era last year (M/T/S/H)
45 , 15 , 64 , 31 ,
create ERANAME \ Era name length/string (M/T/S/H/R)
5 , 77 c, 69 c, 73 c, 74 c, 73 c, 0 c, \ "MEIJI"
6 , 84 c, 65 c, 73 c, 83 c, 72 c, 79 c, \ "TAISHO"
5 , 83 c, 72 c, 79 c, 87 c, 65 c, 0 c, \ "SHOWA"
6 , 72 c, 69 c, 73 c, 83 c, 69 c, 73 c, \ "HEISEI"
5 , 82 c, 69 c, 73 c, 87 c, 65 c, 0 c, \ "REIWA"
create ERADATE \ Era start date length/string (M/T/S/H/R)
5 , 83 c, 101 c, 112 c, 32 c, 56 c, 0 c, \ "Sep 8"
6 , 74 c, 117 c, 108 c, 32 c, 51 c, 48 c, \ "Jul 30"
6 , 68 c, 101 c, 99 c, 32 c, 50 c, 53 c, \ "Dec 25"
5 , 74 c, 97 c, 110 c, 32 c, 56 c, 0 c, \ "Jan 8"
5 , 77 c, 97 c, 121 c, 32 c, 49 c, 0 c, \ "May 1"
: []@ ( uidx a-base -- a-addr ) swap cells + @ ;
: []$ ( uidx a-base -- c-addr ulen )
swap 1 cells 6 chars + * + dup 1 cells + swap @
;
: ng>gy ( ungy uera -- ugy ) ERALFGY []@ + ;
: gy>ng ( ugy -- ungy uera )
ERAR begin
dup ERALFGY []@ rot dup rot <= while swap 1-
repeat
over ERALFGY []@ - swap
;
: prera ( uera -- ) ERANAME []$ type space ;
: preradt ( uera -- ) ERADATE []$ type ;
: prgy ( ug -- ) ." AD " . ;
: ngyok? ( uera ungy -- f )
dup 0< if
2drop false else
swap ERALYR []@ 1+ > if false else true then
then
;
: nengo ( ugy -- )
dup ERAM ERALFGY []@ <= if
drop ." Year prior to MEIJI era unsupported " else
gy>ng over 1 = if
dup 1- dup prera ERALYR []@ . ." / "
dup prera ." GANNEN (" preradt ." -) " drop else
prera . then
then
;
: cvtng ( ungy uera -- )
2dup swap ngyok? if
ng>gy prgy else
2drop ." Invalid NENGO year " then
;
: meiji ( ungy -- ) ERAM cvtng ;
: taisho ( ungy -- ) ERAT cvtng ;
: showa ( ungy -- ) ERAS cvtng ;
: heisei ( ungy -- ) ERAH cvtng ;
: reiwa ( ungy -- ) ERAR cvtng ;
cr ." Type 'help-wareki' for help"
|