DECLARE SUB AXIS()
DECLARE SUB GRAFIK(t!,dfi!,col!)
DECLARE FUNCTION OFFSET!(d!,m!,y!)
REM Построение биоритмов на текущий месяц
DATA 30,28,31,30,31,30,31,31,30,31,30,31
DIM SHARED days(11),a
FOR k=0 TO 11: READ days(k): NEXT k
wwod:
PRINT "Биоритмы на текущий месяц"
PRINT "Введите день, месяц (числом) и год своего рождения"
INPUT d,m,y
d$=DATE$: m1=VAL(LEFT$(d$,2)): d1=VAL(MID$(d$,4,2))
y1=VAL(RIGHT$(d$,4))
IF (m<1)OR(m>12)OR(d<1)OR(d>days(m))OR(y<1900)OR(y>y1) THEN
PRINT "Вы ошиблись. Повторите ввод"
SLEEP 1: GOTO wwod
END IF
IF (y1 MOD 4)=0 THEN days(2)=29:' поправка на високосный год
a=days(m1):' число дней в текущем месяце
' Интервал от дня рождения до начала текущего месяца
dd=OFFSET(1,m1,y1)-OFFSET(d,m,y)
SCREEN 12
PRINT "красный - физическое состояние"
PRINT "синий - эмоциональное состояние"
PRINT "зеленый - интеллектуальное состояние"
' Построение и разметка координатных осей
AXIS
GRAFIK 23,dd MOD 23,4
GRAFIK 28,dd MOD 28,2
GRAFIK 33,dd MOD 33,1
SLEEP
END
SUB AXIS
LINE (0,140)-(0,340)
LINE (0,240)-(a*20,240)
FOR j=1 TO a
stroke=5
IF (j MOD 5)=0 THEN stroke=10
LINE (j*20,240+stroke)-(j*20,240-stroke)
IF stroke=10 THEN LOCATE 17,(j*20-4)\8: PRINT j
NEXT j
END SUB
SUB GRAFIK(t,dfi,col)
CONST twopi=6.2831853#
x=0: y=240-100*SIN(twopi*dfi/t): COLOR col
PSET (x,y)
FOR k=1 TO a
x1=20*k
y1=240-100*SIN(twopi*(k+dfi)/t)
LINE -(x1,y1)
NEXT k
END SUB
FUNCTION OFFSET (d,m,y)
REM Вычисляет количество дней от 1.01.1900 до d.m.y
dd=365: 'Количество дней в 1900 г
REM Цикл учета полных лет
FOR k%=1901 TO y-1
dd=dd+365
REM Поправка на високосный год
IF (k% MOD 4)=0 THEN dd=dd+1
NEXT k%
REM Учет дней в году y до месяца m
FOR k%=1 TO m-1: dd=dd+days(k%): NEXT k%
OFFSET=dd+d:' Добавление дней, прошедших в месяце m
END FUNCTION