1  REM  ****  HP BASIC PROGRAM LIBRARY  *******************************
2  REM
3  REM        CALNDR:   PRINTS A CALENDAR
4  REM
5  REM        36288 REV  A   6/73
6  REM
7  REM  ****  CONTRIBUTED PROGRAM  ************************************
1000  REM ** CALENDAR DEMONSTRATION **
1010  REM ** WRITTEN BY STEVE HTDPHCK **
1020  DIM Y$[72],Z$[72],A[504],B$[72],B[12],E[42,12],J$[72],M$[72],C$[72]
1030  DIM L[80],F$[72],P$[72],U$[72],L$[72],T$[72],S$[72],O$[72],N$[72]
1040  DIM A$[72],G$[72],H$[72],I$[72],E$[72],D$[72]
1050  REM * SETS OUTPUT STRING TO SPACES
1060  LET Y$[1,72]=" "
1070  LET Z$[1,72]=" "
1080  LET K0=S1=0
1090  LET H$="0123456789"
1100  REM * READS LAST DAY OF MONTH
1110  FOR I=1 TO 12
1120  READ B[I]
1130  NEXT I
1140  DATA 31,28,31,30,31,30,31,31,30,31,30,31
1150  PRINT 
1160  LET G$=" S  M  T  W  T  F  S"
1170  REM * INPUT DATA SECTION
1180  PRINT '10"CALENDAR FOR WHAT YEAR";
1190  INPUT J$
1200  LET I$=J$
1210  IF J$="END" THEN 4030
1220  IF J$="STOP" THEN 4030
1230  IF J$="AID" THEN 1830
1240  LET Y=0
1250  FOR I=1 TO LEN(J$)
1260  FOR J=1 TO 10
1270  IF J$[I,I]=H$[J,J] THEN 1300
1280  NEXT J
1290  GOTO 1350
1300  LET Y=Y*10+J-1
1310  NEXT I
1320  GOSUB 3900
1330  IF Y#INT(Y) OR Y<0 THEN 1350
1340  GOTO 1370
1350  PRINT "     ENTRY IGNORED, INVALID YEAR."
1360  GOTO 1180
1370  IF Y<1582 THEN 1830
1380  IF Y>2^23-1 THEN 1830
1390  PRINT '10"ANY PARTICULAR MONTH (Y OR N)";
1400  INPUT B$
1410  IF B$="END" THEN 1180
1420  IF B$="STOP" THEN 4030
1430  IF B$[1,1]="Y" THEN 1470
1440  IF B$[1,1]="N" THEN 1660
1450  PRINT "     ANSWER 'Y' OR 'YES'.....'N' OR 'NO'"
1460  GOTO 1390
1470  PRINT '10"WHAT MONTH";
1480  INPUT C$
1490  IF C$="STOP" THEN 4030
1500  IF C$="END" THEN 1390
1510  IF C$#"AID" THEN 1540
1520  PRINT "     ENTER '1' FOR JANUARY, '2' FOR FEBRUARY, ETC."
1530  GOTO 1470
1540  LET B1=0
1550  FOR I=1 TO LEN(C$)
1560  FOR J=1 TO 10
1570  IF C$[I,I]=H$[J,J] THEN 1600
1580  NEXT J
1590  GOTO 1640
1600  LET B1=B1*10+J-1
1610  NEXT I
1620  IF B1 <= 0 OR B1>12 OR B1#INT(B1) THEN 1640
1630  GOTO 1660
1640  PRINT "     ENTRY IGNORED, INVALID MONTH."
1650  GOTO 1470
1660  IF B$[1,1]="N" THEN 1810
1670  PRINT '10'10'10'10'10
1680  GOSUB 3510
1690  REM * SPACE COUNTER
1700  LET X3=0
1710  FOR S3=1 TO 5
1720  IF C$[S3,S3]=" " THEN 1740
1730  GOTO 1760
1740  LET X3=X3+1
1750  NEXT S3
1760  PRINT TAB(19-X3);C$;TAB(38-LEN(I$));I$
1770  PRINT 
1780  PRINT TAB(18);G$
1790  GOTO 2120
1800  REM * PAGE SEPERATOR
1810  GOSUB 4040
1820  IF Y >= 1582 THEN 1860
1830  PRINT "     ENTER A YEAR AFTER 1581 AND BEFORE 8388608."
1840  GOTO 1180
1850  REM * HEADINGS
1860  PRINT 
1870  PRINT TAB(23);"CALENDAR FOR THE YEAR ";I$
1880  PRINT 
1890  LET I=1
1900  PRINT 
1910  PRINT 
1920  PRINT 
1930  REM * TAB VALUES
1940  LET B=5
1950  LET C=31
1960  LET D=55
1970  REM * K0= NO OF GROUPS OF 3 MONTHS PRINTED
1980  LET K0=K0+1
1990  GOTO K0 OF 2010,2030,2050,2070
2000  REM * PRINTS MONTH HEADINGS
2010  PRINT TAB(B);J$;TAB(C);F$;TAB(D);M$
2020  GOTO 2080
2030  PRINT TAB(B);P$;TAB(C);E$;TAB(D);U$
2040  GOTO 2080
2050  PRINT TAB(B);L$;TAB(C);T$;TAB(D);S$
2060  GOTO 2080
2070  PRINT TAB(B);O$;TAB(C);N$;TAB(D);D$
2080  PRINT 
2090  PRINT G$;TAB(25);G$;TAB(50);G$
2100  GOTO I OF 2120,2870,2880,2880
2110  REM * CHECKS FOR LEAP YEARS
2120  LET H=7
2130  LET L=0
2140  LET L=INT((Y-1201)/400)-INT((Y-1501)/100)+INT((Y-1581)/4)
2150  LET I1=Y-INT(Y/100)*100
2160  IF I1 <> 0 THEN 2190
2170  IF I1-INT(I1/4)*4=0 THEN 2210
2180  GOTO 2290
2190  IF Y-INT(Y/4)*4=0 THEN 2210
2200  GOTO 2290
2210  FOR X=1600 TO Y STEP 400
2220  IF Y=X THEN 2260
2230  NEXT X
2240  GOSUB 3780
2250  IF S1=1 THEN 2290
2260  LET R=366
2270  LET B[2]=29
2280  GOTO 2300
2290  LET R=365
2300  LET M=365*(Y-1583)+L
2310  LET N=M-INT(M/7)*7
2320  REM * ROUTINE TO DETERMINE PROPER DATES
2330  LET H=H+N
2340  IF H <= 7 THEN 2360
2350  LET H=H-7
2360  GOTO 2370
2370  FOR S=1 TO 12
2380  FOR T=1 TO H-1
2390  LET E[T,S]=0
2400  NEXT T
2410  FOR T=H TO B[S]+H-1
2420  LET E[T,S]=T-H+1
2430  NEXT T
2440  FOR T=B[S]+H TO 42
2450  LET E[T,S]=0
2460  NEXT T
2470  LET H=H+B[S]-INT(B[S]/7)*7
2480  IF H <= 7 THEN 2500
2490  LET H=H-7
2500  NEXT S
2510  LET Q=0
2520  LET W=0
2530  FOR V=1 TO 12
2540  FOR U=1 TO 42
2550  LET W=W+1
2560  LET A[W]=E[U,V]
2570  NEXT U
2580  NEXT V
2590  IF B$[1,1]="N" THEN 2880
2600  FOR X=0 TO 5
2610  LET I=-2
2620  LET J=0
2630  FOR V=1 TO 7
2640  LET I=I+3
2650  LET J=J+3
2660  LET A=A[V+7*X+42*B1-42]
2670  LET A1=INT(A/10)
2680  LET B=A-A1*10
2690  IF A=0 THEN 2740
2700  LET C$[1,1]=H$[A1+1,A1+1]
2710  LET C$[2,2]=H$[B+1,B+1]
2720  IF A<10 THEN 2770
2730  GOTO 2750
2740  LET C$="   "
2750  LET A$[I,J]=C$
2760  GOTO 2800
2770  LET A$[I,I]=" "
2780  LET C$[1,1]=" "
2790  LET A$[I,J]=C$
2800  NEXT V
2810  PRINT TAB(18);A$
2820  NEXT X
2830  PRINT 
2840  PRINT 
2850  GOTO 3390
2860  REM
2870  REM
2880  FOR X=0 TO 5
2890  LET R=-2
2900  LET S=0
2910  FOR U=0 TO 2
2920  FOR V=1+7*X TO 7+7*X
2930  LET R=R+3
2940  LET S=S+3
2950  REM * TO RIGHT JUSTIFY OUTPUT DATE
2960  LET A=A[V+42*U]
2970  IF A=0 THEN 3050
2980  LET A1=INT(A/10)
2990  LET B=A-A1*10
3000  LET C$[1,1]=H$[A1+1,A1+1]
3010  LET C$[2,2]=H$[B+1,B+1]
3020  IF C$="0" THEN 3050
3030  IF A<10 THEN 3080
3040  GOTO 3060
3050  LET C$="   "
3060  LET Z$[R,S]=C$
3070  GOTO 3110
3080  LET Z$[R,R]=" "
3090  LET C$[1,1]=" "
3100  LET Z$[R,S]=C$
3110  NEXT V
3120  NEXT U
3130  REM * TO PLACE INTO STRING FOR OUTPUT
3140  FOR G=1 TO 21
3150  LET Y$[G,G]=Z$[G,G]
3160  NEXT G
3170  FOR G=1 TO 4
3180  LET Y$[21+G,21+G]=" "
3190  NEXT G
3200  FOR G=22 TO 42
3210  LET Y$[G+4,G+4]=Z$[G,G]
3220  NEXT G
3230  FOR G=1 TO 4
3240  LET Y$[46+G,46+G]=" "
3250  NEXT G
3260  FOR G=43 TO 63
3270  LET Y$[G+8,G+8]=Z$[G,G]
3280  NEXT G
3290  PRINT Y$
3300  NEXT X
3310  PRINT 
3320  FOR X=1 TO 378
3330  LET A[X]=A[X+126]
3340  NEXT X
3350  LET Q=Q+1
3360  IF Q=4 THEN 3390
3370  LET I=I+1
3380  GOTO 1910
3390  PRINT '10'10'10'10'10'10'10'10'10'10'10'10'13
3400  PRINT '10"MORE (Y OR N)";
3410  INPUT C$
3420  RESTORE 
3430  IF C$[1,1]="Y" THEN 1060
3440  IF C$[1,1]="N" THEN 4030
3450  IF C$="END" THEN 4030
3460  IF C$="STOP" THEN 4030
3470  PRINT "     ANSWER 'Y' OR 'YES'.....'N' OR 'NO'"
3480  GOTO 3400
3490  GOTO 3400
3500  REM * TO DETERMINE WHAT MONTH
3510  GOTO B1 OF 3530,3550,3570,3590,3610,3630,3650,3670,3690,3710,3730,3750
3520  RETURN 
3530  LET C$=J$
3540  RETURN 
3550  LET C$=F$
3560  RETURN 
3570  LET C$=M$
3580  RETURN 
3590  LET C$=P$
3600  RETURN 
3610  LET C$=E$
3620  RETURN 
3630  LET C$=U$
3640  RETURN 
3650  LET C$=L$
3660  RETURN 
3670  LET C$=T$
3680  RETURN 
3690  LET C$=S$
3700  RETURN 
3710  LET C$=O$
3720  RETURN 
3730  LET C$=N$
3740  RETURN 
3750  LET C$=D$
3760  RETURN 
3770  REM * DETERMINES IF CENTURY YEAR
3780  LET Z$=I$
3790  LET K=LEN(Z$)
3800  IF Z$[K-1,K-1]="0" THEN 3830
3810  LET S1=0
3820  RETURN 
3830  IF Z$[K,K]="0" THEN 3860
3840  LET S1=0
3850  RETURN 
3860  LET S1=1
3870  RETURN 
3880  END 
3890  PRINT 
3900  LET J$=" JANUARY "
3910  LET F$="FEBRUARY "
3920  LET M$="  MARCH  "
3930  LET P$="  APRIL  "
3940  LET E$="   MAY   "
3950  LET U$="  JUNE   "
3960  LET L$="  JULY   "
3970  LET T$=" AUGUST "
3980  LET S$="SEPTEMBER"
3990  LET O$=" OCTOBER "
4000  LET N$="NOVEMBER "
4010  LET D$="DECEMBER "
4020  RETURN 
4030  STOP 
4040  PRINT '12'1'1'1'1'1'1'1'1'1'1
4050  RETURN 
4060  END 
