
(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00001  
         
        ----------------------------------------
         
  00001       INTEGER LMODE,FMODE,TMODE,FDEL,BDEL,FFLG,HFLG,BUFI(1)
  00002      1,PLOT
  00002       BYTE BUF(2,80,48),BUFS(7680),NCHAR(4),ZERO(4),TBUF(80)
  00003       BYTE LNAME(30),RNAME(30),WNAME(30)
  00004       BYTE ENTER(2),LEAVE(2)
  00005       COMMON IGO,FDEL,BDEL,IFOR,IBAC,IFORD,IBACD
  00006       EQUIVALENCE (BUF(1,1,1),BUFS(1))
  00007       EQUIVALENCE (BUFS(1),BUFI(1))
  00008       DATA ZERO/0,0,0,0/,IFORD,IBACD/7,"70/
  00009       DATA ENTER/2,254/,LEAVE/255,0/
  00010       CALL KBINIT(,,1)
  00011       CALL WDFUIC("300,"324)
  00012       IFILE=0
  00013       IHELP=1
  00014       IESC=.FALSE.
  00015       IGOT=.FALSE.  !DON'T KNOW LAST CHAR
  00016       NUM=0
  00017       IYC=4   !CURRENT Y POS'N
  00018       IXC=1   !   "    X  "
  00019       IXS=IXC
  00020       IYS=IYC
  00021       IPOS=.TRUE.  !WE KNOW CURRENT POS'N
  00022       ISTATC="007
  00023       IFOR=7
  00024       IBAC="00
  00025       IFORD=0
  00026       IBACD=0-1
  00027       HFLG=.TRUE.  !HORIZONTAL TEXT MODE
  00028       FFLG=.TRUE.  !FORGROUND(FG) FLAG
  00029       LMODE=.TRUE.  !LINE MODE
  00030       FMODE=.FALSE.  !FILL MODE
  00031       TMODE=.FALSE.  !TEXT MODE
  00032       SMODE=.FALSE.  !SCROLL MODE
  00033       FDEL=.TRUE.  !FOREGROUND (FG) DELETE
  00034       BDEL=.FALSE.  !BACKGROUND (BG) DELETE
  00035       IHEAD=.FALSE.
  00036 1     DO (I=1,7680,2)
  00037       .    BUFS(I)="40
  00038       .    BUFS(I+1)="7
  00039       ...FIN
  00040       CALL INIT  !CLEAR AND INIT ISC
  00041       GOTO 3000  !BRANCH TO HELP FILE AND RETURN
  00042 6     WHEN(IHEAD)
  00043       .  RESTORE-TOP-3-LINES
  00045       ...FIN
  00046       ELSE
  00046 7     .  IHEAD=.TRUE.
  00048       .  GET-CURSOR-POS
  00050       .  IF(.NOT.HFLG)CALL ANGLE(2)
  00051       .  CALL HOME
  00052       .  CALL SSTAT(7)
  00053       .  CALL CLRLIN  !CLEAR TOP LINE
  00054       .  CALL APOSV(8,1)
  00055       .  IF(TMODE)CALL KBWR(8,'***TEXT')
  00056       .  IF(LMODE)CALL KBWR(8,'***LINE')
  00057       .  IF(FMODE)CALL KBWR(8,'***FILL')
  00058       .  IF(SMODE)CALL KBWR(9,'***SCROLL')
  00059       .  CALL KBWR(8,' MODE***')
  00060       .  CALL APOSV(43,1)

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00002  
  00061       .  CALL KBWR(29,'FLAG  COLOR  OVERLAY  DELETE')
  00062       .  CALL CLRNXT  !CLR NEXT LINE
  00063       .  CALL APOSV(32,2)
  00064       .  CALL KBWRW(10,'BACKGROUND')
  00065       .  IF(.NOT.FFLG)
  00066       .  .  CALL APOSV(44,2)  !FLAG POINTS TO BG
  00067       .  .  CALL KBWR(1,'*')
  00068       .  ...FIN
  00068       .  CALL APOSV(51,2)  !POS'N FOR BG COLOR
  00069       .  CALL SSTAT(IBAC)
  00070       .  CALL KBWR(1,' ')  !DISPLAY BG COLOR
  00071       .  CALL APOSV(56,2)  !POS'N FOR DOMINANT STATUS
  00072       .  CALL SSTAT(7)
  00073       .  IF(BDEL)CALL KBWR(3,'YES')
  00074       .  IF(.NOT.BDEL)CALL KBWR(2,'NO')
  00075       .  CALL APOSV(65,2)  !POS'N FOR DELETE STATUS OR COLOR
  00076       .  CONDITIONAL
  00076       .  .  (BDEL)CALL KBWR(3,'ALL')
  00078       .  .  (IBACD.LT.0)CALL KBWR(3,'NIL')  !NO DELETEABLE BG COLOR
  00081       .  .  (OTHERWISE)
  00082       .  .  .  CALL SSTAT(IBACD)  !SHOW BG COLOR WHICH WILL ALWAYS
  00083       .  .  .  CALL KBWR(1,' ')  !BE OVER WRITTEN
  00084       .  .  .  CALL SSTAT(7)
  00085       .  .  ...FIN
  00085       .  ...FIN
  00085       .  CALL CLRNXT   !CLR NEXT LINE
  00086       .  IF(TMODE)
  00087       .  .  CALL APOSV(11,3)
  00088       .  .  IF(HFLG)CALL KBWR(10,'HORIZONTAL')
  00089       .  .  IF(.NOT.HFLG)CALL KBWR(8,'VERTICAL')
  00090       .  ...FIN
  00090       .  CALL APOSV(32,3)
  00091       .  CALL KBWR(10,'FOREGROUND')
  00092       .  IF(FFLG)
  00093       .  .  CALL APOSV(44,3)  !SHOW FLAG POINTING AT BG
  00094       .  .  CALL KBWR(1,'*')
  00095       .  ...FIN
  00095       .  CALL APOSV(51,3)  !POS'N FOR FG COLOR
  00096       .  IFA=IFOR*"10
  00097       .  CALL SSTAT(IFA)
  00098       .  CALL KBWRW(1,' ')  !SHOW FG COLOUR
  00099       .  CALL SSTAT(7)
  00100       .  CALL APOSV(56,3)  !POS'N FOR FG DOMINANT STATUS
  00101       .  IF(.NOT.FDEL)CALL KBWR(2,'NO') !SHOW FG DOMINANT STATUS
  00102       .  IF(FDEL)CALL KBWR(3,'YES')
  00103       .  CALL APOSV(65,3)  !POS'N FOR FG DELETE STATUS
  00104       .  CONDITIONAL
  00104       .  .  (FDEL)CALL KBWR(3,'ALL')
  00106       .  .  (IFORD.LT.0)CALL KBWR(3,'NIL')
  00109       .  .  (OTHERWISE)
  00110       .  .  .  IFA=IFORD*"10
  00111       .  .  .  CALL SSTAT(IFA)
  00112       .  .  .  CALL KBWRW(1,' ')  !SHOW FG DELETE COLOUR
  00113       .  .  ...FIN
  00113       .  ...FIN
  00113       ...FIN
  00114       CALL APOSV(IXC,IYC)
  00115       J2=ISTATC
  00116       J2OLD=-1  !FORCE NEW STATUS
  00117       WRITE-STATUS
  00119 85    IF(.NOT.HFLG)CALL ANGLE(4)
        C       

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00003  
  00121 100   IESC=.FALSE.
  00122 105   GET-NEXT-CHAR
  00124       IGOT=.FALSE.
  00125       IF(I.EQ.1)GOTO 2500 !WE EXIT
  00126       IF(I.EQ.3)GOTO 2500 !WE EXIT
  00127       IF(I.LT.7)GOTO 100 !IGNORE THESE CHAR.
  00128       IF(I.EQ.8)GOTO 125 !HOME
  00129       IF(I.LT.11)GOTO 130 !GO ECHO TAB(9), LF(10)
  00130       IF(I.EQ.13)GOTO 140 !ECHO CR
  00131       IF(I.EQ.25)GOTO 130 !CUR RIGHT
  00132       IF(I.EQ.26)GOTO 130 !CUR LEFT
  00133       IF(I.EQ.28)GOTO 130 !CUR UP
  00134       IF(I.LT.16)GOTO 100 !IGNORE
  00135       IF(I.LE.23)GOTO 150 !COLOUR
  00136       IF(I.EQ.27)GOTO 190 !ESC SPECIAL CHARACTER
  00137       IF(I.LT.29)GOTO 100
  00138       IF(I.EQ.29)GOTO 160 !FG ON
  00139       IF(I.EQ.30)GOTO 170 !BG ON
  00140       IF(I.EQ.31)GOTO 100 !BLINK MODE
  00141       IF(IESC)GOTO 120
  00142       IF(TMODE)GOTO 500
  00143 120   IF((I.GE."60).AND.(I.LE."71))GOTO 290 !NUMBER
  00144       NUM=0
  00145       IF(I.EQ."110)GOTO 3005  !H HELP
  00146       IF(I.EQ."115)GOTO 2000 !M SHOW WHOLE SCREEN
  00147       IF(I.EQ."104)GOTO 210 !D SET DELET COLOR
  00148       IF(I.EQ."106)GOTO 230 !F FILL
  00149       IF(I.EQ."124)GOTO 240 !T TEXT
  00150       IF(I.EQ."114)GOTO 250 !L LINE
  00151       IF(I.EQ."130)GOTO 225 !Z SCROLL MODE
  00152       IF(I.EQ."117)GOTO 260 !O OVERLAY STATUS
  00153       IF(I.EQ."126)GOTO 280 !V HORIZONTAT/VERTICAL
  00154       IF(I.EQ."122)GOTO 300 !R READ
  00155       IF(I.EQ."127)GOTO 310 !W WRITE
  00156       IF(I.EQ."103)GOTO 320 !C CLOSE
  00157       IF(I.EQ."120)GOTO 330 !P PAGE
  00158       IF(I.EQ."131)GOTO 340 !Y ANK
  00159       IF(I.EQ."125)GOTO 350 !U OUTPUT PAGE
  00160       IF(I.EQ."123)GOTO 1000 !S TART
  00161       IF(I.EQ."105)GOTO 1010 !E END
  00162       GOTO 3000
        C       
  00163 125   IF(NUM.EQ.0)GOTO 130 !HOME
  00164       IX=NUM/100
  00165       IY=NUM-(IX*100)
  00166       IF(IX.GT.81)IX=80
  00167       IF(IX.EQ.0)IX=IXC
  00168       IF(IY.GT.48)IY=48
  00169       IF(IY.EQ.0)IY=IYC
  00170       IXC=IX
  00171       IYC=IY
  00172 128   CALL APOSV(IXC,IYC)
  00173       IPOS=.TRUE.
  00174       GOTO 146
  00175 130   IF(NUM.EQ.0)NUM=1 !CURSER MOVEMENTS
  00176       IF(SMODE)GOTO 360 !GO FOR SCROL MODE
        C JUST ECHO MOVE CHAR.
  00177       DO(J=1,NUM)CALL KBWR(1,I)
  00180       GOTO 145
  00181 140   CALL CRLF
  00182 145   IPOS=.FALSE.  !WE NO LONGER KNOW POS'N
  00183 146   NUM=0   !CLEAR MOVEMENT COUNTER

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00004  
  00184       GOTO 100  !AND GO READ NEXT CHARCTER
        C     COLOR CHANGE
  00185 150   I=I.AND.7  !GET RID OF EXTRA BITS
  00186       IF(.NOT.FFLG)I=I*"10 !SHIFT BITS FOR BG
  00187       IF(.NOT.FFLG)ISTATC=ISTATC.AND."307.OR.I
  00188       IF(FFLG)ISTATC=ISTATC.AND."370.OR.I
  00189       IFOR=ISTATC.AND."7
  00190       IBAC=ISTATC.AND."70
  00191       GOTO 7
        C       
  00192 160   FFLG=.TRUE.  !FLAG SET TO FG
  00193       GOTO 172
  00194 170   FFLG=.FALSE.  !FLAG SET TO BG
  00195 172   GET-NEXT-CHAR
  00197       IF((I.GE."120).AND.(I.LE."127))GOTO 150 !COLOR
  00198       IGOT=.TRUE.
  00199       GOTO 7
        C       
  00200 190   NUM=0
  00201       IF(IESC)GOTO 6
  00202       IESC=.TRUE.
  00203       GOTO 105
        C       
  00204 210   GET-NEXT-CHAR
  00206       IF((I.GE."120).AND.(I.LE."127))GOTO 220 !COLOR
  00207         IGOT=.TRUE.
  00208         IF(.NOT.FFLG)IBACD=-IBACD-1
  00209         IF(FFLG)IFORD=-IFORD-1
  00210         GOTO 7
  00211 220   I=I.AND.7
  00212       IF(FFLG)IFORD=I
  00213       IF(.NOT.FFLG)IBACD=I*"10
  00214       GOTO 7
  00215 225   SMODE=.TRUE.  !SCROLL MODE
  00216       FMODE=.FALSE.
  00217       GOTO 235
  00218 230   IF(FMODE)GOTO 1100 !GO FILL IN SQUARE
  00219       FMODE=.TRUE.  !FILL MODE
  00220       SMODE=.FALSE.
  00221 235   TMODE=.FALSE.
  00222       BDEL=.TRUE.
  00223       FDEL=.FALSE.
  00224       FFLG=.FALSE.
  00225       LMODE=.FALSE.
  00226       IF(IBACD.LT.0)IBACD=-IBACD-1
  00227       GOTO 255
  00228 240   TMODE=.TRUE.  !TEXT MODE
  00229       FMODE=.FALSE.
  00230       SMODE=.FALSE.
  00231       BDEL=.FALSE.
  00232       FDEL=.TRUE.
  00233       FFLG=.TRUE.
  00234       LMODE=.FALSE.
  00235       HFLG=.TRUE.
  00236       IF(IBACD.LT.0)IBACD=-IBACD-1
  00237       GOTO 285
        C       
  00238 250   LMODE=.TRUE.  !LINE MODE
  00239       FMODE=.FALSE.
  00240       SMODE=.FALSE.
  00241       TMODE=.FALSE.
  00242       BDEL=.FALSE.

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00005  
  00243       FDEL=.TRUE.
  00244       FFLG=.TRUE.
  00245       IF(IBACD.GE.0)IBACD=-IBACD-1
  00246 255   HFLG=.TRUE.
  00247       GOTO 285
        C       
  00248 260   IF(FFLG)FDEL=.NOT.FDEL !FG DOMINANT SWITCH
  00249       IF(.NOT.FFLG)BDEL=.NOT.BDEL !BG DOMINENT SWITCH
  00250       GOTO 7
        C       
  00251 280   IF(.NOT.TMODE)GOTO 3000
  00252       HFLG=.NOT.HFLG   !VERTICAL/HORIZONTAL
  00253 285   IF(HFLG)CALL ANGLE(2)
  00254       IF(.NOT.HFLG)CALL ANGLE(4)
  00255       GOTO 7
        C       
  00256 290   I=I.AND."17   !CREATE NUMBER
  00257       IF(NUM.GT.3760)NUM=NUM-3760
  00258       NUM=NUM*10+I
  00259       GOTO 105
        C       
  00260 300   CALL CLRTOP
  00261       IF((IFILE.AND.1).NE.0)CALL CLMES(2,RNAME,-1) !READ
  00262       IFILE=IFILE.AND.2  !SHOW ITS CLOSED
  00263       LUN=2
  00264       GOTO 3500
        C       
  00265 310   CALL CLRTOP
  00266       LUN=3
  00267       IF((IFILE.AND.2).EQ.0)GOTO 3500
  00268       I=IRESP('DO YOU WANT TO SAVE YOUR OUTPUT FILE? ')
  00269       IF(I.GT.0)GOTO 85  !^Z IGNORE WRITE REQUEST
  00270       CALL CLMES(3,WNAME,I)
  00271       IFILE=IFILE.AND.1  !SHOW ITS CLOSED
  00272       GOTO 3500
        C       
  00273 320   CALL CLRTOP
  00274       IF((IFILE.AND.1).NE.0)CALL CLMES(2,RNAME,-1) !CLOSE
  00275       IF((IFILE.AND.2).NE.0)CALL CLMES(3,WNAME,-1)
  00276       IF(IFILE.EQ.0)CALL CLMES(0)
  00277       IF(IFILE.EQ.0)GOTO 3000   !GO SEE IF HE NEEDS HELP
  00278       IFILE=0
  00279       GOTO 85
        C       
  00280 330   CALL CLRTOP
  00281       IF(IFILE.EQ.3)GOTO 3600
  00282       IF((IFILE.AND.1).EQ.0)CALL PRINTW(' NO FILE TO READ')
  00283       IF((IFILE.AND.2).EQ.0)CALL PRINTW(' NO FILE TO WRITE')
  00284       GOTO 3000
  00285 340   CALL CLRTOP
  00286       IF((IFILE.AND.1).NE.0)GOTO 3635
  00287       CALL PRINTW(' NO FILE TO READ')
  00288       GOTO 3000
  00289 350   CALL CLRTOP
  00290       IF((IFILE.AND.2).NE.0)GOTO 355
  00291       CALL PRINTW(' NO FILE TO WRITE')
  00292       GOTO 3000
  00293 355   IF(IWRITW(BUFI,7680,3).LT.0)GOTO 3670
  00294       CALL PRINTW('$I HAVE WRITTEN TO ')
  00295       CALL PRINTW(0,WNAME)
  00296       GOTO 85
  00297 360   GET-CURSOR-POS

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00006  
  00299       RESTORE-TOP-3-LINES
  00301       CALL HOME
  00302       CALL KBWR(4,ZERO)
  00303       CALL KBWR(4,ZERO)
  00304       IF(NUM.GT.40)NUM=40
  00305       NCHAR(1)=27
  00306       NCHAR(4)=27
  00307       J1="40
  00308       J2=ISTATC.AND."77
  00309       WRITE-STATUS
  00311       IF(I.EQ.26)
        C     .  CURSER LEFT
  00312       .  ITO=79
  00313       .  IFR=1
  00314       .  INC=1
  00315       .  NCHAR(3)=127
  00316       ...FIN
  00316       IF(I.EQ.25)
        C     .  CURSER RIGHT
  00317       .  ITO=2
  00318       .  IFR=80
  00319       .  INC=-1
  00320       .  NCHAR(3)=J1
  00321       ...FIN
  00321       IF(I.EQ.28)
        C     .  CURSER UP
  00322       .  ITO=47
  00323       .  IFR=1
  00324       .  INC=1
  00325       .  NCHAR(2)="126
  00326       ...FIN
  00326       IF(I.EQ.10)
        C     .  CURSER DOWN
  00327       .  ITO=2
  00328       .  IFR=48
  00329       .  INC=-1
  00330       .  NCHAR(2)="125
  00331       ...FIN
  00331       IF((I.EQ.28).OR.(I.EQ.10))
        C     .  UP OR DOWN
  00332       .  DO(J=1,NUM)
  00333       .  .  CALL KBWRW(2,NCHAR)
  00334       .  .  CALL KBWRW(4,ZERO)
  00335       .  .  CALL KBWRW(4,ZERO)
  00336       .  .  DO(IY=IFR,ITO,INC)
  00337       .  .  .  DO(IX=1,80)
  00338       .  .  .  .  BUF(1,IX,IY)=BUF(1,IX,IY+INC)
  00339       .  .  .  .  BUF(2,IX,IY)=BUF(2,IX,IY+INC)
  00340       .  .  .  ...FIN
  00341       .  .  ...FIN
  00342       .  .  DO(IX=1,80)
  00343       .  .  .  BUF(1,IX,ITO+INC)=J1
  00344       .  .  .  BUF(2,IX,ITO+INC)=J2
  00345       .  .  ...FIN
  00346       .  ...FIN
  00347       ...FIN
  00347       IF((I.EQ.25).OR.(I.EQ.26))
        C     .  RIGHT OR LEFT
  00348       .  NCHAR(2)=17
  00349       .  CALL KBWRW(2,NCHAR) !ENTER INSERT MODE
  00350       .  CALL KBWR(4,ZERO)
  00351       .  CALL KBWR(4,ZERO)

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00007  
  00352       .  DO(J=1,NUM)
  00353       .  .  DO(IY=1,48)
  00354       .  .  .  CALL KBWRW(1,NCHAR(3)) !DELETE OR INSERT
  00355       .  .  .  CALL KBWRW(4,ZERO)
  00356       .  .  .  CALL CRLF
  00357       .  .  .  DO(IX=IFR,ITO,INC)
  00358       .  .  .  .  BUF(1,IX,IY)=BUF(1,IX+INC,IY)
  00359       .  .  .  .  BUF(2,IX,IY)=BUF(2,IX+INC,IY)
  00360       .  .  .  ...FIN
  00361       .  .  .  BUF(1,ITO+INC,IY)=J1
  00362       .  .  .  BUF(2,ITO+INC,IY)=J2
  00363       .  .  ...FIN
  00364       .  ...FIN
  00365       .  CALL KBWRW(1,27) !LEAVE INSERT MODE
  00366       ...FIN
  00366       GOTO 128
        C       
        C TEXT MODE
  00367 500   GET-CURSOR-POS
  00369 510   J1=I
  00371       J2=BUF(2,IXC,IYC).AND."77 !GET CURRENT COLORS
  00372       GET-NEW-STATUS-AND-CHAR
  00374       WRITE-STATUS-AND-CHAR
  00376       BUF(1,IXC,IYC)=J1
  00377       BUF(2,IXC,IYC)=J2
  00378       IF(.NOT.HFLG)GOTO 530 !GO FOR VERTICAL
  00379       IF(IXC.GE.80)GOTO 145
  00380         IXC=IXC+1
  00381         GOTO 100
  00382 530   IF(IYC.GE.48)GOTO 145
  00383       IYC=IYC+1
  00384       GOTO 100
        C       
        C LINE AND FILL MODE
  00385 1000  CALL GPOS(IXS,IYS) !GET START POS'N
  00386       GOTO 100
  00387 1010  CALL GPOS(IXE,IYE) !GET END POS'N
  00388       IYES=IYE  !SAVE CURRENT POS'N
  00389       IXES=IXE
  00390       IXC=IXE
  00391       IYC=IYE
  00392       IF(IXS.LE.IXE)GOTO 1020 !SORT OUT SMALLEST X & Y
  00393         IXE=IXS
  00394         IXS=IXES
  00395 1020  IF(IYS.LE.IYE)GOTO 1030
  00396         IYE=IYS
  00397         IYS=IYES
  00398 1030  IF(.NOT.FMODE)GOTO 1500
  00399       GOTO 1200
        C       
        C FIND BOUNDRIES FOR FILL
  00400 1100  GET-CURSOR-POS
  00402       DO 1120 IXS=IXC,1,-1
  00403         IF((BUF(2,IXS,IYC).AND."200).NE.0)GOTO 1125
  00404 1120  CONTINUE
  00405       IXS=1
  00406 1125  DO 1130 IXE=IXC,80
  00407         IF((BUF(2,IXE,IYC).AND."200).NE.0)GOTO 1135
  00408 1130  CONTINUE
  00409       IXE=80
  00410 1135  DO 1140 IYS=IYC,1,-1
  00411         IF((BUF(2,IXC,IYS).AND."200).NE.0)GOTO 1145

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00008  
  00412 1140  CONTINUE
  00413       IYS=1
  00414 1145  DO 1150 IYE=IYC,48
  00415         IF((BUF(2,IXC,IYE).AND."200).NE.0)GOTO 1155
  00416 1150  CONTINUE
  00417       IYE=48
  00418 1155  IF(IXE.LT.80)IXE=IXE-1
  00419       IF(IYE.LT.48)IYE=IYE-1
        C       
        C FILL MODE
  00420 1200  IPOS=.FALSE.
  00421       DO(IY=IYS,IYE)
  00422       .  DO(IX=IXS,IXE)
  00423       .  .  J1=BUF(1,IX,IY)
  00424       .  .  J2=BUF(2,IX,IY)
  00425       .  .  JJ1=J1
  00426       .  .  JJ2=J2
  00427       .  .  GET-NEW-STATUS-AND-CHAR
  00429       .  .  WHEN((JJ1.NE.J1).OR.(JJ2.NE.J2))
  00430       .  .  .  POSITION-CURSER
  00432       .  .  .  WRITE-STATUS-AND-CHAR
  00434       .  .  .  BUF(2,IX,IY)=J2
  00435       .  .  .  BUF(1,IX,IY)=J1
  00436       .  .  .  IF(IX.EQ.IXE)IPOS=.FALSE.
  00437       .  .  ...FIN
  00438       .  .  ELSE IPOS=.FALSE.
  00439       .  ...FIN
  00441       ...FIN
  00442 1260  IPOS=.FALSE.
  00443       IXS=IXES
  00444       IYS=IYES
  00445       IX=IXC
  00446       IY=IYC
  00447       POSITION-CURSER
  00449       GOTO 100
        C       
        C LINE MODE
  00450 1500  IF(IXS.EQ.IXE)GOTO 1555
  00451       CALL ANGLE(2)
  00452       INC=IYE-IYS
  00453       IF(INC.EQ.0)INC=1
  00454       N1="21
  00455       N2=1
  00456       DO 1550 IY=IYS,IYE,INC
  00457         CALL APOSV(IXS,IY)
  00458         IF(IY.EQ.48)N1="210
  00459         IF(IY.EQ.48)N2="10
  00460         DO 1540 IX=IXS,IXE
  00461            J1=BUF(1,IX,IY)
  00462            J2=BUF(2,IX,IY)
  00463            IF((J2.AND."200).NE.0)GOTO 1520
  00464               J1=0
  00465               J2=J2.OR."200
  00466 1520       J1=J1.OR.N2
  00467            IF(IX.NE.IXE)J1=J1.OR.N1
  00468            IF(IX.EQ.80)J1=J1.OR.N1
  00469       GET-NEW-STATUS-AND-CHAR
  00471       WRITE-STATUS-AND-CHAR
  00473            BUF(1,IX,IY)=J1
  00474            BUF(2,IX,IY)=J2
  00475 1540    CONTINUE
  00476       IF(PLOT)CALL KBWRW(1,LEAVE)

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00009  
  00477       PLOT=.FALSE.
  00478 1550  CONTINUE
  00479 1555  IF(IYS.EQ.IYE)GOTO 1260
  00480       CALL ANGLE(4)
  00481       INC=IXE-IXS
  00482       IF(INC.EQ.0)INC=1
  00483       N1="17
  00484       N2="1
  00485       DO 1590 IX=IXS,IXE,INC
  00486         IF(IX.EQ.80)N1="360
  00487         IF(IX.EQ.80)N2="20
  00488         CALL APOSV(IX,IYS)
  00489         DO 1570 IY=IYS,IYE
  00490            J1=BUF(1,IX,IY)
  00491            J2=BUF(2,IX,IY)
  00492            IF((J2.AND."200).NE.0)GOTO 1560
  00493               J1=0
  00494               J2=J2.OR."200
  00495 1560       J1=J1.OR.N2
  00496            IF(IY.NE.IYE)J1=J1.OR.N1
  00497            IF(IY.EQ.48)J1=J1.OR.N1
  00498       GET-NEW-STATUS-AND-CHAR
  00500       WRITE-STATUS-AND-CHAR
  00502            BUF(1,IX,IY)=J1
  00503            BUF(2,IX,IY)=J2
  00504 1570    CONTINUE
  00505       IF(PLOT)CALL KBWRW(1,LEAVE)
  00506       PLOT=.FALSE.
  00507 1590  CONTINUE
  00508       CALL ANGLE(2)
  00509       GOTO 1260
        C       
  00510 2000  GET-CURSOR-POS
  00512 2005  CALL INIT
  00514       NCHAR(1)=27
  00515       NCHAR(2)=29
  00516       CALL KBWR(2,NCHAR) !PUT ISC IN BLOCK RECEIVE MODE
  00517       DO 2010 I=1,7680,160
  00518         CALL KBWRW(160,BUFS(I)) !FILL ISC MEMORY
  00519 2010  CONTINUE
  00520       NCHAR(1)="377
  00521       NCHAR(2)=0
  00522       CALL KBWRW(2,NCHAR) !TERMINATE BLOCK RECEIVE MODE
  00523       J1=BUF(1,1,1)
  00524       J2=BUF(2,1,1)
  00525       J2OLD=-1  !FORCE STATUS OUTPUT
        C     CALL HOME
  00526       WRITE-STATUS-AND-CHAR
  00528       IF(PLOT)CALL KBWRW(1,LEAVE)
  00529       PLOT=.FALSE.
  00530       IF(IPOS)CALL APOSV(IXC,IYC) !RETURN TO SAVED POS'N
  00531       IF(.NOT.IPOS)CALL APOSV(81,48)
  00532       IHEAD=.FALSE.  !NO HEADING
  00533       GOTO 100
        C       
        C EXIT FROM PROGRAM
  00534 2500  IF((IFILE.AND.2).EQ.0)GOTO 2520 !EXIT IF NO OUTPUT FILE OPEN
  00535       CALL CLRTOP
  00536       I=IRESP('DO YOU WANT TO SAVE YOUR OUTPUT FILE? ')
  00537       IF(I.GT.0)GOTO 85  !^Z IGNORE CLOSE COMMAND
  00538       CALL CLMES(3,WNAME,I)
  00539 2520  CALL ANGLE(2)

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00010  
  00540       CALL KBWRW(1,27)
  00541       CALL KBWRW(1,11) !SET ROLL UP
  00542       CALL SSTAT("47)
  00543       CALL APOSV(1,47)
  00544       CALL EXIT
        C       
        C HELP FUNCTION
  00545 3000  IHELP=IHELP-1
  00546       IF(IHELP.GT.0)GOTO 100
  00547 3005  IHELP=6
  00548       CALL SSTAT(7)
  00549       GET-CURSOR-POS
  00551       CALL CLRTOP
  00552       IF(.NOT.IRESP('DO YOU NEED HELP? '))GOTO 7
  00553 3010  CALL ASSIGN(1,'ISC.DOC')
  00554       CALL SSTAT("47)
  00555       CALL HOME
  00556       CALL KBWR(1,27)
  00557       CALL KBWR(1,11)
  00558       CALL CLRLIN
  00559 3009  FORMAT(Q,80A1)
  00560 3020  READ(1,3009,END=3050)N,(TBUF(I),I=1,N)
  00561       CALL KBWR(N,TBUF)
  00562       CALL CLRNXT
  00563       GOTO 3020
  00564 3050  CALL CLOSE(1)
  00565       CALL KBWR(1,27)
  00566       CALL KBWR(1,24)
  00567       CALL KBRDW(1,I)
  00568       IPOS=.FALSE.
  00569       GOTO 7
        C       
        C READ OR WRITE
  00570 3500  CALL CLR2  !CLEAR NEXT TWO LINES
  00571       CALL PRINTW('$FILENAME? < ')
  00572       CALL PRINTW(0,LNAME)
  00573       CALL PRINTW(0,' >')
  00574       J=LNAME(1)
  00575       N=NS
  00576       READ (5,3009,END=7)NS,(LNAME(I),I=1,NS)
  00577       LNAME(NS+1)=0
  00578       IF(NS.GT.0)GOTO 3510   !GO IF WE GOT A FILE NAME
  00579       IF(N.EQ.0)GOTO 3000  !WE NEVER HAD A NAME
  00580         LNAME(1)=J   !RESTORE LAST NAME
  00581         NS=N
  00582 3510  IF(LUN.EQ.3)GOTO 3550  !GO FOR WRITE
  00583       DO 3520 I=1,NS   !SAVE READ NAME
  00584         RNAME(I)=LNAME(I)
  00585 3520  CONTINUE
  00586       RNAME(NS+1)=0   !TERMINATOR
  00587       NR=NS    !AND # OF CHARACTERS
  00588 3540  IF(IOPENR(RNAME,NR,2,'.PIC').LT.0)GOTO 3500
  00589       IFILE=IFILE.OR.1
  00590       IF((IFILE.AND.2).EQ.0)GOTO 3635
  00591       CALL PRINTW(' I AM NOT UPDATING YOUR SCREEN AUTOMATICALY')
  00592       CALL PRINTW(' BECAUSE YOU HAVE A FILE OPEN FOR OUTPUT')
  00593       GOTO 85
        C       
  00594 3550  CONTINUE   !HERE FOR WRITE
  00595       DO 3560 I=1,NS   !SAVE NAME
  00596         WNAME(I)=LNAME(I)
  00597 3560  CONTINUE

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00011  
  00598       WNAME(NS+1)=0
  00599       NW=NS
  00600       IF(IOPENW(WNAME,NW,3,'.PIC').LT.0)GOTO 3500
  00601       IFILE=IFILE.OR.2
  00602       GOTO 85
  00603 3600  IF(IWRITW(BUFI,7680,3).LT.0)GOTO 3670
  00604       CALL PRINTW('$I HAVE WRITTEN TO ')
  00605       CALL PRINTW(0,WNAME)
  00606 3635  IF(IREADW(BUFI,7680,2).LT.0)GOTO 3660
  00607       IPOS=.FALSE.
  00608       GOTO 2005
        C READ ERROR OR END OF FILE
  00609 3660  IFILE=IFILE.AND.2
  00610       CALL CLMES(2,RNAME,-1)
  00611       GOTO 85
  00612 3670  IFILE=IFILE.AND.1
  00613       CALL CLMES(3,WNAME,-1)
  00614       GOTO 85
  00615  
         
        ----------------------------------------
         
  00615       TO GET-CURSOR-POS
  00616       .  UNLESS(IPOS)CALL GPOS(IXC,IYC)
  00617       .  IPOS=.TRUE.
  00618       ...FIN
         
        ----------------------------------------
         
  00619       TO GET-NEXT-CHAR
  00620       .  UNLESS(IGOT)
  00621       .  .  I=ICHAR()
  00622       .  .  IF(I.LT.0)
  00623       .  .  .  CALL KBRDW(1,NCHAR(1))
  00624       .  .  .  I=NCHAR(1)
  00625       .  .  ...FIN
  00625       .  .  IF(I.GT."141)I=I.AND."137
  00626       .  ...FIN
  00626       ...FIN
         
        ----------------------------------------
         
  00627       TO GET-NEW-STATUS-AND-CHAR
        C     .  COMPARES ISTAT TO CURRENT DOMINATE FG AND BG COLORS
        C     .  AND CHANGES IT ACCORDINGLY
        C     .  IT THEN MAKES SURE TERMINAL SET TO CORRECT STATUS
        C     .  AND OUTPUTS CHARACTER IN PLOT OR NORMAL MODE
  00628       .  I=J2.AND.7  !NEW FG COLOR
  00629       .  IF(I.EQ.IFORD.OR.FDEL)
        C     .  .  CHANGE FG COLOR
  00630       .  .  J2=(J2.AND."370).OR.IFOR
  00631       .  ...FIN
  00631       .  I=J2.AND."70  !NEW BG COLOR
  00632       .  IF(I.EQ.IBACD.OR.BDEL)
        C     .  .  CHANGE BG COLOR
  00633       .  .  J2=(J2.AND."307).OR.IBAC
  00634       .  ...FIN
  00634       .  IF(.NOT.TMODE)
  00635       .  .  I1=J2.AND.7  !FG
  00636       .  .  I2=(J2.AND."70)/"10 !BG
  00637       .  .  WHEN(I1.EQ.I2)
  00638       .  .  .  J2=J2.AND."77

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00012  
  00639       .  .  .  J1="40
  00640       .  .  ...FIN
  00641       .  .  ELSE
  00641       .  .  .  IF((I1.EQ."40).AND.((J2.AND."200).EQ.0))
  00642       .  .  .  .  J2=(J2.AND."70).OR.I2
  00643       .  .  .  ...FIN
  00643       .  .  ...FIN
  00644       .  ...FIN
  00645       ...FIN
         
        ----------------------------------------
         
  00646       TO RESTORE-TOP-3-LINES
  00647       .  IF(IHEAD)
  00648       .  .  IHEAD=.FALSE.
  00649       .  .  GET-CURSOR-POS
  00651       .  .  CALL HOME
  00652       .  .  DO(J=1,480,2)
  00653       .  .  .  J1=BUFS(J)
  00654       .  .  .  J2=BUFS(J+1)
  00655       .  .  .  WRITE-STATUS-AND-CHAR
  00657       .  .  ...FIN
  00659       .  ...FIN
  00659       ...FIN
         
        ----------------------------------------
         
  00660       TO WRITE-STATUS-AND-CHAR
  00661       .  WRITE-STATUS
  00663       .  WRITE-CHAR
  00665       ...FIN
         
        ----------------------------------------
         
  00666       TO WRITE-STATUS
  00667       .  IF(J2OLD.NE.J2)
  00668       .  .  IF(PLOT)
  00669       .  .  .  CALL KBWRW(1,LEAVE) !LEAVE PLOT MODE
  00670       .  .  .  PLOT=.FALSE.
  00671       .  .  ...FIN
  00671       .  .  CALL SSTAT(J2)
  00672       .  .  J2OLD=J2
  00673       .  ...FIN
  00673       ...FIN
         
        ----------------------------------------
         
  00674       TO WRITE-CHAR
  00675       .  WHEN((J2.AND."200).NE.0)
  00676       .  .  IF(.NOT.PLOT)
  00677       .  .  .  CALL KBWRW(2,ENTER) !ENTER PLOT MODE
  00678       .  .  .  PLOT=.TRUE.
  00679       .  .  ...FIN
  00679       .  ...FIN
  00680       .  ELSE
  00680       .  .  IF(PLOT)
  00681       .  .  .  CALL KBWRW(1,LEAVE) !LEAVE PLOT MODE
  00682       .  .  .  PLOT=.FALSE.
  00683       .  .  ...FIN
  00683       .  ...FIN
  00684       .  IF(J1.NE.0)CALL KBWR(1,J1)
  00685       ...FIN

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00013  
         
        ----------------------------------------
         
  00686       TO POSITION-CURSER
  00687       .  IF(.NOT.IPOS)
  00688       .  .  IF(PLOT)
  00689       .  .  .  CALL KBWRW(1,LEAVE)
  00690       .  .  .  PLOT=.FALSE.
  00691       .  .  ...FIN
  00691       .  .  CALL APOSV(IX,IY)
  00692       .  .  IPOS=.TRUE.
  00693       .  ...FIN
  00693       ...FIN
  00694       END
         
        ----------------------------------------
         
              PROCEDURE CROSS-REFERENCE TABLE
         
        00615 GET-CURSOR-POS
              00048  00297  00367  00400  00510  00549  00649
         
        00627 GET-NEW-STATUS-AND-CHAR
              00372  00427  00469  00498
         
        00619 GET-NEXT-CHAR
              00122  00195  00204
         
        00686 POSITION-CURSER
              00430  00447
         
        00646 RESTORE-TOP-3-LINES
              00043  00299
         
        00674 WRITE-CHAR
              00663
         
        00666 WRITE-STATUS
              00117  00309  00661
         
        00660 WRITE-STATUS-AND-CHAR
              00374  00432  00471  00500  00526  00655
         
         
        (FLECS VERSION 22.37)
         
        ----------------------------------------
         
        C CLOSES FILE AND PRINTS A MESSAGE
        C       
  00001       SUBROUTINE CLMES(LUN,NAME,ISAVE)
  00002       IF(LUN.GT.0)GOTO 10
  00003       CALL PRINTW(' NO FILES TO CLOSE')
  00004       GOTO 30
  00005 10    IF(ISAVE)I=ICLOSE(LUN)
  00006       IF(.NOT.ISAVE)I=IDELET(LUN)
  00007       IF(ISAVE)CALL PRINTW('$I HAVE CLOSED ')
  00008       IF(ISAVE)CALL PRINTW('+',NAME)
  00009 30    RETURN
  00010       END
         
        (FLECS VERSION 22.37)

(FLECS VERSION 22.37)     19-JUL-79   09:06:32  PAGE 00014  
         
        ----------------------------------------
         
        C SUBROUTINE TO CLEAR TOP 3 LINES OF SCREEN
        C       
  00001       SUBROUTINE CLRTOP
  00002       CALL SSTAT(7)
  00003       CALL ANGLE(2)
  00004       CALL HOME
  00005       CALL CLRLIN
  00006       CALL CLRNXT
  00007       CALL CLRNXT
  00008       CALL HOME
  00009       RETURN
  00010       END
         
        (FLECS VERSION 22.37)
         
        ----------------------------------------
         
        C       
  00001       SUBROUTINE CLR2
  00002       CALL GPOS(IX,IY)
  00003       CALL CLRNXT
  00004       CALL CLRNXT
  00005       CALL APOSV(IX,IY)
  00006       RETURN
  00007       END
         
        (FLECS VERSION 22.37)
         
        ----------------------------------------
         
        C       
  00001       FUNCTION IRESP(BUF)
  00002       BYTE BUF(2),TBUF(10)
  00003 5     CALL PRINTW('$',BUF)
  00004       READ (5,9,END=10)N,(TBUF(I),I=1,N)
  00005 9     FORMAT(Q,10A1)
  00006       IF(N.EQ.0)TBUF(1)="116
  00007       I=TBUF(1).AND."137
  00008       IF(I.NE."116.AND.I.NE."131)GOTO 5
  00009       IF(I.EQ."116)IRESP=.FALSE.
  00010       IF(I.EQ."131)IRESP=.TRUE.
  00011       RETURN
  00012 10    IRESP=1   !TRUE, BUT +VE FOR ^Z
  00013       RETURN
  00014       END
         
        (FLECS VERSION 22.37)
         
        ----------------------------------------
         

,ISC;1=TEST
