home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 330.lzh / Cal-Pal / Cal-Pal.rexx < prev    next >
OS/2 REXX Batch file  |  1990-01-02  |  36KB  |  1,319 lines
  1. /*
  2. **                       =====>>  Calendar Pal  <<=====
  3. **
  4. **
  5. **
  6. **  Calendar/Planner system written in ARexx
  7. **
  8. **  Written by:    Dan R. Schenck - (918) 492-0523 - GEnie:  D.SCHENCK
  9. **
  10. **  Version:       1.01
  11. **
  12. **  Last revised:  16-DEC-89
  13. **
  14. **  Note:          Requires RexxArpLib
  15. **
  16. **  A special thanks to Mike Meyer for developing the calendar routine
  17. **  used in this program.
  18. **
  19. */
  20.  
  21. parse upper arg month year .
  22.  
  23. true = 1
  24. false = 0
  25. pm = false
  26. doffx = 31
  27. doffy = 11
  28. sysinfo = "    Calendar Pal v1.01\"
  29. sysinfo = sysinfo || "       Written by:\       Dan Schenck\\"
  30. sysinfo = sysinfo || "     Tulsa, Oklahoma"
  31. OrigConfigfile = "Cal-Pal.cfg"
  32. configfile = OrigConfigfile
  33. database = "Cal-Pal.dbf"
  34. wx1 = 0
  35. wy1 = 0
  36. IconOn = false
  37. ix1 = 515
  38. iy1 = 377
  39. VerifyKey = "FFEE"x||"Cal-Pal v1.01"
  40. OldVerifyKey = "FFEE"x||"Cal-Pal v1.00"
  41. saved = false
  42. daybg=false
  43. pd = false
  44. ym = 0
  45. saving = false
  46. searchstr = ""
  47. seadirection = "Forward"
  48. seayear = "This Year"
  49. seamonth = "This Month"
  50. yeartrigger = false
  51. Lock = false
  52. if showlist('h','SPEAK') then
  53.   do
  54.     voice = true
  55.     SFile = "T:++CP-Speak"
  56.   end
  57. else voice = false
  58.  
  59. /* Is screen interlace?  If not, we'll have to open our own! */
  60. if ~ScreenLace() then
  61.   do
  62.     newscreen = true
  63.     ScreenID = 'CPS'
  64.   end
  65. else
  66.   do
  67.     newscreen = false
  68.     ScreenID = 'Workbench'
  69.   end
  70.  
  71. /* Is Cal-Pal already active? */
  72. if show('P',"CALHOST") then
  73.   do
  74.     call PostMsg(wx1+50,wy1+50,"WARNING!!\\Calendar Pal Already Active",ScreenID)
  75.     call delay(200)
  76.     call PostMsg
  77.     exit
  78.   end
  79.  
  80. /* Make sure all the libraries are there */
  81. if ~show('L',"rexxarplib.library") then
  82.     rtn = addlib('rexxarplib.library',0,-30,0)
  83.  
  84. if ~show('L',"rexxsupport.library") then
  85.     rtn = addlib('rexxsupport.library',0,-30,0)
  86.  
  87. if ~show('L',"rexxmathlib.library") then
  88.     rtn = addlib('rexxmathlib.library',0,-30,0)
  89.  
  90. /* Set up the months table - from names to numbers, */
  91. months. = 0
  92. months.jan = 1
  93. months.feb = 2
  94. months.mar = 3
  95. months.apr = 4
  96. months.may = 5
  97. months.jun = 6
  98. months.jul = 7
  99. months.aug = 8
  100. months.sep = 9
  101. months.oct = 10
  102. months.nov = 11
  103. months.dec = 12
  104.  
  105. /* and now from numbers to days/month & print names */
  106. months.1 = 'January'
  107. months.1.days = 31
  108. months.2 = 'February'
  109. months.2.days = 1   /* Fixed later */
  110. months.3 = 'March'
  111. months.3.days = 31
  112. months.4 = 'April'
  113. months.4.days = 30
  114. months.5 = 'May'
  115. months.5.days = 31
  116. months.6 = 'June'
  117. months.6.days = 30
  118. months.7 = 'July'
  119. months.7.days = 31
  120. months.8 = 'August'
  121. months.8.days = 31
  122. months.9 = 'September'
  123. months.9.days = 30
  124. months.10 = 'October'
  125. months.10.days = 31
  126. months.11 = 'November'
  127. months.11.days = 30
  128. months.12 = 'December'
  129. months.12.days = 31      /* Not needed, but here for completeness */
  130.  
  131. cdir = Pragma('D')  /* Get Current Directory */
  132.  
  133. /* Open Config File, Find Out Data Base Name, Read In Data */
  134. if exists(configfile) then
  135.   do
  136.     CFValid = true
  137.     call GetConfig
  138.   end
  139. else if exists("S:"||configfile) then
  140.   do
  141.     CFValid = true
  142.     configfile = "S:"||configfile
  143.     call GetConfig
  144.   end
  145. else
  146.   do
  147.     CFValid = false
  148.     call PostMsg(wx1+50,wy1+50,"WARNING!!\\\No Standard Config File Found\You Will Be Asked For One\\IF THERE IS NONE, Hit Cancel",ScreenID)
  149.     call Delay(250)
  150.     call PostMsg
  151.     do until(CFValid)
  152.       configfile = GetFile(wx1+50,wy1+50,,configfile,"Select Config File, If It Exists",ScreenID)
  153.       if exists(configfile) | configfile = "" then CFValid = true
  154.     end
  155.     if configfile ~= "" then call GetConfig
  156.     else CFValid = false
  157.   end
  158.  
  159. /* Get the current date for later use*/
  160. parse value date('Normal') with curday mymonth myyear
  161. curday = curday + 0
  162. thisyear = myyear
  163. thismonth = upper(mymonth)
  164.  
  165. /* Open our window */
  166. call MainWindow(CALHOST,CALPORT,false)
  167.  
  168. /* Set up meuns */
  169. call SetUpMenus
  170.  
  171. /*  Get the required calendar */
  172. call cal
  173.  
  174. call SetUpCal
  175. if thisyear = myyear & months.thismonth = mymonth then
  176.   do
  177.     daysel = right(curday,2,'0')
  178.     previousday = daysel
  179.   end
  180. else
  181.   do
  182.     daysel = 0
  183.     previousday = 0
  184.   end
  185. showingday = false
  186. call SetUpDay
  187. call DayDisplay
  188. if pm then call PostMsg
  189. if newscreen then rtn = ScreenToFront(ScreenID)
  190.  
  191. time2go = false
  192. time2exit = false
  193. all_ok = true
  194. buttondown = false
  195.  
  196. if pm then
  197.   do
  198.     call PostMsg
  199.     pm = false
  200.   end
  201.  
  202. /*
  203. ** Handle the incoming events
  204. */
  205. do until(time2exit)
  206.   t = waitpkt(CALPORT)
  207.   do i = 1
  208.     p = getpkt(CALPORT)
  209.     if c2d(p) = 0 then leave i
  210.     command = getarg(p)
  211.     select
  212.       when left(command,7) = "DAYINFO" then
  213.         do
  214.           parse value command with cmd "." j
  215.           dailynote.j = getarg(p,1)
  216.           t = reply(p,0)
  217.         end
  218.       when command = "ACTIVEWINDOW" then
  219.         do
  220.           nxtarg = getarg(p,1)
  221.           t = reply(p,0)
  222.           parse value nxtarg with wx1 wy1
  223.         end
  224.       when command = "MOUSEBUTTONS" then
  225.         do
  226.           if buttondown then
  227.             do
  228.               nxtarg = getarg(p,1)
  229.               t = reply(p,0)
  230.               parse value nxtarg with mousx mousy wx wy
  231.               buttondown = false
  232.               /* say mousx mousy */
  233.               if IconOn then
  234.                 do
  235.                   IconOn = false
  236.                   ix1 = wx
  237.                   iy1 = wy
  238.                   call CloseWindow(CALHOST,"CONTINUE")
  239.                   call MainWindow(CALHOST,CALPORT,true)
  240.                   call SetUpMenus
  241.                   call SetUpCal
  242.                   call SetUpDay
  243.                   call DayDisplay
  244.                 end
  245.               else
  246.                 wx1 = wx
  247.                 wy1 = wy
  248.                 if mousx > x1 & mousx < x2 & mousy > y1 & mousy < y2 then
  249.                   do
  250.                     thisday = DaySelected(mousx,mousy)
  251.                     if thisday ~= daysel & thisday > 0 then
  252.                       do
  253.                         pm = true
  254.                         call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
  255.                         daysel = right(thisday,2,'0')
  256.                         call ProcessDay("FINISHPD")
  257.                       end
  258.                   end
  259.             end
  260.           else
  261.            do
  262.              t = reply(p,0)
  263.              buttondown = true
  264.            end
  265.         end
  266.       when command = "DECD" then
  267.         do
  268.           t = reply(p,0)
  269.           if ~Lock then
  270.             do
  271.               Lock = true
  272.               dayarg = daysel-1
  273.               if dayarg > 0 then call ProcessDay("D")
  274.               else Lock = false
  275.             end
  276.         end
  277.       when command = "INCD" then
  278.         do
  279.           t = reply(p,0)
  280.           if ~Lock then
  281.             do
  282.               Lock = true
  283.               dayarg = daysel+1
  284.               if dayarg <= curdays then call ProcessDay("D")
  285.               else Lock = false
  286.             end
  287.         end
  288.       when command = "DECM" then
  289.         do
  290.           t = reply(p,0)
  291.           if ~Lock then
  292.             do
  293.               Lock = true
  294.               moryarg = month-1
  295.               morycmd = "MONTH"
  296.               if moryarg > 0 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
  297.               else Lock = false
  298.             end
  299.         end
  300.       when command = "INCM" then
  301.         do
  302.           t = reply(p,0)
  303.           if ~Lock then
  304.             do
  305.               Lock = true
  306.               moryarg = month+1
  307.               morycmd = "MONTH"
  308.               if moryarg <= 12 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
  309.               else Lock = false
  310.             end
  311.         end
  312.       when command = "DECY" then
  313.         do
  314.           t = reply(p,0)
  315.           if ~Lock then
  316.             do
  317.               Lock = true
  318.               moryarg = year-1
  319.               morycmd = "YEAR"
  320.               if moryarg > 0 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
  321.               else Lock = false
  322.             end
  323.         end
  324.       when command = "INCY" then
  325.         do
  326.           t = reply(p,0)
  327.           if ~Lock then
  328.             do
  329.               Lock = true
  330.               moryarg = year+1
  331.               morycmd = "YEAR"
  332.               if moryarg <= 9999 then call ReadHost(CALHOST,CALPORT,"M-OR-Y")
  333.               else Lock = false
  334.             end
  335.         end
  336.       when command = "MONTH" | command = "YEAR" then
  337.         do
  338.           moryarg = getarg(p,1)
  339.           t = reply(p,0)
  340.           morycmd = command
  341.           if ~yeartrigger then call ProcessDay("M-OR-Y")
  342.           else call ReadHost(CALHOST,CALPORT,"M-OR-Y")
  343.         end
  344.       when command = "M-OR-Y" then
  345.         do
  346.           t = reply(p,0)
  347.           if ~yeartrigger then call Processday2
  348.           parse value moryarg with input .
  349.           yeartrigger = false
  350.           if morycmd = "YEAR" then
  351.             do
  352.               yeartrigger = true
  353.               year = input
  354.               call ReadGadget(CALHOST,"MONTH")
  355.             end
  356.           else
  357.             do
  358.               month = input
  359.               call RemoveGadget(CALHOST,"MONTH")
  360.               call RemoveGadget(CALHOST,"YEAR")
  361.               call SetAPen(CALHOST,1)
  362.               call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
  363.               call cal
  364.               call SetUpCal
  365.               if daysel > curdays then
  366.                 do
  367.                   daysel = curdays
  368.                   previousday = curdays
  369.                 end
  370.               call DayDisplay
  371.               call SetUpDay
  372.             end
  373.         end
  374.       when command = "DAY" then
  375.         do
  376.           dayarg = getarg(p,1)
  377.           t = reply(p,0)
  378.           call ProcessDay("D")
  379.         end
  380.       when command = "D" then
  381.         do
  382.           t = reply(p,0)
  383.           call ProcessDay2
  384.           parse value dayarg with daysel .
  385.           if daysel = "" then daysel = 0
  386.           if ~datatype(daysel,"Numeric") then
  387.             do
  388.               call postmsg(wx1+50,wy1+50,"WARNING!!\\Day must be numeric.",ScreenID)
  389.               call delay(200)
  390.               call postmsg
  391.             end
  392.           else
  393.             do
  394.               daysel = right(daysel,2,'0')
  395.               call RemoveGadget(CALHOST,"DAY")
  396.               call SetAPen(CALHOST,1)
  397.               call RectFill(CALHOST,263,32,287,47)
  398.               call DayDisplay
  399.               call SetUpDay
  400.               previousday = daysel
  401.             end
  402.         end
  403.       when command = "FINISHPD" then
  404.         do
  405.           t = reply(p,0)
  406.           call ProcessDay2
  407.           call SetupDay
  408.           previousday = daysel
  409.           call DayDisplay
  410.         end
  411.       when command = "TODAY" then
  412.         do
  413.           t = reply(p,0)
  414.           call RemoveGadget(CALHOST,"TODAY")
  415.           call SetAPen(CALHOST,1)
  416.           call RectFill(CALHOST,279,86,382,107)
  417.           call AddGadget(CALHOST,282,87,"TODAY"," Today is: \"||date('n'),"%d")
  418.         end
  419.       when command = "ICON" then
  420.         do
  421.           nxtarg = getarg(p,1)
  422.           t = reply(p,0)
  423.           parse value nxtarg with wx1 wy1
  424.           IconOn = true
  425.           showingday = false
  426.           daybg = false
  427.           call CloseWindow(CALHOST,"CONTINUE")
  428.           idcmp = 'MOUSEBUTTONS'
  429.           flags = 'WINDOWDRAG+WINDOWDEPTH+BACKFILL'
  430.           if newscreen then call ScreenToBack(ScreenID)
  431.           call OpenWindow(CALHOST,ix1,iy1,125,23,idcmp,flags,"Cal-Pal")
  432.           call ModifyHost(CALHOST,MOUSEBUTTONS,"%l%1%x %y %f %e")
  433.           call SetDrMd(CALHOST,"JAM1")
  434.           call SetAPen(CALHOST,2)
  435.           call Move(CALHOST,7,18)
  436.           call Text(CALHOST,"  Click Here")
  437.         end
  438.       when command = "FINDSTR" then
  439.         do
  440.           t = reply(p,0)
  441.           searchstr = Request(wx1+50,wy1+50,"Enter String to Find",searchstr,"FIND IT","CANCEL",ScreenID)
  442.           if searchstr ~= "" then call FindStr(0)
  443.           if foundit then
  444.             do
  445.               pm = true
  446.               call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
  447.               if mtmp ~= month | ytmp ~= year then
  448.                 do
  449.                   year = ytmp
  450.                   month = mtmp
  451.                   call RemoveGadget(CALHOST,"MONTH")
  452.                   call RemoveGadget(CALHOST,"YEAR")
  453.                   call SetAPen(CALHOST,1)
  454.                   call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
  455.                   call cal
  456.                   call SetUpCal
  457.                   call DayDisplay
  458.                   call SetUpDay
  459.                 end
  460.               daysel = dsea
  461.               call ProcessDay("FINISHPD")
  462.             end
  463.           else
  464.             do
  465.               call PostMsg(wx1+50,wy1+50,"Requested String NOT Found!!",ScreenID)
  466.               call delay(150)
  467.               call PostMsg
  468.             end
  469.         end
  470.       when command = "FINDNXT" then
  471.         do
  472.           t = reply(p,0)
  473.           if searchstr ~= "" then
  474.             do
  475.               call FindStr(dlast)
  476.               if foundit then
  477.                 do
  478.                   if mtmp ~= month | ytmp ~= year then
  479.                     do
  480.                       year = ytmp
  481.                       month = mtmp
  482.                       call RemoveGadget(CALHOST,"MONTH")
  483.                       call RemoveGadget(CALHOST,"YEAR")
  484.                       call SetAPen(CALHOST,1)
  485.                       call RectFill(CALHOST,x1-offset,y1-offset,x2+offset,y2+offset)
  486.                       call cal
  487.                       call SetUpCal
  488.                       call DayDisplay
  489.                       call SetUpDay
  490.                     end
  491.                   pm = true
  492.                   call PostMsg(wx1+50,wy1+50,"WORKING!!",ScreenID)
  493.                   daysel = dsea
  494.                   call ProcessDay("FINISHPD")
  495.                 end
  496.               else
  497.                 do
  498.                   call PostMsg(wx1+50,wy1+50,"Requested String NOT Found!!",ScreenID)
  499.                   call delay(150)
  500.                   call PostMsg
  501.                 end
  502.             end
  503.         end
  504.       when command = "CLOSEWINDOW" | command = "QUITCP" then
  505.         do
  506.           if command = "CLOSEWINDOW" then
  507.             do
  508.               nxtarg = getarg(p,1)
  509.               parse value nxtarg with wx1 wy1
  510.             end
  511.           t = reply(p,0)
  512.           if ~saved then
  513.             do
  514.               result = Request(wx1+50,wy1+50,"WARNING!!\\Quit Without Saving?",,"   YES   "," NO WAY! ",ScreenID)
  515.               if result = "OKAY" then
  516.                 do
  517.                   call MyQuit(CALHOST)
  518.                   do until(~showlist('P','CALHOST'))
  519.                     call delay(10)
  520.                   end
  521.                   exit
  522.                 end
  523.             end
  524.           else
  525.             do
  526.               call MyQuit(CALHOST)
  527.               do until(~showlist('P','CALHOST'))
  528.                 call delay(10)
  529.               end
  530.               exit
  531.             end
  532.         end
  533.       when command = "SYSINFO" then
  534.         do
  535.           t = reply(p,0)
  536.           call Request(wx1+50,wy1+50,sysinfo,,"Done",ScreenID)
  537.         end
  538.       when command = "SAVE" then
  539.         do
  540.           t = reply(p,0)
  541.           if saved then
  542.             do
  543.               call PostMsg(wx1+50,wy1+50,"WARNING!!\\No Changes to Data Base\File Not Written",ScreenID)
  544.               call Delay(150)
  545.               call PostMsg
  546.             end
  547.           else
  548.             do
  549.               if ~CFValid then
  550.                 do until(CFValid)
  551.                   configfile = GetFile(wx1+50,wy1+50,cdir,OrigConfigfile,"Enter Config File Name",ScreenID)
  552.                   if configfile ~= "" then
  553.                     do
  554.                       parse value GetFName(database) with dbdir " " dbname
  555.                       if dbdir = "&&NULL" then dbdir = cdir
  556.                       if dbname = "&&NULL" then dbname = ""
  557.                       database = GetFile(wx1+50,wy1+50,dbdir,dbname,"Enter Data Base Name",ScreenID)
  558.                       if database ~= "" then CFValid = true
  559.                     end
  560.                 end
  561.               /* Write out data base & config file */
  562.               if showingday then call ProcessDay("FINISHWD")
  563.               else call WriteData
  564.             end
  565.         end
  566.       when command = "FINISHWD" then
  567.         do
  568.           t = reply(p,0)
  569.           call ProcessDay2
  570.           call WriteData
  571.         end
  572.       when command = "SAVEAS" THEN
  573.         do
  574.           t = reply(p,0)
  575.           CFValid = false
  576.           do until(CFValid)
  577.             configfile = GetFile(wx1+50,wy1+50,cdir,OrigConfigfile,"Enter Config File Name",ScreenID)
  578.             if configfile ~= "" then
  579.               do
  580.                 parse value GetFName(database) with dbdir " " dbname
  581.                 if dbdir = "&&NULL" then dbdir = cdir
  582.                 if dbname = "&&NULL" then dbname = ""
  583.                 database = GetFile(wx1+50,wy1+50,dbdir,dbname,"Enter Data Base Name",ScreenID)
  584.                 if database ~= "" then CFValid = true
  585.               end
  586.           end
  587.           if showingday then
  588.             do
  589.               saving = true
  590.               call ProcessDay("FINISHWD")
  591.             end
  592.           else call WriteData
  593.         end
  594.       when command = "SPEAKNOTES" then
  595.         do
  596.           t = reply(p,0)
  597.           if ~voice then
  598.             do
  599.               call PostMsg(wx1+50,wy1+50,"WARNING!!\\SPEAK Handler Not Found")
  600.               call delay(150)
  601.               call PostMsg
  602.             end
  603.           else
  604.             do
  605.               void = true
  606.               call open('out',SFile,'Write')
  607.               do i = 1 to 15
  608.                 if dailynote.i ~= "" then
  609.                   do
  610.                     call writeln('out',dailynote.i)
  611.                     void = false
  612.                   end
  613.               end
  614.               call close('out')
  615.               if ~void then address command "type " SFile " to speak:opt/n/s135"
  616.               call delete(SFile)
  617.             end
  618.         end
  619.       when command = "SETPARMS" then
  620.         do
  621.           t = reply(p,0)
  622.           tmpsd = seadirection
  623.           tmpsy = seayear
  624.           tmpsm = seamonth
  625.           call SearchWindow
  626.         end
  627.       when command = "SEAOK" then
  628.         do
  629.           t = reply(p,0)
  630.           call MyQuit(CPSHOST)
  631.           seadirection = tmpsd
  632.           seayear = tmpsy
  633.           seamonth = tmpsm
  634.         end
  635.       when command = "SEACAN" then
  636.         do
  637.           t = reply(p,0)
  638.           call MyQuit(CPSHOST)
  639.         end
  640.       when command = "SEADIR" then
  641.         do
  642.           t = reply(p,0)
  643.           if tmpsd = "Forward" then tmpsd = "Reverse"
  644.           else tmpsd = "Forward"
  645.           call RemoveGadget(CPSHOST,"SEADIR")
  646.           call RectFill(CPSHOST,69,19,130,36)
  647.           call AddGadget(CPSHOST,70,20,SEADIR,tmpsd,"%d")
  648.         end
  649.       when command = "SEAYR" then
  650.         do
  651.           t = reply(p,0)
  652.           if tmpsy = "This Year" then tmpsy = "All Years"
  653.           else tmpsy = "This Year"
  654.           call RemoveGadget(CPSHOST,"SEAYR")
  655.           call RectFill(CPSHOST,60,38,139,55)
  656.           call AddGadget(CPSHOST,61,39,SEAYR,tmpsy,"%d")
  657.         end
  658.       when command = "SEAMN" then
  659.         do
  660.           t = reply(p,0)
  661.           if tmpsm = "This Month" then tmpsm = "All Months"
  662.           else tmpsm = "This Month"
  663.           call RemoveGadget(CPSHOST,"SEAMN")
  664.           call RectFill(CPSHOST,56,57,148,74)
  665.           call AddGadget(CPSHOST,57,58,SEAMN,tmpsm,"%d")
  666.         end
  667.       otherwise t = reply(p,0)
  668.       end
  669.   end
  670. end
  671.  
  672.  
  673. /*
  674. **  Main body of calendar procedure
  675. **
  676. */
  677.  
  678. cal:
  679.  
  680. /* Get a month to work with */
  681. if datatype(month, 'Numeric') then mymonth = month
  682. else do
  683.    if month ~= "" then mymonth = month
  684.    mymonth = upper(left(mymonth, 3))
  685.    mymonth = months.mymonth
  686.    end
  687. mymonth = mymonth+0
  688. if months.mymonth.days = 0 then do
  689.    say "Month must be a month name or a number from 1 to 12, not" month
  690.    if pm then call postmsg
  691.    call MyQuit(CALHOST)
  692.    do until(~showlist('P','CALHOST'))
  693.      call delay(10)
  694.    end
  695.    exit 10
  696.    end
  697.  
  698. /* Got a valid month, now see about the year */
  699. select
  700.    when year = "" then nop   /* myyear is already right */
  701.    when ~datatype(year, 'Numeric') then do
  702.       say "Year must be a number between 1 and 9999, not" year
  703.       if pm then call postmsg
  704.       call MyQuit(CALHOST)
  705.       do until(~showlist('P','CALHOST'))
  706.         call delay(10)
  707.       end
  708.       exit 10
  709.       end
  710.    when length(year) = 2 then myyear = '19'year
  711.    otherwise myyear = year
  712.    end
  713.  
  714. if myyear < 1 | myyear > 9999 then do
  715.    say "Year must be between 1 and 9999 inclusive, not" myyear
  716.    if pm then call postmsg
  717.    call MyQuit(CALHOST)
  718.    do until(~showlist('P','CALHOST'))
  719.      call delay(10)
  720.    end
  721.    exit 10
  722.    end
  723.  
  724. /* Figure out what day of the week that month started on */
  725. firstday = jan1(myyear)
  726.  
  727. /* Get difference in weekdays between this year & next */
  728. fudge = (jan1(myyear + 1) + 7 - firstday) // 7
  729.  
  730. select
  731.    /* this is a regular year */
  732.    when fudge = 1 then months.2.days = 28
  733.  
  734.    /* This is a leap year */
  735.    when fudge = 2 then months.2.days = 29
  736.  
  737.    /* Otherwise, it must be 1752! */
  738.    otherwise
  739.       months.2.days = 29
  740.       months.9.days = 19
  741.    end
  742.  
  743. do i = 1 to mymonth - 1
  744.    firstday = firstday + months.i.days
  745.    end
  746.  
  747. firstday = firstday // 7      /* Got the day of the week */
  748.  
  749. /*
  750.  * Now, go from that to the name of a day of the week. This table is also
  751.  * used for formatting the output. The line at the top of the body consists
  752.  * of these things concatenated together, with a space in between them.
  753.  * The length of that string is the width of the calendar. Finally, we
  754.  * line the numbers up under the last character of each name. All names
  755.  * _must_ be the same length for this to work.
  756.  */
  757. daynames.0 = 'Sun'
  758.  daynames.0.x = 14
  759. daynames.1 = 'Mon'
  760.  daynames.1.x = 46
  761. daynames.2 = 'Tue'
  762.  daynames.2.x = 78
  763. daynames.3 = 'Wed'
  764.  daynames.3.x = 110
  765. daynames.4 = 'Thu'
  766.  daynames.4.x = 142
  767. daynames.5 = 'Fri'
  768.  daynames.5.x = 175
  769. daynames.6 = 'Sat'
  770.  daynames.6.x = 207
  771.  
  772. indxday = firstday
  773. firstday = daynames.firstday      /* and now it's name */
  774.  
  775. /* Get number of days in this month */
  776. curdays = months.mymonth.days
  777.  
  778. /* Next, we set up the header for the calendar. */
  779. headerline = daynames.0
  780. do i = 1 to 6
  781.    headerline = headerline daynames.i
  782.    end
  783. linelength = length(headerline)         /* width of calendar */
  784.  
  785. /* Set up the header for the calender */
  786. lines.1 = center(months.mymonth myyear, linelength)
  787. lines.2 = " "
  788. lines.3 = headerline
  789. linecount = 4   /* First line of body of calendar */
  790.  
  791. /* Now set up to put together lines of the body */
  792. maxline = linecount + 5         /* 6 weeks on a monthly calendar, max */
  793. do i = linecount + 1 to maxline
  794.    lines.i = ""
  795.    end
  796.  
  797. width = length(daynames.0)
  798. indxy = 50
  799. loc.1.x = daynames.indxday.x
  800. loc.1.xo = loc.1.x+doffx
  801. loc.1.y = indxy
  802. loc.1.yo = indxy+doffy
  803. lines.linecount = right(1, index(headerline, firstday) - 1 + width)
  804. do i = 2 to curdays
  805.    if i > 2 & curdays < 20 then day = i + 11
  806.    else day = i
  807.  
  808.    if length(lines.linecount) + width <= linelength then
  809.       do
  810.         lines.linecount = lines.linecount right(day, width)
  811.         indxday = indxday + 1
  812.         loc.i.x = daynames.indxday.x
  813.         loc.i.xo = loc.i.x+doffx
  814.         loc.i.y = indxy
  815.         loc.i.yo = indxy+doffy
  816.       end
  817.    else do
  818.       linecount = linecount + 1
  819.       lines.linecount = right(day, width)
  820.       indxy = indxy + doffy
  821.       indxday = 0
  822.       loc.i.x = daynames.indxday.x
  823.       loc.i.xo = loc.i.x+doffx
  824.       loc.i.y = indxy
  825.       loc.i.yo = indxy+doffy
  826.       end
  827. end
  828. return
  829.  
  830. /*
  831.  * jan1 - returns the day of the week that january first falls on for
  832.  *   any specific year, 1 through 9999 (assuming they don't change
  833.  *   the rules again).
  834.  */
  835. jan1: procedure
  836.    arg year
  837.  
  838.    /* Julian calendar; one extra day every four years */
  839.    day = 4 + year + (year + 3) % 4
  840.  
  841.    /* Gregorian calendar - lose three days over four centuries */
  842.    if year > 1800 then do
  843.       day = day - (year - 1701) % 100
  844.       day = day + (year - 1601) % 400
  845.       end
  846.  
  847.    /* And the instant changeover in 1752 */
  848.    if year > 1752 then
  849.       day = day + 3
  850.  
  851.    return day // 7
  852.  
  853.  
  854. /*  Setup the host and open window for Cal-Pal display  */
  855.  
  856.   MainWindow:
  857.   arg hostcntl,hostport,onlywindow
  858.  
  859.   if ~onlywindow then
  860.     do
  861.       if newscreen then
  862.         do
  863.           chfile = "T:++Cal-S-Win.rexx"
  864.           call MakeScreen
  865.         end
  866.       else chfile = "T:++Cal-Win.rexx"
  867.       if ~exists(chfile) then
  868.         do
  869.           call open('out',chfile,'Write')
  870.           if newscreen then call writeln('out',"/**/;call createhost(" || hostcntl || "," || hostport || ",'" || ScreenID || "')")
  871.           else call writeln('out',"/**/;call createhost(" || hostcntl || "," || hostport || ")")
  872.           call close('out')
  873.         end
  874.       address AREXX chfile
  875.       mp = openport(hostport)
  876.       address command "c:WaitForPort" hostport
  877.       do until(showlist("P",hostcntl) & showlist("P",hostport))
  878.         call delay(10)
  879.       end
  880.     end
  881.   idcmp = 'GADGETUP+MOUSEBUTTONS+CLOSEWINDOW+MENUPICK+MOUSEMOVE+ACTIVEWINDOW'
  882.   flags = 'WINDOWCLOSE+WINDOWDRAG+WINDOWDEPTH+BACKFILL'
  883.  
  884.   call OpenWindow(hostcntl,wx1,wy1,405,400,idcmp,flags,"Calendar Pal")
  885.   if newscreen then
  886.     do
  887.       call SetRGB4(hostcntl,0,0,0,8)
  888.       call SetRGB4(hostcntl,1,7,7,7)
  889.       call SetRGB4(hostcntl,2,0,0,0)
  890.       call SetRGB4(hostcntl,3,15,15,15)
  891.     end
  892.   call ModifyHost(hostcntl,MOUSEMOVE,"%l%1%x %y")
  893.   call ModifyHost(hostcntl,MOUSEBUTTONS,"%l%1%x %y %f %e")
  894.   call ModifyHost(hostcntl,CLOSEWINDOW,"%l%1%f %e")
  895.   call ModifyHost(hostcntl,ACTIVEWINDOW,"%l%1%f %e")
  896.   call AddGadget(hostcntl,290,68,"ICON"," Iconify ","%d%1%f %e")
  897.   call AddGadget(hostcntl,282,87,"TODAY"," Today is: \"||date('n'),"%d")
  898.  
  899.   return 0
  900.  
  901. /* Was a day selected with the mouse?  Return day number or 0 for none. */
  902. DaySelected:
  903.   arg dsx, dsy
  904.   do i = 1 to 7
  905.     if dsx >= loc.i.x & dsx <= loc.i.xo then
  906.       do
  907.         do ii = i to curdays by 7
  908.           if dsy >= loc.ii.y & dsy <= loc.ii.yo then return ii
  909.         end
  910.         return 0
  911.       end
  912.   end
  913.   return 0
  914.  
  915. /* Display the calendar */
  916. SetUpCal:
  917.  
  918. /* Output the calendar outline */
  919. call SetDrMd(CALHOST,JAM1)
  920. call SetAPen(CALHOST,2)
  921. x1 = 10
  922. x2 = 250
  923. y1 = 13
  924. offset = 3
  925. y2 = 25+(linecount*11)
  926. call Move(CALHOST,x1,y1)
  927. call Draw(CALHOST,x2,y1)
  928. call Draw(CALHOST,x2,y2)
  929. call Draw(CALHOST,x1,y2)
  930. call Draw(CALHOST,x1,y1)
  931. x1 = x1 + offset
  932. y1 = y1 + offset
  933. x2 = x2 - offset
  934. y2 = y2 - offset
  935. call Move(CALHOST,x1,y1)
  936. call Draw(CALHOST,x2,y1)
  937. call Draw(CALHOST,x2,y2)
  938. call Draw(CALHOST,x1,y2)
  939. call Draw(CALHOST,x1,y1)
  940. call Flood(CALHOST,1,x1+1,y1+1)
  941.  
  942. /* Output calendar */
  943. call SetAPen(CALHOST,1)
  944. do i = 1 to linecount
  945.   call Move(CALHOST,20,(15+(i*11)))
  946.   call Text(CALHOST,lines.i)
  947. end
  948. month = right(mymonth,2,'0')
  949. year = right(word(myyear,1),4,'0')
  950.  
  951. /* Outline days with notes */
  952. call SetAPen(CALHOST,0)
  953. do i = 1 to curdays
  954.   j = right(i,2,'0')
  955.   if datatype(note.year.month.j.0,'Numeric') & note.year.month.j.0 > 0 then
  956.     call Box(i)
  957. end
  958. call SetAPen(CALHOST,2)
  959. call AddGadget(CALHOST,300, 34,"MONTH",month,"%d%1%g",35)
  960. call AddGadget(CALHOST,303, 49,"DECM","<","%d")
  961. call AddGadget(CALHOST,320, 49,"INCM",">","%d")
  962. call AddGadget(CALHOST,352, 34,"YEAR",year,"%d%1%g",40)
  963. call AddGadget(CALHOST,358, 49,"DECY","<","%d")
  964. call AddGadget(CALHOST,375, 49,"INCY",">","%d")
  965. call AddGadget(CALHOST,261, 49,"DECD","<","%d")
  966. call AddGadget(CALHOST,278, 49,"INCD",">","%d")
  967. call Move(CALHOST,300,26)
  968. call Text(CALHOST,"Month  Year")
  969.  
  970. return
  971.  
  972. /* Set up the day we are focused on */
  973. SetUpDay:
  974.   call SetAPen(CALHOST,2)
  975.   if previousday > 0 then
  976.     do
  977.       if datatype(note.year.month.previousday.0,'Numeric') & note.year.month.previousday.0 > 0 then
  978.         call SetAPen(CALHOST,0)
  979.       call Box(previousday+0)
  980.     end
  981.   call SetAPen(CALHOST,3)
  982.   if daysel > 0 then call Box(daysel+0)
  983.   call SetAPen(CALHOST,2)
  984.   if daysel = 0 then call Addgadget(CALHOST,265,34,"DAY","","%d%1%g",19)
  985.   else call Addgadget(CALHOST,265,34,"DAY",daysel,"%d%1%g",19)
  986.   call Move(CALHOST,263,26)
  987.   call Text(CALHOST,"Day")
  988.   return
  989.  
  990. /*Set up menus */
  991. SetUpMenus:
  992.  
  993.   call AddMenu(CALHOST,"System ")
  994.   call AddItem(CALHOST,"About  ","SYSINFO")
  995.   call AddItem(CALHOST,"Save   ","SAVE","S")
  996.   call AddItem(CALHOST,"Save As","SAVEAS")
  997.   call AddItem(CALHOST,"Quit   ","QUITCP","Q")
  998.   call AddMenu(CALHOST,"Search ")
  999.   call AddItem(CALHOST,"Search Parms","SETPARMS","P")
  1000.   call AddItem(CALHOST,"Find String ","FINDSTR","F")
  1001.   call AddItem(CALHOST,"Find Next   ","FINDNXT","N")
  1002.   call AddMenu(CALHOST,"Speak Notes")
  1003.   call AddItem(CALHOST,"Speak Notes","SPEAKNOTES","R") 
  1004.   return
  1005.  
  1006. /* Display current day's data */
  1007. DayDisplay:
  1008.   if daysel = 0 then return
  1009.   if ~daybg then
  1010.     do
  1011.       dayx1 = 10
  1012.       dayx2 = 395
  1013.       dayy1 = 125
  1014.       dayy2 = 385
  1015.       call Move(CALHOST,dayx1,dayy1)
  1016.       call Draw(CALHOST,dayx2,dayy1)
  1017.       call Draw(CALHOST,dayx2,dayy2)
  1018.       call Draw(CALHOST,dayx1,dayy2)
  1019.       call Draw(CALHOST,dayx1,dayy1)
  1020.       call Flood(CALHOST,1,dayx1+1,dayy1+1)
  1021.       daybg = true
  1022.     end
  1023.   do i = 1 to 15
  1024.     dailynote.i = ""
  1025.   end
  1026.   DayNotes = note.year.month.daysel.0
  1027.   /* say "DayNotes = " DayNotes "Daysel = " daysel */
  1028.   if datatype(DayNotes,'Numeric') then
  1029.     do i = 1 to DayNotes while DayNotes > 0
  1030.       dailynote.i = note.year.month.daysel.i
  1031.     end
  1032.   do i = 1 to 15
  1033.     if showingday then call RemoveGadget(CALHOST,DAYINFO.i)
  1034.     call AddGadget(CALHOST,13,130+((i-1)*17),DAYINFO.i,dailynote.i,"%d%1%g",376)
  1035.   end
  1036.   if pm then call PostMsg
  1037.   showingday = true
  1038.   return
  1039.  
  1040. /* Get configuration (name of data base) */
  1041. GetConfig:
  1042.  
  1043. call open('cf',configfile,"Read")
  1044. CFVerify = readln('cf')
  1045. if CFVerify ~= VerifyKey & CFVerify ~= OldVerifyKey then
  1046.   do
  1047.     CFValid = false
  1048.     call PostMsg(wx1+50,wy1+50,"WARNING!!\\Config File Not Valid\No Data Base Read In",ScreenID)
  1049.     call delay(200)
  1050.     call PostMsg
  1051.     call close('cf')
  1052.     return
  1053.   end
  1054. database = readln('cf')
  1055. if exists(database) then  /* Read in data base */
  1056.   do
  1057.     call open('db',database,'Read')
  1058.     do until(eof('db'))
  1059.       input = readln('db')
  1060.       parse value input with yin '.' min '.' din '.' numnotes '.'
  1061.       yin = right(yin,4,'0')
  1062.       min = right(min,2,'0')
  1063.       din = right(din,2,'0')
  1064.       if numnotes ~= "" then
  1065.         do
  1066.           if note.yin.min.din ~= "Y" then
  1067.             do
  1068.               note.yin.min.din = "Y"
  1069.               ym = ym + 1
  1070.               yearmonths.ym = yin||"."||min||"."||din
  1071.             end
  1072.           note.yin.min.din.0 = numnotes
  1073.           do i = 1 to numnotes
  1074.             note.yin.min.din.i = readln('db')
  1075.           end
  1076.         end
  1077.     end
  1078.     call close('db')
  1079.   end
  1080. else
  1081.   do
  1082.     CFVaild = false
  1083.     call PostMsg(wx1+50,wy1+50,"WARNING!!\\Data Base File Not Found\No Data Base Read In",ScreenID)
  1084.     call delay(200)
  1085.     call PostMsg
  1086.   end
  1087. call close('cf')
  1088. return
  1089.  
  1090. /* Write Out the Data Base */
  1091. WriteData:
  1092.   if ym = 0 then
  1093.     do
  1094.       call PostMsg(wx1+50,wy1+50,"WARNING!!\\No Data Base Written\No Data Present",ScreenID)
  1095.       call delay(200)
  1096.       call PostMsg
  1097.       return
  1098.     end
  1099.   call PostMsg(wx1+50,wy1+50,"Writing Data Base",ScreenID)
  1100.   call SortYears
  1101.   call open('cf',configfile,'Write')
  1102.   call writeln('cf',VerifyKey)
  1103.   call writeln('cf',database)
  1104.   call close('cf')
  1105.   call open('db',database,'Write')
  1106.   do i = 1 to ym
  1107.     parse value yearmonths.i with yout "." mout "." dout
  1108.     if note.yout.mout.dout.0 > 0 then
  1109.       do
  1110.         call writeln('db',yearmonths.i||'.'||note.yout.mout.dout.0||'.')
  1111.         do j = 1 to note.yout.mout.dout.0
  1112.           call writeln('db',note.yout.mout.dout.j)
  1113.         end
  1114.       end
  1115.   end
  1116.   call close('db')
  1117.   call PostMsg
  1118.   saved = true
  1119.   return
  1120.  
  1121. /* Separate Directory from file name */
  1122. GetFName: procedure
  1123.  
  1124.   parse arg combo .
  1125.   lencombo = length(combo)
  1126.   slash = lastpos("/",combo)
  1127.   if slash > 0 then
  1128.     do
  1129.       if slash < lencombo then return insert(" ",delstr(combo,slash,1),slash-1)
  1130.       else return combo || " &&NULL"
  1131.     end
  1132.   colon = lastpos(":",combo)
  1133.   if colon > 0 then
  1134.     do
  1135.       if colon < lencombo then return insert(" ",combo,colon)
  1136.       else return combo || " &&NULL"
  1137.     end
  1138.   return "&&NULL " || combo
  1139.  
  1140. /* Draw a box around the currently selected day */
  1141. Box:
  1142.  
  1143.   parse arg ii
  1144.   bx = loc.ii.x+12
  1145.   bx2 = loc.ii.xo
  1146.   by = loc.ii.y
  1147.   by2 = loc.ii.yo
  1148.   call move(CALHOST,bx,by)
  1149.   call draw(CALHOST,bx2,by)
  1150.   call draw(CALHOST,bx2,by2)
  1151.   call draw(CALHOST,bx,by2)
  1152.   call draw(CALHOST,bx,by)
  1153.   return
  1154.  
  1155. /* Save any changes to daily notes */
  1156. ProcessDay:
  1157.  
  1158.   parse upper arg wheretogo
  1159.   if showingday then
  1160.     do i = 1 to 15
  1161.       call ReadGadget(CALHOST,DAYINFO.i)
  1162.     end
  1163.   call ReadHost(CALHOST,CALPORT,wheretogo)
  1164.   return
  1165.  
  1166. ProcessDay2:
  1167.  
  1168.   if ~showingday then
  1169.     do
  1170.       Lock = false
  1171.       return
  1172.     end
  1173.   k = 0
  1174.   do i = 1 to 15
  1175.     if dailynote.i ~= "" then
  1176.       do
  1177.         k = k + 1
  1178.         note.year.month.previousday.k = dailynote.i
  1179.       end
  1180.   end
  1181.   if k > 0 then
  1182.     do
  1183.       note.year.month.previousday.0 = k
  1184.       if note.year.month.previousday ~= "Y" then
  1185.         do
  1186.           note.year.month.previousday = "Y"
  1187.           ym = ym + 1
  1188.           yearmonths.ym = year||"."||month||"."||previousday
  1189.         end
  1190.     end
  1191.   else if note.year.month.previousday = "Y" then
  1192.     note.year.month.previousday.0 = 0
  1193.   saved = false
  1194.   Lock = false
  1195.   return
  1196.  
  1197. /* Find a string in the notes */
  1198. FindStr:
  1199.   parse arg dstart .
  1200.   foundit = false
  1201.   ytmp = year
  1202.   mtmp = month
  1203.   if dstart = 0 then call SortYears
  1204.   do i = 1 to ym while ym > 0
  1205.     parse value yearmonths.i with ysea '.' msea '.' dsea '.'
  1206.     if seayear = "All Years" then ytmp = ysea
  1207.     if seamonth = "All Months" then
  1208.       do
  1209.         if dstart > 0 then
  1210.           do
  1211.             if msea > mtmp then
  1212.               do
  1213.                 dstart = .9
  1214.                 mtmp = msea
  1215.               end
  1216.           end
  1217.         else mtmp = msea
  1218.       end
  1219.     if seadirection = "Forward" & ysea = ytmp & msea = mtmp & dsea > dstart then
  1220.       do ii = 1 to note.ysea.msea.dsea.0 while(note.ysea.msea.dsea.0 > 0)
  1221.         if index(note.ysea.msea.dsea.ii,searchstr) > 0 then
  1222.           do
  1223.             foundit = true
  1224.             dlast = dsea
  1225.             leave i
  1226.           end
  1227.       end
  1228.     else if seadirection = "Reverse" & ysea = ytmp & msea = mtmp & dsea < dstart then
  1229.       do ii = 1 to note.ysea.msea.dsea.0 while(note.ysea.msea.dsea.0 > 0)
  1230.         if index(note.ysea.msea.dsea.ii,searchstr) > 0 then
  1231.           do
  1232.             foundit = true
  1233.             dlast = dsea
  1234.             leave i
  1235.           end
  1236.       end
  1237.   end
  1238.   return
  1239.  
  1240. /* Open Search Parameter Window */
  1241. SearchWindow:
  1242.  
  1243.  if newscreen then spfile = "T:++CAl-SSea.rexx"
  1244.  else spfile = "T:++Cal-Sea.rexx"
  1245.  if ~exists(spfile) then
  1246.    do
  1247.      call open('out',spfile,"Write")
  1248.      call writeln('out',"/* Start Rexx Source */")
  1249.      if newscreen then call writeln('out',"x = createhost(" || CPSHOST || "," || CALPORT || ",'" || ScreenID || "')")
  1250.      else call writeln('out',"x = createhost(" || CPSHOST || "," || CALPORT || ")")
  1251.      call close('out')
  1252.    end
  1253.   address AREXX spfile
  1254.   do until(showlist("P",CPSHOST))
  1255.     call delay(10)
  1256.   end
  1257.  
  1258.   idcmp = 'GADGETUP'
  1259.   flags = 'WINDOWDRAG+BACKFILL'
  1260.  
  1261.   call OpenWindow(CPSHOST,wx1+50,wy1+50,200,100,idcmp,flags,"Search Parameters")
  1262.   if newscreen then
  1263.     do
  1264.       call SetRGB4(CPSHOST,0,0,0,8)
  1265.       call SetRGB4(CPSHOST,1,7,7,7)
  1266.       call SetRGB4(CPSHOST,2,0,0,0)
  1267.       call SetRGB4(CPSHOST,3,15,15,15)
  1268.     end
  1269.   call SetDrMd(CPSHOST,"JAM1")
  1270.   call SetAPen(CPSHOST,1)
  1271.   call SetOPen(CPSHOST,1)
  1272.   call AddGadget(CPSHOST,70,20,SEADIR,tmpsd,"%d")
  1273.   call AddGadget(CPSHOST,61,39,SEAYR,tmpsy,"%d")
  1274.   call AddGadget(CPSHOST,57,58,SEAMN,tmpsm,"%d")
  1275.   call AddGadget(CPSHOST,20,80,SEAOK,"  USE  ","%d")
  1276.   call AddGadget(CPSHOST,110,80,SEACAN," CANCEL ","%d")
  1277.  
  1278.   return
  1279.  
  1280. /* Sort the year/month index */
  1281. SortYears:
  1282.   if ym <= 1 then return
  1283.   do i = 2 to ym
  1284.     do ii = 1 to i-1
  1285.       if yearmonths.i < yearmonths.ii then
  1286.         do
  1287.           sorttmp = yearmonths.ii
  1288.           yearmonths.ii = yearmonths.i
  1289.           yearmonths.i = sorttmp
  1290.         end
  1291.     end
  1292.   end
  1293.   return
  1294.  
  1295. /* Let's quit a window */
  1296. MyQuit:
  1297.  
  1298.   parse arg quithost .
  1299.   if quithost = 'CALHOST' then
  1300.     do
  1301.       if newscreen then
  1302.         do
  1303.           call CloseWindow(CALHOST)
  1304.           call CloseScreen(ScreenID)
  1305.           exit
  1306.         end
  1307.       else call Quit(CALHOST)
  1308.     end
  1309.   else call Quit(quithost)
  1310.   return
  1311.  
  1312. /* Open interlace screen */
  1313. MakeScreen:
  1314.  
  1315.   if newscreen then modes = 'HIRES+LACE+SCREENBEHIND'
  1316.   else modes = 'HIRES+LACE'
  1317.   rtn = OpenScreen(0,2,modes,'Cal-Pal',ScreenID)
  1318.   return
  1319.