c----------------------------------------------------------------------- c c Year-at-a-glance subroutine c c part of Mitch Wyle's DTC program c c Input: c line - 72 byte string; Format: Y [yy] c c Output: c display screen (see below) c c----------------------------------------------------------------------- c SUBROUTINE year ! (line) c Declarations: include 'comdtc.inc/nolist' include 'escdtc.inc/nolist' byte temp(4), ln1 ! temporary string converting array integer id, idr ! Julian Day integer im, imr ! Julian Month integer iye, iyr ! Julian Year integer iyo ! y offset for where to put month data integer ix ! x coord of cursor integer iy ! y coord of cursor integer img ! month loop index goes from 1 to 12 integer jg ! index offset defined by img integer ii ! implied do loop index variable byte monthn(9) ! string month name real badf77 ! Maybe error in array subscripts character*21 wknam ! string containing names of days of week 1 / 'Su Mo Tu We Th Fr Sa|'/ real badftn ! Hoolay kan byte ihold ! hold the screen 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./ equivalence (line, ln1) if ((ln1 .and. ucmask) .eq. 'Y') 1 call shrink(1, ifnb, lnb) call dtcdatcvt(1) ! Parse out a year value im=idmo id=iddy iye=ibigyr c call dtcidate(imr,idr,iyr) ! initialize to today's date ! to display in reverse video write(iterm,300) esc,'[?3h', ! set screen to 132 col 1 esc,'[2H', esc,'#6', ! set double width for 2 esc,'[14H', esc,'#6' ! Month headers encode (4, 20, temp, err=97) iye 20 format(i4) 97 ix = 29 iy = 11 call dtcat(ix,iy) ! Display year in write(iterm,305) esc,dhdw1, temp ! double height/double width ! in the middle of the screen iy = 12 call dtcat(ix,iy) write(iterm,305) esc,dhdw2, temp ! second line 99 Do 4 img = 1,12 ! for each month: call dtcmthnam(img,monthn) ! Find out name, and display it jg = img - 1 ! x coord of cursor for month if (jg .gt. 5) jg = jg - 6 ! name in outstring ix = ( jg * 22 ) + 1 ! if (img .gt. 6) then ! First six months on top iy = 14 ! last six months on bottom else ! half of screen iy = 2 end if ixx = (ix/2) + 2 c *** if (lmneven(img)) ixx = ixx + 1 call dtcat(ixx,iy) ! Position cursor and: write(iterm,3) monthn 3 format('+',21a1) ! Write out the name. 300 format('+',40a) 305 format('+', 2a, 4(x, a)) 399 format('+',a21) ! Write out the name. If (img .gt. 6) then ! Write out day of week iy = 15 ! Header names also, one else ! line below month names iy = 3 end if call dtcat(ix,iy) write(iterm,399) wknam If (img .gt. 6) then ! Write out numbers for iy = 15 ! Days in each month: iyo = 12 else iy = 4 iyo = 0 end if call dtcalcdow(ib,il,img,iye) ! Now position the month ix = ix - 1 ! Off by 1. CORRECT IT ixspa = 0 ixo = 0 iyspa = 0 call dtcdspmth(ib,il,ix,ixspa,iyo,iyspa) c If displaying current year, mark today's date in reverse video if ((iye .eq. iyr) .and. (img .eq. imr)) then idw = mod(ib + idr -2, 7) ! Day of week and iwm = (idr + ib - 2)/7 ! week of month (orig 0) if (img .gt. 6) iwm = iwm + 1 ! Down one more line for Jul-Dec call dtcat((idw * 3) + ix + 1, iy + iwm) write (iterm, 301), esc,'[5;7m', idr, esc,resetvattr 301 format ('+', 2a, i2, 2a, $) end if 4 Continue call dtcat (1,23) ! Reposition cursor c return next line read in and allow main pgm to decode... read(5,80,END=914)line 80 format(84a1) 914 write(iterm,300) esc,'[?3l' end