start tok64 d64-CSUE3G
80 REM*****************************
81 REM*                           *
82 REM*   bio compatability pgm   *
83 REM*                           *
84 REM*    original concept by    *
85 REM*       joe  cannata        *
86 REM*                           *
87 REM*    greatly improved by    *
88 REM*      (that  amazin')      *
89 REM*                           *
90 REM*    mergatroid mahooney    *
91 REM*                           *
92 REM*       june 21, 1981       *
93 REM*                           *
94 REM*        version 2.1        *
95 REM*                           *
96 REM*****************************
97  
98  
99  
110 DIM a(24),b(29),c(34),m(12)
111  
120 DATA100,92.3,81.6,73.9,65.2,56.5,47.8,39.1,30.4
130 DATA21.7,13,4.3,4.3,13,21.7,30.4,39.1
140 DATA47.8,56.5,65.2,73.9,81.6,92.3,100
150 DATA100,93,86,79,71,64,57,50,43,36,29,21
160 DATA14,7,0,7,14,21,29,36,43,50,57,64,71
170 DATA79,86,93,100
180 DATA100,94,88,82,76,70,64,58,52,46,39,33
190 DATA27,21,15,9,3,3,9,15,21,27,33,39,46
200 DATA52,58,64,70,76,82,88,94,100
210 DATA31,28,31,30,31,30,31,31,30,31,30,31
211  
220 FOR z=1 TO 24 :READ a(z) : NEXT
230 FOR z=1 TO 29 :READ b(z) : NEXT
240 FOR z=1 TO 34 :READ c(z) : NEXT
250 FOR z=1 TO 12 :READ m(z) : NEXT
251  
270 PRINT"{clear}{reverse on}biorhtyhm compatability test"
280 PRINT"{down}enter your birthdate: mm,dd,yy"
290 INPUT p, q, r
300 GOSUB630
310 IF s=0 THEN 290
320 s1=s
330 PRINT"{down}enter the other birthdate: mm,dd,yy"
340 INPUT p, q, r
350 GOSUB630
360 IF s=0 THEN 330
370 s2=s
380 d9=ABS(s1-s2)
390 x2=a(d9-(INT(d9/23)*23)+1):tr=x2:GOSUB900:ph$=tr$
400 x3=b(d9-(INT(d9/28)*28)+1):tr=x3:GOSUB900:em$=tr$
410 x4=c(d9-(INT(d9/33)*33)+1):tr=x4:GOSUB900:in$=tr$
420 x5=(x2+x3+x4)/3:x5=INT(x5)
430 IF x5<25 THEN 470
440 IF x5<50 THEN 500
450 IF x5<75 THEN 530
460 GOTO 550
470 PRINT"{down*2}with a {reverse on}compatability{reverse off} of only:"x5"% {.*4}"
480 PRINT"{down}there ain't much hope."
490 GOTO560
500 PRINT"{down*2}{reverse on}compatability{reverse off} is: "x5"% {.*4}"
510 PRINT"yew otta be able to get along."
520 GOTO560
530 PRINT"{down*2}{reverse on}compatability{reverse off} is: "x5"% {.*8}"
535 PRINT"{down}yew could be pretty good friends"
540 GOTO560
550 PRINT"{down}super terrifik{.*3}{reverse on}compatability{reverse off} of: "x5"%"
560 PRINT"{down}here are the compatability breakdowns:"
580 PRINT"{cm u*37}"
590 PRINT"compatability of: "ph$TAB(22)"% physically"
600 PRINT"compatability of: "em$TAB(22)"% emotionally"
610 PRINT"compatability of: "in$TAB(22)"% intellectually"
620 PRINT"{down*2}":STOP:GOTO270
621  
622  
630 REM ***calculate elapsed days***
640 IF r<1 THEN860
650 IF r>99 THEN860
660 IF INT(r)<>r THEN860
670 s=r*365
680 s=s+((r-1)/4)
690 IF p<1 OR p>12 THEN860
700 IF INT(p)<>p THEN860
710 FOR i=1 TO p
720   s=s+m(i)
730 NEXT
740 l=INT((r/4)*4)
750 IF p<3 THEN770
760 s=s+1
770 IF q<1 THEN860
780 IF q<> INT(q) THEN860
790 IFq>m(p) THEN 810
800 GOTO 840
810 IF l<>0 THEN 860
820 IF p<>2 THEN 860
830 IF q>29 THEN 860
840 s=s+q
850 RETURN
860 PRINT"{clear}invalid date (dummy) * re-enter"
870 s=0
880 RETURN
899 REM *** formattin' subrt. ***
900 add=0:IF tr<100 THEN add=1
910 IF tr<10 THEN add=2
920 tr$=STR$(tr)
930 IFadd=0 THEN tr$=RIGHT$(tr$,3):RETURN
940 IFadd=1 THEN RETURN
950 IFadd=2 THEN tr$=" "+tr$ :RETURN
stop tok64
(bastext 1.0)