100 PROGRAM BIORITMUS
  110 NUMERIC A(3),B(3),C(3),F(3),E(3),S(3)
  120 FOR I=1TO3
  130   LET A(I)=0:LET B(I)=0:LET C(I)=0:LET E(I)=0:LET F(I)=0:LET S(I)=0
  140 NEXT I
  150 SET STATUSOFF
  160 GOSUB  2170
  170 GOSUB  1660
  180 GOSUB  480
  190 !
  200 GOSUB  410
  210 REM ***** grafikus képernyö
  220 SET VIDEOMODE1
  230 SET VIDEOCOLOUR2
  240 SET VIDEOX40
  250 SET VIDEOY10
  260 OPEN #1:"VIDEO:"
  270 SET #1:PALETTEBLACK,RED,GREEN,YELLOW,BLUE,MAGENTA,CYAN,WHITE
  280 DISPLAY #1:AT5FROM1TO10
  290 SET #1:INK0
  300 PLOT #1:5,5,
  310 PLOT #1:PAINT
  320 SET #1:INKWHITE
  330 FOR I=0TONAP*40STEP40
  340   PLOT #1:I,165;I,185
  350 NEXT 
  360 FOR I=0TONAP*40STEP400
  370   PLOT #1:I,150;I,200
  380 NEXT I
  390 PLOT #1:0,175;NAP*40,175
  400 GOTO  1460
  410 REM ***** felirat       
  420 TEXT 40
  430 PRINT AT4,2:"1"
  440 PRINT AT4,12:"10"
  450 PRINT AT4,25:"20"
  460 IF NAP>29THENPRINT AT4,37:"30"
  470 RETURN 
  480 WHEN EXCEPTIONUSEERRC
  490   REM ********bekérés      
  500   TEXT 
  510   LET JO$="n"
  520   !
  530   DO 
  540     LET PAP=0
  550     LET FEB=0
  560     PRINT AT10,1:" ";:INPUT PROMPT"Szül. év:":SZEV
  570     PRINT AT11,1:" ";:INPUT PROMPT"      ho:":SZHO
  580     PRINT AT12,1:" ";:INPUT PROMPT"     nap:":SZNAP
  590     LET EV=SZEV
  600     LET HO=SZHO
  610     LET NAP=SZNAP
  620     CALL NAPSZAM
  630   LOOP WHILEJO$<>"i"
  640   LET SZPAP=PAP
  650   LET JO$="n"
  660   DO 
  670     LET PAP=0
  680     LET FEB=0
  690     PRINT AT10,17:" ";:INPUT PROMPT"Keresett év:":BIEV
  700     PRINT AT11,20:" ";:INPUT PROMPT"      ho:":BIHO
  710     LET BINAP=1
  720     LET EV=BIEV
  730     LET HO=BIHO
  740     LET NAP=BINAP
  750     CALL NAPSZAM
  760   LOOP WHILEJO$<>"i"
  770   LET BIPAP=PAP
  780   IF BIPAP<SZPAPTHENGOTO  2500
  790 END WHEN 
  800 REM ******** bio
  810 LET ELTELT=0
  820 LET ELTELT=BIPAP-SZPAP
  830 LET FIZ=IP(ELTELT/23)
  840 LET FIZ=ELTELT-FIZ*23
  850 LET ERZ=IP(ELTELT/28)
  860 LET ERZ=ELTELT-ERZ*28
  870 LET SZE=IP(ELTELT/33)
  880 LET SZE=ELTELT-SZE*33
  890 LET C(1)=FIZ
  900 LET C(2)=ERZ
  910 LET C(3)=SZE
  920 IF (BIHO=1)OR(BIHO=3)OR(BIHO=5)OR(BIHO=7)THENLET NAP=31
  930 IF (BIHO=8)OR(BIHO=10)OR(BIHO=12)THENLET NAP=31
  940 IF (BIHO=4)OR(BIHO=6)OR(BIHO=9)OR(BIHO=11)THENLET NAP=30
  950 IF (BIHO=2)THENLET NAP=FEB
  960 RETURN 
  970 DEF NAPSZAM
  980   LET PVEG$="08*10*12*"
  990   LET PLAN$="01*03*05*07*08*"
 1000   LET PROS$="04*06*09*11*"
 1010   LET SZOKO=IP(EV/4)
 1020   IF SZOKO*4=EVTHENLET FEB=29
 1030   IF SZOKO*4<>EVTHENLET FEB=28
 1040   !
 1050   LET HO$=STR$(HO)
 1060   IF LEN(HO$)=1THENLET HO$="0"&HO$
 1070 END IF 
 1080 IF (POS(PLAN$,HO$,1)<>0)AND(NAP>0)AND(NAP<32)THENLET JO$="i"
 1090 END IF 
 1100 IF (POS(PVEG$,HO$,1)<>0)AND(NAP>0)AND(NAP<32)THENLET JO$="i"
 1110 END IF 
 1120 IF (POS(PROS$,HO$,1)<>0)AND(NAP>0)AND(NAP<31)THENLET JO$="i"
 1130 END IF 
 1140 IF (HO=2)AND(NAP>0)AND(NAP<FEB+1)THENLET JO$="i"
 1150 END IF 
 1160 IF JO$="n"THEN 1450
 1170 !
 1180 END IF 
 1190 LET PAP=EV*365+SZOKO+NAP
 1200 IF HO>1THENLET PAP=PAP+31
 1210 END IF 
 1220 IF HO>2THENLET PAP=PAP+FEB
 1230 END IF 
 1240 IF HO>3THENLET PAP=PAP+31
 1250 END IF 
 1260 IF HO>4THENLET PAP=PAP+30
 1270 END IF 
 1280 IF HO>5THENLET PAP=PAP+31
 1290 END IF 
 1300 IF HO>6THENLET PAP=PAP+30
 1310 END IF 
 1320 IF HO>7THENLET PAP=PAP+31
 1330 END IF 
 1340 IF HO>8THENLET PAP=PAP+31
 1350 END IF 
 1360 IF HO>9THENLET PAP=PAP+30
 1370 END IF 
 1380 IF HO>10THENLET PAP=PAP+31
 1390 END IF 
 1400 IF HO>11THENLET PAP=PAP+30
 1410 END IF 
 1420 IF FEB=29THENLET PAP=PAP-1
 1430 END IF 
 1440 !   
 1450 END DEF 
 1460 REM ************+szinuszok rajza
 1470 REM *** a-ban ciklusok hossza
 1480 REM *** b-ben szinek
 1490 REM *** c-ben az eltolàs
 1500 REM *** nap-ban a honap hossza
 1510 LET A(1)=40*23
 1520 LET A(2)=40*28
 1530 LET A(3)=40*33
 1540 LET B(1)=1
 1550 LET B(2)=2
 1560 LET B(3)=4
 1570 FOR I=1TO3
 1580   SET #1:INKB(I)
 1590   FOR X=0TO40*NAPSTEP20
 1600     LET XF=2*PI*(X+C(I)*40)/A(I)
 1610     LET Y=175+175*SIN(XF)
 1620     PLOT #1:X+20,Y
 1630   NEXT X
 1640 NEXT I
 1650 GOTO  1790
 1660 TEXT 
 1670 PRINT AT1,12:"B I O R I T M U S"
 1680 PRINT AT4,3:" Az emberek fizikai ållapota 23 ,az érzelmi 28 a szellemi pedig 33 napos ciklusban våltozik."
 1690 PRINT AT7,3:"A szinusz görbével åbråzolt ciklusok pozitiv szakasza az aktiv idöszak, a negativ pedig a feltöltödés ideje."
 1700 PRINT AT10,3:"A görbék és a tengely metszéspontjai adjåk a kritikus napokat.";
 1710 PRINT "Az egymåshoz közeli metszéspontok fokozott veszélyt jelentenek."
 1720 PRINT AT15,1:"A program a TÅBLÅZATOS kiértékelés mellett GRAFIKUSAN is megjeleniti";
 1730 PRINT " a kivålasztott honap bioritmus våltozå- sait."
 1740 PRINT "  A grafikån a piros görbe a fizikai, a sårga az érzelmi, a kék a szellemi periodusokat tükrözi."
 1750 PRINT AT24,8:"Gombnyomåsra folytatom !";
 1760 IF INKEY$=""THENGOTO  1760
 1770 TEXT 
 1780 RETURN 
 1790 REM *****vålasz
 1800 IF (FIZ=0)OR(FIZ=11)THENLET FIZ=23
 1810 IF FIZ>11THENLET FIZ=FIZ-11.5
 1820 LET KEZDET=11.5-FIZ
 1830 LET J=1
 1840 FOR I=KEZDETTONAPSTEP11.5
 1850   LET F(J)=IP(I+1)
 1860   LET J=J+1
 1870 NEXT I
 1880 !
 1890 IF (ERZ=0)OR(ERZ=14)THENLET ERZ=28
 1900 IF ERZ>14THENLET ERZ=ERZ-14
 1910 LET KEZDET=14-ERZ
 1920 LET J=1
 1930 FOR I=KEZDETTONAPSTEP14
 1940   LET E(J)=IP(I)+1
 1950   LET J=J+1
 1960 NEXT I
 1970 IF (SZE=0)OR(SZE=16)THENLET SZE=33
 1980 IF SZE>16THENLET SZE=SZE-16.5
 1990 LET KEZDET=16.5-SZE
 2000 LET J=1
 2010 FOR I=KEZDETTONAPSTEP16.5
 2020   LET S(J)=IP(I)+1
 2030   LET J=J+1
 2040 NEXT I
 2050 !
 2060 PRINT AT15,1:" A megadott személy kritikus napjai a honapban:"
 2070 PRINT AT18,10:"FIZIKAI"
 2080 PRINT AT18,20:"ERZELMI"
 2090 PRINT AT18,30:"SZELLEMI"
 2100 FOR I=1TO3
 2110   IF (F(I)<>0)AND(F(I)<NAP)THENPRINT ATI+19,10:F(I)
 2120   IF (E(I)<>0)AND(E(I)<NAP)THENPRINT ATI+19,20:E(I)
 2130   IF (S(I)<>0)AND(S(I)<NAP)THENPRINT ATI+19,30:S(I)
 2140 NEXT I
 2150 IF INKEY$=""THEN 2150
 2160 GOTO  2500
 2170 SET BORDERRGB(.3,.3,.3)
 2180 SET VIDEOMODE1
 2190 SET VIDEOCOLOUR3
 2200 SET VIDEOX40
 2210 SET VIDEOY24
 2220 OPEN #3:"video:"
 2230 DISPLAY #3:AT1FROM1TO24
 2240 SET #3:PALETTERED,YELLOW,RGB(0,.7,0),WHITE,MAGENTA,RGB(.3,.3,.3)
 2250 SET #3:INKRGB(.3,.3,.3)
 2260 PLOT #3:PAINT
 2270 PING 
 2280 SET #3:INKRED
 2290 PLOT #3:100,700,
 2300 PING 
 2310 PRINT #3:"BIORITMUS"
 2320 PING 
 2330 SET #3:INKWHITE
 2340 PLOT #3:100,500,
 2350 PING 
 2360 PRINT #3:"BIORITMUS"
 2370 PING 
 2380 SET #3:INKRGB(0,.5,0)
 2390 PLOT #3:100,300,
 2400 PING 
 2410 PRINT #3:"BIORITMUS"
 2420 WAIT DELAY5
 2430 TEXT 
 2440 SET BORDERBLACK
 2450 RETURN 
 2460 !
 2470 HANDLER ERRC
 2480   RETRY 
 2490 END HANDLER 
 2500 END