ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1201. Какой сегодня день?

WA#1
Послано debug 31 мар 2007 11:43
program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

var
  a:array[1..7,1..10] of word;
  s:array[1..7] of string=('mon','tue','wed','thu','fri','sat','sun');
  d,m,y,i,j,st,md,l,k,se:longint;

function vis(g:longint):boolean;
begin
  if (g mod 400)=0 then vis:=true
    else vis:=(((g mod 4)=0)and((g mod 100)<>0));
end;

function mes(m,y:longint):longint;
begin
  case m of
    1,3,5,7,8,10,12:mes:=31;
    4,6,9,11:mes:=30;
    2:if vis(y) then mes:=29 else mes:=28;
  end;
end;

begin
  readln(d,m,y);
  st:=1;
  if y>2001 then begin
    for i:=2001 to y-1 do begin
      inc(st);
      if vis(i) then inc(st);
      if st>7 then st:=st-7;
    end;
  end else if y<2001 then begin
    for i:=y to 2000 do begin
      dec(st);
      if vis(i) then dec(st);
      if st<1 then st:=st+7;
    end;
  end;
  if m>1 then for i:=1 to m-1 do begin
    st:=st+mes(i,y);
    while st>7 do st:=st-7;
  end;
  k:=mes(m,y);
  l:=1;
  i:=st;
  j:=1;
  fillchar(a,sizeof(a),0);
  while l<=k do begin
    a[i,j]:=l;
    if l=k then se:=j;
    if i=7 then begin
      inc(j);
      i:=1;
    end else inc(i);
    inc(l);
  end;
  for i:=1 to 7 do begin
    write(s[i]);
    for j:=1 to se do if a[i,j]<>0 then begin
      if a[i,j]<>d then begin
        if (a[i,j] div 10)<>0 then write(' ',a[i,j]) else write(' ',a[i,j]);
      end else begin
        if (a[i,j] div 10)<>0 then write(' [',a[i,j],']') else write(' [ ',a[i,j],']');
      end;
    end;
    writeln;
  end;
end.



Where is mistake???