### kal_island
### 6.1.2010
### Maple procedures for the Icelandic calendar.
### (c) Svante Janson 2010
### May be freely used and modified for non-commercial properties.
### These procedures are drafts only and not in a final, polished
### version (and probably never will be).
### There is no guarantee that they are correct.
### There is, unfortunately, no further documentation.



if 
# true or
(not (Qkal_island_LOADED=true))  then 
Qkal_island_LOADED:=true;
# NB final fi last in the file
# To avoid unnecessary repeated loadings of the file, 
# the line "true or" should be commented away with "#"
# While working on the file, remove this "#"

if not (Qkal_bas_loaded=true) then read kal_bas fi:
if not (Qkal_julgreg_loaded=true) then read kal_julgreg fi:


isl_greg:=2342304;  #JD för gregoriansk kalender

Isl_manad:=
["Harpa","Skerpla","Sólmánuđur","Heyannir","Tvímánuđur","Haustmánuđur",
"Gormánuđur","Ýlir","Mörsugur","Ţorri","Góa","Einmánuđur",
"aukanćtur"];

################### Julian version

IslJ_FDS:=proc(y)
  local x;
  x:=JD4Jul(9,4,y);
  NextVdag(5,x);
end;

IslJ_FDW:= y-> IslJ_FDS(y+1)-180;

IslJ4JD:=proc(jd)
  local y,fds,fdw;
  y:=JulAstroAr4JD(jd);
  fds:=IslJ_FDS(y);
  if jd<fds then y:=y-1; fds:=IslJ_FDS(y); fi;
    fdw:=IslJ_FDW(y);
  Isl4JDYSW(jd,y,fds,fdw);
end;

################### Gregorian version

IslG_FDS:=proc(y)
  local x;
  x:=JD4Greg(19,4,y);
  NextVdag(5,x);
end;

IslG_FDW:= y-> IslG_FDS(y+1)-180;

IslG4JD:=proc(jd)
  local y,fds,fdw;
  y:=GregAstroAr4JD(jd);
  fds:=IslG_FDS(y);
  if jd<fds then y:=y-1; fds:=IslG_FDS(y); fi;
    fdw:=IslG_FDW(y);
  Isl4JDYSW(jd,y,fds,fdw);
end;

#####################  Common

Isl_FDS:=proc(y)
  if y<=1700 then IslJ_FDS(y)
  else IslG_FDS(y);
  fi;
end;

Isl_FDW:= y-> Isl_FDS(y+1)-180;

Isl4JD:=proc(jd)
  if jd<isl_greg then IslJ4JD(jd)
  else IslG4JD(jd);
  fi;
end;

Isl4JDYSW:=proc(jd,y,fds,fdw)
  [op(Isl4JDSWweek(jd,fds,fdw)),op(Isl4JDSWmonth(jd,fds,fdw)),y];
end;

Isl4JDSWweek:=proc(jd,fds,fdw)
  local vnr;
  if jd < fdw then 
    vnr:=floor((jd-fds)/7)+1;
    [vdag4JD(jd),'vecka',vnr,'Sommar'];
  else   
    vnr:=floor((jd-fdw)/7)+1;
    [vdag4JD(jd),'vecka',vnr,'Vinter'];
  fi;
end;

Isl4JDSWmonth:=proc(jd,fds,fdw)
  local m,d,x;
  if jd < fdw-90 then 
    x:=jd-fds;
    m:=floor(x/30)+1;
    d:=x-30*m+31;
    if m=4 then m:=13 fi;
  else   
    x:=jd-fdw;
    m:=floor(x/30)+1;
    d:=x-30*m+31;
    m:=m+6;
  fi;
  [d,Isl_manad[m]];
end;

JD4Isl:=proc(d,m,y);  #aukanaetur + sumarauka kan ges nummer 0 eller 13
  if (m=0) or (m=13) then Isl_FDS(y)+3*30+d-1;
  elif m<=3 then Isl_FDS(y)+30*(m-1)+d-1;
  else Isl_FDW(y)+30*(m-7)+d-1;
  fi;
end;

#JD för veckodag d (1..7), vecka v, ĺr y; 
#vinterveckor skrivs som -v
JD4IslV:=proc(d,v,y);
  if v>0 then NextVdag(d,Isl_FDS(y)+7*(v-1));
  else NextVdag(d,Isl_FDW(y)+7*(-v-1));
  fi;
end;

###### mest som test:

JD4IslJ:=proc(d,m,y);
  if (m=0) or (m=13) then IslJ_FDS(y)+3*30+d-1;
  elif m<=3 then IslJ_FDS(y)+30*(m-1)+d-1;
  else IslJ_FDW(y)+30*(m-7)+d-1;
  fi;
end;

JD4IslG:=proc(d,m,y);
  if (m=0) or (m=13) then IslG_FDS(y)+3*30+d-1;
  elif m<=3 then IslG_FDS(y)+30*(m-1)+d-1;
  else IslG_FDW(y)+30*(m-7)+d-1;
  fi;
end;


fi;