c----------------------------------------------------------------------- c c Daily Appointment subroutine c c part of Mitch Wyle's DTC program c c Input: c line - 72 bytes; Format: D [mmddyy [hh:mm>HH:MM [appointment]]] c c Output: c display screen (see below) c c----------------------------------------------------------------------- c c 07Mar85 DLE Format 4 needs a $ on the end: otherwise the extra cr/lf c pushes hh:mm notations down 1 line too far. c Also threw out ESC< (see patch to dtcat.for for reasons) c I haven't got a F77 manual here, so I just changed 79a1 to c 12a1 - please do neater hack later c Also had to bend format 5: to prevent undesirable linefeed, c first use must have '+', but second use needs ' ' carriage c control characters. The effect of all this butchery is to c raise frame by 1 line, to match rest of display. c Also moved cursor to (1,23) not (1,22) after display done. c This puts command line under ==== line: neater. c SUBROUTINE day(line) c c Declarations: c 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 ! Julian Day integer im ! Julian Month integer iye ! 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 c c Initialize: c iterm = 6 ! Output terminal unit number esc = "033 ! Escape character C call idate(im,id,iye) ! initialize to today's date IM=IDMO ID=IDDY IYE=IDYR c c Parse that line! c c c Was there a D on the front? If so, trim it off: c IDMX=0 If ( line(1) .eq. 'D' .or.line(1).eq.'d') then Do 1 i=1,70 line(i) = line(i+2) 1 Continue End If c c If the date was specified in command line then c set id, im and iye to the right values: c CALL DATMUN(LINE) Do 22 i=1,6 IDL=I If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33 22 Continue c Six numbers in a row, so decode into numeric date: temp(1) = line(1) temp(2) = line(2) 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 IDDY=ID IDYR=IYE IDMO=IM 2 Format(i2) c c Now discard the date part from line string: c Do 3 i=1,63 line(i) = line(i+7) 3 continue GOTO 3307 33 continue C GOT A DELIMITER NOT A NUMERIC IN 1ST 6 COLS SO MAKE THAT THE START OF LINE C BY CHOPPING OFF ALL THAT'S EARLIER IF(IDL.LE.0.OR.IDL.GT.6)GOTO 3307 DO 3308 I=1,63 LINE(I)=LINE(I+IDL) 3308 CONTINUE 3307 CONTINUE c c Clear the screen, move the cursor to the top part, c set up appointments screen: c c+++++++++++++++++++++++++++07Mar85: add $ to this format, 79a1->12a1 write(iterm,4) esc,'[','2','J',esc,'[','0','1',';','0','1','H' 4 format(x,12a1,$) write(iterm,5)'+', esc,'#','3',im,id,iye 5 format(a1,3a1,10X,'Appointments For ',i2.2,'/',i2.2,'/',i2.2) write(iterm,5)' ', esc,'#','4',im,id,iye c+++++++++++++++++++++++++++07Mar85: hack ends Do 8 i=8,16 If ( i .gt. 12 ) then j = i - 12 Else j = i End If write(iterm,6) j 6 format(x,i2.2,':00 -') write(iterm,7) j 7 format(x,i2.2,':30 -') 8 Continue write(iterm,9) 9 format(x,'Evening:',/,79('=')) c c Was a time input? Did it accompany an appointment string? c Why do fools fall in love? c IDMX=0 if(line(1).eq.'e')LINE(1)='E' If (((line(1).le.'9').and.(line(1).ge.'0')).OR.LINE(1) 1 .EQ.'E') then c c Parse the time string, rock the Casbah: c IF(LINE(1).NE.'E') THEN If ( line(2) .eq. ':' ) then temp(1) = '0' temp(2) = line(1) decode ( 2 , 2 , temp ) iht if ( iht .lt. 5 ) iht = iht + 12 IHHR=IHT iht = iht * 10 If ( line(3) .eq. '3' ) iht = iht + 3 Else If ( line(3) .eq. ':' ) then temp(1) = line(1) temp(2) = line(2) decode ( 2 , 2 , temp ) iht If ( iht .lt. 5 ) iht = iht + 12 IHHR=IHT iht = iht * 10 If ( line(4) .eq. '3' ) iht = iht + 3 End If END IF C HANDLE "EV" MODIFIER FOR EVENING APPOINTMENTS IF(LINE(1).EQ.'E')IHT=170 C 170 IS SPECIAL EVENING CODE..... CORRESPONDS TO 5PM... IHMX=1 IDHR=0 IOMX=6 IF (LINE(6).EQ.'>') THEN C IF 2 RANGES EXIST DUPLICATE MESSAGE AFTER EXTRACTING 2ND RANGE C OF HH:MM DECODE(2,2,LINE(7))IHMX IF(IHMX.LT.5)IHMX=IHMX+12 DECODE(2,2,LINE(10))IMMX IF(IMMX.NE.30)IMMX=0 C COUNT HALF HOURS IN GIVEN INTERVAL ... IDHR=(IHMX-IHHR)*2 C FIND NUMBER ENTRIES TO SHOVE OUT... IF(IMMX.NE.0)IDHR=IDHR+1 IF(IHT.NE.(10*IHHR))IDHR=IDHR-1 IDHR=MAX0(1,IDHR) IDMX=IDHR C ABOVE CLAMPS POSITIVE... NO INVALID ENTRIES PLEASE... IOMX=12 END IF c c Now look for space delimiter to trim off the time c of day part, and then extract the appointment: c C USE IOMX SO WE SCAN PAST 2ND RANGE IF ANY... Do 11 io=1,IOMX If ( line(1) .eq. ' ') goto 12 ! Found a space; exit loop Do 10 i=1,71 line(i) = line(i+1) 10 Continue 11 Continue 12 Continue ! Label to Exit loop c c Was there an appointment string input? c If so, put it in file, and display it on screen. c If not, move cursor to correct time on screen, c then input the appointment, put in file and re-display it. c and when the band you're in starts playin different tunes, c I'll see you on the dark side of the moon. c If ( line(1) .lt. ' ' ) then itemp = iht / 10 if ( itemp .gt. 7 ) itemp = itemp - 7 iy = 2 * itemp + 1 If ( ( ( iht/10 ) * 10 ) .ne. iht ) iy = iy + 1 ix = 10 call dtcat(ix,iy) close(iterm) read(5,13,END=914) (line(i),i=1,60) 13 format('+',60a1) 914 CONTINUE End If c copy appointment for use later... Do 1118 ivx=1,60 1118 work(ivx)=line(ivx) iwy=iye iwm=im iwd=id iwht=iht If ( line(1) .ge. ' ' ) then C ADD CLOSE TO GUARANTEE NO FAILURES... CLOSE(1) C If we are using the 'S' command, ONLY add meetings to the indirected C files, not to the current (control) file. IF(CTLFG.NE.1) THEN Open ( unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED', 1 ACCESS='APPEND') IHTSV=IHT IF(IDMX.LT.1)IDMX=1 DO 3005 IVX=1,IDMX write(1,14) iye,im,id,iht,(line(i),i=1,60) IF((IHT/10)*10.EQ.IHT)THEN C IHT IS AN EVEN HOUR ... AD THE HALF HOUR IHT=IHT+3 ELSE C IHT IS A HALF HOUR ... MAKE UP TO NEXT HOUR IHT=IHT+7 END IF 3005 CONTINUE IHT=IHTSV 14 format(3i2.2,i3.3,60a1) close(1) END IF End If End If nunit=1 Open (unit=nunit,file=FNAME ,status='OLD' ,form='FORMATTED', 1 err=99) 100 continue ! loop back up here to continue reading and ! processing input file: read(nunit,200,end=400) ihy,ihm,ihd,iht,(line(k),k=1,60) 200 format(3i2,i3,60a1) if(ihy.eq.99.and.nunit.eq.1)then nunit=2 c null terminate the filename somewhere c lines with 99 in 1st 2 cols are filenames only... c use = as delimiter of filename line(59)=0 do 1068 ii=1,59 if(line(ii).eq.'=')line(ii)=0 1068 continue if(CTLFG.eq.0) goto 1119 c **** c on scheduling multiple dates via the S function, use this occasion to c add the record to everyone's calendar file. CLOSE(2) Open ( unit=2,file=line,status='OLD',form='FORMATTED', 1 ACCESS='APPEND',err=1119) IHTSV=IHT iht=iwht IF(IDMX.LT.1)IDMX=1 DO 3007 IVX=1,IDMX write(2,14) iwy,iwm,iwd,iht,(work(i),i=1,60) IF((IHT/10)*10.EQ.IHT)THEN C IHT IS AN EVEN HOUR ... AD THE HALF HOUR IHT=IHT+3 ELSE C IHT IS A HALF HOUR ... MAKE UP TO NEXT HOUR IHT=IHT+7 END IF 3007 CONTINUE IHT=IHTSV close(2) c **** 1119 continue Open(unit=nunit,file=line,status='old',form='formatted', 1 err=1067) goto 100 end if If ((iye .eq. ihy) .and. (im .eq. ihm) .and. (id .eq. ihd)) then itemp = iht / 10 if ( itemp .gt. 7 ) itemp = itemp - 7 iy = 2 * itemp + 1 If (((iht/10)*10) .ne. iht) iy = iy + 1 ix = 10 call dtcat(ix,iy) write(iterm,300) (line(k),k=1,60) 300 format('+',60a1) call dtcat(1,23) ! 07Mar85 hack: 22->23 End If goto 100 400 continue ! no more appointments left in file. if(nunit.ne.1)then 1067 continue close(2) nunit=1 goto 100 end if close(1) return 99 CONTINUE OPEN(UNIT=1,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') CLOSE(1) return end