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