/* 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