10REM Program Calendar by Barry Thoma s 40REM BEEBUG December 1988 Program su bject to copyright 51REM Modified by Douglas Ambrose Mar ch 1996 to give four 52REM weeks per A4 page beginning on Sunday as an 53REM engagement diary. 60: 100MODE7:PROCinit:ON ERROR GOTO210 120RESTORE 190 140PROCdeskcal 175MODE131:VDU14 180END 190DATA Desk calendar,Check date file, Quit 200: 210VDU1,27,64,3:CLS:*FX15 215REM *FX15,0 flushes all buffers, *F X15,1 flushes current input buffer. 221ON ERROR OFF:VDU3:MODE131:VDU14:REP ORT:PRINT" in line ";ERL:END 230: 999DEF FNN="DIARYX" 1000DEF PROCinit 1010dy$=" ":mn$=dy$:rec$=STRING$(100," "):line$=rec$:rec$="":line$="" 1020DIM month$(12),daysinmonth%(12),day $(6),mstart%(12),daynum%(12) 1030pagelen%=66:width%=132:margin%=6 1040REMS$=" ":U$=S$+STRING$(70,"`"): dot$=S$+STRING$(70,".") 1045S$=" ":U$=S$+STRING$(35,"-"):dot $=S$+STRING$(35,"=") 1050DIM insert$(10),errmess$(5),dayabbr $(31) 1060errmess$(1)="day out of range":errm ess$(2)="month out of range":errmess$(3) ="year out of range":errmess$(4)="printe r not connected":errmess$(5)="File not f ound" 1070RESTORE 1130 1080FOR N%=1 TO 12 1090READ month$(N%),daysinmonth%(N%) 1100daynum%(N%)=daynum%(N%-1)+daysinmon th%(N%) 1110NEXT 1120FOR N%=0TO 6:READ day$(N%):NEXT 1130DATA JANUARY,31,FEBRUARY,28,MARCH,3 1,APRIL,30,MAY,31,JUNE,30 1140DATA JULY,31,AUGUST,31,SEPTEMBER,30 ,OCTOBER,31,NOVEMBER,30,DECEMBER,31 1150DATA Saturday,Sunday,Monday,Tuesday ,Wednesday,Thursday,Friday 1160filechecked=FALSE:nitems%=3:maxlen% =20 1170ENDPROC 1180: 1190DEF FNzeller(D%,M%,Y%) 1200K%=(60+(100/M%))DIV100:X%=365 1210F%=X%*Y%+D%+31*(M%-1)-INT(.4*M%+2.3 )*(1-K%) 1220F%=F%+(Y%-K%)DIV4-INT(.75*(Y%-K%)DI V100+1)+700 1230=F%MOD 7 1240: 1250DEF FNleap(y%) 1260IF y% MOD 400=0 THEN =TRUE 1270IF y% MOD 4=0 AND y% MOD 100<>0 THE N =TRUE 1280=FALSE 1370: 1380DEF PROCtestbuffer 1413CLS:VDU14 1414PRINT"PRINTER ON?":C$=GET$ 1444REM VDU 108,1,40 sets left margin a t 40 1445IF C$="Y" VDU2,1,27,1,64,1,27,1,108 ,1,40,3,15 1450ENDPROC 1460: 1470DEF PROCcentre(S$) 1480PRINTTAB((39-LENS$)DIV2)S$ 1490ENDPROC 1600: 1610DEF PROCerror(n%) 1620L%=LEN(errmess$(n%)) 1630PRINT'TAB((39-L%)DIV2)CHR$129CHR$13 6;errmess$(n%) 1640TIME=0:REPEAT UNTIL TIME>200 1650PRINTTAB((39-L%)DIV2,VPOS-1)SPC(L%+ 2) 1660mistake=TRUE 1670ENDPROC 1680: 1690DEF PROCrepeat 1700CLS:PRINTTAB(5,10)CHR$135CHR$157CHR $129"Repeat this routine Y/N "CHR$156; 1710REPEAT:A$=GET$ 1720UNTIL INSTR("YNyn",A$)>0 1730norepeat=(INSTR("Nn",A$)>0) 1740ENDPROC 1750: 1760DEF PROCdeskcal 1770PROCtestbuffer 1780REMREPEAT 1790CLS:FORY%=0TO1:PROCcentre(CHR$134+C HR$157+CHR$132+CHR$141+"DESK CALENDAR "+CHR$156):NEXT 1800VDU28,0,24,39,3 1810PRINT''CHR$134;"Enter year required : "; 1820REPEAT:mistake=FALSE 1830INPUTTAB(22,2)SPC6;TAB(22,2) year% 1840IF year%<1752 OR year%>4000 THEN PR OCerror(3) 1850UNTIL NOT mistake 1860PRINT''CHR$131;"Enter number of fir st month: "; 1870REPEAT:mistake=FALSE 1880INPUTTAB(30,5)" "TAB(30,5) startmo nth% 1890IF startmonth%<1 OR startmonth%>12 THEN PROCerror(2) 1900UNTIL NOT mistake 1910PRINT''CHR$134;"Enter number of mon ths: "; 1920REPEAT:mistake=FALSE 1930INPUTTAB(25,8)" "TAB(25,8) nm% 1940IF nm%>12 THEN PROCerror(2) 1950UNTIL NOT mistake 1955startmonth%=startmonth%-1:IF startm onth%=0 startmonth%=12 1962month%=startmonth% 1965IF startmonth%=12 year%=year%-1 1970day%=FNzeller(1,startmonth%,year%) 1985CLS:PROConepersheet 1995VDU26,12 2000daysinmonth%(2)=28 2020ENDPROC 2030: 2040DEF PROConepersheet 2042REM rday%, rmonth% - date for entry from file DATES 2044REM month%=startmonth%; nm%=number of months 2046REM day%=day of week, 0 (Saturday) to 6 (Friday); dy%=day of month 2048REM bhd%=date of bankholiday; bhm%= month of bank holiday 2050PROCcalc`hols(year%) 2100IF month%=1 THEN I%=0 ELSE PROCfind startofhols 2105REM I% is the number, 1 to 9 of ban kholiday 2110PROCnextbankholiday 2112PROCspill 2116PROCcalc`hols(year%):IF month%=1 TH EN I%=0 ELSE PROCfindstartofhols 2118PROCnextbankholiday:A%=0 2130FOR m%=1 TO nm% 2135IF FNleap(year%) daysinmonth%(2)=29 ELSE daysinmonth%(2)=28 2145IF A%=0 PROCprintmonth 2150FOR dy%=1 TO daysinmonth%(month%) 2160PRINT SPC(margin%);LEFT$(day$(day%) ,3);SPC(2+(dy%>9));dy%;SPC(2); 2170IF bhd%=dy% AND bhm%=month% THEN PR INT bh$;:PROCnextbankholiday 2185PRINT:B%=B%+1:A%=0 2190IF dy%=daysinmonth%(month%) AND B%< >14 month%=month%+1:PROCprintmonth2:mont h%=month%-1:A%=1:GOTO 2200 2195IF day%=1 OR day%=6 PRINT dot$ ELSE PRINT U$ 2200day%=day%+1:IF day%=7 THEN day%=0 2207IF B%=14 A=GET:B%=0:PRINT:PRINT:IF dy%<>daysinmonth%(month%) PROCprintmonth 2210NEXT dy% 2240month%=month%+1:IF month%=13 THEN m onth%=1:year%=year%+1:PROCcalc`hols(year %):I%=0:PROCnextbankholiday 2250NEXT m% 2255PROCgather 2265VDU 1,27,1,64,3 2280ENDPROC 2290: 2401DEF PROCprintmonth 2402IF month%=13 month%=1:year%=year%+1 2405PRINT TAB(15)month$(month%)" ";year % 2406ENDPROC 2408: 2411DEF PROCprintmonth2 2415IF month%=13 month%=1:year%=year%+1 2419T%=LEN(month$(month%)) 2421IF day%=1 OR day%=6 U1$=STRING$(10, "=") ELSE U1$=STRING$(10,"-") 2423IF day%=1 OR day%=6 U2$=STRING$(18- T%,"=") ELSE U2$=STRING$(18-T%,"-") 2427PRINTTAB(4)U1$;TAB(15)month$(month% )" ";year%;TAB(21+T%)U2$ 2431ENDPROC 2440 2460DEF PROCfindeasterin(X) 2470A=X-19*INT(X/19):B=INT(X/100) 2480C=X-100*B:D=INT(B/4) 2490E=B-4*D:G=INT((8*B+13)/25) 2500F=19*A+B-D-G+15:Z1=INT(F/30) 2510H=F-30*Z1:M=INT((A+11*H)/319) 2520I=INT(C/4):K=C-4*I 2530Q=2*E+2*I-K-H+M+32 2540Z2=INT(Q/7):L=Q-7*Z2 2550R=H-M+L+90:M%=R/25 2560Z3=INT((H-M+L+M%+19)/32) 2570D%=H-M+L+M%+19-32*Z3 2580ENDPROC 2590: 2600DEF PROCcalc`hols(Y%) 2610daysinmonth%(2)=28-FNleap(Y%) 2620LOCAL m%,M%,d%,D% 2630d%=FNzeller(1,1,Y%) 2640IF d%>1 THEN dy$="1" ELSE dy$=STR$( 3-d%) 2650insert$(1)="0"+dy$+"01Bank Holiday" 2660PROCfindeasterin(Y%) 2670insert$(3)=RIGHT$("0"+STR$(D%),2)+" 0"+STR$(M%)+"Easter Day" 2680m%=M%:d%=D%-2:IF d%<1 THEN d%=d%+31 :m%=M%-1 2690insert$(2)=RIGHT$("0"+STR$(d%),2)+" 0"+STR$(m%)+"Good Friday - b.h." 2700m%=M%:d%=D%+1:IF d%>31 THEN d%=1:m% =m%+1 2710insert$(4)=RIGHT$("0"+STR$(d%),2)+" 0"+STR$(m%)+"Bank Holiday" 2720d%=FNzeller(1,5,Y%):C%=1 2730IF d%<>2 THEN REPEAT:d%=d%+1:C%=C%+ 1:d%=ABS(d%<7)*d%:UNTIL d%=2 2740insert$(5)="0"+STR$(C%)+"05Bank Hol iday" 2750d%=FNzeller(31,5,Y%):C%=31 2760IF d%<>2 THEN REPEAT:d%=d%-1:C%=C%- 1:d%=ABS(d%<0)*7+d%:UNTIL d%=2 2770insert$(6)=STR$(C%)+"05Bank Holiday " 2780d%=FNzeller(31,8,Y%):C%=31 2790IF d%<>2 THEN REPEAT:d%=d%-1:C%=C%- 1:d%=ABS(d%<0)*7+d%:UNTIL d%=2 2800insert$(7)=STR$(C%)+"08Bank Holiday " 2810d%=FNzeller(25,12,Y%):C%=1 2820insert$(8)="2512Christmas Day" 2830d%=FNzeller(26,12,Y%) 2840IF d%>2 THEN insert$(9)="2612Bank H oliday" ELSE insert$(9)=STR$(26+2-d%)+"1 2Bank Holiday" 2850ENDPROC 2860: 2870DEF PROCnextbankholiday 2880I%=I%+1 2890bhd%=VAL(LEFT$(insert$(I%),2)) 2900bhm%=VAL(MID$(insert$(I%),3,2)) 2910bh$=" "+MID$(insert$(I%),5) 2920ENDPROC 2930: 2940DEF PROCfindstartofhols 2950I%=0:REPEAT:I%=I%+1:UNTIL VAL(MID$( insert$(I%),3,2))>=month% 2960I%=I%-1 2970ENDPROC 2980: 3260DEF PROCspill 3270B%=0 3280FOR dy%=1 TO daysinmonth%(month%) 3290PRINT SPC(margin%);LEFT$(day$(day%) ,3);SPC(2+(dy%>9));dy%;SPC(2); 3300IF bhd%=dy% AND bhm%=month% THEN PR INT bh$;:PROCnextbankholiday 3320PRINT::B%=B%+1 3330IF day%=1 OR day%=6 PRINT dot$ ELSE PRINT U$ 3340day%=day%+1:IF day%=7 THEN day%=0 3350D%=daysinmonth%(month%) 3370IF D%-dy%<=6 AND day%=1 PRINT "Now we start: insert paper":B%=0:A=GET 3380IF C$="Y" AND B%=0 VDU2,1,27,1,69 3390IF dy%<daysinmonth%(month%) AND B%= 0 PROCprintmonth 3400NEXT dy%:month%=month%+1:IF month%= 13 month%=1:year%=year%+1 3420ENDPROC 3430 3440DEF PROCgather 3450IF month%=13:month%=1:year%=year%+1 3460IF A%=0 PROCprintmonth:PRINT "3460" 3470FOR dy%=1 TO 7 3480PRINT SPC(margin%);LEFT$(day$(day%) ,3);SPC(2+(dy%>9));dy%;SPC(2); 3490IF bhd%=dy% AND bhm%=month%-1 THEN PRINT bh$;:PROCnextbankholiday 3510PRINT 3520IF day%=1 OR day%=6 PRINT dot$ ELSE PRINT U$ 3530day%=day%+1:IF day%=7 day%=0 3540IF day%=1 A=GET:ENDPROC 3550NEXT dy% 3560ENDPROC