170 lines
6.6 KiB
QBasic
170 lines
6.6 KiB
QBasic
100 REM*****************************************************************
|
||
110 REM
|
||
120 REM BIORHYTHM WALL CALENDAR
|
||
130 REM
|
||
140 REM WRITTEN BY
|
||
150 REM
|
||
160 REM RON WILLIAMS
|
||
170 REM 1845 COCHRAN RD.
|
||
180 REM MORGAN HILL, CA 95037
|
||
190 REM (408) 779-8655
|
||
200 REM
|
||
210 REM BASED ON A CONCEPT BY
|
||
220 REM DR. ROBERT SMITH AT
|
||
230 REM CONTROL DATA CORP.
|
||
240 REM
|
||
250 REM
|
||
260 REM THE ONLY INPUT THE PROGRAM REQUIRES IS YOUR NAME AND YOUR
|
||
270 REM DATE OF BIRTH (GIVEN AS MM,DD,YYYY OR MM,DD,YY).
|
||
280 REM THIS PROGRAM PRINTS OUT A 12-MONTH CALENDER FOR 1978. IF SOME
|
||
290 REM PARTICULAR DAY HAS A 'P', AN 'S' OR AN 'I' INSTEAD OF A
|
||
300 REM NUMBER, IT MEANS THAT DAY IS A P(HYSICAL), S(ENSITIVITY) OR
|
||
310 REM I(NTELLECTUAL) CRITICAL DAY FOR YOU. A '+' OR '-' FOLLOWING
|
||
320 REM ONE OF THE THREE LETTERS ABOVE MEANS THE SINE CURVE IS
|
||
330 REM BEGINNING ITS UPWARD(+) OR DOWNWARD(-) SWING.
|
||
340 REM
|
||
350 REM IF TWO LETTERS APPEAR ON THE CALENDAR, IT MEANS YOU HAVE A
|
||
360 REM DOUBLE-CRITICAL DAY! (E.G. 'PS' MEANS YOUR PHYSICAL AND
|
||
370 REM SENSITIVITY CYCLES ARE BOTH CRITICAL ON THAT DAY).
|
||
380 REM
|
||
390 REM IF A DOUBLE ASTERISK (**) APPEARS ON THE CALENDAR, IT MEANS
|
||
400 REM ALL THREE CYCLES ARE CRITICAL ON THAT DAY! YOU'D BEST JUST
|
||
410 REM STAY HOME N BED!! ONE GOOD(?) THING YOU MIGHT SAY
|
||
420 REM ABOUT A TRIPLE-CRITICAL DAY IS THAT YOU ONLY HAVE 9 OF THEM
|
||
430 REM IN THE 58-YEAR BIORHYTHM LIFE CYCLE (YOUR THREE CYCLES
|
||
440 REM START OVER AGAIN ABOUT EVERY 58 YEARS).
|
||
450 REM
|
||
460 REM THIS PROGRAM WAS ORIGINALLY WRITTEN IN PL/M FOR THE INTELLEC
|
||
470 REM MICROCOMPUTER DEVELOPMENT SYSTEM.
|
||
480 REM BEING INNATELY LAZY, I MERELY TRANSLATED THE CODE (INSTEAD OF
|
||
490 REM REDESIGNING IT) WHEN I REWROTE IT IN MICROSOFT DISK BASIC.
|
||
500 REM THIS LAME EXCUSE IS MY WAY OF TELLING THE USER THAT THE
|
||
510 REM PROGRAM RUNS SLO-O-O-W AS COMPARED TO THE PL/M VERSION.
|
||
520 REM
|
||
530 REM
|
||
540 REM******************************************************************
|
||
550 REM
|
||
560 CLEAR 1000
|
||
570 DEFINT A-E:DEFINT G-Z
|
||
580 DIM CA(583),CB$(71)
|
||
590 WIDTH80
|
||
600 GOSUB 1600
|
||
610 LINEINPUT"PLEASE ENTER YOUR NAME ===> ";N$
|
||
620 INPUT"NOW ENTER YOUR BIRTHDATE (E.G. 5,22,1934) ===> ";MM,DD,YY
|
||
630 IF YY<1000 THEN YY=YY+1900
|
||
640 PRINT:LINEINPUT"POSITION PAPER AT TOP OF FORM, THEN HIT -RETURN-";A$
|
||
650 PRINT:PRINT"WAIT....YOUR BIORHYTHM CALENDAR WILL BE PRINTING SHORTLY....."
|
||
660 CY=1978
|
||
670 X=MM:Y=DD:Z=YY:IFX<3THENGOSUB1770ELSEGOSUB1780
|
||
680 F1=F
|
||
690 X=1:Y=1:Z=1978:GOSUB1770
|
||
700 TD=F-F1+1
|
||
710 IF CY MOD 4=0 THEN MV(13)=29
|
||
720 FOR K=0TO583:CA(K)=0:NEXT
|
||
730 MV(1)=MV(13):CP=SD(CY-1971)
|
||
740 FORJ=1TO12
|
||
750 L=MV(J-1)
|
||
760 RP=6*(J-1)+1
|
||
770 FOR K=1TOL
|
||
780 CA(CP+7*(RP-1))=K
|
||
790 CP=CP+1
|
||
800 IF CP>7 THEN CP=1:RP=RP+1
|
||
810 NEXT K
|
||
820 NEXTJ
|
||
830 CL=23:RP=0
|
||
840 FOR L=1 TO 3
|
||
850 MC=TD MOD CL
|
||
860 FOR J=1 TO 72
|
||
870 FOR K=1 TO 7
|
||
880 SL=K+7*(J-1)
|
||
890 IF CA(SL)=0 THEN 960
|
||
900 IF MC-CL\2-1 = 0 THEN 940
|
||
910 IF MC>CL THEN CA(SL)=CA(SL)+1000*(L+RP)+200:MC=1
|
||
920 MC=MC+1
|
||
930 GOTO 960
|
||
940 CA(SL)=CA(SL)+1000*(L+RP)+100
|
||
950 MC=MC+1
|
||
960 NEXT K
|
||
970 NEXT J
|
||
980 CL=CL+5:RP=RP+1
|
||
990 NEXT L
|
||
1000 REM
|
||
1010 L=0:KL=7*(CY-1971)
|
||
1020 FOR J=1TO7
|
||
1030 MG=10000
|
||
1040 FOR K=0TO71:CB$(K)=" ":NEXTK
|
||
1050 L=L+1:M=HP(L-1):IF M<>0 THEN CB$(M)="$":GOTO 1050
|
||
1060 CP=KL+J:K=HN(CP-1)
|
||
1070 IF K=0 THEN FOR I=48TO53:CB$(I)="$":NEXTI:GOTO 1120
|
||
1080 FOR N=1 TO 5:LP=K\MG:K=K-LP*MG
|
||
1090 IF LP<>0 THEN CB$(LP+47)="$"
|
||
1100 MG=MG\10
|
||
1110 NEXT N
|
||
1120 LPRINTTAB(5);:FOR I=0 TO 71:LPRINT CB$(I);:NEXT I:LPRINT
|
||
1130 NEXT J
|
||
1140 PRINT
|
||
1150 FOR I=0TO71:CB$(I)=" ":NEXT I
|
||
1160 LPRINT:LPRINTTAB(23);"BIORHYTHM CALENDAR FOR ";N$:LPRINT
|
||
1170 LPRINT:LPRINTTAB(11);"P=PHYSICAL S=SENSITIVITY I=INTELLECTUAL"
|
||
1180 LPRINTTAB(18);"+ = CURVE RISING - = CURVE FALLING"
|
||
1190 LPRINTTAB(25);"** = TRIPLE CRITICAL DAY!":LPRINT
|
||
1200 FOR L=1 TO 12 STEP 3
|
||
1210 ON L\3+1 GOSUB 1560,1570,1580,1590
|
||
1220 LPRINTTAB(5);" S M T W T F S S M T W T F S S M T W T F S":LPRINT
|
||
1230 N=6*(L-1)+1
|
||
1240 FOR M=1 TO 6
|
||
1250 LP=3
|
||
1260 RP=N
|
||
1270 JL=RP+12
|
||
1280 FOR K=0 TO 71:CB$(K)=" ":NEXT K
|
||
1290 IF RP>JL THEN 1500
|
||
1300 FOR K=1 TO 7
|
||
1310 IF CA(K+7*(RP-1))=0 THEN 1460
|
||
1320 SL=K+7*(RP-1)
|
||
1330 IF CA(SL)>8500 THEN CB$(LP)="*":CB$(LP-1)="*":GOTO1460
|
||
1340 IF CA(SL)>8200 THEN CB$(LP)="I":CB$(LP-1)="S":GOTO1460
|
||
1350 IF CA(SL)>6200 THEN CB$(LP)="I":CB$(LP-1)="P":GOTO1460
|
||
1360 IF CA(SL)>5200 THEN CB$(LP)="+":CB$(LP-1)="I":GOTO1460
|
||
1370 IF CA(SL)>5100 THEN CB$(LP)="-":CB$(LP-1)="I":GOTO1460
|
||
1380 IF CA(SL)>4200 THEN CB$(LP)="S":CB$(LP-1)="P":GOTO1460
|
||
1390 IF CA(SL)>3200 THEN CB$(LP)="+":CB$(LP-1)="S":GOTO1460
|
||
1400 IF CA(SL)>3100 THEN CB$(LP)="-":CB$(LP-1)="S":GOTO1460
|
||
1410 IF CA(SL)>1200 THEN CB$(LP)="+":CB$(LP-1)="P":GOTO1460
|
||
1420 IF CA(SL)>1100 THEN CB$(LP)="-":CB$(LP-1)="P":GOTO1460
|
||
1430 CB$(LP)=MID$(STR$(CA(SL) MOD 10),2)
|
||
1440 CB$(LP-1)=MID$(STR$(CA(SL)\10),2)
|
||
1450 IF CB$(LP-1)="0"THENCB$(LP-1)=" "
|
||
1460 LP=LP+3
|
||
1470 NEXT K
|
||
1480 RP=RP+6:LP=LP+4
|
||
1490 GOTO 1290
|
||
1500 LPRINTTAB(5);:FOR I=0 TO 71:LPRINTCB$(I);:NEXT I:LPRINT
|
||
1510 N=N+1
|
||
1520 NEXT M
|
||
1530 LPRINT
|
||
1540 NEXT L
|
||
1550 END
|
||
1560 LPRINTTAB(5);" J A N U A R Y F E B R U A R Y M A R C H":LPRINT:RETURN
|
||
1570 LPRINTTAB(5);" A P R I L M A Y J U N E":LPRINT:RETURN
|
||
1580 LPRINTTAB(5);" J U L Y A U G U S T S E P T E M B E R":LPRINT:RETURN
|
||
1590 LPRINTTAB(5);" O C T O B E R N O V E M B E R D E C E M B E R":LPRINT:RETURN
|
||
1600 DIM HP(49)
|
||
1610 FOR I=0TO48:READHP(I):NEXT
|
||
1620 DATA 21,29,30,31,32,38,39,40,41,42,43,0,20,21,28,33,38,43,0
|
||
1630 DATA 19,21,28,32,33,41,42,0,21,29,30,31,33,40,0,21,32,40,0
|
||
1640 DATA 21,31,40,0,19,20,21,22,30,40,0
|
||
1650 DIM MV(24)
|
||
1660 FOR I=0TO23:READMV(I):NEXT
|
||
1670 DATA 31,28,31,30,31,30,31,31,30,31,30,31,31,28,31,30,31,30,31,31
|
||
1680 DATA 30,31,30,31
|
||
1690 DIM SD(9)
|
||
1700 FOR I=0TO8:READSD(I):NEXT
|
||
1710 DATA 6,7,2,3,4,5,7,1,2
|
||
1720 DIM HN(63)
|
||
1730 FOR I=49 TO 55:READHN(I):NEXT
|
||
1740 DATA 2345,16,16,2345,16,16,2345
|
||
1750 PRINT:PRINT
|
||
1760 RETURN
|
||
1770 F=365*Z+Y+31*(X-1)+INT((Z-1)/4)-INT(.75*(INT((Z-1)/100)+1)):RETURN
|
||
1780 F=365*Z+Y+31*(X-1)-INT(.4*X+2.3)+INT(Z/4)-INT(.75*(INT(Z/100)+1)):RETURN
|
||
NT((Z-1)/4)-INT(.75*(INT((Z-1)/10 |