PROGRAM DRIINI
#
#     AUTHOR: DON LEDFORD
#
#     DECEMBER 1978	JOHN LUTCH	ADDED CLOAKING
#     DECEMBER 1978	DON LEDFORD	ADDED ANTI-MATTER
#     MARCH 1979	RAY FRENCH	ADDED CONTINUOUS DISPLAY
#     OCTOBER 1979	DON LEDFORD	ADDED ROBOT SHIPS
#     MAY 1980	BILL CAEL AND BILL WOOD	RECODED IN RATFOR
#     MAY 1980		BILL WOOD	ADDED ENERGY NETS
#
   INCLUDE COMMON.RAT
   LOGICAL*1 OK,YES
   BYTE CHAR
#
   WRITE(5,11)
     11 FORMAT('0WELCOME TO MULTI-TREK INITIALIZATION'/)
   DO I = 1, 8
     IF (XSHIP(I)) [
       WRITE(5,1)
         1 FORMAT('$BATTLE IN PROGRESS.  INITIALIZE? ')
       READ(5,2) CHAR
         2  FORMAT(A1)
       IF (CHAR == 'Y' | CHAR == 'y') BREAK
       ELSE CALL EXIT
       ]
   THRU = .TRUE.
   BHOLE = '#'				# CHARACTER FOR BLACK HOLE
   EMPTY = ' '				# CHARACTER FOR UNIVERSE EMPTY SPACE
   UPRATE = 24				# UPDATE RATE IN 60'THS OF A SECOND
#
   WRITE(5, (' DEFAULTS FOR THE FOLLOWING QUESTIONS MAY BE SELECTED_
 BY TYPING CARRIAGE-RETURN.'/))
   WRITE(5,71)
     71 FORMAT('$ENTER A RANDOM INTEGER: ')
   CALL GETINT(ISEED,OK,-32000,32000)
#
#  	SEED THE RANDOM NUMBER GENERATOR
#
   I1 = 0
   I2 = 0
   IF (OK & ISEED != 0)
     DO I = 0,IABS(ISEED)
       RNDOM = RAN(I1,I2)
#
   WRITE(5,41)
     41 FORMAT('$ENTER STAR DENSITY OF UNIVERSE PARTS PER 100: ')
   CALL GETREL(STARS,OK,0.,15.)
   IF (! OK) [
     STARS=2.0
     ]
   WRITE(5,51)
     51 FORMAT('$ENTER APPROXIMATE NUMBER OF STAR BASES: ')
   CALL GETREL(BASES,OK,0.,50.)
   IF (! OK) [
     BASES=20.
     ]
   WRITE(5,61)
     61 FORMAT('$ENTER NUMBER OF RANDOM JUMP POINTS: ')
   CALL GETINT(N,OK,0,10)
   IF (! OK) [
     N=6
     ]
#
#     * NOW GENERATE THE UNIVERSE
#
   DO I=1, 100 [
     DO J=1, 100 [
       RNDOM=RAN(I1,I2)
       IF (RNDOM > (100.-STARS)/100.) [
         UNIV(I,J)='*'
#
         ]
       ELSE IF (RNDOM <= BASES/10000.) [
         UNIV(I,J)='B'
#
         ]
       ELSE [
         UNIV(I,J)=EMPTY
#
         ]
       ]
     ]
#
#     * PUT IN THE HYPERSPACE PORTS
#
   UNIV(20,25)='H'
   UNIV(20,75)='H'
   UNIV(50,30)='H'
   UNIV(50,70)='H'
   UNIV(80,25)='H'
   UNIV(80,75)='H'
#
#     * PUT IN THE MOBILE "BLACK HOLE"
#
   UNIV(30,60)=BHOLE
   HX=30.
   HY=60.
#
#     * PUT IN THE RANDOM HYPER-SPACE PORTS
#
   DO I=1, N [
     OK=.FALSE.
     REPEAT [
       IX=RAN(I1,I2)*100.+1.
       IF (IX > 100) [
         IX=100
         ]
       IY=RAN(I1,I2)*100.+1.
       IF (IY > 100) [
         IY=100
         ]
       IF (UNIV(IX,IY) == EMPTY) [
         UNIV(IX,IY)='R'
         OK=.TRUE.
         ]
       ] UNTIL (OK)
     ]
#
#     * PUT IN THE STAR SHIPS
#
   DO I=1, 8 [
     OK=.FALSE.
     REPEAT [
       IX=RAN(I1,I2)*100.+1.
       IF (IX > 100) [
         IX=100
         ]
       IY=RAN(I1,I2)*100.+1.
       IF (IY > 100) [
         IY=100
         ]
       IF (UNIV(IX,IY) == EMPTY) [
         ENCODE(1,13,CHAR) I
           13 FORMAT(I1)
         UNIV(IX,IY)=CHAR
         XCORD(I)=IX
         YCORD(I)=IY
         XCORD(I)=XCORD(I)+.5
         YCORD(I)=YCORD(I)+.5
         OK=.TRUE.
         ]
       ] UNTIL (OK)
     ]
#
#     * INITIALIZE STARTING STATUS OF THE STAR SHIPS
#
   DO I=1, 8 [
#     * INITIALIZE SHIPS AS UNOWNED AND NOT CLOAKED
     XSHIP(I)=.FALSE.
     CLOAK(I)=.FALSE.
     NET(I) = .FALSE.
     TRBEAM(I) = 0
     SCAN(I)=9
     NHOM(I)=4
     DO II=1, 4 [
       WHOM(I,II)=0
       ]
     LAUNCH(I) = -1
     PHA(I) = -1
     ENERGY(I)=10000.
     SHIELD(I)=0.
     TORPS(I)=10.
     IPOD(I)=0
     CREW(I)=400
     WARP(I)=0.
     DIR(I) = 0.
     MESSAG(I*60-59)=' '
     SCORE(I)=0.
     IT(I)=1
     HYPER(I)=3
     DO K=1, 10 [
       ISENT(I,K)=0
       TDIR(I,K)=-1.
       TLOCS(I,K,1)=1
       TLOCS(I,K,2)=1
       ]
     ]
#
   WRITE(5,81)
     81 FORMAT('$ENTER ENERGY DRAIN FOR CLOAKING: ')
   CALL GETREL(CDRAIN,OK,0.,2000.)
   IF (! OK) [
     CDRAIN=25.
     ]
   WRITE(5,82)
     82 FORMAT('$ENTER ENERGY DRAIN FOR ENERGY NET: ')
   CALL GETREL(NDRAIN,OK,0.,2000.)
   IF (! OK) [
     NDRAIN=75.
     ]
   WRITE(5,83)
     83 FORMAT('$ENTER ENERGY DRAIN FOR TRACTOR BEAM: ')
   CALL GETREL(TDRAIN,OK,0.,2000.)
   IF (! OK) [
     TDRAIN=100.
     ]
   WRITE(5,91)
     91 FORMAT('$ENTER WARP SPEED OF "BLACK HOLE": ')
   CALL GETREL(HW,OK,0.,10.)
   IF (! OK) [
     HW=4.5
     ]
   WRITE(5,101)
     101 FORMAT('0MULTI-TREK INITIALIZED'/)
   END
 
 
 
   SUBROUTINE GETREL(VARI,EXIST,LOW,HIGH)
#
   LOGICAL*1 EXIST,OK
   REAL VARI,LOW,HIGH
   BYTE INPUT(15),LEFTED(15)
   INTEGER NCHRS
   OK=.FALSE.
   REPEAT [
     DO I=1, 15 [
       LEFTED(I)=' '
       ]
     READ(5,101,END=812) NCHRS,(INPUT(I),I=1,15)
       101 FORMAT(Q,15A1)
     GOTO 813
     812 CLOSE(UNIT=5)
     813 CONTINUE
     IF (NCHRS == 0) [
       OK=.TRUE.
       EXIST=.FALSE.
       ]
     ELSE IF (NCHRS <= 15) [
#     * LEFT ADJUST INPUT
       CALL STRMOV(INPUT,1,NCHRS,LEFTED,16-NCHRS)
       DECODE(15,23,LEFTED,ERR=202) VARI
         23 FORMAT(G15.0)
       IF (VARI >= LOW &  VARI <= HIGH) [
         OK=.TRUE.
         EXIST=.TRUE.
         ]
       ELSE [
         WRITE(5,111)
           111 FORMAT("0SORRY CAPTAIN, BUT YOUR COMMAND'S PARAMETER")
         WRITE(5,152) LOW,HIGH
           152 FORMAT(' MUST BE BETWEEN ',F15.4,' AND ',F15.4)
         ]
       GO TO 302
       202 TYPE *,'WOULD YOU PLEASE REPEAT THAT SIR ?'
       302 CONTINUE
       ]
     ELSE [
       WRITE(5,121)
         121 FORMAT(' RUN THAT BY ME AGAIN !')
       ]
     ] UNTIL (OK)
   RETURN
   END
 
 
 
   SUBROUTINE GETINT(NUM,FLAG,LOW,HIGH)
   INTEGER NUM,LOW,HIGH
   LOGICAL*1 OK,FLAG
   OK=.FALSE.
   REPEAT [
     READ(5,11,END=805,ERR=205) NCHRS,NUM
       11 FORMAT(Q,I5)
     GOTO 806
     805 CLOSE(UNIT=5)
     806 CONTINUE
     IF (NCHRS == 0) [
       FLAG=.FALSE.
       OK=.TRUE.
       ]
     ELSE [
       IF ((NUM >= LOW) & (NUM <= HIGH)) [
         OK=.TRUE.
         FLAG=.TRUE.
         ]
       ELSE [
         WRITE(5,131)
           131 FORMAT('0WHAT ? THAT COMMAND REQUIRES A NUMBER THAT IS')
         WRITE(5,141) LOW,HIGH
           141 FORMAT(' BETWEEN ',I6,' AND ',I6)
         WRITE(5,151)
           151 FORMAT('$TRY AGAIN :')
         ]
       ]
     NEXT
     205 WRITE(5,102)
       102 FORMAT('$TRY AGAIN BOZO :')
     ] UNTIL (OK)
   RETURN
   END