/*
           C A L E N D A R    and    A P P O I N T M E N T S
    
            An ARexx program with two levels of application
    
                   by John Collett, March 1994                 */
    
  
              /* Error trap */
    signal on syntax ; signal on error
    
              /* Add required libraries */
    if ~show('l','rexxarplib.library') then do  
     check = addlib('rexxsupport.library',0,-30,0) 
     check = addlib('rexxarplib.library',0,-30,0) 
     end                              
                
              /* Create message port.  Check its existence. */
    address AREXX '"call CreateHost(HO, PORT)"'  
    if ~show('Ports',HO) then address command 'WaitForPort HO' 

              /* Check for file */ 
    data_ok = exists('DateList')
 
              /* Window gadgets */
    flags = 'WINDOWCLOSE + BORDERLESS + WINDOWDRAG'

              /* Types of messages expected */
    idcmp  = 'GADGETUP + CLOSEWINDOW + ACTIVEWINDOW + INACTIVEWINDOW'
    if data_ok then idcmp = idcmp || ' + MOUSEBUTTONS'
    
              /* Open window to required size and initial position */
    call OpenWindow(HO,150,10,232,100,idcmp, flags) ; call OpenPort(PORT)  
    call APen(2) ; call RectFill(HO,0,0,232,100) ; call ActivateWindow(HO)
    cleft = 0 ; ctop = 0
    
              /* Array of day names needed later */
    d.1 = 'Monday' ; d.2 = 'Tuesday' ; d.3 = 'Wednesday' ; d.4 = 'Thursday'
    d.5 = 'Friday' ; d.6 = 'Saturday' ; d.7 = 'Sunday'
    
    /* Arrays of month names and lengths - though they could also have been
    derived from the date() function when required.  The latter method will
    be used in the case of February because of the leap year complication.
    */
    month.1 = 'January' ; month.2 = 'February' ; month.3 = 'March' 
    month.4 = 'April' ;   month.5 = 'May' ;      month.6 = 'June'
    month.7 = 'July' ;    month.8 = 'August' ;   month.9 = 'September' 
    month.10 = 'October'; month.11 = 'November'; month.12 = 'December'
    monlen. = 31 ;  monlen.2 = 28 ; monlen.4 = 30 
    monlen.6 = 30 ; monlen.9 = 30 ; monlen.11 = 30
    
    /* Construct string of numbers for cutting into weeks when needed */
    s = '' ; do i = 1 to 9 ; s = s || '  ' || i || ' ' ; end
    do i = 10 to 31 ; s = s || ' ' || i || ' ' ; end ; daystr = s
    
    /* Isolate this year and month from yyyymmdd format of today's date */
    d = date('s') ; year = substr(d,1,4) ; monthnum = substr(d,5,2)
    if substr(monthnum,1,1) = '0' then monthnum = right(monthnum,1)
    thismonth = monthnum ; thisyear = year 
    
    /* tl : a tedious detail, to try to reduce the number of times
       the drag bar gadget becomes momentarily and untidily visible.
       It works, but was it worth including?   */
    tl = 0
       
              /*  Weekday headers */  
    call SetBPen(HO,2) ; call APen(1) 
    call pat(cleft+8,ctop+19,'Mo  Tu  We  Th  Fr  Sa  Su')
   
    /* Numbers:  A procedure to produce 4 to 6 lines of date numbers for a
    month. It can be only 4 lines, if the 1st of a 28-day February is a
    Monday, as it was in 1993, or up to 6, as in October 1994.  
    The 'distance' variable adjusts spacing for the 5- or 6-line types.
    The argument to Numbers() can be from 1 to 12.
    Here we want THIS month displayed, so the argument is 'thismonth'. */

    call Numbers(thismonth)
    
    /* Two gadgets, to see earlier or later months. Their frames are
    set to black. They are located left and right at the foot of the
    window.    */

    call SetReqColor(HO,'BOXPEN',1) ; call SetReqColor(HO,'SHADOWPEN',1) 
    gt = ctop+89 
    call AddGadget(HO,cleft+2,gt,1,'<<<','%l %d %x') 
    call AddGadget(HO,cleft+202,gt,2,'>>>','%l %d %x') 

    /*  In 'Appointments' mode, a third gadget is required, and then a
    mouse click is used to obtain a display of any week's appointments.  
    Here we arrange for such a click to send the following information :
    · The name of the IDCMP class
    · The button state (down or up)
    · x and y of the click position (the x value is not really needed)
    · The left edge and top of the window - it may have been moved, and
    the position of the appointments output window is designed to vary
    accordingly.    */
    if data_ok then do
     call AddGadget(HO,cleft+102,gt,3,' ? ','%l %d %x')
     call APen(3) ; call DrawEllipse(HO,116,93,10,5) ; call APen(1)
     call RefreshGadgets(HO)      /* Tidy up */
     call ModifyHost(HO,'MOUSEBUTTONS','%l %b %x %y %f %e') 
     end
    
    /* The main loop for user input :
       Wait for a message.  Fetch it.  Check that it is not empty.
       Read it.  Acknowledge.  */
    do forever 
      po = waitpkt(PORT) ; p = getpkt(PORT)                   
      if p ~== NULL() then do               
        i = getarg(p) ; t = reply(p, 0)     
        
    /* Parse the received message into usable pieces */                 
        parse var i class gadno rest
    
    /* All anticipated types of IDCMP message must be accounted for. */
       select
          when class = 'CLOSEWINDOW' then signal 'Finish'
          when class = 'GADGETUP' then call Gadget(gadno)
          when class = 'MOUSEBUTTONS' & data_ok then call OneWeek()
          when tl & (class = 'INACTIVEWINDOW' | class = 'ACTIVEWINDOW') ,
                        then call Topline(month) 
          otherwise 
          end  /* of 'select'         */
        end    /* of 'if ... then do' */
        tl = 1
      end      /* of 'do forever'     */
    
    /*   ------   Here are all the callable procedures   ------  */
  
    Finish:   call CloseWindow(HO) ; exit
    
    syntax: say 'Syntax : ' errortext(rc) '. Line 'sigl ; signal 'Finish'
    error: say "Error " rc sigl ; signal 'Finish'

    Gadget:
     /* Remove text window if present */
     call wclose() 
    
     /* The 'rest' from the gadget message used here is mouse x, and some
     arithmetic is then needed to work out how many months to go backwards
     or forwards.   This patch works as long as you click reasonably
     accurately on one of the '<' or '>'.     */    
    
     if arg(1) = 1 then  monthnum = monthnum - (3 - (rest-4)%8)
     else if arg(1) = 2 then monthnum = monthnum + (rest-6)%8 - 24 
     if arg(1) = 1 | arg(1) = 2 then  call Numbers(monthnum)
     else if arg(1) = 3 then call Circles()
     return
    
    /* ---- Display day numbers for new month ---- */
    Numbers:
       monthnum = arg(1) ; monthhead = 0 ; wopen = 0
    
    /*  Check if the new month has crossed a year boundary.   */
    if monthnum <= 0 then do 
      monthnum = monthnum + 12 ; year = year - 1 ; end
    else if monthnum >= 13 then do 
     monthnum = monthnum - 12 ; year = year + 1 ; end
    
    /*  Position in the week of the 1st of the selected month?  */
    month = month.monthnum
    monlen = monlen.monthnum
    first = date('w',year || pad(monthnum) || '01','s')
    
    /* February is different.  To get the length of the month, we find
    the difference between 'days into the year' of the 1st of February and
    the 1st of March. */
     if monthnum = 2 then do 
     FebFirst = year || '0201' ; firstinto = date('d',FebFirst,'s') 
     MarFirst = year || '0301' ; lastinto = date('d',MarFirst,'s') 
     monlen = lastinto - firstinto
    end
    
              /* Clean out previous */
    call APen(2) ; call RectFill(HO,cleft+2,ctop+20,cleft + 229,ctop + 86) 
    call APen(1) ; call TopLine(month)
       
    /* Calculate space needed before date '1', depending on its day.  */
    do w = 1 to 7 ; found = (first = d.w) ; if found = 1 then leave
    end         
    if w = 1 then str = ' ' ; else str = copies('    ',w-1) 
    str = left(str,length(str)-1) ; set = 28 ; r = 0
    
    /* Add the required part of the previously-built 31-element string */
    str = str || substr(daystr,1,4 * monlen)
    
    /* Break into weeks : l.r = line contents, row by row */
    /* These will be used later for looking up entries */
    do start = 1 to length(str) by set
     r = r + 1 ; l.r = substr(str,start,set-1) 
     end
    y = ctop+30 ; distance = 11 + 2*(r < 6)
    
    /* At last, display rows of numbers for the month */
    do w = 1 to r ; call pat(cleft+9,y,l.w) ; y = y + distance ; end
    
    /* If the current month is displayed, show today's date. Find the line 
    which contains today's date, and its position in that line. 
    Calculate the frame position. */
    
    if month = month.thismonth & year = thisyear then do 
     do i = 1 to r
      pos = index(l.i,todaydate) ; dfound = (pos ~= 0) ; if dfound then leave
      end
     x = cleft+6 + (pos%4) * 32 ; y = ctop+9 + i*distance ; call APen(1) 
     call DrawBox(x,y,22,10) ; call DrawBox(x+1,y,20,10) ; call APen(1)
     end
    ringed = 0
    return
 
    Circles: 
    call wclose()
                                  
    /* Look up datelist to see which dates in this month have entries.*/  
      op = open(dl,'DateList','r') 
   
    /* Go to this month, i.e. jump past preceding unwanted entries. */
      do forever
       t = readln(dl) ; if t = month.monthnum then leave
       end
    
    /* Record this position in the file. Then read through the entries for
    this month (until an empty line), and circle all date numbers found. */
      monthhead = seek(dl,0) ; m = monthnum + 1 
      do forever
       t = readln(dl) ; if t = '' then leave
       sp = index(t,' ') ; t = substr(t,1,sp-1)
       if datatype(t,'n') then call CircleDate()
       end    
      cl = close(dl)
      ringed = 1
     return  
    
       
    OneWeek:
    /* If the circling hasn't been done yet, 'monthhead' isn't known. */
     if ringed = 0 then return
    
     call wclose()
        
    /* Parse the mouse-click message for required details  */
     parse var i class state x y wleft wtop
    
    /* We only want it done once per mouse click, so ... */
     if state = 'SELECTDOWN' then return
    
    /* Is the click within the area of the date numbers? */
      row = (y - ctop - 8)%distance ; if row = 0 | row > r then return
    
    /* Extract first and last numbers from the selected row of dates */
     l.row = strip(l.row,'b') 
     entry = left(l.row,2) ; last = right(l.row,2)
    
    /* Open the file and jump to the start of the required month.
       That position was recorded earlier as 'monthhead'.  */
     op = open(dl,'DateList','r')
     seek = seek(dl,monthhead,'b')
     t. = '' ; linesread = 0 ; reached = 0 ; done = 0 ; maxlen = 0
    
    /* Skip any earlier days in the month by finding a line which starts
       with a number from 'entry' to 'last' inclusive.  
       Or, just in case, an empty line (end of month).  Or eof().  */

    do until reached 
     ftx = readln(dl) ; tx = strip(ftx,'b')
     if (tx = '') | eof(dl) then do ; done = 1 ; leave ; end
     sp = index(tx,' ') 
     if sp > 0 then do
       t = substr(tx,1,sp-1)
       reached = (datatype(t) = 'NUM') & (t >= entry) & (t < last)
       end
     end
    
    /* We are now at the first entry for this week.  We read in all lines
    until we have reached or passed the end of the week.  The lines are not
    displayed yet.  We need to count them first, and check the length of
    the longest line, so that we know how big the new window is to be. If
    you have a very busy social life, the window gets pushed up over the
    bottom of the calendar.  If your entries are so numerous that the
    window won't fit on the screen, try combining lines in 'DateList',
    changing to a daily rather than weekly display, using another program,
    or cancelling some of your appointments. */

    if ~done then do                /*      <-----     Some redundancy  */
     do until done                  /*      <-----     here. Prune it   */
      linesread = linesread+1 ; t.linesread = ftx   /* if you wish.     */
      maxlen = max(maxlen,length(ftx))              /* I tried, and     */
      ftx = readln(dl) ; tx = strip(ftx,'b')        /* then decided to  */
      if (tx = '') | eof(dl) then leave             /* leave well alone.*/
      sp = index(tx,' ') 
      if sp > 0 then do
        t = substr(tx,1,sp-1)
        done = (datatype(t) = 'NUM') & (t > last)
        end
      end    /* of 'until done' */
     end     /* of 'then do'       See above note about redundancy */
    cl = close(dl)
    if linesread ~= 0 then call TextWindow() 
    return

    CircleDate:       
              /* Find number in line */
     do i = 1 to r
      pos = index(l.i,t) ; dfound = (pos ~= 0) ; if dfound then leave
      end
     x = cleft+17 + (pos%4) * 32 ; y = ctop+14 + i*distance
    
              /* Circle position */
     if t < 10 then x = x + 3
     call APen(3) ; call DrawEllipse(HO,x,y,10,5) ; call APen(1)
     return  
   
    TopLine:
    /* A new heading is needed when the month changes.*/
      a = arg(1)
      t = time('c') ; t = left(t,length(t)-2)
      if a = month.thismonth & year = thisyear then do
       w = date('w') ; m = date('m')
       d = date() ; todaydate = left(d,length(d)-8)
       tx = ' ' || t || '  ' || w ||',' || todaydate || m
       if length(tx) > 24 then do                 /* Clip month name */
        m = left(m,3) ; tx = ' ' || t || '  ' || w ||',' || todaydate || m
        end 
       end
      else do ; tx = month || '  ' || year 
       tx = copies(' ',(25-length(tx))%2) || tx ; end
    
    /*  Other events like clicking outside/inside the window also impact on
    this area because of activation of the drag gadget. It can all be a bit
    untidy. This patch deals with it, though I had hoped to be able to
    retain the option of dragging the window to a new position with less
    visible interference. */

     call APen(2) ; call RectFill(HO,cleft+20,ctop+1,cleft + 229,ctop + 10) 
     call APen(1)
     call DrawBox(cleft,ctop,230,99) ; call DrawBox(cleft+1,ctop,230,99)
     call pat(cleft+18,ctop+8,tx,1) ; call RefreshGadgets(HO) 
    return
    
    TextWindow:
    /* I tried using the ARexx 'pragma("*")' function here, and it worked,
    but not without some problems in the relationship between the new
    window and any already-open Shell window.  So I gave up on 'pragma',
    and reverted to the ordinary 'open' and 'writeln' functions which you
    see below.  The new window can be dragged, resized, or zoomed, but not
    closed by a gadget.  It closes if you go to another month, click on a
    week which has no entries, or quit the program.

    The text window always appears just under the calendar.  The effects
    vary if the calendar position has been changed by dragging, but
    generally : 
    A narrow window is made to match the calendar for width. 
    A wide one is centred on the screen. 
    Middle-sized ones line up with the left of the calendar. */

     width = maxlen * 8 + 40 ; depth = linesread * 8 + 24
     if width < 232 then width = 232
     else if width > 640 - wleft then wleft = 320 - width%2
    say wleft width
     params = 'con:' || wleft || '/' || wtop+100 || '/' || width
     params = params || '/' || depth || '/Week Schedule'
     op = open(window,params,"w") ;  wopen = 1
     do j = 1 to linesread ; w = writeln(window,t.j) ; end
    return

    wclose:                     
     if wopen then do ; call close(window) ;  wopen = 0 ; end 
    return

    DrawBox:
     parse arg x,y,w,h
     call Move(HO,x,y) ; call Draw(HO,x+w,y) ; call Draw(HO,x+w,y+h)    
     call Draw(HO,x,y+h) ; call Draw(HO,x,y)    
     return

    pat:       
     if arg() = 4 then call APen(arg(4))
     call Move(HO,arg(1),arg(2)) ; call Text(HO,arg(3))
     return
 
    APen: call SetAPen(HO,arg(1)) ; return
      
    pad: a = arg(1) ; if length(a) = 1 then return '0' || a ; else return a  
   
                /* ------------------------------ */