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, { День рождения, день текущий, день первый, день второй }
 m0, m, dm1, dm2, { Месяц рождения, месяц текущий, месяц первый, месяц второй }
 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('Вашему вниманию представляется программа, ');
  gotoxy (20,2) ;
  Writeln('которая рассчитывает биоритмы человека' );
  gotoxy (20,3) ;
  Writeln('на заданный интервал времени.');
  gotoxy (40,12) ;
  writeln('Программу составила студентка');
  gotoxy (40,13) ;
  writeln('МГУ ПС группы ЭИЭ-111');
  gotoxy (49,14) ;
  writeln('Громова Ирина');
  gotoxy (40,15) ;
  writeln('г.Москва, 16.12.2007') ;
  gotoxy (20,24);
  writeln('Нажмите любую клавишу для продолжения');
  read(tmp);
  ClrScr;
end;

procedure InputDates(var d0, m0, y0, d, m, y, dd1, dm1, dy1, dd2, dm2, dy2: integer);
var
  correctly: boolean;

procedure rDate(wel: string; var d, m, y: integer);
const
  ymin = 1200;
  ymax = 2200;
begin
 repeat
  Write('Введите ' + wel + ' в формате ДД ММ ГГГГ: ');
  ReadLn(d, m, y);
  correctly := (y >= ymin) and (Y <= ymax) and (m >= 1)
	    and (m <= 12) and (d > 0);

 if correctly then
  if (m = 2) and (d = 29) and (y mod 4 = 0) then
   else
   correctly := d <= Size_of_Month[m];
   if not correctly then WriteLn('Ошибка в дате');
 until correctly;
end;

begin
 repeat
 rDate('дату рождения', d0, m0, y0);
 rDate('текущую дату', d,m,y);
 {Проверка на правильность введенных дат}
 correctly := y > y0;
 if not correctly and (y = y0) then
  begin
   correctly := m > m0;
   if not correctly and (y = y0) then
    begin
     correctly := m > m0;
     if not correctly and (m = m0) then
      correctly := d >= d0;
    end;
   end;
 until correctly;
 rDate('начальную дату диапазона поиска', dd1, dm1, dy1);
 rDate('конечную дату диапазона поиска', 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;
 pEmo       = 2*3.1416/28;
 pIntellect = 2*3.1416/33;
var
 dcurr, j, gw, gw5: integer;
 step: real;
 rP, rE, rI, r, fr: real;
 s, c: string;
begin
  gotoxy (1, 7);
  if dmax < dmin then  begin
   WriteLn('Ошибка: Начальная точка привышает конечную.');
   exit;
  end;
  gw := WindMax and $FF - 12;
 for dcurr := dmin to dmax do begin
  rP := sin(dcurr * pPhisics);
  rE := sin(dcurr * pEmo);
  rI := sin(dcurr * pIntellect);
  {write(' [');
  write(rP);
  write(' | ');
  write(rE);
  write(' | ');
  write(rI);
  write('] ');
  WriteLn;}
  s:='';
  for j:=1 to gw do s:=s+' ';
  s[Trunc(1/2*gw+1)]:='|';
  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;
 gw5 := Trunc(gw / 5);
 step:= 10. / gw;
 Write('==========');
 r := -1;
 for j := 1 to gw5 do begin
  if r < 0 then Write('-');
  fr := Frac(r);
  str(Round(abs(r - fr)), c);
  Write(c[1]);
  str(Round(abs(fr) * 10), c);
  Write('.');
  Write(c[1], '=');
  if r >= 0 then Write('=');
  r := r + step
 end;
 for j := gw5 * 5  to gw do
  Write('=');
 Write(1);
 Write('>');
end;


BEGIN
  SplashScreen;
  InputDates(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.