COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	EXPR CHART() 
C00008 00003	EXPR INIT() 
C00012 ENDMK
C⊗;
EXPR CHART() ;
BEGIN
NEW NAME, YEAR, MONTH, DAY, HOUR, ZONE, LATITUDE, LONGITUDE,
    STDTIME, W, GMT, SIDTIMENOON, SIDTIMEG, SIDTIME, SDAY, SGMT, EDAY,
    SMALLT, BIGT, CUSPS, PNEXT, PNATAL, PPREV, MC, ASC, S, Q ;
IF NULL('JANUARY.MONTH) THEN INIT() ;
CHOICE(10) ;

PRINTSTR("IN CASE OF TYPO, MAKE NEXT RESPONSE `NIL'") ;
NAME ← RD("NAME") ;
YEAR ← RD("YEAR") ;
DO BEGIN MONTH ← RD("MONTH") ;
   IF NOT NUMBERP MONTH THEN MONTH ← MONTH.MONTH ;
   END
UNTIL NUMBERP MONTH ;
DAY ← RD("DAY OF THE MONTH") ;
HOUR ← RD("TIME, E.G., 1745 FOR 5:45PM") ;
DO	BEGIN
	ZONE ← RD("TIME ZONE, E.G., (PACIFIC DAYLIGHT WAR)") ;
	W ← (CAR ZONE).WESTOFGREENWICH ;
	IF NOT NUMBERP W THEN PRINTSTR("NO SUCH ZONE " CAT CAR(ZONE)) ;
	END UNTIL NUMBERP W ;
LATITUDE ← RD("FROM TABLE OF HOUSES OR A MAP:
LATITUDE, DEGREES NORTH") ;
LONGITUDE ← RD("LONGITUDE, DEGREES WEST") ;
TERPRI PRINC(<NAME, HOUR, <DAY, MONTHS[MONTH], YEAR>, ZONE,
   LATITUDE, 'N, LONGITUDE, 'W>) ;
%MINUTES AFTER MIDNIGHT FROM HERE ON, EXCEPT SECONDS FOR SIDEREAL TIME%
STDTIME ← MINS(HOUR) - ZONECORRECTION(ZONE) ;
GMT ← STDTIME + 60*W ;
TERPRI PRINC(<'GMT, CLOCK(GMT)>) ;

CHOICE(2) ;

SDAY ← IF GMT GREATERP 24*60 THEN DAY+1 ELSE DAY ;
SGMT ← IF GMT GREATERP 24*60 THEN GMT-24*60 ELSE GMT ;
PRINTSTR("GIVE SIDEREAL TIMES IN THE FORM (17 45 52) FOR 17:45:52.
LOOK IN THE EPHEMERIS, RIGHT HAND PAGE, FIRST COLUMN (S.T.)") ;
SIDTIMENOON ←
	DO Q ← SECS(RD("SIDEREAL TIME NOON FOR " CAT DATE(YEAR, MONTH, SDAY)))
	UNTIL Q ;
SIDTIMEG ← SIDTIMENOON + (361*(SGMT-12*60))/6 ;
SIDTIME ← REMAINDER(SIDTIMEG - 240*LONGITUDE + 48*3600, 24*3600) ;
PRINTSTR("LOOK IN THE TABLE OF HOUSES, LATITUDE " CAT LATITUDE CAT " N
FIND SIDER'L TIMES NEAR " CAT SCLOCK(SIDTIME)) ;
CUSPS ← FOR NEW SIDT IN '(SMALLER LARGER) COLLECT
	<(DO Q←SECS(RD("NEXT " CAT SIDT CAT " SIDEREAL TIME IN FORM (H M S)"))
	  UNTIL Q) CONS
	  FOR NEW HOUSE IN HOUSES COLLECT
		<<IF SIDT EQ 'SMALLER THEN
			DO CSIGN ← RD("SIGN AT " CAT HOUSE CAT " CUSP")
			UNTIL NOT NUMBERP CSIGN AND CSIGN.SIGN,
		  RD(IF SIDT EQ 'SMALLER THEN "DEGREES"
		     ELSE "DEGREES AT " CAT HOUSE CAT " CUSP"),
		  IF HOUSE NEQ 'ASC THEN 0 ELSE RD("MINUTES")>>
	> ;

EDAY ← IF GMT LESSP 12*60 THEN DAY-1 ELSE DAY ;
PRINTSTR("NOW TURN TO THE EPHEMERIS FOR " CAT DATE(YEAR, MONTH, EDAY)) ;

FOR NEW D ← 1 TO 3 DO
BEGIN
IF D=3 THEN S←RD("TYPE OUTPUT FILENAME OR TTY (OR NIL)") ALSO
	BEGIN IF S NEQ 'TTY THEN EVAL(<'OUTC,<'OUTPUT,'DSK?:,S>>) END
ELSE CHOICE(2) ;
PRINTSTR(CASE D OF BEGIN
   "ENTER NOON POSITIONS OF THE PLANETS (FOR PLUTO, 1ST OF MONTH)";
   "DO THE SAME FOR " CAT DATE(YEAR, MONTH, EDAY+1);
   "HERE ARE THE NATAL POSITIONS"
   END) ;
FOR NEW P IN '(SUN VENUS MERCURY MOON SATURN JUPITER MARS URANUS
   NEPTUNE PLUTO) DO
   CASE D OF
   BEGIN
   P.PREV ← <DO S←RD(P CAT " SIGN") UNTIL NOT NUMBERP S AND S.SIGN,
      RD("DEGREES"), RD("MINUTES")> ;
   P.NEXT ← <S←CAR(P.PREV),
      RD("DEGREES OF " CAT S CAT " FOR " CAT P), RD("MINUTES")> ;
	BEGIN
	PNEXT ← P.NEXT ; PPREV ← P.PREV ;
	PNATAL ←
	   IF P EQ 'PLUTO THEN INTERP(EDAY, 1, 60*PPREV[2]+PPREV[3],
		LASTDAY[MONTH]+1, 60*PNEXT[2]+PNEXT[3])
	   ELSE INTERP(GMT,
	   	IF GMT LESSP 12*60 THEN -12*60 ELSE 12*60, 60*PPREV[2]+PPREV[3],
		IF GMT LESSP 12*60 THEN 12*60 ELSE 36*60, 60*PNEXT[2]+PNEXT[3]) ;
	TERPRI PRINC(<P, ARC(PNATAL), PPREV[1]>) ;
	END ;
   END ;
END ;
SMALLT ← CAR(CUSPS[1]) ; BIGT ← CAR(CUSPS[2]) ;
FOR NEW SMALL	IN CDR(CUSPS[1])
FOR NEW BIG	IN CDR(CUSPS[2])
FOR NEW HOUSE	IN HOUSES
    DO	BEGIN
	C ← INTERP(SIDTIME, SMALLT, SMALL[2]*60+SMALL[3], BIGT, BIG[2]*60+BIG[3]) ;
	TERPRI PRINC(<HOUSE, ARC(C), SMALL[1]>) ;
	END ;
TERPRI PRINC(NAME) ;
OUTC(NIL,T);
RD("TYPE `NIL' TO MAKE CORRECTIONS NOW") ;
END ;
EXPR INIT() ;
BEGIN

FOR NEW I ← 4 TO 8 FOR NEW Z IN '(ATLANTIC EASTERN
   CENTRAL MOUNTAIN PACIFIC) DO
   Z.WESTOFGREENWICH ← I ;

FOR NEW I ← 1 TO 12 FOR NEW S IN '(ARIES TAURUS GEMINI
   CANCER LEO VIRGO LIBRA SCORPIO SAGITTARIUS CAPRICORN AQUARIUS
   PISCES) DO
   S.SIGN ← I ;

FOR NEW I ← 1 TO 12 FOR NEW M IN '((JANUARY JAN)(FEBRUARY FEB)
   (MARCH MAR) (APRIL APR) (MAY) (JUNE) (JULY) (AUGUST AUG)
   (SEPTEMBER SEP) (OCTOBER OCT) (NOVEMBER NOV) (DECEMBER DEC))
	DO FOR NEW MM IN M DO MM.MONTH ← I ;

MONTHS ← <" JANUARY ", " FEBRUARY ", " MARCH ", " APRIL ", " MAY ",
	  " JUNE ", " JULY ", " AUGUST ", " SEPTEMBER ", " OCTOBER ",
	  " NOVEMBER ", " DECEMBER "> ;
LASTDAY ← '(31 28 31 30 31 30 31 31 30 31 30 31) ;

HOUSES ← '(?10TH ?11TH ?12TH ASC ?2ND ?3RD) ;

END ;

EXPR INTERP(KEY, PREKEY, PREVAL, POSTKEY, POSTVAL) ;
   ((POSTVAL-PREVAL)*(KEY-PREKEY))/(POSTKEY-PREKEY) + PREVAL ;

EXPR RD(N) ;
   BEGIN
   NEW RDVAL ;
   PRINTSTR(N CAT " = ") ;
   RDVAL ← READ() ;
   IF ¬RDVAL THEN FAILURE() ;
   RETURN RDVAL ;
   END ;

EXPR ZONECORRECTION(Z) ;
   60*((IF 'DAYLIGHT MEMQ Z THEN 1 ELSE 0)
      +(IF 'WAR MEMQ Z THEN 1 ELSE 0)) ;

EXPR MINS(HR) ; 60*QUOTIENT(HR,100) + REMAINDER(HR,100) ;

EXPR SECS(HR) ; IF NOT ATOM HR AND LENGTH(HR) = 3 THEN
			3600*HR[1] + 60*HR[2] + HR[3]
		ELSE PRINTSTR("MUST BE IN THE FORM: (HR MIN SEC)") ALSO NIL ;

EXPR TWODIGITS(N) ;
	IF N LESSP 10 THEN '(?00 ?01 ?02 ?03 ?04 ?05 ?06 ?07 ?08 ?09)[N+1]
	ELSE N ;

EXPR CLOCK(MS) ; 100*QUOTIENT(MS,60) + REMAINDER(MS,60) ;

EXPR SCLOCK(SS) ; <TWODIGITS(QUOTIENT(SS,3600)),
		   TWODIGITS(QUOTIENT(REMAINDER(SS,3600), 60)),
		   TWODIGITS(REMAINDER(SS, 60))	> ;

EXPR ARC(MS) ; (QUOTIENT(MS,60)) CAT "⊗ " CAT REMAINDER(MS,60) CAT "'" ;

EXPR DATE(YEAR, MONTH, DAY) ;
	BEGIN
	IF DAY LESSP 1 THEN MONTH ← MONTH - 1 ALSO
		DAY ← LASTDAY[IF MONTH=0 THEN 12 ELSE MONTH]
	ELSE IF DAY GREATERP LASTDAY[MONTH] THEN MONTH ← MONTH + 1 ALSO
		DAY ← 1 ;
	IF MONTH LESSP 1 THEN YEAR ← YEAR - 1 ALSO MONTH ← 12
	ELSE IF MONTH GREATERP 12 THEN YEAR ← YEAR + 1 ALSO MONTH ← 1 ;
	RETURN(YEAR CAT MONTHS[MONTH] CAT DAY) ;
	END ;

EXPR CHOICE(N) ;
   SELECT II FROM II:1 SUCCESSOR II+1 UNLESS II GREATERP N FINALLY FAILURE() ;

_EOF_