/* Monthly planner program.  Original by Mike Meyer from the Arexx 1.1
 * distribution disk.  Enhancements by me - Dominic Giampaolo.
 */
 if ~show('L','rexxsupport.library') then
  check = addlib('rexxsupport.library',0,-30,0)

 if ~show('L','rexxarplib.library') then
  check = addlib('rexxarplib.library',0,-30,0)

daynames.0 = 'Sun '      /* We need the space after the names, so that */
daynames.1 = 'Mon '      /* they line up with the gadgets....          */
daynames.2 = 'Tue '
daynames.3 = 'Wed '
daynames.4 = 'Thu '
daynames.5 = 'Fri '
daynames.6 = 'Sat '

/* Set up the months table - from names to numbers, */
months. = 0
months.Jan = 1
months.Feb = 2
months.Mar = 3
months.Apr = 4
months.May = 5
months.Jun = 6
months.Jul = 7
months.Aug = 8
months.Sep = 9
months.Oct = 10
months.Nov = 11
months.Dec = 12

call setupmonths()

call pragma(W,NULL)
dirname = pragma(D)



parse value date('Normal') with myday thismonth thisyear

command = myday    /* this is for the call to gadget() which expects it */
if command < 10 then
  command  = right(command,1)
mymonth = upper(left(thismonth, 3))
mymonth = months.mymonth
thismonth = mymonth
myyear = thisyear

call gadget()

parse value date('Normal') with myday mymonth myyear

start:
arg month year .

if (length(month) > 2) then        /* this is a kludge, 'cause Rexx won't*/
 if (length(month) = 5) then       /* let us pass two parameters from    */
  do				   /* down below for some reason ?!???	 */
    year = substr(month,2)
    month = substr(month,1,1)
  end
 else
  do
    year = substr(month,3)
    month = substr(month,1,2)
  end


call setupmonths()

if datatype(month, 'Numeric') then mymonth = month
else
 do
   if month ~= "" then mymonth = month
   mymonth = upper(left(mymonth, 3))
   mymonth = months.mymonth
 end

if months.mymonth.days = 0 then
 do
   say "Month must be a month name or a number from 1 to 12, not" month
   exit 10
 end

/* Got a valid month, now see about the year */
select
   when year = "" then nop
   when ~datatype(year, 'Numeric') then do
      say "Year must be a number between 1 and 9999, not" year
      exit 10
      end
   when length(year) = 2 then myyear = '19'year
   otherwise myyear = year
 end

if myyear < 1 | myyear > 9999 then
 do
   say "Year must be between 1 and 9999 inclusive, not" myyear
   exit 10
 end

/* Figure out what day of the week that month started on */
firstday = jan1(myyear)

/* Get difference in weekdays between this year & next */
fudge = (jan1(myyear + 1) + 7 - firstday) // 7

select
   /* this is a regular year */
   when fudge = 1 then months.2.days = 28

   /* This is a leap year */
   when fudge = 2 then months.2.days = 29

   /* Otherwise, it must be 1752! */
   otherwise
      months.2.days = 29
      months.9.days = 19
 end

do i = 1 to mymonth - 1
   firstday = firstday + months.i.days
 end

firstday = firstday // 7

firstday = daynames.firstday

days = months.mymonth.days

headerline = daynames.0
do i = 1 to 6
   headerline = headerline daynames.i
   end
linelength = length(headerline)

/* Set up the header for the calender */
lines.1 = center(months.mymonth myyear, linelength)
lines.2 = " "
lines.3 = headerline
linecount = 4	/* First line of body of calendar */

/* Now set up to put together lines of the body */
maxline = linecount + 5
do i = linecount + 1 to maxline
   lines.i = ""
 end

outline = lines.1
do i = 2 to 3
   outline = outline '\'lines.i
 end

 fontheight = 8
 fontwidth = 8

 cport = 'CP'
 notport = 'NP'

 address AREXX "'x=call CreateHost(" cport "," notport ")'"

 do until showlist(P,cport)
  end

 idcmp = 'CLOSEWINDOW+WINDOWDRAG+WINDOWDEPTH+GADGETUP'
 flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL+ACTIVATE'

 call SetReqColor(cport,BACKGROUNDPEN,3)
 call SetReqColor(cport,BLOCKPEN,1)
 call SetReqColor(cport,BOXPEN,1)
 call SetReqColor(cport,SHADOWPEN,2)
 call SetReqColor(cport,OKAYPEN,1)
 call SetReqColor(cport,CANCELPEN,0)

 winwidth = 7*fontwidth*5+50  /* DaysInWeek*FontWidth*NumChars + Border */
 winheight = 10*fontheight+100
 name = 'The Monthly Planner'
 call openwindow(cport,0,0,winwidth,winheight,idcmp,flags,name)
 call ActivateWindow(cport)

 call WindowText(cport,outline)

width = length(daynames.0)-1
leftedge = 18
topedge = 6*fontheight

lines.linecount = right(1, index(headerline, firstday) - 1 + width)
offset = (length(lines.linecount) - 3)*fontheight

/* Highlight the current day */
if myday = 1 then
  call Rectfill(cport,leftedge+offset-2,topedge-2,leftedge+offset+33,topedge+11)
call AddGadget(cport,leftedge+offset,topedge,1,'  1',1)

maxlinelength = (linelength-1)*fontwidth
width2 = width*fontwidth

do i = 2 to days
   if i > 2 & days < 20 then day = i + 11
   else day = i

   if offset + width2 < maxlinelength then
     do
       offset = offset + 40
       /* Highlight the current day */
       if i = myday & mymonth = thismonth & myyear = thisyear  then
	 call Rectfill(cport,leftedge+offset-6,topedge-2,leftedge+offset+33,topedge+11)
       call AddGadget(cport,leftedge+offset,topedge,day,right(day, width),day)
     end
   else
     do
      topedge = topedge + 15
      offset = 0
      /* Highlight the current day */
      if i = myday & mymonth = thismonth & myyear = thisyear  then
	call Rectfill(cport,leftedge+offset-6,topedge-2,leftedge+offset+33,topedge+11)
      call AddGadget(cport,leftedge,topedge,day,right(day, width),day)
     end
 end


 call AddGadget(cport,18,140,back, "<-Back up ",back)
 call AddGadget(cport,130,140,jump,"Jump!",jump)
 call AddGadget(cport,200,140,forward, "Next Month->",forward)
 call AddGadget(cport,10,15,edit, "Edit Day",edit)
 call AddGadget(cport,250,15,clear, "Clear",clear)
 call AddGadget(cport,18,160,delday,"Delete Day",delday)
 call AddGadget(cport,130,160,help, "HELP", help)
 call AddGadget(cport,200,160,print,"Print Day",print)

 call SetNotify(cport,CLOSEWINDOW,notport)
 call SetNotify(cport,MOUSEBUTTONS,notport)
 call SetNotify(cport,ACTIVEWINDOW,notport)
 call SetNotify(cport,GADGETUP,notport)

 mport = OpenPort(notport)
 do until showlist(P,notport)
  end


 notquit = 1
 do while notquit
    call WaitPkt (notport)
    packet = GetPkt(notport)
    if packet ~== NULL() then
     do
      command = GetArg(packet,0)
      comm1 = GetArg(packet,1)
      comm2 = GetArg(packet,2)
      call Reply(packet,0)
      select
	when datatype(command,NUMERIC) then call gadget()
	when command = 'BACK' then call backup()
	when command = 'JUMP' then call jump()
	when command = 'FORWARD' then call forward()
	when command = 'EDIT' then call edit()
	when command = 'CLEAR' then call postmsg()
	when command = 'DELDAY' then call delday()
	when command = 'HELP' then call help()
	when command = 'PRINT' then call print()
	when command = 'CLOSEWINDOW' then call closeup()
	otherwise nop
       end
     end
 end
 call PostMsg()
 call pragma(W,W)
exit



/********** SUBROUTINES ************/

gadget:
 call postmsg()
 fname = months.mymonth'.'command
 fname = fname'.'strip(myyear,B)
 nofile = 0

 volindex = index(dirname,":")
 volum = upper(substr(dirname,1,volindex-1))
 if find(showlist(volume),volum) == 0 then
  if exists('df0:') then
    call pragma(D,'df0:')
  else
    call pragma(D,'vd0:')

 filename = findfile(fname)

 if dirname ~= '' & filename ~= "" then
  do
   dirname = substr(filename,1,(length(filename)-length(fname)))
   pragma(D,dirname)
  end
 if filename ~= "" then
  do
    if exists('df0:c/more') then
      address command more filename
    else
     do
      call open(win,"con:330/0/310/200/Notes....")
      call open(info,filename,"r")
      i = 1
      do until eof(info)
	writeln(win,readln(info))
	i = i + 1
	if i = 23 then
	  do
	   writech(win,"Hit RETURN to continue...")
	   ch = readch(win,1)
	   i = 1
	  end
       end
      call close(info)
      writeln(win,"")
      writech(win,"Hit RETURN to continue....")
      ch = readch(win,1)
      call close(win)
     end
  end
 else
  do
   select
     when command = myday & mymonth = thismonth & myyear = thisyear then
       call PostMsg(335,50, "Nothing Planned for today.")
     when command = 1 then
       call PostMsg(335,50, "Nothing Planned for the" command"'st.")
     when command = 2 then
       call PostMsg(335,50, "Nothing Planned for the" command"'nd.")
     when command = 3 then
       call PostMsg(335,50, "Nothing Planned for the" command"'rd.")
     when command > 3 then
       call PostMsg(335,50, "Nothing Planned for the" command"'th.")
    end
 end
return


/**** call an editor up so that we can type in what we want.... *****/
edit:
 call Postmsg()

 text = "Enter the pathname of where you\"
 text = text "want to put your notes file\"
 text = text "or click on cancel to quit"
 putwhere = Request(75,50,text,dirname,"O.K.","Cancel!")

 if putwhere == "" then
   return
 if putwhere == "O.K." then
  putwhere = dirname
 call pragma(D,putwhere)

 command = getdate("Click on the day you want to edit")

 filename = months.mymonth'.'command
 filename = filename'.'strip(myyear,B)
 text = "Enter/Edit the note you want, save it,\ and then exit your editor."
 call postmsg(150,50,"Enter/Edit the note you want, save it,\ and then exit your editor.")
 if exists('df0:') then
    address command 'run ed ' filename
 else
   call PostMsg(75,50,"No Disk in df0:!!!!\Can't run anything!")

 call delay(100)
 call postmsg()
return




backup:
 call Postmsg()
 call Stop(cport)
 if mymonth > 1 then
  mymonth = mymonth - 1
 else
   do
    mymonth = 12
    myyear = myyear - 1
    mymonth = mymonth''myyear
   end
 start(mymonth)
return


jump:
 jumpdate = Request(175,75,"Enter the Month and year to jump to","",,"Cancel")
 if jumpdate == "" then
  return
 call stop(cport)
 mymnth = word(jumpdate,1)
 myyr = word(jumpdate,2)
 if ~datatype(mymnth,NUMERIC) then
  do
   mymnth = upper(mymnth)
   select
    when mymnth = JAN | mymnth = JANUARY then mymnth = 1
    when mymnth = FEB | mymnth = FEBUARY then mymnth = 2
    when mymnth = MAR | mymnth = MARCH then mymnth = 3
    when mymnth = APR | mymnth = APRIL then mymnth = 4
    when mymnth = MAY then mymnth = 5
    when mymnth = JUN | mymnth = JUNE then mymnth = 6
    when mymnth = JUL | mymnth = JULY then mymnth = 7
    when mymnth = AUG | mymnth = AUGUST then mymnth = 8
    when mymnth = SEP | mymnth = SEPT | mymnth = SEPTEMBER then mymnth = 9
    when mymnth = OCT | mymnth = OCTOBER then mymnth = 10
    when mymnth = NOV | mymnth = NOVEMBER then mymnth = 11
    when mymnth = DEC | mymnth = DECEMBER then mymnth = 12
    otherwise mymnth = mymonth
   end
  end

 if myyr ~= '' then
  do
   if (length(myyr) == 2) then
    myyr = '19'myyr
   mymnth = mymnth''myyr
  end

 start(mymnth)
return


forward:
 call PostMsg()
 call Stop(cport)
 if mymonth < 12 then
   mymonth = mymonth + 1
 else
   do
    mymonth = 1
    myyear = myyear + 1
    mymonth = mymonth''myyear
   end
 start(mymonth)
return


delday:
    comm = getdate("Click on the day you want to delete")
    filename = months.mymonth'.'comm
    filename = filename'.'strip(myyear,B)
    if ~(exists(filename)) then
     do
      msg = filename" is not in "dirname"\"
      msg = msg"where should I look for it?\"
      ans = Request(150,60,msg,dirname,"Do it","Forget it")
      if ans ~== "" then
	call pragma(D,ans)
      else
	return
     end
    msg = "Is it o.k. to DELETE\"
    msg = msg" "filename" ?\"
    msg = msg"on the drive "pragma(D)
    answer = request(150,50,msg,,"O.k.","No Way")
    if (answer == OKAY) then
      call delete(filename)
return


print:
    comm = getdate("Click the day you want to print")
    name = months.mymonth'.'comm
    name = name'.'strip(myyear,B)

    printname = findfile(name)

    if (open(file,printname,R) == 0) then
     do
      postmsg(0,100,"Whoa buckeroo, can't find the file "printname)
      return
     end
    if (open(printer,"PRT:",W) == 0) then
     do
      postmsg(0,100,"Trouble accessing the printer. Sorry.")
      return
     end

    do until eof(file)
      writeln(printer,readln(file))
     end
return


/***
 *** This procedure just closes up shop for us
 ***/
closeup:
 call closeport(notport)
 call stop(cport)
 call postmsg()
 call pragma(W,W)
 exit
return

jan1: procedure
   arg year

   /* Julian calendar; one extra day every four years */
   day = 4 + year + (year + 3) % 4

   /* Gregorian calendar - lose three days over four centuries */
   if year > 1800 then do
      day = day - (year - 1701) % 100
      day = day + (year - 1601) % 400
      end

   /* And the instant changeover in 1752 */
   if year > 1752 then
      day = day + 3

   return day // 7

setupmonths:
  /* and now from numbers to days/month & print names */
  months.1 = 'January'
  months.1.days = 31
  months.2 = 'February'
  months.2.days = 1   /* Fixed later */
  months.3 = 'March'
  months.3.days = 31
  months.4 = 'April'
  months.4.days = 30
  months.5 = 'May'
  months.5.days = 31
  months.6 = 'June'
  months.6.days = 30
  months.7 = 'July'
  months.7.days = 31
  months.8 = 'August'
  months.8.days = 31
  months.9 = 'September'
  months.9.days = 30
  months.10 = 'October'
  months.10.days = 31
  months.11 = 'November'
  months.11.days = 30
  months.12 = 'December'
  months.12.days = 31	   /* Not needed, but here for completeness */
return


getdate:
 arg message
 call Postmsg()
 call Postmsg(0,0,message)
 do until datatype(dayclicked,NUMERIC)
   call WaitPkt (notport)
   pack = GetPkt(notport)
   if pack ~== NULL() then
    do
     dayclicked = getarg(pack)
     call Reply(pack,0)
    end
   else
    nop
 end
call Postmsg()
return dayclicked



findfile:
 arg name

 goodname = name
 if ~exists(goodname) then      /** If you wanted to change where the **/
  do				/** program looks for the date files  **/
   goodname = 'df1:'name
   if ~exists(goodname) then
    do
     goodname = 'df1:s/'name
     if ~exists(goodname) then
      do
       goodname = 'df0:s/'name
       if ~exists(goodname) then
	 goodname = ""
      end
    end
  end

return goodname

/* here is the sum total of the code required to interface with HT */
help:
 if ~(showlist(p, "HT")) then
   do
     address command "run HT:ht -r"
     do until showlist(p, "HT")
       delay(25)
      end
   end
 address HT load "df0:rexx/Mp.help"
return
