Functions for working with the idealized calendar of Planet Xhilr
Revision | 75f9aa7438eaa72656820133567c6e6fec298f4e (tree) |
---|---|
Time | 2017-06-13 17:42:14 |
Author | Joel Matthew Rees <joel.rees@gmai...> |
Commiter | Joel Matthew Rees |
Different ways to print the day of the week
@@ -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 | + |