c c COMMAND3.FOR c c More Commands. c Includes modules: c COMP_CMD c TRUCE_CMD c DESTRUCT c AUTO_CMD c SHTL_CMD c SRSCAN c LRSCAN c DMG_RPT c GAL_SCAN c PLOTS c TRACKS c STATUS c TRACTOR_CMD c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION comp_cmd IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c REAL*4 Range INTEGER*4 Fnr LOGICAL*4 Get_str c INTEGER*4 i,p,stime REAL*4 x,y,d CHARACTER ans*1 c c Computer request. c IF (damage(computer) .GT. 0.0 .OR. tribbles) THEN WRITE (ttyout,5) comp_cmd = .FALSE. RETURN ENDIF 100 IF (.NOT. Get_str('Computer request',ans,'COMPUTER REQUEST')) THEN comp_cmd = .FALSE. RETURN ENDIF IF (ans .EQ. 'S') THEN ! Shuttlecraft round trip time IF (shuttle .EQ. SH_lost .OR. shuttle .EQ. SH_onboard) THEN WRITE (ttyout,1) comp_cmd = .FALSE. RETURN ENDIF stime = 0 x = shtl_x y = shtl_y IF (shuttle .EQ. SH_home) GOTO 150 DO i = 1,9 p = shtl_path(i) IF (p .GT. 0) THEN d = Range(x,planet_x(p),y,planet_y(p)) - 1.0 stime = stime + d / 0.25 + 2 + Fnr(0,3) x = planet_x(p) y = planet_y(p) ELSE GOTO 150 ENDIF ENDDO 150 d = Range(x,xqe,y,yqe) stime = stime + d / 0.25 WRITE (ttyout,2) stime ELSEIF (ans .EQ. 'G') THEN ! Energy required to pull in G IF (n_gh .GT. 0 .AND. gh_ctl(1) .NE. Destroyed) THEN d = Range(xqe,gh_x(1),yqe,gh_y(1)) ** 2 x = d * 25.0 / tech(TECH_pulse) WRITE (ttyout,3) x ELSE WRITE (ttyout,4) ENDIF ELSEIF (ans .EQ. 'B') THEN ! Where black hole will take you DO i = 1,n_hole WRITE (ttyout,6) hole_x(i),hole_y(i), 1 x_hole_to(i,ice,jce),y_hole_to(i,ice,jce) ENDDO IF (n_hole .EQ. 0) WRITE (ttyout,8) ELSE WRITE (ttyout,7) GOTO 100 ENDIF c CALL fizzle(1.0,computer) comp_cmd = .TRUE. c RETURN 1 FORMAT (' Shuttlecraft not on an expedition now.') 2 FORMAT (' Estimated round trip time is',i4,' starminutes.') 3 FORMAT (' Energy required is',f7.1) 4 FORMAT (' No ghostship in quadrant.') 5 FORMAT (' Computer is out of whack!?') 6 FORMAT (' Hole at',f5.0,',',f5.0,' will take you to quadrant', 1 i3,',',i3) 7 FORMAT (' Illegal computer request.') 8 FORMAT (' No black holes in quadrant.') END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION truce_cmd IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c REAL*4 Rnd c REAL*4 thits,tleft INTEGER*4 m c c Check if enemy will accept proposed truce. c IF (truce) RETURN thits = 0.0 tleft = 0.0 DO m = 1,n_kl IF (kl_ctl(m) .EQ. Them .AND. kl_troops(m) .EQ. 0) THEN thits = thits + kl_hits(m) tleft = tleft + 300.0 ENDIF ENDDO DO m = 1,n_rom IF (rom_ctl(m) .EQ. Them .AND. rom_troops(m) .EQ. 0) THEN thits = thits + rom_hits(m) tleft = tleft + 400.0 ENDIF ENDDO IF (Rnd() .LE. (thits/tleft) / 0.8) THEN WRITE (ttyout,1) truce = .TRUE. ELSE WRITE (ttyout,2) truce = .FALSE. ENDIF c truce_cmd = .TRUE. CALL chronos RETURN c 1 FORMAT (' All right, but don''t try anything funny.') 2 FORMAT (' You gotta be kidding.') END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION destruct IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c LOGICAL*4 Get_str,Yes c CHARACTER ans*1 c c Go out with a bang. c IF (.NOT. Get_str('Are you sure (y/n)',ans,'DESTRUCT')) THEN destruct = .FALSE. RETURN ENDIF IF (.NOT. Yes(ans)) THEN WRITE (ttyout,1) destruct = .FALSE. RETURN ENDIF CALL blowup(Self_destruct) c RETURN 1 FORMAT (' Self-destruct sequence cancelled.') END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION auto_cmd IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c LOGICAL*4 Get_str,Get_real c REAL*4 nrg CHARACTER ans*1 c c Autopilot command. c IF (damage(computer) .GT. 0.0) THEN WRITE (ttyout,5) damage(computer),item_name(computer) auto_cmd = .FALSE. RETURN ENDIF IF (tribbles) THEN WRITE (ttyout,4) auto_cmd = .FALSE. RETURN ENDIF 100 IF (.NOT. Get_str('Autopilot request',ans,'AUTOPILOT REQUEST')) THEN auto_cmd = .FALSE. RETURN ENDIF IF (ans .EQ. 'B') THEN ! Begin operation autopilot = .TRUE. WRITE (ttyout,1) cutoff ELSEIF (ans .EQ. 'S') THEN ! Stop operation autopilot = .FALSE. autoprint = .FALSE. WRITE (ttyout,2) ELSEIF (ans .EQ. 'E') THEN ! Set energy cutoff level IF (.NOT. Get_real('Cutoff',nrg,'AUTOPILOT CUTOFF')) THEN auto_cmd = .FALSE. RETURN ENDIF cutoff = nrg WRITE (ttyout,6) cutoff ELSEIF (ans .EQ. 'P') THEN ! TUrn on print flag autoprint = .TRUE. ELSEIF (ans .EQ. 'R') THEN ! Turn off print flag autoprint = .FALSE. ELSEIF (ans .EQ. 'T') THEN ! Print status IF (autopilot) THEN WRITE (ttyout,1) cutoff ELSE WRITE (ttyout,2) ENDIF ELSE WRITE (ttyout,3) GOTO 100 ENDIF c auto_cmd = .TRUE. RETURN 1 FORMAT (' Autopilot is turned ON. Cutoff level is:',f7.1) 2 FORMAT (' Autopilot is turned OFF.') 3 FORMAT (' Illegal autopilot request.') 4 FORMAT (' Computer is out of whack!?') 5 FORMAT (' Activity cancelled because of',f7.1, 1 ' units (absolute) damage to ',a) 6 FORMAT (' Cutoff level set to',f7.1) END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION shtl_cmd IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c LOGICAL*4 Get_str,Get_int c INTEGER*4 n,np,p,tpath(9) CHARACTER ans*1 c c Shuttlecraft commands (R,E,D). c IF (psp .GE. 1.0) THEN WRITE (ttyout,2) shtl_cmd = .FALSE. RETURN ENDIF IF (shuttle .EQ. SH_lost) THEN WRITE (ttyout,1) shtl_cmd = .FALSE. RETURN ENDIF IF (.NOT. Get_str('Shuttlecraft command',ans,'SHUTTLE COMMAND')) THEN shtl_cmd = .FALSE. RETURN ENDIF IF (ans .EQ. 'R') THEN ! Returning to Enterprise IF (shuttle .EQ. SH_onboard) THEN WRITE (ttyout,3) shtl_cmd = .FALSE. RETURN ENDIF shuttle = SH_home ELSEIF (ans .EQ. 'E') THEN ! Exploring planets np = 0 100 IF (np .GT. 9) GOTO 150 120 IF (.NOT. Get_int('Planet to explore',p,'SHUTTLE EXPLORE')) THEN shtl_cmd = .FALSE. RETURN ENDIF IF (p .LE. 0) GOTO 150 IF (p .GT. n_planet) THEN WRITE (ttyout,4) GOTO 120 ENDIF IF (planet_ctl(p) .EQ. Destroyed .OR. explored(p)) THEN WRITE (ttyout,5) GOTO 120 ENDIF np = np + 1 tpath(np) = p GOTO 100 150 IF (np .LE. 0) THEN shtl_cmd = .FALSE. RETURN ENDIF DO n = 1,9 IF (n .LE. np) THEN shtl_path(n) = tpath(n) ELSE shtl_path(n) = 0 ENDIF ENDDO shuttle = SH_to_planet ELSEIF (ans .EQ. 'D') THEN ! Destroy shuttlecraft IF (shuttle .EQ. SH_onboard) THEN WRITE (ttyout,6) shtl_cmd = .FALSE. RETURN ENDIF shuttle = SH_destruct ELSE WRITE (ttyout,7) shtl_cmd = .FALSE. RETURN ENDIF shtl_cmd = .TRUE. CALL chronos c RETURN 1 FORMAT (' No shuttlecraft available.') 2 FORMAT (' Illegal while in hyperspace.') 3 FORMAT (' Shuttlecraft already on board.') 4 FORMAT (' Value out of range') 5 FORMAT (' Planet does not exist or has already been explored.') 6 FORMAT (' Shuttlecraft already on board...tooo late!') 7 FORMAT (' Illegal shuttlecraft command.') END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION srscan IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c c Do Short Range Scan c IF (psp .GE. 1.0) THEN WRITE (ttyout,1) srscan = .FALSE. RETURN ENDIF IF (damage(SR_scan) .LE. 0.0) THEN CALL fill_quad CALL disp_srs srscan = .TRUE. ELSE WRITE (ttyout,5) damage(SR_scan),item_name(SR_scan) srscan = .FALSE. ENDIF c RETURN 1 FORMAT (' Illegal while in hyperspace.') 5 FORMAT (' Activity cancelled because of',f7.1, 1 ' units (absolute) damage to ',a) END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION lrscan IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c c Display Long range scan. c IF (damage(LR_scan) .LE. 0.0) THEN CALL gen_lrs CALL disp_lrs lrscan = .TRUE. ELSE WRITE (ttyout,5) damage(LR_scan),item_name(LR_scan) lrscan = .FALSE. ENDIF c RETURN 5 FORMAT (' Activity cancelled because of',f7.1, 1 ' units (absolute) damage to ',a) END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION dmg_rpt IMPLICIT NONE c CALL disp_dmg dmg_rpt = .TRUE. c RETURN END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION gal_scan IMPLICIT NONE c CALL disp_gal gal_scan = .TRUE. c RETURN END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION plots IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c INTEGER*4 Howmany_inq c INTEGER*4 i,j c IF (psp .GE. 1.0) THEN WRITE (ttyout,1) plots = .FALSE. RETURN ENDIF IF (damage(SR_scan) .LE. 0.0) THEN CALL disp_plots plots = .TRUE. ELSE WRITE (ttyout,5) damage(SR_scan),item_name(SR_scan) plots = .FALSE. ENDIF c RETURN 1 FORMAT (' Illegal while in hyperspace.') 5 FORMAT (' Activity cancelled because of',f7.1, 1 ' units (absolute) damage to ',a) END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION status IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c c CALL disp_status status = .TRUE. c RETURN END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION tracks IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c LOGICAL*4 Get_str c CHARACTER ans*1 c IF (psp .GE. 1.0) THEN WRITE (ttyout,1) tracks = .FALSE. RETURN ENDIF IF (damage(SR_scan) .LE. 0.0) THEN IF (.NOT. Get_str('Which report',ans,'TRACKING REPORT')) THEN tracks = .FALSE. RETURN ENDIF IF (ans .NE. 'V' .AND. ans .NE. 'T' .AND. 1 (ans .NE. 'S' .OR. level .NE. Expert)) THEN WRITE (ttyout,2) tracks = .FALSE. RETURN ENDIF track_rpt = ans CALL disp_tracks tracks = .TRUE. ELSE WRITE (ttyout,5) damage(SR_scan),item_name(SR_scan) tracks = .FALSE. ENDIF c RETURN 1 FORMAT (' Illegal while in hyperspace.') 2 FORMAT (' Illegal request.') 5 FORMAT (f7.1,' Units (absolute) damage to ',a,' prevents activity.') END c c -------------------------------------------------------------------------- c LOGICAL*4 FUNCTION tractor_cmd IMPLICIT NONE INCLUDE 'ST84.FTN/Nolist' INCLUDE 'IO.FTN/Nolist' c INTEGER*4 Get_int c INTEGER*4 n,g c IF (damage(pulsar) .GT. 0.0) THEN WRITE (ttyout,5) damage(pulsar),item_name(pulsar) tractor_cmd = .FALSE. RETURN ENDIF IF (psp .GE. 1.0) THEN WRITE (ttyout,3) tractor_cmd = .FALSE. RETURN ENDIF IF (shields .GT. 0.0) THEN WRITE (ttyout,4) tractor_cmd = .FALSE. RETURN ENDIF IF (gh_ctl(1) .EQ. Destroyed) THEN WRITE (ttyout,1) tractor_cmd = .FALSE. RETURN ENDIF tr_nrg = .TRUE. tractor_cmd = .TRUE. CALL chronos c RETURN 1 FORMAT (' No ghostship in quadrant.') 2 FORMAT (' Value out of range.') 3 FORMAT (' Illegal while in hyperspace.') 4 FORMAT (' Illegal with shields up.') 5 FORMAT (' Activity cancelled because of',f7.1, 1 ' units (absolute) damage to ',a) END