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	Declarations:

	include '($ssdef)/nolist'	! Define ss$_normal (and a whole lot more)

	include 'comdtc.inc/list'	! Get common file
	include 'escdtc.inc/list'	! Frequently-used escape sequences

c Initialize common declared above

	byte ln1			! first character of line
	integer*2 ln2			! first two characters of line
	character*84 comlin /' '/
	character*17 fnamech /'SYS$LOGIN:DTC.DAT'/
	data fname(18) /0/,		! Make FORTRAN OPEN happy
	1    fnsz /17/,			! Length of default value
	2    comlen /0/, comidx /0/	! Length, location in command line

	equivalence (comlin, line, ln1, ln2),
	1	    (fname, fnamech)

	data homescrn /'[H'/, clrscrn /'[J'/,
	1    dhdw1 /'#3'/, dhdw2 /'#4'/, dwide /'#6'/,
	2    resetvattr /'[m'/, revattr /'[7m'/

	data incmod /1/					! Default to day

c End common initialization

C INCMOD will flag day/week/month/year default increment...
c 1=day, 2=week, 3=month,4=year
	byte incsel(4) /'D', 'W', 'M', 'Y'/		! Auto display after +/-

	integer*4 lib$get_foreign	! Get DCL command line, unparsed

	logical exflag/.false./		! True if data on DCL command line

	include 'stmtfunc.for/list'	! Get useful statement functions

c Begin code:

c first set up default data filename

	CALL ASSIGN(iterm, 'TT:')	! >>> Assumes VT100, interactive <<<

c Escape sequences used:
c
c	<ESC>7		Save cursor and video attributes
c	<ESC>8		Restore ...
c	<ESC><		Exit ATS mode
c	<ESC>>		Keypad numeric mode (Exit Alternate Keypad mode)
c	<ESC>[?4l	Reset scroll mode (jump)
c	<ESC>[?6l	Reset origin mode (absolute)
c	<ESC>[r		Set top/bottom margins (default - 1:24)
c	<ESC>[m		Graphic rendition = primary (default)
c	<ESC>[H		Set cursor at home position (upper left)
c	<ESC>(B		G0 (SI/^O) = US ASCII
c	<ESC>)0		G1 (SO/^N) = Special graphics
c	^O		Shift In (Select G0 (US ASCII))

	write (iterm,100)	! Clean up terminal
	1 esc,'<', esc,'>',
	2 esc,'[?4l', esc,resetvattr,		! [m
	3 esc,'(B', esc,')0',
	4 esc,'7', esc,'[?6l', esc,'[r', esc,'8', si

 100	format ('+', 21a, $)			! Escape sequences

	call dtcidate(idmo,iddy,ibigyr)		! Get current date

c	First time, get the MCR line, then parse and process it:

c INIT	exflag=.false.				! Assume terminal input

	istat=lib$get_foreign(comlin,,comlen)
	if ((istat .ne. ss$_normal) .or. (comlen .eq. 0))
	1   go to 77

c Allow for single operation to insert an appointment in upper & lower case

	if (ln1 .eq. '"') then			! User quoted the line
	    do i = 2, comlen			! First of many re-copy opns
		line(i-1) = line(i)		! copy it down
	    end do
	    comlen = comlen - 1
	end if

	line(min0(comlen+1, icmln)) = "0	! Set end of line character

	exflag=.true.				! Flag for exit after one command

c Generalized parser and scanner routine for line:

 1	continue				! Loop up here on any input.

c initialize flags to normal search display sense (show occupied times)
c and no special meeting setups...

	rdspfg=0
	ctlfg=0

 1111	continue				! Re-enter here, after "+", etc

c	write(iterm,7787) (line(iv),iv=1,64)
C 7787	format(' lin1:',64a1)

	comidx = 1				! Initialize for parsing

	if (lcalpha(ln1))
	1   ln1 = ln1 .and. '5f'x	! Change to upper case

	If ((ln1 .eq. 'D')
	1   .or. (ln1 .eq. '=')
	2   .or. (ln1 .eq. '*'))
	3 then
	    incmod=1
	    call day	! (line)		! display daily,
	    go to 6

	else if (ln1 .eq. 'W')
	1 then
	    incmod=2
	    call week	! (line)		! weekly,
	    go to 6

	else if (ln1 .eq. 'M')
	1 then
	    incmod=3
	    call month	! (line)		! or monthly schedules,
	    go to 6

	else if (ln1 .eq. 'Y')
	1 then
	    incmod=4
	    call year	! (line)		! or full-year calendar
	    go to 6

c flag multiple schedule of meeting to enable multi entry
	else if (ln1 .eq. 'S')
	1 then
	    ln1='D'
	    ctlfg=1
	    incmod=1
	    call day	! (line)
	    go to 6

c use G as a schedule that will write appointments in current and
c all indirected files.
	else if (ln1 .eq. 'G')
	1 then
	    ln1='D'
	    ctlfg=2
	    incmod=1
	    call day	! (line)
	    go to 6

	else if ((ln1 .eq. '+') .or. (ln1 .eq. '-'))
	1 then
	    Call dtcdatinc	! (line,Incmod)
	    if (ln1 .ne. 0) go to 450		! something left, schedule it

	    ln1 = incsel(incmod)			! Phony line
	    line(2) = "0				! End-of-line ?
	    comlen = 1
	    go to 1111				! Display based on incr

c reverse display flag so we hunt up free slots... note week, month
c routines all get hacked on to do this...
c reparse line after copying it down 1 character to remove the 'N'
	else if (ln1 .eq. 'N')
	1 then
	    rdspfg=1
	    call shrink(1, ifnb, lnb)
	    go to 1111

	else if (ln1 .eq. 'P')
	1 then		! Purge old appointments
	    call strip	! (line)
	    go to 6

	else if ((ln1 .eq. 'U') .or. (ln1 .eq. 'X'))
	1 then
	    call strip	! (line)	! Cancel or reschedule
	    if (ln1 .gt. ' ') go to 1	! Re-scan if leftover chars
	    go to 6

	else if (ln1 .eq. 'L')
	1 then
c for locating free time, use week function and scan map
	    ctlfg=1
	    ln1='W'
	    incmod=2
	    call week	! (line)
	    go to 6

	else if (ln1 .eq. 'T')
	1 then
	    ln1='D'
	    incmod=1
	    call day	! (line)          ! today's memos then exit
	    go to 999

	else if (ln1 .eq. 'R')
	1 then
	    ln1='W'
	    incmod=2
	    call week	! (line)	! remind one of this week
	    go to 999

	else if (ln1 .eq. 'C')
	1 then		! calendar print for month
	    incmod=3
	    call month	! (line)
	    go to 999

	else if (ln1 .eq. 'I')
	1 then		! Reset default date
	    call dtcicomd			! Process possible date string
	    go to 6				! (for testing mods)

	else if ((ln1 .eq. 'H') .or. (ln1 .eq. '?'))
	1 then
	    call dhelp				! HELP! (instructions)
	    go to 6

c f filename enters new default data file name to use...
	else if (ln1 .eq. 'F')
	1 then
	    call shrink(1,ifnb, lnb)
	    if (ifnb .eq. 0)
	1     then
		fnamech = 'SYS$LOGIN:DTC.DAT'
		fnsz = 17		! Length of default value
	      else
		do i=1,lnb
		    fname(i)=line(i)
		end do
		fnsz=lnb
	    end if
	    fname(fnsz+1)=0		! Make FORTRAN OPEN happy
	    go to 6

	else if ((ln1 .eq. 'Q') .or.
	1	 ((ln2 .and. '5f5f'x) .eq. 'EX'))
	2 then
	    go to 999		! Exeunt omnes

	else

c
c	Now get a bit fancy:  (play with the line string)
c
	if (ln1 .eq. 'E') go to 450
c
	If (.not. numeric(ln1)) go to 5 ! unknown
c
 450	continue		! From E above, or leftovers for +/-
c
c The first character is a number or E,
c call the daily appointment subroutine:

	incmod=1
	line(icmln) = "0			! Tag e/o/l
	call day	! (line)
	go to 6

	End If
c
 5	continue		! First character not recognized

c Line was uninterpretable, so display menu:

 77	call menu		! Also display menu first time if no command

 6	continue		! get a new line and hop back up...
	if (exflag) go to 999
c
c DEBUG: Display remains of line after operations on it
c
c !!!	iln = 1
c !!!	do i = 1, icmln
c !!!	if (line(i) .eq. 0) line(i) = "32	! control Z, displays as BLOT
c !!!	if (line(i) .gt. ' ') iln = i
c !!!	end do
c !!!	WRITE(iterm,93) (line(i), i= 1, iln)
c !!! 93	format(' ', <iln>a1, ': DTC: ',$)

	write(iterm,93)
 93	format(' DTC: ',$)

c ---	comlin = ' '		! Initialize w/ blanks

	read (5, 7, end=999) comlen, comlin
 7	format(q, a)

c Mark only stuff read from terminal
c (don't want command-input call to try to read terminal)

	line(min0(comlen+1, icmln)) = "0	! mark for old-style tests

	go to 1

 999	continue				! EXit, Quit, or ^Z

	end
