home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.lbl.gov / 2014.05.ftp.ee.lbl.gov.tar / ftp.ee.lbl.gov / mtrek.shar.Z / mtrek.shar / watch.ftt < prev    next >
Text File  |  1990-04-02  |  3KB  |  158 lines
  1.     PROGRAM WATCH
  2.  
  3.     INCLUDE 'LEDFORD.COM/-LI'
  4.  
  5.     INCLUDE 'COMMND.COM/-LI'
  6.  
  7.     INCLUDE 'BUFFER.COM/-LI'
  8.  
  9.     LOGICAL*1 OK,YES,WARN
  10.     BYTE OLDBUF(40,24),NEWBUF(40,24)
  11.     LOGICAL*1 RESET
  12.     BYTE TMP
  13.  
  14.     DATA OK/.FALSE./
  15.     DATA RESET/.TRUE./
  16.  
  17.     CALL ERRSET(24,,.FALSE.,,.FALSE.)
  18.     CALL ERRSET(39,,.FALSE.,,.FALSE.)
  19.     CALL ERRSET(64,,.FALSE.,.TRUE.,.FALSE.)
  20.  
  21.     CALL RDAST
  22.     I=INT(ZX)
  23.     J=INT(ZY)
  24. C
  25. C    **** TOP OF LOOP ****
  26. C
  27. 1000    CONTINUE
  28.     IF(CMD(1).NE.' ')GOTO 2000
  29.     RESET=.TRUE.
  30.     CALL CLEAR
  31.     ENCODE(35,100,IBUF)I,J
  32. 100    FORMAT('Current     X =',I3,'           Y =',I3)
  33.     CALL WRITE(10,20,IBUF,35)
  34.     CALL WRITE(12,28,'New X ? ')
  35.     CALL GETINT(K,OK,1,90)
  36.     IF(OK)I=K
  37.     CALL WRITE(12,45,'New Y ? ')
  38.     CALL GETINT(K,OK,1,90)
  39.     IF(OK)J=K
  40.     CMD(1)=0
  41.     GOTO 2500
  42. 2000    CONTINUE
  43.     I=INT(ZX)
  44.     J=INT(ZY)
  45.     CMD(1)=0
  46.     GOTO 2500
  47.  
  48. 2010    CONTINUE
  49.     IF((CMD(1).LT.'1').OR.(CMD(1).GT.'8'))GOTO 2100
  50.     I=INT(XCORD(CMD(1)-'0'))
  51.     J=INT(YCORD(CMD(1)-'0'))
  52.     CMD(1)=0
  53.     GOTO 2500
  54. 2100    CONTINUE
  55.     IF((CMD(1).EQ.'Q').OR.(CMD(1).EQ."32))GOTO 10200
  56. 2200    CONTINUE
  57.     IF(CMD(1).EQ.0)GOTO 2500
  58. C
  59. C    SHIFT DISPLAY ON COMMAND
  60. C
  61.     IF(CMD(1).EQ.0)GOTO 10132
  62.     IF(CMD(1).EQ.'R')GOTO 2010
  63.     IF(CMD(1).EQ.'U')GOTO 10XXX
  64.     IF(CMD(1).EQ.'D')GOTO 10XXX
  65.     IF(CMD(1).EQ.'L')GOTO 10XXX
  66.     IF(CMD(1).EQ.'R')GOTO 10XXX
  67.     IF(CMD(1).EQ.'C')GOTO 10XXX
  68.     IF(CMD(1).EQ.'F')GOTO 10XXX
  69.     IF(CMD(1).EQ."15)GOTO 10138
  70. ;
  71. ;    NOT A VALID COMMAND
  72. ;
  73.     CALL OUT(7,1)
  74.     GOTO 10138
  75. ;
  76. ;    RESET COMMAND
  77. ;
  78. 10137    RESET=.TRUE.
  79.     CALL CLREF(25)
  80.     GOTO 10021
  81.     IF(I.LT.1)I=I+100
  82.     IF(I.GT.100)I=I-100
  83.     IF(J.LT.1)J=J+100
  84.     IF(J.GT.100)J=J-100
  85.     CMD(1)=0
  86. C
  87. C    GENERATE NEW NEWBUF
  88. C
  89. 2500    CONTINUE
  90.     DO 10046 IX=1,40
  91.     DO 10049 IY=1,24
  92.     NEWBUF(IX,IY)=' '
  93. 10049    CONTINUE
  94. 10046    CONTINUE
  95.  
  96.     IXB=0
  97.     IXLEF=I-19
  98.     IXRIG=I+20
  99.     IYBOT=J-11
  100.     IYTOP=J+12
  101.  
  102.     DO 10052 IX=IXLEF,IXRIG
  103.     IXB=IXB+1
  104.     IOFF=IX
  105.     IF(IX.LT.1)IOFF=IX+100
  106.     IF(IX.GT.100)IOFF=IX-100
  107.     IYB=0
  108.     DO 10054 IY=IYTOP,IYBOT,-1
  109.     IYB=IYB+1
  110.     JOFF=IY
  111.     IF(IY.LT.1)JOFF=IY+100
  112.     IF(IY.GT.100)JOFF=IY-100
  113.     NEWBUF(IXB,IYB)=UNIV(IOFF,JOFF)
  114.     TMP=NEWBUF(IXB,IYB)
  115.     IF(((IX.EQ.1).OR.(IY.EQ.1)).AND.(TMP.EQ.'.'))NEWBUF(IXB,IYB)=' '
  116.     IF((TMP.LT.'1').OR.(TMP.GT.'8'))GOTO 10054
  117.     IF(CLOAK(TMP-'0'))NEWBUF(IXB,IYB)='~'
  118. 10054    CONTINUE
  119. 10052    CONTINUE
  120. C
  121. C    OUTPUT NEW DISPLAY
  122. C
  123.     IF(.NOT. RESET)GOTO 3000
  124.     CALL CLEAR
  125.     DO 10072 IY=1,24
  126.     ENCODE(80,10074,IBUF) (NEWBUF(IX,IY),IX=1,40)
  127. 10074    FORMAT(40(A1,1X))
  128.     CALL WRITE(IY,1,IBUF,80)
  129. 10072    CONTINUE
  130.     DO 6000 IY=1,24
  131.     DO 7000 IX=1,40
  132.     OLDBUF(IX,IY)=NEWBUF(IX,IY)
  133. 7000    CONTINUE
  134. 6000    CONTINUE
  135.     RESET=.FALSE.
  136. 3000    CONTINUE
  137.  
  138. C
  139. C    COMPARE AND UPDATE DISPLAY
  140. C
  141. 10098    CONTINUE
  142.     DO 10102 IY=1,24
  143.     DO 10104 IX=1,40
  144.     IF(NEWBUF(IX,IY).EQ.OLDBUF(IX,IY))GOTO 10104
  145.     CALL WRITE(IY,2*(IX-1)+1,NEWBUF(IX,IY),1)
  146.     OLDBUF(IX,IY)=NEWBUF(IX,IY)
  147. 10104    CONTINUE
  148. 10102    CONTINUE
  149.  
  150.     CALL MARK(24,60,1)
  151.     CALL CLREF(25)
  152.     CALL STLOR(24,25)
  153.     GOTO 1000
  154. 10200    CONTINUE
  155.     CALL WRITE(23,1,0)
  156.     CALL EXIT
  157.     END
  158.