'=========================================================================== ' Subject: COMPATIBILITY ANALYSIS PROGRAM Date: 11-12-97 (05:34) ' Author: Andrew S. Gibson Code: QB, QBasic, PDS ' Origin: zapf_dingbat@juno.com Packet: AI.ABC '=========================================================================== ' This program was Resurrected from a book called, ' Announcing: Computer Games, for Business, School and Home ' For TSR-80 Level II BASIC by J. Victor Nahigian and William S. Hodges. ' This program will work in plain old Qbasic (or the old GW-BASIC) ' interpreters. When you type in a person's Birthday you must use a comma ' to seperate the Month (MM), Day (DD), Year (YYYY). The year must be four ' digits long ! E-mail me @ this address Zapf_DingBat@JUNO.COM to chat ' or send some of your code (postit encrypted and less than 55k). 1 CLS ' Compatability Analysis program. 2 COLOR 15: LOCATE 2, 28: PRINT " C O M P A T A B I L I T Y" 3 LOCATE 3, 28: PRINT " A N A L Y S I S ": COLOR 7 4 LOCATE 5, 28: PRINT " By using the biorhythmic" 5 LOCATE 6, 28: PRINT "cycle theory, this program" 6 LOCATE 7, 28: PRINT "takes the birthdays of two" 7 LOCATE 8, 28: PRINT "individuals and calculates" 8 LOCATE 9, 28: PRINT "when they are compatible" 9 LOCATE 10, 28: PRINT "during their lifetime," 10 LOCATE 11, 28: PRINT "It also gives the average" 11 LOCATE 12, 28: PRINT "compatability percentage." 12 LOCATE 14, 28: PRINT "Couples therefore should" 13 LOCATE 15, 28: PRINT "not feel insulted if" 14 LOCATE 16, 28: PRINT "their average is not one": LOCATE 17, 28: PRINT "hundred percent." 15 LOCATE 19, 11: PRINT "Program written by J. Victor Nahigian and William S. Hodges.": LOCATE 20, 23: PRINT "Resurrected for DOS by Andrew Gibson." 16 LOCATE 22, 17: PRINT "Copyright 1980, 1979 By Winthrop Publishers, Inc.": COLOR 15: LOCATE 24, 28: PRINT "P R E S S A N Y K E Y ."; : COLOR 7: LOCATE 1, 1 17 ZZ$ = INKEY$: IF ZZ$ = "" THEN 17 18 DIM A1(30), B1(30): DIM A(12) 19 FOR I = 1 TO 12: READ A(I): NEXT I 20 DATA 0,31,59,90,120,151,181,212,243,273,304,334 21 Y = 0 22 Y = Y + 1 23 CLS : PRINT "What is the name of person one (1)"; : INPUT W$ 24 PRINT "What is person one's birthday (MM,DD,YYYY)"; 25 INPUT M, D, Y 26 E1 = M: F1 = D: G1 = Y 27 GOSUB 72 28 Z2 = T: K1 = J + 1 29 PRINT 30 PRINT "What is the name of person two (2)"; : INPUT X$ 31 PRINT "What is person two's birthday (MM,DD,YYYY)"; 32 INPUT M, D, Y 33 E2 = M: D2 = D: G2 = Y 34 GOSUB 72 35 P2 = ABS(Z2 - T) 36 K2 = J + 1 38 CLS 39 PRINT "COMPATABILITY ANALYSIS" 40 PRINT "----------------------" 41 PRINT 42 PRINT "COMPATABILITY ANALYSIS OF "; W$; " AND "; X$; "." 43 PRINT 44 PRINT W$; " was born on "; : M = E1: GOSUB 90 45 PRINT STR$(F1); ","; STR$(G1); ". On a "; : J = K1 46 GOSUB 102 47 PRINT ".": PRINT 49 PRINT X$; " was born on "; : M = E2: GOSUB 90 50 PRINT STR$(D2); ","; STR$(G2); ". On a "; : J = K2 51 GOSUB 102 52 PRINT ".": PRINT 54 Z = P2 55 P3 = ABS(INT(((Z / 23) - INT(Z / 23)) * 23)) 56 S3 = ABS(INT(((Z / 28) - INT(Z / 28)) * 28)) 57 C3 = ABS(INT(((Z / 33) - INT(Z / 33)) * 33)) 58 P5 = ABS(100 - ((2 * P3) * (100 / 23))) 59 S5 = ABS(100 - ((2 * S3) * (100 / 28))) 60 C5 = ABS(100 - ((2 * C3) * (100 / 33))) 61 PRINT USING "PHYSICAL CYCLE COMPATABILITY (23-DAY) IS ###.###%"; INT(P5 * 1000) / 1000 63 PRINT USING "SENSITIVITY CYCLE COMPATABILITY (28-DAY) IS ###.###%"; INT(S5 * 1000) / 1000 65 PRINT USING "COGNITIVE CYCLE COMPATABILITY (33-DAY) IS ###.###%"; INT(C5 * 1000) / 1000 67 PRINT SPC(44); "--------" 69 A5 = (P5 + S5 + C5) / 3 70 PRINT USING "AVERAGE COMPATABILITY IS ###.###%"; INT(A5 * 1000) / 1000 71 GOTO 109 72 Y1 = Y - 1800 73 Q1 = INT(Y1 / 4) 74 Q2 = INT(Q1 / 25) 75 Q3 = INT((Y1 + 200) / 400) 76 K = 0 77 IF Q1 * 4 <> Y1 THEN 81 78 IF Q2 * 100 <> Y1 THEN 81 79 IF Q3 * 400 - 200 <> Y1 THEN 81 80 K = 1 81 T = 365 * Y1 + Q1 - Q2 + Q3 - K 82 T = T + A(M) + D - 1 83 IF M < 3 THEN 85 84 T = T + K 85 IF INT(Y1 / 4) <> Y1 / 4 THEN 88 86 IF M > 2 THEN 88 87 T = T - 1 88 J = T - 7 * INT(T / 7) 89 RETURN 90 IF M = 1 THEN PRINT "JANUARY"; : RETURN 91 IF M = 2 THEN PRINT "FEBRUARY"; : RETURN 92 IF M = 3 THEN PRINT "MARCH"; : RETURN 93 IF M = 4 THEN PRINT "APRIL"; : RETURN 94 IF M = 5 THEN PRINT "MAY"; : RETURN 95 IF M = 6 THEN PRINT "JUNE"; : RETURN 96 IF M = 7 THEN PRINT "JULY"; : RETURN 97 IF M = 8 THEN PRINT "AUGUST"; : RETURN 98 IF M = 9 THEN PRINT "SEPTEMBER"; : RETURN 99 IF M = 10 THEN PRINT "OCTOBER"; : RETURN 100 IF M = 11 THEN PRINT "NOVEMBER"; : RETURN 101 PRINT "DECEMBER"; : RETURN 102 IF J = 1 THEN PRINT "WEDNESDAY"; : RETURN 103 IF J = 2 THEN PRINT "THURSDAY"; : RETURN 104 IF J = 3 THEN PRINT "FRIDAY"; : RETURN 105 IF J = 4 THEN PRINT "SATURDAY"; : RETURN 106 IF J = 5 THEN PRINT "SUNDAY"; : RETURN 107 IF J = 6 THEN PRINT "MONDAY"; : RETURN 108 PRINT "TUESDAY"; : RETURN 109 PRINT : COLOR 15: PRINT "Press any key to return to what ever you were doing.": COLOR 7 110 ZZ$ = INKEY$: IF ZZ$ = "" THEN 110 111 END