c----------------------------------------------------------------------- c c Week-at-a-glance subroutine c c part of Mitch Wyle's DTC program c c Input: c line - 72 byte string; Format: W [mmddyy] c c Output: c display screen (see below) c c----------------------------------------------------------------------- c c Modified 850117 to fix leap-year problems - CG c Modified 850314 to use real corners, lines and T's for box - CG c Modified 850318 to display current date in reverse video - CG c Modified 850806 to use new subroutines (including DTCRDAPPT) c and get rid of previously commented-out code c SUBROUTINE week ! (line) c c Declarations: c include 'comdtc.inc/nolist' include 'apptdtc.inc/nolist' include 'escdtc.inc/nolist' c byte ln1, ll ! equiv to input line byte temp(2) ! temporary string converting array logical apts(7,19), aptsln(133), tflg integer prveof, eofflg INTEGER HASH integer id ! Julian Day integer im ! Julian Month integer iy, iyd ! Julian Year c lengths of months ... leap years adjusted in code integer ml(14) ! December Jan ... Dec January 1 /31, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31/ equivalence (line, ln1), (apts, aptsln) include 'stmtfunc.for/nolist' c Initialize: iss = '7FFFFFFF'X ! Impossible saved Sunday day... iwf=0 ! Adjustment factor if ((ln1 .and. ucmask) .eq. 'W') 1 call shrink(1, ifnb, lnb) call dtcidate(imx,idx,iyx) ! initialize to today's date call dtcdatcvt(3) ! Get date string im=idmo ! Copy values id=iddy iy=ibigyr if (islpyr(iy)) then ml(3)=29 ! Feb is in ML(3), not ML(2)!!! else ml(3)=28 ! C Garman, 17-Jan-1985 end if C Where we look for free space of n units or more length, C then just display reverse and zot out all shorter periods if (ctlfg .eq. 1) rdspfg=1 tflg = (rdspfg .ne. 0) ! initialize flag do ij = 1, 7*19 aptsln(ij) = tflg end do if (ctlfg .ne. 0) then ! Locate N intsz = 0 i = 1 do while(numeric(line(i))) intsz = (intsz * 10) + icvtbn1(line(i)) i = i + 1 if (i .gt. icmln) go to 1191 end do c clamp interval size to permissible range... 1191 intsz = min0(max0(intsz, 1), 18) end if c c Paint the screen: c c following sequence moves to upper left corner on VT100 compatible terminals c and clears screen write(iterm,6) esc,homescrn, esc,clrscrn 6 format('+',4a,$) c Now write box, in graphics mode, to enclose days of week write (iterm, 70), so, 'l', 'k', si ! Upper corners & top line c Do i = 1, 6 ! 6 more days' worth write (iterm, 71), so, esc, esc, si write (iterm, 72), so, si end do c write (iterm, 71), so, esc, esc, si ! two more sides write (iterm, 73), so, 'm', 'j', si ! Lower corners & bottom line c 70 format ('+', 2a1, 77('q'), 2a1) ! Upper/lower corners 71 format (x, a1, 'x', a1, '[77Cx'/ 1 x, 'x', a1, '[77Cx', a1) ! sides 72 format (x, a1, 't', 77('q'), 'u', a1) ! interior lines 73 format (x, 2a1, 77('q'), 2a1) ! Upper/lower corners call dtcat(2,2) write(iterm,10) ' Sunday' 10 format('+',a) call dtcat(2,5) write(iterm,10) ' Monday' call dtcat(2,8) write(iterm,10) ' Tuesday' call dtcat(2,11) write(iterm,10) 'Wednesday' call dtcat(2,14) write(iterm,10) ' Thursday' call dtcat(2,17) write(iterm,10) ' Friday' call dtcat(2,20) write(iterm,10) ' Saturday' c c Now figure out which Sunday is closest to the day specified by id: c call dtcalcdow(ib,il,im,iy) ! Remember: ib = 1st day of month c il = length of month c ib = day number of 1st day of month, 1=sunday. if ( ib .eq. 1 ) then is = 1 ! IS is the Sunday we want. It is else ! either the 1st day of the month is = 9 - ib ! or 9 - 1st day of month. end if C Now...Sunday may be in preceding month 11 continue ! If the day is not in the 1st week c try to fix up case of wrong sunday.. c ML array is preceding month's length iwf=0 if (id .lt. is) then is=is-7+ml(im) im=im-1 if (im .le. 0) then c adjust year wrapback im=12 iy=iy-1 end if il=ml(im+1) iwf=-il go to 301 end if if ( ( id - is ) .ge. 7 ) then ! of the month, then keep adding is = is + 7 ! 7 until we get to the week we go to 11 ! want. end if 301 continue c since we can wrap months down as well as up construct date limits here... c *** if (iy .gt. 1900) iy=iy-1900 c just generate a hashcode that is strictly increasing as a function of c date. only purpose is to be monotonic increasing, so continuity is c not important. we use other methods to handle exact offsets. note that c where wrap arounds occur, iss is allowed to be a little larger than c real month length or a small negative where used below...not here. irqhash(1) = ihymd(iy, im, is) iss = is ! don't lose track of Sunday's date. issss = is ! It will be important later... c c Now figure out where to write the dates of the days of the week, c and write em out where they belong: c iyd = mod(iy, 100) ! Display two digits Do i=1,7 jy = 3 * i call dtcat(2,jy) if ((im .eq. imx) .and. (iy .eq. iyx)) then if (is .eq. idx) then if (id .eq. idx) then ! reverse + underline write(iterm,130,err=99) 1 esc,'[4;7m', im,is,iyd, esc,resetvattr else ! reverse only write(iterm,130,err=99) 1 esc,revattr, im,is,iyd, esc,resetvattr end if else go to 684 end if else 684 if (is .eq. id) then ! underline only write(iterm,130,err=99) 1 esc,'[4m', im,is,iyd, esc,resetvattr else ! N/O/T/A, nothing fancy write(iterm,13,err=99) im,is,iyd end if end if 99 is = is + 1 If ( is .gt. il ) then ! Did the month change is = 1 ! during this week? im = im + 1 If ( im .gt. 12 ) then ! Did the year change im = 1 ! during this week? iy = iy + 1 iyd = mod(iy, 100) End If End If irqhash(2) = ihymd(iy, im, is) ! save last day value in hash end do 13 format('+', i3, '/', i2.2,'/',i2.2) 130 format('+', a1, a, i3, '/', i2.2,'/',i2.2, a1, a) c c Now for Files I/O: c c Set up a boolean array of appointment times and days of c the week. Notice that if this program were written in c assembler, we would use only 18 bytes and store this c information by bits instead of bytes. Oh well. There c goes 100 bytes of storage space... c When life confronts you with its troubles and woes, c Have no fear, just fire photon torpedos! c c c Read the appointments; If the appointment is for one of c the days in this week, mark that spot in the appointments c array true. Otherwise that coordinate is false. The array c looks like this: c c Su Mo Tu We Th Fr Sa c c 8:00 T F F F F F F ! Appointment on Su at 8:00 c 8:30 F T T T F F F ! Appointments on Mo, Tu, We at 8:30 c 9:00 F F F F F F F ! No appointments at 9:00 this week c 9:30 c c . . . . . . . . c . . . . . . . . etcetera c . . . . . . . . c ! sic itur ad astra c c Etcetra. Caveat emptor and three other latin words. c c prveof = 0 eofflg = -1 do while (prveof .ge. 0) call dtcrdappt(eofflg, 0) ! Look at appointments file if (eofflg .ge. 0) 1 then C NOW we are testing the date range validly. However, we must adjust C the ISS range to be in the range from - (small #) to + C (or some such) to take into account the fact that it MUST be C continuous in order to be transformed into a cursor address. C FORTUNATELY we saved the appropriate length of month adjustment C above so can add it back in here. IWF=0 most times. iss=issss+iwf jx = ihd - iss + 1 ! c need a little more logic to handle crossing months here c where jx >7 we have to adjust by length of month once more... if (jx .gt. 7) jx=jx+iwf c also have to handle cases where we crossed months, by adding in c length of previous month. if (jx .le. 0) jx=jx+ml(im) jy = min0(max0(((iht+2)/5)-15, 1), 19) if ((jx .ge. 1) .and. (jx .le. 7) .and. 1 (jy .ge. 1) .and. (jy .le. 19)) 2 then apts(jx,jy) = .not. tflg ! Derived a long time ago! D else D write(iterm,7700)jx,jy,ihd,iht,iss,ihy,ihm D7700 format(' X,Y=',2I4,' Day, tim, ISS, yr, mo= ',5I6) end if end if prveof = eofflg end do ! while c c Now display the information we have extracted: c if (ctlfg .ne. 0) then c here go through and look for "intsz" sized intervals and c set apts(i,j) to .false. if the interval is too small... k=19-intsz Do i=1,7 Do j=1,k ivl=1 Do l=1,intsz if (.not. apts(i,j+l-1)) ivl=0 end do if (ivl .ne. 1) apts(i,j)= .false. end do c since we are showing valid start times, set all times at the end of c the day false since they can't possibly be valid times for any c meetings. kk=k+1 if (kk .le. 18) then do j=kk,18 apts(i,j)= .false. end do end if end do End If Do i=1,7 ! Go through the entire Do j=1,19 ! array and display If ( apts(i,j) ) then ! appts if they exist: jx = 6 * j + 10 ! jx is x coord of cursor jy = 3 * i - 1 ! jy is y coord of cursor If ( jx .gt. 74) then ! For afternoon and evening jy = jy + 1 ! appointments, put the jx = jx - 63 ! appointments on the second End If ! line of the day jj = j ! Now decode the time again call dtcat(jx,jy) ! to display. jj is time if (((j/2)*2) .ne. j) then ! of appointment jj = jj + 7 - (jj/2) ! If the time is odd then write(iterm,16) jj ! it falls on the hour. 16 format('+',i2,':00') else jj = jj + 7 - (jj/2) ! If the time is even then write(iterm,17) jj ! it falls on the half hour 17 format('+',i2,':30') end if End If end do end do 999 call dtcat(1,22) ! move cursor to the bottom end ! of the screen and return