C C THIS FILE WAS ORIGINALLY CONTAINED WITHIN PLAYER.FTN. C IT WAS STRIPPED FROM PLAYER.FTN TO SPEED UP THE COMPILE C OF PLAYER.FTN C SUBROUTINE RBUFF COMMON/MESS/CLEARF LOGICAL CLEARF CALL CLEAR CLEARF = .FALSE. C C DRAW NEW SCREEN C 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(14, 69, 'SCAN:', 5) 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(SC, R, I) C TEXT COMMON COMMON/TORPE/TLOCS(6, 10, 2), TDIR(6, 10), IT(6) COMMON/LEDFOR/ENERGY(6), SHIELD(6), XCORD(6), YCORD(6), TORPS(6), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(6), PHA(6), I1, I2, HYPER *(6), ISENT(6, 10), XPOD(6), YPOD(6), DPOD(6), IPOD(6), WPOD(6), XH *OM(6, 4), YHOM(6, 4), WHOM(6, 4), NHOM(6), TRBEAM(6), SCORE(6), CR *EW(6), DIR(6), WARP(6), LAUNCH(6), UNIV(80, 80), TH *RU, XSHIP(6), CLOAK(6), NET(6), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, BHOLE, EMPTY C END COMMON REAL SC(6), R(9) BYTE STRNG(10) BYTE ACT(6) INTEGER DEFSHP, OLDSHP REAL DEFDIR, OLDDIR COMMON/DEFLTS/DEFSHP, DEFDIR, OLDDIR, OLDSHP DATA ACT/6*' '/, OLDSHP/0/, OLDDIR/ - 1.0/ IF (R(1) .EQ. ENERGY(I)) GOTO 4340 R(1) = ENERGY(I) ENCODE(7, 1001, STRNG) R(1) 1001 FORMAT(F7.1) CALL BUFFIL(2, 15, STRNG, 7) 4340 CONTINUE IF (R(2) .EQ. SHIELD(I)) GOTO 4360 R(2) = SHIELD(I) ENCODE(7, 1001, STRNG) R(2) CALL BUFFIL(3, 15, STRNG, 7) 4360 CONTINUE IF (R(3) .EQ. WARP(I)) GOTO 4380 R(3) = WARP(I) ENCODE(4, 1021, STRNG) R(3) 1021 FORMAT(F4.2) CALL BUFFIL(5, 18, STRNG, 4) 4380 CONTINUE IF (R(4) .EQ. DIR(I)) GOTO 4400 R(4) = DIR(I) IF (R(4) .LE. 90.) GOTO 4420 V = (450. - R(4))/30. GOTO 4430 4420 CONTINUE V = (90. - R(4))/30. 4430 CONTINUE ENCODE(5, 1031, STRNG) V 1031 FORMAT(F5.2) CALL BUFFIL(6, 17, STRNG, 5) 4400 CONTINUE IF (R(5) .EQ. XCORD(I)) GOTO 4440 R(5) = XCORD(I) ENCODE(5, 1041, STRNG) R(5) 1041 FORMAT(F5.1) CALL BUFFIL(8, 17, STRNG, 5) 4440 CONTINUE IF (R(6) .EQ. YCORD(I)) GOTO 4460 R(6) = YCORD(I) ENCODE(5, 1041, STRNG) R(6) CALL BUFFIL(9, 17, STRNG, 5) 4460 CONTINUE IR = R(7) IF (IR .EQ. TORPS(I)) GOTO 4480 R(7) = TORPS(I) ENCODE(2, 1061, STRNG) TORPS(I) 1061 FORMAT(I2) CALL BUFFIL(11, 20, STRNG, 2) 4480 CONTINUE IR = R(8) IF (IR .EQ. NHOM(I)) GOTO 4500 R(8) = NHOM(I) ENCODE(2, 1061, STRNG) NHOM(I) CALL BUFFIL(12, 20, STRNG, 2) 4500 CONTINUE IR = R(9) IF (IR .EQ. HYPER(I)) GOTO 4520 R(9) = HYPER(I) ENCODE(1, 1081, STRNG) HYPER(I) 1081 FORMAT(I1) CALL BUFFIL(13, 21, STRNG, 1) 4520 CONTINUE IF (OLDSHP .EQ. DEFSHP) GOTO 4540 OLDSHP = DEFSHP ENCODE(1, 1081, STRNG) OLDSHP CALL BUFFIL(15, 21, STRNG, 1) 4540 CONTINUE IF (OLDDIR .EQ. DEFDIR) GOTO 4560 OLDDIR = DEFDIR ENCODE(5, 1031, STRNG) DEFDIR CALL BUFFIL(16, 17, STRNG, 5) 4560 CONTINUE DO 4580 J = 1, 6 IF(.NOT.((SC(J) .NE. SCORE(J)) .OR. (XSHIP(J) .XOR. (ACT(J) .EQ. * '*' .AND. CREW(J) .LE. 401)))) GOTO 4600 IF(CREW(J).GT.401 .AND. ACT(J).NE.'$') GOTO 4630 ! UPDATE FOR SHARING IF (.NOT.(XSHIP(J))) GOTO 4620 IF(CREW(J) .GT. 401) GOTO 4630 ACT(J) = '*' GOTO 4640 4620 CONTINUE ACT(J) = ' ' GOTO 4640 4630 ACT(J) = '$' ! UPDATE FOR SHARING COMMAND 4640 SC(J) = SCORE(J) ENCODE(10, 1111, STRNG) SC(J), ACT(J) 1111 FORMAT(F8.0, 1X, A1) CALL BUFFIL(J + 3, 71, STRNG, 10) 4600 CONTINUE 4580 CONTINUE 4590 CONTINUE CALL OUTCH(0, - 1) RETURN END SUBROUTINE BUFFIL(IY, IX, ST, L) BYTE ST(1) CALL TPOS(IY, IX) CALL OUTCH(ST, L) RETURN END SUBROUTINE OUTSTR(LFFLAG, STRNG, CRFLAG) LOGICAL LFFLAG, CRFLAG BYTE STRNG(1) LEN = 0 5020 IF (STRNG(LEN+1) .EQ. 0) GOTO 5040 LEN = LEN + 1 GOTO 5020 5040 CONTINUE IF (LFFLAG) CALL OUTCH(10, 1) 5050 CONTINUE CALL OUTCH(STRNG, LEN) IF (.NOT.(CRFLAG)) GOTO 5070 CALL OUTCH(0, - 1) GOTO 5080 5070 CONTINUE CALL OUTCH(0, 0) 5080 CONTINUE RETURN END SUBROUTINE BNDRY(IXLOW, IXHI, IYLOW, IYHI) C TEXT COMMON COMMON/TORPE/TLOCS(6, 10, 2), TDIR(6, 10), IT(6) COMMON/LEDFOR/ENERGY(6), SHIELD(6), XCORD(6), YCORD(6), TORPS(6), *HX, HY, HW, CDRAIN, NDRAIN, TDRAIN, SCAN(6), PHA(6), I1, I2, HYPER *(6), ISENT(6, 10), XPOD(6), YPOD(6), DPOD(6), IPOD(6), WPOD(6), XH *OM(6, 4), YHOM(6, 4), WHOM(6, 4), NHOM(6), TRBEAM(6), SCORE(6), CR *EW(6), DIR(6), WARP(6), LAUNCH(6), UNIV(80, 80), TH *RU, XSHIP(6), CLOAK(6), NET(6), BHOLE, EMPTY REAL LAUNCH, NDRAIN INTEGER SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, XSHIP, CLOAK, NET C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE AND ARE SET IN MTREKINI. BYTE UNIV, BHOLE, EMPTY C END COMMON BYTE ALPHA BYTE JUNK, NBUFF COMMON/BNDRY/IXX, IYY, ID, MINID8, JUNK, NBUFF( - 9: + 9, - 9: + *9) DO 5090 IX1 = IXLOW, IXHI IX = IX1 - IXX DO 5110 IY1 = IYLOW, IYHI IY = IY1 - IYY ALPHA = UNIV(IX1, IY1) IF (ALPHA .NE. EMPTY) GOTO 5130 IF (.NOT.(((IX .EQ. -ID .OR. IX .EQ. ID .OR. IX .EQ. 0) .AND *. (IY1 .EQ. 80 .OR. IY1 .EQ. 1)) .OR. ((IY .EQ. -ID .OR. IY .EQ. *MINID8 .OR. IY .EQ. 0) .AND. (IX1 .EQ. 80 .OR. IX1 .EQ. 1)))) GOT *O 5150 NBUFF(IX, IY) = '-' 5150 CONTINUE GOTO 5140 5130 CONTINUE IF (.NOT.((ALPHA .GE. 48+1) .AND. (ALPHA .LE. 48+6) .AND. (C *LOAK(ALPHA-48)))) GOTO 5170 NBUFF(IX, IY) = EMPTY GOTO 5180 5170 CONTINUE IF (ALPHA .GE. 0) GOTO 5190 NBUFF(IX, IY) = '%' GOTO 5200 5190 CONTINUE NBUFF(IX, IY) = ALPHA 5200 CONTINUE 5180 CONTINUE 5140 CONTINUE 5110 CONTINUE 5120 CONTINUE 5090 CONTINUE 5100 CONTINUE RETURN END