c----------------------------------------------------------------------- c c Mischy month printing subroutine c c part of Mitch Wyle's DTC program c c Inputs: c ib - begining day of the week c il - length of month in days c xoff - offset for x coordinate c xspa - number of spaces to skip between numbers c yoff - offset for y coordinate c yspa - number of lines to skip between lines c c Output: c display screen (see below) c c----------------------------------------------------------------------- c SUBROUTINE mischy(ib,il,xoff,xspa,YOFF,yspa) c c Declarations: c integer ib ! begining day of the week integer il ! length of month in days integer xoff ! x offset integer xspa ! number of spaces between numbers integer yoff ! y offset integer yspa ! number of lines to skip between lines c include 'comdtc.inc/nolist' ! Need ITERM include 'escdtc.inc/nolist' c integer ix ! x coordinate of where to put day integer iy ! y coordinate of where to put day integer ip ! the day of the week for date in hand integer ixo ! xoff + 1 c c integer iterm/6/ ! terminal unit # c integer nums(31) ! numbers as characters 1 / ' 1', ' 2', ' 3', ' 4', ' 5', ' 6', ' 7', ' 8', ' 9', 2 '10', '11', '12', '13', '14', '15', '16', '17', '18', '19', 3 '20', '21', '22', '23', '24', '25', '26', '27', '28', '29', 4 '30', '31'/ c integer wknums (7) ! To contain copies of above, or blanks c c Initialize: c c iterm = 6 ! Output terminal unit number c do 99, i = 1, 7 ! One week's worth 99 wknums (i) = ' ' ! initialize c ip = ib ix = xspa + 1 ! Used in format # 1 ixo = xoff + 1 iy = 4 + YOFF C *** If (yspa .ne. 0) iy = 12 c c Now write month out to screen, one day at a time: c Do 5 i=1,il wknums(ip) = nums(i) ! Get day as character If ( ip .eq. 7 ) then ! is it Saturday again? call dtcat(ixo,iy) ! Position cursor for line write (iterm,1) wknums ! Write filled array ip = 1 ! reset day to Sunday. iy = iy + 1 + yspa ! move down one line else ip = ip + 1 ! increment day number End If c c ix = (3+xspa) * ip - 2 + xoff c call dtcat(ix,iy) ! position cursor c write(iterm,1) i ! write day number to screen c 1 format('+',i2, $) c 5 Continue c if (ip .ne. 1) then ! Partial buffer remains do i = ip, 7 ! Pad it wknums(i) = ' ' ! with blanks end do c call dtcat(ixo,iy) ! Position cursor write (iterm,1) wknums ! Write filled array end if c 1 format('+',6(a2,x),a2) return end