-
Notifications
You must be signed in to change notification settings - Fork 11
/
Copy pathB16_Kalender.bc3
230 lines (229 loc) · 6.99 KB
/
B16_Kalender.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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
1000 A=2000:GOTO20:REM kalender
1010 DIMKL$(8),MN$(12),MN(12),DN(12)
1020 FORF=0 TO12
1030 READMN$(F),MN(F),DN(F)
1040 NEXTF
1050 SP$="":FORF=0 TOHO:SP$=SP$+" ":NEXTF
1060 JR$="1988":MD$=MN$(1):MD=MN(1):TB$=" "
1070 JR=1988:XX=HO+1:YY=VE+1
1080 REM
1090 REM hoofdmenu
1100 REM
1110 GOSUB100
1120 SR$="RWL's Kalender Programma"
1130 TB=INT((XX-LEN(SR$)-6)/2)
1140 IFTB>0 THENPRINTLEFT$(SP$,TB);
1150 GOSUB150:PRINT:PRINT:PRINT
1160 SR$="MENU:":PRINTTB$;:GOSUB150:PRINT
1170 PRINT
1180 PRINTTB$;"1) Ga een maand verder"
1190 PRINTTB$;"2) Kies een (nieuwe) maand"
1200 PRINTTB$;"3) Ga een maand terug":PRINT
1210 PRINTTB$;"4) Ga een jaar verder"
1220 PRINTTB$;"5) Kies een (nieuw) jaar"
1230 PRINTTB$;"6) Ga een jaar terug":PRINT
1240 PRINTTB$;"7) Druk maandkalender (scherm)"
1250 PRINTTB$;"8) Druk maandkalender (printer)"
1260 PRINTTB$;"9) Druk jaarkalender (printer)":PRINT
1270 PRINTTB$;"0) Stoppen, naar BASIC":PRINT:PRINT
1280 SR$="Maand:"
1290 PRINTTB$;:GOSUB150:GOSUB120:C3=HO:C4=VE:PRINTMD$;
1300 SR=MD:GOSUB300:PRINT" (";SR$;") ":PRINT
1310 SR$=" Jaar:"
1320 PRINTTB$;:GOSUB150:GOSUB120:C1=HO:C2=VE:PRINTJR$;" "
1330 HO=XX-2:VE=YY-1:GOSUB110:GOSUB210
1340 IF(IN$<"0")OR(IN$>"9") THEN GOSUB250:GOTO1330
1350 KZ=ASC(IN$)-ASC("0")+1
1360 IFKZ>7 THEN1380
1370 ONKZ GOTO1510,2010,2060,2170,2510,2550,2610
1380 ONKZ-7 GOTO3010,3510,4010
1500 REM #### stoppen
1510 T$="Echt stoppen?":GOSUB5950
1520 SD=50:GOSUB450
1530 IFSD=0 THEN1550
1540 SR$=IN$:GOSUB330:IFSR$="J" THEN950
1550 GOSUB5960:GOTO1330
2000 REM #### maand door
2010 MD=MD+1:IFMD=13 THENMD=1
2020 MD$=MN$(MD):HO=C3:VE=C4:GOSUB5960
2030 IFMD=1 THEN2510
2040 HO=0:GOSUB110:GOTO1280
2050 REM #### maand kiezen
2060 HO=C3:VE=C4:I$="":L=9:GOSUB5960
2070 GOSUB5120
2080 IFI$="" THEN GOSUB250:GOTO2070
2090 T=0:I=0
2100 FORF=0 TO12
2110 IFLEN(I$)>LEN(MN$(F)) THEN2130
2120 IFLEFT$(MN$(F),LEN(I$))=I$ THENT=T+1:I=MN(F)
2130 NEXTF
2140 IFT<>1 THEN GOSUB250:GOTO2070
2150 MD$=MN$(I):MD=I:HO=0:GOSUB110:GOTO1280
2160 REM #### maand terug
2170 MD=MD-1:IFMD=0 THENMD=12
2180 MD$=MN$(MD)
2190 HO=C3:VE=C4:GOSUB5960
2200 IFMD=12 THEN2610
2210 HO=0:GOSUB110:GOTO1280
2500 REM #### jaar door
2510 JR=JR+1:IFJR=2100 THENJR=1901
2520 SR=JR:GOSUB300:JR$=SR$
2530 HO=0:VE=C4:GOSUB110:GOTO1280
2540 REM #### jaar kiezen
2550 HO=C1:VE=C2:I$=JR$:L=4
2560 GOSUB5010:IFLEN(I$)<3 THENI$="19"+I$
2570 I=VAL(I$)
2580 IF(I<1901)OR(I>2099) THEN GOSUB250:GOTO2560
2590 JR=I:JR$=I$:HO=0:GOSUB110:GOTO1310
2600 REM #### jaar terug
2610 JR=JR-1:IFJR=1900 THENJR=2099
2620 SR=JR:GOSUB300:JR$=SR$
2630 HO=0:VE=C4:GOSUB110:GOTO1280
3000 REM #### maandkalender scherm
3010 T$="Even denken..":GOSUB5950
3020 FORF=0 TO8:KL$(F)="":NEXTF
3030 GOSUB5520:GOSUB100
3040 SR$="Kalender "+JR$:GOSUB150
3050 PRINT:PRINT
3060 FORF=0 TO8
3070 PRINTKL$(F)
3080 IFF<2 THENPRINT
3090 NEXTF
3100 PRINT:PRINT
3110 PRINT" Druk een toets...";
3120 GOSUB210:GOTO1110
3500 REM #### maandkalender printer
3510 T$="Even denken..":GOSUB5950
3520 FORF=0 TO8:KL$(F)="":NEXTF
3530 GOSUB5520
3540 T$="Printer Klaar?":GOSUB5950:GOSUB210
3550 SR$=IN$:GOSUB330:IFSR$="N" THEN3630
3560 SR$=" Kalender "+JR$:GOSUB350
3570 GOSUB360:GOSUB360
3580 FORF=0 TO8
3590 SR$=" "+KL$(F):GOSUB350:GOSUB360
3600 IFF<2 THEN GOSUB360
3610 NEXTF
3620 GOSUB360:GOSUB360
3630 GOSUB5960:GOTO1330
4000 REM #### jaarkalender printer
4010 T$="Printer Klaar?":GOSUB5950:GOSUB210:TT=MD
4020 SR$=IN$:GOSUB330:IFSR$="N" THEN4170
4030 GOSUB5960:T$="Even geduld..":GOSUB5950
4040 SR$=" Kalender "+JR$:GOSUB350:GOSUB360
4050 FORI=0 TO3
4060 FORH=0 TO8:KL$(H)="":NEXTH
4070 FORG=0 TO2
4080 MD=I*3+G+1:GOSUB5520
4090 NEXTG
4100 GOSUB360:GOSUB360
4110 FORG=0 TO8
4120 SR$=" "+KL$(G):GOSUB350:GOSUB360
4130 IFG<2 THEN GOSUB360
4140 NEXTG
4150 GOSUB360:GOSUB360
4160 NEXTI
4170 GOSUB5960:MD=TT
4180 GOTO1330
5000 REM #### inputroutine 1 (cijfers)
5010 GOSUB110:PRINTI$;": ";:GOSUB110:PRINTI$;
5020 SD=300:GOSUB450
5030 IFSD=0 THENRETURN
5040 IF(IN<>127)AND(IN<>28) THEN5070
5050 IFI$="" THEN GOSUB250:GOTO5020
5060 I$=LEFT$(I$,LEN(I$)-1):GOTO5010
5070 IF(IN<32) THENRETURN
5080 IF(IN$<"0")OR(IN$>"9") THEN GOSUB250:GOTO5020
5090 IFLEN(I$)=L THEN GOSUB250:GOTO5020
5100 I$=I$+IN$:GOTO5010
5110 REM #### inputroutine 2 (letters)
5120 GOSUB110:PRINTI$;": ";:GOSUB110:PRINTI$;
5130 SD=300:GOSUB450
5140 IFSD=0 THENRETURN
5150 IF(IN<>127)AND(IN<>28) THEN5180
5160 IFI$="" THEN GOSUB250:GOTO5130
5170 I$=LEFT$(I$,LEN(I$)-1):GOTO5120
5180 IF(IN<32) THENRETURN
5190 SR$=IN$:GOSUB330
5200 IF(SR$<"A")OR(SR$>"Z") THEN GOSUB250:GOTO5130
5210 IFLEN(I$)=L THEN GOSUB250:GOTO5130
5220 I$=I$+SR$:GOTO5120
5500 REM #### maandkalender bij kl$
5510 REM ---- eerst aantal dagen.
5520 DG=0:IFMD/2=INT(MD/2) THENDG=DG+1
5530 IFMD<8 THENDG=1-DG
5540 DG=30+DG:IFMD<>2 THEN5570
5550 DG=28:IFJR/4=INT(JR/4) THENDG=29
5560 REM ---- nu de dagsoort vd 1e
5570 DT=1+(JR-1901)*365
5580 DT=DT+INT((JR-1900)/4):WK=DT
5590 DJ=DT
5600 DT=DT+DN(MD-1)
5610 IFJR/4=INT(JR/4) THENDJ=DJ-1
5620 IF(JR/4=INT(JR/4))AND(MD<3) THENDT=DT-1:WK=WK-1
5630 WK=INT(((DT+(WK-7*INT(WK/7)))-WK)/7)+1
5640 DT=DT-7*INT(DT/7):DJ=DJ-7*INT(DJ/7)
5650 IFDJ>3 THENWK=WK-1
5660 REM ---- begin schrijven in kl$
5670 KL$(0)=KL$(0)+" "+MN$(MD)
5680 KL$(0)=KL$(0)+LEFT$(SP$,17-LEN(MN$(MD)))
5690 KL$(1)=KL$(1)+" week"
5700 KL$(2)=KL$(2)+" ma"
5710 KL$(3)=KL$(3)+" di"
5720 KL$(4)=KL$(4)+" wo"
5730 KL$(5)=KL$(5)+" do"
5740 KL$(6)=KL$(6)+" vr"
5750 KL$(7)=KL$(7)+" za"
5760 KL$(8)=KL$(8)+" zo"
5770 IFDT=0 THEN5810
5780 FORF=2 TODT+1
5790 KL$(F)=KL$(F)+" "
5800 NEXTF
5810 PT=2+DT:CT=3:CN=0
5820 IFWK=0 THENKL$(1)=KL$(1)+" ":WK=1:GOTO5840
5830 SR=WK:GOSUB310:KL$(1)=KL$(1)+SR$:WK=WK+1
5840 FORF=1 TODG
5850 SR=F:GOSUB310:KL$(PT)=KL$(PT)+SR$
5860 PT=PT+1:IF(PT<9)OR(F=DG) THEN5890
5870 SR=WK:GOSUB310:KL$(1)=KL$(1)+SR$
5880 PT=2:WK=WK+1
5890 NEXTF
5900 FORF=1 TO8
5910 IFLEN(KL$(F))>=LEN(KL$(0)) THEN5930
5920 KL$(F)=KL$(F)+LEFT$(SP$,LEN(KL$(0))-LEN(KL$(F)))
5930 NEXTF
5940 RETURN
5950 HO=XX-2-LEN(T$):VE=YY-1:GOSUB110:PRINTT$;:RETURN
5960 GOSUB110:PRINTLEFT$(SP$,XX-2-HO);:RETURN
25000 DATA"OCTOBER",10,0
25010 DATA"JANUARI",1,31
25020 DATA"FEBRUARI",2,59
25030 DATA"MAART",3,90
25040 DATA"APRIL",4,120
25050 DATA"MEI",5,151
25060 DATA"JUNI",6,181
25070 DATA"JULI",7,212
25080 DATA"AUGUSTUS",8,243
25090 DATA"SEPTEMBER",9,273
25100 DATA"OKTOBER",10,304
25110 DATA"NOVEMBER",11,334
25120 DATA"DECEMBER",12,0
30000 REM
30010 REM 'Kalender' is een eeuwig-
30020 REM durende kalender in basi-
30030 REM code 3. Het programma kan
30040 REM maand- en jaarkalenders
30050 REM maken vanaf Januari 1901
30060 REM tot en met December 2099.
30070 REM
30080 REM Het gebruik is erg simpel
30090 REM -gewoon het menu volgen-
30100 REM dus dat hoeft niet verder
30110 REM beschreven te worden. Tot
30120 REM slot wens ik u veel ple-
30130 REM zier met dit programma!
32000 REM
32010 REM R W L
32020 REM
32030 REM TROS-RADIO dd 880113
32040 REM incl corr dd 880119