10 REM "cadran vertical d‚clinant"
15 CLS : PRINT "cadran vertical d‚clinant"
20 INPUT "latitude deg (>0 si nord) "; latd
30 INPUT "latitude min (>0 si nord) "; latm
40 INPUT "latitude sec (>0 si nord) "; lats
42 INPUT "longitude deg (>0 si ouest) "; gitd
43 INPUT "longitude min (>0 si ouest) "; gitm
44 INPUT "longitude sec (>0 si ouest) "; gits
45 pi = 4 * ATN(1): k = 180 / pi
47 lat = (latd + latm / 60 + lats / 3600) / k
49 git = (gitd + gitm / 60 + gits / 3600) / k
50 INPUT "d‚clinaison du mur deg (>0 si dirig‚ vers ouest) "; dec
55 d = dec / k
60 INPUT "position centre % horizontal … partir du cot‚ gauche "; posx
65 INPUT "position centre % vertical … partir du haut "; posy
66 INPUT "longueur sous-stylaire % "; sti
70 CLS : SCREEN 12
80 LINE (0, 0)-(600, 0)
90 LINE -(600, 400)
100 LINE -(0, 400)
110 LINE -(0, 0)
120 xc = posy / 100 * 600
130 yc = 400 - posx / 100 * 400
140 LINE (0, yc)-(600, yc): PSET (xc, yc)
145 DEF FNASN (x) = ATN(x / SQR(1 - x * x))
146 DEF FNACS (x) = ATN(SQR(1 - x * x) / x)
150 st = ATN(SIN(d) / TAN(lat))
160 IF d > 0 AND st < 0 THEN st = st + pi
170 IF d < 0 AND st > 0 THEN st = st - pi
185 xst = xc + sti * 6 * COS(st): yst = yc - sti * 6 * SIN(st)
190 COLOR 4: LINE -(xst, yst): PSET (xc, yc)
200 h = FNASN(COS(lat) * COS(d))
250 a = ATN(TAN(d) / SIN(lat))
265 hemat = 0: hesoir = 0: FOR he = 5 TO 22
270 ah = (he - 12) * 15 / k - git
280 az = ATN(SIN(ah) / (SIN(lat) * COS(ah) - COS(lat) * TAN(23.43 / k)))
285 IF SIN(lat) * COS(ah) - COS(lat) * TAN(23.43 / k) < 0 THEN az = az + pi
287 IF az > pi THEN az = -2 * pi + az: GOTO 287
290 IF hemat = 0 AND az > (d - pi / 2) THEN hemat = INT((ah + git) * k / 15 + 12)
295 IF hesoir = 0 AND az > (d + pi / 2) THEN hesoir = INT((ah + git) * k / 15 + 12) + 1
297 NEXT he
300 FOR he = hemat TO hesoir
400 ah = (he - 12) * 15 / k - git
420 angst = ATN(COS(lat) * COS(d) * TAN(ah + a))
452 IF (ah + a) > pi / 2 THEN angst = angst + pi
453 IF (ah + a) < -pi / 2 THEN angst = angst - pi
500 angmerid = angst - st
530 COLOR 3
540 IF angmerid < -pi / 2 OR angmerid > pi / 2 THEN GOTO 560
550 y1 = yc - (600 - xc) * TAN(angmerid): GOTO 600
560 y1 = yc - (0 - xc) * TAN(angmerid)
600 IF angmerid > -pi / 2 AND angmerid < pi / 2 THEN LINE -(600, y1): PSET (xc, yc)
610 IF angmerid < -pi / 2 OR angmerid > pi / 2 THEN LINE -(0, y1): PSET (xc, yc)
650 NEXT he
1000 cp = 600 * sti / 100
1010 cb = cp / COS(h) / COS(h)
1020 y1 = 400
1025 IF d = 0 THEN x1 = xc + cb: GOTO 1050
1030 x1 = y1 - yc + cb * SIN(st) + 1 / TAN(st) * (xc + cb * COS(st))
1040 x1 = x1 * TAN(st)
1050 y2 = 0
1055 IF d = 0 THEN x2 = xc + cb: GOTO 1080
1060 x2 = y2 - yc + cb * SIN(st) + 1 / TAN(st) * (xc + cb * COS(st))
1070 x2 = x2 * TAN(st)
1080 COLOR 5: LINE (x1, y1)-(x2, y2)
2000 alpha = 23.45 / k: test = 0: GOSUB 3000
2005 alpha = -23.45 / k: test = 0: GOSUB 3000
2010 COLOR 14: alpha = -23.0725 / k: test = 0: GOSUB 3000: 'javvier
2020 alpha = -17.3583 / k: test = 0: GOSUB 3000: 'f‚vrier
2030 alpha = -7.5572 / k: test = 0: GOSUB 3000: 'mars
2040 alpha = 4.5678 / k: test = 0: GOSUB 3000: 'avril
2050 alpha = 15.0964 / k: test = 0: GOSUB 3000: 'mai
2060 alpha = 22.0605 / k: test = 0: GOSUB 3000: 'juin
2070 alpha = 23.1011 / k: test = 0: GOSUB 3000: 'juillet
2080 alpha = 17.9989 / k: test = 0: GOSUB 3000: 'ao–t
2090 alpha = 8.2569 / k: test = 0: GOSUB 3000: 'septembre
2100 alpha = -3.2092 / k: test = 0: GOSUB 3000: 'octobre
2110 alpha = -14.4458 / k: test = 0: GOSUB 3000: 'novembre
2120 alpha = -21.8083 / k: test = 0: GOSUB 3000: 'd‚cembre
2200 GOTO 3200
3000 FOR he = hemat TO hesoir STEP .1
3010 ah = (he - 12) * 15 / k - git
3020 angst = ATN(COS(lat) * COS(d) * TAN(ah + a))
3025 IF (ah + a) > pi / 2 THEN angst = angst + pi
3030 IF (ah + a) < -pi / 2 THEN angst = angst - pi
3040 ang = angst - st
3045 IF ang < st - pi / 2 OR ang > st + pi / 2 THEN GOTO 3160
3047 IF d = 0 THEN xp = xc + cp / COS(h) / COS(h): GOTO 3080
3050 xp = xc * TAN(ang) + cp / COS(h) / COS(h) * SIN(st)
3060 xp = xp + 1 / TAN(st) * (xc + cp * COS(st) / COS(h) / COS(h))
3070 xp = xp / (TAN(ang) + 1 / TAN(st))
3080 yp = yc - (xp - xc) * TAN(ang)
3090 dist = SQR((xp - xc) * (xp - xc) + (yp - yc) * (yp - yc))
3095 IF FNACS(cp / COS(h) / dist) > pi / 2 - alpha THEN GOTO 3160
3100 xs = cp / TAN(alpha) / COS(h) / (1 / TAN(alpha) - TAN(FNACS(cp / COS(h) / dist)))
3110 ys = TAN(FNACS(cp / COS(h) / dist)) * xs
3115 IF xs > 1000 THEN GOTO 3160
3120 lng = SQR(xs * xs + ys * ys)
3130 x1 = xc + lng * COS(ang): y1 = yc - lng * SIN(ang)
3151 IF test = 0 THEN PSET (x1, y1): test = 1: GOTO 3160
3152 LINE -(x1, y1)
3155 'FOR cc = 1 TO 5000: NEXT cc
3160 NEXT he
3170 RETURN
3200 FOR hee = hemat TO hesoir
4010 COLOR 3: m = -23.0421: t = 3.04: test = 0: GOSUB 5000
4020 m = -22.0522: t = 7.05: GOSUB 5000
4030 m = -20.1858: t = 10.43: GOSUB 5000
4040 m = -17.5427: t = 13.08: GOSUB 5000
4050 m = -17.213: t = 13.27: GOSUB 5000
4060 m = -14.3851: t = 14.14: GOSUB 5000
4070 m = -11.1456: t = 13.52: GOSUB 5000
4080 m = -7.5611: t = 12.36: GOSUB 5000
4090 m = -4.0439: t = 10.21: GOSUB 5000
4100 m = -.0757: t = 7.33: GOSUB 5000
4110 m = 4.1053: t = 4.15: GOSUB 5000
4120 m = 7.5817: t = 1.22: GOSUB 5000
4130 m = 11.3225: t = -1.03: GOSUB 5000
4140 m = 14.4731: t = -2.46: GOSUB 5000
4150 m = 17.3812: t = -3.37: GOSUB 5000
4160 m = 19.5926: t = -3.3: GOSUB 5000
4170 m = 21.5519: t = -2.23: GOSUB 5000
4180 m = 23.0049: t = -.39: GOSUB 5000
4190 m = 23.2558: t = 1.29: GOSUB 5000
4195 m = 23.2613: t = 1.42: GOSUB 5000
4200 m = 23.0956: t = 3.35: GOSUB 5000
4210 m = 22.1327: t = 5.18: GOSUB 5000
4220 m = 20.3848: t = 6.19: GOSUB 5000
4230 m = 18.1454: t = 6.21: GOSUB 5000
4240 m = 15.3236: t = 5.2: GOSUB 5000
4250 m = 12.2525: t = 3.24: GOSUB 5000
4260 m = 8.3707: t = .2: GOSUB 5000
4270 m = 4.5451: t = -2.59: GOSUB 5000
4280 m = 1.041: t = -6.32: GOSUB 5000
4290 m = -2.4916: t = -9.58: GOSUB 5000
4300 m = -6.3951: t = -12.58: GOSUB 5000
4310 m = -10.2133: t = -15.1: GOSUB 5000
4320 m = -14.0726: t = -16.23: GOSUB 5000
4330 m = -17.0922: t = -16.06: GOSUB 5000
4340 m = -19.4202: t = -14.24: GOSUB 5000
4350 m = -21.3859: t = -11.24: GOSUB 5000
4360 m = -22.5449: t = -7.17: GOSUB 5000
4370 m = -23.2609: t = -1.59: GOSUB 5000
4380 m = -23.0526: t = 2.56: GOSUB 5000
4500 NEXT hee
4600 GOTO 6010
5000 de = 100 * ABS(m)
5010 des = (100 * ABS(m) - INT(de)) * 100
5020 de = de - des / 100
5030 dem = de / 100: ded = INT(dem)
5040 dem = (dem - ded) * 100
5050 ded = (des / 3600 + dem / 60 + ded) * m / ABS(m) / k
5060 eqs = (ABS(t) - INT(ABS(t))) * 100
5070 eqm = INT(ABS(t))
5080 eq = (eqs / 3600 + eqm / 60) * t / ABS(t)
5090 he = hee - eq
5100 alpha = ded
5110 ah = (he - 12) * 15 / k - git
5120 angst = ATN(COS(lat) * COS(d) * TAN(ah + a))
5125 IF (ah + a) > pi / 2 THEN angst = angst + pi
5130 IF (ah + a) < -pi / 2 THEN angst = angst - pi
5140 ang = angst - st
5145 IF ang < st - pi / 2 OR ang > st + pi / 2 THEN GOTO 6000
5147 IF d = 0 THEN xp = xc + cp / COS(h) / COS(h): GOTO 5180
5150 xp = xc * TAN(ang) + cp / COS(h) / COS(h) * SIN(st)
5160 xp = xp + 1 / TAN(st) * (xc + cp * COS(st) / COS(h) / COS(h))
5170 xp = xp / (TAN(ang) + 1 / TAN(st))
5180 yp = yc - (xp - xc) * TAN(ang)
5190 dist = SQR((xp - xc) * (xp - xc) + (yp - yc) * (yp - yc))
5195 IF FNACS(cp / COS(h) / dist) > pi / 2 - alpha THEN GOTO 6000
5200 xs = cp / TAN(alpha) / COS(h) / (1 / TAN(alpha) - TAN(FNACS(cp / COS(h) / dist)))
5210 ys = TAN(FNACS(cp / COS(h) / dist)) * xs
5215 IF xs > 1000 THEN GOTO 6000
5220 lng = SQR(xs * xs + ys * ys)
5230 x1 = xc + lng * COS(ang): y1 = yc - lng * SIN(ang)
5251 IF test = 0 THEN PSET (x1, y1): test = 1: GOTO 6000
5252 LINE -(x1, y1)
5255 'FOR cc = 1 TO 5000: NEXT cc
6000 RETURN
6010 cc = 1: GOSUB 6011: cc = -1: GOSUB 6011: END
6011 test = 0: FOR alph = -23.45 TO -.05 STEP .1
6015 alpha = alph / k: ah = cc * FNACS(TAN(alpha) * TAN(lat))
6018 ah = ah - git
6020 angst = ATN(COS(lat) * COS(d) * TAN(ah + a))
6025 IF (ah + a) > pi / 2 THEN angst = angst + pi
6030 IF (ah + a) < -pi / 2 THEN angst = angst - pi
6040 ang = angst - st
6045 IF ang < st - pi / 2 OR ang > st + pi / 2 THEN GOTO 6160
6047 IF d = 0 THEN xp = xc + cp / COS(h) / COS(h): GOTO 6080
6050 xp = xc * TAN(ang) + cp / COS(h) / COS(h) * SIN(st)
6060 xp = xp + 1 / TAN(st) * (xc + cp * COS(st) / COS(h) / COS(h))
6070 xp = xp / (TAN(ang) + 1 / TAN(st))
6080 yp = yc - (xp - xc) * TAN(ang)
6090 dist = SQR((xp - xc) * (xp - xc) + (yp - yc) * (yp - yc))
6095 IF FNACS(cp / COS(h) / dist) > pi / 2 - alpha THEN GOTO 6160
6100 xs = cp / TAN(alpha) / COS(h) / (1 / TAN(alpha) - TAN(FNACS(cp / COS(h) / dist)))
6110 ys = TAN(FNACS(cp / COS(h) / dist)) * xs
6115 IF xs > 1000 THEN GOTO 6160
6120 lng = SQR(xs * xs + ys * ys)
6130 x1 = xc + lng * COS(ang): y1 = yc - lng * SIN(ang)
6151 IF test = 0 THEN PSET (x1, y1): test = 1: GOTO 6160
6152 LINE -(x1, y1)
6160 NEXT alph
6200 RETURN