/*******************************************/
/* Birthdays                               */
/* Birthday-Checker for DFA                */
/* by Ralf Keber (rkeber@sparkasse.net)    */
/* 10.09.97 -  Version 1.1                 */
/*******************************************/

if ~show('L',"rexxreqtools.library") then addlib('rexxreqtools.library',0,-30,0)
fonttag="rt_font=courier.font/13"

if ~show(ports, DFA) then do
    ADDRESS COMMAND 'RUN >NIL: DFA:DFA'
    address command 'wait 2'
    if ~show(ports, DFA) then do
       address command 'wait 4'
       if ~show(ports, DFA) then exit
       end
    end

options RESULTS

cr="0A"X

DaysComing = ""
DaysPassed = ""

if open(Prefs,'ENV:DFA/Birthdays.env','R') then do
   if ~EoF(Prefs) then do
       text=ReadLn(Prefs)
       PARSE VAR Text lastdate"*"DaysComing"*"DaysPassed
       /* if coming from DFA, there's no date-filter*/
       if (ADDRESS()~='DFA') & (lastdate=date('i')) then exit
       if ABS(lastdate-date('i'))>365 then do
	  text="The system-date seems unreliable,"||cr||"please check it!"
	  call rtezrequest(text, "set date|forget about date|abort", ,,
	  fonttag "rt_reqpos = reqpos_centerscr" "rtez_defaultresponse = 1")
	  choice= rtresult
	  if choice == 0 then exit
	  if choice == 1 then Address command 'sys:prefs/time'
	  if choice == 2 then nop
	  end
       end
   close(Prefs)
   end

IF DaysComing="" THEN DaysComing =15
IF DaysPassed="" THEN DaysPassed = 5

if ADDRESS()~=DFA then ADDRESS 'DFA' CHANGEGROUPS ALL

again=1
do until ~again
again=calculate()
end

if ~open(Prefs,'ENV:DFA/Birthdays.env','W') then exit
text=date('i')||"*"||DaysComing||"*"||DaysPassed
WriteCh(Prefs,text)
close(Prefs)
if ~open(Prefs,'ENVARC:DFA/Birthdays.env','W') then exit
WriteCh(Prefs,text)
close(Prefs)

exit

/*******************************************************************************************/

calculate:

/* disable listview refresh */
address "DFA" gui output off input off

today = date('i')
thisyear = substr(date(s), 1, 4)
text="Birthdays, "||DaysPassed||" days passed until "||DaysComing||" days coming"||cr||,
     "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"||cr
address "DFA" first stem p.

InTheNextYear = (today+DaysComing > ConvDate("31.12", thisyear))
if InTheNextYear then DayNextYear = today + DaysComing - 365
InTheLastYear = (today-DaysPassed < ConvDate("01.01", thisyear))
if InTheLastYear then DayLastYear = today - DaysPassed + 365
i=0
do while RC = 0
    bday =  p.address.9
    if bday ~= "" then
    do
	birthday = ConvDate(p.address.9, thisyear)
	if InTheNextYear then
	   if birthday < DayNextYear then birthday = birthday + 365
	if InTheLastYear then
	   if birthday > DayLastYear then birthday = birthday - 365
	diff = birthday - today
	if (birthday ~= 0) & (diff<=DaysComing) & (-diff<=DaysPassed) then
	do
	   i=i+1
	   diff.i      = diff
	   birthday.i  = p.address.9
	   fname.i     = p.address.1
	   name.i      = p.address.2
	   sort.i      = i
	end
    end
    address "DFA" next stem p.
end
max=i
address "DFA" gui output on input on

/* order birthdays */
dpassed=1
dcoming=1
do i=1 to max /* max-1 -> wrong dpassed, dcoming */
   if diff.i<-9 then
      if diff.i<-99 then dpassed=3
		    else if dpassed~=3 then dpassed=2
   if diff.i>9 then
      if diff.i>99 then dcoming=3
		   else if dcoming~=3 then dcoming=2
   do l=i+1 to max
      call compare(sort.i,sort.l)
      end
   end

do i=1 to max
   call textout(sort.i)
   end

call rtezrequest(text, "days passed|ok|days coming", ,,
     fonttag "rt_reqpos = reqpos_centerscr" "rtez_defaultresponse = 2")

choice= rtresult
if choice == 1 then do
   rmax=365-DaysComing
   number = rtgetlong(DaysPassed,, "days pased:", , fonttag,
	  "rtgl_min = 0 rtgl_max ="||rmax)
   if rtresult == 0 then exit
   else DaysPassed=number
   neu=1
   end

if choice == 2 then neu=0

if choice == 0 then do
   rmax=365-DaysPassed
   number = rtgetlong(DaysComing, , "days coming:", , fonttag,
	  "rtgl_min = 0 rtgl_max ="||rmax)
   if rtresult == 0 then exit
   else DaysComing=number
   neu=1
   end
return neu

/*******************************************************************************************/

compare:
   arg ii, ll

   if (diff.ll=0)|(diff.ii > diff.ll) then do
      h=sort.i
      sort.i=sort.l
      sort.l=h
      end
   return

/*******************************************************************************************/

textout:
   arg ii

   if right(birthday.ii, 1) = "." then
   do
     howold = ""
     dot    = ""
   end
   else
   do
     howold = right(thisyear, 2) - right(birthday.ii, 2)
     if howold < 0 then howold = howold + 100
     dot = "."
     howlast = right(howold, 1)
   end

   if (diff.ii = 1) | (diff.ii = -1) then days = "day"
   else days = "days"
   GebTag=fname.ii name.ii||x2c(27)||"s "||howold||dot||"birthday."

   if (diff.ii > 0) then
      text=text||"In "||Right(diff.ii,dcoming)||" "||days||" is "||GebTag||cr
   if (diff.ii = 0) then
       text=text||"*** Today is "||GebTag||" ***"||cr
   if (diff.ii < 0) then
       text=text||Right(diff.ii * (-1),dpassed)||" "||days||" ago was "||GebTag||cr
   return 

/*******************************************************************************************/

ConvDate: procedure
    arg bd,thisyear

    parse VAR bd day"."month"."year

    bdi=0
    if (day>0) & (day<32) & (month>0) & (month<13) then
       do
	 if length(day) < 2 then
	     day = 0||day
	 if length(month) < 2 then
	      month = 0||month
	 bdi=date(i, thisyear||month||day , s)
       end
    return bdi