5 DEFINT A-Z
10 'Program Name: CALENDAR.BAS - Last Updated: 01/07/82 IJK for IBN-PC
12 '
14 'Downloaded from MBBS Atlanta, Georgia - 404-872-3430
16 '
17 'Download time: 5 Minutes and 2 seconds.
18 '
20 CLEAR 4000:RESTORE
22 KEY OFF
25 '
30 DEF FNP%(X%,Y%)=X%*64+Y%
33 DEF FNROW%(PRINT.POS%) = (PRINT.POS% \ 64) + 1
36 DEF FNCOLUMN%(PRINT.POS%) = (PRINT.POS% - (PRINT.POS% \ 64) * 64) + 1 + 8
38 DEF FNCLEARLINE$ = STRING$(79-POS(0),32) + STRING$(79-POS(0),29)
40 DIM N$(31),N%(37),A%(37),ND%(12),MN$(12)
45 '
50 'N$  = STR$(1..31), N% = INT((DAY-1)/7)+1 (LINE # ON SCREEN)
60 'A% = PRINT @ FOR DAY #'S, ND%(1..12) = # DAYS IN MONTH 
70 'MN$= Month Name 
75 '
100 FOR I%=1 TO 10 : KEY I%,"" : NEXT I%
110 'FUNCTION TO COMPUTE DAY OF WEEK
115 '
120 DEF FND%(X)=X+(FIX(-X/7)*7) 
125 '
130 ' 0-6 = SAT-FRI 
135 '
140 DEF FNE%(X%)=VAL(MID$("6012345",X%+1,1))
145 '
150 'FUNCTION TO GET NAME OF DAY OF WEEK
160 ' 
170 DEF FNN$(DW%)=MID$("SATSUNMONTUEWEDTHUFRI",(DW%+1)*3-2,3) 
180 ' 
182 '* Initialize Special Ascii Codes *
184 COMMAND$="Press "+CHR$(24)+", "+CHR$(25)+", "+CHR$(26)+", "+CHR$(27)+", "
185 COMMAND$=COMMAND$+"<ENTER>, ? for help, or <ESC> to Quit" : GOSUB 5000
188 ' 
195 LEFT.ARROW% = 75 : RIGHT.ARROW% = 77 : UP.ARROW% = 72 : DOWN.ARROW% = 80
200 '
205 DEF SEG=0 : POKE 1047, (PEEK(1047) OR 32) - 32 ' NUM LOCK off
210 GOSUB 2000  ' Instructions!
215 '
220 'SET UP ARRAY (# Days in Month)
230 '
240 FOR I%=1 TO 12 : READ ND%(I%) : NEXT I% 
250 FOR I%=1 TO 12 : READ MN$(I%) : NEXT I% 
260 ' 
270 ' 
280 '* Initialize Arrays with Print @ positions, etc. *
290 ' 
300 FOR I%=1 TO 37
310     IF I%<=31 THEN N$(I%)=STR$(I%)
320     N%(I%)=INT((I%-1)/7)
330     A%(I%)=(N%(I%)+2)*128+(I%-N%(I%)*7)*7+4 
340 NEXT I% 
350 ' 
420 'Clear Screen... 
430 ' 
440 CLS : LOCATE ,,0
450 ' 
460 M%=1 ' January
470 Y%=1983 ' Starting Year 
480 GOSUB 1060 ' Month Name at top of Screen 
490 ' 
500 GOSUB 840 ' Calculate Month Data 
510 '
520 GOSUB 920 ' Display Month on Screen
530 ' 
540 MC%=0:YC%=0
545 IN$=INKEY$ : IF LEN(IN$)<1 THEN POKE 1047, (PEEK(1047) OR 32) - 32:GOTO 545
550 IF LEN(IN$)>1 THEN 570
555 IF IN$=CHR$(27) THEN CLS : GOSUB 12000 : END ' End stuff
560 IF IN$=CHR$(13) THEN GOSUB 970 : GOTO 640 '* Specify Month/Year *
562 IF IN$="/" OR IN$="?" THEN IN%=(0=0) : RESTORE : GOSUB 2003 : GOSUB 1050 : GOSUB 1060 : GOTO 520
565 BEEP : GOTO 545
570 CODE.ENTERED%=ASC(RIGHT$(IN$,1))
580 IF CODE.ENTERED%=UP.ARROW%    THEN MC%=-1
585 IF CODE.ENTERED%=DOWN.ARROW%  THEN MC%=+1
590 IF CODE.ENTERED%=LEFT.ARROW%  THEN YC%=-1
600 IF CODE.ENTERED%=RIGHT.ARROW% THEN YC%=+1
610 IF YC%=0 AND MC%=0 THEN BEEP : GOTO 545
620 M%=M%+MC%:Y%=Y%+YC%+(M%<1)-(M%>12) 
630 M%=-(M%<1)*12-(M%>12)-M%*(M%>0 AND M%<13) 
640 IN$=INKEY$ : IF IN$="" THEN CLS : GOTO 480 ELSE 550
650 IF M%<3 THEN 680
660 F=365*Y%+31*(M%-1)+D%-FIX(.4*M%+2.3)+FIX(Y%/4)-FIX(.75*(INT(Y%/100)+1)) 
670 GOTO 690
680 F=365*Y%+(M%-1)*31+D%+FIX((Y%-1)/4)-FIX((3/4)*(FIX(((Y%-1)/100)+1)))
690 RETURN
700 ' 
710 '* Calculate Date of First Day of Month # M% * 
720 '* (Year # Y%, Day # D% - Value returned is  * 
730 '* 0-6 (Sat.-Fri.).......................... *
740 ' 
750 D%=1:GOSUB 650 
760 FD%=FND%(F) 
770 RETURN
780 ' 
790 '* Routine to Calculate Next Month Number * 
800 ' 
810 M%=M%+1 
820 Y%=-(M%>12)+Y%
830 M%=-(M%>12)-(M%<=12)*M% 
840 MD%=ND%(M%)-(M%=2 AND Y%=FIX(Y%/100)*100 AND Y%=FIX(Y%/400)*400)-(M%=2 AND Y%<>FIX(Y%/100)*100 AND Y%=FIX(Y%/4)*4)
850 D%=1:GOSUB 650:GOSUB 760
860 RETURN
870 ' 
880 '* Routine to Display Current Month      *
890 '* FD% = Day of Week of Day #1 in Month! * 
900 '* M%  = Month Number, Y% = Year         *
910 ' 
920 ST%=FNE%(FD%)+1  ' Starting Subscript in Array A%
930 FOR I%=ST% TO ST%+MD%-1     ' MD% days on screen
935     PRINT.POSITION%=A%(I%)-LEN(N$(I%-ST%+1))
940     LOCATE FNROW%(PRINT.POSITION%),FNCOLUMN%(PRINT.POSITION%)
945     PRINT N$(I%-ST%+1);
950 NEXT I% 
955 M$=COMMAND$
957 GOSUB 5000
960 RETURN
970 LOCATE 22,1 : PRINT FNCLEARLINE$;"Enter Desired Month (1-12) : ";:V$="01234567890":GOSUB 15120: M$=FL$
980 IF M$="" THEN 1030
990 IF VAL(M$)<1 OR VAL(M$)>12 THEN M$="Enter 1-12 ONLY!":GOSUB 1040:GOTO 970 
1000 M%=VAL(M$) 
1010 LOCATE 23,1 : PRINT "Enter Desired Year (4 char.) : "; : V$="0123456789" : GOSUB 15120
1015 IF FL$="" THEN RETURN ELSE Y$=FL$
1020 Y%=VAL(Y$):IF Y%<999 THEN Y%=Y%+1900
1030 LOCATE 22,1 : FOR I%=1 TO 2 : PRINT FNCLEARLINE$ : NEXT I% : RETURN
1040 GOSUB 5000
1045 BEEP
1050 FOR K%=1 TO 2000:NEXT K%:RETURN
1060 ST$="* "+MN$(M%)+","+STR$(Y%)+" *" 
1070 LOCATE 1,1 : PRINT FNCLEARLINE$;TAB(40-LEN(ST$)/2);ST$;
1080 LOCATE 3,18 : PRINT  "SUN    MON   TUES    WED   THURS   FRI    SAT";
1090 LOCATE 4,18 : PRINT  "---------------------------------------------";FNCLEARLINE$;
1140 RETURN
2000 GOSUB 6000:IN%=(IN$="Y"):
2003 CLS
2005 DATA "CALENDAR.BAS - IBM-PC Version"
2010 DATA "-----------------------------"
2013 '
2016 'Now, if y'all don't want to see my name on this program,
2017 'feel free to substitute whatever you deem appropriate...
2018 '
2020 DATA "Written by Irvan J. Krantzler"
2025 DATA $2
2030 DATA "     This program will display the calendar of virtually any"
2040 DATA "month that you  desire.   It will start up  with the default"
2050 DATA "month and year already set.                                 "
2070 DATA "$2"
2080 DATA "   In order to use this program, all you need to do is press"
2090 DATA "one  of  the  arrow  keys which will move the  month  number"
2100 DATA "forwards  and backwards  (up and down arrows)  or change the"
2110 DATA "year in the same manner  (left arrow is one year ago,  right"
2120 DATA "arrow is one year later).  In order to specify a date, press"
2130 DATA "<ENTER> and  you will be  prompted to  enter a  month  and a"
2140 DATA "year  (4 digits).  To quit, press the <ESC> key and you will"
2150 DATA "exit to BASIC.....Have fun, y'all!                          "
2160 DATA "$END"
2170 '
2172 MAX%=20   'Maximum number of lines per screen!
2175 LC%=0     'Line Counter for multiple-screens
2180 READ A$
2185 IF A$="$END" THEN IF NOT IN% THEN RETURN ELSE M$="Press any key to begin.":GOSUB 5000:GOSUB 3100:GOSUB 3040:RETURN ELSE IF NOT IN% THEN 2180
2190 IF LEFT$(A$,1)="$" THEN GOSUB 2500:GOTO 2180
2195 LC%=LC%+1:IF LC%>MAX% THEN GOSUB 3000'Another screen!
2200 PRINT STRING$(40-FIX(LEN(A$)/2),32);A$
2210 GOTO 2180
2470 '
2480 'Print ML% blank lines.
2490 '
2500 ML%=VAL(RIGHT$(A$,LEN(A$)-1))
2510 IF ML%=0 THEN RETURN
2520 FOR IL%=1 TO ML%
2530    PRINT:LC%=LC%+1:IF LC%>MAX% THEN GOSUB 3000' Another Screen
2540 NEXT IL%
2550 RETURN
3000 M$="Press any key to continue instructions....."
3010 GOSUB 5000
3020 GOSUB 3100        'Wait for keypress
3030 LC%=0             'Zero Line Counter
3040 CLS
3050 RETURN
3100 IF INKEY$="" THEN 3100 ELSE RETURN '* Wait for a key *
5000 LOCATE 22,1 : PRINT FNCLEARLINE$;TAB(40-LEN(M$)/2);M$;:RETURN
6000 CLS : LOCATE ,,1 : PRINT "Do you need instructions (Y/N) ? ";
6020 IN$=INKEY$:IF IN$="" THEN 6020
6040 IN$=CHR$( (ASC(IN$) OR 32)-32)
6050 IF INSTR("YN",IN$) THEN LOCATE ,,0
6060 IF IN$="N" THEN PRINT "No":RETURN
6080 IF IN$="Y" THEN PRINT "Yes":RETURN
6090 M$="Press 'Y' or 'N' ONLY!":GOSUB 1040:GOTO 6000
8000 DATA 31,28,31,30,31,30,31,31,30,31,30,31
8010 DATA "January","February","March","April","May","June"
8020 DATA "July","August","September","October","November"
8030 DATA "December"
9000 '
9010 'Note: PLEASE pardon the sloppy condition of this pgm.
9020 '      If it looks like it was thrown together in short
9030 '      order, that's because it was!!! Thanks,   IJK
9040 '
10000 '
10010 'End stuff - Set up <F2> for 'RUN'
10020 '
12000 LOCATE 1,22 : COLOR 7,0 : PRINT "Press ";
12010 COLOR 8,7 : PRINT " F2 ";
12020 COLOR 7,0 : PRINT " to use this program again."
12030 PRINT
12040 KEY 2, "RUN" + CHR$(13)
12050 RETURN
15120 FL$="":LOCATE ,,1
15140 A$=INKEY$ : IF A$="" THEN GOSUB 15500:GOTO 15140 ELSE A$=CHR$(((ASC(A$)>96) AND (ASC(A$)<123))* 32+ASC(A$))
15160 IF ASC(A$)<32 THEN 15260
15180 IF INSTR(V$,A$)=0 THEN BEEP:GOTO 15140
15200 IF LEN(FL$)>20 THEN BEEP:GOTO 15140
15220 PRINT A$;
15240 FL$=FL$+A$ : GOTO 15140
15260 A%=ASC(A$)
15280 IF A%=13 THEN LOCATE ,,0:RETURN
15300 IF A%=27 THEN IF LEN(FL$)>0 THEN PRINT STRING$(LEN(FL$),29);STRING$(LEN(FL$),32);STRING$(LEN(FL$),29);:GOTO 15120
15320 IF A%<>8 THEN BEEP:GOTO 15140
15340 IF LEN(FL$)<1 THEN BEEP:GOTO 15140
15360 PRINT CHR$(29);" ";CHR$(29);:FL$=LEFT$(FL$,LEN(FL$)-1):GOTO 15140
15500 POKE 1047, (PEEK(1047) OR 32) : RETURN 'NUM LOCK on
50000 '****** End of program listing ******
EN(FL$)-1):GOTO 15140
15500 POKE 1047, (PEEK(1047) OR 32) : RETURN 'NUM LOCK on
50000 '****** En of program listing ******
EN(FL$)-1):GOTO 15140
15500 POKE 1047, (PEEK(1047) OR 32) : RETURN 'NUM LOCK on
50000 '****** En