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----------------------------------------------------------------------- c SUBROUTINE month(line) c c Declarations: c byte line(1) ! input line byte temp(2) ! temporary string converting array byte esc ! escape character integer id ! Julian Day integer im ! Julian Month integer iy ! Julian Year byte monthn(9) ! string month name Byte out(79) ! The output string and * array byte appoin(60) ! Appointment string byte rchr integer rdspfg ! flag to reverse sense of display of time integer ctlfg ! misc control flags here INTEGER IDYR,IDMO,IDDY COMMON/DEFDAT/IDYR,IDMO,IDDY common/ctls/rdspfg,ctlfg byte fname(60) integer fnsz common/fn/fnsz,fname c c Initialize: c iterm = 6 ! Output terminal unit number esc = "033 ! Escape character IM=IDMO ID=IDDY IY=IDYR C call idate(im,id,iy) ! initialize to today's date c c Trim off the M from command line: c Do 1 i=1,70 line(i) = line(i+2) 1 Continue CALL DATMUN(LINE) c c If the month was specified in command line then c set im and iy to the right values: c If ( ( line(1) .ge. '0' ) .and. ( line(2) .le. '9' ) ) then temp(1) = line(1) temp(2) = line(2) decode ( 2 , 2 , temp ) im IDMO=IM End If If ( ( line(3) .ge. '0' ) .and. ( line(4) .le. '9' ) ) then temp(1) = line(3) temp(2) = line(4) decode ( 2 , 2 , temp ) iy IDYR=IY End If 2 Format(i2) c c Clear the screen, move the cursor to the top part, c write(iterm,6) esc,'<',esc,'[','2','J',esc,'[','0','1',';','0', 1 '1','H' c c Now start building the output string: (out) c Do 3 i=1,79 out(i) = ' ' 3 Continue If ( im .eq. 1 ) then nm = 12 ny = iy - 1 Else nm = im - 1 ny = iy End If C PRINT PREVIOUS MONTH call gaby(nm,monthn) j = 0 Do 4 i=1,17,2 j = j + 1 out(i) = monthn(j) 4 Continue out(37) = '1' out(39) = '9' encode( 2 , 2 , temp ) iy out(41) = temp(1) out(43) = temp(2) lm = im + 1 If ( lm .gt. 12 ) then lm = 1 ly = iy + 1 End If C PRINT NEXT MONTH CALENDAR AT TOP call gaby(lm,monthn) Do 5 i=1,9 j = (i*2)-1 out(j+62) = monthn(i) 5 Continue C WRITE OUT HDR FOR LAST, NEXT MONTH, THEN DAYS write(iterm,6) out 6 format(x,79a1) write(iterm,7) 7 format(x,'Su Mo Tu We Th Fr Sa',T62,'Su Mo Tu We Th Fr Sa') c c Now display last month, header for this month, and next month: c If ( im .eq. 1 ) then lm = 12 ly = iy - 1 Else lm = im - 1 ly = iy End If If ( im .eq. 12) then nm = 1 ny = iy + 1 Else nm = im + 1 ny = iy End If call dany(ib,il,lm,ly) call mischy(ib,il,0,0,0,0) call dany(ib,il,nm,ny) call mischy(ib,il,60,0,0,0) c c dislpay big banner header name of this month: c call dtcat(37,7) call gaby(im,monthn) write(iterm,8) monthn 8 format('+',9a1) 9 Continue c c Now print the week day headers for this month, and the days c for this month: c C call dtcat(1,9) call dtcat(1,8) write(iterm,10) 10 format(/,8x,'SUNDAY',3X,'MONDAY',3X,'TUESDAY',2X,'WEDNESDAY',2X, 1 'THURSDAY',3X,'FRIDAY',5X,'SATURDAY',/) call dany(ib,il,im,iy) call mischy(ib,il,1,7,8,1) c c Now for files I/O to put *'s on days with appointments: c Do 110 i=1,31 ! set the out array to all blanks: if(rdspfg.eq.0)then out(i) = ' ' else out(i)='*' end if if(rdspfg.eq.0)then rchr='*' else rchr=' ' end if 110 continue C CLOSE UNIT 1, JUST IN CASE IT WAS OPEN... CLOSE(1) Open (unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED') iunit=1 111 Continue ! =================================================== Read(IUNIT,115,end=122) ihy,ihm,ihd,iht,(appoin(k),k=1,60) ! 115 format(3i2,i3,60a1) ! c single indirection if year = 99 c this permits use of multiple data files for scheduling purposes c maintained by an editor. Note the format is c999999999filename= c where c filename may be absolutely any file spec whatever... if(IUNIT.EQ.1.AND.ihy.eq.99)then iunit=2 c null terminate the filename somewhere c lines with 99 in 1st 2 cols are filenames only... c use = as delimiter of filename appoin(59)=0 do 1068 ii=1,59 if(appoin(ii).eq.'=')appoin(ii)=0 1068 continue Open(unit=iunit,file=appoin,status='old',form='formatted', 1 err=1066) goto 111 end if ! If (( ihm .eq. im ) .and. ( ihy .eq. iy )) out(ihd) = rchr ! goto 111 ! 122 Continue !==================================================== if(iunit.ne.1)then 1066 close(2) iunit=1 goto 111 end if call idate(irm,ird,iry) ! Real month,day,year If ((irm.eq.im).and.(iry.eq.iy)) out(ird)='#' ! put # character on. close(1) iy = 12 C WAS IY=13 ip = ib - 1 Do 1115 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 ix = 10 * ip - 2 call dtcat(ix,iy) ! position cursor write(iterm,231) out(i) ! write * to screen 231 format('+',a1) 1115 Continue call dtcat(1,23) return end