90 REM * CODEWORKS 3838 S.WARNER ST. TACOMA WA 98409 95 REM * 206 475-2219 : PLEASE DO NOT REMOVE THESE CREDIT LINES. 100 REM ** CAL.BAS * WRITTEN FOR CODEWORKS MAGAZINE ** 105 REM * Adapted for the Model 100, Tandy 200, and NEC 8201 by Dave Thomas 110 CLEAR 1000:DIM A$(15):CLS 150 PRINT STRING$(12,"-");" The CodeWorks ";STRING$(13,"-"); 160 PRINT" C A L E N D A R P R O G R A M" 170 PRINT" prints a calendar for any year" 175 PRINT" from 1753 to 3999" 180 PRINT STRING$(40,"-"); 200 REM ** INITIALIZATION ** 210 REM 012345678901234567890123456789012345678901234567890 220 D$=" 1 2 3 4 5 6 7 8 910111213141516171819202122232425262728293031 230 REM 012345678901234567890123456789012345678901234567890 240 FM$=" \\":HW$=" SUN MON TUE WED THU FRI SAT" 250 H$=" \ \ ####" 260 PRINT"Use SHIFT/BREAK to end program." 270 INPUT"CALENDAR for what year";Y 280 REM ** GO PRINT THE YEAR HEADING ** 290 GOSUB 730 300 REM ** PRINT THE CALENDAR ** 310 FOR MB=1 TO 12 STEP 2 320 MC=MB:YC=Y:GOSUB 550:W1=W 330 MC=MB+1:YC=Y:GOSUB 550:W2=W 340 MC=MB:GOSUB 690:M1$=MY$ 350 MC=MB+1:GOSUB 690:M2$=MY$ 360 LPRINT" ":LPRINT USING H$;M1$;Y;M2$;Y 370 LPRINT HW$;HW$ 380 MC=MB:GOSUB 610:D1=DM:MC=MB+1:GOSUB 610:D2=DM 390 FOR I=1 TO 6 400 LPRINT" "; 410 FOR J=1 TO 7:E1=((I-1)*7+J+6-W1)*2-1 420 IF((I-1)*7+J)>D1+W1 THEN DY$=" "ELSE DY$=MID$(D$,E1,2) 430 LPRINT USING FM$;DY$; 440 NEXT J 450 LPRINT" "; 460 FOR J=1 TO 7:E2=((I-1)*7+J+6-W2)*2-1 470 IF((I-1)*7+J)>D2+W2 THEN DY$=" "ELSE DY$=MID$(D$,E2,2) 480 LPRINT USING FM$;DY$; 490 NEXT J 500 LPRINT" " 510 NEXT I 520 NEXT MB 530 RUN 110 540 REM ** DAY OF THE WEEK ROUTINE 550 IF MC>2 THEN 560 ELSE MC=MC+12:YC=YC-1 560 W=1+2*MC+INT(.6*(MC+1))+YC+INT(YC/4)-INT(YC/100)+INT(YC/400)+2 570 W=W-INT(W/7)*7 580 W=W+6:W=W-INT(W/7)*7 590 RETURN 600 REM ** NUMBER OF DAYS IN THE MONTH ** 610 IF MC<>2 THEN 630 ELSE LP=0 620 IF(Y-INT(Y/4)*4)=0 THEN IF((Y-INT(Y/100)*100)=0)AND((Y-INT(Y/400)*400)<>0) THEN LP=0 ELSE LP=1 630 M$="312831303130313130313031" 640 DM=VAL(MID$(M$,2*MC-1,2)) 650 IF MC=2 THEN DM=DM+LP 660 RETURN 670 REM ** MONTH OF THE YEAR ** 680 REM 012345678901234567890123456789012345678901234567890 690 MN$="JANUARY FEBRUARY MARCH APRIL MAY " +"JUNE JULY AUGUST SEPTEMBEROCTOBER " +"NOVEMBER DECEMBER " 700 MY$=MID$(MN$,(MC-1)*9+1,9):RETURN 710 END 720 REM ** PRINT YEAR HEADING ROUTINE ** 730 YD$=STR$(Y) 740 FOR I=1 TO 4 750 DG(I)=ASC(MID$(YD$,I+1,1))-48 760 NEXT I 770 FOR L=1 TO 7 780 READ ST$ 790 I6=2 800 FOR I=1 TO 10 810 Z$(I)=MID$(ST$,I6,5) 820 I6=I6+6 830 NEXT I 840 FOR D=1 TO 4:LPRINT TAB(D*10+15);Z$(DG(D)+1);:NEXT D 845 LPRINT"" 850 NEXT L 860 LPRINT" ":LPRINT" " 870 REM* 123456123456123456123456123456123456123456123456123456123456 880 DATA . WW WW WWW WWWW W WWWW WWWW WWWW WWWW WWWW 890 DATA .W W W W W W W W W W W W W 900 DATA .W W W W WW W W W W W W W W W 910 DATA .W W W W WWW WWWW WWWW WWWW W WWWW WWWW 920 DATA .W W W W WW W W W W W W W W 930 DATA .W W W W W W W W W W W W W 940 DATA . WW WWW WWWW WWWW W WWWW WWWW W WWWW WWW 950 RETURN