home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / amiga / utility / text / htext.lzh / hypertext / Rexx / Mp < prev    next >
Encoding:
Text File  |  1990-12-23  |  13.9 KB  |  598 lines
  1. /* Monthly planner program.  Original by Mike Meyer from the Arexx 1.1
  2.  * distribution disk.  Enhancements by me - Dominic Giampaolo.
  3.  */
  4.  if ~show('L','rexxsupport.library') then
  5.   check = addlib('rexxsupport.library',0,-30,0)
  6.  
  7.  if ~show('L','rexxarplib.library') then
  8.   check = addlib('rexxarplib.library',0,-30,0)
  9.  
  10. daynames.0 = 'Sun '      /* We need the space after the names, so that */
  11. daynames.1 = 'Mon '      /* they line up with the gadgets....          */
  12. daynames.2 = 'Tue '
  13. daynames.3 = 'Wed '
  14. daynames.4 = 'Thu '
  15. daynames.5 = 'Fri '
  16. daynames.6 = 'Sat '
  17.  
  18. /* Set up the months table - from names to numbers, */
  19. months. = 0
  20. months.Jan = 1
  21. months.Feb = 2
  22. months.Mar = 3
  23. months.Apr = 4
  24. months.May = 5
  25. months.Jun = 6
  26. months.Jul = 7
  27. months.Aug = 8
  28. months.Sep = 9
  29. months.Oct = 10
  30. months.Nov = 11
  31. months.Dec = 12
  32.  
  33. call setupmonths()
  34.  
  35. call pragma(W,NULL)
  36. dirname = pragma(D)
  37.  
  38.  
  39.  
  40. parse value date('Normal') with myday thismonth thisyear
  41.  
  42. command = myday    /* this is for the call to gadget() which expects it */
  43. if command < 10 then
  44.   command  = right(command,1)
  45. mymonth = upper(left(thismonth, 3))
  46. mymonth = months.mymonth
  47. thismonth = mymonth
  48. myyear = thisyear
  49.  
  50. call gadget()
  51.  
  52. parse value date('Normal') with myday mymonth myyear
  53.  
  54. start:
  55. arg month year .
  56.  
  57. if (length(month) > 2) then        /* this is a kludge, 'cause Rexx won't*/
  58.  if (length(month) = 5) then       /* let us pass two parameters from    */
  59.   do                   /* down below for some reason ?!???     */
  60.     year = substr(month,2)
  61.     month = substr(month,1,1)
  62.   end
  63.  else
  64.   do
  65.     year = substr(month,3)
  66.     month = substr(month,1,2)
  67.   end
  68.  
  69.  
  70. call setupmonths()
  71.  
  72. if datatype(month, 'Numeric') then mymonth = month
  73. else
  74.  do
  75.    if month ~= "" then mymonth = month
  76.    mymonth = upper(left(mymonth, 3))
  77.    mymonth = months.mymonth
  78.  end
  79.  
  80. if months.mymonth.days = 0 then
  81.  do
  82.    say "Month must be a month name or a number from 1 to 12, not" month
  83.    exit 10
  84.  end
  85.  
  86. /* Got a valid month, now see about the year */
  87. select
  88.    when year = "" then nop
  89.    when ~datatype(year, 'Numeric') then do
  90.       say "Year must be a number between 1 and 9999, not" year
  91.       exit 10
  92.       end
  93.    when length(year) = 2 then myyear = '19'year
  94.    otherwise myyear = year
  95.  end
  96.  
  97. if myyear < 1 | myyear > 9999 then
  98.  do
  99.    say "Year must be between 1 and 9999 inclusive, not" myyear
  100.    exit 10
  101.  end
  102.  
  103. /* Figure out what day of the week that month started on */
  104. firstday = jan1(myyear)
  105.  
  106. /* Get difference in weekdays between this year & next */
  107. fudge = (jan1(myyear + 1) + 7 - firstday) // 7
  108.  
  109. select
  110.    /* this is a regular year */
  111.    when fudge = 1 then months.2.days = 28
  112.  
  113.    /* This is a leap year */
  114.    when fudge = 2 then months.2.days = 29
  115.  
  116.    /* Otherwise, it must be 1752! */
  117.    otherwise
  118.       months.2.days = 29
  119.       months.9.days = 19
  120.  end
  121.  
  122. do i = 1 to mymonth - 1
  123.    firstday = firstday + months.i.days
  124.  end
  125.  
  126. firstday = firstday // 7
  127.  
  128. firstday = daynames.firstday
  129.  
  130. days = months.mymonth.days
  131.  
  132. headerline = daynames.0
  133. do i = 1 to 6
  134.    headerline = headerline daynames.i
  135.    end
  136. linelength = length(headerline)
  137.  
  138. /* Set up the header for the calender */
  139. lines.1 = center(months.mymonth myyear, linelength)
  140. lines.2 = " "
  141. lines.3 = headerline
  142. linecount = 4    /* First line of body of calendar */
  143.  
  144. /* Now set up to put together lines of the body */
  145. maxline = linecount + 5
  146. do i = linecount + 1 to maxline
  147.    lines.i = ""
  148.  end
  149.  
  150. outline = lines.1
  151. do i = 2 to 3
  152.    outline = outline '\'lines.i
  153.  end
  154.  
  155.  fontheight = 8
  156.  fontwidth = 8
  157.  
  158.  cport = 'CP'
  159.  notport = 'NP'
  160.  
  161.  address AREXX "'x=call CreateHost(" cport "," notport ")'"
  162.  
  163.  do until showlist(P,cport)
  164.   end
  165.  
  166.  idcmp = 'CLOSEWINDOW+WINDOWDRAG+WINDOWDEPTH+GADGETUP'
  167.  flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL+ACTIVATE'
  168.  
  169.  call SetReqColor(cport,BACKGROUNDPEN,3)
  170.  call SetReqColor(cport,BLOCKPEN,1)
  171.  call SetReqColor(cport,BOXPEN,1)
  172.  call SetReqColor(cport,SHADOWPEN,2)
  173.  call SetReqColor(cport,OKAYPEN,1)
  174.  call SetReqColor(cport,CANCELPEN,0)
  175.  
  176.  winwidth = 7*fontwidth*5+50  /* DaysInWeek*FontWidth*NumChars + Border */
  177.  winheight = 10*fontheight+100
  178.  name = 'The Monthly Planner'
  179.  call openwindow(cport,0,0,winwidth,winheight,idcmp,flags,name)
  180.  call ActivateWindow(cport)
  181.  
  182.  call WindowText(cport,outline)
  183.  
  184. width = length(daynames.0)-1
  185. leftedge = 18
  186. topedge = 6*fontheight
  187.  
  188. lines.linecount = right(1, index(headerline, firstday) - 1 + width)
  189. offset = (length(lines.linecount) - 3)*fontheight
  190.  
  191. /* Highlight the current day */
  192. if myday = 1 then
  193.   call Rectfill(cport,leftedge+offset-2,topedge-2,leftedge+offset+33,topedge+11)
  194. call AddGadget(cport,leftedge+offset,topedge,1,'  1',1)
  195.  
  196. maxlinelength = (linelength-1)*fontwidth
  197. width2 = width*fontwidth
  198.  
  199. do i = 2 to days
  200.    if i > 2 & days < 20 then day = i + 11
  201.    else day = i
  202.  
  203.    if offset + width2 < maxlinelength then
  204.      do
  205.        offset = offset + 40
  206.        /* Highlight the current day */
  207.        if i = myday & mymonth = thismonth & myyear = thisyear  then
  208.      call Rectfill(cport,leftedge+offset-6,topedge-2,leftedge+offset+33,topedge+11)
  209.        call AddGadget(cport,leftedge+offset,topedge,day,right(day, width),day)
  210.      end
  211.    else
  212.      do
  213.       topedge = topedge + 15
  214.       offset = 0
  215.       /* Highlight the current day */
  216.       if i = myday & mymonth = thismonth & myyear = thisyear  then
  217.     call Rectfill(cport,leftedge+offset-6,topedge-2,leftedge+offset+33,topedge+11)
  218.       call AddGadget(cport,leftedge,topedge,day,right(day, width),day)
  219.      end
  220.  end
  221.  
  222.  
  223.  call AddGadget(cport,18,140,back, "<-Back up ",back)
  224.  call AddGadget(cport,130,140,jump,"Jump!",jump)
  225.  call AddGadget(cport,200,140,forward, "Next Month->",forward)
  226.  call AddGadget(cport,10,15,edit, "Edit Day",edit)
  227.  call AddGadget(cport,250,15,clear, "Clear",clear)
  228.  call AddGadget(cport,18,160,delday,"Delete Day",delday)
  229.  call AddGadget(cport,130,160,help, "HELP", help)
  230.  call AddGadget(cport,200,160,print,"Print Day",print)
  231.  
  232.  call SetNotify(cport,CLOSEWINDOW,notport)
  233.  call SetNotify(cport,MOUSEBUTTONS,notport)
  234.  call SetNotify(cport,ACTIVEWINDOW,notport)
  235.  call SetNotify(cport,GADGETUP,notport)
  236.  
  237.  mport = OpenPort(notport)
  238.  do until showlist(P,notport)
  239.   end
  240.  
  241.  
  242.  notquit = 1
  243.  do while notquit
  244.     call WaitPkt (notport)
  245.     packet = GetPkt(notport)
  246.     if packet ~== NULL() then
  247.      do
  248.       command = GetArg(packet,0)
  249.       comm1 = GetArg(packet,1)
  250.       comm2 = GetArg(packet,2)
  251.       call Reply(packet,0)
  252.       select
  253.     when datatype(command,NUMERIC) then call gadget()
  254.     when command = 'BACK' then call backup()
  255.     when command = 'JUMP' then call jump()
  256.     when command = 'FORWARD' then call forward()
  257.     when command = 'EDIT' then call edit()
  258.     when command = 'CLEAR' then call postmsg()
  259.     when command = 'DELDAY' then call delday()
  260.     when command = 'HELP' then call help()
  261.     when command = 'PRINT' then call print()
  262.     when command = 'CLOSEWINDOW' then call closeup()
  263.     otherwise nop
  264.        end
  265.      end
  266.  end
  267.  call PostMsg()
  268.  call pragma(W,W)
  269. exit
  270.  
  271.  
  272.  
  273. /********** SUBROUTINES ************/
  274.  
  275. gadget:
  276.  call postmsg()
  277.  fname = months.mymonth'.'command
  278.  fname = fname'.'strip(myyear,B)
  279.  nofile = 0
  280.  
  281.  volindex = index(dirname,":")
  282.  volum = upper(substr(dirname,1,volindex-1))
  283.  if find(showlist(volume),volum) == 0 then
  284.   if exists('df0:') then
  285.     call pragma(D,'df0:')
  286.   else
  287.     call pragma(D,'vd0:')
  288.  
  289.  filename = findfile(fname)
  290.  
  291.  if dirname ~= '' & filename ~= "" then
  292.   do
  293.    dirname = substr(filename,1,(length(filename)-length(fname)))
  294.    pragma(D,dirname)
  295.   end
  296.  if filename ~= "" then
  297.   do
  298.     if exists('df0:c/more') then
  299.       address command more filename
  300.     else
  301.      do
  302.       call open(win,"con:330/0/310/200/Notes....")
  303.       call open(info,filename,"r")
  304.       i = 1
  305.       do until eof(info)
  306.     writeln(win,readln(info))
  307.     i = i + 1
  308.     if i = 23 then
  309.       do
  310.        writech(win,"Hit RETURN to continue...")
  311.        ch = readch(win,1)
  312.        i = 1
  313.       end
  314.        end
  315.       call close(info)
  316.       writeln(win,"")
  317.       writech(win,"Hit RETURN to continue....")
  318.       ch = readch(win,1)
  319.       call close(win)
  320.      end
  321.   end
  322.  else
  323.   do
  324.    select
  325.      when command = myday & mymonth = thismonth & myyear = thisyear then
  326.        call PostMsg(335,50, "Nothing Planned for today.")
  327.      when command = 1 then
  328.        call PostMsg(335,50, "Nothing Planned for the" command"'st.")
  329.      when command = 2 then
  330.        call PostMsg(335,50, "Nothing Planned for the" command"'nd.")
  331.      when command = 3 then
  332.        call PostMsg(335,50, "Nothing Planned for the" command"'rd.")
  333.      when command > 3 then
  334.        call PostMsg(335,50, "Nothing Planned for the" command"'th.")
  335.     end
  336.  end
  337. return
  338.  
  339.  
  340. /**** call an editor up so that we can type in what we want.... *****/
  341. edit:
  342.  call Postmsg()
  343.  
  344.  text = "Enter the pathname of where you\"
  345.  text = text "want to put your notes file\"
  346.  text = text "or click on cancel to quit"
  347.  putwhere = Request(75,50,text,dirname,"O.K.","Cancel!")
  348.  
  349.  if putwhere == "" then
  350.    return
  351.  if putwhere == "O.K." then
  352.   putwhere = dirname
  353.  call pragma(D,putwhere)
  354.  
  355.  command = getdate("Click on the day you want to edit")
  356.  
  357.  filename = months.mymonth'.'command
  358.  filename = filename'.'strip(myyear,B)
  359.  text = "Enter/Edit the note you want, save it,\ and then exit your editor."
  360.  call postmsg(150,50,"Enter/Edit the note you want, save it,\ and then exit your editor.")
  361.  if exists('df0:') then
  362.     address command 'run ed ' filename
  363.  else
  364.    call PostMsg(75,50,"No Disk in df0:!!!!\Can't run anything!")
  365.  
  366.  call delay(100)
  367.  call postmsg()
  368. return
  369.  
  370.  
  371.  
  372.  
  373. backup:
  374.  call Postmsg()
  375.  call Stop(cport)
  376.  if mymonth > 1 then
  377.   mymonth = mymonth - 1
  378.  else
  379.    do
  380.     mymonth = 12
  381.     myyear = myyear - 1
  382.     mymonth = mymonth''myyear
  383.    end
  384.  start(mymonth)
  385. return
  386.  
  387.  
  388. jump:
  389.  jumpdate = Request(175,75,"Enter the Month and year to jump to","",,"Cancel")
  390.  if jumpdate == "" then
  391.   return
  392.  call stop(cport)
  393.  mymnth = word(jumpdate,1)
  394.  myyr = word(jumpdate,2)
  395.  if ~datatype(mymnth,NUMERIC) then
  396.   do
  397.    mymnth = upper(mymnth)
  398.    select
  399.     when mymnth = JAN | mymnth = JANUARY then mymnth = 1
  400.     when mymnth = FEB | mymnth = FEBUARY then mymnth = 2
  401.     when mymnth = MAR | mymnth = MARCH then mymnth = 3
  402.     when mymnth = APR | mymnth = APRIL then mymnth = 4
  403.     when mymnth = MAY then mymnth = 5
  404.     when mymnth = JUN | mymnth = JUNE then mymnth = 6
  405.     when mymnth = JUL | mymnth = JULY then mymnth = 7
  406.     when mymnth = AUG | mymnth = AUGUST then mymnth = 8
  407.     when mymnth = SEP | mymnth = SEPT | mymnth = SEPTEMBER then mymnth = 9
  408.     when mymnth = OCT | mymnth = OCTOBER then mymnth = 10
  409.     when mymnth = NOV | mymnth = NOVEMBER then mymnth = 11
  410.     when mymnth = DEC | mymnth = DECEMBER then mymnth = 12
  411.     otherwise mymnth = mymonth
  412.    end
  413.   end
  414.  
  415.  if myyr ~= '' then
  416.   do
  417.    if (length(myyr) == 2) then
  418.     myyr = '19'myyr
  419.    mymnth = mymnth''myyr
  420.   end
  421.  
  422.  start(mymnth)
  423. return
  424.  
  425.  
  426. forward:
  427.  call PostMsg()
  428.  call Stop(cport)
  429.  if mymonth < 12 then
  430.    mymonth = mymonth + 1
  431.  else
  432.    do
  433.     mymonth = 1
  434.     myyear = myyear + 1
  435.     mymonth = mymonth''myyear
  436.    end
  437.  start(mymonth)
  438. return
  439.  
  440.  
  441. delday:
  442.     comm = getdate("Click on the day you want to delete")
  443.     filename = months.mymonth'.'comm
  444.     filename = filename'.'strip(myyear,B)
  445.     if ~(exists(filename)) then
  446.      do
  447.       msg = filename" is not in "dirname"\"
  448.       msg = msg"where should I look for it?\"
  449.       ans = Request(150,60,msg,dirname,"Do it","Forget it")
  450.       if ans ~== "" then
  451.     call pragma(D,ans)
  452.       else
  453.     return
  454.      end
  455.     msg = "Is it o.k. to DELETE\"
  456.     msg = msg" "filename" ?\"
  457.     msg = msg"on the drive "pragma(D)
  458.     answer = request(150,50,msg,,"O.k.","No Way")
  459.     if (answer == OKAY) then
  460.       call delete(filename)
  461. return
  462.  
  463.  
  464. print:
  465.     comm = getdate("Click the day you want to print")
  466.     name = months.mymonth'.'comm
  467.     name = name'.'strip(myyear,B)
  468.  
  469.     printname = findfile(name)
  470.  
  471.     if (open(file,printname,R) == 0) then
  472.      do
  473.       postmsg(0,100,"Whoa buckeroo, can't find the file "printname)
  474.       return
  475.      end
  476.     if (open(printer,"PRT:",W) == 0) then
  477.      do
  478.       postmsg(0,100,"Trouble accessing the printer. Sorry.")
  479.       return
  480.      end
  481.  
  482.     do until eof(file)
  483.       writeln(printer,readln(file))
  484.      end
  485. return
  486.  
  487.  
  488. /***
  489.  *** This procedure just closes up shop for us
  490.  ***/
  491. closeup:
  492.  call closeport(notport)
  493.  call stop(cport)
  494.  call postmsg()
  495.  call pragma(W,W)
  496.  exit
  497. return
  498.  
  499. jan1: procedure
  500.    arg year
  501.  
  502.    /* Julian calendar; one extra day every four years */
  503.    day = 4 + year + (year + 3) % 4
  504.  
  505.    /* Gregorian calendar - lose three days over four centuries */
  506.    if year > 1800 then do
  507.       day = day - (year - 1701) % 100
  508.       day = day + (year - 1601) % 400
  509.       end
  510.  
  511.    /* And the instant changeover in 1752 */
  512.    if year > 1752 then
  513.       day = day + 3
  514.  
  515.    return day // 7
  516.  
  517. setupmonths:
  518.   /* and now from numbers to days/month & print names */
  519.   months.1 = 'January'
  520.   months.1.days = 31
  521.   months.2 = 'February'
  522.   months.2.days = 1   /* Fixed later */
  523.   months.3 = 'March'
  524.   months.3.days = 31
  525.   months.4 = 'April'
  526.   months.4.days = 30
  527.   months.5 = 'May'
  528.   months.5.days = 31
  529.   months.6 = 'June'
  530.   months.6.days = 30
  531.   months.7 = 'July'
  532.   months.7.days = 31
  533.   months.8 = 'August'
  534.   months.8.days = 31
  535.   months.9 = 'September'
  536.   months.9.days = 30
  537.   months.10 = 'October'
  538.   months.10.days = 31
  539.   months.11 = 'November'
  540.   months.11.days = 30
  541.   months.12 = 'December'
  542.   months.12.days = 31       /* Not needed, but here for completeness */
  543. return
  544.  
  545.  
  546. getdate:
  547.  arg message
  548.  call Postmsg()
  549.  call Postmsg(0,0,message)
  550.  do until datatype(dayclicked,NUMERIC)
  551.    call WaitPkt (notport)
  552.    pack = GetPkt(notport)
  553.    if pack ~== NULL() then
  554.     do
  555.      dayclicked = getarg(pack)
  556.      call Reply(pack,0)
  557.     end
  558.    else
  559.     nop
  560.  end
  561. call Postmsg()
  562. return dayclicked
  563.  
  564.  
  565.  
  566. findfile:
  567.  arg name
  568.  
  569.  goodname = name
  570.  if ~exists(goodname) then      /** If you wanted to change where the **/
  571.   do                /** program looks for the date files  **/
  572.    goodname = 'df1:'name
  573.    if ~exists(goodname) then
  574.     do
  575.      goodname = 'df1:s/'name
  576.      if ~exists(goodname) then
  577.       do
  578.        goodname = 'df0:s/'name
  579.        if ~exists(goodname) then
  580.      goodname = ""
  581.       end
  582.     end
  583.   end
  584.  
  585. return goodname
  586.  
  587. /* here is the sum total of the code required to interface with HT */
  588. help:
  589.  if ~(showlist(p, "HT")) then
  590.    do
  591.      address command "run HT:ht -r"
  592.      do until showlist(p, "HT")
  593.        delay(25)
  594.       end
  595.    end
  596.  address HT load "df0:rexx/Mp.help"
  597. return
  598.