astrologie pour Sharp PC1500 ( pas de programme )
tir du magazine Hebdogiciel N78

	Ncessite l'extension PETOOLS.

	Passionns de sciences divinatoires, sachez ce que vous rserve les lendemains qui chantent.

Programme :
1 REM astrologie
2 REM ric baelde
5 TEXT:CSIZE 1:COLOR 0:DIM M(11),P(10)
7 INPUT "nom = ";N$,"prnom = ";P$:LPRINT "nom : ";N$:LPRINT "prenom : ";P$
10 DEGREE:WAIT 0:CLS:PRINT "jour :":CURSOR 8:INPUT JR:IF JR<>INT JR OR JR<1 OR J>31 GOTO 10
20 CLS:PRINT "mois :":CURSOR 8:INPUT MS$:MS=VAL MS$:IF MS=0 LET A$=MS$:GOSUB "M":MS$=A$
30 IF MS<>INT MS OR MS<1 OR MS>12 GOTO 20
40 GOSUB "N"
50 CLS:PRINT "anne :":CURSOR 8:INPUT AN:IF AN<>INT AN GOTO 50
60 CLS:PRINT "heure (hh,mmss):":CURSOR 17:INPUT HR:IF HR<0 OR H>24 GOTO 60
70 IF 100*(HR-INT HR)>60 GOTO 60
80 IF 100*(100*HR-INT(100*HR))>60 GOTO 60
90 GOSUB "D":N=DT-694325:A=DT:C=7:GOSUB "A":SM=A:GOSUB "S"
100 CLS:INPUT "dcalage soleil(h) = ";D
110 INPUT "ville = ";U$:GOSUB "LAT"
120 N=N-D/24:C=24:E=23750.3+236.555362*N:A=E/3600:GOSUB "A":TA=A:A=E:E=DEGU/15
125 A=A/3600+DEG HR-D+E:GOSUB "A"
130 TS=A:C=360:WAIT 0:PRINT DMS TS
140 LPRINT "ne a ";U$:LPRINT "longitude :";ABS U;:A$=" est":IF U<0 LET A$=" ouest"
150 LPRINT A$:LPRINT "latitude :";ABS V;:A$=" nord":IF V<0 LET A$=" sud"
160 LPRINT A$:LPRINT "le ";SM$;JR;" ";MS$;AN:LPRINT "a ";HR:LPRINT "ts =";DMS TA:LPRINT "dec :";DMS E
165 LPRINT "tse = ";DMS TS
170 GRAPH:GLCURSOR (107,-107):SORGN
180 CLS:INPUT "heure avant tse =";T$:DT=DEG VAL T$:IF T$="*" GOTO 280
190 INPUT "heure aprs tse =";T:DS=DEG T-DT:DD=TS-DT
200 COLOR 2:RESTORE "mm":FOR I=1 TO 3:READ A$
210 CLS:PRINT "maison ";A$;" avant ";:INPUT J$:GOSUB "KK":IF J$="rien" GOTO 210
220 H$=J$:H=J:CLS:PRINT "maison ";A$;" aprs ";:INPUT J$:GOSUB "KK":IF J$="rien" GOTO 220
230 M(I-1)=DD*(J-H)/DS+H:GOSUB "IM":A=M(I-1)+180:GOSUB "A":J=A:M(I+5)=J:READ A$:GOSUB "TM":NEXT I
240 FOR I=10 TO 12:READ A$
250 CLS:PRINT "maison ";A$;" avant ";:INPUT J$:GOSUB "KK":IF J$="rien" GOTO 250
260 H$=J$:H=J:CLS:PRINT "maison ";A$;" aprs ";:INPUT J$:GOSUB "KK":IF J$="rien" GOTO 220
270 M(I-1)=DD*(J-H)/DS+H:GOSUB "TM":A=M(I-1)+180:GOSUB "A":J=A:M(I-7)=J:READ A$:GOSUB "TM":NEXT I
280 A=17.9+.6165298*N:GOSUB "A3:L=134*COS A+154*COS B+69*COS CC+43*COS D+28*COS E+57*COS F+49*CO
290 COLOR 0:GLCURSOR (107,0):FOR I=10 TO 360 STEP 10:LINE -(107*COS I,107*SIN I):NEXT I
300 GLCURSOR (70,0):FOR I=10 TO 360 STEP 10:LINE -(70*COS I,70*SIN I):NEXT I
310 GLCURSOR (50,0):FOR I=0 TO 360 STEP 10:LINE -(50*COS I,50*SIN I):NEXT I
320 FOR I=0 TO 355 STEP 5
330 IF I=INT(I/30)*30 LINE (50*COS I,50*SIN I)-(70*COS I,70*SIN I):NEXT I:GOTO 350
340 LINE (50*COS I,50*SIN I)-(55*COS I,55*SIN I):NEXT I
350 I=M(0):Q=180-INT(I/30)*30:I=I+Q:J=I+180:LINE (50*COS J,50*SIN J)-(50*COS I,50*SIN I)
360 A=INT(M(0)/30)*30+180:C=360:GOSUB "A":TR=A
370 B$="so":RESTORE B$:C=360:T=N/36525:READ X,Y,Z:A=X+Y*N+Z*T*T:GOSUB "A":L=A:LS=L
371 READ X,Y,Z:A=X+Y*N+Z*T*T:GOSUB "A":W=A:A=L-W:GOSUB "A":M=A:MS=A:U=M
372 READ X,Y,Z:E1=X-Y*T-Z*T*T:EE=E1*180/(pi)
373 V=M+EE*SIN U:IF V<>U LET U=V:GOTO 373
374 V=2*ATN(TAN(U/2)*(racine)((1+E1)/(1-E1)))
375 A=306+1.2330596*N:GOSUB "A":B=A:A=115.9+2474533*N:GOSUB "A":CC=A:A=222.1+.858513*N
376 GOSUB "A":D=A:A=199.2-.121611*N:GOSUB "A":E=A:A=38.3+.9231589*N:GOSUB "A":F=A
377 A=256.9-.0624422*N:GOSUB "A":G=A:A=281.6+9025161*N:GOSUB "A":H=A:A=7.6-.0830856*N
378 GOSUB "A":J=A:A=291.4+1.80503*N:GOSUB "A":K=A:A=316+.8194305*N:GOSUB "A":P=A
379 A=114.3+12.1907494*N:GOSUB "A":Q=A:A=231.4+.00055305*N:GOSUB "A":R=A
380 A=17.9+.6165298*N:GOSUB "A":L=134*COS A+154*COS B+69*COS CC+43*COS D+28*COS E+57*COS F
381 L=L+49*COS G+200*COS H+72*COS J+76*COS K+45*COS P+179*SIN Q+178*SIN R:L=V+W+L/1e5
382 R=543*SIN A+1575*SIN B+200*SIN CC+345*SIN D+474*SIN F+1627*SIN H+927*SIN K+106*SIN P
383 R=R+3076*COS Q:R=1.00000023*(1-e1*COS U)+R/1e8:A=L:GOSUB "A":L=A:P(0)=L
385 XS=R*COS L:YS=R*SIN L:J=L=GOSUB "P"
390 C=360:B$="me":GOSUB "DD":GOSUB "C":P(1)=J:GOSUB "J"
400 C=360:B$="ve":GOSUB "DD":GOSUB "C":P(2)=J:GOSUB "P"
410 C=360:B$="ma":GOSUB "DD":GOSUB "C":P(3)=J:GOSUB "P"
420 C=360:B$="ju":GOSUB "CC":GOSUB "C":P(4)=J:GOSUB "P"
430 C=360:B$="sa":GOSUB "CC":GOSUB "C":P(5)=J:GOSUB "P"
440 C=360:B$="ur":GOSUB "CC":GOSUB "C":P(6)=J:GOSUB "P"
450 C=360:B$="ne":GOSUB "CC":GOSUB "C":P(7)=J:GOSUB "P"
460 C=360:B$="pl":GOSUB "DD":GOSUB "C":P(8)=J:GOSUB "P"
470 C=360:B$="lu":A=33.26578+13.1763966*N:GOSUB "A":LL=A:A=239.882-.052953922*N:GOSUB "A"
480 OL=A:A=18.294+13.06499245*N:GOSUB "A":ML=A:D=LL-LS:F=LL-OL
490 L=LL+6.28875*SIN ML+.2136*SIN(2*ML)+.6583*SIN(2*D)-.1856*SIN MS+1.274*SIN(2*D-ML)
500 L=L-.1143*SIN(2*F)+.0588*SIN(2*D-2*ML)+.0572*SIN(2*D-ML-MS)+.0533*SIN(2*D+ML)
510 L=L+.0459*SIN(2*D-MS)+.041*SIN(ML-MS)-0.305*SIN(ML+MS)-.0348*SIN D:J=L:P(9)=J
520 GOSUB "P":C=360:B$="PF":A=P(9)+M(0)-P(0):GOSUB "A":P(10)=A:J=A:GOSUB "P"
600 K=3:FOR I=0 TO 9:RESTORE "pl":FOR J=0 TO 1:READ A$:NEXT J
605 RESTORE "pl":FOR J=0 TO 1:READ B$:NEXT J:FOR J=I+1 TO 10:A=ABS(P(1)-P(J)):READ B$
610 IF A<=3 COLOR 1:Q$(K)=A$+B$:K=K+1
615 IF A<=3 LET X=(P(1)+P(J))/2-TR:LINE (50*COS X,50*SIN X)-(40*COS X,40*SIN X=:GOTO 680
620 IF A>=27 AND A<=33 COLOR 1:Q$(K)=A$+B$+"30":GOSUB "Q":K=K+1:GOTO 700
630 IF A>=43 AND A<=47 COLOR 3:Q$(K)=A$+B$+"45":GOSUB "Q":K=K+1:GOTO 700
640 IF A>=54 AND A<=66 COLOR 1:Q$(K)=A$+B$+"60":GOSUB "Q":K=K+1:GOTO 700
650 IF A>=86 AND A<=94 COLOR 3:Q$(K)=A$+B$+"90":GOSUB "Q":K=K+1:GOTO 700
660 IF A>=114 AND A<=126 COLOR 1:Q$(K)=A$+B$+"12":GOSUB "Q":K=K+1:GOTO 700
670 IF A>=133 AND A<=137 COLOR 3:Q$(K)=A$+B$+"13":GOSUB "Q":K=K+1:GOTO 700
680 IF A>=147 AND A<=153 COLOR 1:Q$(K)=A$+B$+"15":GOSUB "Q":K=K+1:GOTO 700
690 IF A>=176 AND A<=184 COLOR 3:Q$(K)=A$+B$+"18":GOSUB "Q":K=K+1
700 NEXT J:NEXT I:KK=KK-1
900 GLCURSOR(0,-107):TEXT:LF 2:CSIZE 1:COLOR 0:RESTORE "pl":USING "##.##":FOR K=0 TO 10:READ B$:J=P(K)
910 P1=PEEK &78BE:P2=PEEK &78BF:A=INT(J/30):GOSUB "Z":C=30:A=J:GOSUB "A":LPRINT B$;" :";DMS A;" ";A$
920 POKE &78BE,P1,P2:NEXT K
925 IF T$="*" GOTO 1000
930 LF 2:FOR K=0 TO 11:J=M(K):A=INT(J/30):GOSUB "Z"
940 C=30:A=J:GOSUB "A":LPRINT STR$(K+1);" :";DMS A;" ";A$:NEXT K
1000 LF 2:FOR I=3 TO KK:A$=LEFT$(Q$(1),7):GOSUB "$":LPRINT A$;" - ";:A$=MID$(Q$(1),8,7):GOSUB "$":LPRINT A$;
1010 A=VAL RIGHT$(Q$(1),2):LCURSOR 19:IF A=0 LPRINT "conjonction":GOTO 1100
1020 IF A=30 LPRINT "demi-sextile":GOTO 1100
1030 IF A=45 LPRINT "demi-carr":GOTO 1100
1040 IF A=60 LPRINT "sextile":GOTO 1100
1050 IF A=90 LPRINT "carr":GOTO 1100
1060 IF A=12 LPRINT "trigone":GOTO 1100
1070 IF A=13 LPRINT "135":GOTO 1100
1080 IF A=15 LPRINT "150":GOTO 1100
1090 IF A=18 LPRINT "opposition"
1100 NEXT I:LF 8
9999 END
10000 "M":GOSUB "M":RESTORE "n":FOR I=1 TO 12:READ A$:IF MS$=LEFT$(A$,LEN MS$):LET MS=I:RETURN
10010 NEXT I:RETURN
10050 "N":DATA "janvier","fvrier","mars","avril","mai","juin","juillet"
10060 DATA "aout","septembre","octobre","novembre","dcembre"
10100 "N":RESTORE "n":FOR I=1 TO MS:READ MS$:NEXT I:RETURN
10500 "m":FOR I=1 TO LEN A$:A=ASC MID$(A$,I,1):IF A<97 OR A>122 NEXT I:RETURN
10510 A$=LEFT$(A$,I-1)+CHR$(A-32)+RIGHT$(A$,LEN A$-1):NEXT I:RETURN
11000 "D":DT=365*AN+31*(MS-1)+JR+DEG HR/24:IF MS<3 LET AN=AN-1:DT=DT+INT(.4*(MS-1)+2.7)
11010 DT=DT+INT(AN/4)-INT(AN/100)+INT(AN/400)-INT(.4*(MS-1)+2.7):IF MS<3 LET AN=AN+1
11020 RETURN
11200 "A":A=A-C*INT(A/C):RETURN
11400 "P":A=INT(J/30):GOSUB "Z":C=30:A=J:GOSUB "A":PRINT DMS A;" du ";A$
11410 J=J-TR:LINE (50*COS J,50*SIN J)-(80*COS J,80*SIN J):LPRINT B$:RETURN
12000 "S":RESTORE "s":FOR I=0 TO SM:READ SM$:NEXT I:RETURN
12100 "s":DATA "samedi","dimanche","lundi","mardi","mercredi","jeudi","vendredi"
12500 "C":RESTORE B$:READ L:READ A:A=L+A*N+DL:GOSUB "A":L=A
12510 READ W:READ A:A=W+A*N:GOSUB "A":W=A
12520 READ E1,AA:E1=E1+DE:EE=E1*180/(pi):AA=AA+DA:U=M
12530 W=W+DW/EE:A=L-W:GOSUB "A":M=A
12540 V=M+EE*SIN U:IF INT(U*1e6)<>INT(V*1e6) LET U=V:GOTO 12540
12550 A=2*ATN(TAN(U/2)*(racin)((1+E1)/(1-E1))):GOSUB "A":V=A
13000 READ O:READ A:A=O+A*N:GOSUB "A":O=A
13010 READ A:A=ASN(A*SIN(V+W-O)):GOSUB "A":B=A
13020 G=ACS(COS(V+W-O)/COS B):A=V+W:GOSUB "A":H=A
13030 FOR I=-3 TO 2:K=(-1)^I*G+O+INT(I/2+1)+1)*360:IF K<H-2 OR K>H+2 NEXT I:BEEP 6:STOP
13040 R=AA*(1-E1*COS U)
13050 Y=R*COS B:X=Y*COS K+XS:Y=Y*SIN K+YS:A=ATN(Y/X)+(X<0)*SGN Y*180:GOSUB "A":J=A
13100 RETURN
13500 "DD":DE=0:DA=0:DL=0:DW=0:RETURN
13600 "CC":RESTORE B$="1":READ A,B:V=A+B*N:READ A,B,D:DL=A*SIN V+B*COS V+D*SIN(2*V)
13610 READ A,B,D:DE=A*SIN V+B*COS V+D*COS(2*V)
13620 READ A,B,D,F:DW=A*SIN V+B*COS V+D*SIN(2*V)+F*COS(2*V)
13630 READ A,B:DA=A*SIN V+B*COS V:RETURN
14000 "SO":DATA 278.774,.03349788,91.117,5362e-8,.055892,9.554747
14110 DATA 112.79,00002391,SIN 2.492519
14115 "UR1":DATA 248.159,233e-6,.864,.082,036,-335e-6,0021,0,.1203,.0194,.006,0,0
14116 DATA -.003824
14120 "UR":DATA 248.487,.01176902,171.563,4064e-8,.046344,19.21814
14130 DATA 73.482,.00001365,SIN .772464
14135 "NE1":DATA 284.159,233e-6,-.5926,-.0561,-.0243,44e-5,426e-6,-6e-3,.024,-.025
14136 DATA .006,-.006,-82e-5,.0082
14140 "NE":DATA 86.652,.00602015,46.742,39e-8,.008997,30.10957
14150 DATA 130.693,.00003009,SIN 1.779242
14160 "PL":DATA 94.00401766,223.33,3823e-8,.250236,39.438712
14170 DATA 109.06,3823e-8,SIN 17.17047
15000 "Q":X=P(1)-TR:Y=P(J)-TR:LINE (50*COS X,50*SIN X)-(50*COS Y,50*SIN Y):RETURN
16000 "$":IF RIGHT$(A$,1)<>" " RETURN
16010 A$=LEFT$(A$,LEN A$-1):GOTO "$"
20000 "Z":RESTORE "z":FOR I=0 TO A:READ A$:NEXT I:RETURN
20050 "z":DATA "blier","taureau","gmeaux","cancer","lion","vierge","balance"
20060 DATA "scorpion","sagittaire","capricorne","verseau","poisson"
30000 "LAT":A$=U$:GOSUB "m":U$=A$:RESTORE "VILLE":FOR I=0 TO 8:READ A$:IF A$=U$ GOTO 30060
30010 NEXT I:INPUT "longitude = ";A$:U=VAL A$:FOR I=1 TO LEN A$:IF VAL RIGHT$(A$,I)=0 NEXT I:GOTO "LAT"
30020 I=I-1:IF RIGHT$(A$,i)=LEFT$("ouest",1)  LET U=-U:GOTO 30030
30025 IF RIGHT$(A$,1)<>LEFT$("est",1) GOTO "LAT"
30030 INPUT "latitude = ";A$:V=VAL A$:FOR I=1 TO LEN A$:IF VAL RIGHT$(A$,1)=0 NEXT I:GOTO 30030
30040 I=I-1:IF RIGHT$(A$,I)=LEFT$("sud",I) LET U=-U:GOTO 30050
30045 IF RIGHT$(A$,I)<>LEFT$("nord",I) GOTO 30030
30050 RETURN
30060 RESTORE "LV":II=1:FOR I=0 TO II:READ U:NEXT I
30070 RESTORE "IV":FOR I=0 TO II:READ V:NEXT I:RETURN
30100 "W":GLCURSOR (80*SIN J,80*COS J):LPRINT A$:RETURN
30120 "TM":J=J-INT(M(0)/30)*30+180:GLCURSOR (50*COS J,50*SIN J):LINE -(110*COS J,110*SIN J):RETURN
30130 "MM":DATA "I","VII","II","VIII","III","IX","X","IV","XI","V","XII","VI"
35000 "VILLE":"DATA "tourcoing","roubaix","valenciennes","cambrai","paris"
35001 DATA "sarlat","bordeaux","alger"
36000 "LV":DATA 3.09,3.1,3.04,3.32,3.14,2.2,1.13,-.34,3.08
37000 "IV":DATA 50.43,50.42,50.38,50.21,50.1,48.52,44.53,44.5,36.42
40000 "KK":P1=PEEK &78BE:P2=PEEK &78BF:J=DEG VAL J$:A=LEN STR$ VAL J$:J$=MID$(J$,A+1,LEN J$-A)
40010 RESTORE "z":FOR K=0 TO 12:READ B$:IF B$<>J$ NEXT K:J$='rien":GOTO 40030
40020 J=J+30*K
40030 POKE &78BE,P1,P2:RETURN
50000 "pl":DATA "soleil","mercure","venus","mars   ","jupiter","saturne","uranus "
50001 DATA "neptune","pluton ","lun   ","fortune"