seed7/prg/startrek.sd7

(********************************************************************)
(*                                                                  *)
(*  startrek.sd7  Classical startrek game                           *)
(*  Copyright (C) 2004  Thomas Mertes                               *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ include "seed7_05.s7i";
  include "stdio.s7i";
  include "float.s7i";
  include "math.s7i";

const float: max_energy is 4000.0;
const integer: max_torpedoes is 10;
const float: maxKlingonEnergy is 400.0;
const string: sector_description is ".EKB*";

const integer: WARP_ENGINES        is 1;
const integer: SHORT_RANGE_SENSORS is 2;
const integer: LONG_RANGE_SENSORS  is 3;
const integer: PHASERS             is 4;
const integer: PHOTON_TORPEDOES    is 5;
const integer: GALACTIC_RECORDS    is 6;

const array string: description is [](
    "Warp engines","Short range sensors","Long range sensors",
    "Phasers","Photon torpedoes","Galactic records");

var integer: total_klingons is 0;
var array integer: klingonRow is 8 times 0;
var array integer: klingonColumn is 8 times 0;
var array float: klingonEnergy is 8 times 0.0;

var array array integer: quad is 8 times 8 times 0;
var integer: quadrantRow is 1;
var integer: quadrantColumn is 1;
var integer: klingons_in_quadrant is 0;
var integer: bases_in_quadrant is 0;
var integer: stars_in_quadrant is 0;

var array array integer: sect is 8 times 8 times 0;
var integer: sectorRow is 1;
var integer: sectorColumn is 1;

var integer: klingons_in_game is 0;
var integer: stardate is 0;
var integer: startStardate is 0;
var integer: endStardate is 0;

var string: cond is "";
var array integer: damage is 6 times 0;
var float: energy is 0.0;
var integer: torpedoes is 0;


const proc: title is func
  begin
    writeln("STAR TREK!!");
    writeln("===========");
    writeln;
  end func; (* title *)


const proc: help_course is func
  begin
    writeln("Course - A number from 1 to 9 indicating a direction.                4   3   2");
    writeln("Starting with a 1 to the right and increasing counterclockwise.        \\ | /");
    writeln("To move to the left, use a course of 5.                              5 - E - 1");
    writeln("A course of 3.5 is halfway between 3 and 4.                            / | \\");
    writeln("A course of 8.75 is three-quarters of the way from 8 to 1.           6   7   8");
  end func; (* help_course *)


const proc: help_sector is func
  begin
    writeln("Each sector can contain a Klingon (K), star (*), starbase (B), the Enterprise");
    writeln("herself (E), or empty space (.).  Each sector is also numbered; a starbase in");
    writeln("sector 3-5 is 3 rows down from the top of the short range scan print-out, and");
    writeln("5 sectors to the right.");
  end func; (* help_sector *)


const proc: help_quadrant is func
  begin
    writeln("The known galaxy is divided into 64 quadrants arranged like a square");
    writeln("checkerboard, 8 on a side.  Each quadrant is represented as a 3-digit number.");
    writeln("The first (hundreds) digit is the number of Klingons in that quadrant, while");
    writeln("the middle (tens) digit is the number of starbases, and the units digit is the");
    writeln("number of stars.  An entry of 305 means 3 Klingons, no starbases, and 5 stars.");
  end func; (* help_quadrant *)


const proc: help_warp_engines is func
  begin
    writeln("WARP ENGINE (command 1 or W):");
    writeln("The warp engine control is used to move the Enterprise.  You will be asked to");
    writeln("set the course, and the distance (measured in warps) for the move.  Each move");
    writeln("that you make with the Enterprise from one sector to another, or from one");
    writeln("quadrant to another, costs you one stardate.  Therefore, a 30-stardate game");
    writeln("means you have 30 moves to win in.");
    writeln;
    help_course;
    writeln;
    writeln("Warp - One warp moves you the width of a quadrant.  A warp of .5 will move you");
    writeln("halfway through a quadrant.  Moving diagonally across a quadrant to the next");
    writeln("will require 1.414 warps.  Warp 3 will move you 3 quadrants providing nothing");
    writeln("in your present quadrant blocks your exit.  Once you leave the quadrant that");
    writeln("you were in, you will enter hyperspace; coming out of hyperspace will place you");
    writeln("randomly in the new quadrant.  Klingons in a given quadrant will fire at you");
    writeln("whenever you leave, enter, or move within the quadrant.  Entering a course or");
    writeln("warp of zero can be used to return to the command mode.");
  end func; (* help_warp_engines *)


const proc: help_short_range_sensors is func
  begin
    writeln("SHORT RANGE SENSORS (command 2 or S):");
    writeln("A short range sensor scan will print out the quadrant you presently occupy");
    writeln("showing the content of each of the 64 sectors, as well as other pertinent");
    writeln("information.");
    writeln;
    help_sector;
  end func; (* help_short_range_sensors *)


const proc: help_long_range_sensors is func
  begin
    writeln("LONG RANGE SENSORS (command 3 or L):");
    writeln("The long range sensor scan summarizes the quadrant you are in, and the");
    writeln("adjoining ones.");
    writeln;
    help_quadrant;
  end func; (* help_long_range_sensors *)


const proc: help_phasers is func
  begin
    writeln("PHASERS (command 4 or P):");
    writeln("The portion of the Enterprise's energy that you specify will be divided evenly");
    writeln("among the Klingons in the quadrant and fired at them.  Surviving Klingons will");
    writeln("retaliate.  Phaser fire bypasses stars and starbases, but is attenuated by the");
    writeln("distance it travels.  The arriving energy depletes the shield power of its");
    writeln("target.  Energy is automatically diverted to the shields as needed, but if you");
    writeln("run out of energy you'll get fried.");
  end func; (* help_phasers *)


const proc: help_photon_torpedoes is func
  begin
    writeln("PHOTON TORPEDOES (command 5 or T):");
    writeln("Photon torpedo control will launch a torpedo on a course you specify which will");
    writeln("destroy any object in its path.  Range is limited to the local quadrant.");
    writeln("Expect return fire from surviving Klingons.");
    writeln;
    help_course;
  end func; (* help_photon_torpedoes *)


const proc: help_galactic_records is func
  begin
    writeln("GALACTIC RECORDS (command 6 or G):");
    writeln("The galactic records section of the ship's computer responds to this command by");
    writeln("printing out a galactic map showing the results of all previous sensor scans.");
    writeln;
    help_quadrant;
  end func; (* help_galactic_records *)


const proc: help_commands is func
  begin
    writeln("Your starship will act on the following commands:");
    writeln("   1 or W  - Warp engine                     ? or H  - Display help info");
    writeln("   2 or S  - Short range sensors             Q       - Quit the game");
    writeln("   3 or L  - Long range sensors");
    writeln("   4 or P  - Phasers");
    writeln("   5 or T  - Photon torpedoes");
    writeln("   6 or G  - Galactic records");
  end func; (* help_commands *)


const proc: help_game is func
  begin
    writeln("   It is stardate 3421 and the federation is being invaded by a band of Klingon");
    writeln("'pirates' whose objective is to test our defenses.  If even one survives the ");
    writeln("trial period, Klingon headquarters will launch an all-out attack.  As captain");
    writeln("of the federation starship 'Enterprise', your mission is to find and destroy");
    writeln("the invaders before the time runs out.");
    writeln;
    writeln("   You mission is supported by starbases.  Docking at a starbase is done by");
    writeln("occupying an adjacent sector. It reprovisions your starship with energy and");
    writeln("photon torpedoes, as well as repairing all damages.");
    writeln;
    help_commands;
  end func; (* help_game *)


const proc: help_quit is func
  begin
    writeln("QUIT (command Q):");
    writeln("The quit command allows you to quit your job as captain.");
  end func; (* help_quit *)


const proc: help is func
  local
    var string: command is "";
  begin
    writeln;
    help_game;
    writeln;
    repeat
      write("Type a command to get information about it or enter to leave help: ");
      readln(command);
      writeln;
      if command <> "" then
        case upper(command[1]) of
          when {'1', 'W'}: help_warp_engines;
          when {'2', 'S'}: help_short_range_sensors;
          when {'3', 'L'}: help_long_range_sensors;
          when {'4', 'P'}: help_phasers;
          when {'5', 'T'}: help_photon_torpedoes;
          when {'6', 'G'}: help_galactic_records;
          when {'?', 'H'}: help_game;
          when {'Q'}:      help_quit;
          otherwise:       help_commands;
        end case;
        writeln;
      end if;
    until command = "";
  end func; (* help *)


const proc: fix_damage is func
  local
    var integer: equipment is 0;
  begin
    for equipment range 1 to 6 do
      damage[equipment] := 0;
    end for;
  end func; (* fix_damage *)


const proc: find_free_sector (inout integer: row, inout integer: column) is func
  begin
    repeat
      row := rand(1, 8);
      column := rand(1, 8);
    until sect[row][column] <= 1;
  end func; (* find_free_sector *)


const proc: init is func
  local
    var integer: row is 0;
    var integer: column is 0;
    var integer: total_bases is 0;
    var float: number is 0.0;
    var integer: klingons is 0;
    var integer: bases is 0;
  begin
    fix_damage;
    quadrantRow:= rand(1, 8);
    quadrantColumn:= rand(1, 8);
    total_klingons := 0;
    total_bases := 0;
    startStardate := 3421;
    endStardate := 3451;
    stardate := startStardate;
    energy := max_energy;
    torpedoes := max_torpedoes;
    for row range 1 to 8 do
      for column range 1 to 8 do
        klingons := 0;
        number := rand(0.0, 1.0);
        if number < 0.2075 then
          number := number * 64.0;
          klingons := 1 + ord(number < 6.28) + ord(number < 3.28) +
              ord(number < 1.8) + ord(number < 0.28) + ord(number < 0.08) +
              ord(number < 0.03) + ord(number < 0.01);
          total_klingons +:= klingons;
        end if;
        bases := ord(rand(0.0, 1.0) > 0.96);
        total_bases +:= bases;
        quad[row][column] := -(klingons * 100 + bases * 10 + rand(1, 9));
      end for;
    end for;
    if total_klingons > endStardate - startStardate then
      endStardate := startStardate + total_klingons;
    end if;
    if total_bases <= 0 then
      row := rand(1, 8);
      column := rand(1, 8);
      quad[row][column] -:= 10;
      total_bases := 1;
    end if;
    klingons_in_game := total_klingons;
    writeln("Objective: Destroy " <& total_klingons <& " Klingon battle cruisers in " <&
            endStardate - startStardate <& " stardates.");
    writeln(" The number of starbases is " <& total_bases);
  end func; (* init *)


const proc: enter_quadrant is func
  local
    var integer: number is 0;
    var integer: row is 0;
    var integer: column is 0;
  begin
    if quadrantRow < 1 or quadrantRow > 8 or quadrantColumn < 1 or quadrantColumn > 8 then
      klingons_in_quadrant := 0;
      bases_in_quadrant := 0;
      stars_in_quadrant := 0;
    else
      number := abs(quad[quadrantRow][quadrantColumn]);
      quad[quadrantRow][quadrantColumn] := number;
      klingons_in_quadrant := number div 100;
      bases_in_quadrant := (number div 10) rem 10;
      stars_in_quadrant := number rem 10;
    end if;
    sectorRow := rand(1, 8);
    sectorColumn := rand(1, 8);
    for row range 1 to 8 do
      for column range 1 to 8 do
         sect[row][column] := 1;
      end for;
    end for;
    sect[sectorRow][sectorColumn] := 2;
    for number range 1 to 8 do
      klingonEnergy[number] := 0.0;
      row := 9;
      if number <= klingons_in_quadrant then
         find_free_sector(row, column);
         sect[row][column] := 3;
         klingonEnergy[number] := maxKlingonEnergy;
      end if;
      klingonRow[number] := row;
      klingonColumn[number] := column;
    end for;
    if bases_in_quadrant > 0 then
      find_free_sector(row, column);
      sect[row][column] := 4;
    end if;
    for number range 1 to stars_in_quadrant do
      find_free_sector(row, column);
      sect[row][column] := 5;
    end for;
  end func; (* enter_quadrant *)


const func string: get_condition is func
  result
    var string: cond is "";
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    for row range pred(sectorRow) to succ(sectorRow) do
      for column range pred(sectorColumn) to succ(sectorColumn) do
        if row >= 1 and row <= 8 and column >= 1 and column <= 8 then
          if sect[row][column] = 4 then  (* Docked at starbase *)
            cond := "DOCKED";
            energy := max_energy;
            torpedoes := max_torpedoes;
            fix_damage;
          end if;
        end if;
      end for;
    end for;
    if cond <> "DOCKED" then
      if klingons_in_quadrant > 0 then  (* Klingons present! *)
        cond := "RED";
      elsif energy < max_energy * 0.1 then  (* Low energy *)
        cond := "YELLOW";
      else
        cond := "GREEN";
      end if;
    end if;
  end func; (* get_condition *)


const proc: write_phaser_hit (in integer: number, in float: unit_hit,
    in string: target, in float: energy_left) is func
  begin
    write(unit_hit digits 3 <& " unit hit on " <& target);
    write(" sector " <& klingonRow[number] <& " - " <& klingonColumn[number]);
    writeln("  (" <& energy_left digits 3 <& " left)");
  end func; (* write_phaser_hit *)


const func float: klingon_distance (in integer: number) is func
  result
    var float: distance is 0.0;
  begin
    distance := sqrt(flt((klingonRow[number] - sectorRow) ** 2 +
                         (klingonColumn[number] - sectorColumn) ** 2));
  end func;  (* klingon_distance *)


const proc: hits_from_klingons is func
  local
    var integer: number is 0;
    var float: unit_hit is 0.0;
  begin
    if klingons_in_quadrant >= 1 then
      if cond = "DOCKED" then
        writeln("Starbase protects Enterprise.");
      else
        for number range 1 to 8 do
          if klingonEnergy[number] > 0.0 then
            unit_hit := klingonEnergy[number] * 0.4 * rand(0.0, 1.0);
            klingonEnergy[number] := klingonEnergy[number] - unit_hit;
            unit_hit := unit_hit / klingon_distance(number) ** 0.4;
            energy := energy - unit_hit;
            write_phaser_hit(number, unit_hit, "Enterprise from", energy);
          end if;
        end for;
      end if;
    end if;
  end func; (* hits_from_klingons *)


const proc: time_for_repair (in integer: equipment) is func
  begin
    writeln(" Estimated time to repair " <& damage[equipment] <& " stardates.");
    writeln;
  end func; (* time_for_repair *)


const proc: show_damage (in integer: equipment) is func
  begin
    write(description[equipment] <& " damaged.");
    time_for_repair(equipment);
  end func;  (* show_damage *)


const proc: move_ship (in float: course, in float: warp_factor,
    in integer: distance) is func
  local
    var integer: number is 0;
    var boolean: inquad is FALSE;
    var boolean: blocked is FALSE;
    var float: x1 is 0.0;
    var float: y1 is 0.0;
    var integer: row is 0;
    var integer: column is 0;
    var float: angle is 0.0;
    var float: delta_x is 0.0;
    var float: delta_y is 0.0;
  begin
    row := sectorRow;
    column := sectorColumn;
    x1 := flt(column) + 0.5;
    y1 := flt(row) + 0.5;
    angle := (course - 1.0) * 0.785398;
    delta_x := cos(angle);
    delta_y := -sin(angle);
    inquad := TRUE;
    blocked := FALSE;
    number := 1;
    while number <= distance do
      y1 := y1 + delta_y;
      x1 := x1 + delta_x;
      row := trunc(y1);
      column := trunc(x1);
      if column < 1 or column > 8 or row < 1 or row > 8 then
         inquad := FALSE;
         number := distance;
      else
        if sect[row][column] <> 1 then  (* Object blocking move *)
           blocked := TRUE;
           number := distance;
        end if;
      end if;
      incr(number);
    end while;
    if inquad then  (* Still in quadrant -- short move or block *)
      if blocked then
        writeln;
        write("Blocked by ");
        case sect[row][column] of
          when {3}: write("Klingon");
          when {4}: write("starbase");
          when {5}: write("star");
        end case;
        writeln(" at sector " <& row <& " - " <& column);
        row := trunc(y1 - delta_y);
        column := trunc(x1 - delta_x);
      end if;
      sectorRow := row;
      sectorColumn := column;
      sect[sectorRow][sectorColumn] := 2;
    else  (* Out of quadrant -- move to new quadrant *)
      quadrantRow := trunc(flt(quadrantRow) + warp_factor * delta_y + (flt(sectorRow) - 0.5) / 8.0);
      quadrantColumn := trunc(flt(quadrantColumn) + warp_factor * delta_x + (flt(sectorColumn) - 0.5) / 8.0);
      if quadrantRow < 1 then
        quadrantRow := 1;
      elsif quadrantRow > 8 then
        quadrantRow := 8;
      end if;
      if quadrantColumn < 1 then
        quadrantColumn := 1;
      elsif quadrantColumn > 8 then
        quadrantColumn := 8;
      end if;
      enter_quadrant;
      hits_from_klingons;
    end if;
  end func; (* move_ship *)


const proc: short_range_sensors is func
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    cond := get_condition;
    if damage[SHORT_RANGE_SENSORS] > 0 then
      show_damage(SHORT_RANGE_SENSORS);
    else
      for row range 1 to 8 do
        for column range 1 to 8 do
          write(sector_description[sect[row][column]] <& " ");
        end for;
        write("  ");
        case row of
          when {1}: writeln("Stardate = " <& stardate);
          when {2}: writeln("Condition: " <& cond);
          when {3}: writeln("Quadrant = " <& quadrantRow <& " - " <& quadrantColumn);
          when {4}: writeln("Sector = "   <& sectorRow <& " - " <& sectorColumn);
          when {5}: writeln("Energy = "   <& energy digits 3);
          when {6}: writeln("Photon torpedoes = " <& torpedoes);
          when {7}: writeln("Klingons left = "    <& total_klingons);
          when {8}: writeln("Time left = "        <& endStardate - stardate);
        end case;
      end for;
    end if;
  end func; (* short_range_sensors *)


const proc: warp_engines is func
  local
    var integer: equipment is 0;
    var integer: repaired_by_spock is 0;
    var integer: number is 0;
    var string: command is "";
    var float: course is 0.0;
    var float: warp_factor is 0.0;
    var integer: distance is 0;
  begin
    repeat
      course := 0.0;
      write("Course (1-9)? ");
      readln(command);
      if command <> "" then
        block
          course := float(command);
          if course < 1.0 or course > 9.0 then
            raise RANGE_ERROR;
          end if;
        exception
          catch RANGE_ERROR:
            writeln("   Lt. Sulu: 'Incorrect course data, sir!'");
            course := 10.0
        end block;
      end if;
    until course <= 9.0;
    if course = 9.0 then
      course := 1.0;
    end if;
    if course >= 1.0 then
      repeat
        warp_factor := 0.0;
        write("Warp (0-12)? ");
        readln(command);
        if command <> "" then
          block
            warp_factor := float(command);
            if warp_factor > 12.0 then
              writeln("   Chief engineer Scott: 'The engines won't take " <& command <& "!'");
            elsif warp_factor > 0.2 and damage[WARP_ENGINES] > 0 then
              write(description[WARP_ENGINES] <& " damaged, max is 0.2 ");
              time_for_repair(WARP_ENGINES);
              warp_factor := 15.0;
            end if;
          exception
            catch RANGE_ERROR:
              writeln("   Chief engineer Scott: 'This is not a warp factor!'");
              warp_factor := 15.0;
          end block;
        end if;
      until warp_factor <= 12.0;
    end if;
    if course >= 1.0 and warp_factor > 0.0 then
      hits_from_klingons;
      if energy > 0.0 then
        if rand(0.0, 1.0) <= 0.25 then
          equipment := rand(1, 6);
          if rand(0.0, 1.0) <= 0.5 then
            damage[equipment] +:= rand(1, 6);
            writeln("**SPACE STORM, " <& upper(description[equipment]) <& " DAMAGED**");
            time_for_repair(equipment);
            incr(damage[equipment]);
          else
            repaired_by_spock := 0;
            for number range equipment to 6 do
              if damage[number] > 0 and repaired_by_spock = 0 then
                repaired_by_spock := number;
              end if;
            end for;
            if repaired_by_spock = 0 then
              for number range 1 to pred(equipment) do
                if damage[number] > 0 and repaired_by_spock = 0 then
                  repaired_by_spock := number;
                end if;
              end for;
            end if;
            if repaired_by_spock <> 0 then
              damage[repaired_by_spock] := 1;
              writeln("**SPOCK USED A NEW REPAIR TECHNIQUE**");
            end if;
          end if;
        end if;
        for equipment range 1 to 6 do
          if damage[equipment] <> 0 then
            decr(damage[equipment]);
            if damage[equipment] <= 0 then
              damage[equipment] := 0;
              writeln(description[equipment] <& " are fixed!");
            end if;
          end if;
        end for;
        distance := trunc(warp_factor * 8.0);
        energy := energy - flt(distance) - flt(distance) + 0.5;
        incr(stardate);
        sect[sectorRow][sectorColumn] := 1;
        if energy > 0.0 and stardate <= endStardate then
          move_ship(course, warp_factor, distance);
          if energy > 0.0 then
            short_range_sensors;
          end if;
        end if;
      end if;
    end if;
  end func; (* warp_engines *)


const func string: quadrant_description (in integer: row, in integer: column) is func
  result
    var string: es is "";
  begin
    es := "00" & str(quad[row][column]);
    es := es[length(es) - 2 .. ];
  end func; (* quadrant_description *)


const proc: long_range_sensors is func
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    if damage[LONG_RANGE_SENSORS] > 0 then
      show_damage(LONG_RANGE_SENSORS);
    else
      writeln(description[LONG_RANGE_SENSORS] <& " for quadrant " <&
              quadrantRow <& " - " <& quadrantColumn);
      for row range pred(quadrantRow) to succ(quadrantRow) do
        for column range pred(quadrantColumn) to succ(quadrantColumn) do
          write("   ");
          if row < 1 or row > 8 or column < 1 or column > 8 then
            write("***");
          else
            quad[row][column] := abs(quad[row][column]);
            write(quadrant_description(row, column));
          end if;
        end for;
        writeln;
      end for;
    end if;
  end func; (* long_range_sensors *)


const proc: phasers is func
  local
    var string: command is "";
    var float: phaser_energy is 0.0;
    var integer: number is 0;
    var float: unit_hit is 0.0;
    var float: y3 is 0.0;
  begin
    if damage[PHASERS] > 0 then
      show_damage(PHASERS);
    else
      repeat
        phaser_energy := 0.0;
        write("Phasers ready: Energy units to fire? ");
        readln(command);
        if command <> "" then
          block
            phaser_energy := float(command);
            if phaser_energy < 0.0 then
              raise RANGE_ERROR;
            end if;
          exception
            catch RANGE_ERROR:
              writeln("   Ensign Chekov: 'Incorrect phaser energy, sir!'");
              phaser_energy := 0.0
          end block;
        end if;
        if phaser_energy > 0.0 and phaser_energy > energy then
          writeln("Only got " <& energy digits 3);
        end if;
      until phaser_energy <= 0.0 or phaser_energy <= energy;
      if phaser_energy > 0.0 then
        energy := energy - phaser_energy;
        y3 := flt(klingons_in_quadrant);
        for number range 1 to 8 do
          if klingonEnergy[number] > 0.0 then
            unit_hit := phaser_energy / (y3 * klingon_distance(number) ** 0.4);
            klingonEnergy[number] := klingonEnergy[number] - unit_hit;
            write_phaser_hit(number, unit_hit, "Klingon at", klingonEnergy[number]);
            if klingonEnergy[number] <= 0.0 then
              writeln("**KLINGON DESTROYED**");
              decr(klingons_in_quadrant);
              decr(total_klingons);
              sect[klingonRow[number]][klingonColumn[number]] := 1;
              quad[quadrantRow][quadrantColumn] -:= 100;
            end if;
          end if;
        end for;
        hits_from_klingons;
        cond := get_condition;
      end if;
    end if;
  end func; (* phasers *)


const proc: torpedo_track (in float: course) is func
  local
    const integer: distance is 15;
    var integer: number is 0;
    var boolean: torpedo_hit is FALSE;
    var float: x1 is 0.0;
    var float: y1 is 0.0;
    var integer: row is 0;
    var integer: column is 0;
    var float: angle is 0.0;
    var float: delta_x is 0.0;
    var float: delta_y is 0.0;
  begin
    x1 := flt(sectorColumn) + 0.5;
    y1 := flt(sectorRow) + 0.5;
    angle := (course - 1.0) * 0.785398;
    delta_x := cos(angle);
    delta_y := -sin(angle);
    torpedo_hit := FALSE;
    number := 1;
    while number <= distance do
      y1 := y1 + delta_y;
      x1 := x1 + delta_x;
      row := trunc(y1);
      column := trunc(x1);
      if column < 1 or column > 8 or row < 1 or row > 8 then
        number := distance;
      else
        write(" " <& row <& " - " <& column <& "  ");
        if sect[row][column] <> 1 then (* Object hit by torpedo *)
          torpedo_hit := TRUE;
          number := distance;
        end if;
      end if;
      incr(number);
    end while;
    if torpedo_hit then
      writeln;
      case sect[row][column] of
        when {3}: (* Klingon *)
          writeln("KLINGON DESTROYED!");
          for number range 1 to 8 do
            if row = klingonRow[number] and column = klingonColumn[number] then
              klingonEnergy[number] := 0.0;
            end if;
          end for;
          decr(klingons_in_quadrant);
          decr(total_klingons);
        when {4}: (* Starbase *)
          writeln("STARBASE DESTROYED! . . . GOOD WORK!");
          decr(bases_in_quadrant);
        when {5}: (* Star *)
          writeln("STAR DESTROYED!");
          decr(stars_in_quadrant);
      end case;
      sect[row][column] := 1;
      quad[quadrantRow][quadrantColumn] := klingons_in_quadrant * 100 +
          bases_in_quadrant * 10 + stars_in_quadrant;
    else
      writeln("MISSED!");
    end if;
  end func; (* torpedo_track *)


const proc: photon_torpedoes is func
  local
    var string: command is "";
    var float: course is 0.0;
  begin
    if damage[PHOTON_TORPEDOES] > 0 then
      writeln("Space crud blocking tubes.");
      time_for_repair(PHOTON_TORPEDOES);
    else
      if torpedoes < 1 then
        writeln("No torpedoes left.");
      else
        repeat
          course := 0.0;
          write("Torpedo course (1-9)? ");
          readln(command);
          if command <> "" then
            block
              course := float(command);
              if course < 1.0 or course > 9.0 then
                raise RANGE_ERROR;
              end if;
            exception
              catch RANGE_ERROR:
                writeln("   Ensign Chekov: 'Incorrect course data, sir!'");
                course := 10.0
            end block;
          end if;
        until course <= 9.0;
        if course = 9.0 then
          course := 1.0;
        end if;
        if course >= 1.0 then
          decr(torpedoes);
          write("Track:");
          torpedo_track(course);
          hits_from_klingons;
          cond := get_condition;
        end if;
      end if;
    end if;
  end func; (* photon_torpedoes *)


const proc: galactic_records is func
  local
    var integer: row is 0;
    var integer: column is 0;
  begin
    if damage[GALACTIC_RECORDS] > 0 then
      show_damage(GALACTIC_RECORDS);
    else
      write("Cumulative galactic map for stardate: ");
      writeln(stardate);
      for row range 1 to 8 do
        write(" ");
        for column range 1 to 8 do
          if quad[row][column] < 0 then
            write(" *** ");
          else
            if row = quadrantRow and column = quadrantColumn then
              write("<" <& quadrant_description(row, column) <& ">");
            else
              write(" " <& quadrant_description(row, column) <& " ");
            end if;
          end if;
        end for;
        writeln;
      end for;
    end if;
  end func; (* galactic_records *)


const proc: write_stardate is func
  begin
    writeln;
    writeln("It is stardate " <& stardate);
  end func; (* write_stardate *)


const proc: game is func
  local
    var integer: rating is 0;
    var string: command is "";
    var boolean: quit is FALSE;
  begin
    init;
    enter_quadrant;
    hits_from_klingons;
    short_range_sensors;
    while energy > 0.0 and
        stardate <= endStardate and
        total_klingons >= 1 and
        not quit do
      write("Command? ");
      readln(command);
      if command = "" then
        command := " ";
      end if;
      case upper(command[1]) of
        when {'1', 'W'}: warp_engines;
        when {'2', 'S'}: short_range_sensors;
        when {'3', 'L'}: long_range_sensors;
        when {'4', 'P'}: phasers;
        when {'5', 'T'}: photon_torpedoes;
        when {'6', 'G'}: galactic_records;
        when {'?', 'H'}: help;
        when {'Q'}:
          writeln;
          write("Are you sure you want to quit? ");
          command := getln(IN);
          if upper(command) = "Y" then
            quit := TRUE;
          end if;
        otherwise:
          help_commands;
      end case;
    end while;
    write_stardate;
    if total_klingons < 1 then
      rating := 1000 * klingons_in_game div (stardate - startStardate);
      writeln("The federation has been saved!");
      writeln("You are promoted to admiral.");
      writeln(klingons_in_game <& " Klingons in " <& stardate - startStardate <&
              " stardates.  Rating = " <& rating);
    elsif energy <= 0.0 or stardate > endStardate or quit then
      if energy <= 0.0 then
        writeln("You ran out of energy!");
      elsif stardate > endStardate then
        writeln("You ran out of time!");
      elsif quit then
        writeln("You quit your job!");
      end if;
      writeln("Thanks to your bungling, the federation will be");
      writeln("conquered by the remaining " <& total_klingons <& " Klingon cruisers!");
      writeln("You are demoted to cabin boy!");
    end if;
  end func; (* game *)


const proc: main is func
  local
    var boolean: finished is FALSE;
    var string: answer is "";
  begin
    title;
    write("Do you need instructions (Y/N)? ");
    answer := upper(getln(IN));
    if answer <> "Q" then
      if answer = "Y" then
        help;
      end if;
      writeln;
      repeat
        game;
        write("Try again? ");
        answer := getln(IN);
        finished := upper(answer) = "N";
      until finished;
    end if;
  end func; (* main *)