1000  REM:  "WEKDAY" (REV.#0B), ADAPTED FROM THE G.E. TIMESHARING PRO-
1010  REM:  GRAM AS PUBLISHED IN "101 BASIC GAMES" (DIGITAL, JULY 1973).
1020  REM:  OPTIMIZED FOR THE H/P 2000 SERIES OF COMPUTERS 6/16/74
1030  REM:  BY MIKE SCHWEIZER, EDP RESOURCE CENTER, SAN FRANCISCO
1040  DIM T[12]
1050  DATA 0,31,59,90,120,151,181,212,243,273,304,334
1060  DATA 0,3,3,6,1,4,6,2,5,0,3,5
1070  DEF FNA()=INT(/4)
1080  DEF FNB()=INT(/7)
1090  MAT  READ T
1100  Y=TIM(3)
1110  D=TIM(2)
1120  IF INT(Y/4)*Y#Y THEN 1160
1130  FOR I=3 TO 12
1140  T[I]=T[I]+1
1150  NEXT I
1160  FOR I=12 TO 1 STEP -1
1170  IF D>T[I] THEN 1190
1180  NEXT I
1190  M1=I
1200  D1=D-T[I]
1210  Y1=Y+1900
1220  MAT  READ T
1230  PRINT 
1240  PRINT "THIS PROGRAM DEMONSTRATES H/P 2000 SERIES TIME-SHARED BASIC"
1250  PRINT "AND ALSO GIVES FACTS ABOUT A DATE OF INTEREST TO YOU."
1260  PRINT 
1270  PRINT "ENTER DATE OF BIRTH (OR OTHER DATE OF INTEREST) IN THIS"
1280  PRINT "FORM:  MM,DD,YYYY  ";
1290  INPUT M,D,Y
1300  PRINT 
1310  IF Y<2000 THEN 1340
1320  PRINT "I CANNOT GIVE ANSWERS BEYOND THE YEAR 1999.  TRY AGAIN..."
1330  GOTO 1270
1340  IF Y#ABS(INT(Y)) OR Y=0 OR M=0 OR D=0 THEN 1360
1350  IF M=ABS(INT(M)) AND M<13 AND D=ABS(INT(D)) AND D<32 THEN 1380
1360  PRINT "IMPOSSIBLE!  TRY IT AGAIN, AND PLEASE TYPE CAREFULLY..."
1370  GOTO 1270
1380  IF Y-75>0 THEN 1400
1390  Y=Y+1900
1400  I1=INT((Y-1500)/100)
1410  IF Y-1582 >= 0 THEN 1450
1420  PRINT "NOT PREPARED TO GIVE DAY OF WEEK PRIOR TO MDLXPXII -"
1430  PRINT "THE CURRENT CALENDAR DID NOT EXIST BEFORE THAT YEAR."
1440  GOTO 1270
1450  A=I1*5+(I1+3)/4
1460  I2=INT(A-FNB(A)*7)
1470  Y2=INT(Y/100)
1480  Y3=INT(Y-Y2*100)
1490  A=Y3/4+Y3+D+T[M]+I2
1500  B=INT(A-FNB(A)*7)+1
1510  IF M>2 THEN 1620
1520  IF Y3=0 THEN 1590
1530  T1=INT(Y-FNA(Y)*4)
1540  IF T1 THEN 1620
1550  IF B THEN 1570
1560  B=6
1570  B=B-1
1580  GOTO 1620
1590  A=I1-1
1600  T1=INT(A-FNA(A)*4)
1610  IF T1=0 THEN 1550
1620  IF B THEN 1650
1630  B=7
1640  REM:  IF USING AN H/P 2000A OR 2000B, CHANGE LINES BELOW
1650  PRINT  USING 1660;M,D,Y
1660  IMAGE #,2D,"/",2D,"/",4D,X
1670  IF (Y1*12+M1)*31+D1<(Y*12+M)*31+D THEN 1730
1680  IF (Y1*12+M1)*31+D1=(Y*12+M)*31+D THEN 1710
1690  PRINT "WAS A ";
1700  GOTO 1740
1710  PRINT "IS A ";
1720  GOTO 1740
1730  PRINT "WILL BE A ";
1740  GOTO B OF 1750,1770,1790,1810,1830,1850,1900
1750  PRINT "SUNDAY"
1760  GOTO 1910
1770  PRINT "MONDAY"
1780  GOTO 1910
1790  PRINT "TUESDAY"
1800  GOTO 1910
1810  PRINT "WEDNESDAY"
1820  GOTO 1910
1830  PRINT "THURSDAY"
1840  GOTO 1910
1850  IF D=13 THEN 1880
1860  PRINT "FRIDAY"
1870  GOTO 1910
1880  PRINT "FRIDAY THE THIRTEENTH *** BEWARE!"
1890  GOTO 1910
1900  PRINT "SATURDAY"
1910  IF (Y1*12+M1)*31+D1=(Y*12+M)*31+D THEN 2320
1920  PRINT 
1930  I5=Y1-Y
1940  I6=M1-M
1950  I7=D1-D
1960  IF I7 >= 0 THEN 1990
1970  I6=I6-1
1980  I7=I7+30
1990  IF I6 >= 0 THEN 2020
2000  I5=I5-1
2010  I6=I6+12
2020  IF I5<0 THEN 1260
2030  IF I6 OR I7 THEN 2050
2040  PRINT "**** HAPPY BIRTHDAY! ****"
2050  PRINT " "," ","YEARS","MONTHS","DAYS"
2060  PRINT "YOUR AGE IF BIRTHDATE ",I5,I6,I7
2070  A8=(I5*365)+(I6*30)+I7+INT(I6/2)
2080  K5=I5
2090  K6=I6
2100  K7=I7
2110  F=.35
2120  PRINT "YOU HAVE SLEPT  ",
2130  GOSUB 2360
2140  F=.17
2150  PRINT "YOU HAVE EATEN  ",
2160  GOSUB 2360
2170  F=.23
2180  IF K5>3 THEN 2210
2190  PRINT "YOU HAVE PLAYED ",
2200  GOTO 2250
2210  IF K5>9 THEN 2240
2220  PRINT "YOU HAVE PLAYED/STUDIED",
2230  GOTO 2250
2240  PRINT "YOU HAVE WORKED/STUDIED",
2250  GOSUB 2360
2260  IF K6#12 THEN 2290
2270  K5=K5+1
2280  K6=0
2290  PRINT "YOU HAVE RELAXED",K5,K6,K7
2300  PRINT 
2310  PRINT " ","***    YOU MAY RETIRE IN";Y+65;"***"
2320  PRINT 
2330  PRINT "CALCULATED FOR YOU BY AN H/P 2000 SERIES MINICOMPUTER"
2340  PRINT LIN(-3)
2350  GOTO 1230
2360  K1=INT(F*A8)
2370  I5=INT(K1/365)
2380  K1=K1-(I5*365)
2390  I6=INT(K1/30)
2400  I7=K1-(I6*30)
2410  K5=K5-I5
2420  K6=K6-I6
2430  K7=K7-I7
2440  IF K7 >= 0 THEN 2470
2450  K7=K7+30
2460  K6=K6-1
2470  IF K6>0 THEN 2500
2480  K6=K6+12
2490  K5=K5-1
2500  PRINT I5,I6,I7
2510  RETURN 
2520  END 
