368 lines
7.1 KiB
HTML
368 lines
7.1 KiB
HTML
<!DOCTYPE html>
|
|
<html>
|
|
<head>
|
|
<title>WAREKI.FS Data-Driven Refactor</title>
|
|
<meta charset="utf-8">
|
|
<meta name="description" content="DOCUMENT DESCRIPTION">
|
|
<style>
|
|
|
|
</style>
|
|
<!-- <link rel="stylesheet" href="STYLESHEET.css"> -->
|
|
</head>
|
|
|
|
<body>
|
|
<h1>WAREKI.FS Data-Driven Refactor</h1>
|
|
|
|
<table>
|
|
<tr>
|
|
<td style="vertical-align:top"><pre>
|
|
\ wareki.fs - Display WAREKI and Anno Domini corresponding years
|
|
\ +JMJ 2020 David Meyer <papa@sdf.org>
|
|
\ 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"
|
|
</pre></td>
|
|
|
|
<td style="vertical-align:top; color:red"><pre>
|
|
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
|
|
</pre></td>
|
|
|
|
<td style="vertical-align:top"><pre>
|
|
\ wareki.fs - Display WAREKI and Anno Domini corresponding years
|
|
\ +JMJ 2022 David Meyer <papa@sdf.org>
|
|
\ 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"
|
|
</pre></td>
|
|
</tr>
|
|
</body>
|
|
</html>
|