home *** CD-ROM | disk | FTP | other *** search
/ ftp.update.uu.se / ftp.update.uu.se.2014.03.zip / ftp.update.uu.se / pub / rainbow / msdos / decus / RB101 / dtc.for < prev    next >
Text File  |  1995-05-19  |  7KB  |  284 lines
  1. $STORAGE: 2
  2. $NOFLOATCALLS
  3. c------------------------------------------------------------------------
  4. c
  5. c        Desk Top Calender Program
  6. c
  7. c                              Mitch Wyle 17.11.82
  8. c
  9. c
  10. c    This program provides an on-line appointment calender system
  11. c    for daily appointments, week-at-a-glance schedule, and month-
  12. c    at-a-glance schedule.  A facility is provided for a daily re-
  13. c    minder.
  14. c
  15. c    The program has help and menu prompting facilities for the new
  16. c    user and the ability to interpret an MCR line for the experienced
  17. c    user.  The CRT screen functions are specific to the DEC VT-100
  18. c    screen terminal, as is the FORTRAN code.
  19. c
  20. c------------------------------------------------------------------------
  21. c
  22. c    Compile:
  23. c
  24. c------------------------------------------------------------------------
  25. C NOTE
  26. C  THIS VERSION is a last-minute update version from Mitch Wyle
  27. c  replacing DTC.FOR and adding the O command to Output a calendar
  28. c  in a 2 date range. The output is not fully implemented but is
  29. c  included for whatever it's worth.
  30. c
  31. c    Declarations:
  32. c
  33.  
  34.     CHARACTER*8 LINE84
  35.     character line(84)        
  36.     EQUIVALENCE(LINE(1),LINE84)
  37. c     command line
  38.     integer rdspfg          
  39. c   flag to reverse sense of display of time
  40.     integer iwid
  41.     common/scrn/iwid
  42. c iwid is screen width. Allow it to be set to 132 for Rainbow
  43. c computers with a 132 column mode.
  44.     integer ctlfg           
  45. c   misc control flags here
  46.     INTEGER IDYR,IDMO,IDDY
  47.     COMMON/DEFDAT/IDYR,IDMO,IDDY
  48.     common/ctls/rdspfg,ctlfg
  49.     character fname(60)
  50.     CHARACTER*20 FNAME60
  51.     EQUIVALENCE(FNAME(1),FNAM60)
  52. C INCMOD WILL FLAG MONTH/DAY/YEAR DEFAULT INCREMENT...
  53. C 1=DAY, 2=WEEK, 3=MONTH,4=YEAR
  54.     INTEGER INCMOD
  55.     integer fnsz,FNS1
  56.     common/fn/fnsz,fname
  57. c first set up default data filename
  58.     iwid=80
  59. c 80 column screen default. Even crummy ibm displays hasve that.
  60.     IDYR=-1
  61.     CALL IDATE(IDMO,IDDY,IDYR)
  62.     MEINC=0
  63.     fname(1)='D'
  64.     FNAME(2)='T'
  65.     FNAME(3)='C'
  66.     FNAME(4)='.'
  67.     FNAME(5)='D'
  68.     FNAME(6)='A'
  69.     FNAME(7)='T'
  70.     FNAME(8)=32
  71.     FNAME(9)=0
  72.     FNSZ=7
  73.     DO 750 I=1,84
  74. 750    LINE(I)=0
  75.     IZERO=0
  76. c
  77. c    Generalized parser and scanner routine for line:
  78. c    Loop up here on any input.
  79. c
  80. 1    continue
  81. c initialize flags to normal search display sense (show occupied times)
  82. c and no special meeting setups...
  83. c zero unused part of filename string each time thru.
  84.     FNS1=FNSZ+1
  85.     do 744 ll=fns1,60
  86. 744    fname(ll)=32
  87.     rdspfg=0
  88.     CTLFG=0
  89. c
  90. c    Trim off the command word "DTC" from the begining (from GETMCR)
  91. c
  92.  
  93.     If ((line(1).eq.'D').and.(line(2).eq.'T').and.
  94.      1         (line(3).eq.'C')) then
  95.         Do 2 i=1,68
  96.         line(i) = line(i+4)
  97. 2        continue
  98.     End If
  99. 1111    continue
  100.     If ( line(1) .eq. 'M' .or. line(1).eq.'m') then
  101.         INCMOD=3
  102.         call month(line)            
  103. c  Month subroutine
  104.         goto 6
  105.     ELSE IF (LINE(1).EQ.'I'.OR.LINE(1).EQ.'i')THEN
  106. C RESET DEFAULT DATE ON I COMMAND
  107.     CALL IDATE(IDMO,IDDY,IDYR)
  108.         GOTO 6
  109.     Else If ( line(1) .eq. 'W' .or.line(1).eq.'w') then
  110.         INCMOD=2
  111.         call week(line)                
  112. c  Week  subroutine
  113.         goto 6
  114.     Else If ( line(1) .eq. 'D' .or.line(1).eq.'d') then
  115.         INCMOD=1
  116.         call day(line)                
  117. c  day subroutine
  118.         goto 6
  119.     Else If(Line(1).eq.'Y'.or.line(1).eq.'y') then
  120.         Line(1)='Y'
  121.         INCMOD=4
  122.         call year(line)
  123.         Goto 1
  124. c        Goto 6
  125.     Else If(Line(1).eq.'S'.or.line(1).eq.'s') then
  126.         Line(1)='D'
  127.         ctlfg=1
  128. c flag multiple schedule of meeting to enable multi entry
  129.         INCMOD=1
  130.         call day(line)
  131.         goto 6
  132.     ELSE IF(LINE(1).EQ.'G'.or.line(1).eq.'g')then
  133. c use G as a schedule that will write appointments in current and
  134. c all indirected files.
  135.         Line(1)='D'
  136.         ctlfg=2
  137.         INCMOD=1
  138.         call day(line)
  139.         goto 6
  140.     Else If(Line(1).eq.'+'.or.Line(1).eq.'-')then
  141.         Call TIMINC(line,Incmod)
  142.         Goto 6
  143.     Else If ( line(1) .eq. 'H' .or.line(1).eq.'h') then 
  144.         call dhelp                
  145. c  HELP! (instructions)
  146.         goto 6
  147.     ELSE IF(LINE(1).EQ.'F'.OR.LINE(1).EQ.'f') THEN
  148. C F FILENAME ENTERS NEW DEFAULT DATA FILE NAME TO USE...
  149.         FNSZ=0
  150.         DO 1114 I=1,40
  151.         IF(LINE(I+2).LE.32)GOTO 1115
  152.         FNSZ=FNSZ+1
  153.         FNAME(FNSZ)=LINE(I+2)
  154. 1114    CONTINUE
  155. 1115    continue
  156.         IF(FNSZ.GT.0)FNAME(FNSZ+1)=32
  157.         GOTO 6
  158. c next: width control
  159.     Else If(line(1).eq.'1'.and.line(2).eq.'3'.and.
  160.      1  line(3).eq.'2') then
  161.         iwid=132
  162.         goto 6
  163.     Else if(line(1).eq.'8'.and.line(2).eq.'0')then
  164.         iwid=80
  165. c command '132' will set wide mode
  166. c command '80' sets narrower mode
  167.         goto 6
  168.     Else If(line(1).eq.'n'.or.line(1).eq.'N') then
  169.         rdspfg=1
  170. c reverse display flag so we hunt up free slots... note day, week, month
  171. c routines all get hacked on to do this...
  172.         do 1112 i=1,71
  173. 1112        line(i)=line(i+1)
  174. c reparse line after copying it down 1 character to remove the 'n'
  175.         goto 1111
  176.     Else If ( line(1) .eq. '?' ) then
  177.         call dhelp                
  178. c  WHAT? (instructions)
  179.         goto 6
  180.     Else If (Line(1).eq.'P'.or.line(1).eq.'p') then
  181.         call strip(line)
  182.         goto 6
  183.  
  184.     Else If(Line(1).eq.'L'.or.Line(1).eq.'l') then
  185. C FOR LOCATING FREE TIME, USE WEEK FUNCTION AND SCAN MAP
  186.         CTLFG=1
  187.         LINE(1)='W'
  188.         INCMOD=2
  189.         CALL WEEK(LINE)
  190.         GOTO 6
  191.     Else If (Line(1).eq.'o'.or.Line(1).eq.'O') then
  192.         Call outpt(Line)
  193.         Goto 6
  194.     ELSE IF (LINE(1).EQ.'T')THEN
  195.         LINE(1)='D'
  196.         INCMOD=1
  197.         CALL DAY(LINE)          
  198. c  TODAY'S MEMOS THEN EXIT
  199.         STOP
  200.     ELSE IF (LINE(1).EQ.'R')THEN
  201.         LINE(1)='W'
  202.         INCMOD=2
  203.         CALL WEEK(LINE)        
  204. c  REMIND ONE OF THIS WEEK
  205.         STOP
  206.     ELSE IF (LINE(1).EQ.'C')THEN    
  207. c  CALENDAR PRINT FOR MONTH
  208.         INCMOD=3
  209.         CALL MONTH(LINE)
  210.         STOP
  211.     Else If ( line(1) .eq. 'Q'.OR.line(1).eq.'q') then
  212.         STOP
  213. c  quit
  214.     Else If ( ( line(1) .eq. 'E' ) .and.
  215.      1       ( line(2) .eq. 'X' ) ) then
  216. C        CALL EXIT
  217.         stop                    
  218. c  exit
  219.     Else
  220.  
  221. c
  222. c    Now get a bit fancy:  ( play with the line string)
  223. c
  224.     IF((LINE(1).EQ.'e'.or.Line(1).eq.'E').and.
  225.      1  (line(2).eq.'v'.or.line(2).eq.'V')) GOTO 450
  226.  
  227.     Do 3 i=1,2
  228.         If ( ( line(i) .lt. '0' ) .or. ( line(i) .gt. '9' ) ) goto 5
  229. 3    Continue
  230. 450    continue
  231.     if(line(2).eq.'v'.or.line(2).eq.'V')line(2)=32
  232. c
  233. c    The first two characters are numbers, so put a D  at front of line
  234. c    and call the daily appointment subroutine:
  235.  
  236.     Do 4 i=70,1,-1
  237.         line(i+9) = line(i)
  238. 4    Continue
  239. C FILL IN DEFAULT DATE TOO. USE MMDDYY FORM FOR SIMPLICITY + TERSENESS.
  240.     WRITE(line84,225)idmo,iddy,idyr
  241. 225    format(2x,3i2)
  242.     line(1) = 'D'
  243.     line(2) = ' '
  244.     LINE(9)=' '
  245.     IF(LINE(3).EQ.' ')LINE(3)='0'
  246.     IF(LINE(5).EQ.' ')LINE(5)='0'
  247.     INCMOD=1
  248.     call day(line)
  249.     goto 6
  250.  
  251. 5    continue        
  252. c  Input was not two numbers (time of day)
  253.     End If
  254. c
  255. c    Evening appointment: (EV input line)
  256. c
  257. C NOTE THAT DAY ROUTINE RECOGNIZES E AS EVENING APPT AS A PSEUDO TIME TOO.
  258.  
  259. c    If ( ( line(1) .eq. 'E' ) .and. ( line(2) .eq. 'V' ) ) then
  260. c        line(1) = 'D'
  261. c        line(2) = ' '
  262. c        line(3) = 'E'
  263. c        INCMOD=1
  264. c        call day(line)
  265. c        goto 6
  266. c    End If
  267.  
  268. c
  269. c    Otherwise, the line was uninterpretable, so display menu:
  270. c
  271.  
  272.     call menu
  273.  
  274. 6    continue        
  275. c  GET A NEW LINE AND HOP BACK UP...
  276.  
  277.     read(0,7) line
  278. 7    format(84a1)
  279.  
  280.     goto 1
  281.     end
  282.  
  283.  
  284.