bwBASIC/cpm/birthday.bas

100 REM BIRTHDAY UPDATED 5-5-77 TO "MITS" BY D. NIXON 
110   DIM Z$(12),L(12),N(60),Y$(7)   
120   DIM G$(12),H$(32)  
130 FOR I=1 TO 12:READ Z$(I):NEXT
140 FOR I=1 TO 12:READ L(I):NEXT 
150 FOR I=1 TO 7:READ Y$(I): NEXT
160 FOR I=1 TO 12:READ G$(I):NEXT
170 FOR I=1 TO 32:READ H$(I):NEXT
180 DATA JANUARY,FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST:  
190 DATA SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER:
200 DATA 31,28,31,30,31,30,31,31,30,31,30,31:
210 DATA THURS,FRI,SATUR,SUN,MON,TUES,WEDNES:
220 DATA THE MOON,THE SUN,THE EARTH,THE PLANET MERCURY,VENUS,MARS:   
230 DATA JUPITER,SATURN,THE PLANET URANUS,THE PLANET NEPTUNE:
240 DATA THE PLANET PLUTO,PEANUT BUTTER: 
250 DATA JUXTAROTATION,CONTRAPOSITION,CONTRASTING PHASES,TRANSPOSITION:  
260 DATA SATISFIED,HAPPY,INTERESTING,TOLERANT:   
270 DATA OFTEN,OCCASIONALLY,SOMETIMES:   
280 DATA TEND TO BE,ARE,ARE INCLINED TO BE:  
290 DATA SHORT OF PATIENCE,UNEASY,AT ODDS:   
300 DATA OTHERS.,CLOSE FRIENDS.,YOUNGER PEOPLE.,THOSE IN AUTHORITY.: 
310 DATA ": BEWARE OF ","  AVOID "   
320 DATA APPLE PIE,BEING ALONE,DARK PLACES,STRANGERS,UNUSUAL SITUATIONS: 
330   DATA BE TAKING A TRIP YOU HAVE NOT MADE BEFORE.
340   DATA BE MEETING SOMEONE YOU WILL KNOW FOR THE REST OF YOUR LIFE.   
350   DATA MAKE SEVERAL IMPORTANT DECISIONS INVOLVING OTHERS.
360   DATA BECOME ILL IF YOU DO NOT LESSEN YOUR UNUSUAL ACTIVITIES.  
370  PRINT "TYPE IN TODAY'S DATE NUMERICALLY: MO,DAY,YEAR"; 
380  INPUT X1,Y1,Z1 
390  IF Z1>99 GOTO 410 
400  Z1=Z1+1900 
410 XF=X1:YF=Y1:ZF=Z1:GOSUB 1220:U=ND
420  PRINT "TODAY IS ";Y$(U-7*INT(U/7)+1);"DAY   (I HOPE)"  
430  PRINT  
440  PRINT "HI, I'M A MICROPROCESSOR."  
450  PRINT "TELL ME YOUR NAME"; 
460  INPUT N$   
470 I=INSTR(N$," ")-1   
480 IF I<0 THEN 580 
490 K$=LEFT$(N$,I)  
500  PRINT "ARE YOU USUALLY CALLED ";K$;
510  INPUT A$   
520 GOSUB 1140   
530  ON NA GOTO 540,560,510
540  PRINT "WHAT DO YOU LIKE TO BE CALLED"; 
550  INPUT K$   
560  PRINT "SO YOUR FULL NAME IS ";N$;", BUT YOU"   
570  PRINT "LIKE TO BE CALLED ";K$;"."  
580  PRINT "HOW OLD ARE YOU, ";K$;  
590  INPUT A
600  A=INT(A)   
610  IF INT((A-5)/95)=0  GOTO 640  
620  PRINT "COME ON, ";K$;", YOU'RE PULLING MY LEG."
630  GOTO 580  
640  PRINT "SO YOU ARE";A;"YEARS OLD."  
650  PRINT "DO YOU KNOW, OFF HAND, HOW MANY DAYS OLD YOU ARE";  
660  INPUT A$   
670 GOSUB 1140   
680  ON NA GOTO 720,690,660
690  PRINT "OK, SMARTY, HOW MANY?"  
700  PRINT "SORRY, ";K$;", YOU'LL HAVE TO BE FASTER THAN THAT!" 
710  GOTO 1600 
720  PRINT "OK, I'LL TELL YOU." 
730  PRINT "IN WHAT MONTH WERE YOU BORN";   
740  INPUT M$   
750  FOR X=1 TO 12  
760  IF M$=Z$(X) GOTO 800  
770  NEXT X 
780  PRINT K$;", YOU MAY BE NICE BUT YOU CAN'T SPELL."  
790  GOTO 730  
800  PRINT "ON WHAT DAY";   
810  INPUT Y
820  Z=Z1-A 
830  IF INT((Y-1)/L(X))=0 GOTO 870 
840  IF (X-1)*(Y-28)*(Z-4*INT(Z/4)+1)=1 GOTO 870   
850  PRINT "COME ON, ";N$;", YOU'RE GIVING ME A HARD TIME." 
860  GOTO 800  
870  REM
880 XF=X1:YF=Y1:ZF=Z:GOSUB 1220:W=ND 
890 XF=X:YF=Y:ZF=Z:GOSUB 1220:V=ND   
900 IF W >= V GOTO 920  
910  Z=Z-1  
920  IF ABS(W-V)>30 GOTO 990   
930  ON SGN(W-V)+2 GOTO 940,980,960
940  PRINT "YOU HAVE A BIRTHDAY COMING UP IN ONLY";V-W;"DAYS!"  
950 GOTO 990
960  PRINT "YOUR BIRTHDAY WAS ONLY";W-V;"DAYS AGO. CONGRATULATIONS!"
970  GOTO 990  
980  PRINT "HAPPY BIRTHDAY, DEAR ";K$;", HAPPY BIRTHDAY TO YOU."
990 XF=X:YF=Y:ZF=Z:GOSUB 1220:V=ND   
1000  PRINT "YOU WERE BORN ON ";Y$(V-7*INT(V/7)+1);"DAY, ";Z$(X);Y;",";Z 
1010  PRINT "WHICH MAKES YOU";U-V;"DAYS OLD."
1020  PRINT "YOU WERE BORN ON THE DAY";V;"AD, AND ON JAN. 1, 2000"   
1030  PRINT "YOU WILL BE";730480!-V;"DAYS OLD."   
1040  PRINT "HOW ABOUT THAT!!!"  
1050  PRINT  
1060  GOSUB 1350 
1070  PRINT "WELL, ";N$; 
1080  IF N$=K$ GOTO 1100 
1090  PRINT " (ALIAS ";K$;")"
1100  PRINT " IT HAS BEEN NICE CHATTING WITH YOU. DO COME AGAIN."
1110  PRINT "GOOD BYE"   
1120  GOTO 1600 
1130 REM SUBROUTINE FOR YES NO REQUEST   
1140 NA=1
1150 IF A$="NO" GOTO 1210
1160 IF A$="N0" GOTO 1210
1170 NA=2
1180 IF A$="YES" GOTO 1210   
1190 NA=3
1200 PRINT "A SIMPLE YES OR NO WILL DO! "
1210 RETURN  
1220 REM SUBROUTINE TO SOLVE FOR NUMBER OF DAYS  
1230 ND=YF-1 
1240  FOR I1=1 TO XF-1   
1250 ND=ND+L(I1) 
1260 NEXT I1 
1270 I1=INT(ZF/100)  
1280 IF ZF<>4*INT(ZF/4) GOTO 1330
1290 IF  ZF/100=I1 GOTO 1330 
1300 IF  ND>59 GOTO 1330 
1310 IF XF=3 GOTO 1330   
1320 ND=ND-1 
1330  ND=ND+36524!*I1+INT(365.25*(ZF-100*I1)) 
1340 RETURN  
1350 REM GENERATE RANDOM HOROSCOPE  
1360 R1=INT(12*RND(1))+1
1370 R2 = INT(12*RND(1))+1  
1380  IF R1=R2 GOTO 1370   
1390 R=1
1400 X=4:GOSUB 1570 
1410 PRINT "YOU WERE BORN UNDER THE ";H$(NR);" OF ";G$(R1)  
1420 X=4:GOSUB 1570 
1430 PRINT "AND ";G$(R2);".  YOU ARE A BASICALLY ";H$(NR)   
1440 X=3:GOSUB 1570 
1450 PRINT "PERSON BUT ";H$(NR);
1460 GOSUB 1570 
1470 PRINT " YOU ";H$(NR)   
1480 GOSUB 1570:N1=NR:X=4:GOSUB 1570:N2=NR:X=2:GOSUB 1570   
1490 PRINT H$(N1);" WITH ";H$(N2);H$(NR)
1500 X=5:GOSUB 1570 
1510 PRINT H$(NR);" FOR THE NEXT WEEK. I PREDICT YOU WILL SOON" 
1520 X=4:GOSUB 1570 
1530 PRINT H$(NR)   
1540 PRINT  
1550 RETURN 
1560 REM SUBROUTINE TO SELECT RANDOM WORDS  
1570 NR=INT(X*RND(1))+R 
1580 R=R+X  
1590 RETURN 
1600 REM END
9991 REM ---------------------------------
9992 REM Updated for bwBASIC 3.0 by Howard Wulf, AF5NE, May 7th  2015:
9993 REM a) changed => to >= on line 900
9999 END