c-----------------------------------------------------------------------
c
c	Week-at-a-glance subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c		line 	- 	72 character string;  Format: W [mmddyy]
c
c	Output:
c		display screen (see below)
c
c-----------------------------------------------------------------------
c

	SUBROUTINE week(line)

c
c	Declarations:
c

	character line(1)		
c 	input line
	character temp(2)		
c 	temporary string converting array
	character*2 temp2
	equivalence (temp(1),temp2)
	character esc		
c 	escape character
	character appoin(60)		
	character*20 appoi6
	equivalence (appoin(1),appoi6)
c 	appointment array
	logical apts(7,19)
	INTEGER HASH
	integer	id		
c 	Julian Day
	integer im		
c 	Julian Month
	integer iy		
c 	Julian Year
C LENGTHS OF MONTHS ... KLUGE ... FORGET LEAP YEARS...
	INTEGER*2 ML(14)
	integer rdspfg          
c   flag to reverse sense of display of time
	integer ctlfg           
c   misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/ctls/rdspfg,ctlfg
	character fname(60)
	character*20 fnam60
	equivalence(fname(1),fnam60)
	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                 
c        impossible saved Sunday day...
	iterm = 0		
c 	Output terminal unit number
	esc = 27		
c 	Escape character
	IWF=0
	IM=IDMO
	ID=IDDY
	IY=IDYR
C	call idate(im,id,iy)	
c 	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		
c 	clear any apointments from
	   Do 1110 j=1,19	
c 	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)
	read(temp2,2)im
c	    decode ( 2 , 2 , temp ) im
	    temp(1) = line(3)
	    temp(2) = line(4)
	read(temp2,2)id
c	    decode ( 2 , 2 , temp ) id
	    temp(1) = line(5)
	    temp(2) = line(6)
	read(temp2,2)iy
c	    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
	intsz=0
	intsz=khar(line(lft))
	intsz=intsz-48
c	intsz=line(lft)-48
c          DECODE(1,931,LINE(LFT),ERR=1113)INTSZ
	  ELSE
	intsz=0
	intsz=khar(line(lft))
	intsz=intsz-48
	intsz=intsz*10
	kkkk=0
	kkkk=khar(line(lft+1))
	kkkk=kkkk-48
	intsz=intsz+kkkk
c	intsz=(line(lft)-48)*10)+(line(lft+1)-48))
c	  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,'[','2','J',esc,'[','0','1',';','0',
     1  '1','H'
6	format(1x,79a1,\)

	Do 8 i=1,7
	    write(iterm,7)
7	    format(1x,78('-'),2(/,1x,'|',77x,'|'),\)
8	Continue	
	write(iterm,9)
9	format(1x,78('-'),\)
	call dtcat(2,2)
	write(iterm,10) 'Sunday'
10	format(1X,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)		
c  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			
c  is is the Sunday we want.  It is
	else				
c  either the 1st day of the month
	    is = 9 - ib			
c  or 9 - 1st day of month.
C NO...SUNDAY MAY BE IN PRECEDING MONTH
	end if

11	continue			
c  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	
c  of the month, then keep adding
	    is = is + 7			
c  7 until we get to the week we
	    goto 11			
c  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			
c  don't lose track of Sunday's date.
					
c  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		
c  Did the month change
		is = 1				
c  during this week?
		im = im + 1
		If ( im .gt. 12 ) then		
c  Did the year change
		    im = 1			
c  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(1X,2(i2,'/'),i2,\)

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 characters and store this
c	information by bits instead of characters.  Oh well.  There
c	goes 100 characters of storage space...
c	When life confronts you with its troubles and woes,
c	Have no fear, just fire photon torpedos
c 
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	
c  Appointment on Su at 8:00
c	8:30     F  T  T  T  F  F  F	
c  Appointments on Mo, Tu, We at 8:30
c	9:00     F  F  F  F  F  F  F	
c  No appointments at 9:00 this week
c	9:30
c
c	 .	 .  .  .  .  .  .  .
c	 .	 .  .  .  .  .  .  .		etcetera
c	 .	 .  .  .  .  .  .  .
c					
c  sic itur ad astra
c
c	Etcetra.  Caveat emptor and three other latin words.
c
c

22	close(1)
	Open (1,file=FNAM60,status='OLD',form='FORMATTED')
	iunit=1
c======================	file reading loop ==============================
c 
	ISSSS=ISS
111	Continue    
c  ===================================================
       Read(iunit,115,end=122,ERR=122)ihy,ihm,ihd,iht,
     1  (appoin(k),k=1,60)	
c 
115	    format(3i2,i3,60a1)						
c 
	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)=32
	KKK=0
	do 1068 ii=1,59
	IF(APPOIN(II).EQ.'='.OR.APPOIN(II).LE.31)KKK=1
	IF(KKK.GT.0)APPOIN(II)=32
C	if(appoin(ii).eq.'=')appoin(ii)=0
1068	continue
	Open(iunit,file=appoi6,status='old',form='formatted')
	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 
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 
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					
c 
		    if ( jy .gt. 7 ) jy = jy - 7			
c 
		    If (((iht/10)*10) .eq. iht) then			
c 
			jy = 2 * jy - 1					
c 
		    else						
c 
			jy = jy * 2					
c 
		    end if						
c 
		  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.				
c 
		    else
		    apts(jx,jy)=.false.
		    end if
		  END IF
	    End If							
c 
	    goto 111							
c 
122	Continue    
c ====================================================
	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				
c  Go through the entire
	    Do 18 j=1,19			
c  array and display
		If ( apts(i,j) ) then		
c  appts if they exist:
		    jx = 6 * j + 10		
c  jx is x coord of cursor
		    jy = 3 * i - 1		
c  jy is y coord of cursor

		    If ( jx .gt. 74) then	
c  For afternoon and evening
			jy = jy + 1		
c  appointments, put the
			jx = jx - 63		
c  appointments on the second
		    End If			
c  line of the day

		    jj = j			
c  Now decode the time again
		    call dtcat(jx,jy)		
c  to display.  jj is time
		    if (((j/2)*2) .ne. j) then	
c  of appointment
		        jj = jj + 7 - (jj/2)	
c  If the time is odd then
			write(iterm,16) jj	
c  it falls on the hour.
16			format(1X,i2,':00')
		    else
		        jj = jj + 7 - (jj/2)	
c  If the time is even then
			write(iterm,17) jj	
c  it falls on the half hour
17			format(1X,i2,':30')
		    end if		    
		End If
18	    Continue
19	Continue
	call dtcat(1,22)			
c  move cursor to the bottom
	return					
c  of the screen and return
	end