fin@norge.unet.umn.edu (Craig A. Finseth) (04/08/91)
Written by: Craig Finseth, University of Minnesota
When: 6 Apr 1991
What: Phase of Moon Display
This version incorporates the CIRCLE routine written by Mark Power and
published in Datafile V10N2. Circle drawing time has been reduced
from 14 sec to about 8 sec.
MPHASE Calculate and show the phase of the moon for the current date/time
MTIME Calculate and show the moon time string for the current date/time
MFRAC Calculate the moon phase fraction (0 new moon; .25 first quarter;
.5 full moon; .75 last quarter)
FLIP Invert the screen.
MPLOT Internal to MPHASE: Plot the crescent
MLINE Internal to MPHASE: Draw a line of the crescent
MFINI Internal to MPHASE: display the stars, call FLIP
CIRCLE Circle drawing routine
D4 Utility routine for CIRCLE: does not support filled circle
Notes:
- The algorithm used is known to be incorrect (it uses a single sin
term: the correct calculation uses about 30 such terms). The
algorithm is retained in homage to the original version written at the
MIT Architecture Machine Group for its MagicSix operating system in
the late 1970s. Everything else, including the constant terms in the
algorithm, has been rewritten and refined.
- If you want to generalize the date/time caluclated for, change
MFRAC.
- You can omit the flip by removing the call to FLIP from MFINI.
- You can omit both the flip and the stars by removing the call to
MFINI from MPHASE.
- The base time for new moon is 12 Jan 1975 at 10:21 am GMT (4:21 AM
CST).
- The moon cycle is assumed to by 42,532 minutes long.
- The stars displayed are just constant random bits: they do not
correspond to real stars.
Checksum: #49b6h
Size: 1772.5
------------------------------------------------------------
%%HP: T(3)A(D)F(.);
DIR
MPHASE
\<< RCLF DEG
ERASE { # 0h # 0h }
PVIEW { # 40h # 1Ch
} # 1Ah CIRCLE 26
28 MFRAC MPLOT
MFINI 7 FREEZE STOF
\>>
MTIME
\<< MFRAC \-> X
\<<
IF X .25 <
THEN "NM+"
ELSE
IF X .5 <
THEN
"FQ+"
ELSE
IF X
.75 <
THEN
"FM+"
ELSE
"LQ+"
END
END
END X
\>> .25 MOD
42532 * SWAP OVER
1440 / IP \->STR +
"d " + SWAP 1440
MOD SWAP OVER 60 /
IP \->STR + "h " +
SWAP 60 MOD SWAP
OVER IP \->STR + "m "
+ SWAP FP 60 * IP
\->STR + "s" +
\>>
MFRAC
\<< 1.121975 DATE
DDAYS TIME 4.21
HMS- HMS\-> 24 / +
1440 * 42532 / FP
\>>
FLIP
\<< PICT PICT RCL
NEG { # 0h # 0h }
SWAP REPL
\>>
MPLOT
\<< \-> RA MI F
\<<
IF F .5 <
THEN F 360
* COS RA * RA
ELSE RA NEG
F .5 - 360 * COS RA
*
END \-> L R
\<< 1 0
FOR x x
ACOS SIN DUP MI x
RA * + L R MLINE MI
x RA * - L R MLINE
RA INV NEG
STEP
\>>
\>>
\>>
MLINE
\<< \-> SC LI L R
\<< SC L * 64 +
R\->B LI R\->B 2 \->LIST
SC R * 64 + R\->B LI
R\->B 2 \->LIST LINE
\>>
\>>
MFINI
\<< { # Ah # Ah }
PIXON { # 6Eh # Fh
} PIXON { # 64h
# 32h } PIXON {
# 1Eh # 29h } PIXON
{ # 1Fh # 29h }
PIXON FLIP
\>>
CIRCLE
\<< B\->R DUP 2 * 3
SWAP - 0 \-> y d x
\<<
IF DUP TYPE
1 ==
THEN C\->PX
END LIST\->
DROP \-> xo yo
\<<
WHILE x y
<
REPEAT xo
x yo y D4 xo y yo x
D4 6 x
IF d 0
\>=
THEN
'y' DECR -
END 4 *
+ 'd' STO+ 'x' INCR
DROP
END
IF x y ==
THEN xo x
yo y D4
END
\>>
\>>
\>>
D4
\<< DUP2 - 5
ROLLD + 4 ROLLD
DUP2 - 5 ROLLD + \->
nx py ny px
\<< px py 2
\->LIST px ny 2 \->LIST
nx py 2 \->LIST nx ny
2 \->LIST PIXON PIXON
PIXON PIXON
\>>
\>>
END
Craig A. Finseth fin@unet.umn.edu [CAF13]
University Networking Services +1 612 624 3375 desk
University of Minnesota +1 612 625 0006 problems
130 Lind Hall, 207 Church St SE +1 612 626 1002 FAX
Minneapolis MN 55455-0134, U.S.A.