      SUBROUTINE STAR79

c	include 'tcommon.for'
	%include tcommon.for

	character iiiii,idup
      character*8 NAMEX,PASSX,IDEMO,moldnm,noldnm
      datA POINT/0./
	data IDEMO/'master  '/,NAMEX/'        '/,PASSX/'        '/
	CALL QTIME(IZZ)
      J=10
      J=MOD(IZZ,J)
      J=J*10
      J=MOD(IZZ,J)
      DO 78888 I=1,J
      IIIIII=RAN(IZZ)
78888 CONTINUE
C     ...SET USER LIMITS 
5666  WRITE(*,1)
1     format(/      ' At any point in the game where information is requ4592
     1ired,'/' you may request a short explanation by typing "7777".'/' 4593
     1good luck! you''ll need it.')
5655  WRITE(*,77702)
77702 FORMAT(' Enter your last name: ')
	read(*,676,end=9680)namex
c      read(*,676)namex
      write(*,77703)
77703 format(' enter your password: ')
      read(*,676,end=9680)passx
      iikk=1
      moldnm=iyes
81818 likk=iikk 
      read(3,rec=likk,err=5666)mname,points,mpass,x6,x7,irst
      if(namex.eq.mname.and.passx.eq.mpass)go to 71717
      if(moldnm.eq.mname)go to 9776
      moldnm=mname
	iikk=iikk+1
      go to 81818
71717 mmkey=iikk
      if(irst.eq.1)call rstart(1)
      if(irst.eq.1)return

      write(*,77777)
77777 format(' Do you want to change your password (y or n)? ')
      read(*,6,ERR=5666,END=9680)IIIII
      IF(IIIII.NE.'Y')GO TO 5654
      WRITE(*,77888)
77888 FORMAT(' Enter new password: ')
      READ(*,676,END=9680)PASSX
      IF(PASSX.EQ.'shazam'.AND.MNAME.EQ.'master')GO TO 77779
      IF(MNAME.EQ.IDEMO)GO TO 5654
      MPASS=PASSX
5654  WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst
      GO TO 77714
77779 WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst
65656 WRITE(*,77780)
77780 FORMAT(' Do you want to add a name to the file (Y or N)? ')
      READ(*,6,ERR=5666,END=9680)IIIII
      IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 77789
      WRITE(*,77781)
77781 FORMAT(' Enter the last name: ')
      READ(*,676,END=9680)NAMEX
676   FORMAT(A8)
      WRITE(*,77783)
77783 FORMAT(' Enter the password: ')
      READ(*,676,END=9680)PASSX
      IIKK=1
      MOLDNM=IYES
77784 READ(3,REC=IIKK,ERR=5666)MNAME,POINTS,MPASS,X6,X7
      IF(MNAME.EQ.MOLDNM)GO TO 77785
      MOLDNM=MNAME
      GO TO 77784
77785 WRITE(3,REC=IIKK)NAMEX,POINT,PASSX,X6,X7,irst
      WRITE(*,77786)NAMEX,PASSX
77786 FORMAT(' Inductee ',A8,' has been added.  password = ',a8)
      IIKK=IIKK+1
      WRITE(3,REC=IIKK)NAMEX,POINT,MPASS,X6,X7,irst
      GO TO 65656
77789 WRITE(*,77790)
77790 FORMAT(' Do you want to display a name on the file (Y or N)? ')
      READ(*,6,ERR=5666,END=9680)IIIII
      IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 88889
      WRITE(*,77791)
77791 FORMAT(' Enter the last name: ')
      READ(*,676,END=9680)NAMEX
      IIKK=1
      MOLDNM=IYES
      NOLDNM=NAMEX
77794 READ(3,REC=IIKK,ERR=5666)NAMEX,X,PASSX,X6,X7
      IF(NAMEX.EQ.NOLDNM)GO TO 77795
      IF(NAMEX.EQ.MOLDNM)GO TO 77798
      MOLDNM=NAMEX
      GO TO 77794
77795 WRITE(3,REC=IIKK)NAMEX,X,PASSX,X6,X7,irst
      WRITE(*,77796)namex,passx
77796 format(1x,a8,' is on the file.  password = ',a8)
      GO TO 77789
77798 WRITE(*,77797)NOLDNM
77797 format(1x,a8,' is not on the file.')
      go to 77789
88889 write(*,77740)
77740 format(' do you want to add a holiday (Y or N)? ')
      READ(*,6,ERR=5666,END=9680)IIIII
      IF(IIIII.NE.'Y'.or.iiiii.ne.'y')GO TO 77714 
      WRITE(*,77741)
77741 FORMAT(' Enter the next two holidays[I]: ')
      READ(*,*,END=9680)NHOL1,NHOL2
      READ(3,REC=1,ERR=5666)X1,X2,X3,X4,X5,X6,X7
      WRITE(3,REC=1)X1,X2,X3,X4,X5,NHOL1,NHOL2

77714 READ(3,REC=MMKEY,ERR=5666)MNAME,POINTS,MPASS,X6,X7,irst
      WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X6,X7,irst
      IOK=0
      CALL QTIME(NTIME)
      CALL QDATE(NDATE)
      IYR=NDATE/1000
      IDAY=NDATE-IYR*1000
      ISTYR=77
      IDIFF=IYR-ISTYR
      ISEVEN=7
      ITOT=IDIFF/4 
      ITOT=ITOT+IDIFF+IDAY-1
      ITOT=MOD(ITOT,ISEVEN)
      ITOT=ITOT+1
      IF(ITOT.EQ.1.OR.ITOT.EQ.2)GO TO 44400
      IF(ITOT.EQ.7.AND.NTIME.GE.54000)GO TO 44400
      READ(3,REC=1,ERR=5666)X1,X2,X3,X4,X5,NHOL1,NHOL2
      IF(NDATE.EQ.NHOL1.OR.NDATE.EQ.NHOL2)GO TO 44400
      IF(NTIME.GE.28800.AND.NTIME.LT.42300)GO TO 5678
      IF(NTIME.GE.46800.AND.NTIME.LT.61200)GO TO 5678
      GO TO 44401
44400 IOK=1
44401 WRITE(*,677)
677   FORMAT(' Do you want this game rated (Y or N)? ')
      READ(*,6,END=9680)IDUP
6     FORMAT(A1)
      IF(IDUP.NE.NHELPS)GO TO 779
      CALL HELP(59)
      GO TO 5654
779   IF(IDUP.NE.'Y')GO TO 5678
      NRW=1
      WRITE(9,rec=1)MNAME,POINTS,MPASS,MMKEY
      IF(POINTS.NE.0.)GO TO 778
      IRANK=1
      GO TO 769
C     ...PRINT CURRENT STATUS OF PLAYER.
778   DO 772 I=1,NRANKS
      IF(RANKPT(I)-POINTS)772,771,773
771   IRANK=I
      GO TO 769
773   IRANK=I-1
      GO TO 769
772   CONTINUE
      IRANK=NRANKS
769   XNEED=RANKPT(IRANK+1)-POINTS
768   WRITE(*,668)RANKS(1,IRANK),RANKS(2,IRANK),MNAME 
668   FORMAT(' Welcome on board the Enterprise, ',2A8,2X,A8/      ' you 4728
     1have the con!')
      IF(IRANK.EQ.NRANKS)GO TO 5678
      WRITE(*,675)XNEED,RANKS(1,IRANK+1),RANKS(2,IRANK+1)
675   FORMAT(' You need ',f5.2,' points to reach the rank of ',2A8)
5678  IF(NRW.EQ.0)WRITE(9,rec=1)MNAME,POINTS,MPASS,NRW
      WRITE(*,5656)
5656  FORMAT(' Enter game level desired.[1/3] ')
      READ(*,*,ERR=800,END=9680)LEVEL
      IF(LEVEL.EQ.XHELP)GO TO 800
      IF(LEVEL.LE.0.OR.LEVEL.GT.3)GO TO 800 
11111 WRITE(*,5657)
5657  FORMAT(' Enter galactic dimensions.[2/10] ')
      READ(*,*,ERR=801,END=9680)NQUAD
      IF(NQUAD.EQ.XHELP)GO TO 801
      IF(NQUAD.LT.2.OR.NQUAD.GT.10)GO TO 801
      MMAX=NQUAD*NQUAD*2-2
      NMAX=400/(NQUAD*NQUAD)
      IF(LEVEL-2)200,300,400
200   MAXKQ=3
      MAXRQ=3
	MAXBQ=1
      MINK=3
      MINR=3
      ICLOAK=0
      PHOLE=0.
      SNOVAP=0.
      GO TO 500
300	iCLOAK=0
      PHOLE=0.
      SNOVAP=0.
      GO TO 500
400 	ICLOAK=1 

500   WRITE(*,77704)
77704 FORMAT(' Mimimum enemy vessels?[I] ')
      READ(*,*,ERR=50,END=9680)MTOT
      IF(MTOT.EQ.XHELP)GO TO 50
      IF(MTOT.GT.MMAX)MTOT=MMAX
      NTOT=MIN0(MTOT,MMAX)
      NTOT=MAX0(NTOT,MINK+MINR)
      NTOT=NTOT+SIGN(.15*RAN(IZZ)*NTOT,.5-RAN(IZZ))
      NTOT=MIN0(NTOT,MMAX)
      NTOT=MAX0(NTOT,MINK+MINR)
      IF(NTOT.LT.MTOT)NTOT=MTOT
      NKL=NTOT*RAN(IZZ)
      IF(NKL.LE.0)NKL=1
      IF(NKL.GT.MAXK)NKL=MAXK
      IF(MROM.LE.MAXR)GO TO 82829
      MROM=MAXR
      NKL=NTOT-MROM
82829 MROM=NTOT-NKL
      NDIFF=MROM-NKL
      IF(NDIFF.LT.0)GO TO 82828
      IF(NDIFF.LE.25)GO TO 55
      NDIFF=NDIFF/2
      NKL=NKL+NDIFF
      MROM=MROM-NDIFF
      GO TO 82829
82828 NDIFF=NKL-MROM
      IF(NDIFF.LE.25)GO TO 55
      NDIFF=NDIFF/2
      NKL=NKL-NDIFF
      MROM=MROM+NDIFF
      GO TO 82829
55    WRITE(*,5)
5     FORMAT(' Enter game speed 1 (fast) to 50 (slow) ') 
      READ(*,*,END=9680)ITFCTR
      IF(ITFCTR.LE.0)ITFCTR=1
      IF(ITFCTR.GT.50)ITFCTR=50
      WRITE(*,7)ITFCTR
7     FORMAT(' Timing Factor = ',I3)
      NS=RAN(IZZ)*99.+1.
C     ...DETERMINE SETUP FOR THIS GAME
      SDATE=RAN(IZZ)*5000.+500.
      XTIME=NKL*XKTIME+MROM*RTIME
      XTIME=XTIME+SQRT(XTIME)*RAN(IZZ)
C     ...REUSE XKTIME AND RTIME.
      XKTIME=.2
      RTIME=XTIME/NTOT
      FDATE=SDATE+XTIME
      NBASES= SQRT(2.*FLOAT(NTOT))/NMAX+1.
      LEFTK=NKL
      LEFTR=MROM
C     ...OUTPUT STARTING CONDITIONS
      CALL CPAGE
      WRITE(*,3)SDATE,NS,NKL,MROM,NTOT,XTIME,FDATE
3     format(' Space, the Final Frontier.'/      ' This is a Voyage of t4813
     1he Starship "Enterprise".'/      ' its five year mission, to explo4814
     1re strange new worlds,'/      ' to seek out new life and new civil4815
     1izations,'/      ' to boldly go where no man has gone before! '   4816
     1//      '                    S T A R   T R E K'/       '          4817
     1  August 1984 Joseph V. DiMeo Consulting     '/       '-----------4818
     1-------------------------------------------------'/        ' Order4819
     1s: Stardate ',F7.2,'   Starfleet Command (TOP SECRET)'//      ' co4820
     1mmunications with sector ',i2,' of the galaxy were suddenly'/     4821
     1 ' cut off a few stardays ago. The last report from that area'/   4822
     1   ' was that a fleet of ',i3,' Klingons and ' ,i3,' Romulans had'4823
     1/      ' invaded and destroyed every federation ship in the area.'4824
     1/      ' your mission, as the pride of the federation starfleet,'/4825
     1      ' is to destroy the entire enemy force (',i3,' vessels).'/  4826
     1    ' you have only ',f6.2,' stardays to accomplish your task, as 4827
     1The'/      ' federation president''s reelection campaign begins on4828
     1 stardate'/      f8.2,' and, as you well know, his opponent propos4829
     1es appropriations'/      ' cutbacks for the space academy and elim4830
     1ination of the '/      ' traditional vulcan bowl game.')
C     ...SET UP GALACTIC MAP(JGAL).
C     ...IGAL SET INITIALLY TO ALL -1S 
	pause ' Press  Return to continue '
	call cpage
99	continue
	DO 100    J=1,NQUAD
      DO 100    I=1,NQUAD
      IGAL(I,J)=-1
      JGAL(I,J)=RAN(IZZ)*MAXSQ
C     ...PUT IN BLACK HOLES AND WHERE THEY GO TO.
      IBL(I,J)=0
      IF(RAN(IZZ).GT.PHOLE)GO TO 100
95	CONTINUE
	Q=RAN(IZZ)
	ICE=RAN(IZZ)*NQUAD+1.
      JCE=RAN(IZZ)*NQUAD+1.
      IF(ICE.EQ.I.AND.JCE.EQ.J)GO TO 95
      IBL(I,J)=ICE*100+JCE
100   CONTINUE
C     ...PUT THINGS IN QUADRANTS
      CALL PLIN(NBASES,MAXBQ*10,10)
      CALL PLIN(NKL,MAXKQ*100,100)
      CALL PLIN(MROM,MAXRQ*1000,1000)
C     ...ENTERPRISE IN UNOCCUPIED QUADRANT
      MMAX=9999
      DO 110 I=1,NQUAD
      DO 110 J=1,NQUAD
      IF(JGAL(I,J).GE.MMAX)GO TO 110
      MMAX=JGAL(I,J)
      ICE=I
      JCE=J
      IF(MMAX.LE.99)GO TO 111
110   CONTINUE
      GO TO 99
111   CONTINUE
      JCPS=0
C     ...SETUP E
      ENERGY=SENRGY
      DO 9944 I=2,20
      ITRMEN(I)=0
      ICNTL(I)=0
9944  CONTINUE
      ITRMEN(1)=IFGHTM
      MEN=NMEN
      ITORP=NTRP
      ISTSH=0
      ISHD=0
C     ...ZERO DAMAGE ARRAY
      DO 995    I=1,10
      IF(I.EQ.10)GO TO 995
      IFNDS(I)=0
995   IDMG(I)=0
      IX=RAN(IZZ)*10.+1.
      IY=RAN(IZZ)*10.+1.
      XQE=IX
      YQE=IY
      DEFL=0.
C     ...START WITH SHORT RANGE SCAN
      IDOCK=0
      PNRGY=0.
      IHWARP=0
      DDEG=0.
      PDEG=0.
      DSP=0.
      PSP=0.
      ITRUCE=0
      ITRSTP=0
      ITFIRE=0
      IHERE=0
      CALL SCAN 
C     ...START TIMER. NTSTPS=TOTAL NO OF STEPS TO DATE
      NTSTPS=0
      DVWP0=DVWP
      EWRP0=EWRP
      DISTP0=DISTPE
      ETVEL0=ETVEL
      IETOF0=IETOFT
      DISTG0=DISTGT
      CODDS0=CODDS
      EODDS0=EODDS
      IDAMR0=IDAMRP
      SHLDF0=SHLDF
      TRNRG0=TRNRGY
      PJAM0=PJAM
      RETURN
800   CALL HELP(56)
      GO TO 5678
801   CALL HELP(57)
      GO TO 11111
50    CALL HELP(58)
      GO TO 500
9776  WRITE(*,9777)
9777  FORMAT(' SORRY, BUT YOU ARE NOT AUTHORIZED TO USE THIS PROGRAM.') 4919
9680	close (3)
	close (9)
	STOP
      END
     4403
      GHOST(11)=RAN(IZZ)*GHEMX                                  