0 'Z-CAL.BA  Alan L. Zeichick
1 'CLUB 100 Library - 415/939-1246 BBS,    937-5039 NEWSLETTER, 932-8856 VOICE
2 'changes in lines 24,26,32,35,38,42
3 '      24: Print wide/bold month
4 '  others: Decrease left margin
5 '
10 'Initialize the arrays
11 DIMDN$(7),MN$(12),MS(12):FORCT=1TO7:READDN$(CT):NEXTCT:DATA Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday
12 FORCT=1TO12:READMN$(CT),MS(CT):NEXTCT
13 DATA January,31,February,28,March,31,April,30,May,31,June,30,July,31,August,31,September,30,October,31,November,30,December,31
14 'Get the date and number of months
15 CLS:CALL17001:PRINT@12," Print Calendar ":CALL17006:PRINT@85,"Alan L. Zeichick
16 CALL17001:PRINT@160," Enter starting month and year (MM,YY): ":CALL17006:PRINT@255,;:INPUTMM,YY:IFYY<100THENYY=YY+1900
17 CALL17001:PRINT@160,"   How many calenders should I make?   ":CALL17006:PRINT@255,"     ";:INPUTNM:FORLP=1TONM
18 ' Calculate starting date
19 IFMM>2THENWD=365*YY+1+31*(MM-1)-INT(.4*MM+2.3)+INT(YY/4)-INT(3/4*INT((YY/100)+1)):GOTO21
20 WD=365*YY+1+31*(MM-1)+INT((YY-1)/4)-(INT(3/4*INT(((YY-1)/100)+1)))
21 WD=WD-INT(WD/7)*7:IFWD<1THENWD=7
22 DY=MS(MM):IFMM=2 ANDYY MOD4=0 ANDYY MOD100<>0THENDY=29
23 'Print the month name
24 TT$=MN$(MM)+","+STR$(YY):SP=(32-LEN(TT$))/2+10:LPRINTCHR$(27)"!"CHR$(27)"Q"TAB(SP)TT$;CHR$(27);CHR$(34);CHR$(27)"R":LPRINT:LPRINT
25 'Print day names
26 FORDC=1TO7:SP=(6-LEN(DN$(DC)))/2+1+DC*10:LPRINTTAB(SP)DN$(DC);:NEXTDC:LPRINT
27 ' Back up to Sunday and begin
28 SD=2-WD:WK=INT(((MS(MM)+WD-8)/7)+2)
29 'Repeat for each week in the month
30 FORWC=1TOWK
31 'Print the top dividing line
32 LPRINTSPACE$(8);
33 FORDC=1TO7:LPRINT"+---------";:NEXTDC:LPRINT"+"
34 ' Print the date line
35 LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"|";:IFSD>=1 ANDSD<=DYTHENLPRINTUSING"#########";SD;ELSELPRINT"         ";
36 SD=SD+1:NEXTDC:LPRINT"|"
37 'Print the day boxes
38 FORBC=1TO7:LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"|         ";:NEXTDC:LPRINT"|":NEXTBC
39 'End the each-week loop
40 NEXTWC
41 'Print the bottom dividing line
42 LPRINTSPACE$(8);:FORDC=1TO7:LPRINT"+---------";:NEXTDC:LPRINT"+"
43 'Page eject, go to next month
44 LPRINTCHR$(12):MM=MM+1:IFMM>12THENYY=YY+1:MM=12
45 NEXTLP:MENU