forked from robhagemans/basicode
-
Notifications
You must be signed in to change notification settings - Fork 0
/
A02_Biorithme.bc3
155 lines (154 loc) · 4.9 KB
/
A02_Biorithme.bc3
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
1000 A=100:GOTO20:REM BIORITHME
1005 REM TROS-RADIO dd. 860712
1010 DIMML(12)
1020 GOSUB100
1030 HO=10:VE=12:GOSUB110:PRINT"Biorithme"
1040 SD=30:GOSUB450
1050 RESTORE
1060 FORI=1 TO12:READML(I):NEXTI
1070 GOSUB2180:REM INLEIDING
1080 GOSUB100
1090 PRINT:PRINT
1100 PRINT"Voor het tekenen van een grafiek"
1110 PRINT"heb ik tweemaal een datum nodig."
1120 PRINT
1130 PRINT"Eerst uw geboortedatum:"
1140 PRINT
1150 GOSUB120:GOSUB1620:REM DATUMINVOER
1160 D1=DD:M1=MM:J1=JJ
1170 HO=0:VE=13:GOSUB110
1180 PRINT"en nu de datum van de grafiek:"
1190 GOSUB120:GOSUB1620:REM DATUMINVOER
1200 D2=DD:M2=MM:J2=JJ
1210 GOSUB2010:REM BEREKEN VERSCHIL IN DAGEN
1220 IFTY<0 THEN1080
1230 HO=0:VE=20:GOSUB110
1240 PRINT"Aantal dagen sinds geboorte is ";TY
1250 GOSUB2460:REM WACHT
1260 GOSUB600:REM GRAFISCH BEDRIJF
1270 CN=0
1280 D=TY-10
1290 I=.039:Y=.45:XO=.078:YO=.5
1300 HO=XO:VE=YO-Y:GOSUB620:VE=YO+Y:GOSUB630
1310 VE=YO:GOSUB620:HO=XO+20*I:GOSUB630
1320 FORK=1 TO20
1330 HO=XO+K*I:VE=YO:GOSUB620:VE=YO+.016:GOSUB630
1340 NEXTK
1350 HO=XO-I:VE=YO-Y/2:SR$="+":GOSUB650
1360 VE=YO+Y/2:SR$="-":GOSUB650
1370 HO=XO+10*I:VE=YO+.06:GOSUB620:VE=YO+.03:GOSUB630
1380 HO=HO-.01:VE=VE+.01:GOSUB630
1390 HO=HO+.02:GOSUB630
1400 HO=HO-.01:VE=VE-.01:GOSUB630
1410 WV=23:SR$="P":GOSUB1520
1420 WV=28:SR$="E":GOSUB1520
1430 WV=33:SR$="I":GOSUB1520
1440 GOSUB210
1450 GOSUB100
1460 HO=0:VE=12:GOSUB110
1470 PRINT"Nog een keer (J/N) ?"
1480 GOSUB210:IFIN=74 THEN1020
1490 GOTO950:REM EINDE VAN HET PROGRAMMA
1510 REM SUBROUTINE TEKEN SINUS
1520 TP=6.28318531
1530 HO=XO:VE=YO-Y*SIN(TP/WV*D):GOSUB620
1540 GOSUB650
1550 FORXX=0 TO20 STEP.5:DX=D+XX
1560 HO=XO+XX*I:VE=YO-Y*SIN(TP/WV*(D+XX)):GOSUB630
1570 NEXTXX
1580 GOSUB650
1590 RETURN
1610 REM SUBROUTINE DATUMINVOER
1620 VP=VE:HP=HO
1630 VE=VP:GOSUB110:SC=120:GOSUB1880
1640 REM LUS DAGINVOER
1650 HO=HP:VE=VP:GOSUB110:SC=39:GOSUB1880
1660 HO=5:VE=VP:GOSUB110:PRINT"Dag (1-31) : ";:INPUTD$
1670 DD=VAL(D$)
1680 IF(DD<1)OR(DD>31) THEN1650
1690 REM LUS MAANDINVOER
1700 HO=HP:VE=VP+1:GOSUB110:SC=39:GOSUB1880
1710 HO=3:VE=VP+1:GOSUB110:PRINT"Maand (1-12) : ";:INPUTM$
1720 MM=VAL(M$)
1730 IF(MM<1)OR(MM>12) THEN GOSUB250:GOTO1700
1740 IF(MM=2)AND(DD>29) THEN GOSUB250:GOTO1620
1750 IF(MM<>2)AND(DD>ML(MM)) THEN GOSUB250:GOTO1620
1760 REM LUS JAARINVOER
1770 HO=HP:VE=VP+2:GOSUB110:SC=39:GOSUB1880
1780 HO=11:VE=VP+2:GOSUB110:PRINT"Jaar : ";:INPUTY$
1790 JJ=VAL(Y$)
1800 IFJJ=0 THEN1770
1810 IFJJ<100 THENJJ=JJ+1900
1820 IF(JJ<1900)OR(JJ>2020) THEN GOSUB250:GOTO1770
1830 TJ=JJ:GOSUB1940
1840 IF(MM=2)AND(DD>ML(MM)+SJ) THEN1620
1850 RETURN
1870 REM PRINT SC SPATIES
1880 FORC=1 TOSC
1890 PRINT" ";
1900 NEXTC
1910 RETURN
1930 REM SUBR. TEST OF TJ SCHRIKKELJAAR IS
1940 IFJJ<>4*INT(JJ/4) THEN1980
1950 IFJJ<>100*INT(JJ/100) THEN1970
1960 IFJJ<>400*INT(JJ/400) THEN1980
1970 SJ=1:RETURN:REM IS SCHRIKKELJAAR
1980 SJ=0:RETURN:REM GEEN SCHRIKKELJAAR
2000 REM SUBR. BEREKEN VERSCHIL
2010 L=365*(J2-J1)
2020 IFM2>1 THENFORI=1 TOM2-1:L=L+ML(I):NEXTI
2030 IFM1>1 THENFORI=1 TOM1-1:L=L-ML(I):NEXTI
2040 L=L+D2-D1
2050 J4=4*INT(J1/4)
2060 J4=J4+4:IFJ4>=J2 THEN2090
2070 TJ=J4:GOSUB1940:L=L+SJ
2080 GOTO2060
2090 IFJ1=J2 THEN2130
2100 TJ=J1:GOSUB1940:IF(SJ=1)AND(M1<3) THENL=L+1
2110 TJ=J2:GOSUB1940:IF(SJ=1)AND(M2>2) THENL=L+1
2120 TY=L:RETURN
2130 TJ=J1:GOSUB1940
2140 IF(SJ=1)AND(M1<3)AND(M2>2) THENL=L+1
2150 TY=L:RETURN
2170 REM SUBROUTINE UITLEG
2180 GOSUB100
2190 PRINT"Volgens de Zwitserse wetenschap van"
2200 PRINT"het biorithme beheersen drie cycli"
2210 PRINT"vanaf de geboorte in een regelmatig"
2220 PRINT"tempo het leven. Deze drie zijn:-"
2230 PRINT
2240 PRINT"PHYSIEK beheerst de lichamelijke"
2250 PRINT"23 dagen kracht, agressiviteit en"
2260 PRINT" uithoudingsvermogen."
2270 PRINT
2280 PRINT"EMOTIE beheerst gevoelen, intuitie"
2290 PRINT"28 dagen creativiteit, omgang"
2300 PRINT" liefde en genegenheid."
2310 PRINT
2320 PRINT"INTELLECT beheerst intellect, geheugen"
2330 PRINT"33 dagen concentratie en snelheid"
2340 PRINT" van het geheugen."
2350 GOSUB2460:REM WACHT
2360 GOSUB100
2370 PRINT"De meest kritieke dagen zijn die waar"
2380 PRINT"de cyclus de horizontale as snijdt,"
2390 PRINT"hetgeen een overgang aangeeft van de"
2400 PRINT"energie die wordt ontladen en weer"
2410 PRINT"wordt opgeladen."
2420 GOSUB2460:REM WACHT
2430 RETURN
2450 REM WACHTROUTINE
2460 HO=0:VE=23:GOSUB110
2470 PRINT"Druk op de SPATIE voor het vervolg";
2480 GOSUB210:IFIN$<>" " THEN2480
2490 RETURN
25000 DATA31,28,31,30,31,30,31,31,30,31,30,31
32000 REM******************************
32010 REM* *
32020 REM* Copyright (C) 1986 *
32030 REM* Stichting BASICODE *
32040 REM* Postbus 1410 *
32050 REM* 5602 BK Eindhoven *
32060 REM* *
32070 REM******************************
32080 REM TROS-RADIO dd 860712