10 '     HAPPY CALENDAR
20 '
30 '     Martin Geisler
40 '     1989
50 '
60 '---------------------------
70 '
80 '     Hauptmenue
90 '
100 DEFSTR z:DIM rg(20):GOSUB 400:MODE 1
110 LOCATE 10,1:FOR i=1 TO 23:PRINT"*";:NEXT
120 FOR i=2 TO 4:LOCATE 10,i:PRINT"*";SPC(21);"*":NEXT
130 LOCATE 10,5:FOR i=1 TO 23:PRINT"*";:NEXT
140 LOCATE 3,18:PRINT CHR$(150);:FOR i=1 TO 34:PRINT CHR$(154);:NEXT:PRINT CHR$(156)
150 FOR i=19 TO 24:LOCATE 3,i:PRINT CHR$(149);SPC(34);CHR$(149):NEXT
160 LOCATE 3,25:PRINTCHR$(147);:FOR i=1 TO 34:PRINTCHR$(154);:NEXT:PRINTCHR$(153)
170 WINDOW #1,11,31,2,4:WINDOW #2,4,37,19,24:WINDOW #3,6,40,8,15:WINDOW SWAP 0,3
180 CLS:LOCATE #1,6,2:PRINT#1,"HAUPTMENUE"
190 LOCATE #2,2,1:PRINT#2,"Abstand zwischen zwei Daten"TAB(31)"- 1"
200 LOCATE #2,2,2:PRINT#2,"Enddatum einer Tagesdiff."TAB(31)"- 2"
210 LOCATE #2,2,3:PRINT#2,"Wochentag"TAB(31)"- 3"
220 LOCATE #2,2,4:PRINT#2,"Jubilaeumskalender"TAB(31)"- 4"
230 LOCATE #2,2,5:PRINT#2,"Gruppenalter"TAB(31)"- 5"
240 LOCATE #2,2,6:PRINT#2,"Ende"TAB(31)"- 6"
250 CLS:PRINT"Was waehlen Sie bitte?":PRINT:GOSUB 300:n=ASC(z)-48:IF n<1 OR n>6 THEN 250
260 ON n GOTO 850,1020,1210,1320,1830,2070
270 '
280 '     Unterprogramme
290 '
300 z=UPPER$(INKEY$):IF z="" THEN 300
310 RETURN
320 '
330 u=t:v=m:w=j:IF v>2THEN v=v-3:GOTO 350
340 v=v+9:w=w-1
350 r=INT(365.25*w)-INT(w/100)+INT(w/400)+INT(30.6*v+0.5)+u:RETURN
360 '
370 PRINT RIGHT$(STR$(d),LEN(STR$(d))-1);".";:RETURN
380 PRINT#2,RIGHT$(STR$(d),LEN(STR$(d))-1);".";:RETURN
390 '
400 zw(1)="Sonntag":zw(2)="Montag":zw(3)="Dienstag":zw(4)="Mittwoch"
410 zw(5)="Donnerstag":zw(6)="Freitag":zw(0)="Sonnabend"
420 ze(1)="Wochen":ze(2)="Tage":ze(3)="Stunden"
430 ze(4)="Minuten":ze(5)="Sekunden":RETURN
440 '
450 DATA 0,31,59,90,120,151,181,212,243,273,304,334,365
460 RESTORE 450:FOR i=1TO mu:READ k:NEXT:nj=tu+k+dt
470 j=ju:GOSUB 650:IF tu+k>59 THEN nj=nj+s
480 IF s=1 AND tu+k=60 AND tu=29 THEN nj=nj-1
490 RESTORE 450:FOR i=1TO 13:n1=n:READ n
500 IF nj>59 THEN n=n+s
510 IF nj<=n THEN 530
520 NEXT i:nj=nj-n:j=j+1:GOSUB 650:GOTO 490
530 m=i-1:t=nj-n1:IF nj=60 THEN t=t+s
540 RETURN
550 '
560 DATA 31,28,31,30,31,30,31,31,30,31,30,31
570 IF j<1583 OR j>9999 THEN PRINT"Im gregor. Kalender bleiben !":p=1:RETURN
580 IF m<1 OR m>12 THEN 630
590 RESTORE 560:FOR i=1 TO m:READ ml:NEXT:GOSUB 650
600 IF m=2 THEN ml=ml+s
610 IF t<0 OR t>ml THEN 630
620 p=0:RETURN
630 PRINT"Ihr Datum gibt es nicht !":P=1:RETURN
640 '
650 s=0:IF (j MOD 4) =0 THEN s=1
660 IF (j MOD 100)=0 AND (INT(j/100) MOD 4)<>0 THEN s=0
670 RETURN
680 '
690 DATA 5,1,1,4,6,2,4,7,3,5,1,3
700 DATA 2,7,5,3
710 RESTORE 690:FOR i=1TO m:READ mi:NEXT
720 sk=0:IF s=1 AND m<3 THEN sk=-1
730 RESTORE 700:FOR i=0 TO (INT(j/100) MOD 4):READ l:NEXT
740 w=(t+mi+INT((j MOD 100)/4)+(j MOD 100)+l+sk) MOD 7
750 RETURN
760 '
770 CLS#1
780 CLS#2:RETURN
790 '
800 SOUND 1,40,0,0,1:SOUND 1,10,20,0:SOUND 1,30,0,0,1:ENV 1,3,5,2,1,0,3,5,-3,2
810 RETURN
820 '
830 '     Abstand zweier Tage
840 '
850 CLS:GOSUB 770:LOCATE #1,2,2:PRINT#1,"ABSTAND ZWEIER TAGE"
860 PRINT:INPUT"Anf.-datum (als T,M,J)";ta,ma,ja:t=ta:m=ma:j=ja:GOSUB 570
870 IF p=1 THEN 860
880 GOSUB 330:ra=r
890 INPUT"Enddatum   (als T,M,J)";te,me,je:t=te:m=me:j=je:GOSUB 570
900 IF p=1 THEN 890
910 GOSUB 330:re=r:r=re-ra
920 GOSUB 800
930 LOCATE #2,6,2:d=ta:GOSUB 380:d=ma:GOSUB 380:PRINT#2,RIGHT$(STR$(ja),4);
940 PRINT#2,"  -  ";:d=te:GOSUB 380:d=me:GOSUB 380:PRINT#2,RIGHT$(STR$(je),4)
950 PRINT#2:LOCATE #2,12,4:PRINT#2,r;"TAGE"
960 PRINT:PRINT:PRINT:PRINT"Noch einmal (J/N)?":GOSUB 300:IF z="N" THEN GOSUB 770:GOTO 180
970 IF z="J" THEN:CLS:GOSUB 780:GOTO 860
980 CLS:GOTO 960
990 '
1000 '     Enddatum
1010 '
1020 CLS:GOSUB 770:LOCATE #1,7,2:PRINT#1,"ENDDATUM"
1030 LOCATE #2,2,2:PRINT#2,"Berechnet Enddatum nach gegeb."
1040 LOCATE #2,2,3:PRINT#2,"Anfangsdatum und Tagesdifferenz"
1050 PRINT:INPUT"Anf.-datum (als T,M,J)";tu,mu,ju:t=tu:m=mu:j=ju:GOSUB 570:IF p=1 THEN 1050
1060 INPUT"Differenztage         ";dt:IF dt<0 OR dt>100000 THEN 1060
1070 GOSUB 460
1080 GOSUB 780:GOSUB 800:LOCATE #2,7,2:d=tu:GOSUB 380:d=mu:GOSUB 380
1090 PRINT#2,RIGHT$(STR$(ju),4);" +";STR$(dt);" Tage":LOCATE #2,11,4
1100 PRINT#2," = ";:d=t:GOSUB 380: d=m:GOSUB 380:PRINT#2,RIGHT$(STR$(j),4)
1110 PRINT:PRINT"Noch eine Differenz zum gleichen"
1120 PRINT"Anfangsdatum (J/N)?":PRINT:GOSUB 300:IF z="J" THEN 1060
1130 IF z="N" THEN 1150
1140 CLS:GOTO 1110
1150 PRINT"Noch ein Anf.-datum (J/N)?":GOSUB 300:IF z="J" THEN 1050
1160 IF z="N" THEN GOSUB 770:GOTO 180
1170 '
1180 '     Wochentag
1190 '
1200 CLS:GOTO 1150
1210 CLS:GOSUB 770:LOCATE #1,7,2:PRINT#1,"WOCHENTAG"
1220 LOCATE #2,9,7:PRINT#2,"Ende mit (T,M,J) = 0,0,0"
1230 INPUT"Ihr Datum (als T,M,J)";t,m,j:IF t=0 AND m=0 AND j=0 THEN GOSUB 770:GOTO 180
1240 GOSUB 570:IF p=1 THEN 1230
1250 GOSUB 710:CLS:GOSUB 800:PRINT:FOR i=1 TO 31:PRINT"-";:NEXT:PRINT
1260 PRINT"  ";: d=t:GOSUB 370:d=m:GOSUB 370
1270 PRINT RIGHT$(STR$(j),4);"    -    ";zw(w):FOR i=1 TO 31:PRINT"-";:NEXT
1280 PRINT:PRINT:PRINT:PRINT:PRINT:GOTO 1230
1290 '
1300 '     Jubilaeumskalender
1310 '
1320 CLS:GOSUB 770:LOCATE #1,2,2:PRINT#1,"JUBILAEUMSKALENDER"
1330 LOCATE #2,2,2:PRINT#2,"Berechnung von Daten innerhalb"
1340 LOCATE #2,2,3:PRINT#2,"eines Intervalls in besonderem"
1350 LOCATE #2,2,4:PRINT#2,"Abstand von einem Ausgangsdatum"
1360 PRINT:INPUT"Ausg.-datum (T,M,J)";tu,mu,ju:t=tu:m=mu:j=ju:GOSUB 570
1370 IF p=1 THEN 1360
1380 GOSUB 330:ru=r
1390 PRINT:INPUT"Int.-anfang (T,M,J)";ta,ma,ja:t=ta:m=ma:j=ja:GOSUB 570
1400 IF p=1 THEN 1390
1410 GOSUB 330:ra=r:IF ra-ru<0 THEN 1390
1420 INPUT"Int.-ende   (T,M,J)";te,me,je:t=te:m=me:j=je:GOSUB 570
1430 IF p=1 THEN 1420
1440 GOSUB 330:re=r:IF re-ra<0 THEN 1420
1450 GOSUB 780
1460 LOCATE #2,2,1:PRINT#2,"Ausgangsdatum ";:d=tu:GOSUB 380:d=mu:GOSUB 380
1470 PRINT#2,RIGHT$(STR$(ju),4):LOCATE #2,2,2:PRINT#2,"Intervall ";:d=ta
1480 GOSUB 380:d=ma:GOSUB 380:PRINT#2,RIGHT$(STR$(ja),4);" - ";:d=te
1490 GOSUB 380:d=me:GOSUB 380:PRINT#2,RIGHT$(STR$(je),4)
1500 LOCATE #2,2,4:PRINT#2,"Einheiten:"SPC(3)"(Wechsel: Diff.= 0)"
1510 LOCATE #2,2,5:PRINT#2,"Wochen 1  Stunden 3  Sekunden 5"
1520 LOCATE #2,2,6:PRINT#2,"Tage   2  Minuten 4  Ende     6"
1530 fa=ra-ru:fe=re-ru
1540 CLS:PRINT"Welche Einheit (Nr.)?":PRINT:GOSUB 300
1550 e=ASC(z)-48:IF e<1 OR e>6 THEN 1540
1560 ON e GOTO 1570,1580,1590,1600,1610,1620
1570 ia=INT(fa/7):ie=INT(fe/7):GOSUB 1680:dt=d*7:GOTO 1740
1580 ia=fa:ie=fe:GOSUB 1680:dt=d:GOTO 1740
1590 ia=fa*24:ie=fe*24:GOSUB 1680:dt=INT(d/24):GOTO 1740
1600 ia=fa*1440:ie=fe*1440:GOSUB 1680:dt=INT(d/1440):GOTO 1740
1610 ia=fa*86400:ie=fe*86400:GOSUB 1680:dt=INT(d/86400):GOTO 1740
1620 PRINT:PRINT"Neues Intervall (J/N)?":GOSUB 300:IF z="J" THEN 1390
1630 IF z="N" THEN PRINT:GOTO 1650
1640 CLS:GOTO 1620
1650 PRINT"Neues Ausgangsdatum (J/N)?":GOSUB 300:IF z="J" THEN CLS:GOTO 1360
1660 IF z="N" THEN GOSUB 770:GOTO 180
1670 CLS:GOTO 1650
1680 PRINT"Im Intervall sind die ";ze(e)
1690 PRINT"  ";ia;" - ";ie
1700 PRINT"Diff.in ";ze(e);:INPUT zd:d=VAL(zd)
1710 IF d<=0 THEN PRINT:GOTO 1540
1720 IF d<ia OR d>ie THEN PRINT:PRINT"Nicht im Intervall!":PRINT:GOTO 1560
1730 RETURN
1740 GOSUB 460:GOSUB 710:CLS:GOSUB 800
1750 FOR i=1 TO 31:PRINT"-";:NEXT:PRINT
1760 PRINT d;ze(e);" am ";:d=t:GOSUB 370:d=m:GOSUB 370:PRINTRIGHT$(STR$(j),4)
1770 PRINTTAB(10);zw(w)
1780 FOR i=1 TO 31:PRINT"-";:NEXT:PRINT:PRINT
1790 GOTO 1560
1800 '
1810 '     Gruppenalter
1820 '
1830 CLS:GOSUB 770:LOCATE #1,5,2:PRINT#1,"GRUPPENALTER"
1840 LOCATE #2,3,2:PRINT#2,"Gesamtalter einer Gruppe von"
1850 LOCATE #2,7,4:PRINT#2,"Personen (maximal 20)"
1860 PRINT:INPUT"Wieviel Personen";np:np=INT(np):IF np<1 OR np>20 THEN 1860
1870 PRINT:FOR ig=1 TO np
1880 PRINT"Geb.-tag";ig;:INPUT"(T,M,J)";t,m,j:GOSUB 570
1890 IF p=1 THEN 1880
1900 GOSUB 330:rg(ig)=r:NEXT
1910 PRINT:INPUT"Pruefber.-Anf.(T,M,J)";t,m,j:GOSUB 570
1920 IF p=1 THEN 1910
1930 GOSUB 330:nb=0:FOR ig=1 TO np:nb=nb+r-rg(ig):NEXT
1940 PRINT TAB(10);"=";INT(nb/3.6525+0.5)/100;"Jahre":PRINT
1950 INPUT"Wieviel Jahre (Ende=0)";jg:IF jg=0 THEN 2010
1960 dt=INT((jg*365.2425-nb)/np):IF dt<0 OR dt>100000 THEN 1950
1970 tu=t:mu=m:ju=j:GOSUB 460:GOSUB 710:GOSUB 780:GOSUB 800
1980 LOCATE #2,5,2:PRINT#2,jg;"Jahre am ";:d=t:GOSUB 380:d=m:GOSUB 380
1990 PRINT#2,RIGHT$(STR$(j),4):LOCATE #2,13,4:PRINT#2,zw(w)
2000 t=tu:m=mu:j=ju:GOTO 1950
2010 PRINT:PRINT"Pruefber.-anf.aendern (J/N)?":GOSUB 300:IF z="J" THEN 1910
2020 IF z="N" THEN 2040
2030 CLS:GOTO 2010
2040 PRINT:PRINT"Noch eine Gruppe (J/N)?":GOSUB 300:IF z="J" THEN 1860
2050 IF z="N" THEN GOSUB 770:GOTO 180
2060 CLS:GOTO 2040
2070 MODE 1:END