home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22a.dsk / NOVEMBER.1984 / BIORHYTHMS.bas < prev    next >
BASIC Source File  |  2023-02-26  |  9KB  |  154 lines
  1. 10  REM  ************************
  2. 20  REM  *      COMP.BIO        *
  3. 30  REM  *    BY LEE BANKS      *
  4. 40  REM  *  COPYRIGHT (C) 1984  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80  IF  PEEK(104) < >64  THEN  POKE 103,1: POKE 104,64: POKE 16384,0: PRINT  CHR$(4)"RUN BIORHYTHMS"
  9. 90  TEXT : HOME 
  10. 100  REM  DIMENSIONS ARRAYS
  11. 110 :
  12. 120  DIM D(8),CIN(33,2),CEM(28,2),CPH(23,2),CV(31),PL(31),MA(12),MN(12)
  13. 130  REM  MA = DAYS PAST, MN = DAYS IN MONTHS
  14. 140  FOR I = 1 TO 12: READ MA(I),MN(I): NEXT 
  15. 150 :
  16. 160  REM  READ INTELLECTUAL VALUE
  17. 170 :
  18. 180  FOR I = 1 TO 33: FOR V = 1 TO 2: READ CIN(I,V): NEXT : NEXT 
  19. 190 :
  20. 200  REM  READ EMOTIONAL VALUES
  21. 210 :
  22. 220  FOR I = 1 TO 28: FOR V = 1 TO 2: READ CEM(I,V): NEXT : NEXT 
  23. 230 :
  24. 240  REM  READ PHYSICAL VALUES
  25. 250 :
  26. 260  FOR I = 1 TO 23: FOR V = 1 TO 2: READ CPH(I,V): NEXT : NEXT 
  27. 270  GOTO 800
  28. 280  DATA  0,31,31,28,59,31,89,30,120,31,150,30,181,31,212,31,242,30,273,31,303,30,334,31
  29. 290 :
  30. 300  REM  COMPOSITE VALUES - INT
  31. 310 :
  32. 320  DATA  15,3,18,6,21,9,24,12,27,15,30,18,33,21,36,24,34,22,31,19,28,16,25,13,22,10,19,7,16,4,13,1,10,-2,7,-5,4,-8,1,-11,-2,-14,-5,-17,-8,-20,-11,-23,-12,-24,-9,-21,-6,-18,-3,-15,0,-12,3,-9,6,-6,9,-3,12,0
  33. 330 :
  34. 340  REM  COMPOSITE VALUES - EMO
  35. 350 :
  36. 360  DATA  14,4,18,8,22,12,26,16,30,20,34,24,38,28,34,24,30,20,20,26,16,22,12,18,8,14,4,10,0,6,-4,2,-8,-2,-12,-6,-16,-10,-20,-14,-24,-18,-28,-14,-24,-10,-20,-6,-16,-2,-12,3,-8,6,-4,1,0
  37. 370 :
  38. 380  REM  COMPOSITE VALUES - PHY
  39. 390 :
  40. 400  DATA  10,2,12,4,14,6,16,8,18,10,19,11,17,9,15,7,13,5,11,3,9,1,7,-1,5,-3,3,-5,1,-7,-1,-9,-3,-11,-2,-10,0,-8,2,-6,4,-4,6,-2,8,0
  41. 410 :
  42. 420  REM  ASSIGN COMPOSITE VALUE
  43. 430 :
  44. 440 D1 = (DZS/33) - INT(DZS/33):D2 = D1 *33:MI(1) =  INT(D2 +.5): IF MI(1) = 0  THEN MI(1) = 1
  45. 450 D3 = (DZS/28) - INT(DZS/28):D4 = D3 *28:EI(1) =  INT(D4 +.5): IF EI(1) = 0  THEN EI(1) = 1
  46. 460 D5 = (DZS/23) - INT(DZS/23):D6 = D5 *23:PI(1) =  INT(D6 +.5): IF PI(1) = 0  THEN PI(1) = 1
  47. 470  FOR I = 1 TO MN(TMN)
  48. 480  IF TP$ = "INT"  THEN CV(I) = CIN(MI(1),1) +CEM(EI(1),2) +CPH(PI(1),2): GOSUB 1500: NEXT 
  49. 490  IF TP$ = "EMO"  THEN CV(I) = CIN(MI(1),2) +CEM(EI(1),1) +CPH(PI(1),2): GOSUB 1500: NEXT 
  50. 500  IF TP$ = "PHY"  THEN CV(I) = CIN(MI(1),2) +CEM(EI(1),2) +CPH(PI(1),1): GOSUB 1500: NEXT 
  51. 510  IF TP$ = "AVG"  THEN CV(I) = CIN(MI(1),2) +CEM(EI(1),2) +CPH(PI(1),2): GOSUB 1500: NEXT 
  52. 520 :
  53. 530  REM  MODIFY PLOT VALUES
  54. 540 :
  55. 550  FOR I = 1 TO MN(TMN)
  56. 560  IF CV(I) = 0  THEN PL(I) = 100: NEXT : GOTO 630
  57. 570  IF CV(I) >0  AND CV(I) <100  THEN PL(I) = 100 -CV(I): NEXT : GOTO 630
  58. 580  IF CV(I) >100  AND CV(I) <160  THEN PL(I) = CV(I): NEXT : GOTO 630
  59. 590  IF CV(I) <0  THEN PL(I) = (CV(I) * -1) +100: NEXT 
  60. 600 :
  61. 610  REM  FRAME COMPOSITE CHART
  62. 620 :
  63. 630  HGR : HCOLOR= 3:P = 1
  64. 640  HPLOT 0,0 TO 279,0 TO 279,159 TO 0,159 TO 0,0: HPLOT 0,100 TO 279,100
  65. 650  FOR I = 1 TO 279  STEP 9: HPLOT I,0 TO I,159: NEXT 
  66. 660  HPLOT 1,90 TO 7,90: HPLOT 4,86 TO 3,94: HPLOT 2,110 TO 7,110
  67. 670  HOME : VTAB 21: PRINT " 1      7   10    15     20     25    31": POKE 34,22
  68. 680 :
  69. 690  REM  PLOT COMPOSITE GRAPH
  70. 700 :
  71. 710 P = 1
  72. 720  HPLOT 9,PL(P)
  73. 730 P = 2
  74. 740  FOR I = 18 TO 279  STEP 9
  75. 750  HPLOT  TO I,PL(P): VTAB 22: IF P = MN(TMN)  THEN 1350
  76. 760 P = P +1: NEXT : GOTO 1350
  77. 770 :
  78. 780  REM  OPTIONS AVAILABLE
  79. 790 :
  80. 800  TEXT : HOME : HTAB 9: INVERSE : PRINT " B I O R H Y T H M S ": NORMAL : PRINT  TAB( 9)"---------------------": POKE 34,2: PRINT : PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **"
  81. 810  VTAB 8: HTAB 5: PRINT "1) POSITION IN CYCLE ": VTAB 10: HTAB 5: PRINT "2) COMPOSITE CHART ": VTAB 12: HTAB 5: PRINT "3) QUIT "
  82. 820  VTAB 21: PRINT "ENTER NUMBER OF CHOICE--> ";: GET N$:N =  VAL(N$): IF N <1  OR N >3  THEN  HOME : VTAB 12: GOTO 840
  83. 830  GOTO 850
  84. 840  FOR I = 1 TO 30:X =  PEEK( -16336) + PEEK( -16336) + PEEK( -16336): NEXT : HTAB 12: FLASH : PRINT " B A D  C H O I C E ": FOR I = 1 TO 1000: NEXT : HOME : GOTO 800
  85. 850  IF N = 3  THEN 1370
  86. 860  HOME : VTAB 12: INPUT "ENTER YOUR FIRST NAME PLEASE ->";NZ$: IF NZ$ = "LEE"  THEN BMN = 9:BDA = 24:BYR = 48: PRINT : PRINT : GOTO 920
  87. 870  IF NZ$ = "BRENDA"  THEN BMN = 8:BDA = 14:BYR = 53: PRINT : PRINT : GOTO 920
  88. 880  HOME : VTAB 5: PRINT "ENTER MONTH,DAY & YEAR OF BIRTH": PRINT 
  89. 890  VTAB 10: CALL  -958: VTAB 11: PRINT "(1=JAN, 2=FEB, ETC.)": VTAB 10: INPUT "MONTH->";K$:BMN =  VAL(K$): IF BMN <1  OR BMN >12  THEN 890
  90. 900  VTAB 13: CALL  -958: INPUT "DAY->";K$:BDA =  VAL(K$): IF BDA <1  OR BDA >31  THEN 900
  91. 910  VTAB 15: CALL  -958: VTAB 16: PRINT "(LAST 2 DIGITS)": VTAB 15: INPUT "YEAR->";K$:BYR =  INT( VAL(K$)): IF BYR <0  OR BYR >99  THEN 910
  92. 920  POKE 34,0: HOME : HTAB 11: INVERSE : PRINT " PERSONALITY TYPES ": NORMAL : PRINT "----------------------------------------": PRINT : PRINT : REM  40 HYPHENS
  93. 930  VTAB 6: PRINT "INTELLECTUAL = INT": PRINT : HTAB 4: PRINT "EMOTIONAL = EMO": PRINT : HTAB 5: PRINT "PHYSICAL = PHY": PRINT : HTAB 6: PRINT "AVERAGE = AVG": PRINT : PRINT : INPUT "ENTER YOUR TYPE -> ";TP$
  94. 940  IF TP$ < >"INT"  AND TP$ < >"EMO"  AND TP$ < >"PHY"  AND TP$ < >"AVG"  THEN  HOME : VTAB 10: GOTO 920
  95. 950 :
  96. 960  REM  INPUT TARGET DATE
  97. 970 :
  98. 980  HOME : PRINT "ENTER TARGET DATE...."
  99. 990  VTAB 10: CALL  -958: VTAB 11: PRINT "(1=JAN, 2=FEB, ETC.)": VTAB 10: INPUT "MONTH->";K$:TMN =  VAL(K$): IF TMN <1  OR TMN >12  THEN 990
  100. 1000  VTAB 13: CALL  -958: INPUT "DAY->";K$:TDA =  VAL(K$): IF TDA <1  OR TDA >31  THEN 1000
  101. 1010  VTAB 15: CALL  -958: VTAB 16: PRINT "(LAST 2 DIGITS, 100=2000)": VTAB 15: INPUT "YEAR->";K$:TYR =  INT( VAL(K$)): IF TYR <0  OR TYR >199  THEN 1010
  102. 1020 :
  103. 1030  REM  COMPUTE DAYS
  104. 1040 :
  105. 1050  IF TYR <BYR  THEN 870
  106. 1060  IF TYR = BYR  AND TMN < >BMN  THEN YRS = 0:DAZ =  INT(MA(TMN) -MA(BMN) +TDA +.5):DZS =  INT(DAZ -TDA): GOTO 1150
  107. 1070  IF TMN <BMN  THEN TYR = TYR -1:YRS = TYR -BYR:DAZ =  INT(YRS *365.25):DAZ =  INT(DAZ +(MA(12) -MA(BMN)) +MA(TMN) +(MN(BMN) -BDA)) +TDA:DZS =  INT(DAZ -TDA) +1: GOTO 1150
  108. 1080 DAZ =  INT(DAZ +(MA(12) -MA(BMN)) +MA(TMN) +(MN(BMN) -BDA)) +TDA
  109. 1090  IF TMN >BMN  THEN YRS = TYR -BYR:DAZ = (YRS *365.25):DAZ =  INT(DAZ +MA(TMN) -MA(BMN) +TDA) +.5:DZS =  INT(DAZ -TDA): GOTO 1150
  110. 1100  IF TYR = BYR  AND TMN = BMN  AND TDA = (BDA)  THEN DAZ = 1:DZS = 1: GOTO 1150
  111. 1110  IF TMN = BMN  AND TDA = (BDA)  THEN YRS = TYR -BYR:DAZ =  INT((365.25 *YRS) +.5):DZS =  INT(DAZ -BDA) +1: GOTO 1150
  112. 1120  IF TDA <(BDA)  THEN YRS = (TYR -1) -BYR:DAZ = (YRS *365.25) +(MN(BMN) -BDA) +(365.25 -MA(BMN +1) +1):DAZ =  INT(DAZ +MA(TMN) +TDA) +.5:DZS =  INT(DAZ -TDA): GOTO 1150
  113. 1130  IF TDA >(BDA)  THEN YRS = TYR -BYR:DAZ = (YRS *365.25):DAZ = DAZ + INT(TDA -BDA)
  114. 1140 DZS =  INT((YRS *365.25) +.5):DZS =  INT(DZS +MA(TMN))
  115. 1150 PH =  INT(DAZ/23):PI =  INT(DAZ -(PH *23)):EM =  INT(DAZ/28):EI =  INT(DAZ -(EM *28)):ME =  INT(DAZ/33):MI =  INT(DAZ -(ME *33))
  116. 1160  IF MI = 0  THEN MI = 33
  117. 1170  IF MI <1  THEN MI = 1
  118. 1180  IF EI = 0  THEN EI = 28
  119. 1190  IF EI <1  THEN EI = 1
  120. 1200  IF PI = 0  THEN PI = 23
  121. 1210  IF PI <1  THEN PI = 1
  122. 1220  IF N = 2  THEN  POKE 34,0: HOME : VTAB 12: HTAB 18: FLASH : PRINT "WORKING": NORMAL : GOTO 440
  123. 1230 :
  124. 1240  REM  DISPLAY RESULTS
  125. 1250 :
  126. 1260  HOME : HTAB 9: INVERSE : PRINT " B I O R H Y T H M S ": NORMAL : PRINT  TAB( 9)"---------------------": POKE 34,2: VTAB 5: REM  21 HYPHENS
  127. 1270  PRINT "PHYSICAL CYCLE          "PH;: HTAB 30: PRINT "COMPLETED": GOSUB 1410: PRINT "DAYS INTO CURRENT CYCLE: "PI"   "PN$: PRINT : GOSUB 1540
  128. 1280  PRINT "EMOTIONAL CYCLE         "EM;: HTAB 30: PRINT "COMPLETED": GOSUB 1440: PRINT "DAYS INTO CURRENT CYCLE: "EI"   "EN$: PRINT : GOSUB 1540
  129. 1290  PRINT "INTELLECTUAL CYCLE      "ME;: HTAB 30: PRINT "COMPLETED": GOSUB 1470: PRINT "DAYS INTO CURRENT CYCLE: "MI"   "MN$: PRINT : GOSUB 1540
  130. 1300 :
  131. 1310  REM  ENDING ROUTINE
  132. 1320 :
  133. 1330  VTAB 23: PRINT "  COMPOSITE CHART (Y/N) ? ";: GET A$: PRINT A$: IF A$ = "Y"  THEN  POKE 34,0: HOME : VTAB 12: HTAB 18: FLASH : PRINT "WORKING": NORMAL : GOTO 440
  134. 1340  GOTO 1360
  135. 1350  HOME : VTAB 22: HTAB 5: PRINT "COMPOSITE CHART FOR -> "TMN"-"TDA"-"TYR
  136. 1360  VTAB 23: CALL  -958: PRINT "      ANOTHER DATE (Y/N) ? ";: GET A$: IF A$ = "Y"  THEN  TEXT : HOME : GOTO 980
  137. 1370  TEXT : HOME : VTAB 12: PRINT "SEE YOU LATER THEN....": END 
  138. 1380 :
  139. 1390  REM  DECIDE STATUS: HIGH-LOW-CRITICAL
  140. 1400 :
  141. 1410  IF PI = 11  OR PI = 1  THEN PN$ = "CRITICAL": RETURN 
  142. 1420  IF PI >11  THEN PN$ = "LOW": RETURN 
  143. 1430 PN$ = "HIGH": RETURN 
  144. 1440  IF EI = 14  OR PI = 1  THEN EN$ = "CRITICAL": RETURN 
  145. 1450  IF EI >14  THEN EN$ = "LOW": RETURN 
  146. 1460 EN$ = "HIGH": RETURN 
  147. 1470  IF MI = 16  OR MI = 1  THEN MN$ = "CRITICAL": RETURN 
  148. 1480  IF MI >16  THEN EN$ = "LOW": RETURN 
  149. 1490 MN$ = "HIGH": RETURN 
  150. 1500 MI(1) = MI(1) +1: IF MI(1) >33  THEN MI(1) = 1
  151. 1510 EI(1) = EI(1) +1: IF EI(1) >28  THEN EI(1) = 1
  152. 1520 PI(1) = PI(1) +1: IF PI(1) >23  THEN PI(1) = 1
  153. 1530  RETURN 
  154. 1540  FOR I = 1 TO 38: PRINT "=";: NEXT : PRINT : RETURN