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

	SUBROUTINE week(line)

c
c	Declarations:
c

	byte line(1)		!	input line
	byte temp(2)		!	temporary string converting array
	byte esc		!	escape character
	byte appoin(60)		!	appointment array
	logical apts(7,19)
	INTEGER HASH
	integer	id		!	Julian Day
	integer im		!	Julian Month
	integer iy		!	Julian Year
C LENGTHS OF MONTHS ... KLUGE ... FORGET LEAP YEARS...
	INTEGER*2 ML(14)
	integer rdspfg          !  flag to reverse sense of display of time
	integer ctlfg           !  misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/ctls/rdspfg,ctlfg
	byte fname(60)
	integer fnsz
	common/fn/fnsz,fname
	DATA ML/31,31,28,31,30,31,30,31,31,30,31,30,31,31/

c
c	Initialize:
c

	iss=999                 !       impossible saved Sunday day...
	iterm = 6		!	Output terminal unit number
	esc = "033		!	Escape character
	IWF=0
	IM=IDMO
	ID=IDDY
	IY=IDYR
C	call idate(im,id,iy)	!	initialize to today's date
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
	Do 1111 i=1,7		!	clear any apointments from
	   Do 1110 j=1,19	!	other weeks.
		if(rdspfg.eq.0) then
		   apts(i,j) = .false.
		else
		   apts(i,j)=.true.
		end if
1110	   Continue
1111	Continue

c
c		Trim off the W from command line:
c

	Do 1 i=1,70
	    line(i) = line(i+2)
1	Continue
	CALL DATMUN(LINE)
c
c		If the date was specified in command line then
c		set id, im and iy to the right values:
c

	lft=1
	If ( ( line(1) .ge. '0' ) .and. ( line(2) .le. '9' ) ) then
	    lft=8
	    temp(1) = line(1)
	    temp(2) = line(2)
	    decode ( 2 , 2 , temp ) im
	    temp(1) = line(3)
	    temp(2) = line(4)
	    decode ( 2 , 2 , temp ) id
	    temp(1) = line(5)
	    temp(2) = line(6)
	    decode ( 2 , 2 , temp ) iy
	IDMO=IM
	IDDY=ID
	IDYR=IY
	End If
2	Format(i2)
931	FORMAT(I1)
	If(ctlfg.ne.0)then
	  IF(LINE(LFT).LT.'0')LINE(LFT)='0'
	  IF(LINE(LFT+1).LT.'0'.OR.LINE(LFT+1).GT.'9')THEN
          DECODE(1,931,LINE(LFT),ERR=1113)INTSZ
	  ELSE
	  decode(2,2,line(lft),err=1113)intsz
	  END IF
1113	  continue
	  if(intsz.le.0)intsz=1
	  if(intsz.gt.18)intsz=18
c clamp interval size to permissible range...
	end if
c
c		Paint the screen:
c

c following sequence sets screen to ANSI mode, clears it, and moves to
c upper left corner on VT100 compatible terminals.
	write(iterm,6) esc,'<',esc,'[','2','J',esc,'[','0','1',';','0',
     1  '1','H'
6	format(x,79a1)

	Do 8 i=1,7
	    write(iterm,7)
7	    format(x,79('-'),2(/,x,'|',t80,'|'))
8	Continue	
	write(iterm,9)
9	format(x,79('-'))
	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 dany(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.
C NO...SUNDAY MAY BE IN PRECEDING MONTH
	end if

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)
c in leap years (IY/4 even) then ML(3) is Feb. entry and is 29, not 28.
c adjust here.
		IF((IY/4)*4.EQ.IY.AND.IM.EQ.3)IS=IS+1
		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
		GOTO 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
	    goto 11			! want.
	end if
301	CONTINUE
C SINCE WE CAN WRAP MONTHS DOWN AS WELL AS UP CONSTRUCT DATE LIMITS HERE...
	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.
	LOHASH=IS+32*(IM+12*(IY-81))
	iss = is			! don't lose track of Sunday's date.
					! 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

	Do 12 i=1,7
	    jy = 3 * i
	    call dtcat(2,jy)
	    write(iterm,13) im,is,iy
	    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
		End If
	    End If
C SAVE LAST DAY VALUE IN HASH
	HASH=IS+32*(IM+12*(IY-81))
12	continue
13	format('+',2(i2.2,'/'),i2.2)

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

	close(1)
	Open (unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED')
	iunit=1
c======================	file reading loop ==============================!
	ISSSS=ISS
111	Continue    ! ===================================================
	    Read(iunit,115,end=122) ihy,ihm,ihd,iht,(appoin(k),k=1,60)	!
115	    format(3i2,i3,60a1)						!
	if(ihy.eq.99)then
	iunit=2
c null terminate the filename somewhere
c lines with 99 in 1st 2 cols are filenames only...
c use = as delimiter of filename
	appoin(59)=0
	do 1068 ii=1,59
	if(appoin(ii).eq.'=')appoin(ii)=0
1068	continue
	Open(unit=iunit,file=appoin,status='old',form='formatted',
     1  err=1066)
	goto 111
	end if
C CHECK FOR LEGALITY BASED ON DATE FROM SUNDAY..
C MUST ACCOUNT FOR MONTH/YEAR WRAPS
C	LOHASH=IS+32*(IM+12*(IY-81))
	IDHASH=IHD+32*(IHM+12*(IHY-81))
	    If ((IDHASH.GE.LOHASH).AND.(IDHASH.LE.HASH))THEN
C	    If (( ihm .eq. im ) .and. ( ihy .eq. iy ) .and.		!
C     1		( ihd .ge. iss ) .and. ( ihd .le. (iss+7) )) 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 = iht / 10					!
		    if ( jy .gt. 7 ) jy = jy - 7			!
		    If (((iht/10)*10) .eq. iht) then			!
			jy = 2 * jy - 1					!
		    else						!
			jy = jy * 2					!
		    end if						!
		  IF(JX.GE.1.AND.JX.LE.7.AND.
     1               JY.GE.1.AND.JY.LE.19) THEN
		    if(rdspfg.eq.0) then
		    apts(jx,jy) = .true.				!
		    else
		    apts(jx,jy)=.false.
		    end if
D		ELSE
D		WRITE(6,7700)JX,JY,IHD,IHT,ISS,IHY,IHM
D7700	FORMAT(' X,Y=',2I4,' Day, tim, ISS, yr, mo= ',5I6)
		  END IF
	    End If							!
	    goto 111							!
122	Continue    !====================================================
	if(iunit.ne.1)then
1066	close(2)
	iunit=1
	goto 111
	end if
	close(1)
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 1120 i=1,7
	  Do 1121 j=1,k
	    ivl=1
	    Do 1122 l=1,intsz
		If(.not.apts(i,j+l-1))ivl=0
1122	continue
	    if(ivl.ne.1)apts(i,j)=.false.
1121	continue
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 1126 j=kk,18
	      apts(i,j)=.false.
1126	continue
	  end if
1120	continue
	End If

	Do 19 i=1,7				! Go through the entire
	    Do 18 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
18	    Continue
19	Continue
	call dtcat(1,22)			! move cursor to the bottom
	return					! of the screen and return
	end
