SUBROUTINE SETUP INCLUDE 'TREK.COM/-LI' INCLUDE 'TREK2.COM/-LI' EQUIVALENCE (CRACKS(2),SHUTUP) C--------PREPARE THE ENTERPRISE SHIP=IHE INENRG=5000.0 ENERGY=5000.0 INSHLD=2500.0 SHLD=2500.0 SHLDUP=0 SHLDCH=0 INLSR=4.0 LSUPRS=4.0 CALL IRAN8(QUADX,QUADY) CALL IRAN10(SECTX,SECTY) INTRPS=10 TORPS=10 WRPFAC=5.0 WFACSQ=25.0 DO 3 I=1,NDEVIC 3 DAMAGE(I)=0.0 C--------SET UP ASSORTED GAME PARAMETERS SHUTUP=0.0 BATX=0 BATY=0 IDATE=31.0*RANF(0)+20.0 DATE=100*IDATE INDATE=DATE KILLK=0 KILLC=0 NKINKS=0 NHELP=0 RSTING=0 CASUAL=0 NROMKL=0 ISATB=0 ISCATE=0 IMINE=0 IXTL=0 ICRAFT=0 NSCKIL=0 NPLNKL=0 ISCRFT=1 LANDED=-1 CRYPRB=0.05 ALIVE=1 DOKFAC=0.25 DO 4 I=1,8 DO 4 J=1,8 NUSTUF(I,J)=0 4 STARCH(I,J)=0 C--------INITIALIZE TIMES FOR EXTRANEOUS EVENTS FUTURE(1)=DATE+EXPRAN(0.5*INTIME) FUTURE(2)=DATE+EXPRAN(1.5*INTIME/REMCOM) FUTURE(3)=DATE+EXPRAN(0.5*INTIME) FUTURE(4)=DATE+EXPRAN(0.3*INTIME) FUTURE(5)=1E38 FUTURE(6)=1E38 IF(NSCREM.GT.0) FUTURE(6)=DATE+0.2777 FUTURE(7)=1E38 C--------PUT STARS IN THE GALAXY INSTAR=0 DO 5 I=1,8 DO 5 J=1,8 K = RANF(0) * 9 + 1 INSTAR=INSTAR+K 5 GALAXY(I,J)=K STARKL=0 C-------LOCATE STARBASES IN THE GALAXY (IMPROVED PLACEMENT) DO 9 I=1,INBASE 6 CALL IRAN8(IX,IY) IF(GALAXY(IX,IY).GE.10) GOTO 6 IF(I.EQ.1) GOTO 8 LIM=I-1 DO 7 J=1,LIM DISTQ=(IX-BASEQX(J))**2 + (IY-BASEQY(J))**2 IF(DISTQ .LT. 6*(6-INBASE) .AND. RANF(0.) .LT. 0.75) GOTO 6 7 CONTINUE 8 BASEQX(I)=IX BASEQY(I)=IY STARCH(IX,IY)= -1 9 GALAXY(IX,IY)=GALAXY(IX,IY)+10 BASEKL=0 C--------POSITION ORDINARY KLINGON BATTLE CRUISERS KREM=INKLNG-INCOM-NSCREM KLUMPR=0.25*SKILL*(9-LENGTH)+1.0 KLUMPR=MIN0(9,KLUMPR) 10 KLUMP=(1.0-RANF(0)**2)*KLUMPR IF(KLUMP .GT. KREM) KLUMP=KREM NUM=100*KLUMP 15 CALL IRAN8(IX,IY) IF(GALAXY(IX,IY)+NUM .GT. 999) GO TO 15 GALAXY(IX,IY)=GALAXY(IX,IY)+NUM KREM=KREM-KLUMP IF(KREM .NE. 0) GO TO 10 C--------POSITION KLINGON COMMAND SHIPS DO 18 I=1,INCOM 16 CALL IRAN8(IX,IY) IF(GALAXY(IX,IY).LT.99 .AND. RANF(0).LT.0.75) GO TO 16 IF(GALAXY(IX,IY) .GT. 899)GO TO 16 IF(I .EQ. 1)GO TO 17 IM1=I-1 DO 1605 JJ=1,IM1 IF(CX(JJ) .EQ. IX .AND. CY(JJ) .EQ. IY)GO TO 16 1605 CONTINUE 17 GALAXY(IX,IY)=GALAXY(IX,IY)+100 CX(I)=IX 18 CY(I)=IY C--------LOCATE PLANETS IN GALAXY DO 20 I=1,INPLAN 19 CALL IRAN8(IX,IY) IF(NUSTUF(IX,IY) .GT. 0) GO TO 19 NUSTUF(IX,IY)=1 PLNETS(I,1)=IX PLNETS(I,2)=IY C--------DECIDE WHAT KIND OF PLANET M=1, N=2, O=3. PLNETS(I,3)=RANF(0)*3. + 1. C--------DECIDE WHETHER DILITHIUM CRYSTALS ARE PRESENT. PLNETS(I,4)=1.2*RANF(0) PLNETS(I,5)=0 20 CONTINUE C--------LOCATE ROMULANS. DO 21 I=1,NROMRM CALL IRAN8(IX,IY) 21 NUSTUF(IX,IY)=NUSTUF(IX,IY)+10 C--------LOCATE THE SUPER-COMMANDER, IF NEEDED. IF(NSCREM .LT. 1) GO TO 23 22 CALL IRAN8(IX,IY) IF(GALAXY(IX,IY) .GT. 899) GO TO 22 ISX=IX ISY=IY GALAXY(IX,IY)=GALAXY(IX,IY)+100 23 IDATE = DATE CALL SKIP(1) SNAP=0 C--------DECIDE IF GALAXY NEEDS A "THING" IF((RANF(0) .GT. 0.04) .OR. (THINGX .EQ. -1)) GO TO 2301 CALL IRAN8(THINGX,THINGY) GO TO 24 2301 THINGX=0 THINGY=0 C--------PRINT BRIEF INITIAL MESSAGE 24 CALL CRAM('STARDATE') CALL CRAMI(IDATE,5) CALL CREND CALL CRAMI(INKLNG,5) CALL CRMDMP(9H KLINGONS) CALL PROUT(31HAN UNKNOWN NUMBER OF ROMULANS ,31) IF(NSCREM .EQ. 0) GO TO 25 CALL PROUT(33HAND ONE (GULP) .,33) 25 CALL CRAMI(IFIX(INTIME),5) CALL CRMDMP(10H STARDATES) CALL CRAMI(INBASE,5) CALL CRAM(24H STARBASES: QUADRANTS ) DO 50 I=1,INBASE CALL CRMLOC(0,BASEQX(I),BASEQY(I)) IF(I .LT. INBASE)CALL CRAM(2H, ) 50 CONTINUE CALL CREND CALL SKIP(1) CALL CRAM(30HTHE ENTERPRISE IS CURRENTLY IN) CALL CRMLOC(1,QUADX,QUADY) CALL CRAM(1H,) CALL CRMLOC(2,SECTX,SECTY) CALL CREND CALL SKIP(1) CALL CRAM(10HGOOD LUCK.) IF(NSCREM.GT.0) CALL CRAM(17H YOU'LL NEED IT. ) CALL CREND CALL NUQUAD RETURN END