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