perm filename ASTRO2.BAS[NET,GUE] blob sn#026500 filedate 1973-02-22 generic text, type T, neo UTF8
00010 REM CHART PROGRAM
00015 P1=3.14159265359
00020 REM TOVAR
00030 REM APRIL 1971
00040 DIM P(11,2),E(3),N$(9),Z$(11),P$(11),A$(11),C(11,7),D$(12),D(12),T(25)
00050 REM P CONTAINS PLANETS; E CONTAIN POLES OF HOUSES; N$ CONTAINS 0-9
00060 REM (FOR FORMATTING); Z$ CONTAINS NAMES OF 12 SIGNS; P$ CONTAINS NAMES
00070 REM OF PLANETS, ETC.; A$ CONTAINS ABRIVIATIONS OF NAMES OF ASPECTS
00080 REM C CONTAINS ORBS FOR ASPECTS; D$ CONTAINS THE NAMES OF THE MONTHES
00090 REM D CONTAINS THE LENGTH OF THE MONTHES; T IS A TEMPERARY STORAGE ARRAY
00100 FOR I=0 TO 9
00110 READ N$(I)
00120 NEXT I
00130 DATA "0","1","2","3","4","5","6","7","8","9"
00140 FOR I=0 TO 11
00150 READ Z$(I)
00160 NEXT I
00170 DATA "ARIES     ","TAURUS    ","GEMINI    ","CANCER    ","LEO       "
00180 DATA "VIRGO     ","LIBRA     ","SCORPIO   ","SAGITARIUS","CAPRICORN "
00190 DATA "AQUARIUS  ","PISCES    "
00200 FOR I=1 TO 11
00210 READ P$(I)
00220 NEXT I
00230 DATA "SUN    ","MOON   ","MERCURY","VENUS  ","MARS   ","JUPITER"
00240 DATA "SATURN ","URANUS ","NEPTUNE","PLUTO  ","NODES  "
00250 FOR I=1 TO 12
00260 READ D$(I),D(I)
00270 NEXT I
00280 DATA "JAN.",31,"FEB.",28,"MARCH",31,"APRIL",30,"MAY",31,"JUNE",30
00290 DATA "JULY",31,"AUG.",31,"SEPT.",30,"OCT.",31,"NOV.",30,"DEC.",31
00300 FOR I=1 TO 5
00310 READ M$(I)
00320 NEXT I
00330 DATA "11TH HOUSE","12TH HOUSE","ASCENDENT ","1ST  HOUSE","2ND  HOUSE"
00340 FOR I=1 TO 11
00350 READ A$(I)
00360 FOR J=1 TO 7
00370 READ C(I,J)
00380 NEXT J
00390 NEXT I
00400 DATA "CONJ",0,12,0,8,0,8,0,"OPPS",169,180,172,180,172,180,180,"TRIN",109
00410 DATA 133,112,132,112,128,120,"SQR ",78,107,82,102,82,98,90,"SXTL",50,68,52
00420 DATA 68,52,68,60,"SSQR",41,49,41,49,41,49,45,"SSXT",26,34,26,34,26,34,30
00430 DATA "QNCX",148,152,148,152,148,152,150,"QNTL",68,76,68,76,68,76,72,"SESQ"
00440 DATA 133,137,133,137,133,137,135,"BQNT",142,146,142,146,142,146,144
00450 PRINT "NAME(>15 CHARACTERS)";
00460 INPUT Q$
00470 PRINT "BIRTHPLACE";
00480 INPUT B$
00490 PRINT "DATE OF BIRTH(AS 4,24,1971 FOR APRIL 24, 1971)";
00500 GOSUB 2570
00510 LET D1=T
00520	PRINT "TIME (IN 24 HOURS, AS 1643 FOR 4:43 PM)";
00530 INPUT T7
00540 LET T7=INT(T7/100)+(T7/100-INT(T7/100))/.6
00550 REM CONVERT FOR HOURS AND MINUTES TO HOURS AND FRACTIONS THEREOF
00560 PRINT "LONGITUDE(AS 97,14 FOR 97 DEGREES AND 14 MINUTES WEST; -97,14 FOR EAST)"
00570 PRINT "EAST)";
00580 INPUT N1,T
00590 IF N1>0 THEN 610
00600 LET T=-ABS(T)
00610 LET N1=N1+T/60
00620 PRINT "LATITUDE(USE MINUS IF SOUTHERN HEMISPHERE)";
00630 INPUT T0,T
00640 IF T0>0 THEN 660
00650 LET T=-ABS(T)
00660 LET T0=T0+T/60
00670 PRINT "CORRECTION INTO GREENWICH MEAN TIME (BEWARE OF DAYLIGHT SAVINGS TIME)";
00680 INPUT T4
00690 LET T7=T7+T4
00700 REM T7 IS NOW GMT
00710 LET T6=0
00720 IF T7<24 THEN 760
00730 LET T6=1
00740 REM R6 INDICATES IF ON NEXT DAY
00750 LET T7=T7-24
00760 PRINT "READ EPHEMERIS FOR";
00770 LET T=D1+T6
00780 GOSUB 2700
00790 PRINT " AND";
00800 LET T=T+1
00810 GOSUB 2700
00819	PRINT
00820	PRINT "SIDERIAL TIME"
00825	PRINT "EARLIER ENTRY";
00830 INPUT T5,T,Q
00840 LET T5=T5+(T+Q/60)/60
00850 PRINT "LATER ENTRY";
00860 INPUT T2,T,Q
00870 LET T2=T2+(T+Q/60)/60
00880 REM T3 IS INTERPOLATIONING CONSTANT
00890 LET N0=T7+T5+(T2-T5)*T7/24-N1/15
00900 PRINT "TO ENTER SIGNS USE;"
00910 FOR I=1 TO 3
00915	PRINT
00920 FOR J=0 TO 9 STEP 3
00930	PRINT TAB(6*J);Z$(I+J-1);" =";I+J;
00940 NEXT J
00950 NEXT I
00960	PRINT 
00965	PRINT
00967	PRINT "FOR EXAMPLE:"
00968	PRINT "1,12,33 FOR 12 ARIES 33"
00970 FOR I=1 TO 11
00980 LET Z=T7
00990 LET Y=24
01000	PRINT
01005	PRINT P$(I)
01007	PRINT "EARLIER ";
01010 IF I<10 THEN 1060
01020 REM DATES ARE ENTERED HERE AS THEY REFER TO ENTRIES NO LISTED DAILY
01030	PRINT "DATE";
01040 GOSUB 2570
01050 LET Z=T
01060 PRINT "ENTRY";
01070 INPUT P(I,1),T,Q
01080	LET P(I,1)=30*P(I,1)+T+Q/30
01090 PRINT "LATER ";
01100 IF I<10 THEN 1150
01110 PRINT "DATE";
01120 GOSUB 2570
01130 LET Y=T-Z
01140 LET Z=D1+T7/24-Z
01150 PRINT "ENTRY";
01160 INPUT P(I,2),T,Q
01170	LET Q=30*P(I,2)+T+Q/30
01180 LET P(I,2)=0
01181	IF ABS(Q-P(I,1))<90 THEN 1190
01182	IF ABS(Q-P(I,1))>270 THEN 1190
01183	PRINT "THAT'S UNREASONABLE, TRY AGAIN"
01184	GOTO 980
01185	IF P(I,1)<Q THEN 1188
01186	LET Q=Q+360
01187	GOTO 1240
01188	LET P(I,1)=P(I,1)+360
01189	GOTO 1200
01190 IF P(I,1)<Q THEN 1240
01200 LET P(I,2)=1
01210 IF P(I,1)<>Q THEN 1240
01220 PRINT "RETROGRADE(1-YES,0-NO)";
01230 INPUT P(I,2)
01240	LET P(I,1)=P(I,1)+(Q-P(I,1))*Z/Y-30
01250 REM INTERPOLATE
01260 NEXT I
01270 PRINT "THAT'S ALOT TO INPUT, UH?  WELL WHAT DO YOU EXPECT FOR A PROGRAM IN "
01280 PRINT "'BASIC', PI TO 10,000 PLACES..."
01290	PRINT
01295	PRINT
01297	PRINT
01298	PRINT "TEAR OFF ON DASHED LINE"
01299	PRINT  "-----"
01300	PRINT
01305	PRINT
01307	PRINT TAB(65-15);Q$
01308	PRINT TAB(65-15);B$
01309	PRINT TAB(65-16);
01310 LET T=D1
01320 GOSUB 2700
01330 PRINT TAB(65-15);"AT";
01340 LET T=T7+T6*24-T4
01350	PRINT 1+INT(T+11-12*INT((T+11)/12));":";
01360 LET Q=60*(T-INT(T))
01370 PRINT N$(Q/10);N$(Q-10*INT(Q/10));" ";
01380 IF T<12 THEN 1410
01390 PRINT "PM"
01400 GOTO 1420
01410 PRINT "AM"
01420 PRINT TAB(65-15);"LAT. ";INT(ABS(T0));
01430 IF T0<0 THEN 1460
01440	PRINT "N";
01450 GOTO 1470
01460	PRINT "S";
01470 PRINT INT(60*(ABS(T0)-INT(ABS(T0))) )
01480 PRINT TAB(65-15);"LONG.";INT(ABS(N1));
01490 IF N1<0 THEN 1520
01500 PRINT " W";
01510 GOTO 1530
01520 PRINT " E";
01530	PRINT INT(60*(ABS(N1)-INT(ABS(N1))))
01535	PRINT "GMT";TAB(15);
01540 LET T=T7
01550 GOSUB 2950
01560	PRINT
01565	PRINT "SIDERIAL TIME";TAB(15);
01570 LET T=T5
01580 GOSUB 2950
01590	PRINT
01595	PRINT "SIDERIAL COR.";TAB(15);
01600 LET T=(T2-T5)*T7/24
01610 GOSUB 2950
01620	PRINT
01625	PRINT "LONG. CORR.";TAB(14);"-";
01630 LET T=N1/15
01640 GOSUB 2950
01645	PRINT
01650	PRINT TAB(16);"----------"
01655	PRINT TAB(15);
01660 LET T=N0
01670 GOSUB 2950
01680	PRINT
01685	PRINT
01687	PRINT
01688	PRINT "CUSPS OF HOUSES"
01690 LET T1=ATN(10↑(10-9.9970351)*TAN(P1*T0/180))
01700 REM GEOCENTRIC CORRECTION
01710 LET N1=N0*360/24
01720 LET O=P1*(23+(27+15/60)/60)/180
01730 LET K1=P1*30/180
01740 PRINT "10TH HOUSE =";
01750 LET T=180*ATN(TAN(P1*N1/180)/COS(O))/P1
01760 LET T3=0
01770 GOSUB 3040
01780 LET L9=P1*N1/180
01790 LET L8=SIN(L9)*SIN(O)/SQR(1-(SIN(L9)*SIN(O))↑2)
01800 LET E(3)=TAN(T1)
01810 LET T=E(3)*L8
01815 LET T=ATN(T/SQRT(1-T*T))
01820 LET E(2)=SIN(T*2/3)/L8
01830 LET E(1)=SIN(T/3)/L8
01840 FOR T3=1 TO 5
01850 LET T=ATN(E(3-ABS(T3-3))/COS(L9+T3*K1))
01860 LET  T=180*ATN(TAN(L9+T3*K1)*COS(T)/COS(T+O))/P1
01870	PRINT
01875	PRINT M$(T3);" =";
01880 GOSUB 3040
01890 NEXT T3
01900 LET T3=0
01910	PRINT
01915	PRINT
01917	PRINT
01918	PRINT "POSITIONS OF PLANETS"
01920 FOR I=1 TO 11
01930	PRINT
01935	PRINT P$(I);
01940	LET T=P(I,1)
01950	GOSUB 3120
01960 IF P(I,2)=0 THEN 1980
01970 PRINT "(RETROGRADE)";
01980 NEXT I
01990	PRINT
01995	PRINT
01997	PRINT "ASPECTS"
01998	PRINT "       ";
02000 FOR J=1 TO 11
02010 LET T(J)=P(J,1)
02020 GOSUB 2870
02030 IF P(J,2)=0 THEN 2060
02040	REM PRINT "R";
02050 GOTO 2070
02060	REM PRINT " ";
02070 NEXT J
02080 FOR I=1 TO 11
02090	PRINT
02095	PRINT P$(I);" ";
02100 FOR J=1 TO 11
02110 LET T(J)=ABS(P(I,1)-P(J,1))
02120 IF Q <= 180 THEN 2140
02130 LET T(J)=360-T(J)
02140 NEXT J
02150 FOR J=1 TO I-1
02160 GOSUB 2870
02170	REM PRINT " ";
02180 NEXT J
02190	PRINT "\///";
02200 FOR J=I+1 TO 11
02210 LET U1=0
02220	IF I=1 THEN 2260
02225	IF J=1 THEN 2260
02230	IF I=2 THEN 2250
02235	IF J=2 THEN 2250
02240 LET U1=U1+2
02250 LET U1=U1+2
02260 FOR K=1 TO 11
02270	IF C(K,U1+1) >= T(J) THEN 2280
02275	IF C(K,U1+2)>T(J) THEN 2320
02280 NEXT K
02290 LET T(J)=-1
02300 PRINT "     ";
02310 GOTO 2340
02320 LET T(J)=ABS(T(J)-C(K,7))/60
02330 PRINT " ";A$(K);
02340 NEXT J
02345	PRINT
02350	PRINT TAB(7);
02360 FOR J=1 TO 11
02370 IF I=J THEN 2440
02380 IF T(J)<0 THEN 2420
02390 LET T=60*(T(J)-INT(T(J)))
02400 GOSUB 3160
02410 GOTO 2450
02420 PRINT "     ";
02430 GOTO 2450
02440 PRINT " ///\";
02450 NEXT J
02460 NEXT I
02470 FOR I=1 TO 4
02480 PRINT
02490 NEXT I
02500 PRINT "-----"
02510 FOR I=1 TO 8
02520 PRINT
02530 NEXT I
02540 GOTO 450
02550 REM READ DATE
02560 PRINT "AH, COME ON NOW, TRY AGAIN";
02570 INPUT T,U8,U9
02580	IF T<1 THEN 2560
02585	IF T>12 THEN 2560
02587	IF U8<1 THEN 2560
02588	IF U9<1800 THEN 2560
02590	IF T=2 THEN 2600
02595	IF U8>D(T) THEN 2560
02600	IF T<>2 THEN 2610
02605	IF U8>29 THEN 2560
02610	IF T<>2 THEN 2620
02615	IF U9<>4*INT(U9/4) THEN 2620
02617	IF U8>28 THEN 2560
02620	IF T<3 THEN 2640
02625	IF U9<>4*INT(U9/4) THEN 2640
02630 LET U8=U8+1
02640 FOR U7=1 TO T-1
02650 LET U8=U8+D(U7)
02660 NEXT U7
02670 LET T=U8+366*(U9-1800)-1
02680 RETURN
02690 REM PRINT DATE
02700 LET U9=INT(T/366)+1800
02710 LET U8=T-366*(U9-1800)
02720	IF U8<>365 THEN 2750
02725	IF U9=4*INT(U9/4) THEN 2750
02730 LET U9=U9+1
02740 LET U8=U8-365
02750 FOR U7=1 TO 12
02760 LET U8=U8-D(U7)
02770 IF U8<0 THEN 2790
02780 NEXT U7
02790 LET U8=U8+D(U7)
02800	IF U7<3 THEN 2850
02805	IF U9<>4*INT(U9/4) THEN 2850
02810 LET U8=U8-1
02820 IF U8>=0 THEN 2850
02830 LET U7=U7 -1
02840 LET U8=U8+D(U7)
02850 PRINT INT(U8+1);" ";D$(U7);INT(U9);
02860 RETURN
02870 IF ABS(T(J)) >= 100 THEN 2920
02880 REM PRINT 3 DIGITS OF T(J)
02890 PRINT " ";
02900 IF ABS(T(J)) >= 10 THEN 2920
02910 PRINT " ";
02920 PRINT INT(T(J));
02930 RETURN
02940 REM PRINT AS %% %% %%
02950 GOSUB 2990
02960 LET T=60*(T-INT(T))
02970 GOSUB 2990
02980 LET T=60*(T-INT(T))
02990 IF T >= 10 THEN 3020
03000 REM PRINT T AS %%
03010 PRINT " ";
03020 PRINT INT(T);
03030 RETURN
03040 IF T>0 THEN 3100
03050	REM PRINT T WITH ZODIACAL SIGN
03060 LET T=T+180
03070 IF N1+30*T3-360*INT((N0+30*T3)/360)<225 THEN 3120
03080 LET T=T+180
03090 GOTO 3120
03100 IF N1+30*T3-360*INT((N0+30*T3)/360)<135 THEN 3120
03110 LET T=T+180
03120 IF T-30*INT(T/30)>=10 THEN 3140
03130 PRINT " ";
03140	PRINT INT(360+T-30*INT(T/30+12));" ";Z$(T/30);
03150 LET T=60*(360+T-INT(360+T))
03160 IF T<10 THEN 3200
03170 REM PRINT T AS %%.%
03180 PRINT " ";N$(T/10);
03190 GOTO 3210
03200 PRINT "  ";
03210 PRINT N$(T-10*INT(T/10));".";N$(10*(T-INT(T)));
03220 RETURN
03230 END