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	
