10 'Biorhythm 09/25/2020
20 if peek(36)<12 or peek(23)=1 then print "Biorhythm requires NBASIC Version 2.0 (Standard) or later":end
30 def fnage(td)=int(td/86400) '60*60*24
40 def usr1=12129:def usr2=12288
50 mv=11:dv=7:yv=1999 'GNA
60 c=0:for i=1 to 12:c=max(c,len(monthname$(i))):next i
70 dim mn$(12):for i=1 to 12:mn$(i)=rpad$(monthname$(i),c):next i
80 pclear 1:pcls 0:pcolor 15:pfont max(6,peek(65260)*.75)
90 s$=" ":fw=usr1(sadd(s$)):fh=usr2(0)
100 s$="Birthday:":x=fw:y=fh/2:pprint (x,y),11;s$
110 mx=x+usr1(sadd(s$))+fw:my=y
120 dx=mx+usr1(sadd(mn$(1)))+fw:dy=y
130 s$="00":yx=dx+usr1(sadd(s$))+fw:yy=y
140 s$="9999":px=yx+usr1(sadd(s$))+fw*2:py=yy
150 pf=1:gosub 710:pf=2:gosub 710:pf=3:gosub 710
160 s$="Intellectual":iw=usr1(sadd(s$))
170 s$=date2$:cl=x+usr1(sadd(s$))/2:ct=y+fh+fh/2
180 s$="-100":cr=pscrw-fw-iw-fw/2-fh-fw*2-usr1(sadd(s$))-fw:cb=pscrh-fh*4:cw=cr-cl:ch=cb-ct
190 di=cw mod 30:if di>0 then cl=cl+di/2:cw=cw-di:cr=cl+cw:
200 cy=ct:di=cw/30:mk=cy+ch/2
210 hh=ch/2:h1=hh-1:hy=cy+hh
220 plock:gosub 1160:punlock
230 x=cr+fw/2:pprint (x,ct);" 100%":pprint (x,ct+(ch-fh)/2);" 0":pprint (x,cb-fh);"-100%"
240 x=pscrw-fw-iw-fw/2-fh:kx=x+fh+fw/2:lx=kx:ax=x
250 y=ct:line (x,y)-(x+fh-1,y+fh-1),10,bf:pprint (kx,y);"Physical":lp=y+fh
260 y=y+fh*3+fh/4:line (x,y)-(x+fh-1,y+fh-1),12,bf:pprint (kx,y);"Emotional":le=y+fh
270 y=y+fh*3+fh/4:line (x,y)-(x+fh-1,y+fh-1),9,bf:pprint (kx,y);"Intellectual":li=y+fh
280 pprint (ax,cb-fh);"Age"
290 pr=360*30/23:er=360*30/27:ir=360*30/33
300 pw=cw/pr:ew=cw/er:iw=cw/ir
310 pm=pr/30:em=er/30:im=ir/30
320 pprint (px,py),7;"UP/DOWN=Change  TAB=Select  ENTER=Display  ESC=QUIT":pf=1:ps=true:gosub 710:sf=1
330 k$=inkey$:if len(k$)=0 then 330
340 if k$<>chr$(0,38) then 470
350 if sf<>1 then 400
360 mv=mv+1:if mv>12 then mv=1
370 pf=1:ps=true:gosub 710
380 if dv>days(mv,yv) then dv=days(mv,yv):pf=2:ps=false:gosub 710
390 goto 330
400 if sf<>2 then 440
410 dv=dv+1:if dv>days(mv,yv) then dv=1
420 pf=2:ps=true:gosub 710
430 goto 330
440 if yv=3001 then 330
450 yv=yv+1:pf=3:ps=true:gosub 710
460 goto 380
470 if k$<>chr$(0,40) then 580
480 if sf<>1 then 510
490 mv=mv-1:if mv=0 then mv=12
500 goto 370
510 if sf<>2 then 550
520 dv=dv-1:if dv=0 then dv=days(mv,yv)
530 pf=2:ps=true:gosub 710
540 goto 330
550 if yv=1001 then 330
560 yv=yv-1:pf=3:ps=true:gosub 710
570 goto 380
580 if k$<>chr$(0,9) then 610
590 pf=sf:ps=false:gosub 710:sf=sf+1:if sf>3 then sf=1
600 pf=sf:ps=true:gosub 710:goto 330
610 if k$<>chr$(13) then 630
620 pclr (px,py)-(pscrw-1,py+fh+1),0:pf=sf:ps=false:gosub 710:goto 780
630 if k$<>chr$(27) then 650
640 pclear 0:end
650 if k$<>chr$(0,37) then 680
660 pf=sf:ps=false:gosub 710:sf=sf-1:if sf<1 then sf=3
670 pf=sf:ps=true:gosub 710:goto 330
680 if k$<>chr$(0,39) then 700
690 goto 590
700 goto 330
710 if ps then pcolor 0,15
720 on pf goto 730,740,750
730 pprint (mx,my);mn$(mv):goto 760
740 pprint (dx,dy);lpad$(str$(dv),2,"0"):goto 760
750 pprint (yx,yy);str$(yv)
760 if ps then pcolor 15,0
770 return
780 bd=mktime(yv,mv,dv):cd=now:ad=fnage(cd-bd)
790 x=fw:y=cb+fh+fh/2:pprint (x,y),7;"LEFT/RIGHT=Day  SHIFT+LEFT/RIGHT=Week  CTRL+LEFT/RIGHT=Month  PAGE UP/DOWN=Year  HOME=Today"
800 y=y+fh:pprint (x,y),7;"ESC=Select Birthday"
810 plock
820 s$=date2$(cd):x=cl+(cw-usr1(sadd(s$)))/2:y=cb+1:pprint (x,y);s$
830 s$=date2$(adddays(cd,-15)):x=cl-usr1(sadd(s$))/2:pprint (x,y);s$
840 s$=date2$(adddays(cd,15)):x=cl+cw-usr1(sadd(s$))/2:pprint (x,y);s$
850 gosub 1160:gosub 1200
860 punlock
870 poke 1999,117
880 k$=inkey$:if len(k$)=0 then 880
890 if k$<>chr$(0,37) then 910
900 cd=adddays(cd,-1):goto 1140
910 if k$<>chr$(0,39) then 930
920 cd=adddays(cd,1):goto 1140
930 if k$<>chr$(0,16,0,37) then 950
940 cd=adddays(cd,-7):goto 1140
950 if k$<>chr$(0,16,0,39) then 970
960 cd=adddays(cd,7):goto 1140
970 if k$<>chr$(0,17,0,37) then 990
980 cd=adddays(cd,-30):goto 1140
990 if k$<>chr$(0,17,0,39) then 1010
1000 cd=adddays(cd,30):goto 1140
1010 if k$<>chr$(0,33) then 1030
1020 cd=adddays(cd,-365):goto 1140
1030 if k$<>chr$(0,34) then 1050
1040 cd=adddays(cd,365):goto 1140
1050 if k$<>chr$(0,36) then 1070
1060 cd=now:goto 1140
1070 if k$<>chr$(0,17,0,36) then 1090
1080 cd=bd:goto 1140
1090 if k$<>chr$(27) then 1130
1100 plock:pclr (fw/2,cb+1)-(pscrw-fw/2,pscrh-fh/2+1),0
1110 pclr (lx,lp)-(lx+fw*4,lp+fh),0:pclr (lx,le)-(lx+fw*4,le+fh),0:pclr (lx,li)-(lx+fw*4,li+fh),0
1120 gosub 1160:punlock:goto 320
1130 goto 880
1140 if cd<mktime(1001,1,16) then cd=mktime(1001,1,16) else if cd>mktime(3001,12,16) then cd=mktime(3001,12,16)
1150 ad=fnage(cd-bd):goto 810
1160 pclr (cl,ct)-(cr,cb),0
1170 line (cl,ct+ch/2)-(cl+cw,ct+ch/2),8:y=mk:for i=0 to 30:x=cl+i*di:line (x,y-2)-(x,y+2),8:next i
1180 line (cl+cw/2,ct)-(cl+cw/2,ct+ch),7
1190 return
1200 aa=ad-15
1210 pa=aa*pm:x=cl:y=hy-sin(rad(pa))*h1:pset (x,y),10:for i=0 to pr:x=cl+i*pw:y=hy-sin(rad(i+pa))*h1:line -(x,y),10:next i
1220 pprint (lx,lp),10;str$(fix(sin(rad(ad*pm))*h1/hh*100));"%   "
1230 ea=aa*em:x=cl:y=hy-sin(rad(ea))*h1:pset (x,y),12:for i=0 to er:x=cl+i*ew:y=hy-sin(rad(i+ea))*h1:line -(x,y),12:next i
1240 pprint (lx,le),12;str$(fix(sin(rad(ad*em))*h1/hh*100));"%   "
1250 ia=aa*im:x=cl:y=hy-sin(rad(ia))*h1:pset (x,y),9:for i=0 to ir:x=cl+i*iw:y=hy-sin(rad(i+ia))*h1:line -(x,y),9:next i
1260 pprint (lx,li),9;str$(fix(sin(rad(ad*im))*h1/hh*100));"%   "
1270 if cd<bd then pprint (ax,cb);"Before birth  ":goto 1320
1280 ya=year(cd)-year(bd):ma=month(cd)-month(bd):da=day(cd)-day(bd)
1290 if da<0 then ma=ma-1:mm=month(cd)-1:if mm>0 then da=days(mm,year(cd))+da else da=days(12,year(cd)-1)+da
1300 if ma<0 then ya=ya-1:ma=12+ma
1310 pprint (ax,cb);rpad$(str$(ya)+"Y "+str$(ma)+"M "+str$(da)+"D",14)
1320 return
1330 'todo:intuition (38 days),aesthetic (43 days),awareness (48 days),spiritual (53 days)