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 c Declarations: c byte line(84) ! input line byte temp(2) ! temporary string converting array byte esc ! escape character integer id ! Julian Day integer im ! Julian Month integer iye ! 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 INTEGER IDYR,IDMO,IDDY COMMON/DEFDAT/IDYR,IDMO,IDDY byte monthn(9) ! string month name real badf77 ! Maybe error in array subscripts byte wknam(21) ! string containing names of days of week real badftn ! Hoolay kan byte ihold ! 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 = 6 ! Output terminal unit number esc = "033 ! Escape character IM=IDMO ID=IDDY IYE=IDYR C call idate(im,id,iye) ! initialize to today's date If (line(1) .eq. 'Y') then Do 1 i=1,70 ! Trim of the 'Y' from the line(i) = line(i+2) ! 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) 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' ! Clear screen invoke ANSI write(iterm,3) esc,'[','?','3','h' ! set screen to 132 col encode ( 2 , 2 , temp ) iye ix = 30 iy = 11 call dtcat(ix,iy) ! Display this year in double write(iterm,3) esc,'#','3','1', ! width double height numbers 1 ' ','9',' ',temp(1),' ',temp(2) ! in the middle of the screen iy = 12 call dtcat(ix,iy) write(iterm,3) esc,'#','4','1', 1 ' ','9',' ',temp(1),' ',temp(2) ! double size Do 4 img = 1,12 ! for each month: call gaby(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 = 13 ! last six months on bottom else ! half of screen iy = 2 end if call dtcat(ix,iy) ! Position cursor and: write(iterm,3) (monthn(ii),ii=1,9) 3 format('+',21a1) ! Write out the name. If (img .gt. 6) then ! Write out day of week iy = 14 ! Header names also, one else ! 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 ! Write out numbers for iy = 15 ! Days in each month: iyo = 12 else iy = 4 iyo = 1 end if call dany(ib,il,img,iye) ! Now position the month ix = ix - 1 ! 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(5,80,END=914)line 80 format(84a1) 914 write(5,3) esc,'[','?','3','l' return end