home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol235 / kalfeest.bas < prev    next >
Encoding:
BASIC Source File  |  1994-07-13  |  8.1 KB  |  318 lines
  1. 1 REM BASICODE 2 ROUTINES DOOR HENK WEVERS
  2. 2 REM NADERE INLICHTINGEN BASICODE
  3. 3 REM NOS, HOBBYSCOOP HILVERSUM  
  4. 5 PRINT CHR$(26);:WIDTH(255)
  5. 10 GOTO 1000
  6. 20 GOTO 1010
  7. 100 PRINT CHR$(26);:RETURN
  8. 110 REM
  9. 111 IF HO>51 THEN HO=51
  10. 112 IF VE>23 THEN VE=23
  11. 113 PRINT CHR$(27);"=";CHR$(VE+32);CHR$(HO+32);
  12. 115 RETURN
  13. 120 HO=PEEK(&HEF5A):VE=PEEK(&HEF5B)-&HF0
  14. 121 VE=VE*2
  15. 122 IF HO>127 THEN HO=HO-128:VE=VE+1
  16. 123 VE=VE-PEEK(&HEF62):IF VE<0 THEN VE=32+VE
  17. 124 RETURN
  18. 200 IN$=INKEY$:RETURN
  19. 210 GOSUB 200:IF IN$="" THEN 210
  20. 211 RETURN
  21. 250 PRINT CHR$(7);:RETURN
  22. 260 RV=RND(1):RETURN
  23. 270 FR=FRE(2):RETURN
  24. 300 SR$=STR$(SR)
  25. 301 Q7=LEN(SR$):IF Q7=0 THEN RETURN
  26. 302 IF RIGHT$(SR$,1)<>" " THEN 304
  27. 303 SR$=LEFT$(SR$,Q7-1):GOTO 301
  28. 304 IF LEFT$(SR$,1)<>" " THEN RETURN
  29. 305 SR$=RIGHT$(SR$,Q7-1):GOTO 301
  30. 310 Q4=SR:IF CN<>0 THEN 316
  31. 312 SR=INT(SR+.5):GOSUB 300:GOTO 330
  32. 316 Q5=SGN(SR):SR=ABS(SR):Q8=INT(SR):Q9=SR-Q8
  33. 318 FOR Q6=1 TO CN:Q9=Q9*10:NEXT Q6
  34. 320 Q9=INT(Q9+.5):SR=Q9:GOSUB 300
  35. 322 Q9$=RIGHT$("00000000000000000000"+SR$,CN)
  36. 324 IF Q8=0 AND Q9=0 THEN Q5=1
  37. 326 SR=Q8:GOSUB 300:IF Q5=-1 THEN SR$="-"+SR$
  38. 328 SR$=SR$+"."+Q9$
  39. 330 IF LEN(SR$)<=CT THEN 334
  40. 332 SR$=LEFT$("********************",CT):GOTO 340
  41. 334 SR$=RIGHT$("                    "+SR$,CT)
  42. 340 SR=Q4:RETURN
  43. 350 LPRINT SR$;:RETURN
  44. 360 LPRINT:RETURN
  45. 1000 A=500:GOTO 20
  46. 1010 Z=0:LJ=0:GOSUB 100:REM WISSEN
  47. 1020 GOTO 5020:REM INITIALISATIES
  48. 1030 REM
  49. 1040 REM ** HOOFDPROGRAMMA **
  50. 1050 REM 
  51. 1060 GOSUB 3220:REM UITLEG
  52. 1070 GOSUB 4020:REM UITLEG(2)+KEUZE
  53. 1080 IF Z=1 THEN END
  54. 1090 GOSUB 2320:REM SCHRIKKELJAAR?
  55. 1100 M(2)=M(0)+S
  56. 1110 DE=0
  57. 1120 FOR T=1 TO M:DB=DE:DE=DB+M(T):NEXT T
  58. 1130 A$="":B$=""
  59. 1140 FOR T=1 TO 31:A$(T)="  ":NEXT T
  60. 1150 IF J=LJ THEN 1180
  61. 1160 GOSUB 2520:REM PAASDATUM
  62. 1170 LJ=J
  63. 1180 I=J-1
  64. 1190 U=J+INT(I/4)-INT(I/100)+INT(I/400)
  65. 1200 T=U+DB:N=7:GOSUB 2030
  66. 1210 Y=-R
  67. 1220 FOR N=0 TO 5:K(N)=0:NEXT N
  68. 1230 IF M>6 THEN 1250
  69. 1240 GOSUB 2760:REM FEESTDAGEN?
  70. 1250 IF M<>12 THEN 1270
  71. 1260 GOSUB 2120:REM KERSTDAGEN
  72. 1270 GOSUB 100:PRINT"         ";B$(M);" ";J:PRINT
  73. 1280 PRINT"--------------------------------------"
  74. 1290 GOSUB 3620:REM PRINTEN
  75. 1300 PRINT
  76. 1310 PRINT"--------------------------------------"
  77. 1320 PRINT:PRINT A$;" ";B$:PRINT
  78. 1330 GOSUB 4200:REM KEUZE
  79. 1340 GOTO 1080
  80. 1350 :
  81. 2000 REM **BEPALING QUOTIENT +
  82. 2010 REM **REST VAN DE BREUK
  83. 2020 REM 
  84. 2030 Q=INT(T/N):R=T-Q*N:RETURN
  85. 2040 :
  86. 2100 REM **KERSTDAGEN
  87. 2110 REM 
  88. 2120 A$="K = Kerstmis"
  89. 2130 A$(25)=":K"
  90. 2140 A$(26)=":K"
  91. 2150 T=24-Y:N=7:GOSUB 2030
  92. 2160 K(Q)=1:T=25-Y:GOSUB 2030
  93. 2170 K(Q)=1
  94. 2180 RETURN
  95. 2190 :
  96. 2300 REM **SCHRIKKELJAAR ?
  97. 2310 REM 
  98. 2320 S=0:T=J:N=4:GOSUB 2030
  99. 2330 IF R<>0 THEN 2390
  100. 2340 S=1:N=100:GOSUB 2030
  101. 2350 IF R<>0 THEN 2390
  102. 2360 S=0:N=400:GOSUB 2030
  103. 2370 IF R<>0 THEN 2390
  104. 2380 S=1
  105. 2390 RETURN
  106. 2400 :
  107. 2500 REM **PAASDATUM ?
  108. 2510 REM 
  109. 2520 T=J:N=19:GOSUB 2030
  110. 2530 A=R:T=J:N=100:GOSUB 2030
  111. 2540 B=Q:C=R:T=B:N=4:GOSUB 2030
  112. 2550 D=Q:E=R:T=B+8:GOSUB 2030
  113. 2560 F=Q:T=B-F+1:N=3:GOSUB 2030
  114. 2570 G=Q:T=19*A+B-D-G+15:N=30:GOSUB 2030
  115. 2580 H=R:T=C:N=4:GOSUB 2030
  116. 2590 I=Q:K=R:T=32+E+E+I+I-H-K:N=7:GOSUB 2030
  117. 2600 L=R:T=A+11*H+22*L:N=451:GOSUB 2030
  118. 2610 O=Q:T=H+L-7*O+114:N=31:GOSUB 2030
  119. 2620 MA=Q:DA=R+1:RETURN
  120. 2630 :
  121. 2700 REM **BEPALING CARNAVAL-,
  122. 2710 REM **PAAS-, HEMELVAART-
  123. 2720 REM **OF PINKSTERDAG IN DE
  124. 2730 REM **AF TE DRUKKEN MAAND
  125. 2750 REM 
  126. 2760 C(4)=59+S+DA+(MA-3)*31
  127. 2770 C(1)=C(4)-49:C(2)=C(4)-48
  128. 2780 C(3)=C(4)-47:C(5)=C(4)+1
  129. 2790 C(6)=C(4)+39:C(7)=C(4)+49
  130. 2800 C(8)=C(4)+50
  131. 2810 FOR T=1 TO 3:X=C(T)-DB
  132. 2820 IF X<1 THEN 2860
  133. 2830 IF X>M(M)THEN 2860
  134. 2840 A$(X)=":C"
  135. 2850 A$="C = Carnaval"
  136. 2860 NEXT T
  137. 2870 FOR T=4 TO 5:X=C(T)-DB
  138. 2880 IF X<1 THEN 2920
  139. 2890 IF X>M(M)THEN 2920
  140. 2900 A$(X)=":P"
  141. 2910 A$="P = Pasen"
  142. 2920 NEXT T
  143. 2930 X=C(6)-DB
  144. 2940 IF X<1 THEN 2980
  145. 2950 IF X>M(M)THEN 2980
  146. 2960 A$(X)=":H"
  147. 2970 A$="H = Hemelvaart"
  148. 2980 FOR T=7 TO 8
  149. 2990 X=C(T)-DB
  150. 3000 IF X<1 THEN 3040
  151. 3010 IF X>M(M)THEN 3040
  152. 3020 A$(X)=":P"
  153. 3030 B$="P = Pinksteren"
  154. 3040 NEXT T
  155. 3050 :
  156. 3100 REM *FEESTDAG IN KOLOM?
  157. 3110 REM 
  158. 3120 FOR X=1 TO M(M)
  159. 3130 IF A$(X)="  "THEN 3160
  160. 3140 T=X-Y-1:N=7:GOSUB 2030
  161. 3150 K(Q)=1
  162. 3160 NEXT X:RETURN
  163. 3170 :
  164. 3200 REM **SUBR.UITLEG
  165. 3210 REM 
  166. 3220 PRINT"****************************"
  167. 3230 PRINT"*                          *"
  168. 3240 PRINT"*         KALENDER         *"
  169. 3250 PRINT"*                          *"
  170. 3260 PRINT"****************************"
  171. 3270 PRINT
  172. 3280 PRINT:PRINT"Dit programma geeft steeds"
  173. 3290 PRINT:PRINT"per maand een kalenderblad."
  174. 3300 PRINT:PRINT"Carnaval, Pasen, Hemelvaart,"
  175. 3310 PRINT:PRINT"Pinksteren en Kerstmis wor-"
  176. 3320 PRINT:PRINT"den hierbij aangegeven."
  177. 3330 PRINT
  178. 3340 PRINT
  179. 3350 GOSUB 4920
  180. 3360 GOSUB 100:REM *WISSEN
  181. 3370 PRINT"U moet eerst de maand en het"
  182. 3380 PRINT:PRINT"jaar opgeven."
  183. 3390 PRINT:PRINT"Daarna kunt U een volgende"
  184. 3400 PRINT:PRINT"maand kiezen met een enkele"
  185. 3410 PRINT:PRINT"toets, te weten:"
  186. 3420 PRINT
  187. 3430 PRINT:PRINT"'N' als U een nieuwe maand wilt"
  188. 3440 PRINT:PRINT"'T' als U terug wilt (vorige)"
  189. 3450 PRINT:PRINT"'V' als U verder wilt"
  190. 3460 PRINT:PRINT"'S' als U wilt stoppen"
  191. 3470 PRINT
  192. 3480 PRINT
  193. 3490 GOSUB 4920
  194. 3500 RETURN
  195. 3510 :
  196. 3600 REM **PRINTEN
  197. 3610 REM 
  198. 3620 CT=2:CN=0
  199. 3630 FOR A=1 TO 7
  200. 3640 :PRINT:PRINT D$(A)
  201. 3650 NEXT A
  202. 3660 VE=2-2*Y:HO=4
  203. 3670 FOR SR=1 TO M(M)
  204. 3680 VE=VE+2
  205. 3690 IF VE>17 THEN VE=VE-14:HO=HO+6
  206. 3700 GOSUB 110:GOSUB 310:PRINT SR$;A$(SR)
  207. 3710 NEXT SR
  208. 3720 VE=17:HO=0:GOSUB 110
  209. 3730 RETURN
  210. 3740 :
  211. 4000 REM **SUBR. UITLEG(2)
  212. 4010 REM 
  213. 4020 GOSUB 100:REM *WISSEN
  214. 4030 PRINT"Geef maandnummer, jaar"
  215. 4040 PRINT
  216. 4050 PRINT"Dus voor bijv. Mei 1982"
  217. 4060 PRINT
  218. 4070 PRINT"Typt U dan :   5,1982"
  219. 4080 PRINT
  220. 4090 PRINT
  221. 4100 REM *SUBROUTINE DATUM INVOER
  222. 4110 PRINT"Maand, Jaar: ";:INPUT M,J
  223. 4120 M=INT(M):IF M>12 OR M<1 THEN 4260
  224. 4130 J=INT(J)
  225. 4140 IF J>9999 THEN 4310
  226. 4150 IF J<1583 THEN 4350
  227. 4160 RETURN
  228. 4170 :
  229. 4200 PRINT"   N , V , T , S : ";:GOSUB 210
  230. 4210 GOSUB 100
  231. 4220 IF IN$="T"OR IN$="t"THEN 4520
  232. 4230 IF IN$="V"OR IN$="v"THEN 4620
  233. 4240 IF IN$="S"OR IN$="s"THEN 4720
  234. 4250 IF IN$="N"OR IN$="n"THEN 4020
  235. 4260 PRINT
  236. 4270 PRINT"FOUTIEVE INVOER !!!!!!"
  237. 4280 PRINT:PRINT:PRINT
  238. 4300 GOTO 4030
  239. 4310 PRINT:PRINT"Jaartallen boven 9999 worden"
  240. 4320 PRINT:PRINT"NIET verwerkt !"
  241. 4330 FOR T=1 TO 4000:NEXT T
  242. 4340 GOTO 4020
  243. 4350 PRINT:PRINT"Tot 1582 gold de Juliaanse"
  244. 4360 PRINT:PRINT"kalender. Schrijf het programma"
  245. 4370 PRINT:PRINT"daarvoor maar zelf !"
  246. 4380 FOR T=1 TO 4000:NEXT T
  247. 4390 GOTO 4020
  248. 4400 :
  249. 4500 REM **TERUG
  250. 4510 REM 
  251. 4520 M=M-1
  252. 4530 IF M>0 THEN 4140:REM *INPUT(2)
  253. 4540 M=12
  254. 4550 J=J-1
  255. 4560 GOTO 4140:REM *INPUT(2)
  256. 4570 :
  257. 4600 REM **VOLGENDE
  258. 4610 REM 
  259. 4620 M=M+1
  260. 4630 IF M<13 THEN 4140:REM *INPUT(2)
  261. 4640 M=1
  262. 4650 J=J+1
  263. 4660 GOTO 4140:REM *INPUT(2)
  264. 4670 :
  265. 4700 REM **STOPPEN
  266. 4710 REM 
  267. 4720 GOSUB 100:REM *WISSEN
  268. 4730 PRINT:PRINT"U Koos voor stoppen"
  269. 4740 PRINT:PRINT"Voor opnieuw beginnen 'RUN' intypen"
  270. 4750 Z=1:RETURN
  271. 4760 :
  272. 4900 REM **WACHT OP INPUT
  273. 4910 REM
  274. 4920 PRINT"                     >RETURN";
  275. 4930 GOSUB 210:RETURN
  276. 4940 :
  277. 5000 REM **INITIALISATIES
  278. 5010 REM
  279. 5020 DIM A$(31),B$(12),D$(7),C$(8),M(12),K(5),C(8)
  280. 5030 FOR T=1 TO 12:READ B$(T):NEXT T
  281. 5040 FOR T=1 TO 7:READ D$(T):NEXT T
  282. 5050 FOR T=0 TO 12:READ M(T):NEXT T
  283. 5060 GOTO 1060
  284. 5070 :
  285. 30000 DATA"Januari","Februari","Maart"
  286. 30010 DATA"April","Mei","Juni","Juli"
  287. 30020 DATA"Augustus","September","Oktober"
  288. 30030 DATA"November","December"
  289. 30040 DATA"Zo","Ma","Di"
  290. 30050 DATA"Wo","Do","Vr","Za"
  291. 30060 DATA 28,31,00,31,30,31,30
  292. 30070 DATA   31,31,30,31,30,31
  293. 30080 :
  294. 30090 REM ********************
  295. 30100 REM *                  *
  296. 30110 REM *     KALENDER     *
  297. 30120 REM *                  *
  298. 30130 REM *  INCL.FEESTDAGEN *
  299. 30140 REM *                  *
  300. 30150 REM * MAKER:E. IVENS,  *
  301. 30160 REM *       DOETINCHEM *
  302. 30170 REM *                  *
  303. 30180 REM ********************
  304. 30190 REM
  305. 30200 REM  GEMAAKT OP APPLE II
  306. 30210 REM
  307. 30220 REM  VERSIE: 17-5-1982
  308. 30230 REM
  309. 30240 REM  ZIE VOOR DE BEPALING
  310. 30250 REM  VAN DE PAASDATUM:
  311. 30260 REM  HEMEL EN DAMPKRING,
  312. 30270 REM  APRIL 1973; OF HET
  313. 30280 REM  BOEK VAN J. MEEUS.
  314. 30290 REM
  315. M  VAN DE PAASDATUM:
  316. 30260 REM  HEMEL EN DAMPKRING,
  317. 30270 REM  APRIL 1973; OF HET
  318. 3