Functions for working with the idealized calendar of Planet Xhilr
Revisión | d510862033d9eaec4ec02a80e2f9847466b3a672 (tree) |
---|---|
Tiempo | 2017-06-13 17:51:57 |
Autor | Joel Matthew Rees <joel.rees@gmai...> |
Commiter | Joel Matthew Rees |
bringing things together
@@ -71,11 +71,18 @@ CELLWIDTH - ALLOT ( Back up to store values. ) | ||
71 | 71 | : MKYBITS ( maxyear --- ) |
72 | 72 | CR |
73 | 73 | 0 SWAP |
74 | - 7 + | |
75 | - 0 DO LPAREN SPACE I 6 .R COLON SPACE RPAREN SPACE | |
74 | + 4 + | |
75 | + 0 DO | |
76 | + DUP 3 AND 0= IF | |
77 | + LPAREN SPACE I 6 .R COLON SPACE RPAREN SPACE | |
78 | + THEN | |
76 | 79 | I MK8YBITS COMMA |
77 | - 1+ DUP 1 AND IF CR ELSE SPACE THEN | |
78 | - 8 +LOOP ; | |
80 | + DUP 3 AND 3 = IF | |
81 | + CR ELSE SPACE | |
82 | + THEN | |
83 | + 1+ | |
84 | + 8 +LOOP | |
85 | + DROP ; | |
79 | 86 | |
80 | 87 | |
81 | 88 |
@@ -1,55 +1,99 @@ | ||
1 | -( | |
2 | -// Forth programs for calculating idealized lengths of months | |
3 | -// relative to skip years | |
4 | -// for the world of Bobbie, Karel, Dan, and Kristie, | |
5 | -// | |
6 | -// by Joel Matthew Rees, winter/spring 2017. | |
7 | -// Copyright 2017, Joel Matthew Rees | |
8 | -// | |
9 | -// Permission granted to use for personal entertainment only. | |
10 | -// -- You really shouldn't write programs like this on modern computers. | |
11 | -// | |
12 | -// http://joel-rees-economics.blogspot.com/2017/03/soc500-03-08-calendar-math.html | |
13 | -// http://joel-rees-economics.blogspot.com/2017/03/soc500-03-09-calculating-skip-years.html | |
14 | -// | |
15 | -// Novel here: | |
16 | -// http://joel-rees-economics.blogspot.com/2017/01/soc500-00-00-toc.html | |
17 | -// | |
18 | -// | |
19 | -// Save as "econcalcmonth.fs" | |
20 | -// | |
21 | -// In gforth and most modern or emulated environments, | |
22 | -// just paste it into the terminal of a running Forth session. | |
23 | -// | |
24 | -// Run it with | |
25 | -// 7 SHOWMONTHS | |
26 | -// for seven years, etc. | |
27 | -) | |
28 | - | |
29 | -( Using integer math. ) | |
1 | +( Forth code for calculating idealized lengths of months ) | |
2 | +( relative to skip years in the world of ) | |
3 | +( Bobbie, Karel, Dan, and Kristi, Sociology 500, a Novel. ) | |
4 | + | |
5 | +( by Ted Turpin, of the Union of Independent States, Xhilr ) | |
6 | +( Earth Copyright 2017, Joel Matthew Rees ) | |
7 | + | |
8 | +( Permission granted to use for personal entertainment only. ) | |
9 | + | |
10 | +( -- If you need it for other purposes, rewriting it yourself is not that hard, ) | |
11 | +( and the result will be guaranteed to satisfy your needs much more effectively. ) | |
12 | + | |
13 | +( See these chapters of Sociology 500, a Novel, on line: ) | |
14 | +( <http://joel-rees-economics.blogspot.com/2017/03/soc500-03-08-calendar-math.html> ) | |
15 | +( <http://joel-rees-economics.blogspot.jp/2017/04/soc500-03-09-calculating-months-skip-years.html> ) | |
16 | +( <http://joel-rees-economics.blogspot.com/2017/04/soc500-03-10-computers.html> ) | |
17 | + | |
18 | +( Novel table of contents and preface here: ) | |
19 | +( <http://joel-rees-economics.blogspot.com/2017/01/soc500-00-00-toc.html>. ) | |
20 | + | |
21 | +( You can save it as something like "econmonths.fs". ) | |
22 | + | |
23 | +( In gforth and most modern or emulated environments, ) | |
24 | +( just paste it into the terminal of a running Forth session. ) | |
25 | + | |
26 | +( Run it with | |
27 | + | |
28 | + 7 SHOWIDEALMONTHS | |
29 | + | |
30 | + for seven years, etc. ) | |
31 | + | |
32 | +( gforth can be found in the repositories at ) | |
33 | +( <https://www.gnu.org/software/gforth/>. ) | |
34 | + | |
35 | +( It can also be obtained as a package from most modern OS distributions ) | |
36 | +( and in many applications stores (Android, yes, iOS, not yet for a while). ) | |
37 | +( Or, for MSWindows, you can get it through Cygwin: <https://www.cygwin.com/>. ) | |
38 | + | |
39 | +( HTML documentation can be found on the web at ) | |
40 | +( <http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/> ) | |
41 | +( which includes a tutorial for experienced programmers. ) | |
42 | + | |
43 | +( An easier tutorial for Forth can be found at ) | |
44 | +( <https://www.forth.com/starting-forth/>.) | |
45 | + | |
46 | +( There is a newsgroup: comp.lang.forth, ) | |
47 | +( which can be accessed from the web via, for example, Google newsgroups. ) | |
48 | + | |
49 | +( Joel Matthew Rees's own implementation of Forth can be found via ) | |
50 | +( <http://bif-c.sourceforge.net/>, ) | |
51 | +( but if you want to play with that, you'll have to compile it yourself. ) | |
52 | +( Look in the wiki at <https://sourceforge.net/p/bif-c/wiki/Home/> for help. ) | |
53 | + | |
54 | +( Many other Forths should also work. ) | |
55 | + | |
56 | +( If you don't like Forth's postfix syntax, you might try bc, ) | |
57 | +( which is an ancient calculator found in many modern OSses and Cygwin. ) | |
58 | +( The bc source is here: <https://osdn.net/users/reiisi/pastebin/4988>. ) | |
59 | +( This file is here: <https://osdn.net/users/reiisi/pastebin/4990>. ) | |
60 | + | |
61 | + | |
62 | +( Uses integer math throughout. ) | |
30 | 63 | ( Forth expression syntax is mostly postfix. ) |
31 | 64 | ( Only the definition syntax is prefix or infix. ) |
32 | -( I've added comments with equivalent infix expressions to help those unfamiliar with Forth. ) | |
65 | +( I've added some comments with equivalent infix expressions ) | |
66 | +( to help those unfamiliar with Forth. ) | |
33 | 67 | |
34 | 68 | |
35 | 69 | ( Using baroque identifiers for ancient Forths. ) |
36 | -( fig-Forth used first three character significant symbol tables. ) | |
70 | +( fig-Forth used first three character + length significance in symbol tables. ) | |
71 | + | |
72 | + | |
73 | +( UM*, FM/MOD, and S>D are already there in most modern Forths. ) | |
74 | +( These definitions are only for ancient Forths, ) | |
75 | +( especially pre-1983 fig and bif-c. ) | |
76 | +( Un-comment them if you see errors like ) | |
77 | +( UM* ? err # 0 ) | |
78 | +( from PRMONTH or thereabouts. ) | |
37 | 79 | |
80 | +( : UM* U* ; ) ( modern name for unsigned mixed multiply ) | |
38 | 81 | |
39 | -( For ancient, especially pre-1983 fig, Forths: ) | |
40 | -( Do not use these in modern Forths like gforth. ) | |
41 | -: UM* U* ; | |
42 | -: FM/MOD M/MOD DROP ; ( Cheat! Behavior is not well defined for negative numbers. ) | |
43 | -( This is just renaming in a sloppy fashion, ) | |
44 | -( to accomodate the difference between ancient fig-Forths and modern Forths. ) | |
45 | -( Showing it in infix won't help. ) | |
46 | -: S>D S->D ; ( Old fashioned name for single-to-double. ) | |
82 | +( This is a cheat! Behavior is not well defined for negative numbers, ) | |
83 | +( but we don't do negatives here. ) | |
84 | +( So this is just sloppy renaming in a sloppy fashion: ) | |
85 | +( : FM/MOD M/MOD DROP ; ) ( unsigned division with modulo remainder ) | |
86 | + | |
87 | +( : S>D S->D ; ) ( Modern name for single-to-double. ) | |
88 | + | |
89 | +( Showing the above in infix won't help. ) | |
47 | 90 | |
48 | -( Semi-simulate local variables. ) | |
49 | 91 | SP@ SP@ - ABS CONSTANT CELLWIDTH |
50 | 92 | ( Infix won't help here, either, but I can try to explain: ) |
51 | 93 | ( CELLWIDTH = absolute-value-of difference-between SP-without-pointer and SP-with-pointer. ) |
52 | 94 | |
95 | +( Semi-simulate local variables with the ability to fetch and store relative to top of stack. ) | |
96 | + | |
53 | 97 | ( Infix will be confusing here, too. ) |
54 | 98 | : LC@ ( index -- sp[ix] ) ( 0 is top. PICK is available on many modern Forths. ) |
55 | 99 | 1 + CELLWIDTH * ( Skip over the stack address on stack. ) |
@@ -79,22 +123,10 @@ SP@ SP@ - ABS CONSTANT CELLWIDTH | ||
79 | 123 | 0 .R ; |
80 | 124 | |
81 | 125 | |
82 | -: NUMERATORS ( count -- ) | |
83 | -DUP 1+ 0 DO | |
84 | - I PSNUM COLON SPACE | |
85 | - I 1000 * OVER / PSNUM COMMA ( 1000 times I, divided by count ) | |
86 | - SPACE LOOP | |
87 | -DROP ; | |
88 | - | |
89 | -: FRACTIONS ( count -- ) | |
90 | -1 DO | |
91 | - I NUMERATORS CR | |
92 | -LOOP ; | |
93 | - | |
94 | - | |
95 | -( Watch limits on 16 bit processors. ) | |
96 | 126 | ( Do it in integers! ) |
97 | 127 | |
128 | +( Watch limits on 16 bit processors! ) | |
129 | + | |
98 | 130 | 7 CONSTANT SCYCLE ( years in short cycle ) |
99 | 131 | ( SCYCLE = 7 ) |
100 | 132 |
@@ -124,7 +156,12 @@ MCYCLE MP2LCYC * CONSTANT 2LCYCLE ( years in double long cycle, should be 686 ) | ||
124 | 156 | |
125 | 157 | DPSKIPYEAR SCYCLE * RDSCYCLE + CONSTANT DPSCYCLE ( whole days per 7 year cycle ) |
126 | 158 | ( DPSCYCLE = DPSKIPYEAR × SCYCLE + RDSCYCLE ) |
159 | +( DPSCYCLE SPMCYC * CONSTANT DPMCYCLE ) | |
160 | +( DPMCYCLE = DPSCYCLE × SPMCYC ) | |
161 | +( DPMCYCLE MP2LCYC * CONSTANT DP2LCYCLE ) | |
162 | +( DP2LCYCLE = DPMCYCLE × MP2LCYC ) | |
127 | 163 | ( DPMCYCLE and DP2LCYCLE would overflow on 16 bit math CPUs. ) |
164 | +( No particular problem on 32 bit CPUs. | |
128 | 165 | |
129 | 166 | RDSCYCLE SPMCYC * 1 - CONSTANT RDMCYCLE ( remainder days in medium cycle ) |
130 | 167 | ( RDMCYCLE = RDSCYCLE × SPMCYC - 1 ) |
@@ -157,7 +194,7 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE | ||
157 | 194 | |
158 | 195 | ( Sum up the days of the months in a year. ) |
159 | 196 | : SU1MONTH ( startfractional startdays -- endfractional enddays ) |
160 | - 29 + ( Add the whole part. ) | |
197 | + FDMONTH + ( Add the whole part. ) | |
161 | 198 | SWAP ( Make the fractional part available to work on. ) |
162 | 199 | MNUMERATOR + ( Add the fractional part. ) |
163 | 200 | DUP MDENOMINATOR < ( Have we got a whole day yet? ) |
@@ -235,8 +272,8 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE | ||
235 | 272 | ( And CREATE is initialized as a CONSTANT in the fig-Forth, ) |
236 | 273 | ( but has no initial characteristic code or value in modern standards. ) |
237 | 274 | ( So. ) |
238 | -( On ancient Forths, VARIABLE wants an initial value. We give it one. ) | |
239 | -( It stays around forever. ) | |
275 | +( On ancient Forths, VARIABLE wants an initial value. We give it a zero. ) | |
276 | +( The zero stays around forever on modern Forths, or until you drop it. ) | |
240 | 277 | 0 VARIABLE DIMARRAY ( Days In Months array ) |
241 | 278 | 30 DIMARRAY ! ( 1st month ) |
242 | 279 | 29 , |
@@ -292,11 +329,10 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE | ||
292 | 329 | ; |
293 | 330 | |
294 | 331 | |
295 | - | |
296 | 332 | ( Below here is scratch work I'm leaving for my notes. ) |
297 | -( It isn't necessary to the above, and can be deleted. ) | |
333 | +( It can be deleted. ) | |
298 | 334 | |
299 | -: V2-SHOWIDEALMONTHS ( years -- ) | |
335 | +: V2-SHOWMONTHS ( years -- ) | |
300 | 336 | >R |
301 | 337 | 0 0 0 ( daysmemory, fractional, days ) |
302 | 338 | R> 0 DO |
@@ -318,8 +354,20 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE | ||
318 | 354 | ; |
319 | 355 | |
320 | 356 | |
321 | -( : ABS number -- absolute-value *** built in! *** | |
322 | -DUP 0< IF NEGATE THEN ; ) | |
357 | +: NUMERATORS ( count -- ) | |
358 | +DUP 1+ 0 DO | |
359 | + I PSNUM COLON SPACE | |
360 | + I 1000 * OVER / PSNUM COMMA ( 1000 times I divided by count ) | |
361 | + SPACE LOOP | |
362 | +DROP ; | |
363 | + | |
364 | +: FRACTIONS ( count -- ) | |
365 | +1 DO | |
366 | + I NUMERATORS CR | |
367 | +LOOP ; | |
368 | + | |
369 | +( : ABS number -- absolute-value *** built in! *** ) | |
370 | +( DUP 0< IF NEGATE THEN ; ) | |
323 | 371 | |
324 | 372 | : WITHIN1 ( n1 n2 -- flag ) |
325 | 373 | - ABS 1 <= ; ( n1 and n2 are within 1 of each other ) |