10 REM KALENDER=2300===========C64
20 REM (P) COMMODORE DISC TEAM
30 REM ===========================
40 REM (C) BY FWK             V3.5
50 REM        WIESLOCH
60 REM
70 REM (V) A.M.               V2.0
80 REM DRUCKER OPTIONAL
90 REM (CITIZEN 120-D)
91 REM ==========================
92 SYS57812"SYSMC",8,0:POKE780,0
93 POKE781,254:POKE782,191:SYS65493
100 REM =========================
110 GOSUB4320
120 PRINTCHR$(147);:SYSAT,11,11:PRINT"BITTE WARTEN !";
130 REM ==========================
140 REM VARIABLE DIMENSIONIEREN
150 REM ==========================
160 DIM MO$(12),TA$(7),MC(13),SB(28),GJ(7),ZS(7),OG(7,19)
170 DIM F1$(32),F1(32),F2(32),F3(32),V2(32)
180 DIM H1$(16),H1(16),H3(16):GOTO920
190 REM ==========================
200 REM DATAZEILEN
210 REM ==========================
220 REM MONATSNAMEN  = MO$(12)
230 REM ==========================
240 DATA JANUAR,FEBRUAR,MAERZ,APRIL,MAI,JUNI
250 DATA JULI,AUGUST,SEPTEMBER,OKTOBER,NOVEMBER,DEZEMBER
260 REM ==========================
270 REM TAGESNAMEN  = TA$(7)
280 REM ==========================
290 DATASONNTAG,MONTAG,DIENSTAG,MITTWOCH
300 DATA DONNERSTAG,FREITAG,SAMSTAG
310 REM ==========================
320 REM MONATSKONSTANTE  = MC(13)
330 REM ==========================
340 DATA 0,31,59,90,120,151,181
350 DATA 212,243,273,304,334,365
360 REM ==========================
370 REM SONNTAGS 'BUCHSTABEN'  = SB(28)
380 REM ==========================
390 DATA 76,5,4,3,21,7,6,5,43,2,1,7,65,4
400 DATA 3,2,17,6,5,4,32,1,7,6,54,3,2,1
410 REM ==========================
420 REM FESTE SONNTAGSBUCHSTABEN = FB(5)
430 REM ==========================
440 DATA 3,5,7,3,5
450 REM ==========================
460 REM GRENZJAHRE  = GJ(7)
470 REM ==========================
480 DATA 15821004,17000101,18000101,19000101,21000101,22000101,1E20
490 REM ==========================
500 REM ZYKLUSSTART  = ZS(7)
510 REM ==========================
520 DATA-9,1567,1691,1787,1883,2091,2187
530 REM ==========================
540 REM OSTERGRENZEN  = OG(7,19)
550 REM ==========================
560 REM OG(1)
570 REM ==========================
580 DATA 15,4,23,12,1,20,9,28,17,6
590 DATA 25,14,3,22,11,0,19,8,27
600 REM ==========================
610 REM OG(2)
620 REM ==========================
630 DATA 22,11,0,19,8,27,16,5,24,13
640 DATA 2,21,10,28,18,7,26,15,4
650 REM ==========================
660 REM OG(3+4)
670 REM ==========================
680 SYSRE:DATA 23,12,1,20,9,28,17,6,25,14
690 DATA 3,22,11,0,19,8,27,16,5
700 REM ==========================
710 REM OG(5+6)
720 REM ==========================
730 SYSRE:DATA 24,13,2,21,10,28,18,7,26,15
740 DATA 4,23,12,1,20,9,27,17,6
750 REM ==========================
760 REM OG(7)
770 REM ==========================
780 DATA 25,14,3,22,11,0,19,8,27,16
790 DATA 5,24,13,2,21,10,28,18,7
800 REM ==========================
810 REM DATEN DER FESTTAGE
820 REM ==========================
830 SYSRE:DATA OSTERN,0,1,3,OSTERN,1,2,3,KARFREITAG,-3,6,3
840 DATA CHRISTI HIMMELF.,41,5,5,PFINGSTEN,10,1,5
850 DATA PFINGSTEN,1,2,5,FRONLEICHNAM,10,5,5
860 DATA 1,1,NEUJAHR,6,1,HL.DREI KOENIGE,1,5,TAG DER ARBEIT
870 DATA 15,8,MARIAE HIMMELF.,3,10,T.D.DTSCH.EINH.
880 DATA 1,11,ALLERHEILIGEN,25,12,WEIHNACHTEN,26,12,WEIHNACHTEN,BUSS UND BETTAG
890 REM ==========================
900 REM DATA LESEN
910 REM ==========================
920 FOR X=1 TO 12: READ MO$(X): NEXT X
930 FOR X=1 TO 7: READ TA$(X):NEXT X
940 FOR X=1 TO 13: READ MC(X): NEXT X
950 FOR X=1 TO 28: READ SB(X):NEXT X
960 FOR X=2 TO 6: READ FB(X): NEXT X
970 FOR X=1 TO 7: READ GJ(X): NEXT X
980 FOR X=1 TO 7: READ ZS(X): NEXT X
990 FOR X=1 TO 7
1000 IF X=4 THENGOSUB680
1010 IF X=6 THENGOSUB730
1020 FOR Y=1 TO 19: READ OG(X,Y): NEXT Y
1030 NEXT X
1040 REM =========================
1050 REM TEXTSTRINGS
1060 REM =========================
1070 T1$=B4$+B4$+"*** PROGRAMM KALENDER ***"+B4$+B3$
1080 T2$=B6$+"** WEITER MIT <SPACE> **"+B6$
1090 T3$=CHR$(18)+T2$+CHR$(146)
1100 T4$=B2$+"FESTTAGSKALENDER DES JAHRES"
1110 T5$="NR. D. WOCHENTAGES ="
1120 T6$="TAGESDATUM"+B5$+B4$+"="
1130 T7$="NR. D. MONATS"+B6$+"="
1140 T8$="JAHR"+B$+B5$+"="
1150 T9$="ZUSATZEINGABEN"
1160 T0$=CHR$(145)
1170 L1$="": FOR X=1 TO 40: L1$=L1$+"-": NEXT X
1180 L2$="": FOR X=1 TO 46: L2$=L2$+"*": NEXT X
1190 REM =========================
1200 REM WINDOWSTRINGS
1210 REM =========================
1220 W1$=CHR$(18)+T1$+CHR$(146)
1230 W2$=CHR$(147)
1240 W3$=""
1250 W4$="":W5$=CHR$(18)
1260 W5$=W5$+"BEZEICHNUNG(MAX.16) :"+B2$+"TAG"+B4$+"MONAT [NR]"+CHR$(146)
1270 REM =========================
1280 REM DRUCKERSTEUERUNG
1290 REM =========================
1300 REM MASTER RESET
1310 P1$=CHR$(27)+"@"
1320 REM LINKEN RAND SETZEN IN SPALTE 10
1330 P2$=CHR$(27)+CHR$(108)+CHR$(10)
1340 REM VAR. HTABS IN SPALTEN 20,25,36
1350 P3$=CHR$(27)+"D"+CHR$(20)+CHR$(25)+CHR$(36)+CHR$(0)
1360 REM VERTIKALE VERGROESSERUNG EIN
1370 P4$=CHR$(27)+CHR$(126)+CHR$(49)+CHR$(49)
1380 REM VERTIKALE VERGROESSERUNG AUS
1390 P5$=CHR$(27)+CHR$(126)+CHR$(49)+CHR$(48)
1400 REM SPRUNG ZUM NAECHSTEN HTAB
1410 P6$=CHR$(9)
1420 REM =========================
1430 REM EROEFFNUNGSGRAFIK
1440 REM =========================
1530 REM =========================
1540 REM MENUE
1550 REM =========================
1560 PRINTW2$W1$:SYSAT,5,3:PRINTW3$;
1570 X=0: Y=0: F=0: X1=0: X2=0: X5=0
1580 PRINT "BITTE GEBEN SIE DIE NUMMER DES":SYSAT,5,4
1590 PRINT "GEWUENSCHTEN UNTERPROGRAMMS EIN:":SYSAT,5,6
1600 PRINT "WOCHENTAG = 1":SYSAT,5,8
1610 PRINT "TAGESDATUM= 2":SYSAT,5,10
1620 PRINT "MONAT"B5$"= 3":SYSAT,5,12
1630 PRINT "FESTTAGE"B2$"= 4":SYSAT,5,14
1640 PRINT "END"B6$" = 5"
1660 GETX$:IFX$=""THEN1660
1665 ONASC(X$)AND7GOSUB 1720,1910,2220,2550,1680
1670 GOTO 1560
1680 PRINT W2$: END
1690 REM =========================
1700 REM UNTERPROGRAMM WOCHENTAGSUCHE
1710 REM =========================
1720 PRINTW2$W1$;:SYSAT,8,3:PRINTW3$;
1730 PRINT "GESUCHT: DER WOCHENTAG"
1740 SYSAT,8,5:PRINTW3$;
1750 PRINT T6$:SYSAT,8,7:PRINT T7$:SYSAT,8,9: PRINT T8$
1760 SYSAT,30,5:PRINTW3$;
1770 INPUT T:SYSAT,30,7:INPUT M:SYSAT,30,9:INPUT A
1780 GOSUB 3820: IF F>0 THEN GOTO 3950
1790 GOSUB 4080
1800 TT=MC(M)+T
1810 GOSUB 4260
1820 IF X5=1 THEN RETURN
1830 SYSAT,8,12:PRINTW3$;
1840 PRINT "ERGEBNIS:":SYSAT,8,14
1850 PRINT TA$(WZ);",";TAB(19) T;TAB(23) MO$(M);TAB(32) A
1860 SYSAT,2,24:PRINTT3$;:GOSUB4352
1870 RETURN
1880 REM =========================
1890 REM UNTERPROGRAMM TAGESDATUM
1900 REM =========================
1910 PRINTW2$W1$;:SYSAT,0,3:PRINTW3$;
1920 FOR X=1 TO 7: PRINT LEFT$(TA$(X),2);"=";X: PRINT: NEXT X
1930 SYSAT,8,3:PRINTW3$;
1940 PRINT "GESUCHT: DAS TAGESDATUM"
1950 SYSAT,8,5:PRINTW3$;
1960 PRINT T5$:SYSAT,8,7:PRINT T7$:SYSAT,8,9: PRINT T8$
1970 SYSAT,30,5:PRINTW3$;
1980 INPUT WZ:SYSAT,30,7:INPUTM:SYSAT,30,9: INPUT A: T=1
1990 GOSUB 3820: IF F>0 THEN GOTO 3950
2000 GOSUB 4080
2010 TZ=WZ+SZ-1: IF TZ>7 THEN TZ=TZ-7
2020 TH=MC(M)+1: TH=TH-INT(TH/7)*7: IF TH=0 THEN TH=7
2030 IF TZ<TH THEN TZ=TZ+7
2040 TH=TZ-TH+1:X3=1:TD(X3)=TH:XH=MC(3)
2050 IF X1=2 THEN MC(3)=MC(3)+1
2060 IFMC(M)+TD(X3)+6>=MC(M+1)THEN2090
2070 X3=X3+1: TD(X3)=TD(X3-1)+7
2080 GOTO2060
2090 MC(3)=XH
2100 SYSAT,8,12:PRINTW3$;
2110 PRINT "ERGEBNIS:": PRINT
2120 Z=1
2130 FORII=ZTOX3:SYSAT,8,13+II
2140 PRINT TA$(WZ);",";TAB(19) TD(II);TAB(23) MO$(M);TAB(32) A:NEXT
2150 Z=II
2170 SYSAT,2,24:PRINTT3$;:GOTO4352
2190 REM =========================
2200 REM UNTERPROGRAMM MONAT
2210 REM =========================
2220 PRINTW2$W1$;:SYSAT,0,3:PRINTW3$;
2230 FOR X=1 TO 7: PRINT LEFT$(TA$(X),2);"=";X: PRINT: NEXT X
2240 SYSAT,8,3:PRINTW3$;
2250 PRINT "GESUCHT: DER MONAT"
2260 SYSAT,8,5:PRINTW3$;
2270 PRINT T5$:SYSAT,8,7:PRINTT6$:SYSAT,8,9:PRINT T8$
2280 SYSAT,30,5:PRINTW3$;
2290 INPUT WZ:SYSAT,30,7:INPUTT:SYSAT,30,9:INPUTA:M=1
2300 GOSUB 3820: IF F>0 THEN GOTO 3950
2310 GOSUB 4080
2320 X3=0
2330 FOR M=1 TO 12
2340 IF LEN(STR$(X2))>2 AND M=2 THEN XH=MC(3): MC(3)=MC(3)+1
2350 IF LEN(STR$(X2))>2 AND M=3 THEN SZ=VAL(MID$(STR$(X2),3,1)): MC(3)=XH
2360 TZ=WZ+SZ-1: IF TZ>7 THEN TZ=TZ-7
2370 TH=MC(M)+T: IF TH>MC(M+1) THEN GOTO 2400
2380 TH=TH-INT(TH/7)*7:IF TH=0 THEN TH=7
2390 IF TH=TZ THEN X3=X3+1: MH(X3)=M
2400 NEXT M
2410 SYSAT,8,12:PRINTW3$;
2420 PRINT "ERGEBNIS:": PRINT
2430 IF X3<>0 THEN GOTO 2460
2440 SYSAT,8,14:PRINT "IM JAHR";A;"GIBT ES KEINEN":SYSAT,8,15
2450 PRINT TA$(WZ);", DEN";T;".": GOTO 2490
2460 FOR Z=1 TO X3:SYSAT,8,13+Z
2470 PRINT TA$(WZ);",";TAB(19) T;TAB(23) MO$(MH(Z));TAB(32) A
2480 NEXT Z
2490 SYSAT,2,24:PRINTT3$;:GOSUB4352
2500 RETURN
2510 REM =========================
2520 REM UNTERPROGRAMM FESTKALENDER
2530 REM GESETZLICHE FEIERTAGE DER BRD
2540 REM =========================
2550 PRINTW2$W1$;:SYSAT,8,3:PRINTW3$;
2560 PRINT "GESUCHT: FESTKALENDER":SYSAT,8,5
2570 PRINT "RECHENZEIT CA. 10-45 SEC"
2580 SYSAT,8,7:PRINTW3$;
2590 PRINT T8$;:INPUT A:SYSAT,8,9
2600 INPUT "ZUSATZEINGABEN (J/N)";Z1$:SYSAT,8,11
2610 PRINT "DRUCKER ODER":SYSAT,8,12
2620 PRINT "BILDSCHIRM"B5$"(D/B)";:INPUTZ2$
2630 T=1: M=1
2640 GOSUB 3820: IF F>0 THEN GOTO 3950
2650 X5=1: X=0
2660 IF Z1$="N" THEN GOTO 2840
2670 REM :
2680 REM ZUSATZEINGABEN
2690 REM :
2700 PRINT W2$;T1$T9$;A:PRINT W5$
2710 X=X+1
2720 PRINTB2$;:INPUTH1$(X)
2730 PRINT T0$,,: INPUT H1(X)
2740 PRINT T0$,,,: INPUT H3(X): PRINT
2750 H1$(X)=LEFT$(H1$(X),16)
2760 T=H1(X): M=H3(X): GOSUB 3820
2770 IF F>0 THEN GOSUB 3950
2780 IFX<>16THEN2790
2781 PRINT"KEINE WEITEREN EINGABEN MOEGLICH":SYSAT,2,24:PRINTT3$;:GOSUB4352:GOTO2830
2790 INPUT "WEITERE EINGABEN (J/N)";Z3$
2800 IF Z3$<>"J" THEN2830
2810 PRINT T0$B$B$B$CHR$(13)T0$T0$L1$;
2820 GOTO2710
2830 Z6=X+16
2840 REM POKE 65286,11
2850 FOR X=17 TO Z6
2860 F1$(X)=H1$(X-16): F1(X)=H1(X-16): F3(X)=H3(X-16)
2870 T=F1(X): M=F3(X): GOSUB 3820
2880 IF F=5 THEN F1(X)=1: F3(X)=3: F=0: T=F1(X): M=F3(X)
2890 GOSUB 1790
2900 F2(X)=WZ
2910 NEXT X
2920 REM :
2930 REM BEWEGLICHE FESTE
2940 REM :
2950 GOSUB830: M=3: GOSUB 4080
2960 GZ=(A+1)-INT((A+1)/19)*19
2970 TT=MC(3)+21+OG(X4,GZ)
2980 GOSUB 4260
2990 FOR X6=1 TO 7
3000 READ F1$(X6),Y,F2(X6),Y1
3010 TT=TT+Y: T=TT-MC(Y1): M=Y1
3020 IF X6=1 THEN T=8-WZ+T
3030 IF T+MC(Y1)>MC(Y1+1) THEN M=Y1+1: T=T-(MC(Y1+1)-MC(Y1))
3040 IF X6=1 THEN TT=T+MC(M)
3050 F3(X6)=M: F1(X6)=T
3060 NEXT X6
3070 REM :
3080 REM FESTE FEIERTAGE
3090 REM :
3100 FOR X6=8 TO 15
3110 READ T,M,F1$(X6)
3120 F1(X6)=T: F3(X6)=M
3130 GOSUB 1790
3140 F2(X6)=WZ
3150 NEXT X6
3160 REM :
3170 REM BUSS UND BETTAG
3180 REM :
3190 X6=16: TT=MC(12)+25: GOSUB 4260
3200 IF WZ=1 THEN WZ=8
3210 TT=TT-WZ-31: T=TT-MC(11)
3220 READ F1$(X6): F1(X6)=T: F2(X6)=4: F3(X6)=11
3230 REM :
3240 REM SORTIEREN
3250 REM :
3260 IF Z6<X6 THEN Z6=X6
3270 FOR X=1 TO Z6
3280 MM$=STR$(F3(X)): TT$="0"+MID$(STR$(F1(X)),2)
3290 TT$=RIGHT$(TT$,2): V2$=MM$+TT$
3300 V2(X)=VAL(V2$)
3310 NEXT X
3320 Y=0
3330 FOR X=1 TO (Z6-1)
3340 IF V2(X+1)>=V2(X) THEN GOTO 3410
3350 C=F1(X): F1(X)=F1(X+1): F1(X+1)=C
3360 C=F2(X): F2(X)=F2(X+1): F2(X+1)=C
3370 C=F3(X): F3(X)=F3(X+1): F3(X+1)=C
3380 C$=F1$(X): F1$(X)=F1$(X+1): F1$(X+1)=C$
3390 C=V2(X): V2(X)=V2(X+1): V2(X+1)=C
3400 Y=1
3410 NEXT X
3420 IF Y>0 THEN GOTO 3320
3430 REM POKE 65286,27
3440 IF Z2$="D" THEN GOTO 3610
3450 REM :
3460 REM AUSGABE BILDSCHIRM
3470 REM :
3480 PRINT W2$;W1$: PRINT T4$;A: PRINT
3490 FOR X=1 TO Z6
3500 F3$=MO$(F3(X)): F2$=TA$(F2(X))
3510 IF F1$(X)=F1$(X-1) THEN GOTO 3530
3520 PRINT F1$(X);
3530 PRINTTAB(16)F1(X);TAB(20)F3$;TAB(29)F2$
3540 IFNOT(X=16ANDZ6>16)THEN3550
3541 SYSAT,2,24:PRINTT3$;:GOSUB4352:PRINTW2$W1$:PRINTT4$A:PRINT
3550 NEXT X
3560 SYSAT,2,24:PRINTT3$;:GOSUB4352
3570 RETURN
3580 REM :
3590 REM AUSGABE DRUCKER
3600 REM :
3610 OPEN1,4,7: CMD1
3620 PRINT P1$;P2$;P3$;L2$: PRINT
3630 PRINT P4$;A;P5$: PRINT
3640 FOR X=1 TO Z6
3650 F3$=MO$(F3(X)): F2$=TA$(F2(X))
3660 IF F1$(X)=F1$(X-1) THEN GOTO 3680
3670 PRINT F1$(X);
3680 PRINT P6$;F1(X);P6$;F3$;P6$;F2$
3690 NEXT X
3700 PRINT: PRINT L2$
3710 PRINT P1$: PRINT#1: CLOSE1
3720 RETURN
3730 REM =========================
3740 REM SUBROUTINE TRAP-RESUME
3750 REM =========================
3760 SYSAT,8,14:PRINTW3$;
3770 PRINT "SIE HABEN EINEN FEHLER GEMACHT!"
3780 SYSAT,2,24:PRINTT3$;:GOSUB4352: (null) 1560
3790 REM =========================
3800 REM SUBROUTINE DATUMSPRUEFUNG
3810 REM =========================
3820 IF A=0 THEN F=1
3830 IF A<0 OR A>2299 THEN F=2
3840 IF T<=0 OR T>31 THEN F=3
3850 IF M<=0 OR M>12 THEN F=5: GOTO 3910
3860 IF A>=1600 AND RIGHT$(STR$(A),2)="00" AND A/400=INT(A/400) AND M=2 THEN GOTO 3890
3870 IF RIGHT$(STR$(A),2)<>"00" AND A/4=INT(A/4) AND M=2 THEN GOTO 3890
3880 IF T>MC(M+1)-MC(M) THEN F=5
3890 IF T>(MC(M+1)-MC(M)+1) THEN F=3
3900 IF A=1582 AND M=10 AND T>4 AND T<15 THEN F=4
3910 RETURN
3920 REM =========================
3930 REM SUBROUTINE FEHLERANGABE
3940 REM =========================
3950 SYSAT,8,14:PRINTW3$;
3960 ON F GOTO 3970,3980,3990,4000,3990
3970 PRINT "DAS JAHR 'NULL' GIBT ES NICHT!": GOTO 4020
3980 PRINT "DATUM NICHT IM PROGRAMMBEREICH!": GOTO 4020
3990 PRINT "DIESES DATUM GIBT ES NICHT!": GOTO 4020
4000 PRINT "KALENDERUMSTELLUNG -": PRINT
4010 PRINT "DIESES DATUM GIBT ES NICHT!"
4020 SYSAT,2,24:PRINTT3$;:GOSUB4352: F=0
4030 IF X5=1 THEN PRINT W2$;W1$;T9$;A: PRINT W5$: X=X-1: F=0: RETURN
4040 GOTO 1560
4050 REM =========================
4060 REM SUBROUTINE SONNTAGS'BUCHSTABE'
4070 REM =========================
4080 MM$="0"+MID$(STR$(M),2)
4090 TT$="0"+MID$(STR$(T),2)
4100 V1$=STR$(A)+RIGHT$(MM$,2)+RIGHT$(TT$,2)
4110 X4=0
4120 X4=X4+1
4130 IF VAL(V1$)<GJ(X4) THEN4160
4140 IF A<>1582 AND A=VAL(LEFT$(STR$(GJ(X4)),5))THEN SZ=FB(X4):X4=X4+1:RETURN
4150 GOTO4120
4160 R=A-ZS(X4)
4170 SZ=R-INT(R/28)*28
4180 IF SZ=0 THEN SZ=28
4190 SZ=SB(SZ): X2=SZ: IF LEN(STR$(SZ))<=2 THEN GOTO 4220
4200 X1=3:IFM<3THENX1=2
4210 SZ=VAL(MID$(STR$(SZ),X1,1))
4220 RETURN
4230 REM =========================
4240 REM SUBROUTINE TAGES'BUCHSTABE'
4250 REM =========================
4260 TZ=TT-INT(TT/7)*7
4270 IF TZ=0 THEN TZ=7
4280 WZ=TZ:IF TZ<SZ THEN WZ=TZ+7
4290 WZ=WZ-SZ+1
4300 RETURN
4310 REM NACHSPANN================
4320 B$=CHR$(32):B2$=B$+B$
4330 B3$=B2$+B$:B4$=B3$+B$
4340 B5$=B4$+B$:B6$=B5$+B$
4350 B$=B5$+B5$:AT=49152:RE=49510:RETURN
4351 REM ----------
4352 GETX$:IFX$=""THEN4352
4353 RETURN
4360 REM KALENDER 2300 =======ENDE
4370 REM =========================