SUBROUTINE TREAD(STR,NC) BYTE STR CALL INCHAR(STR,NC,.FALSE.,0,NC,IERR) IF (NC == 0 & IERR != -2) STR=' ' # ELSE IF (STR >= 'a' & STR <= 'z') # STR = (STR - 'a') + 'A' RETURN END SUBROUTINE RBUFF COMMON /MESS/ CLEARF LOGICAL CLEARF CALL CLEAR CLEARF = .FALSE. # # DRAW NEW SCREEN # CALL BUFFIL(2,4,'Energy :',10) CALL BUFFIL(3,4,'Shields :',10) CALL BUFFIL(5,4,'Warp :',10) CALL BUFFIL(6,4,'Course :',10) CALL BUFFIL(8,4,'X co-ord :',10) CALL BUFFIL(9,4,'Y co-ord :',10) CALL BUFFIL(11,4,'Torps :',10) CALL BUFFIL(12,4,'Seekers :',10) CALL BUFFIL(13,4,'Hyper :',10) CALL BUFFIL(15,4,'Def Ship :',10) CALL BUFFIL(16,4,'Def Direc:',10) CALL BUFFIL(2,71,'Scores',6) CALL BUFFIL(4,69,'1',1) CALL BUFFIL(5,69,'2',1) CALL BUFFIL(6,69,'3',1) CALL BUFFIL(7,69,'4',1) CALL BUFFIL(8,69,'5',1) CALL BUFFIL(9,69,'6',1) CALL BUFFIL(10,69,'7',1) CALL BUFFIL(11,69,'8',1) CALL BUFFIL(13,69,'TARGET:',7) CALL BUFFIL(15,69,'Dir :',5) CALL BUFFIL(16,69,'Dist:',5) CALL BUFFIL(17,69,'Sect:',5) CALL OUTCH(0,0) RETURN END SUBROUTINE REFRSH( ME ) INCLUDE COMMON.RAT BYTE STRNG(10) BYTE ACT(8) INTEGER DEFSHP REAL DEFDIR COMMON /DEFLTS/ DEFSHP,DEFDIR INTEGER OLDSHP COMMON /OLDSTF/ OLDSCR(MAXSHP), OLDCRS, OLDWRP, OLDEN, OLDSH, OLDX, OLDY, IOLDT, IOLDH, IOLDP, OLDDIR, OLDSHP DATA OLDSHP/0/, OLDDIR/-1.0/, OLDWRP/-1.0/, OLDEN/-1.0/ DATA OLDSH/0.0/, OLDX/-1.0/, OLDY/-1.0/, IOLDT/0/, IOLDH/0/ DATA IOLDP/0/ DATA ACT/8*' '/, OLDSCR/8*-1E-10/ IF (OLDEN != ENERGY(ME)) [ OLDEN=ENERGY(ME) ENCODE(7,1001,STRNG) OLDEN 1001 FORMAT(F7.1) CALL BUFFIL(2,15,STRNG,7) ] IF (OLDSH != SHIELD(ME)) [ OLDSH=SHIELD(ME) ENCODE(7,1011,STRNG) OLDSH 1011 FORMAT(F7.1) CALL BUFFIL(3,15,STRNG,7) ] IF (OLDWRP != WARP(ME)) [ OLDWRP=WARP(ME) ENCODE(4,1021,STRNG) OLDWRP 1021 FORMAT(F4.2) CALL BUFFIL(5,18,STRNG,4) ] IF (OLDCRS != DIR(ME)) [ OLDCRS=DIR(ME) V = CLKDIR( OLDCRS ) ENCODE(5,1031,STRNG) V 1031 FORMAT(F5.2) CALL BUFFIL(6,17,STRNG,5) ] IF (OLDX != XCORD(ME)) [ OLDX=XCORD(ME) ENCODE(5,1041,STRNG) OLDX 1041 FORMAT(F5.1) CALL BUFFIL(8,17,STRNG,5) ] IF (OLDY != YCORD(ME)) [ OLDY=YCORD(ME) ENCODE(5,1051,STRNG) OLDY 1051 FORMAT(F5.1) CALL BUFFIL(9,17,STRNG,5) ] IF (IOLDT != TORPS(ME)) [ IOLDT=TORPS(ME) ENCODE(2,1061,STRNG) IOLDT 1061 FORMAT(I2) CALL BUFFIL(11,20,STRNG,2) ] IF (IOLDH != NHOM(ME)) [ IOLDH=NHOM(ME) ENCODE(2,1071,STRNG) IOLDH 1071 FORMAT(I2) CALL BUFFIL(12,20,STRNG,2) ] IF (IOLDP != HYPER(ME)) [ IOLDP=HYPER(ME) ENCODE(1,1081,STRNG) IOLDP 1081 FORMAT(I1) CALL BUFFIL(13,21,STRNG,1) ] IF (OLDSHP != DEFSHP) [ OLDSHP = DEFSHP ENCODE(1,1091,STRNG) OLDSHP 1091 FORMAT(I1) CALL BUFFIL(15,21,STRNG,1) ] IF (OLDDIR != DEFDIR) [ OLDDIR = DEFDIR ENCODE(5,1101,STRNG) DEFDIR 1101 FORMAT(F5.2) CALL BUFFIL(16,17,STRNG,5) ] DO J=1,8 [ IF ((OLDSCR(J) != SCORE(J)) | (SHPACT(J) .XOR. (ACT(J) == '*'))) [ IF (SHPACT(J)) ACT(J) = '*' ELSE ACT(J) = ' ' OLDSCR(J)=SCORE(J) ENCODE(10,1111,STRNG) OLDSCR(J), ACT(J) 1111 FORMAT(F8.0,1X,A1) CALL BUFFIL(J+3,71,STRNG,10) ] ] CALL OUTCH(0,-1) RETURN END SUBROUTINE BNDRY(IXLOW, IXHI, IYLOW, IYHI) DEFINE (DIG0,48) INCLUDE COMMON.RAT BYTE BLUNK(2) BYTE BLUNK2(2) BYTE OBUFF(-9:+9,-9:+9), NBUFF(-9:+9,-9:+9) BYTE JUNK COMMON /BNDRY/ IXX, IYY, ID, MINID8, JUNK, OBUFF, NBUFF EQUIVALENCE (BLUNK(2), NBUFF(-9, -9)) EQUIVALENCE (BLUNK2(2), OBUFF(-9, -9)) BYTE ALPHA DO IX1 = IXLOW, IXHI [ IX = IX1-IXX DO IY1 = IYLOW, IYHI [ IY = IY1-IYY ALPHA = UNIV(IX1, IY1) IF (ALPHA == EMPTY) [ IF (((IX == -ID | IX == ID | IX == 0) & (IY1 == 100 | IY1 == 1)) | ((IY == -ID | IY == MINID8 | IY == 0) & (IX1 == 100 | IX1 == 1))) NBUFF(IX,IY)='-' ] ELSE IF ((ALPHA >= DIG0+1) & (ALPHA <= DIG0+8) & (CLOAK(ALPHA-DIG0))) NBUFF(IX,IY)=EMPTY ELSE IF (ALPHA < 0) NBUFF(IX, IY) = '%' ELSE NBUFF(IX,IY)=ALPHA ] ] RETURN END # SRSCAN - REFRESH SHORT RANGE SCAN SUBROUTINE SRSCAN( ME ) INCLUDE COMMON.RAT BYTE BLUNK(2) BYTE BLUNK2(2) BYTE OBUFF(-9:+9,-9:+9), NBUFF(-9:+9,-9:+9) BYTE JUNK COMMON /BNDRY/ IXX, IYY, ID, MINID8, JUNK, OBUFF, NBUFF EQUIVALENCE (BLUNK(2), NBUFF(-9, -9)) EQUIVALENCE (BLUNK2(2), OBUFF(-9, -9)) #LINE & COLUMN FOR CENTER OF SCAN DISPLAY DEFINE(CTRLIN,9) DEFINE(CTRCOL,43) CALL STRMOV(BLUNK,1,361,NBUFF,1) ID=SCAN(ME) MINID8 = MIN(ID,8) IXX=XCORD(ME) IYY=YCORD(ME) IXLOW = MAX(2, IXX-ID) IXHI = MIN(99, IXX+ID) IYLOW = MAX(2, IYY-ID) IYHI = MIN(99, IYY+MINID8) DO IX1 = IXLOW, IXHI [ IX = IX1-IXX DO IY1 = IYLOW, IYHI [ IY = IY1-IYY ALPHA=UNIV(IX1,IY1) IF ((ALPHA >= DIG0+1) & (ALPHA <= DIG0+8) & (CLOAK(ALPHA-DIG0))) NBUFF(IX,IY)=EMPTY ELSE IF (ALPHA < 0) NBUFF(IX, IY) = '%' ELSE NBUFF(IX,IY)=ALPHA ] ] IF (IXX-ID <= 1) CALL BNDRY(1, 1, MAX(1, IYY-ID), MIN(100, IYY+MINID8)) ELSE IF (IXX+ID >= 100) CALL BNDRY(100, 100, MAX(1, IYY-ID), MIN(100, IYY+MINID8)) IF (IYY-ID <= 1) CALL BNDRY(MAX(1, IXX-ID), MIN(99, IXX+ID), 1, 1) ELSE IF (IYY+ID >= 100) CALL BNDRY(MAX(1, IXX-ID), MIN(99, IXX+ID), 100, 100) IF (NBUFF(-ID, -ID) == EMPTY) NBUFF(-ID, -ID) = '.' IF (NBUFF(-ID, MINID8) == EMPTY) NBUFF(-ID, MINID8) = '.' IF (NBUFF(ID, MINID8) == EMPTY) NBUFF(ID, MINID8) = '.' IF (NBUFF(ID, -ID) == EMPTY) NBUFF(ID, -ID) = '.' DO IY = -9, +8 [ ICURSX = -999 DO IX = -9, +9 [ IF (NBUFF(IX,IY) != OBUFF(IX,IY)) [ IF (ICURSX >= IX-2) [ DO III = ICURSX+1, IX [ CALL OUTCH(' ',1) CALL OUTCH(NBUFF(III, IY), 1) ] ] ELSE [ CALL TPOS( CTRLIN-IY, 2*IX+CTRCOL ) CALL OUTCH(NBUFF(IX, IY), 1) ] ICURSX = IX OBUFF(IX, IY)=NBUFF(IX, IY) ] ] ] CALL OUTCH(0, -1) RETURN END