c DR:[333,106]OUTPT.FTN c c----------------------------------------------------------------- c c Output subroutine for Mitch Wyle's (and Glen Everhardt's) c c D esk T op C alendar program c c Inputs: c line - byte array containing date range to output c c Output: c DTC.OUT file, to be printed c c----------------------------------------------------------------- c c To the reader of this code: c c This routine does NOT perform to specifications. The date c range check is incomplete. c c c This code is worse than a kludge; it is DIE code (Designed In Editor) c The output spec was conceived and coded in the editor, and the algorithm c to get the output stinks. c The idea of using an output record a la COBOL is sound. It is conceptually c best to build up an array by calls to date functions and subroutines, c HOWEVER, the coward arrays and repetitive loops are wasteful and unneccessary c This routine needs a major re-write!!!!! c The output specification and format is fine (for my uses); If you do c re-write this routine, here are some ideas: c c o Include the file indirection to print several calendar files' c appointments. c c o build functions which call the subroutine dany; use these functions c to make the out array for printing; c o eliminate the coward arrays; do fancy math in the code instead c c o Create alternate outputs, such as c - Year-At-A-Glance output c - collumns or boxes on page with appointments AND blank areas c which are free c c I apologize for this lousy code; I hope Glen or somebody cleans it up again. c SUBROUTINE OUTPT(line) byte line(1) ! input line byte temp(2) ! temporary string converting array byte appoin(60) ! appointment string byte work(60) ! scratch array for handling scheduling byte esc ! escape character integer id,id2 ! Julian Day integer im,im2 ! Julian Month integer iye,iye2 ! Julian Year 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 logical*1 got1, got2 ! flags to signal which date(s) passed in byte out(80) ! output record for appointment file byte monthn(9) byte cowrd1(7,6) ! binary array for last month byte cowrd2(7,6) ! binary array for this month byte cowrd3(7,6) ! binary array for next month ! maximum of 6 weeks in a month do 1 i=1,40 ! trim off the 'O ' from begining line(i) = line(i+2) 1 continue got1 = .false. got2 = .false. CALL DATMUN(LINE) ! if date(s) was(ere) specified in line, then Do 22 i=1,6 ! extract it (them) from line: If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33 22 Continue got1 = .true. ! flag existence of 1st date temp(1) = line(1) ! Six numbers in a row, temp(2) = line(2) ! decode into numeric date: decode ( 2 , 2 , temp ) im temp(1) = line(3) temp(2) = line(4) decode ( 2 , 2 , temp ) id temp(1) = line(5) temp(2) = line(6) decode ( 2 , 2 , temp ) iye 2 Format(i2) Do 3 i=1,63 ! Now discard the first date line(i) = line(i+7) ! part from line string: 3 continue got2 = .true. ! flag existence of second date CALL DATMUN(LINE) ! if 2nd date was specified in line, then Do 23 i=1,6 ! extract it from line also: If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33 23 Continue temp(1) = line(1) ! Six numbers in a row, temp(2) = line(2) ! so decode into numeric date: decode ( 2 , 2 , temp ) im2 temp(1) = line(3) temp(2) = line(4) decode ( 2 , 2 , temp ) id2 temp(1) = line(5) temp(2) = line(6) decode ( 2 , 2 , temp ) iye2 33 continue If (.not. got1) call idate(im,id,iye) ! default start date = today If (.not. got2) then ! default ending date im2 = 12 ! is dec 31, 1999 id2 = 31 iye2 = 99 end if open (unit=4,file='DTC.OUT',form='FORMATTED',status='NEW') call idate(idis1,idis2,idis3) write(4,38) idis1,idis2,idis3 38 format('1 DTC Rev 22-NOV-83 Appointments Summary', 1 10x,' Print Date: ',2(i2.2,'/'),i2.2,/) Do 34 i=1,80 ! start building the output line array out(i) = ' ' ! first fill it with blanks 34 Continue If ( im .eq. 1 ) then ! get previous month's month name string nm = 12 ! logic here is for year boundaries ny = iy - 1 Else nm = im - 1 ny = iye End If call gaby(nm,monthn) ! got the string, now stick it in output j = 0 ! spacing it every other letter Do 4 i=1,17,2 j = j + 1 out(i) = monthn(j) 4 Continue call gaby(im,monthn) ! now get this month's month name string j = 0 ! and stick it into output string same way Do 5 i=1,17,2 j = j + 1 out(i+28) = monthn(j) 5 continue ly = iye lm = im + 1 ! Get next month's month name string If ( lm .gt. 12 ) then ! and stick into output string lm = 1 ly = iye + 1 End If call gaby(lm,monthn) Do 61 i=1,9 j = (i*2)-1 out(j+55) = monthn(i) 61 Continue write(4,6) (out(i),i=1,79) ! WRITE MONTH NAME HEADERS 6 format(x,79a1) write(4,69) 69 format(' Su Mo Tu We Th Fr Sa ',5x,' Su Mo Tu We Th Fr Sa ', 1 5x,' Su Mo Tu We Th Fr Sa') c Now do the calendar logic to build the three months' numeric c calendar displays and load them into OUT one line at a time c Hmmmmmm.... how do we wanna do this? c c I shall take the coward's way out: c we shall build three numeric arrays, one for each month c three numeric arrays which contain the dates for last month, c this month, and next month in binary, then fill OUT with the c ascii rows from each, and print OUT.... c lm contains next months month number c nm contains last months month number c im contains this months month number c send these guys into dany... c use dany and extract algorithm out of mischy to build these c three coward arrays call dany(ib,il,nm,ny) ! get day of week, days in month ! for last month ip = ib - 1 ! day of week pointer (collumn #) iy = 1 ! row number index into array Do 7 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 + 1 ! move down one line End If cowrd1(ip,iy) = i ! stick date into binary array 7 Continue call dany(ib,il,lm,ly) ! get day of week, days in month ! for next month ip = ib - 1 ! day of week pointer (collumn #) iy = 1 ! row number index into array Do 8 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 + 1 ! move down one line End If cowrd3(ip,iy) = i ! stick date into binary array 8 Continue call dany(ib,il,im,iye) ! get day of week, days in month ! for this month ip = ib - 1 ! day of week pointer (collumn #) iy = 1 ! row number index into array Do 9 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 + 1 ! move down one line End If cowrd2(ip,iy) = i ! stick date into binary array 9 Continue c Now we have finished building the coward arrays; just c stick data from them into OUT, one line at a time and print c OUT, and we are through with header section, so: Do 12 io=1,6 Do 10 i=1,79 out(i) = 0 10 continue j = 1 Do 11 i=1,7 encode(2,2,temp) cowrd1(i,io) out(j)= temp(1) out(j+1) = temp(2) encode(2,2,temp) cowrd2(i,io) out(j+27) = temp(1) out(j+28) = temp(2) encode(2,2,temp),cowrd3(i,io) out(j+54) = temp(1) out(j+55) = temp(2) j = j + 3 11 continue Do 118 ii=1,80 ! if values are if (out(ii).eq.0) out(ii) = ' ' ! 0, make em blanks if ((out(ii).eq.'0').and. ! unless we want 0's 1 (out(ii-1).lt.'1'))out(ii)=' ' 118 continue write(4,13) (out(i),i=1,79) 13 FORMAT(X,79a1) 12 continue c now read appointments open (unit=1,form='FORMATTED',status='OLD',err=990,file=fname, 1 readonly) write(4,15) ! skip a line past last one on calendars 15 format(/) 21 continue ! now process appointments: read(1,722,end=26) iyo,imo,ido,itim,(appoin(i),i=1,60) 722 format(i2,i2,i2,i3,60a1) c c Check to see if appointment is in range: c qqq stick range check code here ************** qqq ************ c c If .not.((imo.ge.ime).and.(imo.le.im2)) goto 21 c write(4,723) imo,ido,iyo,itim,(appoin(i),i=1,60) 723 format(x,i2.2,'/',i2.2,'/',i2.2,xx,i3.3,'0',' - ',60a1) goto 21 26 continue 990 return end