Commit: cadfda1113be8e550b5feee4253a90589c6ff7f4 - xhilr_calendar (git)

Functions for working with the idealized calendar of Planet Xhilr

Commit MetaInfo

• Revisão: cadfda1113be8e550b5feee4253a90589c6ff7f4 (tree)
• Hora: 2017-06-13 18:16:48
• Autor: Joel Matthew Rees <joel.rees@gmai...>
• Commiter: Joel Matthew Rees

Mensagem de Log

Fixing errors, a little code cleanup

Mudança Sumário

• modified: econmonths.fs

Diff

--- a/econmonths.fs
+++ b/econmonths.fs
@@ -343,12 +343,12 @@ CELLBITS CELLWIDTH /MOD CONSTANT BYTEBITS CONSTANT LEFTOVERBITS
 ( Just best to do in assembler, along with UD* and UQD/MOD . )
 
 ( Do it in assembler instead! Hundreds of times as slow!!!! )
-: DIV2/ ( u1 --- u2 : Halve the top cell. REALLY SLOW! )
+: DIV-2/ ( u1 --- u2 : Halve the top cell. REALLY SLOW! )
   S>D 2 UM/MOD SWAP DROP ;
 
 ( Do it in assembler instead! Hundreds of times as slow!!!! )
-: DIVD2/ ( ud1 --- ud2 : Halve the top double cell. REALLY SLOW! )
-  2 UM/MOD ROT DROP ;
+: DIV-D2/ ( ud1 --- ud2 : Halve the top double cell. REALLY SLOW! )
+  2 JM/MOD ROT DROP ;
 
 ( Scaling, to keep the steps time-bounded, )
 ( is going to leave me at the binary long division )
@@ -755,7 +755,7 @@ CELLWIDTH NEGATE ALLOT ( Back up to store values. )
 
 
 ( Modern Forths will leave the initialization 0 behind. )
-0 CONSTANT WKDAYOFFSET ( Weekday corresponding to day zero of year zero. )
+6 CONSTANT WKDAYOFFSET ( Weekday corresponding to day zero of year zero. )
 0 VARIABLE 1STDAYOFWEEK ( Weekday corresponding to first day of week. )
 0 1STDAYOFWEEK !
 
@@ -783,9 +783,6 @@ RD2LCYCLE 16 * CONSTANT NUCYCLE ( numerator: 7760 )
 : SMPERIOD10976 [ SMPERIODINT DECYCLE UM* SMPERIODFRAC10976 0 D+ SWAP ] LITERAL LITERAL ; 
 ( 28 9645 / 10976 == 316973 / 10976 )
 
-0 CONSTANT SMOFFINT ( Slow moon offset at year 0 day 0, integer part. )
-0 CONSTANT SMOFFFRAC10976 ( Fractional part. )
-
 ( Modern Forths will leave the initialization 0 behind. )
 0 VARIABLE SMSTATEINT ( Slow moon state integer part. )
 0 SMSTATEINT ! 0 , ( Initialize cleared, make double variable. )
@@ -796,6 +793,27 @@ RD2LCYCLE 16 * CONSTANT NUCYCLE ( numerator: 7760 )
 : SM16THPERIOD10976 [ SMPERIOD10976 8. D+ 16 JM/MOD ROT DROP SWAP ] LITERAL LITERAL ;
 : SM32NDPERIOD10976 [ SMPERIOD10976 16. D+ 32 JM/MOD ROT DROP SWAP ] LITERAL LITERAL ;
 
+( start + mt = 1/2, start + gt = 3/4 => t * { g - m } = 1/4 => t = 1 / 4 * { g - m } )
+( g = 1 rot/day, m = 10976 / 316973 rev/day => t = 1 / { 4 * [ 316973 - 10976 ] / 316973 } )
+( s + gt = 3/4 => s = 3/4 - t; s = 3/4 - 1 / { 4 * [ 316973 - 10976 ] / 316973 } ) 
+( s + mt = 1/2 => s = 1/2 - mt; s = 1/2 - 10976 / [ 4 * { 316973 - 10976 } ] )
+( s = [ 2 * 316973 - 3 * 10976 ] / [ 4 * { 316973 - 10976 } ] )
+( s = 601018 / 1223988 )
+: SMTARGET 
+  [ 2. SMPERIOD10976 UMD* 2DROP 3 DECYCLE UM* D-
+    SMPERIOD10976 UMD* ( Scale it py period and keep high double word. )
+    4. SMPERIOD10976 DECYCLE 0 D- UMD* 2DROP 
+    SLOW-UMD/MOD 2SWAP 2DROP SWAP
+ ] LITERAL LITERAL ;
+( Used SMTARGET like this with SMOFFFRAC10976 set to 0.: )
+( 34 3 STYCYCLES 5 DMADJUST SMSTATEFRAC10976 D@ SMTARGET D- D. 76151 )
+0 CONSTANT SMOFFINT ( Slow moon offset at year 0 day 0, integer part. )
+: SMOFFFRAC10976  ( Fractional part. ) [ 76151. SWAP ] LITERAL LITERAL ;
+
+( Below was guessing wrong: )
+(  [ SM32NDPERIOD10976 28 UDS* DROP )
+(    SM32NDPERIOD10976 DIV-D2/ D+ 4 JM/MOD ROT DROP SWAP ] )
+
 ( Could pre-divide the period into 16ths but this is an output function, )
 ( can be a little slow. )
 : SMSHOWPHASE ( --- ) ( --- ) ( Show the Slowmoon phase with no spacing. )
@@ -912,7 +930,7 @@ RD2LCYCLE 16 * CONSTANT NUCYCLE ( numerator: 7760 )
 ( Intended to be called from STYCYCLES. Other use will leave things out of sync. )
 : SLOMSTCYCLES ( ddays --- ) 
   DECYCLE S>D UMD* SMPERIOD10976 SLOW-UMD/MOD 
-  2SWAP SMOFFFRAC10976 S>D D+
+  2SWAP SMOFFFRAC10976 D+
   2DUP SMPERIOD10976 D< 0= IF
     SMPERIOD10976 D- 2SWAP 1. D+ 2SWAP
   THEN