PureBasic

bjr à tous voilà
j'ai un code astro très vieux exTurbo Basic? converti en QB64
si quelqu'un connais bien et a du temps pour convertir ce code
en PureBasic. merci
Cdt

première partie

Code : Tout sélectionner

THEME:
CLOSE: CLEAR
PI = 3.14159265359#: Z = 57.2957795131#: KEY OFF
'
'                        presentation
'
DIM L(3, 16), L2(3, 16), A$(11), B$(16), A%(1, 100), A1%(100), A2%(100)
CLS: SCREEN 1, 1: COLOR 1, 1: PRINT: PRINT
PRINT TAB(9); "**** THEME ASTRAL ****": PRINT: PRINT
PRINT "   INFORMATIONS POUR ETABLIR UN THEME ": PRINT
PRINT: PRINT TAB(17); "LE JOUR": PRINT: PRINT TAB(17); "LE MOIS": PRINT: PRINT TAB(17); "L'ANNEE": PRINT: PRINT TAB(17); "L'HEURE": PRINT: PRINT TAB(17); "LA LATITUDE": PRINT: PRINT TAB(17); "LA LONGITUDE": FOR I = 0 TO 10: NEXT
A$(0) = "BELIER": A$(1) = "TAUREAU": A$(2) = "GEMEAUX": A$(3) = "CANCER": A$(4) = "LION"
A$(5) = "VIERGE": A$(6) = "BALANCE": A$(7) = "SCORPION": A$(8) = "SAGITTAIRE"
A$(9) = "CAPRICORNE": A$(10) = "VERSEAU": A$(11) = "POISSONS"
B$(0) = "SOLEIL": B$(1) = "LUNE": B$(2) = "MERCURE": B$(3) = "VENUS": B$(4) = "MARS"
B$(5) = "JUPITER": B$(6) = "SATURNE": B$(7) = "URANUS": B$(8) = "NEPTUNE"
B$(9) = "PLUTON": B$(10) = "A S C": B$(11) = "M C"
B$(13) = "MAISON XI": B$(14) = "MAISON XII": B$(15) = "MAISON II": B$(16) = "MAISON III"
'
'                      saisie et recherche par nom
DEBUT:
'#################   Bloc suivant mis en commentaire   ##################### provoque une erreur ??
'IF INDEX = 1 THEN 350                                 'mis en commentaire
'OPEN "I", 1, "A%"                                     'mis en commentaire
'FOR I = 0 TO 1: FOR J = 1 TO 100                      'mis en commentaire
'INPUT #1, A$: A%(I, J) = VAL(A$): A$ = "00"           'mis en commentaire
'    NEXT                                              'mis en commentaire
'NEXT                                                  'mis en commentaire
'CLOSE                                                 'mis en commentaire
'###########################################################################
INDEX = 1                    
350:
SCREEN 0, 1: WIDTH 80: COLOR 11, 1, 9: CLS: GOSUB 24100
364:
LOCATE 4, 8: INPUT NOM$: IF NOM$ = "" THEN 364
365:
LOCATE 4, 50: INPUT PRE$: IF PRE$ = "" THEN 365
I = ASC(NOM$): J = ASC(PRE$)
A = 0: OPEN "R", 1, "NOM", 82: FIELD #1, 15 AS N$, 15 AS PR$, 2 AS J$, 2 AS M$, 4 AS AA$, 8 AS LU$, 7 AS LX$, 8 AS PF$, 7 AS U$, 7 AS U4$, 7 AS HH$
390:
A = A + 1: IF A > 100 THEN CLOSE: GOTO 2330
IF I = A%(0, A) AND J = A%(1, A) THEN 410 ELSE GOTO 390
410:
GET #1, A: IF NOM$ = LEFT$(N$, LEN(NOM$)) AND PRE$ = LEFT$(PR$, LEN(PRE$)) THEN 420 ELSE GOTO 390
420:
COLOR 14: LOCATE 4, 7: PRINT ": "; N$: LOCATE 4, 49: PRINT ": "; PR$: LOCATE 13, 25: PRINT "CE NOM EST IL CELUI RECHERCHE";: Z$ = INPUT$(1): IF Z$ = "O" THEN NOM$ = N$: PRE$ = PR$ ELSE GOTO 390
LOCATE 13, 25: PRINT "                                     "
LOCATE 6, 10: PRINT J$: JJ = VAL(J$): LOCATE 6, 36: PRINT M$: MM = VAL(M$): LOCATE 6, 63: PRINT AA$: LOCATE 8, 11: PRINT HH$: AA = VAL(AA$)
LOCATE 8, 39: PRINT LU$: LU = VAL(LU$): U = VAL(U$): U4 = VAL(U4$): HH = VAL(HH$): LOCATE 8, 66: PRINT LX$: LX = VAL(LX$): PF = VAL(PF$): CLOSE
H = ((HH - INT(HH)) / .6 + INT(HH)) / 24: J = JJ + H: A1 = AA: M = MM:
T = (A1 * 365) + (31 * (M - 1)) + J: IF M <= 2 THEN A1 = A1 - 1
T = T + INT(A1 / 4) - INT(A1 / 100) + INT(A1 / 400): IF M > 2 THEN T = T - INT((M - 1) * .4 + 2.7)
TTT = T - 694325!
O = 4.1867 - 9.2422E-04 * TTT: NELU = 360 * ((O / PI / 2) - INT(O / PI / 2))
LUNO = 3.40339 + 2 * PI * TTT / 3231.5: LUNO = 360 * ((LUNO / PI / 2) - INT(LUNO / PI / 2))
OPEN "R", 1, "L0$", 150: FIELD #1, 150 AS L0$: GET #1, A: L4$ = L0$: CLOSE: L0$ = ""
OPEN "R", 1, "L1$", 150: FIELD #1, 150 AS L0$: GET #1, A: L1$ = L0$: CLOSE: L0$ = ""
OPEN "R", 1, "L2$", 150: FIELD #1, 150 AS L0$: GET #1, A: L2$ = L0$: CLOSE: L0$ = ""
OPEN "R", 1, "L3$", 150: FIELD #1, 150 AS L0$: GET #1, A: L3$ = L0$: CLOSE: L0$ = ""
A = 1: C = 1: E = 1: G = 1: FOR I = 0 TO 16: B = INSTR(A, L4$, " "):
    D = INSTR(C, L1$, " "): F = INSTR(E, L2$, " "): H = INSTR(G, L3$, " ")
    IF A > B THEN B = 150
    IF C > D THEN D = 150
    IF E > F THEN F = 150
    IF G > H THEN H = 150
    A$ = MID$(L4$, A, B - A): L(0, I) = VAL(A$): A$ = MID$(L1$, C, D - C): L(1, I) = VAL(A$):
    A$ = MID$(L2$, E, F - E): L(2, I) = VAL(A$)
    A$ = MID$(L3$, G, H - G): L(3, I) = VAL(A$): SWAP A, B: SWAP C, D:
SWAP E, F: SWAP G, H: A = A + 1: C = C + 1: E = E + 1: G = G + 1: NEXT
GOTO 1500
MEMORISATION:
'                       memorisation
'
GOSUB 24000: LOCATE 12, 32: PRINT "1 ---- SAUVEGARDE": LOCATE 14, 32: PRINT "2 ---- ANNULATION": LOCATE 16, 32: PRINT "LISTE DES CLIENTS"
LOCATE 20, 32: PRINT "ENTREZ VOTRE CHOIX": Z$ = INPUT$(1)
A = VAL(Z$): ON A GOTO SAUVE, ANNUL, CLIENT
CLIENT:
GOSUB 24000: GOTO 1500
SAUVE:
GOSUB 24000
LOCATE 13, 22: PRINT "VOULEZ VOUS SAUVEGARDER CE NOM ? O/N": Z$ = INPUT$(1): IF Z$ <> "O" THEN GOSUB 24000: GOTO 1500
A = 0: OPEN "R", 1, "NOM", 82: FIELD #1, 15 AS N$, 15 AS PR$, 2 AS J$, 2 AS M$, 4 AS AA$, 8 AS LU$, 7 AS LX$, 8 AS PF$, 7 AS U$, 7 AS U4$, 7 AS HH$
I = ASC(NOM$): J = ASC(PRE$): LSET U$ = RIGHT$(STR$(U), LEN(STR$(U)) - 1): LSET HH$ = RIGHT$(STR$(HH), LEN(STR$(HH)) - 1)
LSET N$ = NOM$: LSET PR$ = PRE$: JJ$ = STR$(JJ): JJ$ = RIGHT$(JJ$, LEN(JJ$) - 1): LSET J$ = JJ$: MM$ = STR$(MM): MM$ = RIGHT$(MM$, LEN(MM$) - 1): LSET M$ = MM$: A1$ = STR$(AA): A1$ = RIGHT$(A1$, LEN(A1$) - 1): LSET AA$ = A1$: LSET LU$ = STR$(LU): LSET LX$ = STR$(LX)
A1$ = STR$(PF): A1$ = RIGHT$(A1$, LEN(A1$) - 1): LSET PF$ = A1$: LSET U4$ = RIGHT$(STR$(U4), LEN(STR$(U4)) - 1)
800:
A = A + 1: IF A = 100 THEN LOCATE 15, 15: PRINT "LE FICHIER EST PLEIN LA SAUVEGARDE EST LA DERNIERE"
IF A%(0, A) <> 0 THEN 800 ELSE PUT #1, A
OPEN "O", 2, "A%": A%(0, A) = I: A%(1, A) = J: FOR I = 0 TO 1: FOR J = 1 TO 100: A$ = STR$(A%(I, J)): PRINT #2, A$: A$ = "": NEXT: NEXT: CLOSE
OPEN "R", 1, "L0$", 150: OPEN "R", 3, "L1$", 150: OPEN "R", 2, "L2$", 150: FIELD #1, 150 AS L0$: FIELD #3, 150 AS L1$: FIELD #2, 150 AS L2$
FOR I = 0 TO 2: Z$ = "": FOR J = 0 TO 16: A$ = STR$(L(I, J)): A$ = RIGHT$(A$, LEN(A$) - 1): Z$ = Z$ + A$ + " ": NEXT: IF I = 0 THEN LSET L0$ = Z$
    IF I = 1 THEN LSET L1$ = Z$
    IF I = 2 THEN LSET L2$ = Z$
NEXT
PUT #1, A: PUT #2, A: PUT #3, A: CLOSE
OPEN "R", 1, "L3$", 150: FIELD #1, 150 AS L3$
Z$ = "": FOR J = 0 TO 16: A$ = STR$(L(3, J)): A$ = RIGHT$(A$, LEN(A$) - 1): Z$ = Z$ + A$ + " ": NEXT: LSET L3$ = Z$: PUT #1, A: CLOSE: GOSUB 24000: GOTO 1500
ANNUL:
'                  annulation
'
GOSUB 24000
LOCATE 15, 22: PRINT "VOULEZ VOUS ANNULER CE THEME ? O/N": Z$ = INPUT$(1): IF Z$ = "O" THEN 1050 ELSE GOSUB 24000: GOTO 1500
1050:
I = ASC(NOM$): J = ASC(PRE$)
A = 0: OPEN "R", 1, "NOM", 82: FIELD #1, 15 AS N$, 15 AS PR$, 2 AS J$, 2 AS M$, 4 AS AA$, 8 AS LU$, 7 AS LX$, 8 AS PF$, 7 AS U$, 7 AS U4$, 7 AS HH$
1070:
A = A + 1: IF A > 100 THEN LOCATE 22, 22: PRINT "CE NOM N'EXISTE PAS": GOSUB 25000: CLOSE: GOSUB 24000: GOTO 1500
IF I = A%(0, A) AND J = A%(1, A) THEN GET #1, A: GOTO 1090 ELSE GOTO 1070
1090:
IF NOM$ = LEFT$(N$, LEN(NOM$)) AND PRE$ = LEFT$(PR$, LEN(PRE$)) THEN A%(0, A) = 0: A%(1, A) = 0: CLOSE ELSE GOTO 1070
OPEN "O", 1, "A%": FOR I = 0 TO 1: FOR J = 1 TO 100: A$ = STR$(A%(I, J)): A$ = RIGHT$(A$, LEN(A$) - 1): PRINT #1, A$: A$ = "": NEXT: NEXT: CLOSE #1
1110 GOSUB 24000: GOTO 1500
1500: '                        menu
'
COLOR 14: LOCATE 11, 5: PRINT "1---- ETABLIR UN AUTRE THEME"
LOCATE 13, 5: PRINT "2---- POSITION DES PLANETES": LOCATE 15, 5: PRINT "3---- ASPECTS": LOCATE 17, 5: PRINT "4---- CARTE"
LOCATE 19, 5: PRINT "5---- TRANSITS": LOCATE 11, 45: PRINT "6---- POLES"
LOCATE 13, 45: PRINT "7---- PROGRESSIONS": LOCATE 15, 45: PRINT "8---- SAUVEGARDE THEME"
LOCATE 17, 45: PRINT "9---- ANALYSE CARTE": LOCATE 19, 44: PRINT "10---- ARRET": LOCATE 21, 30: INPUT "ENTREZ VOTRE CHOIX "; Z$: PP = VAL(Z$)
ON PP GOTO 2290, 2060, 2000, 2370, 2530, 2430, 2480, MEMORISATION, 2600, 2700
GOTO 1500
2000:
'                  aspects
GOSUB ASP: GOSUB 24000: GOTO 1500
TASP:
LOCATE 9, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 10, 1: PRINT "º              ³               ³               ³               ³               º"
LOCATE 11, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR I = 12 TO 22: LOCATE I, 1: PRINT "º              ³               ³               ³               ³               º": NEXT
LOCATE 23, 1: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN

ASP:
GOSUB TASP: LOCATE 10, 3: PRINT "CONJONCTION"
COL = 0: LIG = 12
'EN CONJONCTION
BS = 8: BI = 0: GOSUB ASP1
'EN OPPOSITION"
IF LIG <> 12 THEN GOSUB ASP2
LOCATE 10, COL * 16 + 1: PRINT "  OPPOSITION ": EA = 8: AP = 180: GOSUB ASP3
'TRIGONE"
IF LIG <> 12 THEN GOSUB ASP2
LOCATE 10, COL * 16 + 1: PRINT "     TRIGONE ": EA = 6: AP = 120: GOSUB ASP3
'EN CARRE
IF LIG <> 12 THEN GOSUB ASP2
LOCATE 10, COL * 16 + 1: PRINT "     CARRE  ": EA = 6: AP = 90: GOSUB ASP3
'EN SEXTIL"
IF LIG <> 12 THEN GOSUB ASP2
LOCATE 10, COL * 16 + 2: PRINT "   SEXTILE ": EA = 5: AP = 60: GOSUB ASP3
GOSUB 25000: RETURN
ASP3:
BS = AP + EA: BI = ABS(AP - EA)
ASP1:
FOR O = 0 TO 10: FOR K = O + 1 TO 11: DI = Z * ABS(L(0, O) - L(0, K)): IF DI > BS THEN DI = 360 - DI
        IF DI > BS OR DI < BI THEN GOTO ASP4
        A$ = B$(O) + "-" + B$(K): IF COL = 0 THEN I = 2 ELSE I = 1
        LOCATE LIG, COL * 16 + I: PRINT A$
        LIG = LIG + 1: IF LIG > 22 THEN LIG = 12: COL = COL + 1: IF COL = 6 THEN COL = 0: GOSUB 24000: GOSUB TASP
        ASP4:
NEXT: NEXT: RETURN
ASP2:
COL = COL + 1: LIG = 12: IF COL = 5 THEN COL = 0: GOSUB 24000: GOSUB TASP
RETURN
  

'                  position

2060:
GOSUB POSITION: GOTO 1500
POSITION: '                    position des planetes
LOCATE 9, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÑÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÊÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÊÍÍÑÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍ¹º PLANETE ³P³  PAS  ³ POSITION ³   SIGNE   º  PLANETE  ³ POSITION ³   SIGNE    º";
PRINT "ÌÍÍÍÍÍÍÍÍÍØÍØÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍ¹";
FOR I = 1 TO 11: PRINT "º         ³ ³       ³          ³           º           ³          ³            º";: NEXT
PRINT "ÈÍÍÍÍÍÍÍÍÍÏÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍ¼";
FOR P = 0 TO 16
    IF P = 10 THEN LOCATE 12, 46: PRINT B$(P); ELSE IF P < 10 THEN LOCATE 12 + P, 2: PRINT B$(P); ELSE LOCATE (P - 11) + 13, 46: PRINT B$(P);
    G = INT((L(0, P) * Z) / 30): L = (L(0, P) * Z) - G * 30: L3 = INT(L): L4 = INT((L - INT(L)) * 60)
    L3$ = RIGHT$(STR$(L3), LEN(STR$(L3)) - 1): IF LEN(L3$) = 1 THEN L3$ = "0" + L3$
    L4$ = RIGHT$(STR$(L4), LEN(STR$(L4)) - 1): IF LEN(L4$) = 1 THEN L4$ = "0" + L4$
    L5 = INT(60 * (L * 100 - INT(L * 100))): L5$ = RIGHT$(STR$(L5), LEN(STR$(L5)) - 1): IF LEN(L5$) = 1 THEN L5$ = "0" + L5$
    IF P > 9 THEN 2200
    XX = (L(1, P) - L(0, P)) * Z: IF ABS(XX) > 20 AND (L(0, P) * Z) < 20 THEN XX = XX - 360
    IF ABS(XX) > 20 AND (L(0, P) * Z) > 340 THEN XX = XX + 360
    IF XX < 0 THEN LOCATE 12 + P, 12: PRINT "R";: XX = ABS(XX)
    LOCATE 12 + P, 14: PRINT USING "###.##"; ABS(INT(XX) + INT((XX - INT(XX)) * 60) / 100)
    2200:
    IF P < 10 THEN LOCATE 12 + P, 23: PRINT USING "&ø&'&"; L3$; L4$; L5$
    IF P < 10 THEN LOCATE 12 + P, 34: PRINT A$(G): GOTO 2210
    IF P <> 12 AND P > 9 THEN LOCATE (P - 10) + 12, 58: PRINT USING "&ø&'&"; L3$; L4$; L5$: LOCATE (P - 10) + 12, 70: PRINT A$(G) ELSE GOTO 2210
2210 NEXT
LOCATE 19, 46: PRINT "P.FORTUNE";: XX = PF * Z: G = INT(XX / 30): XX = XX - G * 30: L3 = INT(XX): L4 = INT((XX - INT(XX)) * 60)
L3$ = RIGHT$(STR$(L3), LEN(STR$(L3)) - 1): IF LEN(L3$) = 1 THEN L3$ = "0" + L3$
L4$ = RIGHT$(STR$(L4), LEN(STR$(L4)) - 1): IF LEN(L4$) = 1 THEN L4$ = "0" + L4$
L5 = INT(60 * (XX * 100 - INT(XX * 100))): L5$ = RIGHT$(STR$(L5), LEN(STR$(L5)) - 1)
IF LEN(L5$) = 1 THEN L5$ = "0" + L5$
LOCATE 19, 58: PRINT USING "&ø&'&"; L3$; L4$; L5$: LOCATE 19, 70: PRINT A$(G)
LOCATE 20, 46: PRINT "NOEUD.L";: XX = NELU: G = INT(XX / 30): XX = XX - G * 30: L3 = INT(XX): L4 = INT((XX - INT(XX)) * 60)
L3$ = RIGHT$(STR$(L3), LEN(STR$(L3)) - 1): IF LEN(L3$) = 1 THEN L3$ = "0" + L3$
L4$ = RIGHT$(STR$(L4), LEN(STR$(L4)) - 1): IF LEN(L4$) = 1 THEN L4$ = "0" + L4$
L5 = INT(60 * (XX * 100 - INT(XX * 100))): L5$ = RIGHT$(STR$(L5), LEN(STR$(L5)) - 1): IF LEN(L5$) = 1 THEN L5$ = "0" + L5$
LOCATE 20, 58: PRINT USING "&ø&'&"; L3$; L4$; L5$: LOCATE 20, 70: PRINT A$(G)
LOCATE 21, 46: PRINT "LUNE NOIRE";: XX = LUNO: G = INT(XX / 30): XX = XX - G * 30: L3 = INT(XX): L4 = INT((XX - INT(XX)) * 60)
L3$ = RIGHT$(STR$(L3), LEN(STR$(L3)) - 1): IF LEN(L3$) = 1 THEN L3$ = "0" + L3$
L4$ = RIGHT$(STR$(L4), LEN(STR$(L4)) - 1): IF LEN(L4$) = 1 THEN L4$ = "0" + L4$
L5 = INT(60 * (XX * 100 - INT(XX * 100))): L5$ = RIGHT$(STR$(L5), LEN(STR$(L5)) - 1): IF LEN(L5$) = 1 THEN L5$ = "0" + L5$
LOCATE 21, 58: PRINT USING "&ø&'&"; L3$; L4$; L5$: LOCATE 21, 70: PRINT A$(G)
LOCATE 24, 1, 0: GOSUB 25000: GOSUB 24000: RETURN
2290:
'                      nouveau theme
'
CLS: FOR I = 0 TO 3: FOR J = 0 TO 16: L(I, J) = 0: NEXT: NEXT: NOM$ = "": PRE$ = "": GOTO DEBUT
2330:
'
'     calcul du theme puis calcul pour j+1
'
AB = 0: GOSUB CALCUL1: AB = 1: IF JJ = 31 THEN J = 1 ELSE J = JJ + 1: M = MM
IF JJ = 31 THEN M = MM + 1
IF MM = 12 AND JJ = 31 THEN M = 1: A = AA + 1 ELSE A = AA
LA = LU: LO = LX: H = HH: P = 0: IF M <= 2 THEN A = A - 1: M = M + 12
GOSUB CALCUL2: GOSUB POSITION: GOSUB 24000: GOTO 1500
PRECAL:
'  premiere partie du calcul
'
N = M: FOR J = 0 TO 10: N = M + E * SIN(N): NEXT
R = A - A * E * COS(N): L = W + 2 * ATN(SQR((1 + E) / (1 - E)) * TAN(N / 2)): RETURN

'  seconde partie des calcul
SECCAL:
W = L - D: L = ATN(COS(I) * SIN(W) / COS(W)) + D: IF COS(W) < 0 THEN L = L + PI
E = SIN(W) * SIN(I): E = ATN(E / SQR(-E * E + 1))
I = R * COS(E) * COS(L) + X: J = R * COS(E) * SIN(L) + Y: L = ATN(J / I): IF I < 0 THEN L = L + PI
30170 '
TABUSING:
L = (L * Z) / 360: L = 360 * (L - INT(L)): IF AB > 3 THEN RETURN
L(AB, P) = L / Z: P = P + 1
RETURN

CALCUL1:
AB = 0
'
'  entree des coordonnees
'
COLOR 14
JOUR:
LOCATE 6, 10: INPUT J: JJ = J: IF J < 1 OR J > 31 THEN GOTO JOUR ELSE LOCATE 6, 10: PRINT JJ
MOIS:
LOCATE 6, 36: INPUT M: MM = M: IF M < 1 OR M > 12 THEN GOTO MOIS ELSE LOCATE 6, 36: PRINT USING "##"; MM
ANNEE:
LOCATE 6, 63: INPUT A: AA = A: LOCATE 6, 63: PRINT USING "####"; AA
HEURES:
LOCATE 8, 11: INPUT H: HH = H: IF H < 0 OR H > 24 THEN GOTO HEURES ELSE LOCATE 8, 11: PRINT USING "##.##"; HH
LATITUDE:
LOCATE 8, 39: INPUT LA: LU = LA: IF ABS(LA) > 90 THEN GOTO LATITUDE ELSE LOCATE 8, 39: PRINT USING "###.##"; LU
LONGITUDE:
LOCATE 8, 66: INPUT LO: LX = LO: IF ABS(LO) > 360 THEN GOTO LONGITUDE ELSE LOCATE 8, 66: PRINT USING "####.##"; LX
P = 0: H = ((H - INT(H)) / .6 + INT(H)) / 24: LO = LO / Z: LA = LA / Z: J = J + H
IF M <= 2 THEN A = A - 1: M = M + 12
COLOR 14
CALCUL2:
'                       calcul de T
'
T = INT(A * 365.25) + INT(30.6001 * (M + 1)) + J - INT(A / 100) + INT(INT(A / 100) / 4)
T = (T - 694000! - 23.5) / 36525!
IF AB > 0 THEN GOTO SOLEIL ELSE A1 = AA: M = MM
NN = (A1 * 365) + (31 * (M - 1)) + J: IF M <= 2 THEN A1 = A1 - 1
NN = NN + INT(A1 / 4) - INT(A1 / 100) + INT(A1 / 400): IF M > 2 THEN NN = NN - INT((M - 1) * .4 + 2.7)
TTT = NN - 694325!
O = 4.1867 - 9.2422E-04 * TTT: NELU = 360 * ((O / PI / 2) - INT(O / PI / 2))
LUNO = 3.40339 + 2 * PI * TTT / 3231.5: LUNO = 360 * ((LUNO / PI / 2) - INT(LUNO / PI / 2))
SOLEIL:
'                       soleil
'
A = 1.00000101778#: E = .016751 - .000042 * T: M = .000004 + 6.25658 + T * 628.301946#
W = T * .030005 - 1.37496
U = .40932 - T * .000227: B = COS(U): C = SIN(U): GOSUB PRECAL: X = R * COS(L): Y = R * SIN(L)
GOSUB TABUSING: IF AB = 4 THEN RETURN
LUNE:
'                      lune
'
D = 6.12152 + T * 7771 + T * .377194 + .000004: N = 5.168 + T * 8328 + T * .691104
F = .196365 + T * 8433 + T * .46629
L = 4.71996 + .000007 + T * 8399 + T * .709144 + .109759 * SIN(N) + .022236 * SIN(D + D - N) + .01149 * SIN(D + D) + .003728 * SIN(N + N) - .003239 * SIN(M) - .001996 * SIN(F + F)
L = L + .001026 * SIN(D + D - N - N) + 9.990002E-04 * SIN(D + D - M - N) + .000931 * SIN(D + D + N) + .000801 * SIN(D + D - M) + .000716 * SIN(N - M) - .000606 * SIN(D) - .000532 * SIN(M + N) + .000267 * SIN(D + D - F - F) - .000219 * SIN(F + F + N) - .000192 * SIN(F + F - N)
GOSUB TABUSING: IF AB = 5 THEN RETURN
MERCURE:
'                      mercure
'
A = .38709830982#: E = .205614 + T * .000002: I = .122223 + T * .000032: M = 1.78511 + .000002 + T * (2608 + .787533)
W = 1.3247 + T * .027148: D = .822852 + T * .020686: GOSUB PRECAL
GOSUB SECCAL: IF AB = 6 THEN RETURN
VENUS:
'                      venus
'
A = .72332981996#: E = .006821 - T * .000048: I = .05923 + T * .000018
M = 3.71062 + .000006 + T * (1021 + .328349)
W = 2.27178 + .000007 + T * .024575: D = 1.3226 + T * .015705: GOSUB PRECAL: GOSUB SECCAL
IF AB = 7 THEN RETURN
MARS:
'                      mars
'
A = 1.52367934191#: E = .093313 + T * .000092: I = .032294 - T * .000012: M = 5.57666 + .000001 + T * (334 + .053484)
W = .032127 * T - .449977: D = .851484 + T * .013456: GOSUB PRECAL: GOSUB SECCAL: IF AB = 8 THEN RETURN
JUPITER:
'                     jupiter
'
K = 2.34976 + T * .711349: A = 5.20260319132# + .000001 - .000026 * COS(K): E = .048335 + T * .000164 + .000361 * SIN(K) + .000129 * COS(K)
I = .020842 - T * .000099: M = 3.93272 + .000001 + T * (52 + .965368) + .007442 * COS(K) + .003176 * SIN(K)
W = .222022 + T * .028099 - .007386 * COS(K) + .002607 * SIN(K): D = 1.73561 + .000005 + T * .017637
GOSUB PRECAL: GOSUB SECCAL: IF AB = 9 THEN RETURN
SATURNE:
'                      saturne
'
A = 9.55490959574# + .000047 + .000057 * SIN(K) + .000293 * COS(K): E = .055892 - T * .000346 - .000793 * SIN(K) + .001338 * COS(K)
I = .043503 - T * .000068: M = 3.0624 + .000063 + T * (21 + .320095) - .0383 * SIN(K) - .014478 * COS(K)
W = 1.5899 + .000063 + T * .034181 + .024079 * SIN(K) + .014295 * COS(K): D = 1.96856 + T * .01524 + .000004
GOSUB PRECAL
GOSUB SECCAL: IF AB = 10 THEN RETURN
URANUS:
'                       uranus
'
K = 4.95802 + .000008 + T * .148533: A = 19.21844606178# + .00004 - .003824 * COS(K): E = .046344 - T * .000027 - .000335 * SIN(K) + .0021 * COS(K)
I = .013482 + T * .000011: M = 1.26796 + T * (7 + .476626) - .030225 * SIN(K) - .005875 * COS(K)
W = 2.99409 + T * .025908 + .045305 * SIN(K) + .007306 * COS(K)
D = 1.2824 + .000018 + T * .008703: GOSUB PRECAL: GOSUB SECCAL: IF AB = 11 THEN RETURN
NEPTUNE:
'                       neptune
'
A = 30.11038686942# + .00057 + .01058 * COS(K): E = .008997 + T * .000006 + .00044 * SIN(K) + .000426 * COS(K)
I = .031054 - T * .000167: M = .658524 + T * 3.81287 - .056901 * SIN(K) + .047519 * COS(K)
W = .815546 + T * .024863 + .046558 * SIN(K) - .048498 * COS(K): D = 2.28082 + T * .01918
GOSUB PRECAL: GOSUB SECCAL: IF AB = 12 THEN RETURN
PLUTON:
'                       pluton
'
A = 39.438712# + .00071: E = .250236: I = .299681: M = 4.0006 + .000035 + T * (2 + .536813): W = 3.90971: D = 1.91532
GOSUB PRECAL: GOSUB SECCAL: IF AB = 13 THEN RETURN
MC:
'                    milieu du ciel
'
T1 = T - H / 36525!: TS = .27692 + (100 + .002136) * T1 + .000001 * T1 * T1: TS = (TS - INT(TS)) * 2 * PI
TS = TS + (6.30038 + .000008) * H - LO: IF TS > 2 * PI THEN TS = TS - 2 * PI
L(AB, 11) = ATN(SIN(TS) / (COS(TS) * B)): IF (B * COS(TS)) < 0 THEN L(AB, 11) = L(AB, 11) + PI
IF L(AB, 11) < 0 THEN L(AB, 11) = L(AB, 11) + 2 * PI
ASCENDANT:
'                        ascendant
'
A = SIN(U) * TAN(LA) + COS(U) * SIN(TS): L = ATN(-COS(TS) / A) + PI: IF A < 0 THEN L = L + PI
GOSUB TABUSING: IF AB = 0 THEN U4 = TS
IF AB = 0 AND LU <= 65 THEN GOSUB MAISON
31210 PF = L(0, 1) - L(0, 0): IF PF < 0 THEN PF = PF + 2 * PI
31220 PF = PF + L(0, 10): IF PF > 2 * PI THEN PF = PF - 2 * PI: RETURN ELSE RETURN
MAISON:
'           calcul des maisons
'
IF ABS(LU) = 48.84 THEN T3 = 21.65: T4 = 38: T2 = 48.84: GOTO MAIS
IF ABS(LU) = 0 THEN T2 = 0: T3 = 0: T4 = 0: GOTO MAIS
IF ABS(LU) < 44 THEN T5 = INT(ABS(LU) + .5): GOTO MAIS1
IF ABS((LU - INT(LU))) < .25 THEN T5 = INT(ABS(LU)): GOTO MAIS1
IF ABS((LU - INT(LU))) >= .25 AND ABS((LU - INT(LU))) <= .75 THEN T5 = ABS(INT(LU)) + .5 ELSE T5 = ABS(INT(LU)) + 1
MAIS1:
OPEN "R", 2, "DATA", 6: FIELD #2, 3 AS C$, 3 AS D$: GET #2, T5 * 2: A$ = C$: B$ = D$: T3 = VAL(A$): T4 = VAL(B$): CLOSE: T2 = ABS(LU)
MAIS:
T1 = T3 / Z: T6 = TS - PI / 3: J = 13: IF LU >= 0 THEN GOSUB MAI1 ELSE GOSUB MAI2
T1 = T4 / Z: T6 = TS - PI / 6: J = 14: IF LU >= 0 THEN GOSUB MAI1 ELSE GOSUB MAI2
T1 = T4 / Z: T6 = TS + PI / 6: J = 15: IF LU >= 0 THEN GOSUB MAI1 ELSE GOSUB MAI2
T1 = T3 / Z: T6 = TS + PI / 3: J = 16: IF LU >= 0 THEN GOSUB MAI1 ELSE GOSUB MAI2
RETURN
MAI1:
A = SIN(U) * TAN(T1) + COS(U) * SIN(T6): L = ATN(-COS(T6) / A) + PI: IF A < 0 THEN L = L + PI
IF L > 2 * PI THEN L(AB, J) = L - 2 * PI ELSE L(AB, J) = L
RETURN
MAI2:
A = SIN(U) * TAN(-T1) + COS(U) * SIN(T6): L = ATN(-COS(T6) / A) + PI: IF A < 0 THEN L = L + PI
IF L > 2 * PI THEN L(AB, J) = L - 2 * PI ELSE L(AB, J) = L
RETURN
2350 GOTO 1500
2360 '
2370 '                       graphisme
2380 '
2390
2400 COLOR 14, 9: CLS: GOSUB GRAPH: GOSUB RETOUR
2410 GOTO 1500
GRAPH:
'             graphisme
'
SCREEN 2:
CIRCLE (320, 100), 130, 3: CIRCLE (320, 100), 92, 3
FOR R = 0 TO 330 STEP 30
A = R * PI / 180: I = 65: J = 46: GOSUB G720: NEXT
P = 1: FOR R = 15 TO 345 STEP 30: A = R * PI / 180:: E = INT(R / 30) * 4: PRESET (1, 1)
    X = 315 + 2 * 55 * COS(A): Y = 95 - .85 * 55 * SIN(A)
    ON P GOSUB G090, G110, G120, G130, G140, G150, G160, G170, G180, G190, G200, G220
P = P + 1: NEXT: GOTO G230
G090:
PRESET (1, 1): GET (1, 1)-(25, 25), A2%()
CIRCLE (1, 16), 10, 3, 0, 1.57: CIRCLE (19, 16), 10, 3, 1.57, 3.145: PSET (10, 17)
GET (0, 0)-(20, 20), A1%(): PUT (X - 5, Y - 10), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G110:
CIRCLE (10, 10), 8, 3: LINE (10, 6)-(15, 4): LINE (10, 6)-(5, 4): GET (0, 0)-(20, 20), A1%()
PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G120:
CIRCLE (10, 11), 9, 3, .6919, 2.3902: CIRCLE (10, 1), 9, 3, 3.9627, 5.4723
GET (0, 0)-(20, 20), A1%(): PUT (X - 4, Y), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G130:
CIRCLE (4, 14), 4, 3: CIRCLE (16, 17), 4, 3: LINE (4, 12)-(19, 12): LINE (17, 19)-(2, 19)
GET (0, 0)-(20, 20), A1%(): PUT (X - 5, Y - 11), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G140:
CIRCLE (2, 14), 2, 3: CIRCLE (18, 14), 2, 3, 3.145: CIRCLE (10, 10), 6, 3, 0, 3.145
LINE (4, 14)-(4, 10): LINE (16, 14)-(16, 10): GET (0, 0)-(20, 20), A1%()
PUT (X - 5, Y - 8), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G150:
CIRCLE (4, 7), 3, 3, 0, 3.141: CIRCLE (11, 7), 3, 3, 0, 3.141: CIRCLE (17, 12), 3, 3, 3.145
LINE (1, 7)-(1, 14): LINE (8, 6)-(8, 14): LINE (14, 6)-(14, 12): LINE (19, 10)-(14, 16)
GET (0, 0)-(20, 20), A1%(): PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G160:
LINE (1, 9)-(19, 9): CIRCLE (10, 11), 3, 3, 3.145: LINE (1, 11)-(7, 11)
LINE (13, 11)-(19, 11): GET (0, 0)-(20, 20), A1%()
PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G170:
CIRCLE (4, 7), 3, 3, 0, 3.145: CIRCLE (11, 7), 3, 3, 0, 3.145: CIRCLE (17, 12), 3, 3, 3.145
LINE (1, 7)-(1, 14): LINE (8, 6)-(8, 14): LINE (14, 6)-(14, 12)
GET (0, 0)-(20, 20), A1%(): PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G180:
CIRCLE (10, 10), 2, 3: LINE (0, 10)-(20, 10): PSET (18, 9): PSET (18, 11)
GET (0, 0)-(20, 20), A1%(): PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G190:
LINE (1, 8)-(1, 14): CIRCLE (11, 5), 10, 3, 3.5, 5: CIRCLE (14, 7), 4, 3
LINE (10, 10)-(15, 14): GET (0, 0)-(20, 20), A1%()
PUT (X - 5, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G200:
LINE (0, 9)-(4, 5): LINE (4, 5)-(8, 9): LINE (8, 9)-(12, 5): LINE (12, 5)-(16, 9)
LINE (16, 9)-(20, 5): LINE (0, 12)-(4, 8): LINE (4, 8)-(8, 12)
LINE (8, 12)-(12, 8): LINE (12, 8)-(16, 12)
LINE (16, 12)-(20, 8): GET (0, 0)-(20, 20), A1%(): PUT (X - 4, Y - 4), A1%(), OR
PUT (0, 0), A2%(), AND: RETURN
G220:
CIRCLE (10, 14), 9, 3, .6919, 2.3902: CIRCLE (10, 5), 9, 3, 3.9627, 5.4723
CIRCLE (16, 7), 2, 3: CIRCLE (16, 12), 2, 3: GET (0, 0)-(20, 20), A1%()
PUT (X - 4, Y - 5), A1%(), OR: PUT (0, 0), A2%(), AND: RETURN
G230:
'                 MAISON
I = 65: J = 80
A = L(0, 13): GOSUB G680: LOCATE 1, 1, 0: PRINT "XI": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
A = L(0, 13) + PI: GOSUB G680: LOCATE 1, 1, 0: PRINT "V": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
A = L(0, 14): GOSUB G680: LOCATE 1, 1, 0: PRINT "XII": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(25, 10), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
A = L(0, 14) + PI: GOSUB G680: LOCATE 1, 1: PRINT "VI": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
A = L(0, 15): GOSUB G680: LOCATE 1, 1, 0: PRINT "II": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND: GET (0, 0)-(32, 8), A2%()
A = L(0, 15) + PI: GOSUB G680: LOCATE 1, 1, 0: PRINT "VIII": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(32, 8), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND: GET (0, 0)-(20, 20), A2%()
A = L(0, 16): GOSUB G680: LOCATE 1, 1, 0: PRINT "III": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(25, 10), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
A = L(0, 16) + PI: GOSUB G680: LOCATE 1, 1, 0: PRINT "IX": PRINT: PRINT: PRINT: PRINT: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
'                  MC
A = L(0, 11) + PI: I = 65: J = 90: GOSUB G680
A = L(0, 11): GOSUB G680: GET (0, 0)-(20, 20), A2%(): LOCATE 1, 1: PRINT "MC": GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  AS
A = L(0, 10) + PI: GOSUB G680: A = L(0, 10): GOSUB G680: LOCATE 1, 1, 0: PRINT "AS": GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  SOL
A = L(0, 0): GOSUB G680: CIRCLE (10, 10), 10, 3: PSET (10, 10): GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
'                  LUN
A = L(0, 1): GOSUB G680: CIRCLE (10, 10), 10, 3, 1.5725, 4.7175: LINE (10, 6)-(10, 14): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  MER
A = L(0, 2): GOSUB G680: CIRCLE (10, 10), 8, 3: LINE (10, 13)-(10, 18): LINE (7, 16)-(13, 16): LINE (0, 3)-(10, 6): LINE (20, 3)-(10, 6): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  VEN
A = L(0, 3): GOSUB G680: CIRCLE (10, 10), 8, 3: LINE (10, 13)-(10, 18): LINE (7, 16)-(13, 16): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  MAR
A = L(0, 4): GOSUB G680: CIRCLE (10, 10), 8, 3: LINE (10, 6)-(20, 3): PSET (19, 3): PSET (19, 4): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  JUP
A = L(0, 5): GOSUB G680: LINE (2, 10)-(18, 10): LINE (2, 10)-(5, 3): LINE (5, 18)-(18, 3): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  SAT
A = L(0, 6): GOSUB G680: CIRCLE (6, 10), 5, 3, 0, 3.145: CIRCLE (14, 11), 4, 3, 3.145: LINE (0, 14)-(3, 5): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  URA
A = L(0, 7): GOSUB G680: LINE (2, 8)-(18, 8): LINE (2, 3)-(2, 11): LINE (10, 3)-(10, 11): LINE (18, 3)-(18, 11): CIRCLE (10, 15), 7, 3: GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  NEP
A = L(0, 8): GOSUB G680: CIRCLE (10, 8), 8, 3, 3.145: LINE (10, 5)-(10, 17): LINE (7, 15)-(13, 15): LINE (6, 5)-(2, 9): LINE (14, 5)-(18, 9): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  PLU
A = L(0, 9): GOSUB G680: LINE (2, 15)-(18, 15): LINE (2, 5)-(2, 15): LINE (2, 5)-(16, 5): LINE (16, 5)-(16, 10): LINE (16, 10)-(2, 10): GET (0, 0)-(20, 20), A1%(): PUT (XX - 10, YY - 10), A1%(), OR: PUT (0, 0), A2%(), AND
'                  PF
I = 65: J = 80
A = PF: GOSUB G680: CIRCLE (10, 10), 8, 3: LINE (5, 10)-(15, 10): LINE (10, 7)-(10, 13): GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
'                  LUNE NOIRE
A = LUNO / Z: GOSUB G680: CIRCLE (10, 10), 8, 3, 1.5725, 4.7175: LINE (10, 7)-(10, 13): PAINT (8, 10), 3: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 5), A1%(), OR: PUT (0, 0), A2%(), AND
'                NOEUD LUNAIRE
A = NELU / Z: GOSUB G680
CIRCLE (2, 10), 2, 3: CIRCLE (18, 10), 2, 3: CIRCLE (10, 10), 6, 3, 3.145, 6.28: GET (0, 0)-(20, 20), A1%(): PUT (XX - 5, YY - 8), A1%(), OR: PUT (0, 0), A2%(), AND
'                   aspects
EA = 6: AP = 120: GOSUB G730: EA = 5: AP = 60: GOSUB G730: EA = 7: AP = 180: GOSUB G730: EA = 6: AP = 90: GOSUB G730: Z$ = INPUT$(1): SCREEN 0: RETURN
G680:
'                affichage des traits
'
X = 320 + 2 * (I * COS(A)): Y = 100 - .85 * I * SIN(A): XX = 320 + 2 * (J * COS(A))
YY = 100 - .85 * J * SIN(A): X1 = 320 + 2 * ((J - 10) * COS(A)): Y1 = 100 - .85 * (J - 10) * SIN(A)
LINE (X, Y)-(X1, Y1): RETURN
G720:
X = 320 + 2 * (I * COS(A)): Y = 100 - .85 * I * SIN(A): XX = 320 + 2 * (J * COS(A))
YY = 100 - .8 * J * SIN(A): LINE (X, Y)-(XX, YY): RETURN
G730:
'            affichage des aspects
'
BS = AP + EA: BI = ABS(AP - EA): FOR O = 0 TO 11: FOR K = O + 1 TO 11: DI = Z * ABS(L(0, O) - L(0, K))
        IF DI > BS THEN DI = 360 - DI
        IF DI > BS OR DI < BI THEN GOTO G800
        X = 320 + 90 * COS(L(0, O)): Y = 100 - .85 * 45 * SIN(L(0, O)): XX = 320 + 90 * COS(L(0, K))
        YY = 100 - .85 * 45 * SIN(L(0, K)): LINE (X, Y)-(XX, YY)
        G800:
NEXT: NEXT: RETURN

deuxième partie

Code : Tout sélectionner

2420 '
2430 '                       directions
2450 GOSUB 24000: GOSUB DIRECTION
2460 GOTO 1500
DIRECTION:
DIM T1(60), T2(60), T3(60), T$(60)
'
'                 calcul des poles
'
DIRDEB:

IF ABS(LU) > 65 THEN COLOR 4: LOCATE 13, 31: PRINT "CALCUL IMPOSSIBLE ": GOSUB DIRMESS: COLOR 7: LOCATE 13, 31: PRINT "                        ": RETURN
DIRMENU:
LOCATE 10, 26: PRINT "CALCUL DES DIRECTIONS PRIMAIRES": LOCATE 12, 24
PRINT "1 ---- CALCUL DES POLES ": LOCATE 14, 24: PRINT "2 ---- CALCUL DES DIRECTIONS"
LOCATE 16, 24: PRINT "3 ---- LECTURE DES DIRECTIONS": LOCATE 18, 24
PRINT "4 ---- MENU": Z$ = INPUT$(1): PP = VAL(Z$): ON PP GOTO POLES, DIREC, DIRVISU, DIRARRET
GOTO DIRMENU
DIRARRET:
GOSUB 24000: ERASE T1, T2, T3, T$: RETURN
  
POLES:
IF L(3, 10) <> 0 THEN GOTO DIRMENU
GOSUB DIRT1: LOCATE 10, 24: PRINT "      TABLE DU TEMPS SIDERAL          "
T1 = T3 / Z: U0 = 0: T2 = T4 / Z: T3 = PI - T2: T4 = PI - T1
T7 = U4 * 24 / (2 * PI): T6 = INT(T7) + (INT((T7 - INT(T7)) * 60) / 100)
LOCATE 14, 3: PRINT B$(10): LOCATE 14, 17: PRINT USING "##.##"; LU:
LOCATE 14, 30: PRINT USING "##.##"; T6
LOCATE 15, 3: PRINT B$(11): LOCATE 15, 17: PRINT USING "##.##"; 0: LOCATE 15, 30
IF T6 - 6 < 0 THEN PRINT USING "##.##"; T6 - 6 + 24 ELSE PRINT USING "##.##"; T6 - 6
L(3, 11) = 0: L(3, 10) = LU: FOR I = 0 TO 9
    IF I < 4 THEN LOCATE I + 16, 3: PRINT B$(I) ELSE LOCATE I + 10, 42: PRINT B$(I)
    T7 = L(0, I)
    IF T7 < L(0, 11) OR T7 > L(0, 11) + PI THEN T7 = T7 + PI
    IF L(0, 11) + PI < 2 * PI THEN GOTO DIR1
    IF L(0, 11) + PI > 2 * PI AND T7 > (L(0, 11) + PI) - 2 * PI AND T7 < L(0, 11) THEN T7 = T7 + PI
    DIR1:
    IF T7 < 0 THEN T7 = T7 + 2 * PI
    IF T7 > 2 * PI THEN T7 = T7 - 2 * PI
    IF T7 >= L(0, 11) AND T7 < L(0, 13) THEN GOTO D320
    IF L(0, 11) > L(0, 13) AND T7 > L(0, 11) THEN GOTO D320
    IF L(0, 11) > L(0, 13) AND T7 < L(0, 13) THEN GOTO D320 ELSE GOTO D330
    D320:
    E = 13: W = 11: D = T7 - L(0, 11): T0 = T1: GOTO D550
    D330:
    IF T7 >= L(0, 13) AND T7 < L(0, 14) THEN GOTO D360
    IF L(0, 13) > L(0, 14) AND T7 > L(0, 13) THEN GOTO D360
    IF L(0, 13) > L(0, 14) AND T7 < L(0, 14) THEN GOTO D360 ELSE GOTO D370
    D360:
    E = 14: W = 13: D = T7 - L(0, 13): T0 = T2 - T1: GOTO D550
    D370:
    IF T7 >= L(0, 14) AND T7 < L(0, 10) THEN GOTO D400
    IF L(0, 14) > L(0, 10) AND T7 > L(0, 14) THEN GOTO D400
    IF L(0, 14) > L(0, 10) AND T7 < L(0, 10) THEN GOTO D400 ELSE GOTO D410
    D400:
    E = 10: W = 14: D = T7 - L(0, 14): T0 = ABS(LU) / Z - T2: GOTO D550
    D410:
    IF T7 >= L(0, 10) AND T7 < L(0, 15) THEN GOTO D440
    IF L(0, 10) > L(0, 15) AND T7 > L(0, 10) THEN GOTO D440
    IF L(0, 10) > L(0, 15) AND T7 < L(0, 15) THEN GOTO D440 ELSE GOTO D450
    D440:
    E = 15: W = 10: D = T7 - L(0, 10): T0 = ABS(LU) / Z - T2: GOTO D550
    D450:
    IF T7 >= L(0, 15) AND T7 < L(0, 16) THEN GOTO D480
    IF L(0, 15) > L(0, 16) AND T7 > L(0, 15) THEN GOTO D480
    IF L(0, 15) > L(0, 16) AND T7 < L(0, 16) THEN GOTO D480 ELSE GOTO D490
    D480:
    E = 16: W = 15: D = T7 - L(0, 15): T0 = T2 - T1: GOTO D550
    D490:
    T9 = L(0, 11) + PI: IF T9 > 2 * PI THEN T9 = T9 - 2 * PI
    L(0, 12) = T9
    IF T7 >= L(0, 16) AND T7 < T9 THEN GOTO D540
    IF L(0, 16) > L(0, 12) AND T7 > L(0, 16) THEN GOTO D540
    IF L(0, 16) > L(0, 12) AND T7 < T9 THEN GOTO D540 ELSE PRINT "PROBLEME": GOSUB DIRMESS: END
    D540:
    E = 12: W = 16: D = T7 - L(0, 16): T0 = T1
    D550:
    IF D < 0 THEN D = D + 2 * PI
    Y = L(0, E) - L(0, W): IF Y < 0 THEN Y = Y + 2 * PI
    IF L(0, E) < L(0, W) THEN Y = L(0, E) + 2 * PI - L(0, W)
    A = T0 * D / Y: IF W = 11 THEN A = A: U5 = U4 - PI / 2: IF U5 < 0 THEN U5 = U5 + 2 * PI
    IF W = 13 THEN A = A + T1: U5 = U4 - PI / 3: IF U5 < 0 THEN U5 = U5 + 2 * PI
    IF W = 14 THEN A = A + T2: U5 = U4 - PI / 6: IF U5 < 0 THEN U5 = U5 + 2 * PI
    IF W = 10 THEN A = ABS(LU) / Z - A: U5 = U4
    IF W = 15 THEN A = T2 - A: U5 = U4 + PI / 6: IF U5 > 2 * PI THEN U5 = U5 - 2 * PI
    IF W = 16 THEN A = T1 - A: U5 = U4 + PI / 3: IF U5 > 2 * PI THEN U5 = U5 - 2 * PI
    IF LU > 0 THEN L(3, I) = A ELSE L(3, I) = -A
    IF I < 4 THEN LOCATE I + 16, 17 ELSE LOCATE I + 10, 56
    A = A * Z: A = INT(A) + INT((A - INT(A)) * 60) / 100
    IF LU > 0 THEN PRINT USING "##.##"; A ELSE PRINT USING "##.##"; -A
    IF D <= Y / 2 THEN GOTO D662 ELSE GOTO D664
    D662:
    IF D <= Y / 4 THEN GOTO D800 ELSE U5 = U5 + PI / 12: GOTO D700
    D664:
    IF D > Y / 2 AND D < (Y / 4) * 3 THEN U5 = U5 + PI / 12: GOTO D800 ELSE U5 = U5 + PI / 6: GOTO D700
    '
    '              calcul du TS
    '
    D700:
    ' calcul TS par decomptage
    '
    IF U5 > 2 * PI THEN U5 = U5 - 2 * PI
    D730:
    A = SIN(U) * TAN(L(3, I)) + COS(U) * SIN(U5): L = ATN(-COS(U5) / A) + PI
    IF A < 0 THEN L = L + PI: L = (L * Z) / 360: L = 360 * (L - INT(L)): L = L / Z
    IF INT(T7 * 1000) - INT(L * 1000) > 1 THEN U5 = U5 - 4.77465E-03
    U5 = U5 - 1.59155E-03: IF U5 < 0 THEN U5 = U5 + 2 * PI
    IF INT(L * 1000) < INT(T7 * 1000) THEN GOTO D780 ELSE GOTO D730
    D780:
    U6 = U5 * 24 / (2 * PI): U6 = INT(U6) + INT((U6 - INT(U6)) * 60) / 100: GOTO D880
    '
    D800: '        calcul TS par comptage
    '
    IF U5 > 2 * PI THEN U5 = U5 - 2 * PI
    D820:
    A = SIN(U) * TAN(L(3, I)) + COS(U) * SIN(U5): L = ATN(-COS(U5) / A) + PI
    IF A < 0 THEN L = L + PI: L = (L * Z) / 360: L = 360 * (L - INT(L)): L = L / Z
    IF INT(T7 * 1000) - INT(L * 1000) > 1 THEN U5 = U5 + 4.77465E-03
    U5 = U5 + 1.59155E-03: IF U5 > 2 * PI THEN U5 = U5 - 2 * PI
    IF INT(L * 1000) > INT(T7 * 1000) THEN GOTO D870 ELSE GOTO D820
    D870:
    U6 = U5 * 24 / (2 * PI): U6 = INT(U6) + INT((U6 - INT(U6)) * 60) / 100
    D880:
    IF I < 4 THEN LOCATE I + 16, 30 ELSE LOCATE I + 10, 70
    PRINT USING "##.##"; U6
    IF I < 5 THEN L(3, I + 12) = U5 ELSE L(2, I + 7) = U5
NEXT: GOSUB DIRMESS: GOTO DIRMENU

DIREC: '       nouv periode directions
'
FOR I = 0 TO 60: T1(I) = 0: T2(I) = 0: T3(I) = 0: T$(I) = ""
NEXT: U0 = 0
'
'        directions primaires
'
IF L(3, 10) = 0 THEN GOTO POLES
LOCATE 10, 2: PRINT "DIRECTIONS A DATER DU :                                               ":
GOSUB DIRT2: LIG = 12: COL = 0
LOCATE 10, 40: INPUT "MOIS"; M: LOCATE 10, 25: PRINT USING "##"; M;: PRINT "/":
LOCATE 10, 40: PRINT SPC(15);
LOCATE 10, 40: INPUT "ANNEE"; A: LOCATE 10, 28: PRINT USING "####"; A
LOCATE 10, 40: PRINT SPC(15);
LOCATE 10, 40: INPUT "DUREE "; D: LOCATE 10, 33: PRINT "D"; D
LOCATE 10, 40: PRINT SPC(15);
IF D > 5 THEN LOCATE 14, 15: PRINT " ATTENTION LE CALCUL EST LONG": Z$ = INPUT$(1): GOSUB DIRT2
L = (A + (M / 12)) - (AA + (MM - 1) / 12 + JJ / 365.25): L = ((L * 4) / 60) * 2 * PI / 24
FOR O = 0 TO D * 12: M = M + 1
    IF M > 12 THEN M = 1: A = A + 1
    IF O = 0 THEN GOTO D1090
    L = L + ((((4 / 12) / 60) * 2 * PI / 24))
    D1090:
    FOR I = 0 TO 11
        IF I = 10 THEN T1 = U4 + L: T2 = L(3, I) / Z: W = 3: GOTO D1150
        IF I = 11 THEN T1 = U4 - PI / 2: IF T1 < 0 THEN T1 = T1 + 2 * PI
        IF I = 11 THEN GOTO D1140
        IF I < 5 THEN T1 = L(3, I + 12) ELSE T1 = L(2, I + 7)
        D1140:
        T1 = T1 + L: T2 = L(3, I): W = 3
        D1150:
        GOSUB D1670
        T1 = T1 + (((4 / 12) / 60) * 2 * PI / 24): W = 4: GOSUB D1670
        T5 = ABS(T3 - T4): IF T5 > 3 / 2 * PI THEN T5 = ABS(T5 - 2 * PI)
        T5 = T5 / 2: IF T4 < T3 THEN T6 = T4 + T5 ELSE T6 = T3 + T5
        U5 = L(0, I): U6 = L(0, 11): U7 = L(0, 11) + PI: IF U7 > 2 * PI THEN U7 = U7 - 2 * PI
        IF U6 < U7 THEN IF U5 < U6 OR U5 > U7 THEN T6 = T6 + PI: GOTO D1220
        IF U5 > U7 AND U5 < U6 THEN T6 = T6 + PI
        D1220:
        IF T6 > 2 * PI THEN T6 = T6 - 2 * PI
        T5 = T5 * Z: LOCATE 10, 38: PRINT USING "##"; M;: PRINT "/";: PRINT USING "##"; (A - INT(A / 100) * 100)
        LOCATE 10, 45: PRINT SPC(10);: LOCATE 10, 45: PRINT B$(I): LOCATE 10, 65: PRINT SPC(10);
        T9 = T6 * Z: G = INT(T9 / 30): T9 = T9 - G * 30: T9 = INT(T9) + INT((T9 - INT(T9)) * 60) / 100

        LOCATE 10, 55: PRINT USING "##.##"; T9;: LOCATE 10, 65: PRINT A$(G): LOCATE 10, 75
        IF T5 < .01 THEN PRINT USING "##.##"; .01 ELSE PRINT USING "##.##"; INT(T5 * 200) / 100
        AP = 0: BI = 0: BS = T5: GOSUB D1550: AP = 180: GOSUB D1540: AP = 120: GOSUB D1540
AP = 90: GOSUB D1540: AP = 60: GOSUB D1540: NEXT: NEXT: GOSUB DIRMESS: GOTO DIRMENU
31280: '
DIRVISU:
'    lecture des directions
'
GOSUB DIRT1: LOCATE 10, 24: PRINT "      TABLE DU TEMPS SIDERAL          "
LOCATE 14, 3: PRINT B$(10): LOCATE 14, 17: PRINT USING "##.##"; L(3, 10);: U5 = U4 * 24 / (2 * PI)
U5 = INT(U5) + INT((U5 - INT(U5)) * 60) / 100: LOCATE 14, 31: PRINT USING "##.##"; U5
LOCATE 15, 3: PRINT B$(11): LOCATE 15, 17: PRINT USING "##.##"; 0: U5 = U5 - 6:
IF U5 < 0 THEN U5 = U5 + 24
LOCATE 15, 31: PRINT USING "##.##"; U5
FOR I = 0 TO 9: IF I < 4 THEN LIG = I + 16: COL = 0 ELSE LIG = I + 10: COL = 39
    LOCATE LIG, COL + 3: PRINT B$(I): U5 = L(3, I) * Z: U5 = INT(U5) + INT((U5 - INT(U5)) * 60) / 100: LOCATE LIG, COL + 17: PRINT USING "##.##"; U5
    IF I < 5 THEN U5 = L(3, I + 12) ELSE U5 = L(2, I + 7)
U5 = U5 * 24 / (2 * PI): U5 = INT(U5) + INT((U5 - INT(U5)) * 60) / 100: LOCATE LIG, COL + 31: PRINT USING "##.##"; U5: NEXT: GOSUB DIRMESS
'
'       lecture fichier
'
LIG = 12: COL = 0: GOSUB DIRT2: LOCATE 10, 35: PRINT " DIRECTIONS"
FOR I = 0 TO 60
    IF T$(I) = "" THEN GOTO D1530
    LOCATE LIG, COL * 39 + 3
    IF T3(I) = 0 THEN PRINT "CO"
    IF T3(I) = 60 THEN PRINT "SE"
    IF T3(I) = 90 THEN PRINT "CA"
    IF T3(I) = 120 THEN PRINT "TR"
    IF T3(I) = 180 THEN PRINT "OP"
    LOCATE LIG, COL * 39 + 28: PRINT T$(I): LOCATE LIG, COL * 39 + 16: PRINT "-": LOCATE LIG, COL * 39 + 7: PRINT B$(T1(I))
    LOCATE LIG, COL * 39 + 19: PRINT B$(T2(I))
    LIG = LIG + 1: IF LIG > 22 THEN LIG = 12: COL = COL + 1
    IF COL = 2 THEN GOSUB 25000: GOSUB DIRT2: COL = 0
    D1530:
NEXT: GOSUB DIRMESS: GOTO DIRMENU
D1540:
BS = AP + T5: BI = ABS(AP - T5)
D1550:
FOR K = 0 TO 11
    DI = Z * ABS(T6 - L(0, K))
    IF DI > BS THEN DI = 360 - DI
    IF DI > BS OR DI < BI THEN GOTO D1660
    IF AP = 0 THEN LOCATE LIG, COL * 39 + 3: PRINT "CO"
    IF AP = 180 THEN LOCATE LIG, COL * 39 + 3: PRINT "OP"
    IF AP = 120 THEN LOCATE LIG, COL * 39 + 3: PRINT "TR"
    IF AP = 90 THEN LOCATE LIG, COL * 39 + 3: PRINT "CA"
    IF AP = 60 THEN LOCATE LIG, COL * 39 + 3: PRINT "SE"
    LOCATE LIG, COL * 39 + 7: PRINT B$(I)
    LOCATE LIG, COL * 39 + 16: PRINT "-"
    LOCATE LIG, COL * 39 + 19: PRINT B$(K)
    T1(U0) = I: T2(U0) = K: T3(U0) = AP: LOCATE LIG, COL * 39 + 28: T$(U0) = STR$(M) + " /" + STR$(A): PRINT T$(U0): U0 = U0 + 1: ' BEEP
    LIG = LIG + 1: IF LIG > 22 THEN LIG = 12: COL = COL + 1
    IF COL = 2 THEN GOSUB 25000: GOSUB DIRT2: COL = 0
    D1660:
NEXT: RETURN
D1670:
T7 = SIN(U) * TAN(T2) + COS(U) * SIN(T1)
T8 = ATN(-COS(T1) / T7) + PI
IF T7 < 0 THEN T8 = T8 + PI
T8 = (T8 * Z) / 360: T8 = 360 * (T8 - INT(T8)): T8 = T8 / Z
IF W = 3 THEN T3 = T8 ELSE T4 = T8
RETURN
DIRT1:
LOCATE 11, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 12, 1: PRINT "º  PLANETE   ³   POLES    ³    T.S     º  PLANETE   ³    POLES   ³     T.S     º"
LOCATE 13, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR I = 14 TO 22: LOCATE I, 1: PRINT "º            ³            ³            º            ³            ³             º": NEXT
LOCATE 23, 1, 0: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN
DIRT2:
LOCATE 11, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR I = 12 TO 22: LOCATE I, 1: PRINT "º                                      º                                       º": NEXT
LOCATE 23, 1, 0: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN
DIRMESS:
'                   MESSAGE
'
COLOR 14
LOCATE 24, 25: PRINT "Faites ENTREE pour continuer...";
COLOR 14: Z$ = INPUT$(1): GOSUB 24000
LOCATE 24, 25: PRINT "                               ";: RETURN



2470 '
2480 '                   progressions
2490 '
2520 GOSUB 24000: GOSUB PROG: GOTO 1500

PROG:
'                      PROGRESSIONS

PROMENU:
LOCATE 10, 34: PRINT "PROGRESSIONS"
LOCATE 11, 10: PRINT "1 ----- SOLEIL": LOCATE 13, 10: PRINT "2 ----- LUNE"
LOCATE 15, 10: PRINT "3 ----- MERCURE": LOCATE 17, 10: PRINT "4 ----- VENUS"
LOCATE 19, 10: PRINT "5 ----- MARS": LOCATE 11, 50: PRINT "6 ----- JUPITER"
LOCATE 13, 50: PRINT "7 ----- SATURNE"
LOCATE 15, 50: PRINT "8 ----- URANUS": LOCATE 17, 50: PRINT "9 ----- NEPTUNE"
LOCATE 19, 49: PRINT "10  ----- PLUTON": LOCATE 21, 10: PRINT "11 ----- MENU";
DO
    LOCATE 21, 50: INPUT "CHOIX"; Z$: AB = VAL(Z$)
LOOP UNTIL AB > 0 AND AB < 12
IF AB = 11 THEN GOSUB 24000: RETURN ELSE AB = AB + 3: GOSUB T34000
LOCATE 10, 2: PRINT "PROGRESSIONS "; B$(AB - 4); "                                     ": COL = 0: LIG = 12
DO
    LOCATE 10, 40: INPUT "MOIS"; M: LOCATE 10, 25: PRINT USING "##"; M;: PRINT "/"
LOOP UNTIL M < 13
LOCATE 10, 40: PRINT SPC(15);
LOCATE 10, 40: INPUT "ANNEE"; A: T9 = A: LOCATE 10, 28: PRINT USING "####"; A
LOCATE 10, 40: PRINT SPC(15);
LOCATE 10, 40: INPUT "DUREE "; D: LOCATE 10, 33: PRINT "D "; USING "##"; D
LOCATE 10, 40: PRINT SPC(15);
J = A - AA: J = J + JJ: H = (M - MM) * 2 + JJ * .04: H = H + HH: IF H > 24 THEN H = H - 24: J = J + 1
IF H < 0 THEN H = H + 24: J = J - 1
U6 = M + .5
M = MM: IF J > 31 AND M = 1 THEN J = J - 31: M = M + 1
IF J > 28 AND M = 2 AND ((1984 - AA) / 4) <> INT((1984 - AA) / 4) THEN J = J - 28: M = M + 1
IF J > 29 AND M = 2 THEN J = J - 29: M = M + 1
IF J > 31 AND M = 3 THEN J = J - 31: M = M + 1
IF J > 30 AND M = 4 THEN J = J - 30: M = M + 1
IF J > 31 AND M = 5 THEN J = J - 31: M = M + 1
IF J > 30 AND M = 6 THEN J = J - 30: M = M + 1
IF J > 31 AND M = 7 THEN J = J - 31: M = M + 1
IF J > 31 AND M = 8 THEN J = J - 31: M = M + 1
IF J > 30 AND M = 9 THEN J = J - 30: M = M + 1
IF J > 31 AND M = 10 THEN J = J - 31: M = M + 1
IF J > 30 AND M = 11 THEN J = J - 30: M = M + 1
IF J > 31 AND M = 12 THEN J = J - 31: M = M + 1
H = ((H - INT(H)) / .6 + INT(H)) / 24: J = J + H: A = AA
IF M <= 2 THEN A = A - 1: M = M + 12
E2 = M: J1 = J + D: A2 = A: J2 = J
pasprog = 1 / 24
FOR J3 = J2 TO J1 STEP pasprog
    T = INT(A2 * 365.25) + INT(30.6001 * (E2 + 1)) + J3 - INT(A2 / 100) + INT(INT(A2 / 100) / 4)
    T = (T - 694000# - 23.5#) / 36525#
    GOSUB SOLEIL: L = L / Z: T7 = L
    T = INT(A2 * 365.25) + INT(30.6001 * (E2 + 1)) + (J3 + pasprog) - INT(A2 / 100) + INT(INT(A2 / 100) / 4)
    T = (T - 694000# - 23.5#) / 36525#
    GOSUB SOLEIL: L = L / Z: T8 = L: T5 = T8 - T7: T5 = T5 * Z
    IF T7 > T8 THEN T5 = 360 + T5
    T5 = T5 / 2: IF T8 > T7 THEN T6 = T7 + T5 / Z ELSE T6 = T8 + T5 / Z
    LOCATE 10, 38: PRINT USING "##.#"; U6
    LOCATE 10, 42: PRINT "/"; USING "##"; (T9 - INT(T9 / 100) * 100)
    I = AB - 4: G = INT(T6 * Z / 30): L = T6 * Z - G * 30: L = INT(L) + INT((L - INT(L)) * 60) / 100
    LOCATE 10, 47: PRINT B$(AB - 4): LOCATE 10, 57: PRINT USING "##.##"; L
    LOCATE 10, 64: PRINT A$(G)
    AP = 0: BI = 0: BS = T5: LOCATE 10, 75: PRINT USING "##.##"; 2 * T5: GOSUB P470
    AP = 180: GOSUB P460
    AP = 120: GOSUB P460
    AP = 90: GOSUB P460
    AP = 60: GOSUB P460
    'IF AB <> 5 THEN U6 = U6 + 3 ELSE U6 = U6 + .5
    U6 = U6 + .5
    IF U6 > 12.5 THEN T9 = T9 + 1: U6 = 1
NEXT: GOSUB 25000: GOSUB 24000: AB = 0: GOTO PROMENU
P460:
BS = AP + T5: BI = ABS(AP - T5)
P470:
FOR K = 0 TO 11
    DI = Z * ABS(T6 - L(0, K))
    IF DI > BS THEN DI = 360 - DI
    IF DI > BS OR DI < BI THEN GOTO P590
    IF AP = 0 THEN LOCATE LIG, COL * 39 + 3: PRINT "CO"
    IF AP = 180 THEN LOCATE LIG, COL * 39 + 3: PRINT "OP"
    IF AP = 120 THEN LOCATE LIG, COL * 39 + 3: PRINT "TR"
    IF AP = 90 THEN LOCATE LIG, COL * 39 + 3: PRINT "CA"
    IF AP = 60 THEN LOCATE LIG, COL * 39 + 3: PRINT "SE"
    LOCATE LIG, COL * 39 + 7: PRINT B$(I): LOCATE LIG, COL * 39 + 16: PRINT "-": LOCATE LIG, COL * 39 + 19: PRINT B$(K)
    LOCATE LIG, COL * 39 + 28: PRINT USING "##.#"; U6: LOCATE LIG, COL * 39 + 32: PRINT "/"; USING "##"; (T9 - INT(T9 / 100) * 100)
    LIG = LIG + 1: IF LIG > 22 THEN LIG = 12: COL = COL + 1
    IF COL = 2 THEN GOSUB P36000: COL = 0
    P590:
NEXT: RETURN
T34000:
LOCATE 11, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR YI = 12 TO 22: LOCATE YI, 1: PRINT "º                                      º                                       º": NEXT
LOCATE 23, 1: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN
P36000:
COLOR 14
LOCATE 24, 25: PRINT "Faites RETURN pour continuer...";
COLOR 14: Z$ = INPUT$(1): GOSUB T34000
LOCATE 24, 25: PRINT "                               ";: RETURN

  
2530 '
2540 '                   transits
2550 '
2570 GOSUB 24000: GOSUB TRANS: GOTO 1500
'
'                     Transits
  
TRANS:
DEBTRANS:
DIM T(5, 8, 2):
DO
    LOCATE 10, 32: PRINT "TRANSITS POUR ";
    INPUT D$: D = VAL(D$)
LOOP UNTIL D$ <> ""
TRA$ = "TRAN" + D$ + ".DAT"
OPEN "R", 1, TRA$, 145
IF LOF(1) = 0 THEN CLOSE: KILL TRA$: GOTO T100
LOCATE 10, 32: PRINT "TRANSITS POUR "; D$; "        "
LOCATE 13, 25: PRINT "1 --- CALCUL DES TRANSITS"
LOCATE 17, 25: PRINT "2 --- ARRET"
T080:
Z$ = INPUT$(1): PP = VAL(Z$): ON PP GOTO T110, T390
GOTO T080
T100:
CLS: SHELL "CALTRANS"
GOTO THEME
T110:
GOSUB 24000
LOCATE 10, 32: PRINT "TRANSITS POUR  "; D$
LOCATE 13, 25: PRINT "1 --- CALCUL AVEC MARS"
LOCATE 15, 25: PRINT "2 --- CALCUL SANS MARS"
LOCATE 17, 25: PRINT "3 --- CALCUL AVEC MARS SUR IMPRIMANTE"
LOCATE 19, 25: PRINT "4 --- CALCUL SANS MARS SUR IMPRIMANTE"
T170:
Z$ = INPUT$(1): PP = VAL(Z$): ON PP GOTO T325, T315, T195, T195
GOTO T170
T195:
LOCATE 1, 1, 0: LPRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
LOCATE 2, 1: LPRINT "º";: LPRINT TAB(18); "* * * *   T H E M E   A S T R A L  * * * * "; TAB(80); "º"
LOCATE 3, 1: LPRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 4, 1: LPRINT "º NOM :"; NOM$;: LPRINT TAB(40); "º PRENOM :"; PRE$;: LPRINT TAB(80); "º"
LOCATE 5, 1: LPRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 6, 1: LPRINT "º JOUR :"; JJ;: LPRINT TAB(27); "º MOIS :"; MM;: LPRINT TAB(53); "º ANNEE :"; AA;: LPRINT TAB(80); "º"
LOCATE 7, 1: LPRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 8, 1: LPRINT "º HEURE :"; HH;: LPRINT TAB(27); "º LATITUDE :"; LU;: LPRINT TAB(53); "º LONGITUDE :"; LX;: LPRINT TAB(80); "º"
LOCATE 9, 1: LPRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LPRINT "º "; TAB(33); "TRANSITS POUR "; D;: LPRINT TAB(80); "º":
'LOCATE 23,1,0:PRINT"ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
IF PP = 3 THEN GOTO T325 ELSE GOTO T315
T315:
NP = 1: GOTO T335
T325:
NP = 0
T335:
FIELD #1, 8 AS T0$, 8 AS T1$, 8 AS T2$, 8 AS T3$, 8 AS T4$, 8 AS T5$, 8 AS T6$, 8 AS T7$, 8 AS T8$, 8 AS T9$, 8 AS T10$, 8 AS T11$, 8 AS T12$, 8 AS T13$, 8 AS T14$, 8 AS T15$, 8 AS T16$, 8 AS T17$
GOSUB 24000: FOR I = 0 TO 8: J = I + 1: GET #1, J
    T(0, I, 0) = CVD(T0$): T(0, I, 1) = CVD(T1$): T(0, I, 2) = CVD(T2$)
    T(1, I, 0) = CVD(T3$): T(1, I, 1) = CVD(T4$): T(1, I, 2) = CVD(T5$)
    T(2, I, 0) = CVD(T6$): T(2, I, 1) = CVD(T7$): T(2, I, 2) = CVD(T8$)
    T(3, I, 0) = CVD(T9$): T(3, I, 1) = CVD(T10$): T(3, I, 2) = CVD(T11$)
    T(4, I, 0) = CVD(T12$): T(4, I, 1) = CVD(T13$): T(4, I, 2) = CVD(T14$)
    T(5, I, 0) = CVD(T15$): T(5, I, 1) = CVD(T16$): T(5, I, 2) = CVD(T17$)
NEXT: IF PP < 3 THEN LOCATE 10, 25: PRINT "TRANSITS POUR ", D$
IF PP > 2 THEN
    LPRINT "º"; TAB(80); "º": LPRINT "º"; TAB(33); "CONJONTION"; TAB(80); "º": COL = 0
ELSE
    LOCATE 11, 34: PRINT "CONJONCTION": LIG = 12: LIG1 = 0: COL = 0
END IF
FOR I = 0 TO 11: T7 = L(0, I) * Z: GOSUB T650: NEXT
IF PP > 2 AND COL > 0 THEN COL = 0: LPRINT TAB(80); "º"
IF PP < 3 THEN GOSUB 25000: GOSUB 24000
IF PP < 3 THEN LOCATE 10, 25: PRINT "TRANSITS POUR ", D$
IF PP > 2 THEN
    LPRINT "º"; TAB(80); "º": LPRINT "º"; TAB(33); "SEXTILE"; TAB(80); "º": COL = 0
ELSE
    LOCATE 11, 34: PRINT "SEXTILE": LIG = 12: LIG1 = 0: COL = 0
END IF
FOR I = 0 TO 11: T7 = L(0, I) * Z + 60: GOSUB T650
T7 = L(0, I) * Z - 60: GOSUB T650: NEXT
IF PP > 2 AND COL > 0 THEN LPRINT TAB(80); "º"
IF PP < 3 THEN GOSUB 25000: GOSUB 24000
IF PP < 3 THEN LOCATE 10, 25: PRINT "TRANSITS POUR ", D$
IF PP > 2 THEN
    LPRINT "º"; TAB(80); "º": LPRINT "º"; TAB(33); "CARRE"; TAB(80); "º": COL = 0
ELSE
    LOCATE 11, 34: PRINT "CARRE": LIG = 12: LIG1 = 0: COL = 0
END IF
FOR I = 0 TO 11: T7 = L(0, I) * Z + 90: GOSUB T650
T7 = L(0, I) * Z - 90: GOSUB T650: NEXT
IF PP > 2 AND COL > 0 THEN LPRINT TAB(80); "º"
IF PP < 3 THEN GOSUB 25000: GOSUB 24000
IF PP < 3 THEN LOCATE 10, 25: PRINT "TRANSITS POUR ", D$
IF PP > 2 THEN
    LPRINT "º"; TAB(80); "º": LPRINT "º"; TAB(33); "TRIGONE"; TAB(80); "º": COL = 0
ELSE
    LOCATE 11, 34: PRINT "TRIGONE": LIG = 12: LIG1 = 0: COL = 0
END IF
FOR I = 0 TO 11: T7 = L(0, I) * Z + 120: GOSUB T650
T7 = L(0, I) * Z - 120: GOSUB T650: NEXT
IF PP > 2 AND COL > 0 THEN LPRINT TAB(80); "º"
IF PP < 3 THEN GOSUB 25000: GOSUB 24000
IF PP < 3 THEN LOCATE 10, 25: PRINT "TRANSITS POUR ", D$
IF PP > 2 THEN
    LPRINT "º"; TAB(80); "º": LPRINT "º"; TAB(33); "OPPOSITION"; TAB(80); "º": COL = 0
ELSE
    LOCATE 11, 34: PRINT "OPPOSITION": LIG = 12: LIG1 = 0: COL = 0
END IF
FOR I = 0 TO 11: T7 = L(0, I) * Z + 180: GOSUB T650: NEXT
IF PP > 2 AND COL > 0 THEN LPRINT TAB(80); "º"
IF PP > 2 THEN LPRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼"
GOSUB 25000: GOSUB 24000: CLOSE: RETURN
T650:
IF T7 > 360 THEN T7 = T7 - 360
IF T7 < 0 THEN T7 = T7 + 360
FOR J = NP TO 5
    IF T(J, 0, 0) <> 1 THEN IF T7 > T(J, 0, 1) AND T7 < T(J, 0, 2) THEN GOSUB T720: GOTO T710 ELSE GOTO T710
    IF T7 > 0 AND T7 < T(J, 0, 2) THEN GOSUB T020: GOTO T710
    IF T7 > T(J, 1, 1) AND T7 < 360 THEN GOSUB T040
    T710:
NEXT: RETURN
T720:
IF T7 > T(J, 0, 1) AND T7 < T(J, 2, 1) THEN DEB = 1: FIN = T(J, 2, 0): GOSUB T870: RETURN
IF T7 > T(J, 2, 1) AND T7 < T(J, 3, 0) THEN DEB = T(J, 2, 0): FIN = T(J, 2, 2): GOSUB T870
IF T7 > T(J, 3, 0) AND T7 < T(J, 3, 2) THEN DEB = T(J, 2, 2): FIN = T(J, 3, 1): GOSUB T870
IF T7 > T(J, 3, 2) AND T7 < T(J, 4, 1) THEN DEB = T(J, 3, 1): FIN = T(J, 4, 0): GOSUB T870
IF T7 > T(J, 4, 1) AND T7 < T(J, 5, 0) THEN DEB = T(J, 4, 0): FIN = T(J, 4, 2): GOSUB T870
IF T7 > T(J, 5, 0) AND T7 < T(J, 5, 2) THEN DEB = T(J, 4, 2): FIN = T(J, 5, 1): GOSUB T870
IF T7 > T(J, 5, 2) AND T7 < T(J, 6, 1) THEN DEB = T(J, 5, 1): FIN = T(J, 6, 0): GOSUB T870
IF T7 > T(J, 6, 1) AND T7 < T(J, 7, 0) THEN DEB = T(J, 6, 0): FIN = T(J, 6, 2): GOSUB T870
IF T7 > T(J, 7, 0) AND T7 < T(J, 7, 2) THEN DEB = T(J, 6, 2): FIN = T(J, 7, 1): GOSUB T870
IF T7 > T(J, 7, 2) AND T7 < T(J, 8, 1) THEN DEB = T(J, 7, 1): FIN = T(J, 8, 0): GOSUB T870
IF T7 > T(J, 8, 1) AND T7 < T(J, 0, 2) THEN DEB = T(J, 8, 0): FIN = 365: GOSUB T870
RETURN
30860 RETURN
T870:
DEB = DEB + 9: FIN = FIN + 9: MIL = (DEB + FIN) / 2
GET #1, MIL: GOSUB T890: IF T7 < MA THEN GOTO T960 ELSE GOTO T990
T890:
ON J GOTO T910, T920, T930, T940, T950
T900:
DA = CVD(T0$): MA = CVD(T1$): MI = CVD(T2$): RETURN
T910:
DA = CVD(T3$): MA = CVD(T4$): MI = CVD(T5$): RETURN
T920:
DA = CVD(T6$): MA = CVD(T7$): MI = CVD(T8$): RETURN
T930:
DA = CVD(T9$): MA = CVD(T10$): MI = CVD(T11$): RETURN
T940:
DA = CVD(T12$): MA = CVD(T13$): MI = CVD(T14$): RETURN
T950:
DA = CVD(T15$): MA = CVD(T16$): MI = CVD(T17$): RETURN
T960:
MI = 0: WHILE T7 > MI
    GET #1, DEB: DEB = DEB + 1: GOSUB T890: IF T7 < MA AND T7 > MI THEN GOSUB T070
WEND: RETURN
T990:
MA = 360: WHILE T7 < MA
    GET #1, FIN: FIN = FIN - 1: GOSUB T890: IF T7 < MA AND T7 > MI THEN GOSUB T070
WEND: RETURN
T020:
MIL1 = T(J, 8, 2): IF MIL1 = 1 THEN DEB = 1: FIN = T(J, 1, 0): GOSUB T870: RETURN
GOSUB T720: RETURN
T040:
MIL1 = T(J, 8, 2): IF MIL1 = 11 THEN DEB = T(J, 1, 0): FIN = 365: GOSUB T870: RETURN
ON MIL1 - 1 GOSUB T190, T200, T210, T220, T230, T240, T250, T260, T270
ON MIL1 - 1 GOSUB T290, T300, T310, T320, T330, T340, T350, T360, T370
RETURN
T070:
IF PP > 2 THEN GOTO T130
COL = LIG1 * 27 + 3: LIG1 = LIG1 + 1
DA$ = STR$(DA): DA$ = MID$(DA$, (LEN(DA$) - 3), 2) + "/" + RIGHT$(DA$, 2) + " "
LOCATE LIG, COL: PRINT DA$; B$(J + 4); "-"; B$(I)
IF LIG1 > 2 THEN LIG1 = 0: LIG = LIG + 1
IF LIG > 22 THEN GOSUB 25000: GOSUB 24000: COL = 0: LIG = 11: COL1 = 0
RETURN
T130:
DA$ = STR$(DA): DA$ = MID$(DA$, (LEN(DA$) - 3), 2) + "/" + RIGHT$(DA$, 2) + " "
IF COL = 0 THEN LPRINT "º";
LPRINT TAB(COL * 27 + 3); DA$; B$(J + 4); "-"; B$(I);
IF COL = 2 THEN LPRINT TAB(80); "º"
COL = COL + 1: IF COL > 2 THEN COL = 0
RETURN
T190:
DEB = T(J, 1, 0): FIN = T(J, 2, 2): GOSUB T870: RETURN
T200:
DEB = T(J, 1, 0): FIN = T(J, 3, 1): GOSUB T870: RETURN
T210:
DEB = T(J, 1, 0): FIN = T(J, 4, 0): GOSUB T870: RETURN
T220:
DEB = T(J, 1, 0): FIN = T(J, 4, 2): GOSUB T870: RETURN
T230:
DEB = T(J, 1, 0): FIN = T(J, 5, 1): GOSUB T870: RETURN
T240:
DEB = T(J, 1, 0): FIN = T(J, 6, 0): GOSUB T870: RETURN
T250:
DEB = T(J, 1, 0): FIN = T(J, 6, 2): GOSUB T870: RETURN
T260:
DEB = T(J, 1, 0): FIN = T(J, 7, 1): GOSUB T870: RETURN
T270:
DEB = T(J, 1, 0): FIN = T(J, 8, 0): GOSUB T870: RETURN
T280:
IF T7 > T(J, 2, 1) AND T7 < T(J, 3, 0) THEN DEB = T(J, 2, 0): FIN = T(J, 2, 2): GOSUB T870
T290:
IF T7 > T(J, 3, 0) AND T7 < T(J, 3, 2) THEN DEB = T(J, 2, 2): FIN = T(J, 3, 1): GOSUB T870
T300:
IF T7 > T(J, 3, 2) AND T7 < T(J, 4, 1) THEN DEB = T(J, 3, 1): FIN = T(J, 4, 0): GOSUB T870
T310:
IF T7 > T(J, 4, 1) AND T7 < T(J, 5, 0) THEN DEB = T(J, 4, 0): FIN = T(J, 4, 2): GOSUB T870
T320:
IF T7 > T(J, 5, 0) AND T7 < T(J, 5, 2) THEN DEB = T(J, 4, 2): FIN = T(J, 5, 1): GOSUB T870
T330:
IF T7 > T(J, 5, 2) AND T7 < T(J, 6, 1) THEN DEB = T(J, 5, 1): FIN = T(J, 6, 0): GOSUB T870
T340:
IF T7 > T(J, 6, 1) AND T7 < T(J, 7, 0) THEN DEB = T(J, 6, 0): FIN = T(J, 6, 2): GOSUB T870
T350:
IF T7 > T(J, 7, 0) AND T7 < T(J, 7, 2) THEN DEB = T(J, 6, 2): FIN = T(J, 7, 1): GOSUB T870
T360:
IF T7 > T(J, 7, 2) AND T7 < T(J, 8, 1) THEN DEB = T(J, 7, 1): FIN = T(J, 8, 0): GOSUB T870
T370:
IF T7 > T(J, 8, 1) AND T7 < T(J, 1, 2) THEN DEB = T(J, 8, 0): FIN = 365: GOSUB T870
RETURN
T390:
GOSUB 24000: ERASE T: CLOSE: T7 = 0: MIL = 0: MA = 0: MI = 0: DEB = 0: FIN = 0: RETURN

2600 '
2610 '              ANALYSE DE LA CARTE
2620 '
2630 IF PRG = 7 THEN 2660
2640 CHAIN "GRAPHMOD"
2650 CHAIN "CALCUL"
2660 PRG = 7: GOTO 1500
2700 '
2710 '                    ARRET
2720 '
2730 CLS: LOCATE 10, 30: PRINT "PROGRAMME D' ARRET"
2740 CLOSE: RESET
2750 END
24000:
LOCATE 9, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR IY = 10 TO 22: LOCATE IY, 1: PRINT "º                                                                              º": NEXT
LOCATE 23, 1, 0: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN
24100:
LOCATE 1, 1, 0: PRINT "ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"
LOCATE 2, 1: PRINT "º                * * * *   T H E M E   A S T R A L   * * * *  PROG.PREC        º"
LOCATE 3, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 4, 1: PRINT "º NOM :                                º PRENOM :                              º"
LOCATE 5, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 6, 1: PRINT "º JOUR :                  º MOIS :                  º ANNEE :                  º"
LOCATE 7, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
LOCATE 8, 1: PRINT "º HEURE :                 º LATITUDE :              º LONGITUDE :              º"
LOCATE 9, 1: PRINT "ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹"
FOR IY = 10 TO 22: LOCATE IY, 1: PRINT "º                                                                              º": NEXT
LOCATE 23, 1, 0: PRINT "ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼";
RETURN

RETOUR:
'               RETOUR CARTE
COLOR 11, 1: GOSUB 24100
COLOR 14: LOCATE 4, 9: PRINT NOM$: LOCATE 4, 51: PRINT PRE$: LOCATE 6, 10
PRINT USING "##"; JJ: LOCATE 6, 36: PRINT USING "##"; MM
LOCATE 6, 63: PRINT USING "####"; AA
LOCATE 8, 11: PRINT USING "##.##"; HH: LOCATE 8, 39: PRINT USING "###.##"; LU
LOCATE 8, 66: PRINT USING "####.##"; LX: COLOR 14, 9, 9
RETURN
25000:
'                   MESSAGE
'
COLOR 13
LOCATE 24, 25: PRINT "Faites ENTREE pour continuer...";
COLOR 14: Z$ = INPUT$(1): LOCATE 24, 25: PRINT "                                ";: RETURN

S'il y a des gosub et des goto faut demander à SPH

bjr Ar-s probablement

Cdt

Beh... Y'a rien à convertir en fait...
Tu reprends instruction après instruction, et c'est bon...
Tu peux déjà faire un test en QB64 pour voir si ton code d'origine fonctionne.

Ensuite,

THEME c'est un label.
CLOSE c'est l'équivalent de fermer tous les fichiers
KEY OFF osef
DIM il faut réécrire des dims pour chaque variable.
syntaxe de type :
1)FLOTTANT
2)CHAINE$
3)ENTIER%
TAB(x) c'est Chr(9) x fois
OPEN "I", 1, "A%" = openFile(1, "A%", #qqchRead)
INPUT #1 etc... = ReadString(1, etc...) ce qui signifie que tu as un fichier de données à récup quelquepart
SCREEN 0, 1 = Écran 80 colonnes par 25 lignes page 1 (il y a 16 pages de 0 à 15)
COLOR 11, 1, 9 = couleur caractère cyan surbrillant, sur fond bleu, dans un cadre écran bleu clair
OPEN "R", 1, "NOM", 82
= openFile(1, "NOM", #qqchRead)
82 c'est le nombre d'octets par ligne de données

FIELD #1, 15 AS N$, 15 AS PR$, etc...
C'est la structure de chaque ligne de donnée :
#1 (ou #x) c'est le numéro de fichier ouvert (comme en pureBasic)
15 AS N$ = consacre 15 octets pour la chaîne N$
15 AS PR$ = consacre 15 octets pour la chaîne PR$
etc...
GET #1, A = lit une ligne de données (la numéro A de 0 à x)
INSTR(C, L1$, " ") = findString()
LSET = Ltrim()
OPEN "O" = openFile(id, nom$, #qqchWrite)
ON PP GOTO Label1, Label2, Label3, etc... = ah ça c'est le plus cocu...
Équivaut à :
if PP=1: GOTO Label1: EndIf
if PP=2: Goto Label2: endif
if PP=3: GOTO Label3: endif
etc...

Ce qui aurait pu te bloquer sérieusement c'est un CALL ABSOLUTE équivalent à callFunctionFast mais avec de l'asm8086 (16bits). Il y a aussi un décalage de pile dans ce type d'appel entre QB et TB.
TB ne transmettait qu'une variable en argument. Donc c'était soit une seule variable, soit un pointeur de données.
Tandis que QB pouvait transmettre 4 variables et modifiait les registres dans une capsule en pile donc plus lent.

Mais là tu n'as pour ainsi dire rien d'autre que du traitement de chaîne, de l'i/o avec des fichiers, et un affichage de type console...

Perso, je n'utilisais jamais ces instructions de fichiers : complètement grillées. Il y avait BLOAD et BSAVE (binary load / binary save) limités à 32Ko par fichier mais au moins il fallait s'accrocher à une fusée pour trouver ce que ça contenait...
D'ailleurs LSET je me plante ce n'est pas LTrim l'équivalent ça doit être "Line SET" c'est donc pour remplir un champ avant d'enregistrer une ligne de champs de données (structurée avec FIELD)
Et enfin un petit dernier pour la route :
IF equation logique THEN 450 ELSE 500
équivaut à If equation: Goto Line450: Else: Goto Line500: Endif

(le plus ouf c'est de mettre un 80286 en mode protégé avec TB et d'afficher un pixel blanc !! Après ça, il n'y a que le bouton RESET qui fonctionne

)

2ème partie

ERASE A$
équivaut à Dim A$(0)

PRINT USING
cocu : c'est pour afficher un nombre au format désiré.

SPC
équivalent à Space()

Z$ = INPUT$(x)
Crée une chaîne Z$ de x frappes de touche. Comme c'est sans sortie d'affichage, x est systématiquement à 1. C'est donc ici l'équivalent de l'attente de frappe d'une touche.

DO
...
LOOP UNTIL equationLogique

équivaut à

Repeat
...
Until equationLogique

KILL équivaut à DeleteFile

SHELL équivaut à RunProgram donc il te manque aussi les EXE qui vont avec (CALTRANS.EXE), en plus des fichiers de données.

LPRINT cocu : c'est exactement comme un PRINT mais vers l'imprimante.

CVD convertit vers valeur en double précision (== valD() )

CHAIN "fichier"
C'est l'équivalent d'un RunProgram() mais qui efface toute la mémoire du programme appelant.

RESET C'était inutile avec TB. osef

Le point-virgule :
1) équivaut au + (concaténation de chaîne) en PB
2) en fin de ligne, équivaut à maintenir le curseur sur la même ligne.

PRINT "message" ==== PrintN("message")
PRINT "message"; ==== Print("message")

Domaine pour LOCATE yy, xx
xx de 1 à 80
yy de 1 à 25

Petite remarque pour CVD() : je me suis gamellé.
--> CVD() doc "gladir.com"

En QB/TB, une des toutes puissances de ce langage, c'était la manière de stocker les chaînes : le Chr(0) c'était un caractère comme les autres. Une chaîne vide prenait 2 octets, une chaîne de 1 caractère en prenait 3, et ainsi de suite. En TB, 15 bits était consacré à renseigner la longueur d'une chaîne. Donc une chaîne pouvait faire de 0 à 32767 caractères (ou octets). Et on pouvait y gaufrer ce qu'on voulait, même des caractères nuls.

Donc, en gros, X = CVD(A$) ça équivaut à une sorte de :

Code : Tout sélectionner

X.D = PeekD(@A$)

Mais un A$ boosté à l'ancienne. Pas un null terminal string.

En PB pour aller moucher un truc pareil, autant gaspiller 25% de la mémoire utile pour ce type d'usage et remplacer :
a = cvd(z$)
z$ = mkd$(a)

par

base64decode()
base64encode()

bjr ollivier
tout d'abord merci d'avoir passé du temps à examiner le code

Pour les calculs éphémérides les données sont intéressantes mais c'est avec une base de départ année 2000
ce qui limite la qualités des calculs sur un grand nombre d'années, mais pour le fun c 'est cool
maintenant nous avons le site : https://www.astro.com/swisseph/swephprg.htm
pour justement avoir des calculs très précis sur le sujet en utilisant leur Fichier "DLL" gratuit

Dans ce code le coté intéressant c est la séquences du calcul des direction primaires
et divers autres calculs qui sont très bons, ce qui pourrait intéresser certaines personnes du forums

pour la conversion j'ai un peu commencé à mes heures perdues
mais comme j'ai pleins de projets en sus, c est compliqué pour moi en ce moment..
j 'ai d'abord choisi de le convertir GfaBasic GB32 pour Windows qui utilise encore les commandes
locate, goto etc. ainsi que les fichier à accès direct
voici le lien:
https://gfabasic32codes.info/?view=arti ... 2&catid=11
en tout cas ollivier merci de ton aide
Cdt
PS: il semble que QB soit plus adapté

bjr à tous
mises à jours des codes transmis plus haut pour les tests
j 'ai réussi à faire fonctionner le code "Turbo Basic"
sous QB64 avec quelques "GOTO" après les "THEN"
et avec une mise en commentaire de la ligne 23 du précèdent Code affichée ci-dessous

il a fonctionné sous seven

Code : Tout sélectionner

; code mis en commentaire sous QB64
OPEN "I", 1, "A%": FOR I = 0 TO 1: FOR J = 1 TO 100: INPUT #1, A$: A%(I, J) = VAL(A$): A$ = "00": NEXT: NEXT: CLOSE :

j'ai utilisé le QB64 trouvé ici: https://softfamous.com/qb64/

j' essaierais de le convertir en PureBasic quand j'aurais du temps libre

Cordialement
PS: copier le code directement vers l'éditeur QB64 car il y a des caractères de dessin des cadres mode IBM ASCII
très susceptibles à la copie vers un autre éditeur que QB

voir dans le code vers lignes 118

J'ai commencé une conversion PB. Je travaille actuellement sur le texte et l'affichage graphique.

Il y a un peu de code qui est nécessaire. Comme Ollivier l'a mentionné, les fichiers utilisés avec la commande CHAIN sont nécessaires. Il s'agit de "GRAPHMOD" et "CALCUL". Le fichier "CALTRANS" utilisé avec la commande SHELL est également nécessaire pour calculer les données de transit.

Les autres fichiers nécessaires semblent être créés après l'exécution du programme.

(Note : Traduction effectuée par DeepL.)

Traduit avec www.DeepL.com/Translator (version gratuite)

bjr Demivec,
merci de ton aide bienvenue

Voici les nouvelles au sujet des fichiers manquants. j'ai transmis la demande
à la personne qui m'as donné ce code cet ami m'as dit qu'il possedait une vielle
revue des années 80 ou il à trouvé ce code avec tout le mode d'emploi
et les fichiers annexes.
il va nous transmettre tous ces documents dans quelques jours.

Cordialement

PureBasic

Code Astro ex_Turbo Basic? to QB64 première partie

Code Astro ex_Turbo Basic? to QB64 première partie

Code Astro en Turbo Basic? deuxième partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro en Turbo Basic? première partie

Re: Code Astro ex_Turbo Basic? to QB64 première partie

Re: Code Astro ex_Turbo Basic? to QB64 première partie