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 7 Save cursor and video attributes c 8 Restore ... c < Exit ATS mode c > Keypad numeric mode (Exit Alternate Keypad mode) c [?4l Reset scroll mode (jump) c [?6l Reset origin mode (absolute) c [r Set top/bottom margins (default - 1:24) c [m Graphic rendition = primary (default) c [H Set cursor at home position (upper left) c (B G0 (SI/^O) = US ASCII c )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(' ', 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