vypocet dna v tyzdni

[Jan Waclawek]

Tak som si dovolil male variacie na danu temu. Prva funkcia je vlastne ta povodna, druha je variacia na temu 366-dnovy rok (vratane gregorianskej korekcie), a tretia je modifikacia druhej tak, aby sa to dalo jednoducho implementovat v jednocipe. No a prikladam aj vzorovu implementaciu v '51, ale len pre toto storocie. Oboje ma ako "main" test, ktory testuje den za dnom.

Prijemne (po)citanie! :-)

wek

------

uses crt;

var d,m,y:integer;
    dow:integer;
    leapday:boolean;

const
  dd: array[1..12] of integer = ( 31,28,31,30,31,30,31,31,30,31,30,31);

  md:array[1..12] of integer = (
  0,
  31,
  31+29,
  31+29+31,
  31+29+31+30,
  31+29+31+30+31,
  31+29+31+30+31+30,
  31+29+31+30+31+30+31,
  31+29+31+30+31+30+31+31,
  31+29+31+30+31+30+31+31+30,
  31+29+31+30+31+30+31+31+30+31,
  31+29+31+30+31+30+31+31+30+31+30
{  31+29+31+30+31+30+31+31+30+31+30+31,}
);

function get_dow(d,m,y:integer):integer;
var dd:integer;
const
  a=3; b=4;
begin
  y:=y-2000;
  dd:=y+((y+a) div 4);
  dd:=dd+md[m];
  if (m>2) and (y mod 4 <> 0) then begin
    dd := dd - 1 ;
  end;
  dd:=dd+d;
  dd := dd + b;
  get_dow := dd mod 7;
end;


function get_dow2(d,m,y:integer):integer;
var dd,c1,c2,c3,c4:longint;
const b=0000; c=2; {"gregorian" 1.3.0000 - wednesday}
begin
  dd:=longint(y-b)*366+md[m]+d-31-29-1; {nr of days since 1.3.0000 in hypothetical 366-day years}
  c1:=dd div 366; {correction 366 -> 365 days per year}
  c2:=c1 div 4; {standard Julian leap year correction}
  c3:=c1 div 100; {Gregorian correction for 100 years are not leap}
  c4:=c1 div 400; {Gregorian correction for the overshoot in each 400 years}
  dd := dd - c1 + c2 - c3 + c4;
  get_dow2 := (dd + c) mod 7;
end;


function get_dow3(d,m,y:integer):integer;
var dd,c1,c2,c3,c4:longint;
const b=0000; c=4; {"gregorian" 1.3.0000 - wednesday}
begin
  dd:=longint(y-b)*(366 mod 7)+(md[m] mod 7)+d; {nr of days since 1.1.0000 in hypothetical 366-day years}
  c1:=y-b; if m<3 then dec(c1);
  c2:=c1 div 4; {standard Julian leap year correction}
  c3:=c2 div 25; {Gregorian correction for 100 years are not leap}
  c4:=c3 div 4; {Gregorian correction for the overshoot in each 400 years}
  dd := dd - c1 + c2 - c3 + c4;
  get_dow3 := (dd + c) mod 7;
end;




begin

  y:=2000;
  m:=1;
  d:=1;
  dow:=5;

  repeat
    writeln(d:2,'-',m:2,'-',y:2,':',dow:2,'/',get_dow3(d,m,y));
    if dow <> get_dow3(d,m,y) then begin
      writeln('...mismatch - press ENTER...');
      readln;
    end;
    inc(dow);
    dow := dow mod 7;
    inc(d);
    leapday := (m = 2) and (d = 29) and ((y mod 4) = 0);
    if leapday and ((y mod 100) = 0) and not ((y mod 400) = 0) then leapday:=false;
    if d>dd[m] then
      if not leapday then begin
        d:=1;
        inc(m);
        if m>12 then begin
          m:=1;
          inc(y);
        end;
      end;
  until keypressed and (readkey=#27);
end.


-------------

$MOD52

day equ 30h
month equ 31h
year equ 32h
dow equ 33h

TestDow:
       mov   dow,#2
       mov   year,#0      
       mov   month,#3
       sjmp  TestDowX2
TestDowX1:
       mov   month,#1
TestDowX2:
       mov   day,#1
TestDowX3:
       mov   r5,day
       mov   r6,month
       mov   r7,year
       call  DayOfWeek
       cjne  a,dow,Fail
       inc   dow
       mov   a,dow
       cjne  a,#7,TestDowX4
       mov   dow,#0
TestDowX4:
       inc   day
       mov   a,month
       add   a,#TestDowTab-TestDowX5-1
       movc  a,@a+pc
TestDowX5:
       cjne  a,day,TestDowX6
       sjmp  TestDowX3
TestDowX6:
       jnc   TestDowX3
       mov   a,month
       cjne  a,#2,TestDowX7
       mov   a,day
       cjne  a,#29,TestDowX7
       mov   a,year
       anl   a,#3
       jz    TestDowX3
TestDowX7:
       inc   month
       mov   a,month
       cjne  a,#12+1,TestDowX2
       inc   year       
       mov   a,year
       cjne  a,#100,TestDowX1
       sjmp  Pass
TestDowTab:
       db    31,28,31,30,31,30,31,31,30,31,30,31
 
Fail: 
       ljmp  Fail
Pass:
       sjmp  Pass 


;calculates day of week
;good since 01.03.2000 until 31.12.2099
;input: r7 - year (00-99 for 2000-2099)
;       r6 - month (01-12)
;       r5 - day (01-31, as appropriate for given month)
;no sanity check performed
;returns in acc 00-06 for Monday-Sunday
;uses b
;

DayOfWeek:
        mov   a,r6
        cjne  a,#3,DayOfWeekX1
DayOfWeekX1:
        mov   a,r7
        subb  a,#0
        mov   b,a
        rr    a
        rr    a
        anl   a,#03Fh
        clr   c
        subb  a,b
        mov   b,a
        mov   a,r7
        rl    a
        add   a,b
        mov   b,a
        mov   a,r6
        add   a,#DayOfWeekTab-DayOfWeekX2-1
        movc  a,@a+pc
DayOfWeekX2:
        add   a,r5
        add   a,b
        add   a,#4
        mov   b,#7
        div   ab
        mov   a,b
        ret

DayOfWeekTab:
        db    0,3,4,0,2,5,0,3,6,1,4,6        


   


        end