c------------------------------------------------------------------------ c c Desk Top Calender Program c c Mitch Wyle 17.11.82 c c c This program provides an on-line appointment calender system c for daily appointments, week-at-a-glance schedule, and month- c at-a-glance schedule. A facility is provided for a daily re- c minder. c c The program has help and menu prompting facilities for the new c user and the ability to interpret an MCR line for the experienced c user. The CRT screen functions are specific to the DEC VT-100 c screen terminal, as is the FORTRAN code. c c------------------------------------------------------------------------ c c Compile: c c------------------------------------------------------------------------ c c Declarations: c byte line(84) ! command line 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) C INCMOD WILL FLAG MONTH/DAY/YEAR DEFAULT INCREMENT... C 1=DAY, 2=WEEK, 3=MONTH,4=YEAR INTEGER INCMOD integer fnsz common/fn/fnsz,fname c first set up default data filename CALL ASSIGN(6,'TI:') INCMOD=1 fname(1)='D' FNAME(2)='T' FNAME(3)='C' FNAME(4)='.' FNAME(5)='D' FNAME(6)='A' FNAME(7)='T' FNAME(8)=0 FNSZ=7 DO 750 I=1,84 750 LINE(I)=0 C SET UP DEFAULT DATE CALL IDATE(IDMO,IDDY,IDYR) C c c First get the MCR line, and then parse and process it: c Call getmcr(line) IGD=0 DO 751 I=1,84 LL=LINE(I) IF(LL.LT.32)IGD=1 IF(IGD.EQ.1)LINE(I)=0 751 CONTINUE c c Generalized parser and scanner routine for line: c Loop up here on any input. c 1 continue c initialize flags to normal search display sense (show occupied times) c and no special meeting setups... rdspfg=0 CTLFG=0 c c Trim off the command word "DTC" from the begining (from GETMCR) c If ((line(1).eq.'D').and.(line(2).eq.'T').and. 1 (line(3).eq.'C')) then Do 2 i=1,68 line(i) = line(i+4) 2 continue End If 1111 continue If ( line(1) .eq. 'M' .or. line(1).eq.'m') then INCMOD=3 call month(line) ! Month subroutine goto 6 ELSE IF (LINE(1).EQ.'I'.OR.LINE(1).EQ.'i')THEN C RESET DEFAULT DATE ON I COMMAND CALL IDATE(IDMO,IDDY,IDYR) GOTO 6 Else If ( line(1) .eq. 'W' .or.line(1).eq.'w') then INCMOD=2 call week(line) ! Week subroutine goto 6 Else If ( line(1) .eq. 'D' .or.line(1).eq.'d') then INCMOD=1 call day(line) ! day subroutine goto 6 Else If(Line(1).eq.'Y'.or.line(1).eq.'y') then Line(1)='Y' INCMOD=4 call year(line) Goto 1 c year routine returns a new line too (since it has to reset screen) c so just use what it returns... c Goto 6 Else If(Line(1).eq.'+'.or.Line(1).eq.'-')then Call TIMINC(line,Incmod) Goto 6 Else If(Line(1).eq.'S'.or.line(1).eq.'s') then Line(1)='D' ctlfg=1 c flag multiple schedule of meeting to enable multi entry INCMOD=1 call day(line) goto 6 ELSE IF(LINE(1).EQ.'G'.or.line(1).eq.'g')then c use G as a schedule that will write appointments in current and c all indirected files. Line(1)='D' ctlfg=2 INCMOD=1 call day(line) goto 6 Else If ( line(1) .eq. 'H' .or.line(1).eq.'h') then call dhelp ! HELP! (instructions) goto 6 ELSE IF(LINE(1).EQ.'F'.OR.LINE(1).EQ.'f') THEN C F FILENAME ENTERS NEW DEFAULT DATA FILE NAME TO USE... FNSZ=0 DO 1114 I=1,40 IF(LINE(I+2).LE.32)GOTO 1115 FNSZ=FNSZ+1 FNAME(FNSZ)=LINE(I+2) 1114 CONTINUE 1115 continue IF(FNSZ.GT.0)FNAME(FNSZ+1)=0 GOTO 6 Else If(line(1).eq.'n'.or.line(1).eq.'N') then rdspfg=1 c reverse display flag so we hunt up free slots... note day, week, month c routines all get hacked on to do this... do 1112 i=1,71 1112 line(i)=line(i+1) c reparse line after copying it down 1 character to remove the 'n' goto 1111 Else If ( line(1) .eq. '?' ) then call dhelp ! WHAT? (instructions) goto 6 Else If (Line(1).eq.'P'.or.line(1).eq.'p') then call strip(line) goto 6 Else If(Line(1).eq.'L'.or.Line(1).eq.'l') then C FOR LOCATING FREE TIME, USE WEEK FUNCTION AND SCAN MAP CTLFG=1 LINE(1)='W' INCMOD=2 CALL WEEK(LINE) GOTO 6 ELSE IF (LINE(1).EQ.'T')THEN LINE(1)='D' INCMOD=1 CALL DAY(LINE) ! TODAY'S MEMOS THEN EXIT CALL EXIT ELSE IF (LINE(1).EQ.'R')THEN LINE(1)='W' INCMOD=2 CALL WEEK(LINE) ! REMIND ONE OF THIS WEEK CALL EXIT ELSE IF (LINE(1).EQ.'C')THEN ! CALENDAR PRINT FOR MONTH INCMOD=3 CALL MONTH(LINE) CALL EXIT Else If ( line(1) .eq. 'Q'.OR.line(1).eq.'q') then CALL EXIT C stop ! quit Else If ( ( line(1) .eq. 'E' ) .and. 1 ( line(2) .eq. 'X' ) ) then CALL EXIT C stop ! exit Else c c Now get a bit fancy: ( play with the line string) c c handle evening appointments here or just hour entry IF((LINE(1).EQ.'e'.or.Line(1).eq.'E').and. 1 (line(2).eq.'v'.or.line(2).eq.'V')) GOTO 450 Do 3 i=1,2 If ( ( line(i) .lt. '0' ) .or. ( line(i) .gt. '9' ) ) goto 5 3 Continue 450 continue if(line(2).eq.'v'.or.line(2).eq.'V')line(2)=32 c c The first two characters are numbers, so put a D at front of line c and call the daily appointment subroutine: Do 4 i=70,1,-1 line(i+9) = line(i) 4 Continue line(1) = 'D' line(2) = ' ' C FILL IN DEFAULT DATE TOO. USE MMDDYY FORM FOR SIMPLICITY + TERSENESS. ENCODE(2,225,LINE(3))IDMO 225 FORMAT(I2.2) ENCODE(2,225,LINE(5))IDDY ENCODE(2,225,LINE(7))IDYR INCMOD=1 call day(line) goto 6 5 continue ! Input was not two numbers (time of day) End If c c Evening appointment: (EV input line) c C NOTE THAT DAY ROUTINE RECOGNIZES E AS EVENING APPT AS A PSEUDO TIME TOO. c If ( ( line(1) .eq. 'E' ) .and. ( line(2) .eq. 'V' ) ) then c line(1) = 'D' c line(2) = ' ' c line(3) = 'E' c INCMOD=1 c call day(line) c goto 6 c End If c c Otherwise, the line was uninterpretable, so display menu: c call menu 6 continue ! GET A NEW LINE AND HOP BACK UP... read(5,7) line 7 format(84a1) goto 1 end