Commit: d510862033d9eaec4ec02a80e2f9847466b3a672 - xhilr_calendar (git)

Functions for working with the idealized calendar of Planet Xhilr

Commit MetaInfo

• Revision: d510862033d9eaec4ec02a80e2f9847466b3a672 (tree)
• Time: 2017-06-13 17:51:57
• Author: Joel Matthew Rees <joel.rees@gmai...>
• Commiter: Joel Matthew Rees

Log Message

bringing things together

Change Summary

• modified: econcalendar.fs
• modified: econmonths.fs

Incremental Difference

--- a/econcalendar.fs
+++ b/econcalendar.fs
@@ -71,11 +71,18 @@ CELLWIDTH - ALLOT ( Back up to store values. )
 : MKYBITS ( maxyear --- )
   CR
   0 SWAP 
-  7 + 
-  0 DO LPAREN SPACE I 6 .R COLON SPACE RPAREN SPACE
+  4 + 
+  0 DO 
+    DUP 3 AND 0= IF 
+      LPAREN SPACE I 6 .R COLON SPACE RPAREN SPACE
+    THEN
     I MK8YBITS COMMA 
-    1+ DUP 1 AND IF CR ELSE SPACE THEN
-    8 +LOOP ;
+    DUP 3 AND 3 = IF 
+      CR ELSE SPACE
+    THEN 
+    1+
+    8 +LOOP
+  DROP ;
 
 
 

--- a/econmonths.fs
+++ b/econmonths.fs
@@ -1,55 +1,99 @@
-(
-// Forth programs for calculating idealized lengths of months
-// relative to skip years
-// for the world of Bobbie, Karel, Dan, and Kristie, 
-//
-// by Joel Matthew Rees, winter/spring 2017.
-// Copyright 2017, Joel Matthew Rees
-//
-// Permission granted to use for personal entertainment only.
-// -- You really shouldn't write programs like this on modern computers.
-//
-// http://joel-rees-economics.blogspot.com/2017/03/soc500-03-08-calendar-math.html
-// http://joel-rees-economics.blogspot.com/2017/03/soc500-03-09-calculating-skip-years.html
-// 
-//  Novel here:
-// http://joel-rees-economics.blogspot.com/2017/01/soc500-00-00-toc.html
-//
-//
-// Save as "econcalcmonth.fs"
-//
-// In gforth and most modern or emulated environments, 
-// just paste it into the terminal of a running Forth session. 
-// 
-// Run it with
-// 7 SHOWMONTHS
-// for seven years, etc.
-)
-
-( Using integer math. )
+( Forth code for calculating idealized lengths of months )
+( relative to skip years in the world of )
+( Bobbie, Karel, Dan, and Kristi, Sociology 500, a Novel. )
+
+( by Ted Turpin, of the Union of Independent States, Xhilr )
+( Earth Copyright 2017, Joel Matthew Rees )
+
+( Permission granted to use for personal entertainment only. )
+
+( -- If you need it for other purposes, rewriting it yourself is not that hard, )
+( and the result will be guaranteed to satisfy your needs much more effectively. )
+
+( See these chapters of Sociology 500, a Novel, on line: )
+( <http://joel-rees-economics.blogspot.com/2017/03/soc500-03-08-calendar-math.html> )
+( <http://joel-rees-economics.blogspot.jp/2017/04/soc500-03-09-calculating-months-skip-years.html> )
+( <http://joel-rees-economics.blogspot.com/2017/04/soc500-03-10-computers.html> )
+
+( Novel table of contents and preface here: )
+( <http://joel-rees-economics.blogspot.com/2017/01/soc500-00-00-toc.html>. )
+
+( You can save it as something like "econmonths.fs". ) 
+
+( In gforth and most modern or emulated environments, )
+( just paste it into the terminal of a running Forth session. )
+
+( Run it with 
+
+ 7 SHOWIDEALMONTHS
+
+  for seven years, etc. )
+
+( gforth can be found in the repositories at )
+( <https://www.gnu.org/software/gforth/>. )
+
+( It can also be obtained as a package from most modern OS distributions )
+( and in many applications stores (Android, yes, iOS, not yet for a while). )
+( Or, for MSWindows, you can get it through Cygwin: <https://www.cygwin.com/>. )
+
+( HTML documentation can be found on the web at )
+( <http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/> )
+( which includes a tutorial for experienced programmers. )
+
+( An easier tutorial for Forth can be found at )
+( <https://www.forth.com/starting-forth/>.)
+
+( There is a newsgroup: comp.lang.forth, )
+( which can be accessed from the web via, for example, Google newsgroups. )
+
+( Joel Matthew Rees's own implementation of Forth can be found via )
+( <http://bif-c.sourceforge.net/>, )
+( but if you want to play with that, you'll have to compile it yourself. )
+( Look in the wiki at <https://sourceforge.net/p/bif-c/wiki/Home/> for help. )
+
+( Many other Forths should also work. )
+
+( If you don't like Forth's postfix syntax, you might try bc, )
+( which is an ancient calculator found in many modern OSses and Cygwin. )
+( The bc source is here: <https://osdn.net/users/reiisi/pastebin/4988>. )
+( This file is here: <https://osdn.net/users/reiisi/pastebin/4990>. )
+ 
+
+( Uses integer math throughout. )
 ( Forth expression syntax is mostly postfix. )
 ( Only the definition syntax is prefix or infix. )
-( I've added comments with equivalent infix expressions to help those unfamiliar with Forth. )
+( I've added some comments with equivalent infix expressions )
+( to help those unfamiliar with Forth. )
 
 
 ( Using baroque identifiers for ancient Forths. )
-( fig-Forth used first three character significant symbol tables. )
+( fig-Forth used first three character + length significance in symbol tables. )
+
+
+( UM*, FM/MOD, and S>D are already there in most modern Forths. )
+( These definitions are only for ancient Forths, )
+( especially pre-1983 fig and bif-c. )
+( Un-comment them if you see errors like )
+( UM* ? err # 0 )
+( from PRMONTH or thereabouts. )
 
+( : UM* U* ; ) ( modern name for unsigned mixed multiply )
 
-( For ancient, especially pre-1983 fig, Forths: )
-( Do not use these in modern Forths like gforth. )
-: UM* U* ;
-: FM/MOD M/MOD DROP ; ( Cheat! Behavior is not well defined for negative numbers. )
-( This is just renaming in a sloppy fashion, )
-( to accomodate the difference between ancient fig-Forths and modern Forths. )
-( Showing it in infix won't help. )
-: S>D S->D ; ( Old fashioned name for single-to-double. )
+( This is a cheat! Behavior is not well defined for negative numbers, )
+( but we don't do negatives here. )
+( So this is just sloppy renaming in a sloppy fashion: )
+( : FM/MOD M/MOD DROP ; ) ( unsigned division with modulo remainder )
+
+( : S>D S->D ; ) ( Modern name for single-to-double. )
+
+( Showing the above in infix won't help. )
 
-( Semi-simulate local variables. )
 SP@ SP@ - ABS CONSTANT CELLWIDTH
 ( Infix won't help here, either, but I can try to explain: )
 ( CELLWIDTH = absolute-value-of difference-between SP-without-pointer and SP-with-pointer.  )
 
+( Semi-simulate local variables with the ability to fetch and store relative to top of stack. )
+
 ( Infix will be confusing here, too. )
 : LC@ ( index -- sp[ix] ) ( 0 is top. PICK is available on many modern Forths. )
   1 + CELLWIDTH *  ( Skip over the stack address on stack. )
@@ -79,22 +123,10 @@ SP@ SP@ - ABS CONSTANT CELLWIDTH
  0 .R ;
 
 
-: NUMERATORS ( count -- )
-DUP 1+ 0 DO 
-   I PSNUM COLON SPACE
-   I 1000 * OVER / PSNUM COMMA ( 1000 times I, divided by count )
-   SPACE LOOP 
-DROP ;
-
-: FRACTIONS ( count -- )
-1 DO 
-   I NUMERATORS CR 
-LOOP ;
-
-
-( Watch limits on 16 bit processors. )
 ( Do it in integers! )
 
+( Watch limits on 16 bit processors! )
+
 7 CONSTANT SCYCLE ( years in short cycle )
 ( SCYCLE = 7 )
 
@@ -124,7 +156,12 @@ MCYCLE MP2LCYC * CONSTANT 2LCYCLE ( years in double long cycle, should be 686 )
 
 DPSKIPYEAR SCYCLE * RDSCYCLE + CONSTANT DPSCYCLE ( whole days per 7 year cycle )
 ( DPSCYCLE = DPSKIPYEAR × SCYCLE + RDSCYCLE )
+( DPSCYCLE SPMCYC * CONSTANT DPMCYCLE )
+( DPMCYCLE = DPSCYCLE × SPMCYC )
+( DPMCYCLE MP2LCYC * CONSTANT DP2LCYCLE )
+( DP2LCYCLE = DPMCYCLE × MP2LCYC )
 ( DPMCYCLE and DP2LCYCLE would overflow on 16 bit math CPUs. ) 
+( No particular problem on 32 bit CPUs.
 
 RDSCYCLE SPMCYC * 1 - CONSTANT RDMCYCLE ( remainder days in medium cycle )
 ( RDMCYCLE = RDSCYCLE × SPMCYC - 1 )
@@ -157,7 +194,7 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE
 
 ( Sum up the days of the months in a year. )
 : SU1MONTH ( startfractional startdays -- endfractional enddays )
-  29 + ( Add the whole part. )
+  FDMONTH + ( Add the whole part. )
   SWAP ( Make the fractional part available to work on. )
   MNUMERATOR + ( Add the fractional part. )
   DUP MDENOMINATOR < ( Have we got a whole day yet? )
@@ -235,8 +272,8 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE
 ( And CREATE is initialized as a CONSTANT in the fig-Forth, )
 ( but has no initial characteristic code or value in modern standards. )
 ( So. )
-( On ancient Forths, VARIABLE wants an initial value. We give it one. )
-( It stays around forever. )
+( On ancient Forths, VARIABLE wants an initial value. We give it a zero. )
+( The zero stays around forever on modern Forths, or until you drop it. )
 0 VARIABLE DIMARRAY  ( Days In Months array )
    30 DIMARRAY !  ( 1st month )
    29 ,
@@ -292,11 +329,10 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE
 ;
   
 
-
 ( Below here is scratch work I'm leaving for my notes. )
-( It isn't necessary to the above, and can be deleted. )
+( It can be deleted. )
 
-: V2-SHOWIDEALMONTHS ( years -- )
+: V2-SHOWMONTHS ( years -- )
   >R
   0 0 0 ( daysmemory, fractional, days )
   R> 0 DO
@@ -318,8 +354,20 @@ MDENOMINATOR 2 / CONSTANT MROUNDFUDGE
 ;
 
 
-( : ABS  number -- absolute-value *** built in! ***
-DUP 0< IF NEGATE THEN ; )
+: NUMERATORS ( count -- )
+DUP 1+ 0 DO 
+   I PSNUM COLON SPACE
+   I 1000 * OVER / PSNUM COMMA ( 1000 times I divided by count )
+   SPACE LOOP 
+DROP ;
+
+: FRACTIONS ( count -- )
+1 DO 
+   I NUMERATORS CR 
+LOOP ;
+
+( : ABS  number -- absolute-value *** built in! *** )
+( DUP 0< IF NEGATE THEN ; )
 
 : WITHIN1 ( n1 n2 -- flag ) 
  - ABS 1 <= ; ( n1 and n2 are within 1 of each other )