$STORAGE: 2 $NOFLOATCALLS 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 NOTE C THIS VERSION is a last-minute update version from Mitch Wyle c replacing DTC.FOR and adding the O command to Output a calendar c in a 2 date range. The output is not fully implemented but is c included for whatever it's worth. c c Declarations: c CHARACTER*8 LINE84 character line(84) EQUIVALENCE(LINE(1),LINE84) c command line integer rdspfg c flag to reverse sense of display of time integer iwid common/scrn/iwid c iwid is screen width. Allow it to be set to 132 for Rainbow c computers with a 132 column mode. integer ctlfg c misc control flags here INTEGER IDYR,IDMO,IDDY COMMON/DEFDAT/IDYR,IDMO,IDDY common/ctls/rdspfg,ctlfg character fname(60) CHARACTER*20 FNAME60 EQUIVALENCE(FNAME(1),FNAM60) C INCMOD WILL FLAG MONTH/DAY/YEAR DEFAULT INCREMENT... C 1=DAY, 2=WEEK, 3=MONTH,4=YEAR INTEGER INCMOD integer fnsz,FNS1 common/fn/fnsz,fname c first set up default data filename iwid=80 c 80 column screen default. Even crummy ibm displays hasve that. IDYR=-1 CALL IDATE(IDMO,IDDY,IDYR) MEINC=0 fname(1)='D' FNAME(2)='T' FNAME(3)='C' FNAME(4)='.' FNAME(5)='D' FNAME(6)='A' FNAME(7)='T' FNAME(8)=32 FNAME(9)=0 FNSZ=7 DO 750 I=1,84 750 LINE(I)=0 IZERO=0 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... c zero unused part of filename string each time thru. FNS1=FNSZ+1 do 744 ll=fns1,60 744 fname(ll)=32 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) c 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) c Week subroutine goto 6 Else If ( line(1) .eq. 'D' .or.line(1).eq.'d') then INCMOD=1 call day(line) c 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 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.'+'.or.Line(1).eq.'-')then Call TIMINC(line,Incmod) Goto 6 Else If ( line(1) .eq. 'H' .or.line(1).eq.'h') then call dhelp c 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)=32 GOTO 6 c next: width control Else If(line(1).eq.'1'.and.line(2).eq.'3'.and. 1 line(3).eq.'2') then iwid=132 goto 6 Else if(line(1).eq.'8'.and.line(2).eq.'0')then iwid=80 c command '132' will set wide mode c command '80' sets narrower mode 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 c 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.'o'.or.Line(1).eq.'O') then Call outpt(Line) Goto 6 ELSE IF (LINE(1).EQ.'T')THEN LINE(1)='D' INCMOD=1 CALL DAY(LINE) c TODAY'S MEMOS THEN EXIT STOP ELSE IF (LINE(1).EQ.'R')THEN LINE(1)='W' INCMOD=2 CALL WEEK(LINE) c REMIND ONE OF THIS WEEK STOP ELSE IF (LINE(1).EQ.'C')THEN c CALENDAR PRINT FOR MONTH INCMOD=3 CALL MONTH(LINE) STOP Else If ( line(1) .eq. 'Q'.OR.line(1).eq.'q') then STOP c quit Else If ( ( line(1) .eq. 'E' ) .and. 1 ( line(2) .eq. 'X' ) ) then C CALL EXIT stop c exit Else c c Now get a bit fancy: ( play with the line string) c 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 C FILL IN DEFAULT DATE TOO. USE MMDDYY FORM FOR SIMPLICITY + TERSENESS. WRITE(line84,225)idmo,iddy,idyr 225 format(2x,3i2) line(1) = 'D' line(2) = ' ' LINE(9)=' ' IF(LINE(3).EQ.' ')LINE(3)='0' IF(LINE(5).EQ.' ')LINE(5)='0' INCMOD=1 call day(line) goto 6 5 continue c 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 c GET A NEW LINE AND HOP BACK UP... read(0,7) line 7 format(84a1) goto 1 end