home *** CD-ROM | disk | FTP | other *** search
/ Profi Club / Profi_Club_5_1992_-_de.d64 / kalender (.txt) < prev    next >
Commodore BASIC  |  2023-02-26  |  12KB  |  436 lines
  1. 10 rem kalender=2300===========c64
  2. 20 rem (p) commodore disc team
  3. 30 rem ===========================
  4. 40 rem (c) by fwk             v3.5
  5. 50 rem        wiesloch
  6. 60 rem
  7. 70 rem (v) a.m.               v2.0
  8. 80 rem drucker optional
  9. 90 rem (citizen 120-d)
  10. 91 rem ==========================
  11. 92 sys57812"sysmc",8,0:poke780,0
  12. 93 poke781,254:poke782,191:sys65493
  13. 100 rem =========================
  14. 110 gosub4320
  15. 120 printchr$(147);:sysat,11,11:print"bitte warten !";
  16. 130 rem ==========================
  17. 140 rem variable dimensionieren
  18. 150 rem ==========================
  19. 160 dim mo$(12),ta$(7),mc(13),sb(28),gj(7),zs(7),og(7,19)
  20. 170 dim f1$(32),f1(32),f2(32),f3(32),v2(32)
  21. 180 dim h1$(16),h1(16),h3(16):goto920
  22. 190 rem ==========================
  23. 200 rem datazeilen
  24. 210 rem ==========================
  25. 220 rem monatsnamen  = mo$(12)
  26. 230 rem ==========================
  27. 240 data januar,februar,maerz,april,mai,juni
  28. 250 data juli,august,september,oktober,november,dezember
  29. 260 rem ==========================
  30. 270 rem tagesnamen  = ta$(7)
  31. 280 rem ==========================
  32. 290 datasonntag,montag,dienstag,mittwoch
  33. 300 data donnerstag,freitag,samstag
  34. 310 rem ==========================
  35. 320 rem monatskonstante  = mc(13)
  36. 330 rem ==========================
  37. 340 data 0,31,59,90,120,151,181
  38. 350 data 212,243,273,304,334,365
  39. 360 rem ==========================
  40. 370 rem sonntags 'buchstaben'  = sb(28)
  41. 380 rem ==========================
  42. 390 data 76,5,4,3,21,7,6,5,43,2,1,7,65,4
  43. 400 data 3,2,17,6,5,4,32,1,7,6,54,3,2,1
  44. 410 rem ==========================
  45. 420 rem feste sonntagsbuchstaben = fb(5)
  46. 430 rem ==========================
  47. 440 data 3,5,7,3,5
  48. 450 rem ==========================
  49. 460 rem grenzjahre  = gj(7)
  50. 470 rem ==========================
  51. 480 data 15821004,17000101,18000101,19000101,21000101,22000101,1e20
  52. 490 rem ==========================
  53. 500 rem zyklusstart  = zs(7)
  54. 510 rem ==========================
  55. 520 data-9,1567,1691,1787,1883,2091,2187
  56. 530 rem ==========================
  57. 540 rem ostergrenzen  = og(7,19)
  58. 550 rem ==========================
  59. 560 rem og(1)
  60. 570 rem ==========================
  61. 580 data 15,4,23,12,1,20,9,28,17,6
  62. 590 data 25,14,3,22,11,0,19,8,27
  63. 600 rem ==========================
  64. 610 rem og(2)
  65. 620 rem ==========================
  66. 630 data 22,11,0,19,8,27,16,5,24,13
  67. 640 data 2,21,10,28,18,7,26,15,4
  68. 650 rem ==========================
  69. 660 rem og(3+4)
  70. 670 rem ==========================
  71. 680 sysre:data 23,12,1,20,9,28,17,6,25,14
  72. 690 data 3,22,11,0,19,8,27,16,5
  73. 700 rem ==========================
  74. 710 rem og(5+6)
  75. 720 rem ==========================
  76. 730 sysre:data 24,13,2,21,10,28,18,7,26,15
  77. 740 data 4,23,12,1,20,9,27,17,6
  78. 750 rem ==========================
  79. 760 rem og(7)
  80. 770 rem ==========================
  81. 780 data 25,14,3,22,11,0,19,8,27,16
  82. 790 data 5,24,13,2,21,10,28,18,7
  83. 800 rem ==========================
  84. 810 rem daten der festtage
  85. 820 rem ==========================
  86. 830 sysre:data ostern,0,1,3,ostern,1,2,3,karfreitag,-3,6,3
  87. 840 data christi himmelf.,41,5,5,pfingsten,10,1,5
  88. 850 data pfingsten,1,2,5,fronleichnam,10,5,5
  89. 860 data 1,1,neujahr,6,1,hl.drei koenige,1,5,tag der arbeit
  90. 870 data 15,8,mariae himmelf.,3,10,t.d.dtsch.einh.
  91. 880 data 1,11,allerheiligen,25,12,weihnachten,26,12,weihnachten,buss und bettag
  92. 890 rem ==========================
  93. 900 rem data lesen
  94. 910 rem ==========================
  95. 920 for x=1 to 12: read mo$(x): next x
  96. 930 for x=1 to 7: read ta$(x):next x
  97. 940 for x=1 to 13: read mc(x): next x
  98. 950 for x=1 to 28: read sb(x):next x
  99. 960 for x=2 to 6: read fb(x): next x
  100. 970 for x=1 to 7: read gj(x): next x
  101. 980 for x=1 to 7: read zs(x): next x
  102. 990 for x=1 to 7
  103. 1000 if x=4 thengosub680
  104. 1010 if x=6 thengosub730
  105. 1020 for y=1 to 19: read og(x,y): next y
  106. 1030 next x
  107. 1040 rem =========================
  108. 1050 rem textstrings
  109. 1060 rem =========================
  110. 1070 t1$=b4$+b4$+"*** programm kalender ***"+b4$+b3$
  111. 1080 t2$=b6$+"** weiter mit <space> **"+b6$
  112. 1090 t3$=chr$(18)+t2$+chr$(146)
  113. 1100 t4$=b2$+"festtagskalender des jahres"
  114. 1110 t5$="nr. d. wochentages ="
  115. 1120 t6$="tagesdatum"+b5$+b4$+"="
  116. 1130 t7$="nr. d. monats"+b6$+"="
  117. 1140 t8$="jahr"+b$+b5$+"="
  118. 1150 t9$="zusatzeingaben"
  119. 1160 t0$=chr$(145)
  120. 1170 l1$="": for x=1 to 40: l1$=l1$+"-": next x
  121. 1180 l2$="": for x=1 to 46: l2$=l2$+"*": next x
  122. 1190 rem =========================
  123. 1200 rem windowstrings
  124. 1210 rem =========================
  125. 1220 w1$=chr$(18)+t1$+chr$(146)
  126. 1230 w2$=chr$(147)
  127. 1240 w3$=""
  128. 1250 w4$="":w5$=chr$(18)
  129. 1260 w5$=w5$+"bezeichnung(max.16) :"+b2$+"tag"+b4$+"monat [nr]"+chr$(146)
  130. 1270 rem =========================
  131. 1280 rem druckersteuerung
  132. 1290 rem =========================
  133. 1300 rem master reset
  134. 1310 p1$=chr$(27)+"@"
  135. 1320 rem linken rand setzen in spalte 10
  136. 1330 p2$=chr$(27)+chr$(108)+chr$(10)
  137. 1340 rem var. htabs in spalten 20,25,36
  138. 1350 p3$=chr$(27)+"d"+chr$(20)+chr$(25)+chr$(36)+chr$(0)
  139. 1360 rem vertikale vergroesserung ein
  140. 1370 p4$=chr$(27)+chr$(126)+chr$(49)+chr$(49)
  141. 1380 rem vertikale vergroesserung aus
  142. 1390 p5$=chr$(27)+chr$(126)+chr$(49)+chr$(48)
  143. 1400 rem sprung zum naechsten htab
  144. 1410 p6$=chr$(9)
  145. 1420 rem =========================
  146. 1430 rem eroeffnungsgrafik
  147. 1440 rem =========================
  148. 1530 rem =========================
  149. 1540 rem menue
  150. 1550 rem =========================
  151. 1560 printw2$w1$:sysat,5,3:printw3$;
  152. 1570 x=0: y=0: f=0: x1=0: x2=0: x5=0
  153. 1580 print "bitte geben sie die nummer des":sysat,5,4
  154. 1590 print "gewuenschten unterprogramms ein:":sysat,5,6
  155. 1600 print "wochentag = 1":sysat,5,8
  156. 1610 print "tagesdatum= 2":sysat,5,10
  157. 1620 print "monat"b5$"= 3":sysat,5,12
  158. 1630 print "festtage"b2$"= 4":sysat,5,14
  159. 1640 print "end"b6$" = 5"
  160. 1660 getx$:ifx$=""then1660
  161. 1665 onasc(x$)and7gosub 1720,1910,2220,2550,1680
  162. 1670 goto 1560
  163. 1680 print w2$: end
  164. 1690 rem =========================
  165. 1700 rem unterprogramm wochentagsuche
  166. 1710 rem =========================
  167. 1720 printw2$w1$;:sysat,8,3:printw3$;
  168. 1730 print "gesucht: der wochentag"
  169. 1740 sysat,8,5:printw3$;
  170. 1750 print t6$:sysat,8,7:print t7$:sysat,8,9: print t8$
  171. 1760 sysat,30,5:printw3$;
  172. 1770 input t:sysat,30,7:input m:sysat,30,9:input a
  173. 1780 gosub 3820: if f>0 then goto 3950
  174. 1790 gosub 4080
  175. 1800 tt=mc(m)+t
  176. 1810 gosub 4260
  177. 1820 if x5=1 then return
  178. 1830 sysat,8,12:printw3$;
  179. 1840 print "ergebnis:":sysat,8,14
  180. 1850 print ta$(wz);",";tab(19) t;tab(23) mo$(m);tab(32) a
  181. 1860 sysat,2,24:printt3$;:gosub4352
  182. 1870 return
  183. 1880 rem =========================
  184. 1890 rem unterprogramm tagesdatum
  185. 1900 rem =========================
  186. 1910 printw2$w1$;:sysat,0,3:printw3$;
  187. 1920 for x=1 to 7: print left$(ta$(x),2);"=";x: print: next x
  188. 1930 sysat,8,3:printw3$;
  189. 1940 print "gesucht: das tagesdatum"
  190. 1950 sysat,8,5:printw3$;
  191. 1960 print t5$:sysat,8,7:print t7$:sysat,8,9: print t8$
  192. 1970 sysat,30,5:printw3$;
  193. 1980 input wz:sysat,30,7:inputm:sysat,30,9: input a: t=1
  194. 1990 gosub 3820: if f>0 then goto 3950
  195. 2000 gosub 4080
  196. 2010 tz=wz+sz-1: if tz>7 then tz=tz-7
  197. 2020 th=mc(m)+1: th=th-int(th/7)*7: if th=0 then th=7
  198. 2030 if tz<th then tz=tz+7
  199. 2040 th=tz-th+1:x3=1:td(x3)=th:xh=mc(3)
  200. 2050 if x1=2 then mc(3)=mc(3)+1
  201. 2060 ifmc(m)+td(x3)+6>=mc(m+1)then2090
  202. 2070 x3=x3+1: td(x3)=td(x3-1)+7
  203. 2080 goto2060
  204. 2090 mc(3)=xh
  205. 2100 sysat,8,12:printw3$;
  206. 2110 print "ergebnis:": print
  207. 2120 z=1
  208. 2130 forii=ztox3:sysat,8,13+ii
  209. 2140 print ta$(wz);",";tab(19) td(ii);tab(23) mo$(m);tab(32) a:next
  210. 2150 z=ii
  211. 2170 sysat,2,24:printt3$;:goto4352
  212. 2190 rem =========================
  213. 2200 rem unterprogramm monat
  214. 2210 rem =========================
  215. 2220 printw2$w1$;:sysat,0,3:printw3$;
  216. 2230 for x=1 to 7: print left$(ta$(x),2);"=";x: print: next x
  217. 2240 sysat,8,3:printw3$;
  218. 2250 print "gesucht: der monat"
  219. 2260 sysat,8,5:printw3$;
  220. 2270 print t5$:sysat,8,7:printt6$:sysat,8,9:print t8$
  221. 2280 sysat,30,5:printw3$;
  222. 2290 input wz:sysat,30,7:inputt:sysat,30,9:inputa:m=1
  223. 2300 gosub 3820: if f>0 then goto 3950
  224. 2310 gosub 4080
  225. 2320 x3=0
  226. 2330 for m=1 to 12
  227. 2340 if len(str$(x2))>2 and m=2 then xh=mc(3): mc(3)=mc(3)+1
  228. 2350 if len(str$(x2))>2 and m=3 then sz=val(mid$(str$(x2),3,1)): mc(3)=xh
  229. 2360 tz=wz+sz-1: if tz>7 then tz=tz-7
  230. 2370 th=mc(m)+t: if th>mc(m+1) then goto 2400
  231. 2380 th=th-int(th/7)*7:if th=0 then th=7
  232. 2390 if th=tz then x3=x3+1: mh(x3)=m
  233. 2400 next m
  234. 2410 sysat,8,12:printw3$;
  235. 2420 print "ergebnis:": print
  236. 2430 if x3<>0 then goto 2460
  237. 2440 sysat,8,14:print "im jahr";a;"gibt es keinen":sysat,8,15
  238. 2450 print ta$(wz);", den";t;".": goto 2490
  239. 2460 for z=1 to x3:sysat,8,13+z
  240. 2470 print ta$(wz);",";tab(19) t;tab(23) mo$(mh(z));tab(32) a
  241. 2480 next z
  242. 2490 sysat,2,24:printt3$;:gosub4352
  243. 2500 return
  244. 2510 rem =========================
  245. 2520 rem unterprogramm festkalender
  246. 2530 rem gesetzliche feiertage der brd
  247. 2540 rem =========================
  248. 2550 printw2$w1$;:sysat,8,3:printw3$;
  249. 2560 print "gesucht: festkalender":sysat,8,5
  250. 2570 print "rechenzeit ca. 10-45 sec"
  251. 2580 sysat,8,7:printw3$;
  252. 2590 print t8$;:input a:sysat,8,9
  253. 2600 input "zusatzeingaben (j/n)";z1$:sysat,8,11
  254. 2610 print "drucker oder":sysat,8,12
  255. 2620 print "bildschirm"b5$"(d/b)";:inputz2$
  256. 2630 t=1: m=1
  257. 2640 gosub 3820: if f>0 then goto 3950
  258. 2650 x5=1: x=0
  259. 2660 if z1$="n" then goto 2840
  260. 2670 rem :
  261. 2680 rem zusatzeingaben
  262. 2690 rem :
  263. 2700 print w2$;t1$t9$;a:print w5$
  264. 2710 x=x+1
  265. 2720 printb2$;:inputh1$(x)
  266. 2730 print t0$,,: input h1(x)
  267. 2740 print t0$,,,: input h3(x): print
  268. 2750 h1$(x)=left$(h1$(x),16)
  269. 2760 t=h1(x): m=h3(x): gosub 3820
  270. 2770 if f>0 then gosub 3950
  271. 2780 ifx<>16then2790
  272. 2781 print"keine weiteren eingaben moeglich":sysat,2,24:printt3$;:gosub4352:goto2830
  273. 2790 input "weitere eingaben (j/n)";z3$
  274. 2800 if z3$<>"j" then2830
  275. 2810 print t0$b$b$b$chr$(13)t0$t0$l1$;
  276. 2820 goto2710
  277. 2830 z6=x+16
  278. 2840 rem poke 65286,11
  279. 2850 for x=17 to z6
  280. 2860 f1$(x)=h1$(x-16): f1(x)=h1(x-16): f3(x)=h3(x-16)
  281. 2870 t=f1(x): m=f3(x): gosub 3820
  282. 2880 if f=5 then f1(x)=1: f3(x)=3: f=0: t=f1(x): m=f3(x)
  283. 2890 gosub 1790
  284. 2900 f2(x)=wz
  285. 2910 next x
  286. 2920 rem :
  287. 2930 rem bewegliche feste
  288. 2940 rem :
  289. 2950 gosub830: m=3: gosub 4080
  290. 2960 gz=(a+1)-int((a+1)/19)*19
  291. 2970 tt=mc(3)+21+og(x4,gz)
  292. 2980 gosub 4260
  293. 2990 for x6=1 to 7
  294. 3000 read f1$(x6),y,f2(x6),y1
  295. 3010 tt=tt+y: t=tt-mc(y1): m=y1
  296. 3020 if x6=1 then t=8-wz+t
  297. 3030 if t+mc(y1)>mc(y1+1) then m=y1+1: t=t-(mc(y1+1)-mc(y1))
  298. 3040 if x6=1 then tt=t+mc(m)
  299. 3050 f3(x6)=m: f1(x6)=t
  300. 3060 next x6
  301. 3070 rem :
  302. 3080 rem feste feiertage
  303. 3090 rem :
  304. 3100 for x6=8 to 15
  305. 3110 read t,m,f1$(x6)
  306. 3120 f1(x6)=t: f3(x6)=m
  307. 3130 gosub 1790
  308. 3140 f2(x6)=wz
  309. 3150 next x6
  310. 3160 rem :
  311. 3170 rem buss und bettag
  312. 3180 rem :
  313. 3190 x6=16: tt=mc(12)+25: gosub 4260
  314. 3200 if wz=1 then wz=8
  315. 3210 tt=tt-wz-31: t=tt-mc(11)
  316. 3220 read f1$(x6): f1(x6)=t: f2(x6)=4: f3(x6)=11
  317. 3230 rem :
  318. 3240 rem sortieren
  319. 3250 rem :
  320. 3260 if z6<x6 then z6=x6
  321. 3270 for x=1 to z6
  322. 3280 mm$=str$(f3(x)): tt$="0"+mid$(str$(f1(x)),2)
  323. 3290 tt$=right$(tt$,2): v2$=mm$+tt$
  324. 3300 v2(x)=val(v2$)
  325. 3310 next x
  326. 3320 y=0
  327. 3330 for x=1 to (z6-1)
  328. 3340 if v2(x+1)>=v2(x) then goto 3410
  329. 3350 c=f1(x): f1(x)=f1(x+1): f1(x+1)=c
  330. 3360 c=f2(x): f2(x)=f2(x+1): f2(x+1)=c
  331. 3370 c=f3(x): f3(x)=f3(x+1): f3(x+1)=c
  332. 3380 c$=f1$(x): f1$(x)=f1$(x+1): f1$(x+1)=c$
  333. 3390 c=v2(x): v2(x)=v2(x+1): v2(x+1)=c
  334. 3400 y=1
  335. 3410 next x
  336. 3420 if y>0 then goto 3320
  337. 3430 rem poke 65286,27
  338. 3440 if z2$="d" then goto 3610
  339. 3450 rem :
  340. 3460 rem ausgabe bildschirm
  341. 3470 rem :
  342. 3480 print w2$;w1$: print t4$;a: print
  343. 3490 for x=1 to z6
  344. 3500 f3$=mo$(f3(x)): f2$=ta$(f2(x))
  345. 3510 if f1$(x)=f1$(x-1) then goto 3530
  346. 3520 print f1$(x);
  347. 3530 printtab(16)f1(x);tab(20)f3$;tab(29)f2$
  348. 3540 ifnot(x=16andz6>16)then3550
  349. 3541 sysat,2,24:printt3$;:gosub4352:printw2$w1$:printt4$a:print
  350. 3550 next x
  351. 3560 sysat,2,24:printt3$;:gosub4352
  352. 3570 return
  353. 3580 rem :
  354. 3590 rem ausgabe drucker
  355. 3600 rem :
  356. 3610 open1,4,7: cmd1
  357. 3620 print p1$;p2$;p3$;l2$: print
  358. 3630 print p4$;a;p5$: print
  359. 3640 for x=1 to z6
  360. 3650 f3$=mo$(f3(x)): f2$=ta$(f2(x))
  361. 3660 if f1$(x)=f1$(x-1) then goto 3680
  362. 3670 print f1$(x);
  363. 3680 print p6$;f1(x);p6$;f3$;p6$;f2$
  364. 3690 next x
  365. 3700 print: print l2$
  366. 3710 print p1$: print#1: close1
  367. 3720 return
  368. 3730 rem =========================
  369. 3740 rem subroutine trap-resume
  370. 3750 rem =========================
  371. 3760 sysat,8,14:printw3$;
  372. 3770 print "sie haben einen fehler gemacht!"
  373. 3780 sysat,2,24:printt3$;:gosub4352: (NULL) 1560
  374. 3790 rem =========================
  375. 3800 rem subroutine datumspruefung
  376. 3810 rem =========================
  377. 3820 if a=0 then f=1
  378. 3830 if a<0 or a>2299 then f=2
  379. 3840 if t<=0 or t>31 then f=3
  380. 3850 if m<=0 or m>12 then f=5: goto 3910
  381. 3860 if a>=1600 and right$(str$(a),2)="00" and a/400=int(a/400) and m=2 then goto 3890
  382. 3870 if right$(str$(a),2)<>"00" and a/4=int(a/4) and m=2 then goto 3890
  383. 3880 if t>mc(m+1)-mc(m) then f=5
  384. 3890 if t>(mc(m+1)-mc(m)+1) then f=3
  385. 3900 if a=1582 and m=10 and t>4 and t<15 then f=4
  386. 3910 return
  387. 3920 rem =========================
  388. 3930 rem subroutine fehlerangabe
  389. 3940 rem =========================
  390. 3950 sysat,8,14:printw3$;
  391. 3960 on f goto 3970,3980,3990,4000,3990
  392. 3970 print "das jahr 'null' gibt es nicht!": goto 4020
  393. 3980 print "datum nicht im programmbereich!": goto 4020
  394. 3990 print "dieses datum gibt es nicht!": goto 4020
  395. 4000 print "kalenderumstellung -": print
  396. 4010 print "dieses datum gibt es nicht!"
  397. 4020 sysat,2,24:printt3$;:gosub4352: f=0
  398. 4030 if x5=1 then print w2$;w1$;t9$;a: print w5$: x=x-1: f=0: return
  399. 4040 goto 1560
  400. 4050 rem =========================
  401. 4060 rem subroutine sonntags'buchstabe'
  402. 4070 rem =========================
  403. 4080 mm$="0"+mid$(str$(m),2)
  404. 4090 tt$="0"+mid$(str$(t),2)
  405. 4100 v1$=str$(a)+right$(mm$,2)+right$(tt$,2)
  406. 4110 x4=0
  407. 4120 x4=x4+1
  408. 4130 if val(v1$)<gj(x4) then4160
  409. 4140 if a<>1582 and a=val(left$(str$(gj(x4)),5))then sz=fb(x4):x4=x4+1:return
  410. 4150 goto4120
  411. 4160 r=a-zs(x4)
  412. 4170 sz=r-int(r/28)*28
  413. 4180 if sz=0 then sz=28
  414. 4190 sz=sb(sz): x2=sz: if len(str$(sz))<=2 then goto 4220
  415. 4200 x1=3:ifm<3thenx1=2
  416. 4210 sz=val(mid$(str$(sz),x1,1))
  417. 4220 return
  418. 4230 rem =========================
  419. 4240 rem subroutine tages'buchstabe'
  420. 4250 rem =========================
  421. 4260 tz=tt-int(tt/7)*7
  422. 4270 if tz=0 then tz=7
  423. 4280 wz=tz:if tz<sz then wz=tz+7
  424. 4290 wz=wz-sz+1
  425. 4300 return
  426. 4310 rem nachspann================
  427. 4320 b$=chr$(32):b2$=b$+b$
  428. 4330 b3$=b2$+b$:b4$=b3$+b$
  429. 4340 b5$=b4$+b$:b6$=b5$+b$
  430. 4350 b$=b5$+b5$:at=49152:re=49510:return
  431. 4351 rem ----------
  432. 4352 getx$:ifx$=""then4352
  433. 4353 return
  434. 4360 rem kalender 2300 =======ende
  435. 4370 rem =========================
  436.