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
