SUBROUTINE DAMGED C** DAMAGE CONTROL ROUTINE COMMON /GENDTA/SDATE,COND(2),KLING,TMLEFT,ITORP,ENERGY,SHELDS COMMON /DAMAGS/IRPARS(10,2),IRAND,IRATE,IDMGD,TSTRT,GTIME COMMON /RMULN/IRMLN,IRMX,IRMY,IHTMS C** IRATE INDICATES IF THERE IS DAMAGE C** IDMGD = 2 - BUY REPAIRS C** 1 - ESTABLISH DAMAGE C** 0 - UPDATE DAMAGE C** 3 - ADVANCED GAME MOVEMENT DAMAGES IF(IDMGD .EQ. 3)GO TO 300 IF(IDMGD .EQ. 2)GO TO 299 IF(IDMGD .EQ. 0)GO TO 500 C** DETERMINE DAMAGE BY A RANDOM NUMBER HURT = RANDOM(IRAND) IHURT = HURT*7.0 + 1.0 IF(IHURT .GT. 6)GO TO 152 ADMGED = RANDOM(IRAND)*200. + 1.0 ADMGED = AMAX1(100.0,ADMGED) IRPARS(IHURT,1) = ADMGED C** SET TIME WHEN REPAIRS WILL BE CONPLETE IRPARS(IHURT,2) = SECNDS(TSTRT) + ADMGED 152 CALL ADVICE(4) GO TO 999 C** DAMAGES C** IHURT = 1 COMPUTER DAMAGE C** 2 PHASER DAMAGE C** 3 TORPEDO TUBES DAMAGED C** 4 S.R. SENSORS C** 5 L.R. SENSORS C** 6 WARP ENGINES 500 ITMEX = SECNDS(TSTRT) + 10.0 IRATE = 0 199 DO 100 I=1,6 IF(IRPARS(I,1) .EQ. 0)GO TO 100 IF(IRPARS(I,2) .LE. ITMEX)GO TO 75 C** REDUCE DAMAGE VALUE IRPARS(I,1) = IRPARS(I,2) - SECNDS(TSTRT) IF(IRPARS(I,1) .LE. 0)GO TO 75 IRATE = 1 GO TO 100 C** REPAIRS HAVE BEEN COMPLETED 75 IRPARS(I,1) = 0 IRPARS(I,2) = 0 100 CONTINUE GO TO 999 C** BUY REPAIRS C** 299 TYPE *,' ' TYPE *,' ITEMS THAT CAN BE REPAIRED' TYPE *,' 1 = COMPUTER' TYPE *,' 2 = PHASERS' TYPE *,' 3 = TORPEDO TUBES' TYPE *,' 4 = S.R. SENSORS' TYPE *,' 5 = L.R. SENSORS' TYPE *,' 6 = WARP ENGINES' TYPE 2001 2001 FORMAT(' INPUT ITEM NO. TO REPAIR> ',$) ACCEPT *,ITEM TYPE 2002,IRPARS(ITEM,1) 2002 FORMAT(' UNITS NEEDED TO COMPLETE REPAIRS =',I5) TYPE 2003 2003 FORMAT(' INPUT UNITS TO ALLOCATE TO REPAIRS>',$) ACCEPT *,VALUE IRPARS(ITEM,1) = IRPARS(ITEM,1) - VALUE IRPARS(ITEM,2) = IRPARS(ITEM,2) - VALUE GTIME = GTIME - VALUE*0.5 GO TO 998 C** C** ADVANCED GAME DAMAGES C** 300 IF(COND(1) .EQ. 'DOCK')GO TO 998 IDO = RANDOM(IRAND)*10.0 + 1.0 IF(IDO .LT. 6 .OR. IDO .GT. 7)GO TO 999 IF(IDO .EQ. 7)GO TO 350 TYPE *,' *** SHORT RANGE SENSORS DAMAGED BY ***' TYPE *,' *** METEOR SHOWER ***' IRPARS(4,1) = 60.0 IRPARS(4,2) = SECNDS(TSTRT) + 60. GO TO 998 350 TYPE *,' *** LONG RANGE SENSORS REPORTED NOT FUNCTIONING ***' TYPE *,' *** BECAUSE OF GALACTIC STORM ***' IRPARS(5,1) = 60. IRPARS(5,2) = SECNDS(TSTRT) + 60. 998 IDMGD = 0 999 RETURN END