c-----------------------------------------------------------------------
c
c	Month-at-a-glance subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c		line 	- 	72 byte string;  Format: M [dd[19[yy]]]
c
c	Output:
c		display screen (see below)
c
c  Line
c     1	Prevmonth			Nextmonth
c     2 SMTWTFS				SMTWTFS
C   3-8 Calendar     (6) Y e a r	Calendar
c     9 		M o n t h
c    11		      S M T W T F S
c 13-23		     C a l e n d a r
c
c Odd lines 9-23 are double-width
c Even lines 10-22 are blank
c
c-----------------------------------------------------------------------
c
c	Modified 850318, several changes- CG
c		Display today's date in current, prev or next month
c		  in reverse video
c		Write out >>> only <<< non-blank flags (*'s)
c		Speed-up of month display (actually in MISCHY subr)
c		Months mixed-case and centered (GABY)
c
	SUBROUTINE month	! (line)

c
c	Declarations:
c

	include 'comdtc.inc/nolist'
	include 'escdtc.inc/nolist'
c
c	byte line(1)		!	input line
	byte temp(2)		!	temporary string converting array
c	byte esc /"033/		!	escape character
c	integer iterm/6/	!	Terminal unit number
	integer	id		!	Julian Day
	integer im		!	Julian Month
	integer iy		!	Julian Year
	byte monthn(9),		!	string month name
	1 lmonth(9)
	Byte out(79)		!	The output string and * array
        byte rchr		!	Flag set (or reset) character
	byte ln1		!	Same as line(1)
	byte appoin(icmln)	!	Appointment string

	equivalence (line, ln1)
c
c	Initialize:
c

c	iterm = 6		!	Output terminal unit number
c	esc = "033		!	Escape character
c
c		Trim off the M from command line:

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

	call dtcdatcvt(2)	! Decode date string

	im=idmo			! Pick up result from common
	id=iddy
	iy=idyr
c
	call idate(irm,ird,iry)	! Real month,day,year, for display highlight

c ***
c
c		Trim off the M from command line:
c

c ***	    IENDER=1
c ***	    DO 63 I=2,10
c ***	    IF(LINE(I).NE.' '.AND.LINE(I).NE.'	')GO TO 64
c ***	    IENDER=IENDER+1
c *** 63	    CONTINUE
c *** 64	    Do 1 i=1,70
c ***		line(i) = line(i+IENDER)
c *** 1	    Continue

c ***	Call datmun(2)
c
c
c		If the month was specified in command line then
c		set im and iy to the right values:
c

c ***	If ( ( line(1) .ge. '0' ) .and. ( line(2) .le. '9' ) ) then
c ***	    temp(1) = line(1)
c ***	    temp(2) = line(2)
c ***	    decode ( 2 , 2 , temp ) im
c ***	IDMO=IM
c ***	End If
c ***	If ( ( line(3) .ge. '0' ) .and. ( line(4) .le. '9' ) ) then
c ***	    temp(1) = line(3)
c ***	    temp(2) = line(4)
c ***	    decode ( 2 , 2 , temp ) iy
c ***	IDYR=IY
c ***	End If
c *** 2	Format(i2)

c
c		Move the cursor to the top part, clear the screen
c

	write(iterm,600) esc,homescrn, esc,clrscrn
 600	format ('+', 4a, $)

c
c		Now start building the output string: (out)
c

c	Do 3 i=1,79
c	    out(i) = ' '
c 3	Continue

c	out(35) = '1'
c	out(37) = '9'
	encode( 2 , 20 , temp, err=11 ) iy
 11	continue
 20	format(i2.2)
c	out(39) = temp(1)
c	out(41) = temp(2)

c
c Calculate nominal prev, next month numbersc
c
	lm = im - 1
	ly = iy
	nm = im + 1
	ny = iy
c
	If ( im .eq. 1 ) then

	    lm = 12
	    ly = iy - 1
	
	else If ( im .eq. 12 ) then

	    nm = 1
	    ny = iy + 1

	End If

C PRINT PREVIOUS MONTH
	call gaby(lm,lmonth)

c	j = 0
c	Do 4 i=3,19,2
c	    j = j + 1
c	    out(i) = monthn(j)
c 4	Continue

C PRINT NEXT MONTH CALENDAR AT TOP
	call gaby(nm,monthn)

c	j = 61					! Set first index
c	Do 5 i=1,9
c	    ! j = (i*2)-1 !!!!
c	    out(j) = monthn(i)
c	    j = j + 2
c 5	Continue
C WRITE OUT HDR FOR LAST, NEXT MONTH, THEN DAYS
	write(iterm,6) lmonth, monthn
 6	format ('+', 2x, 9(a1, x), 39x, 9(x, a1))
	write(iterm,7)
 7	format(x,'Su Mo Tu We Th Fr Sa',T60,'Su Mo Tu We Th Fr Sa')
	call dtcat(37, 7)			! Center year above cur month
	write(iterm,96) temp
 96	format ('+', '1 9 ', a1, x, a1)

c
c	Now display last month, header for this month, and next month:
c

c	If ( im .eq. 1 ) then
c	    lm = 12
c	    ly = iy - 1
c	Else
c	    lm = im - 1
c	    ly = iy
c	End If
c
c	If ( im .eq. 12) then
c	    nm = 1
c	    ny = iy + 1
c	Else
c	    nm = im + 1
c	    ny = iy
c	End If

c
c Last month to upper-left corner of screen
c
	call dany(ib,il,lm,ly)
	call mischy(ib,il,0,0,-1,0)
	If ((irm.eq.lm).and.(iry.eq.ly)) then		! today in rev video
	    irdw = mod (ird + ib - 2, 7)		! Day of week (orig 0)
	    irwk = (ird + ib - 2)/7			! Week in month (orig 0)
	    call dtcat ((irdw*3) + 1, irwk + 3)
	    write (iterm,684) esc,revattr, ird, esc,resetvattr
	end if
c
c Next month to upper-right corner of screen
c
	call dany(ib,il,nm,ny)
	call mischy(ib,il,58,0,-1,0)
	If ((irm.eq.nm).and.(iry.eq.ny)) then		! today in rev video
	    irdw = mod (ird + ib - 2, 7)		! Day of week (orig 0)
	    irwk = (ird +ib - 2)/7			! Week in month (orig 0)
	    call dtcat ((irdw*3) + 59, irwk + 3)
	    write (iterm,684) esc,revattr, ird, esc,resetvattr
	end if

c
c		display big banner header name of this month:
c

	call dtcat(10,9)
	call gaby(im,monthn)
	write(iterm,8) esc,dwide, monthn
 8	format('+',2a, 9(x,a1), $)
9	Continue

c
c	Now print the week day headers for this month, and the days
c	for this month:
c

C	call dtcat(1,9)
	call dtcat(1,11)
c	write(iterm,10)
c 10	format('+',
c	1 'Sunday      Monday     Tuesday   Wednesday    ',
c	2 'Thursday      Friday    Saturday', $)
	write(iterm,10), esc,dwide
 10	format('+', 2a,
	1 'Sun   Mon  Tues  Weds Thurs   Fri   Sat', $)
c	   x     x     x     x     x     x     x     x
c
c Set up header so day numbers will be right-justified under day names
c
c   Sunday    Monday   Tuesday  Wednesday  Thursday   Friday   Saturday
c     nn        nn        nn        nn        nn        nn        nn
c
c 10	format(/,8x,'SUNDAY',3X,'MONDAY',3X,'TUESDAY',2X,'WEDNESDAY',3X,
c	1  'THURSDAY',5X,'FRIDAY',3X,'SATURDAY',/)
c
	write (iterm,138)			! Mark double-width lines
	1 esc,'[13H', esc,dwide,
	2 esc,'[15H', esc,dwide,
	3 esc,'[17H', esc,dwide,
	4 esc,'[19H', esc,dwide,
	5 esc,'[21H', esc,dwide,
	6 esc,'[23H', esc,dwide
 138	format ('+', 24a, $)
c
	call dany(ib,il,im,iy)
c	call mischy(ib,il,8,8,8,1)
	call mischy(ib,il,1,3,9,1)
c
	irdwx = mod (id + ib - 2, 7)		! Day of week (orig 0)
	irwkx = (id + ib - 2)/7			! Week in month (orig 0)

	If ((irm.eq.im).and.(iry.eq.iy)) then		! today in rev video
c
	    irdw = mod (ird + ib - 2, 7)		! Day of week (orig 0)
	    irwk = (ird + ib - 2)/7			! Week in month (orig 0)
	    call dtcat ((irdw*6)+2, (irwk*2)+13)

	    if (id .eq. ird) then
		write (iterm,684) esc,'[4;7m', ird, esc,resetvattr
	    else
		write (iterm,684) esc,revattr, ird, esc,resetvattr
		call dtcat ((irdwx*6)+2, (irwkx*2)+13)
		write (iterm,684) esc,'[4m', id, esc,resetvattr
	    end if

 684		format('+', 2a, i2, 2a, $)

	else

	    call dtcat ((irdwx*6)+2, (irwkx*2)+13)
	    write (iterm,684) esc,'[4m', id, esc,resetvattr

	end if
c
c		Now for files I/O to put *'s on days with appointments:
c

	if(rdspfg.eq.0)then
		rchr='*'
		out(1) = ' '
	else
		rchr=' '
		out(1) = '*'
	end if
c
	Do 110 i=2,31		! set the out array to all blanks:
c	 if(rdspfg.eq.0)then
c	    out(i) = ' '
c	 else
c	    out(i)='*'
c	 end if
	out(i) = out(1)
 110	continue
C CLOSE UNIT 1, JUST IN CASE IT WAS OPEN...
	CLOSE(1)
	Open (unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED')
	iunit=1
 111	Continue    ! ===================================================
	    Read(IUNIT,115,end=122) ihy,ihm,ihd,iht,appoin		!
 115	    format(3i2,i3,100a1)					!
c single indirection if year = 99
c this permits use of multiple data files for scheduling purposes
c maintained by an editor. Note the format is
c999999999filename=
c where
c filename may be absolutely any file spec whatever...
	if(IUNIT.EQ.1.AND.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
									!
	    If (( ihm .eq. im ) .and. ( ihy .eq. iy )) out(ihd) = rchr  !
	    goto 111							!
 122	Continue    !====================================================
	if(iunit.ne.1)then
 1066	close(2)
	iunit=1
	goto 111
	end if

	close(1)
	iy = 13
C WAS IY=13
	ip = ib - 1
	
	Do 1115 i=1,il

	    ip = ip + 1			!	increment day number
	    If ( ip .gt. 7 ) then	!	is it Sunday again?
		ip = 1			!	reset day to Sunday.
		iy = iy + 2 		!	move down one line
	    End If
	    if (out(i) .ne. ' ') then	! Write only non-blank entries !!!!
c		ix = 11 * ip - 3
		ix = 6 * ip - 5
		call dtcat(ix,iy)		!	position cursor
		write(iterm,231) out(i)	!	write * to screen
 231		format('+',a1, $)
	    end if
 1115	Continue
	
	call dtcat(1,23)		! Position for "Option ==>"

	return
	end