start tok64 d64-1O71Mt
4100 POKE53280,0:POKE53281,0:PRINT"{clear}{yellow}{ct n}";SPC(12)"Calendar Printer"
4110 FORi=1TO40:PRINT"{cm t}";:NEXTi
4120 INPUT"{down}Month (1-12)";m
4130 IF m<1 OR m>12 THEN 4120
4140 INPUT"{down}Year{space*2}({y*4})";yr
4150 IFyr<1904ORyr>2099THENPRINT"{down*2}{reverse on}Only years from 1904-2099 are covered":GOTO4140
4160 OPEN10,4,10:PRINT#10:CLOSE10:OPEN4,4
4170 DIM a$(10):lf=13
4180 DIM m$(12,2),c(6,7),aa$(10)
4190 FORi=1TO12:READm$(i,1):NEXTi
4200 n$=m$(m,1)+STR$(yr)
4210 DATA "{space*6}j a n u a r y{space*8}"
4220 DATA "{space*5}f e b r u a r y{space*7}"
4230 DATA "{space*8}m a r c h{space*10}"
4240 DATA "{space*8}a p r i l{space*10}"
4250 DATA "{space*10}m a y{space*12}"
4260 DATA "{space*10}j u n e{space*10}"
4270 DATA "{space*10}j u l y{space*10}"
4280 DATA "{space*8}a u g u s t{space*8}"
4290 DATA "{space*4}s e p t e m b e r{space*6}"
4300 DATA "{space*6}o c t o b e r{space*8}"
4310 DATA "{space*6}n o v e m b e r{space*6}"
4320 DATA "{space*6}d e c e m b e r{space*6}"
4330 FORi=1TO12:READm$(i,2):NEXT
4340 DATA 31,28,31,30,31,30,31
4350 DATA 31,30,31,30,31
4360 dm=VAL(m$(m,2))
4370 IF4*INT(yr/4)=yrANDm=2THENdm=29
4380 y=yr:IFm<3THENy=y-1
4390 r%=(y-1903)/4
4400 p1=5*r%:s=y-1903-4*r%
4410 IFs>0THENp1=p1+1+s
4420 IFm=1ORm=5THENp1=p1+5:GOTO4480
4430 IFm=2ORm=6THENp1=p1+1:GOTO4480
4440 IFm=4ORm=7THENp1=p1+3:GOTO4480
4450 IFm=8THENp1=p1-1:GOTO4480
4460 IFm=9ORm=12THENp1=p1+2:GOTO4480
4470 IFm=10THENp1=p1+4:GOTO4480
4480 p1=p1-7*INT(p1/7)
4490 FORx=1TO6:FORy=1TO7:c(x,y)=-1:NEXTy,x
4500 d=1:FORz=p1+1TO100
4510 x=INT((z-1)/7)+1
4520 y=z-7*INT((z-1)/7)
4530 c(x,y)=d
4540 d=d+1:IF d>dm THEN 4560
4550 NEXTz
4560 l1$="B":FORx=1TO69:l1$=l1$+" ":NEXTx:l1$=l1$+"B"
4570 l$="":FORx=1TO71:l$=l$+"-":NEXTx
4580 FORx=0TO10:READ aa$(x):NEXTx
4590 DATA 0,1,2,3,4,5,6,7,8,9," "
4600 s$="{space*4}":d$="B{space*9}":s1$="B ":e$="{space*6}"
4610 PRINT#4,s$;l$;CHR$(lf);
4620 PRINT#4,s$;l1$;CHR$(lf);:PRINT#4,s$;l1$;CHR$(lf);
4630 PRINT#4,s$;"B{space*19}";n$;"{space*18}B";CHR$(lf);
4640 PRINT#4,s$;l1$;CHR$(lf);:PRINT#4,s$;l1$;CHR$(lf);
4650 PRINT#4,s$;l$;CHR$(lf);
4660 PRINT#4,s$;d$;d$;d$;d$;d$;d$;d$;"B";CHR$(lf);
4670 PRINT#4,s$;"B{space*3}sun{space*3}B{space*3}mon{space*3}B{space*3}tue{space*3}B{space*3}wed{space*3}B{space*3}thu{space*3}B";
4680 PRINT#4,"{space*3}fri{space*3}B{space*3}sat{space*3}B";CHR$(lf);
4690 PRINT#4,s$;d$;d$;d$;d$;d$;d$;d$;"B";CHR$(lf);
4700 PRINT#4,s$;l$;CHR$(lf);
4710 FORw=1TO6
4720 t=0:FORzz=1TO7:t=t+c(w,zz):NEXTzz:IF t=-7 THEN 4830
4730 PRINT#4,s$;d$;d$;d$;d$;d$;d$;d$;"B";CHR$(lf);
4740 PRINT#4,s$;
4750 FORy=1TO7:z=c(w,y)
4760 IF z=-1THENa1=10:a2=10:GOTO4790
4770 a1=INT(z/10):IFa1=0THENa1=10
4780 a2=z-(INT(z/10)*10)
4790 PRINT#4,s1$;aa$(a1);aa$(a2);e$;
4800 NEXTy:PRINT#4,"B";CHR$(lf);
4810 FORx=1TO6:PRINT#4,s$;d$;d$;d$;d$;d$;d$;d$;"B";CHR$(lf);:NEXTx
4820 PRINT#4,s$;l$;CHR$(lf);
4830 NEXTw:CLOSE4
4840 PRINT"{clear}{right*3}{down*3}[a]gain or [m]enu?"
4850 GETa$
4860 IFa$="a" THEN RUN4100
4870 IFa$="m" THEN LOAD"sta.store",8,1:RUN
4880 IFa$<>"a"ORa$<>"m"THEN4850
stop tok64
(bastext 1.0)