$ 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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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
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
cond := "RED";
elsif energy < max_energy * 0.1 then
cond := "YELLOW";
else
cond := "GREEN";
end if;
end if;
end func;
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;
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;
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;
const proc: time_for_repair (in integer: equipment) is func
begin
writeln(" Estimated time to repair " <& damage[equipment] <& " stardates.");
writeln;
end func;
const proc: show_damage (in integer: equipment) is func
begin
write(description[equipment] <& " damaged.");
time_for_repair(equipment);
end func;
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
blocked := TRUE;
number := distance;
end if;
end if;
incr(number);
end while;
if inquad then
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
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;
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;
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;
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;
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;
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;
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
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}:
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}:
writeln("STARBASE DESTROYED! . . . GOOD WORK!");
decr(bases_in_quadrant);
when {5}:
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;
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;
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;
const proc: write_stardate is func
begin
writeln;
writeln("It is stardate " <& stardate);
end func;
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;
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;