TITLE MOONPHASE FUNCTION FOR MACLISP (ITS ONLY)

;;; BY GUY L. STEELE JR. (GLS)
;;; PRIMARILY USED BY THE PHSPRT PACKAGE (Q.V.).

.FASL
.INSRT SYS:.FASL DEFS

;;; (MOONPHASE) RETURNS A 5-LIST (PHS DAY HOUR MIN SEC)
;;;	PHS IS:	0	NEW MOON
;;;		1	FIRST QUARTER
;;;		2	FULL MOON
;;;		3	LAST QUARTER
;;;	DAY, HOUR, MIN, SEC IS THE TIME SINCE PHS.
;;; THIS ROUTINE IS NOT TRULY ACCURATE, THEY SAY, BUT WHO CARES?

.ENTRY MOONPHASE SUBR 000001

	SETZ A,
	.RLPDT TT,
	SKIPGE TT
	 POPJ P,
	TLNE D,400000
	SUBI TT,24.*60.*60.
	TLNE D,100000
	SUBI TT,60.*60.
	MOVE F,TT
	MOVEI T,-1(D)
	TLZ D,-1
	IMULI D,365.
	LSH T,-2
	ADDI D,(T)
	IDIVI T,25.
	SUBI D,(T)
	LSH T,-2
	ADDI D,1(T)
	MULI D,24.*60.*60.
	JFCL 4,.+1
	ADD R,F
	ADD R,[690882.]
	JFCL 4,[AOJA D,.+1]
	ASHC D,2
	DIV D,[2551443.]
	ANDI D,3
	ASH R,-2
	SETZ B,
IRP X,,[60.,60.,24.]
	IDIVI R,X
	MOVE TT,F
	JSP T,FXCONS
	CALL 2,.FUNCTION CONS
	MOVEI B,(A)
TERMIN
	MOVE TT,R
	JSP T,FXCONS
	CALL 2,.FUNCTION CONS
	MOVEI B,(A)
	MOVE TT,D
	JSP T,FXCONS
	JCALL 2,.FUNCTION CONS

FASEND