home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug026.ark / BIOCAL.ASC < prev    next >
Text File  |  1984-04-29  |  7KB  |  170 lines
  1. 100 REM*****************************************************************
  2. 110 REM
  3. 120 REM                BIORHYTHM WALL CALENDAR
  4. 130 REM
  5. 140 REM                     WRITTEN BY
  6. 150 REM
  7. 160 REM                    RON WILLIAMS
  8. 170 REM                    1845 COCHRAN RD.
  9. 180 REM                    MORGAN HILL, CA   95037
  10. 190 REM                    (408) 779-8655
  11. 200 REM
  12. 210 REM                    BASED ON A CONCEPT BY
  13. 220 REM                    DR. ROBERT SMITH AT
  14. 230 REM                    CONTROL DATA CORP.
  15. 240 REM
  16. 250 REM
  17. 260 REM   THE ONLY INPUT THE PROGRAM REQUIRES IS YOUR NAME AND YOUR
  18. 270 REM   DATE OF BIRTH (GIVEN AS MM,DD,YYYY OR MM,DD,YY).
  19. 280 REM   THIS PROGRAM PRINTS OUT A 12-MONTH CALENDER FOR 1978.  IF SOME
  20. 290 REM   PARTICULAR DAY HAS A 'P', AN 'S' OR AN 'I' INSTEAD OF A
  21. 300 REM   NUMBER, IT MEANS THAT DAY IS A P(HYSICAL), S(ENSITIVITY) OR
  22. 310 REM   I(NTELLECTUAL) CRITICAL DAY FOR YOU.  A '+' OR '-' FOLLOWING
  23. 320 REM   ONE OF THE THREE LETTERS ABOVE MEANS THE SINE CURVE IS
  24. 330 REM   BEGINNING ITS UPWARD(+) OR DOWNWARD(-) SWING.  
  25. 340 REM
  26. 350 REM   IF TWO LETTERS APPEAR ON THE CALENDAR, IT MEANS YOU HAVE A
  27. 360 REM   DOUBLE-CRITICAL DAY!  (E.G.  'PS' MEANS YOUR PHYSICAL AND
  28. 370 REM   SENSITIVITY CYCLES ARE BOTH CRITICAL ON THAT DAY).
  29. 380 REM
  30. 390 REM   IF A DOUBLE ASTERISK (**) APPEARS ON THE CALENDAR, IT MEANS
  31. 400 REM   ALL THREE CYCLES ARE CRITICAL ON THAT DAY!  YOU'D BEST JUST
  32. 410 REM   STAY HOME N BED!!  ONE GOOD(?) THING YOU MIGHT SAY
  33. 420 REM   ABOUT A TRIPLE-CRITICAL DAY IS THAT YOU ONLY HAVE 9 OF THEM
  34. 430 REM   IN THE 58-YEAR BIORHYTHM LIFE CYCLE  (YOUR THREE CYCLES
  35. 440 REM   START OVER AGAIN ABOUT EVERY 58 YEARS).
  36. 450 REM
  37. 460 REM   THIS PROGRAM WAS ORIGINALLY WRITTEN IN PL/M FOR THE INTELLEC
  38. 470 REM   MICROCOMPUTER DEVELOPMENT SYSTEM.
  39. 480 REM   BEING INNATELY LAZY, I MERELY TRANSLATED THE CODE (INSTEAD OF
  40. 490 REM   REDESIGNING IT) WHEN I REWROTE IT IN MICROSOFT DISK BASIC.
  41. 500 REM   THIS LAME EXCUSE IS MY WAY OF TELLING THE USER THAT THE
  42. 510 REM   PROGRAM RUNS SLO-O-O-W AS COMPARED TO THE PL/M VERSION.
  43. 520 REM
  44. 530 REM
  45. 540 REM******************************************************************
  46. 550 REM
  47. 560 CLEAR 1000
  48. 570 DEFINT A-E:DEFINT G-Z
  49. 580 DIM CA(583),CB$(71)
  50. 590 WIDTH80
  51. 600 GOSUB 1600
  52. 610 LINEINPUT"PLEASE ENTER YOUR NAME ===> ";N$
  53. 620 INPUT"NOW ENTER YOUR BIRTHDATE  (E.G. 5,22,1934) ===> ";MM,DD,YY
  54. 630 IF YY<1000 THEN YY=YY+1900
  55. 640 PRINT:LINEINPUT"POSITION PAPER AT TOP OF FORM, THEN HIT -RETURN-";A$
  56. 650 PRINT:PRINT"WAIT....YOUR BIORHYTHM CALENDAR WILL BE PRINTING SHORTLY....."
  57. 660 CY=1978
  58. 670 X=MM:Y=DD:Z=YY:IFX<3THENGOSUB1770ELSEGOSUB1780
  59. 680 F1=F
  60. 690 X=1:Y=1:Z=1978:GOSUB1770
  61. 700 TD=F-F1+1
  62. 710 IF CY MOD 4=0 THEN MV(13)=29
  63. 720 FOR K=0TO583:CA(K)=0:NEXT
  64. 730 MV(1)=MV(13):CP=SD(CY-1971)
  65. 740 FORJ=1TO12
  66. 750   L=MV(J-1)
  67. 760   RP=6*(J-1)+1
  68. 770   FOR K=1TOL
  69. 780     CA(CP+7*(RP-1))=K
  70. 790     CP=CP+1
  71. 800     IF CP>7 THEN CP=1:RP=RP+1
  72. 810   NEXT K
  73. 820 NEXTJ
  74. 830 CL=23:RP=0
  75. 840 FOR L=1 TO 3
  76. 850   MC=TD MOD CL
  77. 860   FOR J=1 TO 72
  78. 870     FOR K=1 TO 7
  79. 880       SL=K+7*(J-1)
  80. 890       IF CA(SL)=0 THEN 960
  81. 900       IF MC-CL\2-1 = 0 THEN 940
  82. 910       IF MC>CL THEN CA(SL)=CA(SL)+1000*(L+RP)+200:MC=1
  83. 920       MC=MC+1
  84. 930       GOTO 960
  85. 940       CA(SL)=CA(SL)+1000*(L+RP)+100
  86. 950       MC=MC+1
  87. 960     NEXT K
  88. 970   NEXT J
  89. 980   CL=CL+5:RP=RP+1
  90. 990 NEXT L
  91. 1000 REM
  92. 1010 L=0:KL=7*(CY-1971)
  93. 1020 FOR J=1TO7
  94. 1030   MG=10000
  95. 1040   FOR K=0TO71:CB$(K)=" ":NEXTK
  96. 1050   L=L+1:M=HP(L-1):IF M<>0 THEN CB$(M)="$":GOTO 1050
  97. 1060   CP=KL+J:K=HN(CP-1)
  98. 1070   IF K=0 THEN FOR I=48TO53:CB$(I)="$":NEXTI:GOTO 1120
  99. 1080   FOR N=1 TO 5:LP=K\MG:K=K-LP*MG
  100. 1090     IF LP<>0 THEN CB$(LP+47)="$"
  101. 1100     MG=MG\10
  102. 1110   NEXT N
  103. 1120   LPRINTTAB(5);:FOR I=0 TO 71:LPRINT CB$(I);:NEXT I:LPRINT
  104. 1130 NEXT J
  105. 1140 PRINT
  106. 1150 FOR I=0TO71:CB$(I)=" ":NEXT I
  107. 1160 LPRINT:LPRINTTAB(23);"BIORHYTHM CALENDAR FOR ";N$:LPRINT
  108. 1170 LPRINT:LPRINTTAB(11);"P=PHYSICAL          S=SENSITIVITY          I=INTELLECTUAL"
  109. 1180 LPRINTTAB(18);"+ = CURVE RISING          - = CURVE FALLING"
  110. 1190 LPRINTTAB(25);"** = TRIPLE CRITICAL DAY!":LPRINT
  111. 1200 FOR L=1 TO 12 STEP 3
  112. 1210   ON L\3+1 GOSUB 1560,1570,1580,1590
  113. 1220   LPRINTTAB(5);"   S  M  T  W  T  F  S      S  M  T  W  T  F  S      S  M  T  W  T  F  S":LPRINT
  114. 1230   N=6*(L-1)+1
  115. 1240   FOR M=1 TO 6
  116. 1250     LP=3
  117. 1260     RP=N
  118. 1270     JL=RP+12
  119. 1280     FOR K=0 TO 71:CB$(K)=" ":NEXT K
  120. 1290     IF RP>JL THEN 1500
  121. 1300     FOR K=1 TO 7
  122. 1310       IF CA(K+7*(RP-1))=0 THEN 1460
  123. 1320       SL=K+7*(RP-1)
  124. 1330       IF CA(SL)>8500 THEN CB$(LP)="*":CB$(LP-1)="*":GOTO1460
  125. 1340       IF CA(SL)>8200 THEN CB$(LP)="I":CB$(LP-1)="S":GOTO1460
  126. 1350       IF CA(SL)>6200 THEN CB$(LP)="I":CB$(LP-1)="P":GOTO1460
  127. 1360       IF CA(SL)>5200 THEN CB$(LP)="+":CB$(LP-1)="I":GOTO1460
  128. 1370       IF CA(SL)>5100 THEN CB$(LP)="-":CB$(LP-1)="I":GOTO1460
  129. 1380       IF CA(SL)>4200 THEN CB$(LP)="S":CB$(LP-1)="P":GOTO1460
  130. 1390       IF CA(SL)>3200 THEN CB$(LP)="+":CB$(LP-1)="S":GOTO1460
  131. 1400       IF CA(SL)>3100 THEN CB$(LP)="-":CB$(LP-1)="S":GOTO1460
  132. 1410       IF CA(SL)>1200 THEN CB$(LP)="+":CB$(LP-1)="P":GOTO1460
  133. 1420       IF CA(SL)>1100 THEN CB$(LP)="-":CB$(LP-1)="P":GOTO1460
  134. 1430       CB$(LP)=MID$(STR$(CA(SL) MOD 10),2)
  135. 1440       CB$(LP-1)=MID$(STR$(CA(SL)\10),2)
  136. 1450       IF CB$(LP-1)="0"THENCB$(LP-1)=" "
  137. 1460       LP=LP+3
  138. 1470     NEXT K
  139. 1480     RP=RP+6:LP=LP+4
  140. 1490     GOTO 1290
  141. 1500     LPRINTTAB(5);:FOR I=0 TO 71:LPRINTCB$(I);:NEXT I:LPRINT
  142. 1510     N=N+1
  143. 1520   NEXT M
  144. 1530   LPRINT
  145. 1540 NEXT L
  146. 1550 END
  147. 1560 LPRINTTAB(5);"     J A N U A R Y           F E B R U A R Y             M A R C H":LPRINT:RETURN
  148. 1570 LPRINTTAB(5);"       A P R I L                  M A Y                   J U N E":LPRINT:RETURN
  149. 1580 LPRINTTAB(5);"        J U L Y                A U G U S T           S E P T E M B E R":LPRINT:RETURN
  150. 1590 LPRINTTAB(5);"     O C T O B E R           N O V E M B E R          D E C E M B E R":LPRINT:RETURN
  151. 1600 DIM HP(49)
  152. 1610 FOR I=0TO48:READHP(I):NEXT
  153. 1620 DATA 21,29,30,31,32,38,39,40,41,42,43,0,20,21,28,33,38,43,0
  154. 1630 DATA 19,21,28,32,33,41,42,0,21,29,30,31,33,40,0,21,32,40,0
  155. 1640 DATA 21,31,40,0,19,20,21,22,30,40,0
  156. 1650 DIM MV(24)
  157. 1660 FOR I=0TO23:READMV(I):NEXT
  158. 1670 DATA 31,28,31,30,31,30,31,31,30,31,30,31,31,28,31,30,31,30,31,31
  159. 1680 DATA 30,31,30,31
  160. 1690 DIM SD(9)
  161. 1700 FOR I=0TO8:READSD(I):NEXT
  162. 1710 DATA 6,7,2,3,4,5,7,1,2
  163. 1720 DIM HN(63)
  164. 1730 FOR I=49 TO 55:READHN(I):NEXT
  165. 1740 DATA 2345,16,16,2345,16,16,2345
  166. 1750 PRINT:PRINT
  167. 1760 RETURN
  168. 1770 F=365*Z+Y+31*(X-1)+INT((Z-1)/4)-INT(.75*(INT((Z-1)/100)+1)):RETURN
  169. 1780 F=365*Z+Y+31*(X-1)-INT(.4*X+2.3)+INT(Z/4)-INT(.75*(INT(Z/100)+1)):RETURN
  170.