c-----------------------------------------------------------------------
c
c	Daily Appointment subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c       line - 72 bytes;  Format: D [mmddyy [hh:mm>HH:MM [appointment]]]
c
c	Output:
c		display screen (see below)
c
c-----------------------------------------------------------------------
C
c	Modified 850314 to write day-of-week to daily-appointment screen,
c	   and note current time if current day displayed (reverse video)
c		CG
c
	SUBROUTINE day		! (line)
c
c	Declarations:
c
	include 'comdtc.inc/nolist'
	include 'escdtc.inc/nolist'
c
c	byte line(1)		!	input line
	byte appoin(icmln)	!	appointment string
	byte work(icmln)	! 	scratch array for handling scheduling
	byte temp(2), ll, ln1,	!	temporary string converting array
	1 ap1
c	byte esc/"033/		!	escape character
	byte blot/26/		!	^Z, for entry from display
c	integer iterm/6/	! 	Terminal unit #
	integer	id, idr		!	Julian Day
	integer im, imr		!	Julian Month
	integer iye, iyr	!	Julian Year
	integer idx, imx, iyx, isx	! copies for calling DANY
c
	real*8 daylist(7) / '   Sun', '   Mon', '  Tues', ! uses A6 fmt
	1 'Wednes', ' Thurs', '   Fri', ' Satur' /	! 'day' is in format
c
	equivalence (line, ln1), (appoin, ap1)

	include 'stmtfunc.for/nolist'

c	Initialize:
c
c	iterm = 6		!	Output terminal unit number
c	esc = "033		!	Escape character

	if ((ln1 .and. ucmask) .eq. 'D')
	1    call shrink(1, ifnb, lnb)

	call dtcdatcvt(3)		! Pick off a date value
c
c ************************** Move the cursor to top of screen and clear it,
c ************************** set up appointments display:
c
	call idate(imr, idr, iyr)		!	Get today's date
c
	im=idmo
	id=iddy
	iye=idyr

	iyx = iye				! Can be modified
c
	if ((im .eq. imr) .and.
	1   (id .eq. idr) .and.
	2   (iye .eq. iyr)) then	! Displaying current day
c
	    scnds = amax1(secnds(0.), 28801.)	! Get current time (>8 AM)
	    ihalf = mod(ifix(scnds/1800.), 48) ! current half-hour (orig 0)
	    ihour = ihalf/2		!	Current hour
	    ihalf = ihalf - (ihour*2)	!	0 or 1 for half-hour
c
	else
	    ihour = 0			!	Set non-match value
	endif
c
	call dany (isx, imx, im, iyx)		! Get day-of-week
c
	idx = mod (id + isx - 2, 7) + 1	! Calc current d/o/w
c
	write(iterm,4) esc,homescrn, esc,clrscrn
 4	format('+', 4a, $)

	write(iterm,5) '+', esc,dhdw1, daylist(idx),im,id,iye
 5	format(3a,'   Appointments for ', a6,'day, ',
	1 i2,'/',i2.2,'/',i2.2)
	write(iterm,5) ' ', esc,dhdw2, daylist(idx),im,id,iye

	Do 8 i=8,16
	    If ( i .gt. 12 ) then
		j = i - 12
	    Else
		j = i
	    End If
c
	    if (i .ne. ihour) then			! Check for highlighting
		write(iterm,6) j
 6		format(x,i2,':00   -')
		write(iterm,7) j
 7		format(x,i2,':30   -')
	    else					! must be current hour
		if (ihalf .eq. 0) then		! Check which half
		    write(iterm,96), esc,revattr, j, esc,resetvattr
		    write(iterm,7) j
		else
		    write(iterm,6) j
		    write(iterm,97), esc,revattr, j, esc,resetvattr
		endif
c
 96	    format (x, 2a, i2,':00   -', 2a)
 97	    format (x, 2a, i2,':30   -', 2a)
c
	    endif
 8	Continue

	if (ihour .ge. 17) then		! Highlight 'Evening' line
	    write(iterm,98), esc,revattr, esc,resetvattr
	else				! Includes display other than today
	    write(iterm,9)
	end if

 9	format(x, 'Evening:', /, x, 78('='))
 98	format(x, 2a, 'Evening: ', 2a, /, x, 78('='))

c ******************* Screen has now been displayed,
c ******************* now check rest of line for time and appointment

	if (ln1 .ne. 0) then		! More characters available?

	    call dtctimcvt(iht, ihmx)	! & a time value
	
	    ihh1 = (iht+2)/5		! Adds 1 if trailing 3
	    ihh2 = (ihmx+2)/5		! Result is 16 to 35
	    idmx = max0(ihh2-ihh1, 1)	! 8:00>5:30

c Note: range of h1:00>h1:30 is considered only one scheduling interval,
c	similarly h(1)>h(2) is an even number, ending just before h(2),
c	computation forces at least one for interval h1:00>h1:00

	    ifnb = 0
	    lnb = 0
	    ivx = 0
	    ap1 = 0				! Clear appointment string

	    do i = 1, icmln
c
		ll = line(i)
		appoin(i) = ll
c
		if (ll .eq. 0) go to 6789		! done

		ivx = i					! Save current length

	    end do
c
c		Was there an appointment string input?
c		If so, put it in file, and display it on screen.
c		If not, move cursor to correct time on screen,
c		then input the appointment, put in file and re-display it.
c		and when the band you're in starts playing different tunes,
c		I'll see you on the dark side of the moon.
c
 6789	    If (ap1 .eq. 0) then		! Empty appointment string
c
		iy = ihh1 - 13			! Vertical position for half hour
		ix = 11
		call dtcat(ix,iy)

		write(iterm, 987) blot, esc,'[D'	! write, backspace
 987		format ('+', 3a, $)
c
c !!!		close(iterm)
c
		read(5,13,END=914) lapp, work
 13		format(q,100a1)
c
c copy appointment for use later...
c
		ifnb = 0
		lnb = 0
		ivx = 0

		Do i = 1, lapp
c
		    ll = work(i)			! fetch character
c
		    if (ll .gt. ' ') then
			if (ifnb .eq. 0) ifnb = i	! Flag first non-blank
			lnb = i				! Flag last non-blank

		    end if

		    if (ifnb .ne. 0) then		! Copy after first n/b
			ivx = ivx + 1
			appoin(ivx) = ll
		    end if
c
		end do

		if (ifnb .eq. 0) go to 914		! Nothing on read either
c
	    End If
c
	    ivx = min0(ivx, iaptlim)	! ivx = length of string

	    iwy=iye
	    iwm=im
	    iwd=id
	    iwht=iht
c
	    close(1)			! add close to guarantee no failures...

c
C  If we are using the 'S' command, ONLY add meetings to the indirected
C  files, not to the current (control) file.
	    if (ctlfg .ne. 1) then
		Open ( unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED',
	1	carriagecontrol='LIST', access='APPEND')

		ihtxx=iht
		do 3005 ixx = 1, idmx
		write(1,14) iye,im,id,ihtxx,(appoin(i),i=1, ivx)
		if ((ihtxx/10)*10 .eq. ihtxx) then
		    ihtxx=ihtxx+3	! IHT is even hour, go to next half hour
		else
		    ihtxx=ihtxx+7	! IHT is a half hour ... make up to next hour
		end if
 3005		continue
 14		format(3i2.2,i3.3,x,100a1)
		close(1)
	    End If

	else				! Empty line (no appointment to add)
 914	    idmx = 0			! Use as flag for display only

	end if
c
 9876	nunit=1
	Open (unit=nunit,file=FNAME ,status='OLD' ,form='FORMATTED',
     1		err=99)

 100	continue	!	loop back up here to continue reading and
			!	processing input file:


	read(nunit,200,end=400) ihy, ihm, ihd, iht, iwkln, work
 200	format(3i2, i3, q, 100a1)
c
	if ((ihm .eq. 99) .and. (nunit .eq. 1)) then
	    nunit=2
c null terminate the filename somewhere
c lines with 99 in 2nd 2 cols are filenames only...
c use = as delimiter of filename
	    work(59)=0
	    ij = 0
	    do ii=1, iwkln
		iq=iwkln-ii+1
c go from end of line back to beginning and null trailing blanks
c this works even if filename contains spaces in specs. somehow.
		ll = work(iq)
		if (ll.eq.'=')work(iq)=0  ! null out any = signs
		if (ll.gt.' ')goto 5678
	    end do
 5678	    continue
	    if (ctlfg .ne. 0) then

c on scheduling multiple dates via the S function, use this occasion to
c add the record to everyone's calendar file.
c
		close(2)
		Open (unit=2, file=work, status='OLD',
	1	    form='FORMATTED', carriagecontrol='LIST',
	2	    access='APPEND', err=1119)

		ihtxx=iwht
		do ixx = 1, idmx
		    write(2,14) iwy,iwm,iwd,ihtxx,(appoin(i),i=1,ivx)
		    if ((ihtxx/10)*10 .eq. ihtxx) then
			ihtxx=ihtxx+3	! iht is an even hour ... add the half hour
		    else
			ihtxx=ihtxx+7	! iht is a half hour ... make up to next hour
		    end if
		end do
		close(2)
	    end if

 1119	    Open(unit=nunit,file=work,status='old',form='formatted',
	1	carriagecontrol='LIST', err=1067)

	    go to 100

c Display appointment if it matches current date

	else If ((iye .eq. ihy) .and. (im .eq. ihm)
	1	 .and. (id .eq. ihd)) then

	    iy = min0(max0((((iht+2) / 5) - 13), 3), 22) ! Compute vertical posn
c
	    do kk = iaptlim + 1, 1, -1		! Trim trailing blanks and nulls
		if (work(kk) .gt. ' ') go to 1066	! and all that
	    end do

	    kk = 1			! Line was empty
	    work(1) = blot

 1066	    ix = 10
	    if (work(1) .ne. ' ') then
		ix = 11			! '12:00 - Appointment'
		kk = min0(kk, iaptlim)
	    end if
	    call dtcat(ix,iy)
	    write(iterm,300) (work(k),k=1,kk), esc,'[K'	! Erase EOL
 300	    format('+', <kk>a1, 2a, $)
	End If
	go to 100

 400	continue	! no more appointments left in file.
	if (nunit .ne. 1) then
c
 1067	    continue
	    close(2)
	    nunit=1
	    go to 100
c
	end if
c
	go to 101			! Common exit code
c
 99	continue			! Error opening, create empty
	open(unit=1, file=FNAME, status='NEW', form='FORMATTED',
	1    carriagecontrol='LIST')
c
 101	close(1)
	call dtcat(1,22)
	return
	end
