Пока что с помощью интернета и учебника смог изобразить график буквами
Код
program bio;
uses crt;
const
Size_of_Month: array [1..12] of byte = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var
d0, d, dd1, dd2, { Den rozhdeniya, den tekushchiy. }
m0, m, dm1, dm2, { Depeche Mode..;) }
y0, y, dy1, dy2,
days, dmin, dmax: integer;
tstr: string[1];
Label L1;
procedure SplashScreen;
var
tmp: string[1];
begin
textbackground (White);
textColor (Red);
ClrScr;
gotoxy (20,1);
Writeln('Vashemu vnimaniyu predstavlyayetsya programma, ');
gotoxy (18,2);
Writeln('kotoraya rasschityvayet bioritmy cheloveka' );
gotoxy (20,3);
Writeln('na zadannyy interval vremeni');
gotoxy (40,12);
writeln('Programmu sostavil student Volokhin Denis');
gotoxy (40,13);
writeln('');
gotoxy (49,14);
writeln('');
gotoxy (40,15);
writeln('');
gotoxy (20,24);
writeln('Nazhmite lyubuyu klavishu dlya prodolzheniya');
read(tmp);
ClrScr;
end;
procedure iDates(var d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2: integer);
var
isCorr: boolean;
procedure rDate(wel: string; var d, m, y: integer);
const
ymin = 1800;
ymax = 2200;
begin
repeat
Write('Vvedite ' + wel + ' v formate DD MM GGGG: ');
ReadLn(d, m, y);
isCorr := (y >= ymin) and (Y <= ymax) and (m >= 1)
and (m <= 12) and (d > 0);
if isCorr then
if (m = 2) and (d = 29) and (y mod 4 = 0) then
{foo bar, ibo etogo dnya ne sushchestvuyet..}
else
isCorr := d <= Size_of_Month[m];
if not isCorr then WriteLn('Oshibka v date');
until isCorr;
end;
begin
repeat
rDate('datu rozhdeniya', d0, m0, y0);
rDate('tekushchuyu datu', d,m,y);
{test for corr. input}
isCorr := y > y0;
if not isCorr and (y = y0) then
begin
isCorr := m > m0;
if not isCorr and (y = y0) then
begin
isCorr := m > m0;
if not isCorr and (m = m0) then
isCorr := d >= d0;
end;
end;
until isCorr;
rDate('nachalnuyu datu diapazona poiska', dd1, dm1, dy1);
rDate('konechnuyu datu diapazona poiska', dd2, dm2, dy2);
end;
procedure getDays (d0, m0, y0, d, m, y: integer; var days: integer);
Procedure mLoop;
var
mm: integer;
begin
mm := m0;
while mm < m do
begin
days := days + Size_of_Month[mm];
if (mm = 2) and (y0 mod 4 = 0) then inc(days);
inc(mm);
end;
end;
procedure ymLoop;
var
mm, yy: integer;
begin
mm := m0 + 1;
while mm <= 12 do
begin
days := days + Size_of_Month[mm];
if (mm = 2) and (y0 mod 4 = 0) then inc(days);
inc(mm);
end;
yy := y0 + 1;
while yy < y do
begin
days := days + 365;
if yy mod 4 = 0 then inc(days);
inc(yy);
end;
mm := 1;
while mm < m do
begin
days := days + Size_of_Month[mm];
if (y mod 4 = 0) and (mm = 2) then inc(days);
inc(mm);
end;
end;
begin
if (y = y0) and (m = m0) then
days := d - d0
else
begin
days := d + Size_of_Month[m0] - d0;
if (y0 mod 4 = 0) and (m0 = 2) then inc(days);
if y = y0 then mLoop else ymLoop;
end;
end;
procedure parseGraph(d0, m0, y0, dmin, dmax: integer);
const
pPhisics = 2*3.1416/23.6884;
pEmo = 2*3.1416/28.4261;
pIntellect = 2*3.1416/33.1638;
var
dall, dcurr, i, j, gw: integer;
rP, rE, rI: real;
s: string;
begin
dall := dmax - dmin;
if dall < 0 then WriteLn('Oshibka: Nachalnaya tochka privyshayet konechnuyu.');
gw:=WindMax and $FF -12;
for i := 0 to dall do begin
dcurr := dmin + i;
rP := sin(dcurr * pPhisics);
rE := sin(dcurr * pEmo);
rI := sin(dcurr * pIntellect);
s:='';
for j:=1 to gw do s:=s+' ';
s[Trunc((rP+1)/2*gw+1)]:='p';
s[Trunc((rE+1)/2*gw+1)]:='e';
s[Trunc((rI+1)/2*gw+1)]:='i';
WriteLn(dd1:2,dm1:3,dy1:5,' :',s,':');
Inc(dd1);
if dd1>Size_of_Month[dm1] then begin
dd1:=1;
Inc(dm1);
if dm1>12 then begin
dm1:=1;
Inc(dy1)
end
end;
end;
writeln (' 100 80 60 40 20 0 -20 -40 -60 -80 -100 ');
writeln ('p-fisicheskiy, e-emotsionalnyy, i-intellektualnyy ');
end;
BEGIN
{ main proc. }
SplashScreen;
iDates(d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2);
getDays(d0, m0, y0, d, m, y, days);
getDays(d0, m0, y0, dd1, dm1, dy1, dmin);
getDays(d0, m0, y0, dd2, dm2, dy2, dmax);
parseGraph(d0, m0, y0, dmin, dmax);
read(tstr);
END.