Listing of file='STTREK.FOR;0F' on disk='vmedia/fortrek-sector.ccvf'
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C STAR TREK
C
REAL DATE,FINDAT
REAL ENERGY,SHIELD
REAL KLGEGY(9)
INTEGER CRT
INTEGER GALAXY(8,8)
INTEGER N
BYTE I,J,K
BYTE RAN,CI
BYTE QUDRNT(8,8)
BYTE STATUS,NBASES,NTORPS
BYTE LINE,CMND
BYTE DEV(9)
BYTE NK,NB,NS
BYTE NKLING,KX(9),KY(9)
BYTE P,Q,U,V,X,Y
BYTE CLRMSG(8),DISPLY(16)
BYTE BLK,RED,GRN,YEL,BLU,MGN,CYN,WHT
BYTE A7ON,BA7OFF,BLINK,HOME
BYTE REPLY,CHRY
COMMON /MAP/GALAXY,U,V,QUDRNT,X,Y
COMMON /INFO/STATUS,DATE,FINDAT,ENERGY,SHIELD,
* NBASES,NTORPS
COMMON /STAT/DEV
COMMON /KLING/NKLING,KLGEGY,KX,KY
COMMON /COLORS/BLK,RED,GRN,YEL,BLU,MGN,CYN,WHT
DATA CRT/3/
DATA CLRMSG/29,6,2,15,12,27,24,X'EF'/
DATA DISPLY/'L','O','A','D',' ',
* 'S','T','T','R','E','K','.','P','I','C',0/
DATA BLK,RED,GRN,YEL,BLU,MGN,CYN,WHT
* /16,17,18,19,20,21,22,23/
DATA A7ON,BA7OFF,BLINK,HOME/14,15,31,8/
DATA CHRY/'Y'/
DIST(I) = SQRT((KX(I)-X)**2+(KY(I)-Y)**2)
CALL SETVEC
10 CALL OSTR(CLRMSG)
CALL FCS(DISPLY)
ENERGY = 3000.0
SHIELD = 0.0
NBASES = 0
NTORPS = 10
STATUS = 0
LINE = 20
20 CALL SCLCLR(LINE,31)
WRITE(CRT,30)YEL,GRN
30 FORMAT('+',A1,'STAR DATE ? ',A1)
CALL INPUT(DATE,1)
IF(DATE.LT.1.0.OR.DATE.GT.9900.0) GOTO 20
CALL OUT(8,247)
FINDAT = DATE+30.0
R = RND(-DATE)
DO 100 I=1,8
DO 100 J=1,8
R = RND(1.0)
NK = 0
NB = 0
NS = 0
IF(R.GT.0.8) NK = NK+1
IF(R.GT.0.95) NK = NK+1
IF(R.GT.0.98) NK = NK+1
NKLING = NKLING+NK
IF(RND(1.0).GT.0.96) NB = 1
NBASES = NBASES+NB
NS = RAN(9.0)
GALAXY(I,J) = 100*NK+10*NB+NS
100 CONTINUE
IF(NBASES.NE.0) GOTO 200
NBASES = 1
P = RAN(8.0)
Q = RAN(8.0)
GALAXY(P,Q) = GALAXY(P,Q)+10
200 U = RAN(8.0)
V = RAN(8.0)
X = RAN(8.0)
Y = RAN(8.0)
DO 300 I=1,8
DEV(I) = 0
300 CALL DSPDEV(I)
DO 400 K=1,7
400 CALL DSINFO(K)
CALL NEWMAP
CALL SCLCLR(LINE,31)
WRITE(CRT,450)YEL,GRN,NBASES
450 FORMAT('+',A1,'NUMBER OF STARBASES:',A1,I3)
1000 IF(NKLING.EQ.0) GOTO 5000
CALL SPLIT(GALAXY(U,V),NK,NB,NS)
IF(STATUS.EQ.3) GOTO 1100
IF((ENERGY.LT.8.0).AND.(DEV(7).LT.0)) GOTO 5300
1100 CONTINUE
C CALL BASE
DO 1200 K=1,7
1200 CALL DSINFO(K)
CALL LRSCAN
CALL SRSCAN
CALL SCLCLR(LINE,31)
CALL SCLCLR(LINE,31)
WRITE(CRT,1250)YEL,GRN
1250 FORMAT('+',A1,'COMMAND: ',A1)
1300 CALL OUT(8,255)
CMND = CI(5)
IF(CMND.LT.0) GOTO 3000
IF((CMND.GT.52).OR.(CMND.LT.48)) GOTO 1300
CALL CO(CMND)
CMND = CMND-48
GOTO (2000,2100,2200,2300,2400),CMND
2000 CONTINUE
GOTO 3000
2100 CONTINUE
GOTO 3000
2200 CONTINUE
GOTO 3000
2300 CONTINUE
GOTO 3000
2400 CONTINUE
GOTO 3000
3000 CALL OUT(8,247)
GOTO 1000
5000 CALL SCLCLR(LINE,31)
CALL SCLCLR(LINE,31)
WRITE(CRT,5010)CYN
5010 FORMAT('+',A1,'MISSION ACCOMPLISHED')
CALL CO(BLINK)
CALL SCLCLR(LINE,31)
WRITE(CRT,5020)
5020 FORMAT('+ALL KLINGONS DESTROYED')
CALL CO(BA7OFF)
GOTO 10000
5300 CALL SCLCLR(LINE,31)
CALL SCLCLR(LINE,31)
WRITE(CRT,5310)RED
5310 FORMAT('+',A1,'DEAD IN SPACE')
CALL SCLCLR(LINE,31)
WRITE(CRT,5320)
5320 FORMAT('+','YOU WILL DRIFT FOREVER ...')
GOTO 9000
9000 DO 9100 N=1,5000
9100 CONTINUE
10000 CALL OSTR(CLRMSG)
CALL OUT(8,255)
WRITE(CRT,10010)
10010 FORMAT(' ANOTHER MISSION ? (Y/N) ')
REPLY = CI(0)
IF(REPLY.EQ.CHRY) GOTO 10
STOP
END