c----------------------------------------------------------------------- c c Year-at-a-glance subroutine c c part of Mitch Wyle's DTC program c c Input: c line - 72 character string; Format: Y [yy] c c Output: c display screen (see below) c c----------------------------------------------------------------------- c SUBROUTINE year(line) c c Declarations: c character line(84) c input line character temp(2) character*2 temp2 equivalence(temp(1),temp2) c temporary string converting array character esc c escape character integer id c Julian Day integer im c Julian Month integer iye c Julian Year integer iyo c y offset for where to put month data integer ix c x coord of cursor integer iy c y coord of cursor integer img c month loop index goes from 1 to 12 integer jg c index offset defined by img integer ii c implied do loop index variable INTEGER IDYR,IDMO,IDDY COMMON/DEFDAT/IDYR,IDMO,IDDY character monthn(9) c string month name real badf77 c Maybe error in array subscripts character wknam(21) c string containing names of days of week real badftn c Hoolay kan character ihold c hold the screen c c Initialize: c Do 121 ii=1,21 wknam(ii) = ' ' 121 continue wknam(1) = 'S' wknam(2) = 'u' wknam(4) = 'M' wknam(5) = 'o' wknam(7) = 'T' wknam(8) = 'u' wknam(10)= 'W' wknam(11)= 'e' wknam(13)= 'T' wknam(14)= 'h' wknam(16)= 'F' wknam(17)= 'r' wknam(19)= 'S' wknam(20)= 'a' wknam(21)= '|' iterm = 0 c Output terminal unit number esc = 27 c Escape character IM=IDMO ID=IDDY IYE=IDYR C call idate(im,id,iye) c initialize to today's date If (line(1) .eq. 'Y') then Do 1 i=1,70 c Trim of the 'Y' from the line(i) = line(i+2) c command line 1 Continue End If If ( ( line(1) .ge. '0' ) .and. ( line(2) .le. '9' ) ) then temp(1) = line(1) temp(2) = line(2) read(temp2,2)iye c decode ( 2 , 2 , temp ) iye IDYR=IYE End If 2 Format(i2) Temp(1)=32 Temp(2)=32 write(iterm,3) esc,'<',esc,'[','2','J' c Clear screen invoke ANSI write(iterm,3) esc,'[','?','3','h' c set screen to 132 col write(temp2,2)iye c encode ( 2 , 2 , temp ) iye ix = 30 iy = 11 call dtcat(ix,iy) c Display this year in double write(iterm,3) '1', 1 ' ','9',' ',temp(1),' ',temp(2) c in the middle of the screen iy = 12 call dtcat(ix,iy) c write(iterm,3) esc,'#','4','1', c 1 ' ','9',' ',temp(1),' ',temp(2) c double size Do 4 img = 1,12 c for each month: call gaby(img,monthn) c Find out name, and display it jg = img - 1 c x coord of cursor for month if (jg .gt. 5) jg = jg - 6 c name in outstring ix = ( jg * 22 ) + 1 c if (img .gt. 6) then c First six months on top iy = 13 c last six months on bottom else c half of screen iy = 2 end if call dtcat(ix,iy) c Position cursor and: write(iterm,3) (monthn(ii),ii=1,9) 3 format(1x,21a1,\) c Write out the name. If (img .gt. 6) then c Write out day of week iy = 14 c Header names also, one else c line below month names iy = 3 end if call dtcat(ix,iy) write(iterm,3) (wknam(ii),ii=1,21) If (img .gt. 6) then c Write out numbers for iy = 15 c Days in each month: iyo = 12 else iy = 4 iyo = 1 end if call dany(ib,il,img,iye) c Now position the month ix = ix - 1 c Off by 1. CORRECT IT ixspa = 0 ixo = 0 iyspa = 0 call mischy(ib,il,ix,ixspa,iyo,iyspa) 4 Continue c return next line read in and allow main pgm to decode... read(0,80,END=914)line 80 format(84a1) 914 write(0,3) esc,'[','?','3','l' return end