home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / friendly / bio.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-25  |  5.6 KB  |  88 lines
  1. 10 KEY OFF:WIDTH 80:SCREEN 0,0,0:COLOR 3,0,0
  2. 20 CLEAR:DEFINT K,L:DEFDBL B,J,M-Y:DEFSTR C,E,Z
  3. 30 ON KEY(1) GOSUB 830:ON KEY(10) GOSUB 360
  4. 40 L=0:T=35:P=3.1415926535#:CLS
  5. 50 GOSUB 390:XX=1:YY=1:GOSUB 380
  6. 60 LOCATE 1,1:PRINT"╔"STRING$(78,205)"╗":LOCATE 3,1:PRINT"╚"STRING$(78,205)"╝":LOCATE 2,1:PRINT"║"SPC(31)"B I O R H Y T H M"SPC(30)"║"
  7. 70 COLOR 0,7:LOCATE 4,25:PRINT" Please Enter Your Birth Date ":COLOR 3,0:LOCATE 6,30:PRINT"(m-d-y)";:GOSUB 180:GOSUB 190:JB=JD:GOSUB 200
  8. 80 COLOR 0,7:LOCATE 4,20:PRINT" Please Enter A Start Date For Your Chart ";:COLOR 3,0:LOCATE 6,30,1:PRINT"(m-d-y)";:GOSUB 180:GOSUB 190:JC=JD
  9. 90 IF JC<JB THEN GOSUB 210:GOTO 70
  10. 100 GOSUB 220
  11. 110 N=JC-JB:V=23:GOSUB 230:V=28:GOSUB 230:V=33:GOSUB 230:GOSUB 320:E=" "+E
  12. 120 COLOR 15,0:LOCATE ,1,0:PRINT C;:COLOR 3,0:PRINT E;:JC=JC+1:L=L+1:IF L<21 THEN 110
  13. 130 LOCATE 24,15:COLOR 15,0:PRINT" Strike Space Bar To Continue---<F1> To Enter New Dates";:COLOR 3,0
  14. 140 LOCATE 25,24:COLOR 0,7:PRINT" Strike <F10> To Leave This Program ";:COLOR 3,0
  15. 150 KEY(1) ON
  16. 160 Z=INKEY$:IF Z=" " THEN 170 ELSE 160
  17. 170 KEY (1) OFF:L=0:GOTO 100
  18. 180 GOSUB 490:YEAR=YEAR+1900:RETURN
  19. 190 W=FIX((MONTH-14)/12):JD=INT(1461*(YEAR+4800+W)/4):B=FIX(367*(MONTH-2-W*12)/12):JD=JD+B:B=INT(INT(3*(YEAR+4900+W)/100)/4):JD=JD+DAY-32075-B:RETURN
  20. 200 FOR A=6 TO 4 STEP -1:LOCATE A,1:PRINT SPC(79);:NEXT:RETURN
  21. 210 LOCATE 10,21:PRINT"Start Date Cannot Be Earlier Than Your":LOCATE 11,21:PRINT"     Birth Date. Please Try Again.":FOR A=1 TO 4000:NEXT:LOCATE 10,1:PRINT SPC(79):PRINT SPC(79):GOTO 200
  22. 220 CLS:COLOR 7,0:PRINT"--DATE--";SPC(13)"D O W N"SPC(12)"CRITICAL"SPC(12)"U P":COLOR 2,0:PRINT SPC(8)STRING$(72,219);:RETURN
  23. 230 IF V=23 THEN E=SPACE$(72):E=LEFT$(E,T)+CHR$(222)+RIGHT$(E,T)
  24. 240 W=INT(N/V):R=N-W*V:IF V=23 THEN C="P" ELSE IF V=28 THEN C="E" ELSE IF V=33 THEN C="I"
  25. 250 W=R/V:W=W*2*P:W=T*SIN(W):W=W+T+1.5:W=INT(W):Z=MID$(E,W,1)
  26. 260 IF Z="P" OR Z="E" OR Z="&" THEN C="&"
  27. 270 IF W=1 THEN 300
  28. 280 IF W=T+T+1 THEN 310
  29. 290 E=LEFT$(E,W-1)+C+RIGHT$(E,T+T+1-W):RETURN
  30. 300 E=C+RIGHT$(E,T+T):RETURN
  31. 310 E=LEFT$(E,T+T)+C:RETURN
  32. 320 W=JC+68569!:R=INT(4*W/146097!):W=W-INT((146097!*R+3)/4):YEAR=INT(4000*(W+1)/1461001!):W=W-INT(1461*YEAR/4)+31:MONTH=INT(80*W/2447):DAY=W-INT(2447*MONTH/80):W=INT(MONTH/11):MONTH=MONTH+2-12*W:YEAR=100*(R-49)+YEAR+W:Z=STR$(MONTH):W=LEN(Z)-1
  33. 330 IF MONTH<10 THEN Z=" "+Z:W=W+1
  34. 340 C=MID$(Z,2,W)+"/":Z=STR$(DAY):W=LEN(Z)-1:IF DAY<10 THEN Z="0"+Z:W=W+1
  35. 350 C=C+MID$(Z,2,W)+"/":Z=STR$(YEAR):W=LEN(Z)-1:C=C+MID$(Z,W,2):RETURN
  36. 360 XX=CSRLIN:YY=POS(0):KEY(1) OFF:KEY(10) OFF:LOCATE 25,1:PRINT SPC(78);:COLOR 15,0:LOCATE 25,21:PRINT"Do You Wish To Leave This Program? <Y/N>";:COLOR 3,0
  37. 370 Z=INKEY$:IF Z="" THEN 370 ELSE IF Z="Y" OR Z="y" THEN 850 ELSE IF Z<>"N" AND Z<>"n" THEN 370
  38. 380 LOCATE 25,1:PRINT SPC(78);:COLOR 0,7:LOCATE 25,23:PRINT" Strike <F10> To Leave This Program ";:Z="":KEY(1) ON:KEY(10) ON:COLOR 3,0:LOCATE XX,YY:RETURN
  39. 390 'INSTRUCTIONS
  40. 400 CLS:PRINT STRING$(80,219):FOR A=2 TO 22:LOCATE A,1:PRINT CHR$(219):LOCATE A,80:PRINT CHR$(219):NEXT:LOCATE 23,1:PRINT STRING$(80,219);:COLOR 15,0:LOCATE 3,32:PRINT"B I O R H Y T H M
  41. 410 LOCATE 8,23:PRINT"Would You Like Instructions? <Y/N>":COLOR 3,0
  42. 420 Z=INKEY$:IF Z="" THEN 420 ELSE IF Z="N" OR Z="n" THEN CLS:RETURN ELSE IF Z<>"Y" AND Z<>"y" THEN 420
  43. 430 COLOR 15,0:LOCATE 3,22:PRINT"P E R S O N A L    B I O R H Y T H M ":COLOR 3,0
  44. 440 LOCATE 5,22:PRINT"The  Biorhythm  theory was originally":LOCATE 6,22:PRINT"developed in  the  19th  century.  It":LOCATE 7,22:PRINT"suggests  that we  are  all  affected":LOCATE 8,22:PRINT"by predictable  and recurring  cycles.
  45. 450 LOCATE 9,22:PRINT"There  are   THREE   distinct  cycles:":LOCATE 11,22:PRINT"  <1> The 23 day Physical Rhythm":LOCATE 12,22:PRINT"  <2> The 28 day Emotional Rhythm":LOCATE 13,22:PRINT"  <3> The 33 day Intellectual Rhythm
  46. 460 LOCATE 15,22:PRINT"First enter your birth date, then the":LOCATE 16,22:PRINT"date that you would like the chart to":LOCATE 17,22:PRINT"begin.":LOCATE 19,22:PRINT"For more information on the Biorhythm
  47. 470 LOCATE 20,22:PRINT"Theory, see page  31  in your manual.":LOCATE 25,27:COLOR 14,0:PRINT"Strike Any Key To Continue";:COLOR 3,0
  48. 480 Z=INKEY$:IF Z="" THEN 480 ELSE CLS:RETURN
  49. 490 LOCATE ,40:PRINT SPC(39);:LOCATE ,40,1:
  50. 500 Z1="":Z=""
  51. 510 Z=INKEY$:IF Z="" THEN 510
  52. 520 IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 580
  53. 530 IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 490
  54. 540 IF Z=CHR$(13) OR LEN(Z)>1 THEN 510
  55. 550 IF LEN(Z1)>1 THEN 510
  56. 560 IF Z<"0" OR Z>"9" THEN 510
  57. 570 Z1=Z1+Z:LOCATE ,40:PRINT Z1;:GOTO 510
  58. 580 MONTH=VAL(Z1):IF MONTH<1 OR MONTH >12 THEN 490
  59. 590 Z2=Z1+Z:LOCATE ,40:PRINT Z2;:Z1="":Z=""
  60. 600 Z=INKEY$:IF Z="" THEN 600
  61. 610 IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 680
  62. 620 IF Z=CHR$(13) THEN 600
  63. 630 IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 490
  64. 640 IF LEN(Z1)>1 THEN 510
  65. 650 IF LEN(Z)>1 THEN 600
  66. 660 IF Z<"0" OR Z>"9" THEN 600
  67. 670 Z1=Z1+Z:LOCATE ,POS(0):PRINT Z;:GOTO 600
  68. 680 DAY=VAL(Z1):IF DAY<1 OR DAY>31 THEN 490
  69. 690 Z2=Z2+Z1+Z:LOCATE ,40:PRINT Z2;:Z1="":Z=""
  70. 700 Z=INKEY$:IF Z="" THEN 700
  71. 710 IF Z="." OR Z="/" OR Z="-" OR Z=" " THEN 760
  72. 720 IF Z=CHR$(8) OR RIGHT$(Z,1)=CHR$(75) THEN Z1="":Z="":GOTO 490
  73. 730 IF Z=CHR$(13) OR LEN(Z)>1 THEN 700
  74. 740 IF Z<"0" OR Z>"9" THEN 700
  75. 750 Z1=Z1+Z:LOCATE ,POS(0):PRINT Z;:IF LEN(Z1)<2 THEN 700
  76. 760 YEAR=VAL(Z1)
  77. 770 Z2=Z2+Z1
  78. 780 LOCATE ,POS(0)+5,1:COLOR 15,0:PRINT"Correct? <Y/N>";:COLOR 3,0
  79. 790 Z=INKEY$:IF Z="" THEN 790
  80. 800 IF Z="y" OR Z="Y" OR Z=CHR$(13) THEN RETURN
  81. 810 IF Z<>"n" AND Z<>"N" THEN 790
  82. 820 GOTO 490
  83. 830 RETURN 840
  84. 840 L=0:CLS:KEY(1) OFF:GOTO 60
  85. 850 CLEAR:ON ERROR GOTO 860:RUN"MENU2"
  86. 860 CLEAR:ON ERROR GOTO 870:RUN"MENU1"
  87. 870 RUN"menu3"
  88.