(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