1 REM ****************** 2 REM Bio Rhythms 3 REM By Chris Nixon 4 REM ****************** 5 REM NC200 Version 6 REM Downloaded from Tim's Amstrad NC User's Site 7 REM http://www.ncus.org.uk 20 : 30 CLS 40 ON ERROR GOTO 950 50 PROCsetup 60 REPEAT:PROCinput:PROCdays:PROCgraph:PROCreport:UNTIL FALSE 70 : 80 DEF PROCsetup 90 VDU29,0;64; 100 yc%=31:REM Y Centre of graphic window 110 xc%=155:REM X Centre of graphic window 120 px%=10:REM No. of pixels per day horizontally 130 xm%=310:REM Width of graphic window 140 ym%=61:REM Height of graphic window 150 DIM m%(12):FOR d%=1 TO 12:READ m%(d%):NEXT 160 DIM m$(12):FOR d%=1 TO 12:READ m$(d%):NEXT 170 DIM period%(3),gap%(3,2),flag%(3),well%(3),well$(7) 180 FOR t%=1 TO 3:READ period%(t%),gap%(t%,0),gap%(t%,1),flag%(t%):NEXT 190 FOR w%=1 TO 7:READ well$(w%):NEXT 200 MOVE 0,0:DRAW 479,0:DRAW 479,63:DRAW 0,63:DRAW 0,0 210 MOVE 167,0:DRAW 167,63:PRINT TAB(5,1);CHR$(17); 220 PRINT"Biorhythm Monitor";CHR$(18) 230 PROCwin1:CLS:ENDPROC 240 : 250 DEF PROCinput 260 REPEAT:UNTIL INKEY$(0)="":REM Flush keyboard buffer 270 PROCwin1:CLS:PRINT TAB(1,0);"Enter your Date of Birth";:PROCwin2:REPEAT 280 REPEAT:CLS:INPUT" Day (1-31): "d1%:UNTIL d1%>0 AND d1%<32 290 REPEAT:CLS:INPUT" Month (1-12): "m1%:UNTIL m1%>0 AND m1%<13 300 REPEAT:CLS:INPUT" Year (1900-): "y1%:UNTIL y1%<100 OR y1%>1900 310 IF y1%<100 y1%=y1%+1900 320 leg%=TRUE:IF y1%<1900 OR y1%>2020 leg%=FALSE 330 IF d1%>m%(m1%)+FNleap(y1%)*(m1%=2) leg%=FALSE 340 IF leg%=0 CLS:PRINT CHR$(17)" Bad date - press SPACE";CHR$(18);:g%=GET 350 UNTIL leg%:ENDPROC 360 : 370 DEF PROCwin1:VDU 28,1,6,26,3:ENDPROC 380 : 390 DEF PROCwin2:VDU 28,1,5,26,5:ENDPROC 400 : 410 DEF PROCdays 420 d2%=VAL(MID$(TIME$,5,2)):y2%=VAL(MID$(TIME$,12,4)) 430 m2%=0:REPEAT:m2%=m2%+1:m$=m$(m2%):UNTIL m$=MID$(TIME$,8,3) 440 d%=365*(y2%-y1%) 450 IF m2%>1 FOR m%=1 TO m2%-1:d%=d%+m%(m%):NEXT 460 IF m1%>1 FOR m%=1 TO m1%-1:d%=d%-m%(m%):NEXT 470 d%=d%+d2%-d1% 480 y%=y1%-y1% MOD 4:REPEAT:y%=y%+4 490 IF y%y2% 510 IF y1%=y2% IF FNleap(y1%) AND m1%<3 AND m2%>2 d%=d%+1:ENDPROC 520 IF FNleap(y1%) AND m1%<3 d%=d%+1 530 IF FNleap(y2%) AND m2%>2 d%=d%+1 540 ENDPROC 550 : 560 DEF FNleap(y%) 570 IF y%MOD4=0 AND (y%MOD100<>0 OR y%MOD400=0) THEN =TRUE ELSE =FALSE 580 : 590 DEF PROCgraph 600 PROCwin1:CLS:PRINT TAB(3,0);"Plot on ";MID$(TIME$,5,11) 610 PRINT TAB(4,2);"For DoB ";CHR$(17);d1%;"-";m1%;"-";y1%;CHR$(18) 620 VDU24,168;65;478;126;29,168;65;:CLG 630 MOVE 0,yc%:PLOT 21,xm%,yc%:MOVE xc%-px%/2,yc%:PLOT 1,px%,0 640 FOR x%=0 TO xm% STEP px%:MOVE x%,0:PLOT 21,x%,ym%:NEXT 650 sd%=d%-17:quit%=FALSE:FOR x%=0 TO xm%:IF INKEY(0)=81 quit%=TRUE:x%=xm% 660 IF t% FOR t%=1 TO 3:PROCbio(t%):NEXT 670 NEXT:MOVE xc%-4,0:PLOT 102,xc%+4,ym%:ENDPROC 680 : 690 DEF PROCbio(t%) 700 period%=period%(t%):flag%=flag%(t%):gap%=gap%(t%,flag%) 710 IF flag% PLOT 69,x%,yc%+(yc%*SIN(2*PI/period%*(sd%+x%/px%))) 720 IF x% MOD gap%=0 flag%=flag%+1:IF flag%=2 flag%=0 730 flag%(t%)=flag%:ENDPROC 740 : 750 DEF PROCreport 760 PROCwin1:CLS 770 FOR t%=1 TO 3:period%=period%(t%):VDU29,0;64;:flag%=0 780 FOR x%=8 TO 28:gap%=gap%(t%,flag%) 790 IF flag% PLOT 69,x%,36-t%*8 800 IF x% MOD gap%=0 flag%=flag%+1:IF flag%=2 flag%=0 810 NEXT 820 well%(t%)=(yc%+(yc%*SIN(2*PI/period%*(sd%+(xc%+px%)/px%))))/(ym%/6)+2 830 IF well%(t%)>7 well%(t%)=7 840 NEXT:PRINT TAB(0,0);CHR$(19);"Your Constitution Today Is";CHR$(20) 850 PRINT TAB(5,1);"Physically";SPC(5);well$(well%(1)); 860 PRINT TAB(5,2);"Emotionally";SPC(4);well$(well%(2)); 870 PRINT TAB(5,3);"Intellectually ";well$(well%(3)); 880 REPEAT:UNTIL INKEY(0)=32:ENDPROC 890 : 900 DATA 31,28,31,30,31,30,31,31,30,31,30,31 910 DATA Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec 920 DATA 23,8,8,0,28,1,8,0,33,4,4,0 930 DATA Awful,Poor,Fair,Normal,Good,Great,Superb 940 : 950 ON ERROR GOTO 970 960 CLS:IF ERR=17 THEN *QUIT 970 REPORT:PRINT" at line ";ERL 980 PRINT:PRINT"Press [Function][X] for Notepad Main Menu"