SUBROUTINE SETUP C*BEGIN COMMON COMMON SNAP,SNAPSHT(247), + DATE,REMKL,REMCOM,REMBASE,REMRES,REMTIME,STARKL,BASEKL, + KILLK,KILLC,GALAXY(8,8),CX(10),CY(10),BASEQX(5),BASEQY(5), + NEWSTUF(8,8),PLNETS(10,5),ISX,ISY,NSCREM,NROMKL,NROMREM, + NSCKILL,NPLANKL,ISATB,BATX,BATY,THINGX,THINGY, + QUAD(10,10),KX(20),KY(20),KPOWER(20),KDIST(20),KSTUF(20), + FUTURE(10),MESSAGE(5,10), + INKLING,INBASE,INRESOR,INCOM,INTIME,INSTAR,INENRG,INSHLD, + INTORPS,INLSR,INDATE,ENERGY,SHLD,SHLDUP,CONDIT,TORPS,SHIP, + QUADX,QUADY,SECTX,SECTY,WARPFAC,WFACSQ,LSUPRES,DAMAGE(20), + LENGTH,SKILL,PASSWD,DIST,DIREC,TIME,BASEX,BASEY,DOCKFAC, + KLHERE,COMHERE,CASUAL,NHELP,NKINKS,STARCH(8,8), + DEVICE(2,14),IDIDIT,GAMEWON,ALIVE,JUSTIN,RESTING,ALLDONE, + DAMFAC,SHLDCHG,NDEVICE,PLNETX,PLNETY,INORBIT,LANDED,IPLANET, + IMINE,ICRYSTL,INPLAN,NENHERE,ISHERE,NEUTZ,IRHERE,ICRAFT, + IENTESC,ISCRAFT,ISCATE,CRYPROB,ICITE,IPHWHO, + CRACKS(12) INTEGER SHLDUP,CONDIT,QUADX,QUADY,SECTX,SECTY,TORPS, + REMKL,REMBASE,SKILL,REMCOM,GALAXY,STARCH,CX,CY, + SHIP,ALLDONE,BASEQX,BASEQY,BASEX,BASEY,GAMEWON, + ALIVE,STARKL,BASEKL,CASUAL,COMHERE,RESTING,SNAP,SHLDCHG, + THINGX,THINGY,BATX,BATY,PLNETX,PLNETY,PLNETS REAL KDIST,KPOWER,LSUPRES,INTIME,INRESOR,INDATE,INSHLD, + INENRG,INLSR BYTE QUAD REAL*8 DEVICE,PASSWD C*END COMMON LOGICAL*1 IHS,IHR,IHC,IHK,IHE,IHF,IHBLANK,IHDOT,IHP,IHB 1 ,IHSTAR,IHT,IHQUEST,IHNUM COMMON/HOLLER/IHEOL,IHREAL,IHALPHA,IHS,IHR,IHC,IHK,IHGREEN,IHRED, +IHYELLO,IHDOCKD,IHE,IHF,IHBLANK,IHDOT,IHQUEST,IHP,IHSTAR,IHB +,IHT,IHNUM EQUIVALENCE (CRACKS(2),SHUTUP),(KSTUF(6),MESS) C--------PREPARE THE ENTERPRISE SHIP=IHE INENRG=5000.0 ENERGY=5000.0 INSHLD=2500.0 SHLD=2500.0 SHLDUP=0 SHLDCHG=0 INLSR=4.0 LSUPRES=4.0 CALL IRAN8(QUADX,QUADY) CALL IRAN10(SECTX,SECTY) INTORPS=10 TORPS=10 WARPFAC=5.0 WFACSQ=25.0 DO 3 I=1,NDEVICE 3 DAMAGE(I)=0.0 C--------SET UP ASSORTED GAME PARAMETERS SHUTUP=0.0 MESS=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 RESTING=0 CASUAL=0 NROMKL=0 ISATB=0 ISCATE=0 IMINE=0 ICRYSTL=0 ICRAFT=0 NSCKILL=0 NPLANKL=0 ISCRAFT=1 LANDED=-1 CRYPROB=0.05 ALIVE=1 DOCKFAC=0.25 DO 4 I=1,8 DO 4 J=1,8 NEWSTUF(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=INKLING-INCOM-NSCREM KLUMPER=0.25*SKILL*(9-LENGTH)+1.0 KLUMPER=MIN0(9,KLUMPER) 10 KLUMP=(1.0-RANF(0)**2)*KLUMPER 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(NEWSTUF(IX,IY) .GT. 0) GO TO 19 NEWSTUF(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,NROMREM CALL IRAN8(IX,IY) 21 NEWSTUF(IX,IY)=NEWSTUF(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(INKLING,5) CALL CRAMDMP(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 CRAMDMP(10H STARDATES) CALL CRAMI(INBASE,5) CALL CRAM(24H STARBASES: QUADRANTS ) DO 50 I=1,INBASE CALL CRAMLOC(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 CRAMLOC(1,QUADX,QUADY) CALL CRAM(1H,) CALL CRAMLOC(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 NEWQUAD RETURN END