Article 5680 of comp.sys.handhelds:
Path: en.ecn.purdue.edu!noose.ecn.purdue.edu!samsung!spool.mu.edu!cs.umn.edu!uc!norge.unet.umn.edu!fin
From: fin@norge.unet.umn.edu (Craig A. Finseth)
Newsgroups: comp.sys.handhelds
Subject: revised phase of moon program for the HP-48SX
Message-ID: <3849@uc.msc.umn.edu>
Date: 8 Apr 91 16:12:23 GMT
Sender: news@uc.msc.umn.edu
Organization: Univ Netw Serv, Univ of Minn
Lines: 185

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.


