start tok64 d64-aN1FLH
1000 REM******************************
1010 REM*                            *
1020 REM*  this adaptation for pet   *
1030 REM*                            *
1040 REM*            by              *
1050 REM*                            *
1060 REM*       d. s. penner         *
1070 REM*                            *
1080 REM*      june-ish  1980        *
1090 REM*                            *
1100 REM******************************
1110 PRINT"{clear}{down*5}"
1120 aa$="{space*8}biorhythm plotter"
1130 ab$="on entry of birth date and a starting"
1140 ac$="date, plots a short chart [ 20 days ]."
1150 ad$="to continue on; press the space bar."
1160 ae$="to end; press{space*2}z ."
1170 af$="to start with a new date; press{space*2}s ."
1180 PRINTaa$
1190 PRINT"{down*3}"
1200 PRINTab$
1210 PRINT"{down}";ac$
1220 PRINT"{down}";ad$
1230 PRINT"{down}";ae$
1240 PRINT"{down}";af$
1250 GETz$:IFz$=""GOTO1250
1260 DEF FNi(x)=SGN(x)*INT(ABS(x))
1270 DEF FNf(x)=x-FNi(x)
1280 DIM f(12),j(2),o$(51)
1290 k=2*{pi}
1300 FORi=1TO12:READf(i)
1310 NEXT i
1320 DATA31,28,31,30,31,30,31,31,30,31,30,31
1330 PRINT"{clear}"
1340 INPUT"birth date: mm,dd,{y*4} ";m1,d1,y1
1350 m=m1:d=d1:y=y1:GOSUB 2360
1360 q1=jd
1370 m2=m1:d2=d1:y2=y1
1380 GOSUB 1860
1390 pi=p2
1400 PRINT
1410 INPUT"starting date: mm,dd,{y*4} ";m2,d2,y2
1420 m=m2:d=d2:y=y2:GOSUB 2360
1430 q2=jd:qf=q2-q1
1440 GOSUB 1860
1450 REM calculates offset
1460 x=m1:GOSUB1960
1470 ji=j2+d1+y1*365
1480 IF j1<639723 THEN pi=8
1490 x=m2:GOSUB 1960
1500 j2=j2+d2+y2*365
1510 IFj2<639723 THENp2=8
1520 n1=y2-.1
1530 o=j2-j1+INT(n1/4)-INT(y1/4)-INT(n1/100)+INT(y1/100)+INT(n1/400)-INT(y1/400)
1540 IFm1>2THEN1570
1550 x=y1:GOSUB2020
1560 o=o+x
1570 IFm2>3THEN 1600
1580 x=y2:GOSUB 2020
1590 o=o+x
1600 REM print header
1610 PRINT"{clear}"
1620 PRINTTAB(7);"down";TAB(20);"critical";TAB(38);"up"
1630 h$="{-*16}!{-*16}"
1640 PRINT TAB(7);h$
1650 REM set f(2) to 29 for lp yrs
1660 x=y2
1670 f(2)=f(2)+x
1680 REM maka de chart
1690 y=qf
1700 PRINT"{home}{down*3}"
1710 FOR o=oTO o+19
1720 PRINTm2;"/";d2;TAB(23);"!"
1730 REM incrument the date
1740 IF p2=8 THEN 1770
1750 p2=p2+1
1760 IF p2>7 THEN p2=1
1770 d2=d2+1
1780 IF d2>f(m2)THEN GOSUB 2350
1790 IF m2<13 THEN 1810
1800 m2=1:y2=y2+1
1810 x=y2:f(2)=28
1820 GOSUB 2020
1830 f(2)=f(2)+x
1840 NEXT o
1850 GOTO 2100
1860 REM finda de daze of de week
1870 n1=m2+12*INT(.6+1/m2)
1880 n2=y2-INT(.6+1/m2)
1890 n3=INT(13*(n1+1)/5)
1900 n4=INT(5*n2/4)
1910 n5=INT(n2/100)
1920 n6=INT(n2/400)
1930 n7=n3+n4-n5+n6+d2-1
1940 p2=n7-7*INT(n7/7)+1
1950 RETURN
1960 REM daze in past months
1970 j2=0
1980 FOR i=1 TO x-1
1990 j2=j2+f(i)
2000 NEXT i
2010 RETURN
2020 REM check for leap yr
2030 IF x/400-INT(x/400)=0THEN2060
2040 IF x/100-INT(x/100)=0THEN2080
2050 IFx/4-INT(x/4)<>0THEN2080
2060 x=1
2070 RETURN
2080 x=0
2090 RETURN
2100 o=y
2110 PRINT"{home}{down*2}"
2120 FOR o=oTO o+19
2130 x=(SIN(k*(o/23-INT(o/23)))*15)+24
2140 p=x
2150 PRINTTAB(p);"p"
2160 NEXT o
2170 o=y
2180 PRINT"{home}{down*2}"
2190 FOR o=oTO o+19
2200 x=(SIN(k*(o/33-INT(0/33)))*15)+24
2210 i=x
2220 PRINTTAB(i);"i"
2230 NEXT o
2240 o=y
2250 PRINT"{home}{down*2}"
2260 FOR o=oTO o+18
2270 x=(SIN(k*(o/28-INT(o/28)))*15)+24
2280 e=x
2290 PRINTTAB(e);"e"
2300 NEXT o
2310 GETz$:IF z$="" THEN 2310
2320 IF z$="z" THEN END
2330 IF z$="s" THEN 1330
2340 o=o+20:qf=qf+20:GOTO 1600
2350 d2=1:m2=m2+1:RETURN
2360 yy=y+FNi((m-14)/12):mm=13+12*FNf((m-14)/12)
2370 jd=d+FNi((367*mm+5)/12)+FNi(365.25*(yy+4712))-2.5
2380 RETURN
stop tok64
(bastext 1.0)