home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTRAN / SUPERT87.ZIP / RSTART.FOR < prev    next >
Encoding:
Text File  |  1986-12-15  |  3.2 KB  |  112 lines
  1.       SUBROUTINE RSTART(NN)
  2.  
  3. c    include 'tcommon.for'
  4.     %include tcommon.for
  5.  
  6.       DATA MZERO/0/        
  7. C     ...RESTART GAME IF NOT PRIME TIME.
  8.       GO TO(62001,62002),NN
  9. 62001 IOK=0
  10.       CALL QTIME(NTIME)
  11.       CALL QDATE(NDATE)
  12.       IYR=NDATE/1000
  13.       IDAY=NDATE-IYR*1000
  14.       ISTYR=77
  15.       IDIFF=IYR-ISTYR
  16.       ISEVEN=7
  17.       ITOT=IDIFF/4
  18.       ITOT=ITOT+IDIFF+IDAY-1
  19.       ITOT=MOD(ITOT,ISEVEN)
  20.       ITOT=ITOT+1
  21.       IF(ITOT.EQ.1.OR.ITOT.EQ.2)GO TO 62007
  22.       IF(ITOT.EQ.7.AND.NTIME.GE.54000)GO TO 62007
  23.       READ(3,REC=1,ERR=62010)X1,X2,X3,X4,X5,NHOL1,NHOL2
  24.       IF(NDATE.EQ.NHOL1.OR.NDATE.EQ.NHOL2)GO TO 62007
  25.       IF(NTIME.GE.28800.AND.NTIME.LT.42300)GO TO 62008
  26.       IF(NTIME.GE.46800.AND.NTIME.LT.61200)GO TO 62008
  27.       GO TO 62011
  28. 62007 IOK=1
  29. 62011 WRITE(*,62003)
  30. 62003 FORMAT(' Restart from saved game.')
  31.     pause ' Press return key to continue...'
  32.       CALL BPAGE
  33.       READ(3,REC=MMKEY)MNAME,POINTS,MPASS,X1,X2,irst,
  34.      1  MROM,XTIME,SDATE,ENERGY,ITORP,MEN,ITRMEN(1),DVWP,EWRP,DISTPE,
  35.      1  TRATE,RTIME,DISTGT,CODDS,EODDS,IDAMRP,TRNRGY,PJAM,SHLDF,ICLOAK,
  36.      1  ETVEL,IETOFT,NQUAD,ITFCTR,NTSTPS,DVWP0,EWRP0,DISTP0,ETVEL0,
  37.      1  ISHNUM,LEVEL,CODDS0,EODDS0,IDAMR0,SHLDF0,TRNRG0,PJAM0,JCE,ICE,
  38.      1  IETOF0,DISTG0,IRANKLEFTK,LEFTR,MAXBQ,NKL
  39.      1  ,((IGAL(I,J),I=1,10),J=1,10),((IBL(I,J),I=1,10),J=1,10),
  40.      1  ((JGAL(I,J),I=1,10),J=1,10)
  41.  
  42.       WRITE(3,REC=MMKEY)MNAME,POINTS,MPASS,X1,X2
  43.       WRITE(9,REC=1)MNAME,POINTS,MPASS,MMKEY
  44.       IF(LEVEL-2)63001,63002,63003
  45. 63001 MAXKQ=3
  46.       MAXRQ=3
  47.       MINK=3
  48.       MINR=3
  49.       ICLOAK=0
  50.       PHOLE=0.
  51.       SNOVAP=0.
  52.       GO TO 63003
  53. 63002 ICLOAK=0
  54.       PHOLE=0.
  55.       SNOVAP=0.
  56. 63003 DO 62005 I=2,20
  57.       ITRMEN(I)=0
  58.       ICNTL(I)=0
  59. 62005 CONTINUE
  60.       ISTSH=0
  61.       ISHD=0
  62. C     ...ZERO DAMAGE ARRAY
  63.       DO 62006  I=1,10
  64.       IF(I.EQ.10)GO TO 62006
  65.       IFNDS(I)=0
  66. 62006 IDMG(I)=0
  67.       IX=RAN(IZZ)*10.+1.
  68.       IY=RAN(IZZ)*10.+1.
  69.       XQE=IX
  70.       YQE=IY
  71.       DEFL=0.
  72. C     ...START WITH SHORT RANGE SCAN
  73.       IDOCK=0
  74.       PNRGY=0.
  75.       IHWARP=0
  76.       DDEG=0.
  77.       PDEG=0.
  78.       DSP=0.
  79.       PSP=0.
  80.       ITRUCE=0
  81.       ITRSTP=0
  82.       ITFIRE=0
  83.       IHERE=0
  84.       KLNGNS=0
  85.       NROM=0
  86.       NRW=1
  87.       CALL SCAN
  88.       RETURN
  89. 62008 WRITE(*,62009)
  90. 62009 FORMAT(' Cannot restart game during prime time.')
  91. 62010    close(3)
  92.     close(9)
  93.     STOP
  94. C     ...SAVE GAME - CAN'T PLAY ANOTHER UNTIL THIS ONE FINISHED
  95. 62002 WRITE(*,62004)
  96. 62004 FORMAT(' Game Will be automatically restarted at next playing.')  4215
  97.       READ(3,REC=MMKEY)MNAME,POINTS,MPASS,X1,X2
  98.     irst=1
  99.       write(3,REC=MMKEY)MNAME,POINTS,MPASS,X1,X2,irst,
  100.      1  MROM,XTIME,SDATE,ENERGY,ITORP,MEN,ITRMEN(1),DVWP,EWRP,DISTPE,
  101.      1  TRATE,RTIME,DISTGT,CODDS,EODDS,IDAMRP,TRNRGY,PJAM,SHLDF,ICLOAK,
  102.      1  ETVEL,IETOFT,NQUAD,ITFCTR,NTSTPS,DVWP0,EWRP0,DISTP0,ETVEL0,
  103.      1  ISHNUM,LEVEL,CODDS0,EODDS0,IDAMR0,SHLDF0,TRNRG0,PJAM0,JCE,ICE,
  104.      1  IETOF0,DISTG0,IRANKLEFTK,LEFTR,MAXBQ,NKL
  105.      1  ,((IGAL(I,J),I=1,10),J=1,10),((IBL(I,J),I=1,10),J=1,10),
  106.      1  ((JGAL(I,J),I=1,10),J=1,10)
  107.       write(9,REC=1)MNAME,POINTS,MPASS,MZERO
  108.     close(3)
  109.     close(9)
  110.       STOP
  111.       END
  112.