1 2(********************************************************************) 3(* *) 4(* startrek.sd7 Classical startrek game *) 5(* Copyright (C) 2004 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "stdio.s7i"; 27 include "float.s7i"; 28 include "math.s7i"; 29 30const float: max_energy is 4000.0; 31const integer: max_torpedoes is 10; 32const float: maxKlingonEnergy is 400.0; 33const string: sector_description is ".EKB*"; 34 35const integer: WARP_ENGINES is 1; 36const integer: SHORT_RANGE_SENSORS is 2; 37const integer: LONG_RANGE_SENSORS is 3; 38const integer: PHASERS is 4; 39const integer: PHOTON_TORPEDOES is 5; 40const integer: GALACTIC_RECORDS is 6; 41 42const array string: description is []( 43 "Warp engines","Short range sensors","Long range sensors", 44 "Phasers","Photon torpedoes","Galactic records"); 45 46var integer: total_klingons is 0; 47var array integer: klingonRow is 8 times 0; 48var array integer: klingonColumn is 8 times 0; 49var array float: klingonEnergy is 8 times 0.0; 50 51var array array integer: quad is 8 times 8 times 0; 52var integer: quadrantRow is 1; 53var integer: quadrantColumn is 1; 54var integer: klingons_in_quadrant is 0; 55var integer: bases_in_quadrant is 0; 56var integer: stars_in_quadrant is 0; 57 58var array array integer: sect is 8 times 8 times 0; 59var integer: sectorRow is 1; 60var integer: sectorColumn is 1; 61 62var integer: klingons_in_game is 0; 63var integer: stardate is 0; 64var integer: startStardate is 0; 65var integer: endStardate is 0; 66 67var string: cond is ""; 68var array integer: damage is 6 times 0; 69var float: energy is 0.0; 70var integer: torpedoes is 0; 71 72 73const proc: title is func 74 begin 75 writeln("STAR TREK!!"); 76 writeln("==========="); 77 writeln; 78 end func; (* title *) 79 80 81const proc: help_course is func 82 begin 83 writeln("Course - A number from 1 to 9 indicating a direction. 4 3 2"); 84 writeln("Starting with a 1 to the right and increasing counterclockwise. \\ | /"); 85 writeln("To move to the left, use a course of 5. 5 - E - 1"); 86 writeln("A course of 3.5 is halfway between 3 and 4. / | \\"); 87 writeln("A course of 8.75 is three-quarters of the way from 8 to 1. 6 7 8"); 88 end func; (* help_course *) 89 90 91const proc: help_sector is func 92 begin 93 writeln("Each sector can contain a Klingon (K), star (*), starbase (B), the Enterprise"); 94 writeln("herself (E), or empty space (.). Each sector is also numbered; a starbase in"); 95 writeln("sector 3-5 is 3 rows down from the top of the short range scan print-out, and"); 96 writeln("5 sectors to the right."); 97 end func; (* help_sector *) 98 99 100const proc: help_quadrant is func 101 begin 102 writeln("The known galaxy is divided into 64 quadrants arranged like a square"); 103 writeln("checkerboard, 8 on a side. Each quadrant is represented as a 3-digit number."); 104 writeln("The first (hundreds) digit is the number of Klingons in that quadrant, while"); 105 writeln("the middle (tens) digit is the number of starbases, and the units digit is the"); 106 writeln("number of stars. An entry of 305 means 3 Klingons, no starbases, and 5 stars."); 107 end func; (* help_quadrant *) 108 109 110const proc: help_warp_engines is func 111 begin 112 writeln("WARP ENGINE (command 1 or W):"); 113 writeln("The warp engine control is used to move the Enterprise. You will be asked to"); 114 writeln("set the course, and the distance (measured in warps) for the move. Each move"); 115 writeln("that you make with the Enterprise from one sector to another, or from one"); 116 writeln("quadrant to another, costs you one stardate. Therefore, a 30-stardate game"); 117 writeln("means you have 30 moves to win in."); 118 writeln; 119 help_course; 120 writeln; 121 writeln("Warp - One warp moves you the width of a quadrant. A warp of .5 will move you"); 122 writeln("halfway through a quadrant. Moving diagonally across a quadrant to the next"); 123 writeln("will require 1.414 warps. Warp 3 will move you 3 quadrants providing nothing"); 124 writeln("in your present quadrant blocks your exit. Once you leave the quadrant that"); 125 writeln("you were in, you will enter hyperspace; coming out of hyperspace will place you"); 126 writeln("randomly in the new quadrant. Klingons in a given quadrant will fire at you"); 127 writeln("whenever you leave, enter, or move within the quadrant. Entering a course or"); 128 writeln("warp of zero can be used to return to the command mode."); 129 end func; (* help_warp_engines *) 130 131 132const proc: help_short_range_sensors is func 133 begin 134 writeln("SHORT RANGE SENSORS (command 2 or S):"); 135 writeln("A short range sensor scan will print out the quadrant you presently occupy"); 136 writeln("showing the content of each of the 64 sectors, as well as other pertinent"); 137 writeln("information."); 138 writeln; 139 help_sector; 140 end func; (* help_short_range_sensors *) 141 142 143const proc: help_long_range_sensors is func 144 begin 145 writeln("LONG RANGE SENSORS (command 3 or L):"); 146 writeln("The long range sensor scan summarizes the quadrant you are in, and the"); 147 writeln("adjoining ones."); 148 writeln; 149 help_quadrant; 150 end func; (* help_long_range_sensors *) 151 152 153const proc: help_phasers is func 154 begin 155 writeln("PHASERS (command 4 or P):"); 156 writeln("The portion of the Enterprise's energy that you specify will be divided evenly"); 157 writeln("among the Klingons in the quadrant and fired at them. Surviving Klingons will"); 158 writeln("retaliate. Phaser fire bypasses stars and starbases, but is attenuated by the"); 159 writeln("distance it travels. The arriving energy depletes the shield power of its"); 160 writeln("target. Energy is automatically diverted to the shields as needed, but if you"); 161 writeln("run out of energy you'll get fried."); 162 end func; (* help_phasers *) 163 164 165const proc: help_photon_torpedoes is func 166 begin 167 writeln("PHOTON TORPEDOES (command 5 or T):"); 168 writeln("Photon torpedo control will launch a torpedo on a course you specify which will"); 169 writeln("destroy any object in its path. Range is limited to the local quadrant."); 170 writeln("Expect return fire from surviving Klingons."); 171 writeln; 172 help_course; 173 end func; (* help_photon_torpedoes *) 174 175 176const proc: help_galactic_records is func 177 begin 178 writeln("GALACTIC RECORDS (command 6 or G):"); 179 writeln("The galactic records section of the ship's computer responds to this command by"); 180 writeln("printing out a galactic map showing the results of all previous sensor scans."); 181 writeln; 182 help_quadrant; 183 end func; (* help_galactic_records *) 184 185 186const proc: help_commands is func 187 begin 188 writeln("Your starship will act on the following commands:"); 189 writeln(" 1 or W - Warp engine ? or H - Display help info"); 190 writeln(" 2 or S - Short range sensors Q - Quit the game"); 191 writeln(" 3 or L - Long range sensors"); 192 writeln(" 4 or P - Phasers"); 193 writeln(" 5 or T - Photon torpedoes"); 194 writeln(" 6 or G - Galactic records"); 195 end func; (* help_commands *) 196 197 198const proc: help_game is func 199 begin 200 writeln(" It is stardate 3421 and the federation is being invaded by a band of Klingon"); 201 writeln("'pirates' whose objective is to test our defenses. If even one survives the "); 202 writeln("trial period, Klingon headquarters will launch an all-out attack. As captain"); 203 writeln("of the federation starship 'Enterprise', your mission is to find and destroy"); 204 writeln("the invaders before the time runs out."); 205 writeln; 206 writeln(" You mission is supported by starbases. Docking at a starbase is done by"); 207 writeln("occupying an adjacent sector. It reprovisions your starship with energy and"); 208 writeln("photon torpedoes, as well as repairing all damages."); 209 writeln; 210 help_commands; 211 end func; (* help_game *) 212 213 214const proc: help_quit is func 215 begin 216 writeln("QUIT (command Q):"); 217 writeln("The quit command allows you to quit your job as captain."); 218 end func; (* help_quit *) 219 220 221const proc: help is func 222 local 223 var string: command is ""; 224 begin 225 writeln; 226 help_game; 227 writeln; 228 repeat 229 write("Type a command to get information about it or enter to leave help: "); 230 readln(command); 231 writeln; 232 if command <> "" then 233 case upper(command[1]) of 234 when {'1', 'W'}: help_warp_engines; 235 when {'2', 'S'}: help_short_range_sensors; 236 when {'3', 'L'}: help_long_range_sensors; 237 when {'4', 'P'}: help_phasers; 238 when {'5', 'T'}: help_photon_torpedoes; 239 when {'6', 'G'}: help_galactic_records; 240 when {'?', 'H'}: help_game; 241 when {'Q'}: help_quit; 242 otherwise: help_commands; 243 end case; 244 writeln; 245 end if; 246 until command = ""; 247 end func; (* help *) 248 249 250const proc: fix_damage is func 251 local 252 var integer: equipment is 0; 253 begin 254 for equipment range 1 to 6 do 255 damage[equipment] := 0; 256 end for; 257 end func; (* fix_damage *) 258 259 260const proc: find_free_sector (inout integer: row, inout integer: column) is func 261 begin 262 repeat 263 row := rand(1, 8); 264 column := rand(1, 8); 265 until sect[row][column] <= 1; 266 end func; (* find_free_sector *) 267 268 269const proc: init is func 270 local 271 var integer: row is 0; 272 var integer: column is 0; 273 var integer: total_bases is 0; 274 var float: number is 0.0; 275 var integer: klingons is 0; 276 var integer: bases is 0; 277 begin 278 fix_damage; 279 quadrantRow:= rand(1, 8); 280 quadrantColumn:= rand(1, 8); 281 total_klingons := 0; 282 total_bases := 0; 283 startStardate := 3421; 284 endStardate := 3451; 285 stardate := startStardate; 286 energy := max_energy; 287 torpedoes := max_torpedoes; 288 for row range 1 to 8 do 289 for column range 1 to 8 do 290 klingons := 0; 291 number := rand(0.0, 1.0); 292 if number < 0.2075 then 293 number := number * 64.0; 294 klingons := 1 + ord(number < 6.28) + ord(number < 3.28) + 295 ord(number < 1.8) + ord(number < 0.28) + ord(number < 0.08) + 296 ord(number < 0.03) + ord(number < 0.01); 297 total_klingons +:= klingons; 298 end if; 299 bases := ord(rand(0.0, 1.0) > 0.96); 300 total_bases +:= bases; 301 quad[row][column] := -(klingons * 100 + bases * 10 + rand(1, 9)); 302 end for; 303 end for; 304 if total_klingons > endStardate - startStardate then 305 endStardate := startStardate + total_klingons; 306 end if; 307 if total_bases <= 0 then 308 row := rand(1, 8); 309 column := rand(1, 8); 310 quad[row][column] -:= 10; 311 total_bases := 1; 312 end if; 313 klingons_in_game := total_klingons; 314 writeln("Objective: Destroy " <& total_klingons <& " Klingon battle cruisers in " <& 315 endStardate - startStardate <& " stardates."); 316 writeln(" The number of starbases is " <& total_bases); 317 end func; (* init *) 318 319 320const proc: enter_quadrant is func 321 local 322 var integer: number is 0; 323 var integer: row is 0; 324 var integer: column is 0; 325 begin 326 if quadrantRow < 1 or quadrantRow > 8 or quadrantColumn < 1 or quadrantColumn > 8 then 327 klingons_in_quadrant := 0; 328 bases_in_quadrant := 0; 329 stars_in_quadrant := 0; 330 else 331 number := abs(quad[quadrantRow][quadrantColumn]); 332 quad[quadrantRow][quadrantColumn] := number; 333 klingons_in_quadrant := number div 100; 334 bases_in_quadrant := (number div 10) rem 10; 335 stars_in_quadrant := number rem 10; 336 end if; 337 sectorRow := rand(1, 8); 338 sectorColumn := rand(1, 8); 339 for row range 1 to 8 do 340 for column range 1 to 8 do 341 sect[row][column] := 1; 342 end for; 343 end for; 344 sect[sectorRow][sectorColumn] := 2; 345 for number range 1 to 8 do 346 klingonEnergy[number] := 0.0; 347 row := 9; 348 if number <= klingons_in_quadrant then 349 find_free_sector(row, column); 350 sect[row][column] := 3; 351 klingonEnergy[number] := maxKlingonEnergy; 352 end if; 353 klingonRow[number] := row; 354 klingonColumn[number] := column; 355 end for; 356 if bases_in_quadrant > 0 then 357 find_free_sector(row, column); 358 sect[row][column] := 4; 359 end if; 360 for number range 1 to stars_in_quadrant do 361 find_free_sector(row, column); 362 sect[row][column] := 5; 363 end for; 364 end func; (* enter_quadrant *) 365 366 367const func string: get_condition is func 368 result 369 var string: cond is ""; 370 local 371 var integer: row is 0; 372 var integer: column is 0; 373 begin 374 for row range pred(sectorRow) to succ(sectorRow) do 375 for column range pred(sectorColumn) to succ(sectorColumn) do 376 if row >= 1 and row <= 8 and column >= 1 and column <= 8 then 377 if sect[row][column] = 4 then (* Docked at starbase *) 378 cond := "DOCKED"; 379 energy := max_energy; 380 torpedoes := max_torpedoes; 381 fix_damage; 382 end if; 383 end if; 384 end for; 385 end for; 386 if cond <> "DOCKED" then 387 if klingons_in_quadrant > 0 then (* Klingons present! *) 388 cond := "RED"; 389 elsif energy < max_energy * 0.1 then (* Low energy *) 390 cond := "YELLOW"; 391 else 392 cond := "GREEN"; 393 end if; 394 end if; 395 end func; (* get_condition *) 396 397 398const proc: write_phaser_hit (in integer: number, in float: unit_hit, 399 in string: target, in float: energy_left) is func 400 begin 401 write(unit_hit digits 3 <& " unit hit on " <& target); 402 write(" sector " <& klingonRow[number] <& " - " <& klingonColumn[number]); 403 writeln(" (" <& energy_left digits 3 <& " left)"); 404 end func; (* write_phaser_hit *) 405 406 407const func float: klingon_distance (in integer: number) is func 408 result 409 var float: distance is 0.0; 410 begin 411 distance := sqrt(flt((klingonRow[number] - sectorRow) ** 2 + 412 (klingonColumn[number] - sectorColumn) ** 2)); 413 end func; (* klingon_distance *) 414 415 416const proc: hits_from_klingons is func 417 local 418 var integer: number is 0; 419 var float: unit_hit is 0.0; 420 begin 421 if klingons_in_quadrant >= 1 then 422 if cond = "DOCKED" then 423 writeln("Starbase protects Enterprise."); 424 else 425 for number range 1 to 8 do 426 if klingonEnergy[number] > 0.0 then 427 unit_hit := klingonEnergy[number] * 0.4 * rand(0.0, 1.0); 428 klingonEnergy[number] := klingonEnergy[number] - unit_hit; 429 unit_hit := unit_hit / klingon_distance(number) ** 0.4; 430 energy := energy - unit_hit; 431 write_phaser_hit(number, unit_hit, "Enterprise from", energy); 432 end if; 433 end for; 434 end if; 435 end if; 436 end func; (* hits_from_klingons *) 437 438 439const proc: time_for_repair (in integer: equipment) is func 440 begin 441 writeln(" Estimated time to repair " <& damage[equipment] <& " stardates."); 442 writeln; 443 end func; (* time_for_repair *) 444 445 446const proc: show_damage (in integer: equipment) is func 447 begin 448 write(description[equipment] <& " damaged."); 449 time_for_repair(equipment); 450 end func; (* show_damage *) 451 452 453const proc: move_ship (in float: course, in float: warp_factor, 454 in integer: distance) is func 455 local 456 var integer: number is 0; 457 var boolean: inquad is FALSE; 458 var boolean: blocked is FALSE; 459 var float: x1 is 0.0; 460 var float: y1 is 0.0; 461 var integer: row is 0; 462 var integer: column is 0; 463 var float: angle is 0.0; 464 var float: delta_x is 0.0; 465 var float: delta_y is 0.0; 466 begin 467 row := sectorRow; 468 column := sectorColumn; 469 x1 := flt(column) + 0.5; 470 y1 := flt(row) + 0.5; 471 angle := (course - 1.0) * 0.785398; 472 delta_x := cos(angle); 473 delta_y := -sin(angle); 474 inquad := TRUE; 475 blocked := FALSE; 476 number := 1; 477 while number <= distance do 478 y1 := y1 + delta_y; 479 x1 := x1 + delta_x; 480 row := trunc(y1); 481 column := trunc(x1); 482 if column < 1 or column > 8 or row < 1 or row > 8 then 483 inquad := FALSE; 484 number := distance; 485 else 486 if sect[row][column] <> 1 then (* Object blocking move *) 487 blocked := TRUE; 488 number := distance; 489 end if; 490 end if; 491 incr(number); 492 end while; 493 if inquad then (* Still in quadrant -- short move or block *) 494 if blocked then 495 writeln; 496 write("Blocked by "); 497 case sect[row][column] of 498 when {3}: write("Klingon"); 499 when {4}: write("starbase"); 500 when {5}: write("star"); 501 end case; 502 writeln(" at sector " <& row <& " - " <& column); 503 row := trunc(y1 - delta_y); 504 column := trunc(x1 - delta_x); 505 end if; 506 sectorRow := row; 507 sectorColumn := column; 508 sect[sectorRow][sectorColumn] := 2; 509 else (* Out of quadrant -- move to new quadrant *) 510 quadrantRow := trunc(flt(quadrantRow) + warp_factor * delta_y + (flt(sectorRow) - 0.5) / 8.0); 511 quadrantColumn := trunc(flt(quadrantColumn) + warp_factor * delta_x + (flt(sectorColumn) - 0.5) / 8.0); 512 if quadrantRow < 1 then 513 quadrantRow := 1; 514 elsif quadrantRow > 8 then 515 quadrantRow := 8; 516 end if; 517 if quadrantColumn < 1 then 518 quadrantColumn := 1; 519 elsif quadrantColumn > 8 then 520 quadrantColumn := 8; 521 end if; 522 enter_quadrant; 523 hits_from_klingons; 524 end if; 525 end func; (* move_ship *) 526 527 528const proc: short_range_sensors is func 529 local 530 var integer: row is 0; 531 var integer: column is 0; 532 begin 533 cond := get_condition; 534 if damage[SHORT_RANGE_SENSORS] > 0 then 535 show_damage(SHORT_RANGE_SENSORS); 536 else 537 for row range 1 to 8 do 538 for column range 1 to 8 do 539 write(sector_description[sect[row][column]] <& " "); 540 end for; 541 write(" "); 542 case row of 543 when {1}: writeln("Stardate = " <& stardate); 544 when {2}: writeln("Condition: " <& cond); 545 when {3}: writeln("Quadrant = " <& quadrantRow <& " - " <& quadrantColumn); 546 when {4}: writeln("Sector = " <& sectorRow <& " - " <& sectorColumn); 547 when {5}: writeln("Energy = " <& energy digits 3); 548 when {6}: writeln("Photon torpedoes = " <& torpedoes); 549 when {7}: writeln("Klingons left = " <& total_klingons); 550 when {8}: writeln("Time left = " <& endStardate - stardate); 551 end case; 552 end for; 553 end if; 554 end func; (* short_range_sensors *) 555 556 557const proc: warp_engines is func 558 local 559 var integer: equipment is 0; 560 var integer: repaired_by_spock is 0; 561 var integer: number is 0; 562 var string: command is ""; 563 var float: course is 0.0; 564 var float: warp_factor is 0.0; 565 var integer: distance is 0; 566 begin 567 repeat 568 course := 0.0; 569 write("Course (1-9)? "); 570 readln(command); 571 if command <> "" then 572 block 573 course := float(command); 574 if course < 1.0 or course > 9.0 then 575 raise RANGE_ERROR; 576 end if; 577 exception 578 catch RANGE_ERROR: 579 writeln(" Lt. Sulu: 'Incorrect course data, sir!'"); 580 course := 10.0 581 end block; 582 end if; 583 until course <= 9.0; 584 if course = 9.0 then 585 course := 1.0; 586 end if; 587 if course >= 1.0 then 588 repeat 589 warp_factor := 0.0; 590 write("Warp (0-12)? "); 591 readln(command); 592 if command <> "" then 593 block 594 warp_factor := float(command); 595 if warp_factor > 12.0 then 596 writeln(" Chief engineer Scott: 'The engines won't take " <& command <& "!'"); 597 elsif warp_factor > 0.2 and damage[WARP_ENGINES] > 0 then 598 write(description[WARP_ENGINES] <& " damaged, max is 0.2 "); 599 time_for_repair(WARP_ENGINES); 600 warp_factor := 15.0; 601 end if; 602 exception 603 catch RANGE_ERROR: 604 writeln(" Chief engineer Scott: 'This is not a warp factor!'"); 605 warp_factor := 15.0; 606 end block; 607 end if; 608 until warp_factor <= 12.0; 609 end if; 610 if course >= 1.0 and warp_factor > 0.0 then 611 hits_from_klingons; 612 if energy > 0.0 then 613 if rand(0.0, 1.0) <= 0.25 then 614 equipment := rand(1, 6); 615 if rand(0.0, 1.0) <= 0.5 then 616 damage[equipment] +:= rand(1, 6); 617 writeln("**SPACE STORM, " <& upper(description[equipment]) <& " DAMAGED**"); 618 time_for_repair(equipment); 619 incr(damage[equipment]); 620 else 621 repaired_by_spock := 0; 622 for number range equipment to 6 do 623 if damage[number] > 0 and repaired_by_spock = 0 then 624 repaired_by_spock := number; 625 end if; 626 end for; 627 if repaired_by_spock = 0 then 628 for number range 1 to pred(equipment) do 629 if damage[number] > 0 and repaired_by_spock = 0 then 630 repaired_by_spock := number; 631 end if; 632 end for; 633 end if; 634 if repaired_by_spock <> 0 then 635 damage[repaired_by_spock] := 1; 636 writeln("**SPOCK USED A NEW REPAIR TECHNIQUE**"); 637 end if; 638 end if; 639 end if; 640 for equipment range 1 to 6 do 641 if damage[equipment] <> 0 then 642 decr(damage[equipment]); 643 if damage[equipment] <= 0 then 644 damage[equipment] := 0; 645 writeln(description[equipment] <& " are fixed!"); 646 end if; 647 end if; 648 end for; 649 distance := trunc(warp_factor * 8.0); 650 energy := energy - flt(distance) - flt(distance) + 0.5; 651 incr(stardate); 652 sect[sectorRow][sectorColumn] := 1; 653 if energy > 0.0 and stardate <= endStardate then 654 move_ship(course, warp_factor, distance); 655 if energy > 0.0 then 656 short_range_sensors; 657 end if; 658 end if; 659 end if; 660 end if; 661 end func; (* warp_engines *) 662 663 664const func string: quadrant_description (in integer: row, in integer: column) is func 665 result 666 var string: es is ""; 667 begin 668 es := "00" & str(quad[row][column]); 669 es := es[length(es) - 2 .. ]; 670 end func; (* quadrant_description *) 671 672 673const proc: long_range_sensors is func 674 local 675 var integer: row is 0; 676 var integer: column is 0; 677 begin 678 if damage[LONG_RANGE_SENSORS] > 0 then 679 show_damage(LONG_RANGE_SENSORS); 680 else 681 writeln(description[LONG_RANGE_SENSORS] <& " for quadrant " <& 682 quadrantRow <& " - " <& quadrantColumn); 683 for row range pred(quadrantRow) to succ(quadrantRow) do 684 for column range pred(quadrantColumn) to succ(quadrantColumn) do 685 write(" "); 686 if row < 1 or row > 8 or column < 1 or column > 8 then 687 write("***"); 688 else 689 quad[row][column] := abs(quad[row][column]); 690 write(quadrant_description(row, column)); 691 end if; 692 end for; 693 writeln; 694 end for; 695 end if; 696 end func; (* long_range_sensors *) 697 698 699const proc: phasers is func 700 local 701 var string: command is ""; 702 var float: phaser_energy is 0.0; 703 var integer: number is 0; 704 var float: unit_hit is 0.0; 705 var float: y3 is 0.0; 706 begin 707 if damage[PHASERS] > 0 then 708 show_damage(PHASERS); 709 else 710 repeat 711 phaser_energy := 0.0; 712 write("Phasers ready: Energy units to fire? "); 713 readln(command); 714 if command <> "" then 715 block 716 phaser_energy := float(command); 717 if phaser_energy < 0.0 then 718 raise RANGE_ERROR; 719 end if; 720 exception 721 catch RANGE_ERROR: 722 writeln(" Ensign Chekov: 'Incorrect phaser energy, sir!'"); 723 phaser_energy := 0.0 724 end block; 725 end if; 726 if phaser_energy > 0.0 and phaser_energy > energy then 727 writeln("Only got " <& energy digits 3); 728 end if; 729 until phaser_energy <= 0.0 or phaser_energy <= energy; 730 if phaser_energy > 0.0 then 731 energy := energy - phaser_energy; 732 y3 := flt(klingons_in_quadrant); 733 for number range 1 to 8 do 734 if klingonEnergy[number] > 0.0 then 735 unit_hit := phaser_energy / (y3 * klingon_distance(number) ** 0.4); 736 klingonEnergy[number] := klingonEnergy[number] - unit_hit; 737 write_phaser_hit(number, unit_hit, "Klingon at", klingonEnergy[number]); 738 if klingonEnergy[number] <= 0.0 then 739 writeln("**KLINGON DESTROYED**"); 740 decr(klingons_in_quadrant); 741 decr(total_klingons); 742 sect[klingonRow[number]][klingonColumn[number]] := 1; 743 quad[quadrantRow][quadrantColumn] -:= 100; 744 end if; 745 end if; 746 end for; 747 hits_from_klingons; 748 cond := get_condition; 749 end if; 750 end if; 751 end func; (* phasers *) 752 753 754const proc: torpedo_track (in float: course) is func 755 local 756 const integer: distance is 15; 757 var integer: number is 0; 758 var boolean: torpedo_hit is FALSE; 759 var float: x1 is 0.0; 760 var float: y1 is 0.0; 761 var integer: row is 0; 762 var integer: column is 0; 763 var float: angle is 0.0; 764 var float: delta_x is 0.0; 765 var float: delta_y is 0.0; 766 begin 767 x1 := flt(sectorColumn) + 0.5; 768 y1 := flt(sectorRow) + 0.5; 769 angle := (course - 1.0) * 0.785398; 770 delta_x := cos(angle); 771 delta_y := -sin(angle); 772 torpedo_hit := FALSE; 773 number := 1; 774 while number <= distance do 775 y1 := y1 + delta_y; 776 x1 := x1 + delta_x; 777 row := trunc(y1); 778 column := trunc(x1); 779 if column < 1 or column > 8 or row < 1 or row > 8 then 780 number := distance; 781 else 782 write(" " <& row <& " - " <& column <& " "); 783 if sect[row][column] <> 1 then (* Object hit by torpedo *) 784 torpedo_hit := TRUE; 785 number := distance; 786 end if; 787 end if; 788 incr(number); 789 end while; 790 if torpedo_hit then 791 writeln; 792 case sect[row][column] of 793 when {3}: (* Klingon *) 794 writeln("KLINGON DESTROYED!"); 795 for number range 1 to 8 do 796 if row = klingonRow[number] and column = klingonColumn[number] then 797 klingonEnergy[number] := 0.0; 798 end if; 799 end for; 800 decr(klingons_in_quadrant); 801 decr(total_klingons); 802 when {4}: (* Starbase *) 803 writeln("STARBASE DESTROYED! . . . GOOD WORK!"); 804 decr(bases_in_quadrant); 805 when {5}: (* Star *) 806 writeln("STAR DESTROYED!"); 807 decr(stars_in_quadrant); 808 end case; 809 sect[row][column] := 1; 810 quad[quadrantRow][quadrantColumn] := klingons_in_quadrant * 100 + 811 bases_in_quadrant * 10 + stars_in_quadrant; 812 else 813 writeln("MISSED!"); 814 end if; 815 end func; (* torpedo_track *) 816 817 818const proc: photon_torpedoes is func 819 local 820 var string: command is ""; 821 var float: course is 0.0; 822 begin 823 if damage[PHOTON_TORPEDOES] > 0 then 824 writeln("Space crud blocking tubes."); 825 time_for_repair(PHOTON_TORPEDOES); 826 else 827 if torpedoes < 1 then 828 writeln("No torpedoes left."); 829 else 830 repeat 831 course := 0.0; 832 write("Torpedo course (1-9)? "); 833 readln(command); 834 if command <> "" then 835 block 836 course := float(command); 837 if course < 1.0 or course > 9.0 then 838 raise RANGE_ERROR; 839 end if; 840 exception 841 catch RANGE_ERROR: 842 writeln(" Ensign Chekov: 'Incorrect course data, sir!'"); 843 course := 10.0 844 end block; 845 end if; 846 until course <= 9.0; 847 if course = 9.0 then 848 course := 1.0; 849 end if; 850 if course >= 1.0 then 851 decr(torpedoes); 852 write("Track:"); 853 torpedo_track(course); 854 hits_from_klingons; 855 cond := get_condition; 856 end if; 857 end if; 858 end if; 859 end func; (* photon_torpedoes *) 860 861 862const proc: galactic_records is func 863 local 864 var integer: row is 0; 865 var integer: column is 0; 866 begin 867 if damage[GALACTIC_RECORDS] > 0 then 868 show_damage(GALACTIC_RECORDS); 869 else 870 write("Cumulative galactic map for stardate: "); 871 writeln(stardate); 872 for row range 1 to 8 do 873 write(" "); 874 for column range 1 to 8 do 875 if quad[row][column] < 0 then 876 write(" *** "); 877 else 878 if row = quadrantRow and column = quadrantColumn then 879 write("<" <& quadrant_description(row, column) <& ">"); 880 else 881 write(" " <& quadrant_description(row, column) <& " "); 882 end if; 883 end if; 884 end for; 885 writeln; 886 end for; 887 end if; 888 end func; (* galactic_records *) 889 890 891const proc: write_stardate is func 892 begin 893 writeln; 894 writeln("It is stardate " <& stardate); 895 end func; (* write_stardate *) 896 897 898const proc: game is func 899 local 900 var integer: rating is 0; 901 var string: command is ""; 902 var boolean: quit is FALSE; 903 begin 904 init; 905 enter_quadrant; 906 hits_from_klingons; 907 short_range_sensors; 908 while energy > 0.0 and 909 stardate <= endStardate and 910 total_klingons >= 1 and 911 not quit do 912 write("Command? "); 913 readln(command); 914 if command = "" then 915 command := " "; 916 end if; 917 case upper(command[1]) of 918 when {'1', 'W'}: warp_engines; 919 when {'2', 'S'}: short_range_sensors; 920 when {'3', 'L'}: long_range_sensors; 921 when {'4', 'P'}: phasers; 922 when {'5', 'T'}: photon_torpedoes; 923 when {'6', 'G'}: galactic_records; 924 when {'?', 'H'}: help; 925 when {'Q'}: 926 writeln; 927 write("Are you sure you want to quit? "); 928 command := getln(IN); 929 if upper(command) = "Y" then 930 quit := TRUE; 931 end if; 932 otherwise: 933 help_commands; 934 end case; 935 end while; 936 write_stardate; 937 if total_klingons < 1 then 938 rating := 1000 * klingons_in_game div (stardate - startStardate); 939 writeln("The federation has been saved!"); 940 writeln("You are promoted to admiral."); 941 writeln(klingons_in_game <& " Klingons in " <& stardate - startStardate <& 942 " stardates. Rating = " <& rating); 943 elsif energy <= 0.0 or stardate > endStardate or quit then 944 if energy <= 0.0 then 945 writeln("You ran out of energy!"); 946 elsif stardate > endStardate then 947 writeln("You ran out of time!"); 948 elsif quit then 949 writeln("You quit your job!"); 950 end if; 951 writeln("Thanks to your bungling, the federation will be"); 952 writeln("conquered by the remaining " <& total_klingons <& " Klingon cruisers!"); 953 writeln("You are demoted to cabin boy!"); 954 end if; 955 end func; (* game *) 956 957 958const proc: main is func 959 local 960 var boolean: finished is FALSE; 961 var string: answer is ""; 962 begin 963 title; 964 write("Do you need instructions (Y/N)? "); 965 answer := upper(getln(IN)); 966 if answer <> "Q" then 967 if answer = "Y" then 968 help; 969 end if; 970 writeln; 971 repeat 972 game; 973 write("Try again? "); 974 answer := getln(IN); 975 finished := upper(answer) = "N"; 976 until finished; 977 end if; 978 end func; (* main *) 979