$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


