來篇 FORTH 程式語言跟曆法的一些計算的紀錄吧! 這個我的 blog, 當初規劃就想放一些 FORTH 程式語言的一些心得的, 連分類都設好在那裡好久囉! 但是, 真的沒時間呀! (攤手
心血來潮, 雖然不看好這種冷門的語言會有什麼造訪率, 但還是來個第一篇打破鴨蛋吧!
FORTH 程式語言:
FORTH 是個1960年代末期, 由祖師爺 Charles Havice Moore (大家比較喜歡用他的小名 Chuck Moore 來稱呼他!) 所獨立發明的, 一個非常有趣的程式語言. Chuck Moore 原來是個非常有經驗的程式設計師. 在那個1960年電腦科技的拓荒年代, 他能使用的程式語言不外乎是 FORTRAN, COBOL ... 這類的程式語言, 所以最後當他受聘為 Kitt Peak National Observatory (美國基特峰國家天文台) 的36英尺天文望遠鏡發展電腦控制程式時, 他覺得假如以傳統的程式語言來做控制, 將會窒礙難行, 於是他引進了他自己所發明並已經秘密發展多年的新一代程式語言 FORTH 來撰寫天文望遠鏡控制程式跟後續觀測數據分析程式, 最後獲得巨大成功. (Chuck 覺得他所發明的程式語言, 超越當時所有第三代程式語言, 所以把他命名為 FOURTH, 第四代電腦語言. 因為當時他所用的 IBM 電腦只允許5 個字的識別元, 所以去掉 U, 所以最後命名為 FORTH)
由於 FORTH 語言的交談性, 方便性. 因為操作使用的關係, 很快的, 世界上第二位第三位 FORTH 程式員就在 Kitt Peak 國家天文台誕生了. 然後 Chuck Moore 所發明的這個語言開始在天文台望遠鏡界流傳跟使用. 喜愛的跟知曉FORTH的人越來越多, 一些符式語言的愛好者協會 (FORTH Interest Group, 簡稱 FIG) 慢慢地於世界上不同的地方成立, 於是這個非主流的語言開始在地下慢慢地流傳跟普及起來囉. 因為需求者眾, 所以隨後 Chuck Moore 也跑到矽谷成立了有名的 FORTH Inc. 把他多年在FORTH上的心血結晶轉成有名的 FORTH系統 polyFORTH, 專心販賣跟推廣 FORTH 系統給大家使用. (當然, Chuck Moore 現在早已經離開這家公司了!) 從此 FORTH 也一舉帶上公堂, 開始廣為電腦世界所熟知跟使用.
FORTH 有幾個非常迷人的特色(如下所列), 系統非常的短小精悍, 使得 FORTH 在 1980年代非常的流行. 一些專屬的 FORTH 電腦都被開發出來. 例如在英國家用電腦的先驅 Jupiter Ace, 當初因為記憶體受限, 塞不進 BASIC 的翻譯器. 最後內部內建的語言選擇採用 FORTH. 當時有名的 Byte 雜誌, 也為 FORTH 開了專題, 一時間洛陽紙貴, FORTH 成為當時很夯的話題跟大家非常重視的電腦技術之一啊!
- FORTH 的程式碼是編譯式的, 編寫程式完畢後編譯器即時將程式編譯成線緒碼放入FORTH特有的字典, 執行時交由FORTH內部巧妙的位址翻譯器核心從字典中取出線緒碼執行. 編譯的方式跟精心設計的位址翻譯器核心使得 FORTH 有絕佳近乎機械語言的執行速度.
- FORTH 的程式發展是交談性的, FORTH 擁有跟 BASIC 一樣絕佳的交談性. 當使用者在鍵盤鍵入指令時, 文字翻譯器隨時在後面跟使用者反應. 看是要執行字典裡面的指令, 還是要叫出編譯器編譯新的指令, 還是將數字丟入堆疊, 隨君號令. 這使得 FORTH 也是個超棒的 Script Language. 像 UNIX Shell 一樣, 可以很方便的餵它一堆指令來完成一堆事.
- FORTH 有很高的移轉性, FORTH 編譯出來的程式碼是和 CPU 無關的一堆位址所組成的線緒碼, 只有核心的的低階指令是由 CPU 的機械語言所撰寫的. 內部位址翻譯器核心在執行時也有一個特定通用的虛擬機架構, 所以 FORTH 有很高的移轉性. 再來, FORTH 的編譯器也是由 FORTH 語言所撰寫的, 所以只要花幾天的時間將系統裡面的一些以機械語言所撰寫的 FORTH 低階指令跟核心, 以新的 CPU 機械語言改寫, 整個FORTH系統瞬間就可以轉移到新的機器上. 事實上, 當一個全新開發新的 CPU 尚未有任何高階語言編譯器時, FORTH 系統通常是第一個可以進駐的高階語言系統.
- FORTH 是個可以進步的語言, FORTH 語言系統編譯器也是由 FORTH 撰寫的, 所以只要熟悉FORTH就可以對系統做任意的更改. 而 FORTH 語言本身也提供了使用者可以即時新增跟擴充編譯器的彈性, 所以使用者很容易擴充跟增加新的語法因應任何新的需求.
- FORTH 系統非常簡潔跟精簡, 一個8位元的系統下, 整個系統大概 8K- 10K 的記憶體大小左右就可以建置. 在某些極端的應用下, 甚至 1K 就可以組成 FORTH 系統. 這使得 FORTH 對電腦資源的需求極小化, 可以很容易的塞入跟生存在任何電腦硬體之中. (嵌入式系統, 微電腦... etc, 甚至是寄生在其他的語言跟作業系統中!)
因為是我 blog 第一篇 FORTH 語言紀錄, 所以拉哩拉雜的廢話特別多, 亂寫了一堆. 因為 FORTH 是筆者所深愛的電腦語言啊.
這裡要順便稍微說一下給認識我的朋友們, 有些人應該會覺得很驚訝我會這個目前算是非常冷僻的電腦語言. 是的, 如你們所熟知的, 我大學跟研究所念的是理學院的科系, 所以我平常工作的專業並不是這個跟這些電腦技術, 而是半導體製程研發, 製程實驗或設備技術, 量測技術或製程控制. 那, 大家一定很好奇這些電腦程式設計的技術那裡學的呀?
答案很簡單, 自學的! 筆者國中二年級老爸就買了一台國產的類似 Jupiter Ace 的小歡樂電腦, 裡面內建了 BASIC 翻譯器. 所以國中二年級, 筆者就已經會寫 BASIC 程式囉. 也因為這樣, 高一下的暑假, 還被數學老師指定為學校暑期小學生電腦營的小老師. 高中當然囉, 家裏添購了個人電腦的經典 Apple ][, 所以 FORTH 是那時候所學的. 所以從國中開始, 課餘一直就是各種電腦技術的追求者, 所以雖然大學不是念資訊科系的, 但熟悉這些電腦技術是一點也不奇怪的喲! (C語言是在大學的時候去資管系旁聽她們的課程所學的!)
FORTH 系統:
來談一下筆者現在所使用的FORTH語言環境吧! 一談到語言環境, 首先要提 FORTH 語言的標準. 祖師爺 Chuck Moore 其實是蠻反對 FORTH 語言的任何標準的. 因為祖師爺近乎神般的存在, FORTH 在他手裡, 有如九陰真經般, 程式碼如詩詞般的優雅, 多一分則太多, 少一分則太少. 裡面的資料結構如此的巧妙搭配, 精美的讓人讚嘆, 而執行起來卻又如此強悍. 短小精悍, 讓人印象深刻. 而標準的制定, 強制要求某些字詞跟架構, 會破壞了這樣的優雅.
但是沒辦法呀, 我們是人, 不是神般的 FORTH 祖師爺. 所以一定的標準還是需要的. 標準化一定的軟體介面, 才有機會讓大家彼此溝通啊! FORTH 的標準從早期的 FORTH-79, 還有個黑市標準 fig-FORTH, 後來我念大學的時候進步到 FORTH-83. 最後因為 FORTH 也被承認是電腦技術裡面重要的語言了, 所以美國國家標準局出來制定了現在目前最通用的標準, ANSI-FORTH.
筆者在公司用 PC, 回家用 Mac.
PC 這邊, 最好用的還是 Win32For 的 FORTH 系統, 完全 100% 的支援 ANSI-FORTH 標準, 可惜因為是 32 位元的系統, 只能在 Win XP 上執行. 但筆者全公司還是以 WinXP 為主的, 所以毫無疑問的, 我公司的電腦是有安裝 Win32For 的, 而且真的非常好用. 這裡的所有程式都有經過 Win32For 測試過, 執行無誤.
Mac 這邊, 也沒什麼好選擇, 大概就是只有 gFORTH 啦. gFORTH 是一個在 UNIX 下所發展出來的 ANSI FORTH 標準的 FORTH 系統, 可以在 UNIX/Linus 系統下執行無誤. 一樣, 這裡的程式也都在我家裡的 Mac 充分測試過, 可以執行無誤.
老實說, 寫這些程式除了是練習自己的演算法功力, 練習FORTH程式語言, 娛樂外. 也變成自己的程式庫. 需要的時候就可以拿來用的, 非常的方便!
這篇是希望練習兩個不同的日期間計算日數的演算法, 順便也做一些其他的應用啦! 挑選 FORTH 來寫是因為我很喜歡這個語言, 也希望多少野人獻曝, 盡量多一些 FORTH 的資訊給有興趣的人參考啦!
西元曆法:
好, FORTH 簡介完畢, 開始導入正題囉! 來簡介一下西元曆法的規則吧!
首先介紹一下一天的定義. 如何定義一天呢?? 大家直覺會認為就是太陽升起跟落下的時間啊! 可是仔細想想後一定覺得怪怪的, 因為一年中每天太陽升起跟落下的時間並不固定. 所以一天定義的參考點該放在哪裡呢? 答案就是正午. 也就是地球從正對太陽正午(日規的影子最短)那一瞬間開始, 到下一個又是正對太陽正午(日規的影子最短)的那一瞬間結束. 這樣叫一個太陽日! (Solar Day)
地球邊自轉然後慢慢繞太陽公轉, 很不幸的, 當地球繞太陽公轉回到一年前的那個相同位置(我們目前的曆法以春分點的那個位置當參考點)的瞬間, 地球的自轉的平均圈數(這裡指平均太陽日)並不是一個整數. 而是 365.2422... 個平均太陽日.
所有的曆法問題, 就源自於這個 0.2422 的擾人小數點啊!
如果只規定一年只有365年, 很快的 0.2422 x 4 = 0.9668, 四年後就會有將近多出一天的誤差. 只好設計一個叫做閏年的東東, 每四年叫做閏年, 那一年是366日要多一天出來. 但是實際上還是不足一天的, 所以到湊到某個閏年後, 新的誤差會再出來的. 所以又需要新的規則來抵消這樣誤差.
這裡有個精確且非常容易理解的作法如下,
首先可以發現 97/400 = 0.2425 小數點下三位非常接近 0.2422
所以 365.2422 大約近似 365 + 97/400,
然後 97 = 100 - 4 + 1
所以 365.2422 大約近似 365 + 97/400 = 365 + 100/400 - 4/400 + 1/400 = 365 + 1/4 - 1/100 + 1/400
這樣就出現目前我們所採用的閏年的規則了: 4年一閏, 100年不閏, 400年再閏, 透過這樣簡單的規則, 可以有效的平均的維持住我們的曆法跟地球自轉 365.2422 個平均太陽日的一致性!
再來就是一年有 12個月, 每個月依序為 一月31天, 二月28天, 三月31天, 四月30天, 五月31天, 六月30天, 七月31天, 八月31天, 九月30天, 十月31天, 十一月30天, 十二月 31天.
為什麼這樣定呢? 因為 365天也是沒法用12月來整除的, 只好 30, 31 交叉使用囉. 然後然後那個月要30天, 那個月要31天? 這是由歷代君王頒布曆法硬性規定的, 所以約定俗成, 就這樣用囉.
閏年被定在二月, 不是閏年二月就是28天, 是閏年就是29天.
對應的 FORTH 程式碼,
首先建個每個月的日數表吧, 讓我們也能夠很方便的透過 FORTH 的交談性來跟我們的電腦溝通查詢!
create days
31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 ,
對 FORTH 的初學者, 這裡解釋一下. create 會創造出一個新的指令, 這個指令一執行, 會把指令後面的資料位址推上堆疊. 這裡用 ‘,' 逗點指令把數值編入字典.
透過下面簡單的計算, 就可以算出資料儲放的位址, 並將對應的每個月份的日數資料取出來囉.
: days@ ( month -- days)
1- cells days + @
;
所以只要, 2 days@ 問一下 FORTH 系統, 系統馬上會將 28 天放上堆疊以供使用; 7 days@ 系統馬上會將 31 天放上堆疊以供使用. 每月有幾天, 隨時可以查詢哩!
再進一步延伸一下, 來定義一個 計算月跟月之間的總日數的指令吧!
: months>days ( month1 month2 -- days)
1+ swap 0 -rot
?do i days@ +
loop
;
裡面有個 do-loop 迴圈, 輸入 month1 跟 month2, 透過 do-loop 迴圈, 利用 days@ 指令查詢之間每個月的日數, 然後加起來變成總日數. ANSI FORTH 裡面 do 有兩個, 一個是有問號 ?do, 一個是沒問號 do. 有問號的會做檢查, 假如 do-loop 裡的起始值跟結束值一樣的話, 只會被執行一次! 這裡因為有可能會一樣, 所以採用有問號的 ?do. 用錯了do, 可是會變成無窮迴圈, 整個爆掉囉!
再來, 建個判斷閏年的指令吧!
前面有說了, 判斷閏年的規則很簡單: 4年一閏, 100年不閏, 400年再閏
所以, 閏年的判斷式: (可以被400整除) 或 (可以被4整除但不可以被100整除)
: leap? ( year -- leap?) \ leap year?
dup 400 mod 0=
over 4 mod 0= rot 100 mod 0= invert and
or
;
指令先複製你給的年份數字, 除400看看餘數是否為零; 再複製你給的年份數字, 除4看看餘數是否為零, 再複製你給的年份數字, 除100看看餘數是否不為零. 最後再將這三個結果 or and 一下得到最後是否為閏年的結論.
使用起來很方便的, 例如 2000 leap? 問一下系統, 系統會放個 -1 (true) 在堆疊, 是, 2000年是閏年.
可以判斷閏年了, 那只要給定任何一年, 我們就可以知道它的真實總日數囉? 來個這樣的指令吧!
: 1year>days ( year -- days)
365 swap leap? if 1+ then
;
其實很簡單呀, 先放上 365 天, 然後再判斷是否閏年. 是的話就加1天囉!
鍵入這樣的敘述問系統: 2000 1year>days 系統馬上回傳 366 日於堆疊上.
再來延伸一下, 來計算間隔不同年間的總日數吧!
: years>days ( year1 year2 -- days)
1+ swap 0 -rot
?do i 1year>days +
loop
;
一樣, 用個 ?do-loop 就搞定囉. 用個 ?do-loop 讓它從起始年 year1 到結束年 year2 之間透過 1year>days 來查詢當年的總天數, 然後所有結果加起來就是總日數囉!
鍵入這樣的敘述問系統, 2000年初 到 2004年末 總共幾天呀: 2000 2004 years>days 系統馬上回傳 1827 日於堆疊上.
再來複雜一點的, 來計算特定日期那年, 從當天到除夕的日數吧!
: date..year-end>days ( year month day -- days)
over days@ swap - ( year month days) 先算一下當日到當月底的天數
over 12 = ( December?) 是12月嗎? 假如是的話就不用算月跟月間的天數
if >r 2drop r> exit then 是12月的話, 處理放好結果, 就先離開囉!
rot leap? >r ( month days | leap?) 是閏年嗎? 旗號先放到返回堆疊暫存起來!
over 1+ 12 months>days + 算一下當日下個月跟年底之間的天數
r> ( month days leap?) 剛剛的閏年旗號從返回堆疊推出來供後面使用
rot 3 < ( under Feb.) ( days leap? month<3? ) 有經過2月嗎?
if if 1+ then 是閏年嗎? 是就加一囉
else drop
then
;
指令先判斷日期是否最後一月, 是的話只要算到當月底的天數就可以離開了. 不是的話, 要判斷一下有無經過2月及是否閏年, 是的話最後總天數要多加一. 最後, 把特定日期的下個月到年底的天數算出來, 然後全部加起來就是囉!
一樣, 複雜一點的, 來計算特定日期那年, 從過年到當天的日數吧!
: year-start..date>days ( year month day -- days)
over 1 = ( Jan?) 是一月嗎?
if >r 2drop r> exit then 是一月的話特定日期就剛好是天數囉, 放好結果, 就先離開囉!
rot leap? >r ( month days | leap?) 是閏年嗎? 旗號先放到返回堆疊暫存起來!
over 1- 1 swap months>days + 算一下年初到當日前一個月之間的天數
r> ( month days leap?) 剛剛的閏年旗號從返回堆疊推出來供後面使用
rot 2 > ( over Feb.?) ( days leap? month>2? ) 有經過2月嗎?
if if 1+ then 是閏年嗎? 是就加一囉
else drop
then
;
指令先判斷日期是否是第一月, 是的話只要算到當天的天數就可以離開了. 不是的話, 要判斷一下有無經過2月及是否閏年, 是的話最後總天數要多加一. 最後, 把年初到特定日期的上個月的天數算出來, 然後全部加起來就是囉!
如何計算兩個日期間的日數:
這裡我們先來設計一下使用的語法, 希望能用這樣的語法來使用,
1969 4 10 from 2017 8 20 to .TotalDays 這樣的語法, 就可以算出從 1969年4月10日 到 2017年8月20日 的總天數 指令 .TotalDay 會把總天數算出來並列印出來.
這麼多, 多達六個之多的參數, 為了減少堆疊資料使用的深度, 趕快來定義一些變數吧!
日期的開始, year1, month1, day1
variable year1
variable month1
variable day1
日期的結束, year2, month2, day2
variable year2
variable month2
variable day2
配合剛剛所設計的語法, 定義一下 from 跟 to 的指令
: from ( year month day --)
day1 ! month1 ! year1 !
;
: to ( year month day --)
day2 ! month2 ! year2 !
;
簡單的演算法,
狀況一: 兩個日期不在同一年
兩個日期間的日數 = 開始日期到那年除夕的日數 + 經過中間間隔那幾年的總日數 + 結束日期那年過年到結束日期的日數
狀況二: 兩個日期在同一年
兩個日期間的日數 = 開始日期到那年除夕的日數 - 結束日期到那年除夕的日數
: TotalDays ( -- days)
year2 @ year1 @ - 2 < 兩者間隔小於兩年嗎?
if 0 ( less than 2 years) 是的話, 中間那幾年天數為零
else year1 @ 1+ year2 @ 1-
years>days 不是的話, 把中間間隔那幾年的天數算出來
then
( days of start date to year-end)
year1 @ year2 @ = ( same year?) 兩個日期在同一年嗎?
if year2 @ month2 @ day2 @ 是的話,
date..year-end>days negate 算出結束日期到那年除夕的日數, 給上負號
else year2 @ month2 @ day2 @ 不是的話,
year-start..date>days 算出結束日期那年過年到結束日期的日數
then
( days of year-start to end date)
year1 @ month1 @ day1 @
date..year-end>days 算出開始日期到那年除夕的日數
+ + 三個結果全部加起來就是總天數囉!
;
定義個列印的指令吧,
: .TotalDays ( --)
." .. It is " TotalDays . cr
;
完工, 真的是超棒的! 只要用下面的指令寫在文字檔裡面, 叫 FORTH 系統去執行一下, 馬上算出一堆結果喲. FORTH 真是世界上最棒的 script 語言.
延伸, 延伸, 再延伸:
繼續來延伸下去, 兩個日期間間隔的天數現在可以算了, 那只要找一天當參考點. 星期幾也可以算囉!
1911年的1月1日, 剛好是個不錯的參考點. 因為那天是星期日.
所以1911年之後的任一天, 只要計算一下它跟 1911年1月1日所經過的總天數, 除以7, 那個餘數就是星期幾囉! (0=星期日, 1=星期一, 2=星期二...)
所以來定義一下吧,
: >DayOfWeek ( year month day -- day) \ 0=Sun, 1=Mon, 2=Tue ...
to
1911 1 1 from
TotalDays 7 mod
;
鍵入 2017 8 20 >DayOfWeek 系統會回傳告訴你, 呵呵, 這天星期日!
星期幾都可以知道了, 那來印個月曆吧!
variable 1stLine? 旗號變數, 是否列印第一行?
: tab ( n --) 跳到特定 星期n 的位置
1stLine? @ 是否列印第一行
if 4 * 1+ 1stLine? off 是的話, 空出 4*n +1 格,把旗號變數 off (每個星期會占四格的位置)
else 不是列印第一行的話,
0= if cr then 是否這是星期日的位置, 是的話跳到下一行.
1 大家空一格
then
spaces 空格
;
: .calendar ( year month --)
cr
cr ." Year:" over . ." - Month:" dup 2 .r 印一下年跟月
cr
cr ." Sun Mon Tue Wed Thu Fri Sat" 印一下星期標籤,每個星期會占四格的位置
cr
1stLine? on 旗號變數, 是否列印第一行? 打開
swap over 1 >DayOfWeek 算一下這個月的1號是星期幾,這是進入迴圈前的起始值.
swap days@ 1+ 1 月的總日數, 用 do-loop 迴圈來印月曆囉!
do ( DayOfWeek)
dup 7 mod tab i 3 .r 現在的星期,取餘數讓它不會超過7.跳到特定星期的位置,印上日期
1+ 星期數加一, 下一天的星期數.
loop drop
cr cr
;
鍵入 2017 8 .calendar 呵呵! 漂亮的月曆!!
來個漂亮的年曆也不是問題啦,
: .YearCalendar ( year --)
13 1
do dup i .calendar
loop drop
;
最後, 是我自己要用的!
因為有維護一個特定粉絲頁的關係, 之前常常看到 twitpic 上的圖片, 它告訴你, 這是 763日前的照片. 但是我是想要知道確切日期的!
只好寫個指令來計算囉,
這個有點暴力法來搜尋啦! 先用年來找, 等發現過頭了就是那年的後一年囉. 再用月來找, 一樣等發現過頭了就是那個月的後一月囉. 最後, 用日來找, 直到找到為止!
: SearchFromDate ( days -- year month day)
dup 365 / year2 @ swap - year1 ! 1 month1 ! 1 day1 !
( days --)
\ search for year 逐年找
year2 @ 1+ year1 @
?do
i year1 ! dup TotalDays > if i 1- year1 ! leave then
loop
\ search for month 逐月找
13 1
do
i month1 ! dup TotalDays > if i 1- month1 ! leave then
loop
\ search for day 逐日找
month1 @ days@ 1+ 1
do
i day1 ! dup TotalDays = if leave then
loop
drop
year1 @ month1 @ day1 @
;
測試一下,
已知今天是 2017年8月20日, 請問 763天之前是幾年幾月幾號啊?
鍵入 2017 8 20 to 763 SearchFromDate 結果是 2015年7月19日
這就是 FORTH, 很好用吧! :)
xxx
對 FORTH 有興趣的, 假如你英文還可以的話. 這裡有個超有名的經典 FORTH教材呦! Starting FORTH 由淺入深, 你會發現, 原來啊! FORTH 竟是如此的簡單! 不要錯過囉!
最後, 原始總程式碼列表
\
\ The days between two dates
\
\ Frank Lin 2017.8.3 v1
\
\ Features:
\ 1. The Days between two dates
\ ex: 1977 4 10 from 2017 8 3 to .TotalDays
\
\ 2. the Day of the week for specific date
\ ex: 2017 8 3 >DayOfWeek .
\
\ 3. calendar, year calendar print out
\ ex. 2017 8 .calendar
\ ex. 2017 .YearCalendar
\
\ 4. search specific from-date to meet specific passing days
\ ex: 2017 8 3 to 100 SearchFromDate rot . swap . .
\
( reset and change words searching orders, FORTH words first)
FORTH only FORTH also
( define new vocabulary to store DateTools words)
vocabulary DateTools
( set DateTools as current definition vocabulary)
DateTools definitions
( fence for new words in DateTool, a mark for forgeting if you want to redefine)
marker DateToolsFence
create days
31 , 28 , 31 , 30 , 31 , 30 , 31 , 31 , 30 , 31 , 30 , 31 ,
: days@ ( month -- days)
1- cells days + @
;
: months>days ( month1 month2 -- days)
1+ swap 0 -rot
?do i days@ +
loop
;
: leap? ( year -- leap?) \ leap year?
dup 400 mod 0=
over 4 mod 0= rot 100 mod 0= invert and
or
;
\
\ rule for leap year:
\ ( 400 multiple? ) or ( 4 multiple but not 100 multiple)
\
: 1year>days ( year -- days)
365 swap leap? if 1+ then
;
: years>days ( year1 year2 -- days)
1+ swap 0 -rot
?do i 1year>days +
loop
;
: date..year-end>days ( year month day -- days)
over days@ swap - ( year month days)
over 12 = ( December?)
if >r 2drop r> exit then
rot leap? >r ( month days | leap?)
over 1+ 12 months>days + ( month days | leap?)
r> ( month days leap?)
rot 3 < ( under Feb.) ( days leap? month<3? )
if if 1+ then
else drop
then
;
: year-start..date>days ( year month day -- days)
over 1 = ( Jan?)
if >r 2drop r> exit then
rot leap? >r ( month days | leap?)
over 1- 1 swap months>days + ( month days | leap?)
r> ( month days leap?)
rot 2 > ( over Feb.?) ( days leap? month>2? )
if if 1+ then
else drop
then
;
variable year1
variable month1
variable day1
variable year2
variable month2
variable day2
: from ( year month day --)
day1 ! month1 ! year1 !
;
: to ( year month day --)
day2 ! month2 ! year2 !
;
\
\ Case 1. across one year
\ Total days = days of start date to year-end + days of years + days of year-start to end date
\
\ Case 2. in the same year
\ Total days = days of start date to year-end - days of end date to year-end
\
: TotalDays ( -- days)
year2 @ year1 @ - 2 <
if 0 ( less than 2 years)
else year1 @ 1+ year2 @ 1- years>days then
( days of start date to year-end)
year1 @ year2 @ = ( same year?)
if year2 @ month2 @ day2 @ date..year-end>days negate
else year2 @ month2 @ day2 @ year-start..date>days
then
( days of year-start to end date)
year1 @ month1 @ day1 @ date..year-end>days
+ +
;
: .TotalDays ( --)
." .. It is " TotalDays . cr
;
\ ex: 1911 1 1 from 2017 8 3 to .TotalDays
\
\ 1911 Jan 1, it is Sunday.
\ So, calculate the days of current date between this date and divide it by 7
\ the remainder is the day of week.
\
: >DayOfWeek ( year month day -- day) \ 0=Sun, 1=Mon, 2=Tue ...
to
1911 1 1 from
TotalDays 7 mod
;
\ search specific from-date to to-date that can meet the specific days
\ ex: 2017 8 7 to 100 days SearchFromDate
\
\ method: search year first, then month, then date until fit the answer
\
: SearchFromDate ( days -- year month day)
dup 365 / year2 @ swap - year1 ! 1 month1 ! 1 day1 !
( days --)
\ search for year
year2 @ 1+ year1 @
?do
i year1 ! dup TotalDays > if i 1- year1 ! leave then
loop
\ search for month
13 1
do
i month1 ! dup TotalDays > if i 1- month1 ! leave then
loop
\ search for day
month1 @ days@ 1+ 1
do
i day1 ! dup TotalDays = if leave then
loop
drop
year1 @ month1 @ day1 @
;
variable 1stLine?
: tab ( n --)
1stLine? @
if 4 * 1+ 1stLine? off
else
0= if cr then
1
then
spaces
;
: .calendar ( year month --)
cr
cr ." Year:" over . ." - Month:" dup 2 .r
cr
cr ." Sun Mon Tue Wed Thu Fri Sat"
cr
1stLine? on
swap over 1 >DayOfWeek ( month DayOfWeek)
swap days@ 1+ 1
do ( DayOfWeek)
dup 7 mod tab i 3 .r
1+
loop drop
cr cr
;
: .YearCalendar ( year --)
13 1
do dup i .calendar
loop drop
;
留言列表
