• R/O
  • HTTP
  • SSH
  • HTTPS

Commit

Tags
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

Functions for working with the idealized calendar of Planet Xhilr


Commit MetaInfo

Revision75f9aa7438eaa72656820133567c6e6fec298f4e (tree)
Time2017-06-13 17:42:14
AuthorJoel Matthew Rees <joel.rees@gmai...>
CommiterJoel Matthew Rees

Log Message

Different ways to print the day of the week

Change Summary

Incremental Difference

--- /dev/null
+++ b/badweekdayshere.fs
@@ -0,0 +1,88 @@
1+: A, ( n --- ) ( Convert a number to an upper-case letter and store it away. )
2+ 55 + C, ;
3+
4+: CELLX! ( n x addr --- ) ( Indexed store. )
5+ SWAP CELLWIDTH * + ! ;
6+
7+0 VARIABLE WKDAYS
8+( Modern Forths don't initialize, will leave 0 on stack. )
9+( Proper strings are often not available in small or old Forths. )
10+( WORD has various conflicting definitions. )
11+( We will be tricky and avoid them. )
12+
13+6 CELLWIDTH * ALLOT ( Space for pointer array. )
14+
15+36 BASE !
16+
17+HERE DUP 0 WKDAYS CELLX!
18+6 C,
19+S A, U A, N A, D A, A A, Y A,
20+HERE 1 WKDAYS CELLX!
21+8 C,
22+M A, O A, O A, N A, S A, D A, A A, Y A,
23+HERE 2 WKDAYS CELLX!
24+8 C,
25+A A, E A, G A, I A, S A, D A, A A, Y A,
26+HERE 3 WKDAYS CELLX!
27+7 C,
28+G A, E A, F A, N A, D A, A A, Y A,
29+HERE 4 WKDAYS CELLX!
30+7 C,
31+F A, R A, E A, Y A, D A, A A, Y A,
32+HERE 5 WKDAYS CELLX!
33+8 C,
34+T A, E A, W A, E A, S A, D A, A A, Y A,
35+HERE 6 WKDAYS CELLX!
36+7 C,
37+V A, E A, N A, S A, D A, A A, Y A,
38+
39+DECIMAL
40+
41+: WKSTR@ ( n --- str-addr length )
42+ CELLWIDTH * WKDAYS + @ DUP 1+ SWAP C@ ;
43+
44+: TYPEDAY ( n --- )
45+ WKSTR@ TYPE ;
46+
47+: TPWDAY ( n --- ) ( TYPE the name of the day of the week. )
48+ DUP 4 < IF
49+ DUP 2 < IF
50+ DUP 0 < IF
51+ ." ??? " DROP
52+ ELSE
53+ 0 = IF
54+ ." Sunday "
55+ ELSE
56+ ." Moonsday"
57+ THEN
58+ THEN
59+ ELSE
60+ 2 = IF
61+ ." Aegisday"
62+ ELSE
63+ ." Gefnday"
64+ THEN
65+ THEN
66+ ELSE
67+ DUP 6 < IF
68+ 5 < IF
69+ ." Freyday"
70+ ELSE
71+ ." Tewesday"
72+ THEN
73+ ELSE
74+ 6 = IF
75+ ." Vensday"
76+ ELSE
77+ ." ??? "
78+ THEN
79+ THEN
80+ THEN
81+;
82+
83+
84+: TESTMONTHS ( year -- )
85+ 13 0 DO CR DUP I . I MDAYS . CR LOOP DROP ;
86+
87+
88+