ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1201. Which Day Is It?

WA#1
Posted by debug 31 Mar 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???