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