home *** CD-ROM | disk | FTP | other *** search
- 10 rem kalender von j.hagen, erstellt auf einem c128
- 15 rem c64-version a.m.
- 20 rem in der anlistung : < = kleiner , > = groesser
- 30 rem
- 40 rem dieses programm erstellt kalender fuer die jahre von 1583 bis 4199
- 50 b$=" ":rem
- 60 dim t$(12),tm(12),am(12),wn(18),et(6),st(6),nm(12),vm(12):l=29.530589:jx%=0
- 70 o$=chr$(145):l$=chr$(157):rn$=chr$(18):rf$=chr$(146):em$=chr$(13):r$=chr$(29)
- 80 wt$="montag dienstag mittwoch donnerstagfreitag samstag sonntag "
- 90 mt$="januar februar maerz april mai juni "
- 100 mt$=mt$+"juli august septemberoktober november dezember "
- 110 poke53281,0:poke53280,0:poke646,1:f$=" ":tb$=chr$(16)
- 120 printchr$(147);:print:print:print" notiz : ";:gosub7500:d$=f$
- 200 printchr$(147);:print:print" ";d$;
- 210 printtab(31)mid$(ti$,1,2);":";mid$(ti$,3,2);":";mid$(ti$,5,2)
- 220 printtab(16)"kalender":printtab(15)"=========="
- 230 print:print" funktion waehlen :"
- 240 print:printtab(10)"generieren 1"
- 250 print:printtab(10)"korrektur 2"
- 260 print:printtab(10)"feiertage 3"
- 270 print:printtab(10)"mondphasen 4"
- 280 print:printtab(10)"anzeigen 5"
- 290 print:printtab(10)"drucken 6"
- 300 print:printtab(10)"programm-ende 9"
- 310 print:print" funktion eingeben ";:f$="?":gosub7500
- 320 if f$="1"then1000
- 330 if f$="2"then2000
- 340 if f$="3"then3000
- 350 if f$="4"then4000
- 360 if f$="5"then5000
- 370 if f$="6"then6000
- 380 if f$="9"then9000
- 381 printo$;o$:goto310
- 500 printchr$(147);:print:print" ";d$;
- 510 printtab(31)mid$(ti$,1,2);":";mid$(ti$,3,2);":";mid$(ti$,5,2):return
- 1000 gosub500:printtab(15)"generieren":print:print:jx%=0:f$="jjjj"
- 1010 print" jahr (1583 - 4199) ";:gosub7500:jx%=val(f$)
- 1020 ifnot(jx%<4200 and jx%>1582)thenprinto$:goto1010
- 1021 print:print
- 1030 print:printtab(16)"kalender":print:printtab(18)"wird"
- 1040 print:printtab(16)"generiert":print:print
- 1050 form=1to12:tm(m)=0:am(m)=0:t$(m)="":nextm:jh%=jx%/100
- 1060 p%=15+jh%-int(jh%/3)-int(jh%/4):p%=p%-int(p%/30)*30:q%=jh%-int(jh%/4)+4
- 1070 q%=q%-int(q%/7)*7:a%=jx%-int(jx%/19)*19:b%=jx%-int(jx%/4)*4
- 1080 c%=jx%-int(jx%/7)*7:x%=19*a%+p%:d%=x%-int(x%/30)*30:x%=2*b%+4*c%+6*d%+q%
- 1090 e%=x%-int(x%/7)*7:f%=22+d%+e%:mo%=3:if f%>31 then mo%=4:f%=d%+e%-9
- 1100 if d%=29 and e%=6 then f%=19:mo%=4:goto1120
- 1110 if d%=28 and e%=6 and a%>10 then mo%=4:f%=18
- 1120 tm(1)=31:tm(2)=28:tm(3)=31:tm(4)=30:tm(5)=31:tm(6)=30:tm(7)=31:tm(8)=31
- 1130 tm(9)=30:tm(10)=31:tm(11)=30:tm(12)=31:if int(jx%/4)*4<>jx% then1150
- 1140 if int(jh%/4)*400<>jx% and jh%*100=jx% then1150
- 1141 tm(2)=29
- 1150 m1%=mo%:f1%=f%-2:if f1%<1 then f1%=f1%+31:m1%=m1%-1
- 1160 m5%=mo%:f5%=f%-46:if f5%<1 and m5%=4 then f5%=f5%+31:m5%=m5%-1
- 1170 if f5%<1 and m5%=3 then f5%=f5%+tm(2):m5%=m5%-1
- 1180 m6%=mo%:f6%=f%-7:if f6%<1 then f6%=f6%+31:m6%=m6%-1
- 1190 m2%=mo%:f2%=f%+39:if f2%>31 and m2%=3 then f2%=f2%-31:m2%=m2%+1
- 1200 if f2%>30 and m2%=4 then f2%=f2%-30:m2%=m2%+1
- 1210 if f2%>31 and m2%=5 then f2%=f2%-31:m2%=m2%+1
- 1220 m3%=m2%:f3%=f2%+10:if f3%>31 and m3%=5 then f3%=f3%-31:m3%=m3%+1
- 1230 if f3%>30 and m3%=6 then f3%=f3%-30:m3%=m3%+1
- 1240 m7%=m3%:f7%=f3%+11:if f7%>31 and m7%=5 then f7%=f7%-31:m7%=m7%+1
- 1250 if f7%>30 and m7%=6 then f7%=f7%-30:m7%=m7%+1
- 1260 m8%=m5%:f8%=f5%-2:if f8%<1 and m8%=3 then f8%=f8%+tm(2):m8%=m8%-1
- 1270 nt=int((jx%-1)*365.25)-int((jx%-1)/100)+int((jx%-1)/400)+309
- 1280 nt=nt-int(nt/7)*7:if nt=0 then nt=7
- 1290 wt=nt:gt=0:form=1to12:gt=gt+tm(m)
- 1300 fort=1to31:if t>tm(m) then t$(m)=t$(m)+chr$(0):goto1330
- 1310 xx=wt+7:if wt<6 then xx=wt
- 1311 t$(m)=t$(m)+chr$(xx)
- 1320 wt=wt+1:if wt>7 then wt=wt-7
- 1330 nextt:nextm
- 1340 bt=asc(mid$(t$(12),24,1)):f4%=22:m4%=11:if bt<7 then f4%=22-bt
- 1350 t=1:m=1:gosub1900:if jx%>1888 then t=1:m=5:gosub1900
- 1360 t=25:m=12:gosub1900:if(jx%>1953)and(jx%<1991)then t=17:m=6:gosub1900
- 1361 ifjx%>1989thent=3:m=10:gosub1900
- 1370 t=26:m=12:gosub1900:t=f1%:m=m1%:gosub1900:t=f%:m=mo%:gosub1900
- 1380 t=f%+1:m=mo%:if t>31 then t=t-31:m=m+1
- 1390 gosub1900:t=f2%:m=m2%:gosub1900
- 1400 t=f3%:m=m3%:gosub1900:t=f3%+1:m=m3%:if t>31 then t=t-31:m=m+1
- 1410 gosub1900:t=f4%:m=m4%:gosub1900:form=1to12:am(m)=0
- 1420 fort=1to31:if t<=tm(m) then if asc(mid$(t$(m),t,1))<8 then am(m)=am(m)+1
- 1430 nextt:nextm
- 1440 nm(0)=jx%*10.632932+int((jx%-1)/4)-int((jx%-1)/100)+int((jx%-1)/400)+8.582
- 1450 vm(0)=nm(0)-int(nm(0)/l)*l:nm(0)=l+1-vm(0)
- 1460 xx=-14.8:if nm(0)<15thenxx=14.8
- 1461 vm(0)=nm(0)+xx
- 1470 form=1to12:vm(m)=vm(m-1)+l:nm(m)=nm(m-1)+l:nextm
- 1480 forx=0to12:t=vm(x):vm(x)=0:if int(t)<=gt then gosub1950:vm(x)=t
- 1490 t=nm(x):nm(x)=0:ift<=gt thengosub1950:nm(x)=t
- 1500 nextx:goto200
- 1900 wt=asc(mid$(t$(m),t,1)):if wt>=8 then return
- 1901 t$(m)=left$(t$(m),t-1)+chr$(wt+7)+right$(t$(m),len(t$(m))-t)
- 1910 return
- 1950 form=1to12:if int(t)>tm(m) then t=t-tm(m):goto1960
- 1951 t=int(t)+(m/100):m=12
- 1960 nextm:return
- 2000 gosub500:print:printtab(8)"korrektur fuer ";jx%:if jx%=0 then2500
- 2010 print:print:print:print:f$="tt"
- 2020 print" tag ";:gosub7500:gosub3500
- 2030 t=m:if not(t>0 and t<32) then printo$:goto2020
- 2031 f$="mm"
- 2040 printtab(12)" monat ";:gosub7500:gosub3500
- 2050 if m<1 or m>12 then printo$:goto2040
- 2051 if t<=tm(m) then2070
- 2060 print:print:print:printtab(12)"datum ist ungueltig":goto2150
- 2070 printtab(26)" f / w ";:f$="?":gosub7500
- 2080 if f$="w"then2110
- 2081 if f$<>"f"then printo$:goto2070
- 2090 x=asc(mid$(t$(m),t,1)):if x>7 then2130
- 2100 t$(m)=left$(t$(m),t-1)+chr$(x+7)+right$(t$(m),len(t$(m))-t)
- 2101 am(m)=am(m)-1:goto2130
- 2110 x=asc(mid$(t$(m),t,1)):if x<8 then2130
- 2120 t$(m)=left$(t$(m),t-1)+chr$(x-7)+right$(t$(m),len(t$(m))-t)
- 2121 am(m)=am(m)+1
- 2130 print:print:print:print" der";t;". ";mid$(mt$,(m-1)*9+1,9);" ist ein ";
- 2140 if f$="w"then print"werktag":goto2150
- 2141 print"feiertag"
- 2150 print:print:print
- 2160 print:printtab(10)"noch einmal (j / n) ";:f$="?":gosub7500
- 2170 if f$="j"then2000
- 2171 if f$="n"then200
- 2172 printo$;:goto2160
- 2500 print:print:printtab(16)"kalender":print:printtab(17)"wurde"
- 2510 print:printtab(16)"noch nicht":print:printtab(16)"generiert":print:print
- 2520 print:printtab(16)"weiter ? ";:f$="j":gosub7500:goto200
- 3000 gosub500:printtab(12)"feiertage ";jx%:print:if jx%=0 then2500
- 3010 print:printtab(8)"rosenmontag ";
- 3020 printright$(str$(f8%),2)".";:printright$(str$(m8%),2)"."
- 3030 print:printtab(8)"aschermittwoch ";
- 3040 printright$(str$(f5%),2)".";:printright$(str$(m5%),2)"."
- 3050 print:printtab(8)"palmsonntag ";
- 3060 printright$(str$(f6%),2)".";:printright$(str$(m6%),2)"."
- 3070 print:printtab(6)"* karfreitag ";
- 3080 printright$(str$(f1%),2)".";:printright$(str$(m1%),2)"."
- 3090 print:printtab(6)"* ostern ";
- 3100 printright$(str$(f%),2)".";:printright$(str$(mo%),2)"."
- 3110 print:printtab(6)"* himmelfahrt ";
- 3120 printright$(str$(f2%),2)".";:printright$(str$(m2%),2)"."
- 3130 print:printtab(6)"* pfingsten ";
- 3140 printright$(str$(f3%),2)".";:printright$(str$(m3%),2)"."
- 3150 print:printtab(8)"fronleichnam ";
- 3160 printright$(str$(f7%),2)".";:printright$(str$(m7%),2)"."
- 3170 print:printtab(6)"* buss-und bettag ";
- 3180 printright$(str$(f4%),2)".";:printright$(str$(m4%),2)"."
- 3190 print:printtab(12)"weiter ? ";:f$="j":gosub7500:goto200
- 3500 m=asc(mid$(f$,2,1)):if m<48 or m>57 then if m<>32 then m=0:return
- 3510 m=val(f$):return
- 4000 gosub500:printtab(12)"mondphasen ";jx%:print:if jx%=0 then2500
- 4010 print:printtab(8)"vollmond neumond":print:form=0to12
- 4020 if vm(m)<=0 then 4040
- 4021 print" ";:printright$(b$+str$(int(vm(m))),3)".";
- 4030 printright$(str$(int((vm(m)-int(vm(m)))*100+.5)),2)".";
- 4040 if nm(m)<=0 then 4060
- 4041 printtab(24)" ";:printright$(b$+str$(int(nm(m))),3)".";
- 4050 printright$(str$(int((nm(m)-int(nm(m)))*100+.5)),2)".";
- 4060 print:nextm
- 4070 print:printtab(12)"weiter ? ";:f$="j":gosub7500:goto200
- 5000 gosub500:printtab(16)"anzeigen":print:if jx%=0 then2500
- 5010 print" eingabe t / w ";:f$="?":gosub7500:e1$=f$:f$=" "
- 5020 if not(e1$="t" or e1$="w")thenprinto$:goto5010
- 5030 printtab(22)" ";:print"monat 1-12 ";:gosub7500:gosub3500
- 5040 e2%=m:ifnot(e2%>0 and e2%<13)thenprinto$:goto5030
- 5050 printo$:if e1$="t"then5500
- 5100 print" werkskalender ";mid$(mt$,(e2%-1)*9+1,9);" ";jx%;" ":print
- 5110 t1%=0:a1%=0:if e2%<>1 then forx=1toe2%-1:t1%=t1%+tm(x):a1%=a1%+am(x):nextx
- 5120 t2%=t1%+15:a2%=a1%:forx=1to15:if asc(mid$(t$(e2%),x,1))<8 then a2%=a2%+1
- 5130 nextx:forx=1to16:if x=16 then5190
- 5140 y$=mid$(t$(e2%),x,1):ify$=""theny$=chr$(0)
- 5141 y=asc(y$):a%=0:y=y-7:ify<1 then a1%=a1%+1:a%=a1%:y=y+7
- 5150 print" ";:printright$(str$(x),2);:print". ";mid$(wt$,(y-1)*10+1,2);
- 5160 printright$(b$+str$(t1%+x),4);:ifa%>0then printright$(str$(a%),4);:goto5170
- 5161 print" ";
- 5170 if y<>4 then print" ";:goto5190
- 5171 v=1:a%=t1%:t=x:gosub5800
- 5180 printright$(b$+str$(wn((v-1)*6+y)),3);
- 5190 y=asc(mid$(t$(e2%),x+15,1)):a%=0:y=y-7:ify<1 then a2%=a2%+1:a%=a2%:y=y+7
- 5200 if y<=0 then print:goto5250
- 5201 printtab(20)" ";:printright$(str$(x+15),2);
- 5210 print". ";mid$(wt$,(y-1)*10+1,2);:printright$(b$+str$(t2%+x),4);
- 5220 if a%>0 then printright$(b$+str$(a%),4);:goto5230
- 5221 print" ";
- 5230 if y<>4 then print" ":goto5250
- 5231 v=1:a%=t1%:t=x+15:gosub5800
- 5240 printright$(b$+str$(wn((v-1)*6+y)),3)
- 5250 nextx:goto5610
- 5500 print" tageskalender ";mid$(mt$,(e2%-1)*9+1,9);" ";jx%;" "
- 5510 a%=0:if e2%<>1 then forx=1toe2%-1:a%=a%+tm(x):nextx
- 5520 v=1:m=2-asc(mid$(t$(e2%),1,1)):if m<-5 then m=m+7
- 5530 forx=1to7:print:printtab(05)mid$(wt$,(x-1)*10+1,10);
- 5540 fory=1to6:t=m+(x-1)+((y-1)*7)
- 5550 if t>0 and t<tm(e2%)+1 then printright$(b$+str$(t),4);:goto5560
- 5551 print" ";
- 5560 if x=4 then gosub5800
- 5570 nexty:print:nextx:print:print:printtab(5)"w o c h e ";
- 5580 fory=1to6:if wn((v-1)*6+y)<=0 thenprint" ";:goto5600
- 5590 printright$(b$+str$(wn((v-1)*6+y)),4);
- 5600 nexty:print
- 5610 print:printtab(10)"noch einmal (j / n) ";:f$="?":gosub7500
- 5620 if f$="j"then5000
- 5621 if f$="n"then200
- 5622 printo$;o$:goto5610
- 5800 wn((v-1)*6+y)=0:if t>0 and t<tm(e2%)+1 then wn((v-1)*6+y)=int((a%+t+6.5)/7)
- 5810 return
- 6000 gosub500:printtab(12)"kalender drucken":print:print:if jx%=0 then2500
- 6010 printtab(8)"druck t / w ";:f$="?":gosub7500:e1$=f$
- 6020 if not(f$="t"or f$="w")then printo$:goto6010
- 6030 open4,4,0:print
- 6040 print:printtab(8)"drucker eingeschaltet ? ";:f$="j":gosub7500:print
- 6050 if f$="n"then6880
- 6060 print:printtab(8)"papier eingelegt ? ";:f$="j":gosub7500:print
- 6070 if f$="n"then6880
- 6080 print:printtab(8)"schreibdichte korrekt ? ";:f$="j":gosub7500:print
- 6090 if f$="n"then6880
- 6100 print:printtab(8)"zeilen-dichte korrekt ? ";:f$="j":gosub7500:print
- 6110 if f$="n"then6880
- 6120 print:printtab(8)"tabulator korrekt ? ";:f$="j":gosub7500
- 6130 if f$="n"then6880
- 6131 if e1$="w"then6700
- 6200 print#4,tb$;"27kalender";jx%:print#4
- 6210 forj=1to4:print#4:print#4," ";:forv=1to3
- 6220 et(v)=2-asc(mid$(t$((j-1)*3+v),1,1)):if et(v)<-5 then et(v)=et(v)+7
- 6230 print#4," ";mid$(mt$,(j-1)*27+(v-1)*9+1,9);" ";
- 6240 nextv:print#4:print#4:st(1)=0:a=(j-1)*3:if a=0 then6260
- 6250 forv=1toa:st(1)=st(1)+tm(v):nextv
- 6260 st(2)=st(1)+tm(a+1):st(3)=st(2)+tm(a+2)
- 6270 forx=1to7:print#4,mid$(wt$,(x-1)*10+1,2);" ";:forv=1to3
- 6280 fory=1to6:t=et(v)+(x-1)+(y-1)*7
- 6290 if t>0andt<tm((j-1)*3+v)+1 then print#4,right$(b$+str$(t),3);:goto6300
- 6291 print#4," ";
- 6300 if x=4 then e2%=(j-1)*3+v:a%=st(v):gosub5800
- 6310 nexty:print#4," ";:nextv:print#4:nextx:print#4:print#4,"wn ";
- 6320 forv=1to3:fory=1to6:ifnot(wn((v-1)*6+y)>0)thenprint#4," ";:goto6340
- 6330 print#4,right$(b$+str$(wn((v-1)*6+y)),3);
- 6340 nexty:print#4," ";:nextv:print#4:print#4
- 6350 nextj:print#4:print#4,"feiertage : karfreitag ";
- 6360 print#4,right$(str$(f1%),2)".";:print#4,right$(str$(m1%),2);:print#4,". , ";
- 6370 print#4," ostern ";:x=f%+1:y=mo%:if x>31 then x=x-31:y=y+1
- 6380 print#4,right$(str$(f%),2);:if mo%<>y then print#4,right$(str$(mo%),2)".";
- 6390 print#4,"/";:print#4,right$(str$(x),2);:print#4,right$(str$(y),2)
- 6400 print#4,tb$;"12himmelfahrt ";
- 6410 print#4,right$(str$(f2%),2)".";:print#4,right$(str$(m2%),2);:print#4,". , ";
- 6420 print#4," pfingsten ";:x=f3%+1:y=m3%:if x>31 then x=x-31:y=y+1
- 6430 print#4,right$(str$(f3%),2)".";:if m3%<>y then print#4,right$(str$(m3%),2)".";
- 6440 print#4,"/";:print#4,right$(str$(x),2)".";:print#4,right$(str$(y),2)"."
- 6450 print#4,tb$;"12buss- und bettag ";:print#4,right$(str$(f4%),2)".";
- 6460 print#4,right$(str$(m4%),2)".":print#4:print#4,"vollmond : ";
- 6470 form=0to5:gosub6600:print#4," , ";:nextm:print#4:print#4,tb$;"11 ";
- 6480 form=6to11:gosub6600:if m<11 then print#4," , ";:goto6500
- 6490 if m<12 and vm(12)>0 then print#4," , ";
- 6500 nextm:print#4
- 6510 if vm(12)<>0 then print#4,tb$;"11 ";:m=12:gosub6600
- 6520 forx=1to11:print#4:nextx:goto6880
- 6600 if vm(m)<=0 then return
- 6601 print#4,right$(str$(vm(m)),2)".";
- 6610 print#4,right$(str$((vm(m)-int(vm(m)))*100),2)".";:return
- 6700 print#4,tb$;"29werks-kalender";jx%:print#4
- 6710 forj=1to2:et(1)=0:st(1)=0:if j=1 then6730
- 6720 forx=1to6:et(1)=et(1)+tm(x):st(1)=st(1)+am(x):nextx
- 6730 forx=1to5:et(x+1)=et(x)+tm((j-1)*6+x):st(x+1)=st(x)+am((j-1)*6+x):nextx
- 6740 print#4," ";:forx=1to6:a%=9:if j>1 then6760
- 6750 if x<5 then a%=8:print#4," ";
- 6751 if x<2 then a%=7:print#4," ";
- 6760 print#4," ";mid$(mt$,(j-1)*54+(x-1)*9+1,a%);:nextx:print#4
- 6770 fort=1to31:print#4,right$(str$(t),2)".";
- 6780 forx=1to6:if t>tm((j-1)*6+x) then print#4," ";:goto6800
- 6790 print#4,right$(b$+str$(et(x)+t),5);
- 6800 if t>tm((j-1)*6+x) or asc(mid$(t$((j-1)*6+x),t,1))>7 then6820
- 6810 st(x)=st(x)+1:print#4,right$(b$+str$(st(x)),4);:goto6830
- 6820 print#4," ";
- 6830 v=asc(mid$(t$((j-1)*6+x),t,1)):ifnot(v=4 or v=11)then6860
- 6840 v=1:y=1:e2%=(j-1)*6+x:a%=et(x):gosub5800
- 6850 print#4,right$(b$+str$(wn((v-1)*6+y)),3);:goto6870
- 6860 print#4," ";
- 6870 nextx:print#4:nextt:print#4:nextj:forx=1to4:print#4:nextx
- 6880 print:print:print:goto6920
- 6890 (NULL)6900
- 6900 print:print:print:print:print
- 6910 open3,3:print#3,tab(11)"drucker nicht bereit";o$;o$;o$:close3
- 6920 close4:e1$="":printtab(11)"noch einmal (j / n) ";:f$="?":gosub7500
- 6930 if f$="j"then6000
- 6931 if f$="n"then200
- 6932 printo$:goto6920
- 7500 rem zeichen-eingabe-routine
- 7510 g$="":g=0:printf$;:forx=1tolen(f$):printl$;:nextx
- 7520 printg$;:g=g+1:if g>len(f$) then7580
- 7530 g$=mid$(f$,g,1):printrn$;g$;rf$;l$;
- 7531 getg$:if g$=""then7531
- 7532 if g$=em$ then7580
- 7540 if g$=r$ then7560
- 7541 if g$=l$ then7570
- 7542 if asc(g$)=34 then7530
- 7550 if asc(g$)<32 or asc(g$)>95 then 7530
- 7551 f$=left$(f$,g-1)+g$+right$(f$,len(f$)-g):goto7520
- 7560 if g=>len(f$) then7530
- 7561 g$=mid$(f$,g,1):goto7520
- 7570 if g<2 then7530
- 7571 printmid$(f$,g,1);l$;l$;:g=g-1:goto7530
- 7580 printmid$(f$,g,1);:return
- 9000 end
-