Biorhythm Computer (1700-2200)

Developer(s): Imre Auersbacher
Date: 1985
Type: Program
Platform(s): TS 2068
   10 REM  BIORHYTHM (1700-2200) 
   20 REM  \* 1983 I. Auersbacher 
   30 POKE 23658,8: CLS : BORDER 5
   35 PRINT " BIORHYTHM COMPUTER (1700-2200) ": PRINT "     FOR TS-2068 & PRINTER      ": PRINT 
   40 LET D$="01020304050607080910111213141516171819202122232425262728293031"
   50 LET Y$="JFMAMJJASOND"
   60 PRINT "NAME:"
   70 INPUT Q$
   80 PRINT Q$
   90 LPRINT INVERSE 1;"NAME "; INVERSE 0;": ";Q$
  100 PRINT "PLACE:"
  110 INPUT Q$
  120 PRINT Q$
  130 LPRINT INVERSE 1;"PLACE"; INVERSE 0;": ";Q$
  140 PRINT "BIRTHDATE (MM.DD.YYYY):"
  150 INPUT Q$
  160 PRINT Q$
  170 LPRINT "BIRTHDATE: ";Q$
  180 GO SUB 1150
  190 GO SUB 1270
  200 LET D1=F
  210 LET M$="JAN.FEB.MAR.APR.MAY JUN.JUL.AUG.SEP.OCT.NOV.DEC."
  220 LET W$="SUNDAY   MONDAY   TUESDAY  WEDNESDAYTHURSDAY FRIDAY   SATURDAY "
  230 LET S=F-(7*INT (F/7))+1
  240 LPRINT M$(4*M-3 TO 4*M);D;",";Y;"  ";W$(9*S-8 TO 9*S)
  250 LPRINT "JULIAN DAY = ";F+2342031
  260 PRINT 
  270 LPRINT 
  280 PRINT "START DATE(MM.DD.YYYY):"
  290 INPUT Q$
  300 PRINT Q$
  310 LPRINT "START DATE: ";Q$
  320 GO SUB 1150
  330 LET M1=M
  340 LET Y1=Y
  350 LET D=1
  360 GO SUB 1270
  370 LET S=F-(7*INT (F/7))+1
  380 LET S1=S
  390 LPRINT M$(4*M-3 TO 4*M);D;",";Y;"  ";W$(9*S-8 TO 9*S)
  400 LET JD=F+2342031
  410 LPRINT "JULIAN DAY = ";JD
  420 LPRINT F-D1;" DAYS OLD ON ";Q$
  430 LPRINT 
  440 LET D2=F
  450 LET DIF=D2-D1
  460 PRINT "END DATE  (MM.DD.YYYY):"
  470 INPUT Q$
  480 PRINT Q$
  490 LPRINT "STOP DATE : ";Q$
  500 GO SUB 1150
  510 GO SUB 1270
  520 LET S=F-(7*INT (F/7))+1
  530 LPRINT M$(4*M-3 TO 4*M);D;",";Y;"  ";W$(9*S-8 TO 9*S)
  540 LPRINT "JULIAN DAY = ";F+2342031
  550 PAUSE 100
  560 LET D3=F
  570 FOR Z=1 TO 4
  580 LPRINT 
  590 NEXT Z
  600 LPRINT INVERSE 1;"\::\:: BIORHYTHM CHART STARTING "
  610 LPRINT TAB 5;M$(4*M1-3 TO 4*M1);"1,";Y1;"  ";W$(9*S1-8 TO 9*S1)
  620 LPRINT 
  630 CLS 
  640 LPRINT 
  650 LPRINT "DAY";TAB 6;"LOW (-)";TAB 17;"0";TAB 24;"HIGH (+)"
  660 LPRINT "-----------------+--------------"
  670 LET N=0
  680 LET M=M1
  690 LET Y=Y1
  700 GO SUB 1340
  710 FOR Z=1 TO DAYS
  720 LET P=DIF/23
  730 LET P=SIN (2*PI*(P-INT P))
  740 LET E=DIF/28
  750 LET E=SIN (2*PI*(E-INT E))
  760 LET I=DIF/33
  770 LET I=SIN (2*PI*(I-INT I))
  780 PRINT AT N,0;Y$(M);D$(2*Z-1 TO 2*Z)
  790 PRINT AT N,17;":"
  800 LET P=INT ((P+1)*13+4.55)
  810 LET E=INT ((E+1)*13+4.55)
  820 LET I=INT ((I+1)*13+4.55)
  830 PRINT AT N,P;"P"
  840 IF P=17 THEN PRINT AT N,17; INVERSE 1;"P"
  850 PRINT AT N,E;"E"
  860 IF E=17 THEN PRINT AT N,17; INVERSE 1;"E"
  870 PRINT AT N,I;"I"
  880 IF I=17 THEN PRINT AT N,17; INVERSE 1;"I"
  890 IF (P=E)+(P=I) THEN PRINT AT N,P;"*"
  900 IF E=I THEN PRINT AT N,E;"*"
  910 LET N=N+1
  920 IF N<=21 THEN GO TO 960
  930 LET N=0
  940 COPY 
  950 CLS 
  960 LET DIF=DIF+1
  970 IF DIF+D1>D3 THEN GO TO 1040
  980 NEXT Z
  990 LET M=M+1
 1000 IF M<=12 THEN GO TO 1030
 1010 LET M=1
 1020 LET Y=Y+1
 1030 GO TO 700
 1040 IF N<=18 THEN GO TO 1100
 1050 COPY 
 1060 LPRINT 
 1070 LPRINT 
 1080 LPRINT "  *** END OF BIO-OUTPUT ***"
 1090 STOP 
 1100 PRINT 
 1110 PRINT 
 1120 PRINT "  *** END OF BIO-OUTPUT ***"
 1130 COPY 
 1140 STOP 
 1150 DIM L(2)
 1160 LET L=1
 1170 FOR Z=1 TO LEN Q$
 1180 IF (Q$(Z)<>".") THEN GO TO 1210
 1190 LET L(L)=Z
 1200 LET L=L+1
 1210 NEXT Z
 1220 LET M=VAL Q$( TO L(1)-1)
 1230 LET D=VAL Q$(L(1)+1 TO L(2)-1)
 1240 LET Y=VAL Q$(L(2)+1 TO )
 1250 IF Y<100 THEN LET Y=Y+1900
 1260 RETURN 
 1270 IF M>2 THEN GO TO 1300
 1280 LET F=INT (30.6*(M+13))+INT (365.25*(Y-1))+D-621049
 1290 GO TO 1310
 1300 LET F=INT (30.6*(M+1))+INT (365.25*Y)+D-621049
 1310 IF F>146097 THEN LET F=F-1
 1320 IF F<=73047 THEN LET F=F+(F<=73047)+(F<=36522)
 1330 RETURN 
 1340 IF (M=4)+(M=6)+(M=9)+(M=11) THEN LET DAYS=30
 1350 IF (M=1)+(M=3)+(M=5)+(M=7)+(M=8)+(M=10)+(M=12) THEN LET DAYS=31
 1360 IF M<>2 THEN GO TO 1400
 1370 LET DAYS=28
 1380 IF (Y/4=INT (Y/4))+(Y/100<>INT (Y/100))=2 THEN LET DAYS=29
 1390 IF Y=2000 THEN LET DAYS=29
 1400 RETURN 
 1500 STOP : STOP : STOP 
 2000 SAVE "bio" LINE 10
Scroll to Top