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			 Calendar
c  9/10 Y e a r		M o n t h	  Y e a r
c    11		      S M T W T F S
c 13-23		     C a l e n d a r
c
c Lines 9/10 are double-height/double-width
c Odd lines 11-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 dtcdspmth subr)
c		Months mixed-case and centered (GABY)
c	Modified 850809 - display IBIGYR both sides of month, DH/DW

	SUBROUTINE month	! (line)

c	Declarations:

	include 'comdtc.inc/nolist'
	include 'apptdtc.inc/nolist'
	include 'escdtc.inc/nolist'

	byte temp(4)		!	temporary string converting array

	integer	id		!	Julian Day
	integer im		!	Julian Month
	integer iy		!	Julian Year

	integer prveof, eofflg

	byte monthn(9),		!	string month name
	1 lmonth(9)
	logical*1 lmneven(12)/	!	Entries true if length of name is even
	1 .false., .true., .false., .false., .false., .true.,
	2  .true., .true., .false., .false., .true.,  .true./
	logical*1 lmnodd(12)	!	Entries true if length of name is odd
	1 /.true., .false., .true., .true.,  .true., .false.,
	2 .false., .false., .true., .true., .false., .false./

	Byte out(79)		!	The output string and * array
        byte rchr		!	Flag set (or reset) character
	byte ln1		!	Same as line(1)

	equivalence (line, ln1)

	include 'stmtfunc.for/nolist'

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=ibigyr

	call dtcidate(irm,ird,iry) ! Real month,day,year, for display highlight

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

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

c Now start building the output string: (out)

	encode(4, 20, temp, err=11) iy
 11	continue
 20	format(i4)

c Calculate nominal prev, next month numbers

	lm = im - 1
	ly = iy
	nm = im + 1
	ny = iy

	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 dtcmthnam(lm,lmonth)

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

C WRITE OUT HDR FOR LAST, NEXT MONTH, THEN DAYS
	ix = 3
	if (lmneven(lm)) ix = ix + 1
	call dtcat(ix, 1)
	write(iterm,6) lmonth
	ix = 61
	if (lmneven(nm)) ix = ix + 1
	call dtcat(ix, 1)
	write(iterm,6) monthn
 6	format ('+', 9(a1, x), $)
	call dtcat(1, 2)
	write(iterm,7)
 7	format('+','Su Mo Tu We Th Fr Sa',T60,'Su Mo Tu We Th Fr Sa',$)
c ***	call dtcat(35, 7)			! Center year above cur month
c ***	write(iterm,96) temp
c *** 96	format ('+', 4(x, a1))

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

c Last month to upper-left corner of screen

	call dtcalcdow(ib,il,lm,ly)
	call dtcdspmth(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 Next month to upper-right corner of screen

	call dtcalcdow(ib,il,nm,ny)
	call dtcdspmth(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		display big banner header name of this month:

c	call dtcat(ix,9)
	call dtcat(1,9)

	call dtcmthnam(im,monthn)

	ix = 11
	if (lmneven(im)) ix = ix + 1
	ixx = ix - 9
	ixy = 14 - ix

	write(iterm,8) '+', esc,dhdw1, temp, monthn, temp
 8	format(3a, 4(a1, x), <ixx>x, 9(x,a1), <ixy>x, 4(x, a1), $)
	write(iterm,8) ' ', esc,dhdw2, temp, monthn, temp

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

	call dtcat(1,11)
	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

	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 dtcalcdow(ib,il,im,iy)
c	call dtcdspmth(ib,il,8,8,8,1)		! For single-width
	call dtcdspmth(ib,il,1,3,9,1)		! For double-width
c
	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
		go to 685				! And show looking-at date
	    end if

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

	else

 685	    irdw = mod (id + ib - 2, 7)		! Day of week (orig 0)
	    irwk = (id + ib - 2)/7			! Week in month (orig 0)
	    call dtcat ((irdw*6)+2, (irwk*2)+13)
	    write (iterm,684) esc,'[4m', id, esc,resetvattr

	end if

	if (rdspfg .eq. 0) then
		rchr='*'
		out(1) = ' '
	else
		rchr=' '
		out(1) = '*'
	end if

	Do i= 2, 31		! set the out array to all blanks:
	out(i) = out(1)
	end do

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

	irqhash(1) = ihymd(iy, im, 1)		! Want entries for
	irqhash(2) = ihymd(iy, im, 31)		! current month

	eofflg = -1
	prveof = 0

	do while (prveof .ge. 0)

	    call dtcrdappt(eofflg, 0)
	    if (eofflg .ge. 0) out(ihd) = rchr
	    prveof = eofflg

	end do

c Have now accumulated all info about current month,
c go back and flag appropriate days

	iy = 13
	ip = ib - 1
	
	Do 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
	end do				! # days in month
	
 999	call dtcat(1,23)		! Position for next prompt

	end
