'***************
'* WOCHTAG.BAS *
'***************
'
' Dim
DIM Pp(3)
'
cls
' Titel
BOX 1,1,8,40,1
locate 2,11:PRINT "Wochentag-Berechnung"
locate 3,10:PRINT "----------------------"
10 locate 4,12:PRINT "Datum"
locate 5,12:PRINT "Format: TT.MM.JJJJ"
locate 7,3:print "Datum vom 15.10.1582 bis 31.12.4099"
'
' Datum-Eingabe
20 Datum$=""
locate 4,18:PRINT "                    "
locate 4,18:INPUT Datum$
'
' Eingabe-Auswertung
30 Ldatum=0
Ldatum=LEN(Datum$)
IF Ldatum=0 OR Datum$="" THEN Datum$=MID$(DATE$,4,2)+"."+MID$(DATE$,1,2)+"."+mid$(DATE$,7,4):GOTO 30
IF Ldatum>10 THEN  Ff=0:GOTO 140
IF Ldatum<3 THEN  Ff=9:GOTO 140
FOR Tt=0 TO 3:Pp(Tt)=0:NEXT Tt:Pt=0
FOR Tt=1 TO Ldatum
Ttas=ASC(MID$(Datum$,Tt,1))
IF Ttas=46 THEN Pt=Pt+1:IF Pt<3 THEN  Pp(Pt)=Tt:GOTO 40 ELSE Ff=1:GOTO 140
IF Ttas>57 OR Ttas<48 THEN  Ff=2:GOTO 140
40 NEXT Tt
IF Pp(1)=0 OR Pp(1)=Ldatum THEN  Ff=1:GOTO 140
IF Pp(1)>3 OR (Pp(2)=0 AND (Ldatum-Pp(1)<1 OR Ldatum-Pp(1)>2)) OR (Pp(2)>0 AND (Pp(2)-Pp(1)<2 OR Pp(2)-Pp(1)>3)) THEN Ff=1:GOTO 140
IF Pp(2)=Ldatum THEN  Datum$=Datum$+mid$(DATE$,7,4):GOTO 30
IF Pp(2)=0 THEN  Datum$=Datum$+"."+mid$(DATE$,7,4):GOTO 30
Ldapp=Ldatum-Pp(2)
IF Ldapp=1 THEN  Datum$=LEFT$(Datum$,Pp(2))+"190"+RIGHT$(Datum$,1):GOTO 30
IF Ldapp=2 THEN  Datum$=LEFT$(Datum$,Pp(2))+"19"+RIGHT$(Datum$,2):GOTO 30
IF Ldapp=3 OR Ldapp>4 THEN  Ff=1:GOTO 140
'
' Variabeln
Tag=VAL(LEFT$(Datum$,Pp(1)-1))
Mon=VAL(MID$(Datum$,Pp(1)+1,Pp(2)-Pp(1)-1))
Jahr=VAL(RIGHT$(Datum$,2))
Jhun=VAL(MID$(Datum$,Pp(2)+1,2))
'
' Schaltjahr?
Schalt=0:jahrs=jahr:jhuns=jhun
if jahr=0 then
50 if jhuns>4 then jhuns=jhuns-4:goto 50
if jhuns<4 then schalt=1
else
60 if jahr>4 then jahrs=jahrs-4:goto 60
if jahrs<4 then schalt=1
endif
'
' EingabegrӇen
IF Jhun>40 THEN  Ff=3:GOTO 140
IF Jhun<15 OR (Jhun=15 AND Jahr<82) OR (Jhun=15 AND Jahr=82 AND Mon<10) THEN  Ff=4:GOTO 140
IF Jhun=15 AND Jahr=82 AND Mon=10 AND Tag<15 THEN  Ff=4:GOTO 140
IF Mon<1 THEN  Ff=5:GOTO 140
IF Mon>12 THEN  Ff=6:GOTO 140
IF Tag<1 THEN  Ff=7:GOTO 140
IF (Mon=1 OR Mon=3 OR Mon=5 OR Mon=7 OR Mon=8 OR Mon=10 OR Mon=12) AND Tag>31 THEN  Ff=8:GOTO 140
IF (Mon=4 OR Mon=6 OR Mon=9 OR Mon=11) AND Tag>30 THEN  Ff=8:GOTO 140
IF Mon=2 AND ((Schalt=0 AND Tag>28) OR (Schalt=1 AND Tag>29)) THEN  Ff=8:GOTO 140
'
' Jahrhundertzahl
RESTORE 200
T1=0
FOR T1=1 TO 4
READ Anza,Add
T2=0
FOR T2=1 TO Anza
READ Jhunza
IF Jhunza=Jhun THEN  Jhunadd=Add
NEXT T2
NEXT T1
'
' Jahrzahl
RESTORE 300
T3=0
FOR T3=0 TO 6
READ Anza,Jahrv
T4=0
FOR T4=1 TO Anza
READ Jahrza
IF Jahrza=Jahr THEN  Jahradd=Jahrv
NEXT T4
NEXT T3
'
' Tagzahl
Tagz=Tag
90 IF Tagz>7 THEN  Tagz=Tagz-7:GOTO 90
'
' Monatzahl
IF Mon=8 OR (Schalt=1 AND Mon=2) THEN  Monz=0
IF Mon=3 OR Mon=11 OR (Schalt=0 AND Mon=2) THEN  Monz=1
IF Mon=6 THEN  Monz=2
IF Mon=9 OR Mon=12 THEN  Monz=3
IF Mon=4 OR Mon=7 OR (Schalt=1 AND Mon=1) THEN  Monz=4
IF Mon=10 OR (Schalt=0 AND Mon=1) THEN  Monz=5
IF Mon=5 THEN  Monz=6
'
' Zahl-Berechnung
Zahl=2+Jhunadd+Jahradd+Monz+Tagz
100 IF Zahl>7 THEN  Zahl=Zahl-7:GOTO 100
'
' Wochnetag$
RESTORE 400
T5=0
FOR T5=1 TO Zahl
READ Wochtag$
NEXT T5
'
' Ausgabe
GOSUB 130
Datum$=""
RESTORE 500
FOR Tta=1 TO Mon
READ Mona$
NEXT Tta
Datum$=STR$(Tag)+"."+Mona$+"."+STR$(Jhun)+STR$(Jahr)
locate 4,9:PRINT "Wochentag am ";Datum$;":"
locate 5,15:PRINT Wochtag$
locate 7,12:PRINT "Noch einmal (J/N)?"
110 Tast=ASC(INKEY$)
IF Tast=74 OR Tast=106 OR Tast=13 THEN  GOTO 120
IF Tast=78 OR Tast=110 OR Tast=27 THEN  END ELSE  GOTO 110
120 GOSUB 130
GOTO 10
'
' Bildschirm L”schen
130 locate 4,2:PRINT "                                      "
locate 5,2:PRINT "                                      "
locate 7,2:PRINT "                                      "
RETURN 
'
' Fehlermeldung
140 RESTORE 600
FOR Tfe=0 TO Ff
READ Ff$
NEXT Tfe
locate 5,11:PRINT "                           "
locate 5,5:PRINT Ff$
150 Fff$=INKEY$
if fff$="" then goto 150
locate 5,2:PRINT "          Format: TT.MM.JJJJ         "
GOTO 20
'
' Data-Werte
200 DATA 7,0,16,20,24,28,32,36,40
210 DATA 7,1,15,19,23,27,31,35,39
220 DATA 6,3,18,22,26,30,34,38
230 DATA 6,5,17,21,25,29,33,37
'
300 DATA 14,0,0,6,17,23,28,34,45,51,56,62,73,79,84,90
310 DATA 15,1,1,7,12,18,29,35,40,46,57,63,68,74,85,91,96
320 DATA 14,2,2,13,19,24,30,41,47,52,58,69,75,80,86,97
330 DATA 15,3,3,8,14,25,31,36,42,53,59,64,70,81,87,92,98
340 DATA 14,4,9,15,20,26,37,43,48,54,65,71,76,82,93,99
350 DATA 14,5,4,10,21,27,32,38,49,55,60,66,77,83,88,94
360 DATA 14,6,5,11,16,22,33,39,44,50,61,67,72,78,89,95
'
400 DATA "  Sonntag","  Montag"," Dienstag"
410 DATA " Mittwoch","Donnerstag","  Freitag"
420 DATA "  Samstag"
'
500 DATA "Jan","Feb","M„r","Apr","Mai","Jun"
510 DATA "Jul","Aug","Sep","Okt","Nov","Dez"
'
600 DATA "    Fehler! Eingabe zu lang!"
610 DATA "     Fehler! Eingabe-Fehler!"
620 DATA "   Fehler! Falsche(s) Zeichen!"
630 DATA "Fehler! Auáerhalb des Bereiches!"
640 DATA "Fehler! Unterhalb des Bereiches!"
650 DATA "     Fehler! Monat zu klein!"
660 DATA "     Fehler! Monat zu groá!"
670 DATA "      Fehler! Tag zu klein!"
680 DATA "      Fehler! Tag zu groá!"
690 DATA "    Fehler! Eingabe zu kurz!"
END