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 a DCL 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 Modified: James Downward C 10-June-1984 Major Rewrite. Here VAXDTC is taking a major C departure from the version which also works C on PDP-11's. C 1. Trap ^Z uniformly. Exit if discovered C 2. Catch/trap illegal inputs and do not abominate C 3. Convert mainline to use string variables C 4. Convert command line to UC to ease parsing C 5. Declare exit handler to return terminal to C the status it should have had. C 6. Fix many many bugs with formatting screen C correctly on the VAX (different terminal handler C sometimes does different things) C 7. Illuminate current day in Year/Month display C 8. Escape key processing support. C 9. PF4/F20 escape to new window support C 10. PF2/HELP escape to current HELP topic C VT2xx support as needed c c------------------------------------------------------------------------ c c Declarations: c OPTIONS /NOI4 PROGRAM VAXDTC c CHARACTER*1 Cesc,Cnull,Cbell CHARACTER*4 Cbold,Cnorm CHARACTER*60 Cfile_name ! File name CHARACTER*84 Command ! VAX Foreign command CHARACTER*80 Chelp_Topic ! BYTE FNAME(60) ! BYTE LINE(84) ! command line LOGICAL*1 Ladvanced_Video/.TRUE./ ! True is TT: has AVO LOGICAL*1 Lsort_Flag /.FALSE./! Do not sort on exit LOGICAL*1 Lhelp_Prompt /.FALSE./! Do not prompt for help INTEGER*2 Check_Type ! Flag to control special checks ! in DAY subroutine ! =0 No spcl chk ! =1 List today's apts/exit ! =2 Warn if apts today INTEGER*2 rdspfg ! reverse sense of dsply of time INTEGER*2 ctlfg ! misc control flags here INTEGER*2 INCMOD ! Flag month/day/year default ! increment... 1=DAY, 2=WEEK, ! 3=MONTH,4=YEAR INTEGER*2 IDYR,IDMO,IDDY ! INTEGER*2 FNSZ ! INTEGER*2 TTCHAN ! For SYS$ASSIGN INTEGER*4 Istatus,LIB$GET_FOREIGN ! INTEGER*4 Iterminal,SYS$ASSIGN ! INTEGER*4 Ilength ! INTEGER*4 Term_char(3) ! INTEGER*4 SYS$QIOW,Sense_Mode ! INTEGER*4 IO$_SENSEMODE,TT2$V_AVO ! EXTERNAL IO$_SENSEMODE ! COMMON /DEFDAT/ IDYR,IDMO,IDDY COMMON /CTLS/ RDSPFG,CTLFG,Check_Type COMMON /FN/ FNSZ,FNAME COMMON /Terminal/ TTchan,Lun_Terminal ! COMMON /Constants/ Cesc,Cbell,Cnull,Cbold,Cnorm COMMON /Sort/ Lsort_Flag ! PARAMETER (TT2$V_AVO=27) ! DATA Cesc /27/ DATA Cnull /0/ DATA Cbell /7/ c LUN_Terminal=6 ! Terminal Lun c OPEN(Unit=LUN_Terminal, ! Open with large c - Status ='UNKNOWN', ! c - Name ='SYS$OUTPUT', ! record size c - Recordsize=512) ! CALL Get_Termtype(Iterminal) ! Get terminal type IF(Iterminal.GT.0) THEN ! If have a real term Istatus = SYS$ASSIGN('SYS$INPUT',TTchan,,) ! Get chnl for input Sense_mode = %LOC(IO$_SENSEMODE) ! Istatus = SYS$QIOW (,%VAL(TTCHAN), %VAL(Sense_mode) - ,,,,Term_Char, %VAL(12),,,,) ! IF (.NOT. Istatus) CALL LIB$STOP (%VAL(Istatus))! Die if fails Ladvanced_Video=BTEST(Term_Char(3),TT2$V_AVO)! ELSE ! Else flag TTchan TTchan=-1 ! so won't use it END IF ! IF (Iterminal.LT.96) THEN ! If not VT100 Cbold=Cnull//Cnull//Cnull//Cnull ! Set video attributes Cnorm=Cbold ! if any ELSE ! Cbold=Cesc//'[1m' ! Cnorm=Cesc//'[0m' ! END IF ! c CALL IDATE(IDMO,IDDY,IDYR) Cfile_NAME='SYS$LOGIN:DTC.DAT'//Cnull Fnsz=17 C Cfile_NAME='DTC.DAT'//Cnull C Fnsz=7 READ(Cfile_Name,'(60a1)')Fname DO I=1,84 LINE(I)=0 END DO c c First get the DCL line, and then parse and process it: c Istatus=LIB$GET_FOREIGN(Command,,Ilen) ! If have command IF(Ilen.GT.0) THEN ! Convert to bytes Command=Command(1:Ilen) ! Padd with spaces READ(Command,'(84A1)')Line ! Command(Ilen+1:Ilen+1)=Cnull ! Terminate with null ELSE ! If no command CALL EXIT_DTC(Iterminal,TTchan) ! Establish exit handler END IF ! c c Generalized parser and scanner routine for line: c Loop up here on any input. c CTLFG=0 ! Check_Type=0 ! No special checks Chelp_Topic=' ' 1 continue c initialize flags to normal search display sense (show occupied times) c and no special meeting setups... rdspfg=0 1111 continue If ( Command(1:1) .eq. 'M' ) then ! Month command Lhelp_Prompt=.FALSE. ! disable help prompt Chelp_Topic='Month_At_A_Glance' ! INCMOD=3 call month(line) ! Month subroutine goto 6 ELSE IF (Command(1:1) .EQ.'I') THEN ! If initialize reset Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt CALL IDATE(IDMO,IDDY,IDYR) ! default date GOTO 66 Else If (Command(1:1) .EQ.'W' ) THEN ! Week command Chelp_Topic='Week_At_A_Glance' ! Lhelp_Prompt=.FALSE. ! disable help prompt INCMOD=2 call week(line) ! Week subroutine goto 6 Else If ( Command(1:1) .eq. 'D' ) then ! Day command Chelp_Topic='Day_At_A_Glance' ! Lhelp_Prompt=.FALSE. ! disable help prompt INCMOD=1 call day(line) ! day subroutine goto 6 Else If(Command(1:1) .eq.'Y') then ! Year command IF(Ladvanced_Video) THEN ! If supported Line(1)='Y' ! Chelp_Topic='Year_At_A_Glance' ! Lhelp_Prompt=.FALSE. ! disable help prompt INCMOD=4 ! call year(line) ! END IF ! Command=' ' ! Goto 1 Else If(Command(1:1).eq.'S') then ! Schedule command Line(1)='D' ! Use DAY subroutine Chelp_Topic='Scheduling_appointments' ! Lhelp_Prompt=.FALSE. ! disable help prompt ctlfg=1 ! but flag mult sched INCMOD=1 ! of meeting for multi entry call day(line) goto 6 ELSE IF(Command(1:1).EQ.'G') then ! Use G to schedule apts Line(1)='D' ! in current and all Chelp_Topic='Scheduling_appointments' ! Lhelp_Prompt=.FALSE. ! disable help prompt ctlfg=2 ! indirected files INCMOD=1 ! call day(line) goto 6 Else If(Line(1).eq.'+' .or. ! If delta time - Line(1).eq.'-') then ! then change increment Chelp_Topic='Date_Format' ! Lhelp_Prompt=.FALSE. ! disable help prompt Call TIMINC(line,Incmod) ! Goto 66 ! Else If ( Command(1:1) .eq. 'H') then ! Chelp_Topic=' ' ! IF(.NOT. Lhelp_Prompt) THEN ! Ipos=INDEX(Command,' ') ! Find a 1st space Command(1:)=Command(Ipos+1:) ! Shift left call dhelp(Iterminal,Command) ! HELP (instructions) Lhelp_Prompt=.TRUE. ! Next time, prompt ELSE WRITE(*,1000)Cnull,Cesc,Cesc ! Command=' ' ! CALL READ_STRING(Command,Ilength) ! Read input IF(Ilength.GE.0) THEN ! call dhelp(Iterminal,Command) ! HELP Command=' ' ! ELSE IF(Ilength.EQ.-1) THEN ! GOTO 9999 ! Exit on ^Z ELSE ! GOTO 1 ! Redisplay menu END IF ! END IF goto 6 ELSE IF(Command(1:1).EQ.'F') THEN ! Change dflt filename Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt FNSZ=0 DO I=1,40 IF(LINE(I+2).LE.32) GOTO 1115 FNSZ=FNSZ+1 FNAME(FNSZ)=LINE(I+2) END DO ! 1115 CONTINUE ! IF(FNSZ.GT.0)FNAME(FNSZ+1)=0 GOTO 66 c reverse display flag so we hunt up free slots... note day, week, month c routines all get hacked on to do this... Else If(Command(1:1).eq.'N') then ! Reverse display Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt rdspfg=1 ! set flag do i=1,71 ! Shift cmd line over 1 line(i)=line(i+1) ! to remove 'N' END DO ! Command(1:)=Command(2:) ! Then go and reparse goto 1111 ! the command line Else If ( Command(1:2) .eq. 'PR' ) then ! Day command Lhelp_Prompt=.FALSE. ! disable help prompt Chelp_Topic='Print' ! INCMOD=1 ! call DTC_PRINT(Command) ! Print subroutine goto 6 Else If (Command(1:2).eq.'PU') then ! Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt call strip(line) ! goto 66 ! Repaint Menu Else If(Command(1:1).eq.'L') then ! Locate free time Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt CTLFG=1 ! Specify to scan map LINE(1)='W' ! and use week function INCMOD=2 ! CALL WEEK(LINE) ! GOTO 6 ! ELSE IF (Command(1:1).EQ.'T') THEN ! Today's activities Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt LINE(1)='D' ! INCMOD=1 ! Check_Type=1 ! List today/exit dsply CALL DAY(LINE) ! TODAY'S MEMOS THEN EXIT IF (Lsort_Flag) THEN I=INDEX(Cfile_Name,Cnull) CALL File_Sort(Cfile_Name(1:I),Iterminal,Istatus) END IF CALL EXIT ! ELSE IF (Command(1:1) .EQ.'R') THEN ! Chelp_Topic=' ' ! Lhelp_Prompt=.FALSE. ! disable help prompt LINE(1)='W' ! INCMOD=2 ! CALL WEEK(LINE) ! REMIND ONE OF THIS WEEK CALL EXIT ELSE IF (Command(1:2).EQ.'CH') THEN ! Lhelp_Prompt=.FALSE. ! disable help prompt LINE(1)='D' ! INCMOD=1 ! Check_Type=2 ! List today/exit dsply CALL DAY(LINE) ! TODAY'S MEMOS THEN EXIT CALL EXIT ! ELSE IF (Command(1:3).EQ.'QCH') THEN ! QCHECK (QUIET CHECK) Lhelp_Prompt=.FALSE. ! disable help prompt LINE(1)='D' ! INCMOD=1 ! Check_Type=3 ! List today/exit dsply CALL DAY(LINE) ! TODAY'S MEMOS THEN EXIT CALL EXIT ! ELSE IF (Command(1:1).EQ.'C') THEN ! CALENDAR PRINT FOR MONTH Lhelp_Prompt=.FALSE. ! disable help prompt Chelp_Topic='Month_At_A_Glance' ! INCMOD=3 CALL MONTH(LINE) CALL EXIT Else If ( Command(1:1) .eq. 'Q' .OR. - Command(1:2) .EQ. 'EX') THEN ! I=INDEX(Cfile_Name,Cnull) IF (Lsort_Flag) - CALL File_Sort(Cfile_Name(1:I),Iterminal,Istatus) CALL EXIT Else c c Now get a bit fancy: ( play with the line string) c IF( Command(1:2) .EQ. 'EV') GOTO 450! Evening pseudo time IF((line(1) .GE. '0') .AND. ! If input is of form - (line(1) .LE. '9') .AND. ! H:mm, OK - (line(2) .EQ. ':')) GOTO 450! Do 3 i=1,2 ! Also OK if form of If ( ( line(i) .lt. '0' ) .or. ! HH:MM - ( line(i) .gt. '9' ) ) GOTO 5 ! If not, bad input 3 Continue ! ret to menu, read more 450 continue if(Command(2:2).EQ.'V') THEN ! Lhelp_Prompt=.FALSE. ! disable help prompt Line(1)='E' ! force upper case IF(Ilength.GT.2) THEN ! line(2)=32 ! make a space I=3 ! Now compress the line DO WHILE (Line(I).EQ.' ') ! find first non-space I=I+1 ! so can remove extra END DO ! spaces between the DO J=I,Ilength ! 'EV' and the text Line(3-I+J)=Line(J) ! END DO ! Ilength=J+1 ! ELSE ! Line(2)=0 ! Terminate, no text END IF END IF 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 ! Shift right to make line(i+9) = line(i) ! space for dflt date 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 LINE(9)=' ' ! WRITE(Command,'(84A1)')Line ! Paste back into buffer INCMOD=1 call day(line) goto 6 5 continue ! Input was not two numbers (time of day) End If c c c Otherwise, the line was uninterpretable, so display menu: c 66 call menu CTLFG=0 Check_Type=0 6 continue ! GET A NEW LINE AND HOP BACK UP... Command=' ' ! CALL READ_STRING(Command,Ilength) ! Read input IF (Ilength.EQ.-1) GOTO 9999! Exit on ^Z IF (Ilength.EQ.-2) THEN ! If escape sequence IF(Command(1:1).EQ.'S' .OR. ! If Window key - Command(1:3).EQ.'34~') THEN ! go do a window Command=' ' ! Istatus=VPW_Window(Command) ! GOTO 1 ! ELSE IF (Command(1:1).EQ.'Q' .OR. ! If Help Key - Command(1:3).EQ.'28~') THEN ! Must want HELP Command=' ' ! IF(.NOT. Lhelp_Prompt) THEN ! call dhelp(Iterminal,Chelp_Topic) ! Get help Lhelp_Prompt=.TRUE. ! Prompt next time ELSE WRITE(*,1000)Cnull,Cesc,Cesc 1000 FORMAT(A,A,'[23;0H',A,'[KHelp Topic: ',$) CALL READ_STRING(Command,Ilength) ! Read input IF(Ilength.GT.0) THEN ! call dhelp(Iterminal,Command) ! HELP Command=' ' ! ELSE IF(Ilength.EQ.0) THEN ! WRITE(*,1010)Cnull,Cesc,Cesc ! 1010 FORMAT(A,A,'[23;0H',A,'[KCommand: ',$)! Lhelp_Prompt=.FALSE. ! GOTO 6 ! ELSE IF(Ilength.EQ.-1) THEN ! GOTO 9999 ! Exit on ^Z ELSE ! command=' ' ! Lhelp_Prompt=.FALSE. GOTO 1 ! Redisplay menu END IF ! END IF GOTO 6 ! ELSE ! otherwise refresh GOTO 1 ! & redisplay menu END IF END IF DO I=1,Ilength IF(Command(I:I).GT.' ') GOTO 300 END DO 300 CONTINUE COMMAND=COMMAND(I:Ilength)//Cnull c Command(Ilength+1:Ilength+1)=Cnull ! tack on trailing null READ(Command,'(84A1)')Line ! Cnvt to bytes Istatus=STR$UPCASE(Command,Command) ! but preserve LC ! in Line Chelp_Topic=' ' ! goto 1 9999 IF (Lsort_Flag) THEN I=INDEX(Cfile_Name,Cnull) CALL File_Sort(Cfile_Name(1:I),Iterminal,Istatus) CALL EXIT END IF end