v11i100: Another Star Trek Game, Part14/14
pfuetz at agd.fhg.de
pfuetz at agd.fhg.de
Tue Feb 26 15:16:45 AEST 1991
Submitted-by: pfuetz at agd.fhg.de
Posting-number: Volume 11, Issue 100
Archive-name: xstrek/part14
#!/bin/sh
# To unshare, sh or unshar this file
echo xstrek/strek_prune_db.c 1>&2
sed -e 's/^X//' > xstrek/strek_prune_db.c <<'E!O!F! xstrek/strek_prune_db.c'
X/* strek_prune_db.f -- translated by f2c (version of 19 December 1990 16:50:21).
X You must link the resulting object file with the libraries:
X -lF77 -lI77 -lm -lc (in that order)
X*/
X
X#include "f2c.h"
X
X/* Table of constant values */
X
Xstatic integer c__1 = 1;
X
X/* Main program */ MAIN__()
X{
X /* System generated locals */
X integer i__1;
X olist o__1;
X cllist cl__1;
X
X /* Builtin functions */
X integer f_open(), s_rdue(), do_uio(), e_rdue(), s_cmp(), s_wdue(), e_wdue(
X ), f_clos();
X /* Subroutine */ int s_stop();
X
X /* Local variables */
X static real year;
X static char key_file__[256*1000];
X static integer num_kept__, ship_retired__[1000], i, j;
X static real check;
X static shortint clock[6];
X static char nick_name__[10*1000], capt_name__[10*1000], ship_name__[30*
X 1000];
X static integer month;
X static char user_name__[10*1000];
X static integer cum_score__[1000], num_lines__, ship_avail__[3000] /*
X was [1000][3] */;
X extern /* Subroutine */ int caldecodelocaltime_();
X static integer last_score__[1000];
X
X /* Fortran I/O blocks */
X static cilist io___2 = { 0, 1, 0, 0, 1 };
X static cilist io___5 = { 0, 1, 0, 0, 0 };
X static cilist io___20 = { 0, 1, 0, 0, 0 };
X static cilist io___21 = { 0, 1, 0, 0, 0 };
X static cilist io___22 = { 0, 1, 0, 0, 1 };
X
X
X
X/* *******************************************************************
X*/
X/* ***** *****
X*/
X/* ***** STAR TREK VERSION 3.0 *****
X*/
X/* ***** *****
X*/
X/* ***** written by *****
X*/
X/* ***** *****
X*/
X/* ***** Justin S. Revenaugh *****
X*/
X/* ***** *****
X*/
X/* ***** 7/87 *****
X*/
X/* ***** *****
X*/
X/* ***** Massachussetts Institute of Technology *****
X*/
X/* ***** Department of Earth, Atmospheric and Planetary Science *****
X*/
X/* ***** *****
X*/
X/* *******************************************************************
X*/
X
X/* STREK_PRUNE_INFO helps weed out retired or unused ships from the */
X/* ship's registry (STREK_INFO). Used occasionally it should prevent */
X
X/* this file from growing too huge. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X
X/* get local date */
X
X caldecodelocaltime_(clock);
X
X/* open up file and read num_lines */
X
X o__1.oerr = 0;
X o__1.ounit = 1;
X o__1.ofnmlen = 30;
X o__1.ofnm = "/usr/lib/X11/xstrek/strek_info";
X o__1.orl = 1000;
X o__1.osta = 0;
X o__1.oacc = "direct";
X o__1.ofm = "unformatted";
X o__1.oblnk = 0;
X f_open(&o__1);
X s_rdue(&io___2);
X do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X e_rdue();
X i__1 = num_lines__;
X for (j = 1; j <= i__1; ++j) {
X io___5.cirec = j + 1;
X s_rdue(&io___5);
X do_uio(&c__1, ship_name__ + (j - 1) * 30, 30L);
X do_uio(&c__1, user_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, capt_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, nick_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, key_file__ + (j - 1 << 8), 256L);
X for (i = 1; i <= 3; ++i) {
X do_uio(&c__1, (char *)&ship_avail__[j + i * 1000 - 1001], (ftnlen)
X sizeof(integer));
X }
X do_uio(&c__1, (char *)&last_score__[j - 1], (ftnlen)sizeof(integer));
X do_uio(&c__1, (char *)&cum_score__[j - 1], (ftnlen)sizeof(integer));
X do_uio(&c__1, (char *)&ship_retired__[j - 1], (ftnlen)sizeof(integer))
X ;
X e_rdue();
X/* L10: */
X }
X num_kept__ = 0;
X i__1 = num_lines__;
X for (j = 1; j <= i__1; ++j) {
X if (ship_retired__[j - 1] != 1) {
X check = (real) (clock[1] - 2);
X year = (real) (clock[0] - 1);
X month = clock[1] - 10;
X if (ship_avail__[j - 1] >= clock[0] && (real) ship_avail__[j +
X 999] > check || (real) ship_avail__[j - 1] == year &&
X month > 0) {
X if (s_cmp(ship_name__ + (j - 1) * 30, " ", 30L, 1L) != 0) {
X ++num_kept__;
X io___20.cirec = num_kept__ + 1;
X s_wdue(&io___20);
X do_uio(&c__1, ship_name__ + (j - 1) * 30, 30L);
X do_uio(&c__1, user_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, capt_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, nick_name__ + (j - 1) * 10, 10L);
X do_uio(&c__1, key_file__ + (j - 1 << 8), 256L);
X for (i = 1; i <= 3; ++i) {
X do_uio(&c__1, (char *)&ship_avail__[j + i * 1000 -
X 1001], (ftnlen)sizeof(integer));
X }
X do_uio(&c__1, (char *)&last_score__[j - 1], (ftnlen)
X sizeof(integer));
X do_uio(&c__1, (char *)&cum_score__[j - 1], (ftnlen)sizeof(
X integer));
X do_uio(&c__1, (char *)&ship_retired__[j - 1], (ftnlen)
X sizeof(integer));
X e_wdue();
X }
X }
X }
X/* L20: */
X }
X
X/* erase all former ships */
X
X i__1 = num_lines__ + 1;
X for (j = num_kept__ + 2; j <= i__1; ++j) {
X io___21.cirec = j;
X s_wdue(&io___21);
X e_wdue();
X/* L30: */
X }
X
X/* rewrite the number of ships in the registry */
X
X s_wdue(&io___22);
X do_uio(&c__1, (char *)&num_kept__, (ftnlen)sizeof(integer));
X e_wdue();
X cl__1.cerr = 0;
X cl__1.cunit = 1;
X cl__1.csta = 0;
X f_clos(&cl__1);
X s_stop("", 0L);
X} /* MAIN__ */
X
X/* Main program alias */ int strek_prune_info__ () { MAIN__ (); }
E!O!F! xstrek/strek_prune_db.c
echo xstrek/strek_random_subs.c 1>&2
sed -e 's/^X//' > xstrek/strek_random_subs.c <<'E!O!F! xstrek/strek_random_subs.c'
X/* strek_random_subs.f -- translated by f2c (version of 19 December 1990 16:50:21).
X You must link the resulting object file with the libraries:
X -lF77 -lI77 -lm -lc (in that order)
X*/
X
X#include "f2c.h"
X
X/* Table of constant values */
X
Xstatic integer c__1 = 1;
Xstatic integer c__3 = 3;
X
X/* Subroutine */ int strek_assess_damage__(d_pct__, damage, scan, tract,
X phase, energy, seed)
Xreal *d_pct__, *damage;
Xlogical *scan, *tract, *phase;
Xreal *energy, *seed;
X{
X extern /* Subroutine */ int rand_();
X static integer j;
X
X
X/* *******************************************************************
X*/
X/* ***** *****
X*/
X/* ***** STAR TREK VERSION 3.0 *****
X*/
X/* ***** *****
X*/
X/* ***** written by *****
X*/
X/* ***** *****
X*/
X/* ***** Justin S. Revenaugh *****
X*/
X/* ***** *****
X*/
X/* ***** 7/87 *****
X*/
X/* ***** *****
X*/
X/* ***** Massachussetts Institute of Technology *****
X*/
X/* ***** Department of Earth, Atmospheric and Planetary Science *****
X*/
X/* ***** *****
X*/
X/* *******************************************************************
X*/
X
X/* STREK_ASSESS_DAMAGE assesses enemy damage done to the player's */
X/* ship. If a damage percent reaches 100 (i.e. d_pct = 0.0) then */
X/* the associated function (if any) is deactivated. */
X
X
X
X/* adjust energy */
X
X /* Parameter adjustments */
X --d_pct__;
X
X /* Function Body */
X if (*damage > (float)0.) {
X *energy -= *damage / (float)10.;
X
X/* apply damage */
X
X for (j = 1; j <= 6; ++j) {
X rand_(seed);
X d_pct__[j] -= *seed * *damage * (float).0025;
X if (d_pct__[j] < (float)0.) {
X d_pct__[j] = (float)0.;
X }
X/* L10: */
X }
X
X/* check for function loss */
X
X if (d_pct__[3] == (float)0.) {
X *phase = FALSE_;
X }
X if (d_pct__[5] == (float)0.) {
X *scan = FALSE_;
X }
X if (d_pct__[6] == (float)0.) {
X *tract = FALSE_;
X }
X *damage = (float)0.;
X }
X return 0;
X} /* strek_assess_damage__ */
X
X/* Subroutine */ int strek_photon_damage__(distance, damage, seed, type)
Xreal *distance, *damage, *seed;
Xinteger *type;
X{
X /* Builtin functions */
X double sqrt();
X
X /* Local variables */
X extern /* Subroutine */ int rand_();
X static real mult, t1;
X
X
X/* STREK_PHOTON_DAMAGE calculates the damage do to anyone's */
X/* photons hitting anyone. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X
X/* using distance figure damage. Falls off as 1/sqrt(distance) */
X/* instead as 1/distance (which is physically correct, but destroys */
X/* game balance). Type is the rating of damage (mild - severe). */
X
X rand_(seed);
X if (*seed < (float).8) {
X mult = (float).8;
X } else {
X mult = *seed;
X }
X t1 = (float)100. / sqrt(sqrt(*distance) + (float)3.) * mult;
X *damage = t1 + *damage;
X if (t1 < (float)5.) {
X *type = 1;
X }
X if (t1 >= (float)5. && t1 < (float)15.) {
X *type = 2;
X }
X if (t1 >= (float)15.) {
X *type = 3;
X }
X return 0;
X} /* strek_photon_damage__ */
X
X/* Subroutine */ int strek_phaser_damage__(range, damage, seed, target)
Xreal *range, *damage, *seed;
Xlogical *target;
X{
X /* Initialized data */
X
X static char message[80*3+1] = "Ship hit by enemy phaser fire. \
X \
X \
X ";
X static char text[80+1] = "Repair parties report that the damage was \
X ";
X static char dam_rating__[10*3+1] = "light moderate heavy ";
X
X /* System generated locals */
X real r__1, r__2;
X
X /* Builtin functions */
X double sqrt();
X integer s_wsfi(), do_fio(), e_wsfi();
X
X /* Local variables */
X extern /* Subroutine */ int rand_();
X static integer type;
X static real t1, t2, t3, t4;
X extern /* Subroutine */ int strek_message__();
X
X /* Fortran I/O blocks */
X static icilist io___12 = { 0, message+160, 0, "(a42, a10)", 80, 1 };
X
X
X
X/* STREK_PHASER_DAMAGE computes klingon phaser damage */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X
X/* figure damage */
X
X t4 = (float)0.;
X rand_(seed);
X if (*seed <= (float)80.) {
X rand_(seed);
X/* Computing MAX */
X r__1 = (float)10., r__2 = sqrt(*range);
X t1 = dmax(r__1,r__2);
X t2 = (float)15. - t1 * (float).075;
X t3 = *seed * (float).2 + (float).8;
X t4 = dmax((float)0.,t2) * t3;
X *damage += t4;
X }
X
X/* write damage message */
X
X if (*target) {
X type = 1;
X if (t4 < (float)5.) {
X type = 1;
X }
X if (t4 >= (float)5. && t4 < (float)15.) {
X type = 2;
X }
X if (t4 >= (float)15.) {
X type = 3;
X }
X s_wsfi(&io___12);
X do_fio(&c__1, text, 80L);
X do_fio(&c__1, dam_rating__ + (type - 1) * 10, 10L);
X e_wsfi();
X strek_message__(message, &c__3, 80L);
X }
X return 0;
X} /* strek_phaser_damage__ */
X
X/* Subroutine */ int strek_phaser_fire__(range, seed, damage, type)
Xreal *range, *seed, *damage;
Xinteger *type;
X{
X /* System generated locals */
X real r__1, r__2;
X
X /* Builtin functions */
X double sqrt();
X
X /* Local variables */
X extern /* Subroutine */ int rand_();
X static real t1, t2, t3;
X
X
X/* STREK_PHASER_FIRE evaluates the damage done by the players */
X/* phasers to all other objects. */
X
X/* version 1 */
X/* - jsr 8/85 */
X
X
X rand_(seed);
X if (*seed <= (float)80.) {
X rand_(seed);
X t3 = *seed * (float).2 + (float).8;
X/* Computing MAX */
X r__1 = (float)10., r__2 = sqrt(*range);
X t1 = dmax(r__1,r__2);
X t2 = (float)25. - t1 * (float).075;
X t2 = dmax((float)0.,t2) * t3;
X *damage += t2;
X }
X if (t2 < (float)5.) {
X *type = 1;
X }
X if (t2 >= (float)5. && t2 < (float)15.) {
X *type = 2;
X }
X if (t2 >= (float)15.) {
X *type = 3;
X }
X return 0;
X} /* strek_phaser_fire__ */
X
E!O!F! xstrek/strek_random_subs.c
echo xstrek/strek_ships_subs.c 1>&2
sed -e 's/^X//' > xstrek/strek_ships_subs.c <<'E!O!F! xstrek/strek_ships_subs.c'
X/* strek_ships_subs.f -- translated by f2c (version of 19 December 1990 16:50:21).
X You must link the resulting object file with the libraries:
X -lF77 -lI77 -lm -lc (in that order)
X*/
X
X#include "f2c.h"
X
X/* Table of constant values */
X
Xstatic integer c__10 = 10;
Xstatic integer c__6 = 6;
Xstatic integer c__15 = 15;
Xstatic integer c__5 = 5;
Xstatic integer c__12 = 12;
Xstatic integer c__9 = 9;
Xstatic integer c__8 = 8;
Xstatic integer c__14 = 14;
X
X/* Subroutine */ int strek_nemian__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir, sa, ca, sp, cp)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
Xreal *sa, *ca, *sp, *cp;
X{
X /* Initialized data */
X
X static real x1[10] = { (float)2.5,(float)2.5,(float)2.5,(float)-2.5,(
X float)-2.5,(float)-2.5,(float)-2.5,(float)2.5,(float)2.5,(float)
X -2.5 };
X static real y1[10] = { (float)-5.,(float)-7.5,(float)3.5,(float)3.5,(
X float)-7.5,(float)-5.,(float)2.5,(float)2.5,(float)-5.,(float)-5.
X };
X static real z1[10] = { (float)-2.5,(float)2.5,(float)2.5,(float)2.5,(
X float)2.5,(float)-2.5,(float)-2.5,(float)-2.5,(float)-2.5,(float)
X -2.5 };
X static real x2[7] = { (float)-2.5,(float)2.5,(float)-2.5,(float)-2.5,(
X float)2.5,(float)2.5,(float)0. };
X static real y2[7] = { (float)-7.5,(float)-7.5,(float)3.5,(float)2.5,(
X float)3.5,(float)2.5,(float)5. };
X static real z2[7] = { (float)2.5,(float)2.5,(float)2.5,(float)-2.5,(float)
X 2.5,(float)-2.5,(float)0. };
X
X extern /* Subroutine */ int gprpolyline_();
X static shortint x_pt__[10], y_pt__[10], x_pt1__[6], y_pt1__[6];
X extern /* Subroutine */ int gprmultiline_();
X static integer j, istat;
X extern /* Subroutine */ int gprcircle_();
X static real r1[10], r2[10], t1[10], t2[10], t3[10], t4[10], t5[10], t6[10]
X , r3[10], r4[10], r5[10], r6[10];
X static shortint center[2], radius;
X extern /* Subroutine */ int gprmove_();
X
X
X
X/* *******************************************************************
X*/
X/* ***** *****
X*/
X/* ***** STAR TREK VERSION 3.0 *****
X*/
X/* ***** *****
X*/
X/* ***** written by *****
X*/
X/* ***** *****
X*/
X/* ***** Justin S. Revenaugh *****
X*/
X/* ***** *****
X*/
X/* ***** 7/87 *****
X*/
X/* ***** *****
X*/
X/* ***** Massachussetts Institute of Technology *****
X*/
X/* ***** Department of Earth, Atmospheric and Planetary Science *****
X*/
X/* ***** *****
X*/
X/* *******************************************************************
X*/
X/* STREK_NEMIAN draws a nemian freighter in 3-d at xs, ys, zs as */
X/* seen from xc, yc, zc. */
X
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* saves and data for ship config */
X
X
X/* if dir then rotate ship into galatic coordinates */
X
X if (*dir) {
X
X/* rotate the points about the local position */
X
X for (j = 1; j <= 10; ++j) {
X t1[j - 1] = x1[j - 1] * *ca - y1[j - 1] * *sa * *cp + z1[j - 1] *
X *sa * *sp + *xs;
X t2[j - 1] = x1[j - 1] * *sa + y1[j - 1] * *ca * *cp - z1[j - 1] *
X *ca * *sp + *ys;
X t3[j - 1] = y1[j - 1] * *sp + z1[j - 1] * *cp + *zs;
X/* L10: */
X }
X for (j = 1; j <= 7; ++j) {
X t4[j - 1] = x2[j - 1] * *ca - y2[j - 1] * *sa * *cp + z2[j - 1] *
X *sa * *sp + *xs;
X t5[j - 1] = x2[j - 1] * *sa + y2[j - 1] * *ca * *cp - z2[j - 1] *
X *ca * *sp + *ys;
X t6[j - 1] = y2[j - 1] * *sp + z2[j - 1] * *cp + *zs;
X/* L20: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 10; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X r1[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X r2[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X r3[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (r2[j - 1] < (float)1.) {
X r2[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = r1[j - 1] / r2[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - r3[j - 1] / r2[j - 1] * (float)350.;
X
X/* L30: */
X }
X for (j = 1; j <= 7; ++j) {
X t4[j - 1] -= *xc;
X t5[j - 1] -= *yc;
X t6[j - 1] -= *zc;
X r4[j - 1] = t4[j - 1] * *csa + t5[j - 1] * *ssa;
X r5[j - 1] = -(doublereal)t4[j - 1] * *ssa * *csp + t5[j - 1] * *
X csa * *csp + t6[j - 1] * *ssp;
X r6[j - 1] = t4[j - 1] * *ssa * *ssp - t5[j - 1] * *csa * *ssp +
X t6[j - 1] * *csp;
X if (r5[j - 1] < (float)1.) {
X r5[j - 1] = (float)1.;
X }
X if (j != 7) {
X x_pt1__[j - 1] = r4[j - 1] / r5[j - 1] * (float)350. + (float)
X 450.;
X y_pt1__[j - 1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)
X 350.;
X } else {
X center[0] = r4[j - 1] / r5[j - 1] * (float)350. + (float)450.;
X
X center[1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)350.;
X
X }
X/* L40: */
X }
X radius = (float)2.5 / r5[6] * (float)350. + (float).5;
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__10, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__6, &istat);
X if (radius > 0) {
X gprcircle_(center, &radius, &istat);
X }
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__10, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__6, &istat);
X if (radius > 0) {
X gprcircle_(center, &radius, &istat);
X }
X }
X return 0;
X} /* strek_nemian__ */
X
X/* Subroutine */ int strek_klingon__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir, pcen, sa, ca, sp, cp)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
Xshortint *pcen;
Xreal *sa, *ca, *sp, *cp;
X{
X /* Initialized data */
X
X static real x1[15] = { (float).75,(float)1.,(float)6.5,(float)7.5,(float)
X 7.5,(float)6.5,(float)6.5,(float)0.,(float)-6.5,(float)-6.5,(
X float)-7.5,(float)-7.5,(float)-6.5,(float)-1.,(float)-.75 };
X static real y1[15] = { (float)6.,(float)3.,(float)0.,(float)0.,(float)
X -7.5,(float)-7.5,(float)-1.5,(float)-3.5,(float)-1.5,(float)-7.5,(
X float)-7.5,(float)0.,(float)0.,(float)3.,(float)6. };
X static real z1[15] = { (float)1.,(float).8,(float).1,(float).1,(float).1,(
X float).1,(float).1,(float)1.,(float).1,(float).1,(float).1,(float)
X .1,(float).1,(float).8,(float)1. };
X static real x3[5] = { (float)6.5,(float)6.5,(float)7.5,(float)7.5,(float)
X 6.5 };
X static real y3[5] = { (float)0.,(float)-7.5,(float)-7.5,(float)0.,(float)
X 0. };
X static real z3[5] = { (float)-2.,(float)-2.,(float)-2.,(float)-2.,(float)
X -2. };
X static real x4[5] = { (float)-6.5,(float)-6.5,(float)-7.5,(float)-7.5,(
X float)-6.5 };
X static real y4[5] = { (float)0.,(float)-7.5,(float)-7.5,(float)0.,(float)
X 0. };
X static real z4[5] = { (float)-2.,(float)-2.,(float)-2.,(float)-2.,(float)
X -2. };
X static real x5[13] = { (float)7.5,(float)7.5,(float)7.5,(float)7.5,(float)
X 6.5,(float)6.5,(float)-7.5,(float)-7.5,(float)-7.5,(float)-7.5,(
X float)-6.5,(float)-6.5,(float)0. };
X static real y5[13] = { (float)0.,(float)0.,(float)-7.5,(float)-7.5,(float)
X -7.5,(float)-7.5,(float)0.,(float)0.,(float)-7.5,(float)-7.5,(
X float)-7.5,(float)-7.5,(float)7.5 };
X static real z5[13] = { (float).1,(float)-2.,(float).1,(float)-2.,(float)
X .1,(float)-2.,(float).1,(float)-2.,(float).1,(float)-2.,(float).1,
X (float)-2.,(float)1. };
X
X extern /* Subroutine */ int gprpolyline_();
X static shortint x_pt__[15], y_pt__[15], x3_pt__[5], y3_pt__[5], x4_pt__[5]
X , y4_pt__[5], x5_pt__[12], y5_pt__[12];
X extern /* Subroutine */ int gprmultiline_();
X static integer j, istat;
X extern /* Subroutine */ int gprcircle_();
X static real r1[15], r2[15], t1[15], t2[15], t3[15], t7[15], t8[15], t9[15]
X , r3[15], r7[15], r8[15], r9[15], t10[15], t11[15], t12[15], t13[
X 15], t14[15], t15[15], r10[15], r11[15], r12[15], r13[15], r14[15]
X , r15[15];
X static shortint center[2], radius;
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_KLINGON_1 draws a klingon in 3-d at xs, ys, zs as */
X/* seen from xc, yc, zc. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* saves and data for ship config */
X
X /* Parameter adjustments */
X --pcen;
X
X /* Function Body */
X
X/* if dir then rotate into galatic coords */
X
X if (*dir) {
X
X/* rotate the points about the local position */
X
X for (j = 1; j <= 15; ++j) {
X t1[j - 1] = x1[j - 1] * *ca - y1[j - 1] * *sa * *cp + z1[j - 1] *
X *sa * *sp + *xs;
X t2[j - 1] = x1[j - 1] * *sa + y1[j - 1] * *ca * *cp - z1[j - 1] *
X *ca * *sp + *ys;
X t3[j - 1] = y1[j - 1] * *sp + z1[j - 1] * *cp + *zs;
X/* L10: */
X }
X for (j = 1; j <= 5; ++j) {
X t7[j - 1] = x3[j - 1] * *ca - y3[j - 1] * *sa * *cp + z3[j - 1] *
X *sa * *sp + *xs;
X t8[j - 1] = x3[j - 1] * *sa + y3[j - 1] * *ca * *cp - z3[j - 1] *
X *ca * *sp + *ys;
X t9[j - 1] = y3[j - 1] * *sp + z3[j - 1] * *cp + *zs;
X t10[j - 1] = x4[j - 1] * *ca - y4[j - 1] * *sa * *cp + z4[j - 1] *
X *sa * *sp + *xs;
X t11[j - 1] = x4[j - 1] * *sa + y4[j - 1] * *ca * *cp - z4[j - 1] *
X *ca * *sp + *ys;
X t12[j - 1] = y4[j - 1] * *sp + z4[j - 1] * *cp + *zs;
X/* L20: */
X }
X for (j = 1; j <= 13; ++j) {
X t13[j - 1] = x5[j - 1] * *ca - y5[j - 1] * *sa * *cp + z5[j - 1] *
X *sa * *sp + *xs;
X t14[j - 1] = x5[j - 1] * *sa + y5[j - 1] * *ca * *cp - z5[j - 1] *
X *ca * *sp + *ys;
X t15[j - 1] = y5[j - 1] * *sp + z5[j - 1] * *cp + *zs;
X/* L30: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 15; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X r1[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X r2[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X r3[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (r2[j - 1] < (float)1.) {
X r2[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = r1[j - 1] / r2[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - r3[j - 1] / r2[j - 1] * (float)350.;
X
X/* L40: */
X }
X for (j = 1; j <= 5; ++j) {
X t7[j - 1] -= *xc;
X t8[j - 1] -= *yc;
X t9[j - 1] -= *zc;
X r7[j - 1] = t7[j - 1] * *csa + t8[j - 1] * *ssa;
X r8[j - 1] = -(doublereal)t7[j - 1] * *ssa * *csp + t8[j - 1] * *
X csa * *csp + t9[j - 1] * *ssp;
X r9[j - 1] = t7[j - 1] * *ssa * *ssp - t8[j - 1] * *csa * *ssp +
X t9[j - 1] * *csp;
X if (r8[j - 1] < (float)1.) {
X r8[j - 1] = (float)1.;
X }
X x3_pt__[j - 1] = r7[j - 1] / r8[j - 1] * (float)350. + (float)
X 450.;
X y3_pt__[j - 1] = (float)400. - r9[j - 1] / r8[j - 1] * (float)
X 350.;
X t10[j - 1] -= *xc;
X t11[j - 1] -= *yc;
X t12[j - 1] -= *zc;
X r10[j - 1] = t10[j - 1] * *csa + t11[j - 1] * *ssa;
X r11[j - 1] = -(doublereal)t10[j - 1] * *ssa * *csp + t11[j - 1] *
X *csa * *csp + t12[j - 1] * *ssp;
X r12[j - 1] = t10[j - 1] * *ssa * *ssp - t11[j - 1] * *csa * *ssp
X + t12[j - 1] * *csp;
X if (r11[j - 1] < (float)1.) {
X r11[j - 1] = (float)1.;
X }
X x4_pt__[j - 1] = r10[j - 1] / r11[j - 1] * (float)350. + (float)
X 450.;
X y4_pt__[j - 1] = (float)400. - r12[j - 1] / r11[j - 1] * (float)
X 350.;
X/* L50: */
X }
X for (j = 1; j <= 13; ++j) {
X t13[j - 1] -= *xc;
X t14[j - 1] -= *yc;
X t15[j - 1] -= *zc;
X r13[j - 1] = t13[j - 1] * *csa + t14[j - 1] * *ssa;
X r14[j - 1] = -(doublereal)t13[j - 1] * *ssa * *csp + t14[j - 1] *
X *csa * *csp + t15[j - 1] * *ssp;
X r15[j - 1] = t13[j - 1] * *ssa * *ssp - t14[j - 1] * *csa * *ssp
X + t15[j - 1] * *csp;
X if (r14[j - 1] < (float)1.) {
X r14[j - 1] = (float)1.;
X }
X if (j == 13) {
X center[0] = r13[j - 1] / r14[j - 1] * (float)350. + (float)
X 450.;
X center[1] = (float)400. - r15[j - 1] / r14[j - 1] * (float)
X 350.;
X pcen[1] = center[0];
X pcen[2] = center[1];
X } else {
X x5_pt__[j - 1] = r13[j - 1] / r14[j - 1] * (float)350. + (
X float)450.;
X y5_pt__[j - 1] = (float)400. - r15[j - 1] / r14[j - 1] * (
X float)350.;
X }
X/* L60: */
X }
X radius = (float)1.5 / r14[12] * (float)350. + (float).5;
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__15, &istat);
X gprmove_(x3_pt__, y3_pt__, &istat);
X gprpolyline_(x3_pt__, y3_pt__, &c__5, &istat);
X gprmove_(x4_pt__, y4_pt__, &istat);
X gprpolyline_(x4_pt__, y4_pt__, &c__5, &istat);
X gprmultiline_(x5_pt__, y5_pt__, &c__12, &istat);
X if (radius > 0) {
X gprcircle_(center, &radius, &istat);
X }
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__15, &istat);
X gprmove_(x3_pt__, y3_pt__, &istat);
X gprpolyline_(x3_pt__, y3_pt__, &c__5, &istat);
X gprmove_(x4_pt__, y4_pt__, &istat);
X gprpolyline_(x4_pt__, y4_pt__, &c__5, &istat);
X gprmultiline_(x5_pt__, y5_pt__, &c__12, &istat);
X if (radius > 0) {
X gprcircle_(center, &radius, &istat);
X }
X }
X return 0;
X} /* strek_klingon__ */
X
X/* Subroutine */ int strek_romulan_1__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir, sa, ca, sp, cp)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
Xreal *sa, *ca, *sp, *cp;
X{
X /* Initialized data */
X
X static real x1[9] = { (float)6.5,(float)3.3,(float)0.,(float)-3.3,(float)
X -6.5,(float)0.,(float)6.5,(float)0.,(float)-6.5 };
X static real y1[9] = { (float)-3.5,(float)3.,(float)5.,(float)3.,(float)
X -3.5,(float)-5.,(float)-3.5,(float)-5.,(float)-3.5 };
X static real z1[9] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)0.,(
X float)1.5,(float)0.,(float)-1.5,(float)0. };
X static real x2[10] = { (float)0.,(float)0.,(float)3.3,(float)0.,(float)
X -3.3,(float)0.,(float)0.,(float)0.,(float)7.5,(float)-7.5 };
X static real y2[10] = { (float)5.,(float)-5.,(float)3.,(float)0.,(float)3.,
X (float)0.,(float)-5.,(float)0.,(float)-3.5,(float)-3.5 };
X static real z2[10] = { (float)0.,(float)1.5,(float)0.,(float)-1.,(float)
X 0.,(float)-1.,(float)-1.5,(float)-1.,(float)0.,(float)0. };
X
X extern /* Subroutine */ int gprpolyline_();
X static shortint x_pt__[9], y_pt__[9], x_pt1__[8], y_pt1__[8];
X static integer i, j;
X extern /* Subroutine */ int gprmultiline_();
X static integer istat;
X extern /* Subroutine */ int gprcircle_();
X static real r1[10], r2[10], t1[10], t2[10], t3[10], t4[10], t5[10], t6[10]
X , r3[10], r4[10], r5[10], r6[10];
X static shortint center[4] /* was [2][2] */, radius[2], xpt[2];
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_ROMULAN_1 draws a romulan in 3-d at xs, ys, zs as */
X/* seen from xc, yc, zc. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* saves and data for ship config */
X
X
X/* if dir then rotate into galatic coords */
X
X if (*dir) {
X
X/* rotate the points about the local position */
X
X for (j = 1; j <= 9; ++j) {
X t1[j - 1] = x1[j - 1] * *ca - y1[j - 1] * *sa * *cp + z1[j - 1] *
X *sa * *sp + *xs;
X t2[j - 1] = x1[j - 1] * *sa + y1[j - 1] * *ca * *cp - z1[j - 1] *
X *ca * *sp + *ys;
X t3[j - 1] = y1[j - 1] * *sp + z1[j - 1] * *cp + *zs;
X/* L10: */
X }
X for (j = 1; j <= 10; ++j) {
X t4[j - 1] = x2[j - 1] * *ca - y2[j - 1] * *sa * *cp + z2[j - 1] *
X *sa * *sp + *xs;
X t5[j - 1] = x2[j - 1] * *sa + y2[j - 1] * *ca * *cp - z2[j - 1] *
X *ca * *sp + *ys;
X t6[j - 1] = y2[j - 1] * *sp + z2[j - 1] * *cp + *zs;
X/* L20: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 9; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X r1[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X r2[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X r3[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (r2[j - 1] < (float)1.) {
X r2[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = r1[j - 1] / r2[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - r3[j - 1] / r2[j - 1] * (float)350.;
X
X/* L30: */
X }
X for (j = 1; j <= 10; ++j) {
X t4[j - 1] -= *xc;
X t5[j - 1] -= *yc;
X t6[j - 1] -= *zc;
X r4[j - 1] = t4[j - 1] * *csa + t5[j - 1] * *ssa;
X r5[j - 1] = -(doublereal)t4[j - 1] * *ssa * *csp + t5[j - 1] * *
X csa * *csp + t6[j - 1] * *ssp;
X r6[j - 1] = t4[j - 1] * *ssa * *ssp - t5[j - 1] * *csa * *ssp +
X t6[j - 1] * *csp;
X if (r5[j - 1] < (float)1.) {
X r5[j - 1] = (float)1.;
X }
X if (j <= 8) {
X x_pt1__[j - 1] = r4[j - 1] / r5[j - 1] * (float)350. + (float)
X 450.;
X y_pt1__[j - 1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)
X 350.;
X } else {
X i = j - 8;
X center[i - 1] = r4[j - 1] / r5[j - 1] * (float)350. + (float)
X 450.;
X center[i + 1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)
X 350.;
X }
X/* L40: */
X }
X radius[0] = (float)1. / r5[8] * (float)350. + (float).5;
X radius[1] = (float)1. / r5[9] * (float)350. + (float).5;
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__9, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__8, &istat);
X for (j = 1; j <= 2; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 1];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L50: */
X }
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__9, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__8, &istat);
X for (j = 1; j <= 2; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 1];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L60: */
X }
X }
X return 0;
X} /* strek_romulan_1__ */
X
X/* Subroutine */ int strek_romulan_2__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir, sa, ca, sp, cp)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
Xreal *sa, *ca, *sp, *cp;
X{
X /* Initialized data */
X
X static real x1[9] = { (float)6.5,(float)3.3,(float)0.,(float)-3.3,(float)
X -6.5,(float)0.,(float)6.5,(float)0.,(float)-6.5 };
X static real y1[9] = { (float)-3.5,(float)3.,(float)5.,(float)3.,(float)
X -3.5,(float)-5.,(float)-3.5,(float)-5.,(float)-3.5 };
X static real z1[9] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)0.,(
X float)1.5,(float)0.,(float)-1.5,(float)0. };
X static real x2[10] = { (float)0.,(float)0.,(float)3.3,(float)0.,(float)
X -3.3,(float)0.,(float)0.,(float)0.,(float)7.5,(float)-7.5 };
X static real y2[10] = { (float)5.,(float)-5.,(float)3.,(float)0.,(float)3.,
X (float)0.,(float)-5.,(float)0.,(float)-3.5,(float)-3.5 };
X static real z2[10] = { (float)0.,(float)1.5,(float)0.,(float)-1.,(float)
X 0.,(float)-1.,(float)-1.5,(float)-1.,(float)0.,(float)0. };
X
X extern /* Subroutine */ int gprpolyline_();
X static shortint x_pt__[9], y_pt__[9], x_pt1__[8], y_pt1__[8];
X static integer i, j;
X extern /* Subroutine */ int gprmultiline_();
X static integer istat;
X extern /* Subroutine */ int gprcircle_();
X static real r1[10], r2[10], t1[10], t2[10], t3[10], t4[10], t5[10], t6[10]
X , r3[10], r4[10], r5[10], r6[10];
X static shortint center[4] /* was [2][2] */, radius[2], xpt[2];
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_ROMULAN_2 draws a romulan in 3-d at xs, ys, zs as */
X/* seen from xc, yc, zc. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* saves and data for ship config */
X
X
X/* if dir then rotate into galatic coords */
X
X if (*dir) {
X
X/* rotate the points about the local position */
X
X for (j = 1; j <= 9; ++j) {
X t1[j - 1] = x1[j - 1] * *ca - y1[j - 1] * *sa * *cp + z1[j - 1] *
X *sa * *sp + *xs;
X t2[j - 1] = x1[j - 1] * *sa + y1[j - 1] * *ca * *cp - z1[j - 1] *
X *ca * *sp + *ys;
X t3[j - 1] = y1[j - 1] * *sp + z1[j - 1] * *cp + *zs;
X/* L10: */
X }
X for (j = 1; j <= 10; ++j) {
X t4[j - 1] = x2[j - 1] * *ca - y2[j - 1] * *sa * *cp + z2[j - 1] *
X *sa * *sp + *xs;
X t5[j - 1] = x2[j - 1] * *sa + y2[j - 1] * *ca * *cp - z2[j - 1] *
X *ca * *sp + *ys;
X t6[j - 1] = y2[j - 1] * *sp + z2[j - 1] * *cp + *zs;
X/* L20: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 9; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X r1[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X r2[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X r3[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (r2[j - 1] < (float)1.) {
X r2[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = r1[j - 1] / r2[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - r3[j - 1] / r2[j - 1] * (float)350.;
X
X/* L30: */
X }
X for (j = 1; j <= 10; ++j) {
X t4[j - 1] -= *xc;
X t5[j - 1] -= *yc;
X t6[j - 1] -= *zc;
X r4[j - 1] = t4[j - 1] * *csa + t5[j - 1] * *ssa;
X r5[j - 1] = -(doublereal)t4[j - 1] * *ssa * *csp + t5[j - 1] * *
X csa * *csp + t6[j - 1] * *ssp;
X r6[j - 1] = t4[j - 1] * *ssa * *ssp - t5[j - 1] * *csa * *ssp +
X t6[j - 1] * *csp;
X if (r5[j - 1] < (float)1.) {
X r5[j - 1] = (float)1.;
X }
X if (j <= 8) {
X x_pt1__[j - 1] = r4[j - 1] / r5[j - 1] * (float)350. + (float)
X 450.;
X y_pt1__[j - 1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)
X 350.;
X } else {
X i = j - 8;
X center[i - 1] = r4[j - 1] / r5[j - 1] * (float)350. + (float)
X 450.;
X center[i + 1] = (float)400. - r6[j - 1] / r5[j - 1] * (float)
X 350.;
X }
X/* L40: */
X }
X radius[0] = (float)1. / r5[8] * (float)350. + (float).5;
X radius[1] = (float)1. / r5[9] * (float)350. + (float).5;
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__9, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__8, &istat);
X for (j = 1; j <= 2; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 1];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L50: */
X }
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__9, &istat);
X gprmultiline_(x_pt1__, y_pt1__, &c__8, &istat);
X for (j = 1; j <= 2; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 1];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L60: */
X }
X }
X return 0;
X} /* strek_romulan_2__ */
X
X/* Subroutine */ int strek_photon_1__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[8] = { (float)0.,(float)3.5,(float)-3.5,(float)0.,(float)
X 0.,(float)-3.5,(float)3.5,(float)0. };
X static real yp[8] = { (float)3.,(float)-3.,(float)-3.,(float)3.,(float)0.,
X (float)-3.,(float)-3.,(float)0. };
X static real zp[8] = { (float)-2.6,(float)-2.6,(float)-2.6,(float)-2.6,(
X float)2.6,(float)-2.6,(float)-2.6,(float)2.6 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X extern /* Subroutine */ int gprpolyline_();
X static real temp;
X static shortint x_pt__[8], y_pt__[8];
X static integer j, istat;
X static real t1[8], t2[8], t3[8], t4[8], t5[8], t6[8];
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_PHOTON_1 draws an enemy photon similar to a player photon */
X/* (see strek_photon_4). */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about the local position into galatic coords
X*/
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (t5[j - 1] < (float)1.) {
X t5[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X }
X return 0;
X} /* strek_photon_1__ */
X
X/* Subroutine */ int strek_photon_2__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[8] = { (float)0.,(float)3.5,(float)-3.5,(float)0.,(float)
X 0.,(float)-3.5,(float)3.5,(float)0. };
X static real yp[8] = { (float)3.,(float)-3.,(float)-3.,(float)3.,(float)0.,
X (float)-3.,(float)-3.,(float)0. };
X static real zp[8] = { (float)-2.6,(float)-2.6,(float)-2.6,(float)-2.6,(
X float)2.6,(float)-2.6,(float)-2.6,(float)2.6 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X extern /* Subroutine */ int gprpolyline_();
X static real temp;
X static shortint x_pt__[8], y_pt__[8];
X static integer j, istat;
X static real t1[8], t2[8], t3[8], t4[8], t5[8], t6[8];
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_PHOTON_2 draws an enemy photon similar to a player photon */
X/* (see strek_photon_4). */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about the local position into galatic coords
X*/
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (t5[j - 1] < (float)1.) {
X t5[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X }
X return 0;
X} /* strek_photon_2__ */
X
X/* Subroutine */ int strek_photon_3__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[8] = { (float)0.,(float)3.5,(float)-3.5,(float)0.,(float)
X 0.,(float)-3.5,(float)3.5,(float)0. };
X static real yp[8] = { (float)3.,(float)-3.,(float)-3.,(float)3.,(float)0.,
X (float)-3.,(float)-3.,(float)0. };
X static real zp[8] = { (float)-2.6,(float)-2.6,(float)-2.6,(float)-2.6,(
X float)2.6,(float)-2.6,(float)-2.6,(float)2.6 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X extern /* Subroutine */ int gprpolyline_();
X static real temp;
X static shortint x_pt__[8], y_pt__[8];
X static integer j, istat;
X static real t1[8], t2[8], t3[8], t4[8], t5[8], t6[8];
X extern /* Subroutine */ int gprmove_();
X
X
X/* STREK_PHOTON_3 draws an enemy photon similar to a player photon */
X/* (see strek_photon_4). */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about the local position into galatic coords
X*/
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 8; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (t5[j - 1] < (float)1.) {
X t5[j - 1] = (float)1.;
X }
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X } else {
X
X/* erase old lines by drawing over them in black */
X
X gprmove_(x_pt__, y_pt__, &istat);
X gprpolyline_(x_pt__, y_pt__, &c__8, &istat);
X }
X return 0;
X} /* strek_photon_3__ */
X
X/* Subroutine */ int strek_photon_4__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[14] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)3.5,
X (float)-3.5,(float)-1.75,(float)1.75,(float)1.75,(float)-1.75,(
X float)-1.75,(float)1.75,(float)1.75,(float)-1.75 };
X static real yp[14] = { (float)0.,(float)0.,(float)-3.5,(float)3.5,(float)
X 0.,(float)0.,(float)-1.75,(float)1.75,(float)-1.75,(float)1.75,(
X float)1.75,(float)-1.75,(float)1.75,(float)-1.75 };
X static real zp[14] = { (float)3.5,(float)-3.5,(float)0.,(float)0.,(float)
X 0.,(float)0.,(float)2.5,(float)-2.5,(float)2.5,(float)-2.5,(float)
X 2.5,(float)-2.5,(float)2.5,(float)-2.5 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X static real temp;
X static shortint x_pt__[14], y_pt__[14];
X extern /* Subroutine */ int gprmultiline_();
X static integer j, istat;
X static real t1[14], t2[14], t3[14], t4[14], t5[14], t6[14];
X
X
X/* STREK_PHOTON_4 draws a player photon torpedo (or erases depending */
X
X/* on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a */
X/* ship with angles csa, ssa, csp, and ssp. No provision is made */
X/* for views that are both in front of and behind the viewer, other */
X/* than to do a first order correction to the projected y coord. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X
X/* use double angle formulas to update rotations */
X
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about their local frame to bring them into the
X */
X/* absolute frame */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them into its local fra
Xme */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X } else {
X
X/* erase old lines by drawing over them again (i.e. change color to
X */
X/* black, or set xor raster op) */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X }
X return 0;
X} /* strek_photon_4__ */
X
X/* Subroutine */ int strek_photon_5__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[14] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)3.5,
X (float)-3.5,(float)-1.75,(float)1.75,(float)1.75,(float)-1.75,(
X float)-1.75,(float)1.75,(float)1.75,(float)-1.75 };
X static real yp[14] = { (float)0.,(float)0.,(float)-3.5,(float)3.5,(float)
X 0.,(float)0.,(float)-1.75,(float)1.75,(float)-1.75,(float)1.75,(
X float)1.75,(float)-1.75,(float)1.75,(float)-1.75 };
X static real zp[14] = { (float)3.5,(float)-3.5,(float)0.,(float)0.,(float)
X 0.,(float)0.,(float)2.5,(float)-2.5,(float)2.5,(float)-2.5,(float)
X 2.5,(float)-2.5,(float)2.5,(float)-2.5 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X static real temp;
X static shortint x_pt__[14], y_pt__[14];
X extern /* Subroutine */ int gprmultiline_();
X static integer j, istat;
X static real t1[14], t2[14], t3[14], t4[14], t5[14], t6[14];
X
X
X/* STREK_PHOTON_5 draws a player photon torpedo (or erases depending */
X
X/* on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a */
X/* ship with angles csa, ssa, csp, and ssp. No provision is made */
X/* for views that are both in front of and behind the viewer, other */
X/* than to do a first order correction to the projected y coord. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X
X/* use double angle formulas to update rotations */
X
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about their local frame to bring them into the
X */
X/* absolute frame */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them into its local fra
Xme */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X } else {
X
X/* erase old lines by drawing over them again (i.e. change color to
X */
X/* black, or set xor raster op) */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X }
X return 0;
X} /* strek_photon_5__ */
X
X/* Subroutine */ int strek_photon_6__(xc, yc, zc, xs, ys, zs, csa, ssa, csp,
X ssp, dir)
Xreal *xc, *yc, *zc, *xs, *ys, *zs, *csa, *ssa, *csp, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[14] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)3.5,
X (float)-3.5,(float)-1.75,(float)1.75,(float)1.75,(float)-1.75,(
X float)-1.75,(float)1.75,(float)1.75,(float)-1.75 };
X static real yp[14] = { (float)0.,(float)0.,(float)-3.5,(float)3.5,(float)
X 0.,(float)0.,(float)-1.75,(float)1.75,(float)-1.75,(float)1.75,(
X float)1.75,(float)-1.75,(float)1.75,(float)-1.75 };
X static real zp[14] = { (float)3.5,(float)-3.5,(float)0.,(float)0.,(float)
X 0.,(float)0.,(float)2.5,(float)-2.5,(float)2.5,(float)-2.5,(float)
X 2.5,(float)-2.5,(float)2.5,(float)-2.5 };
X static real sda = (float).0998;
X static real sdp = (float).0998;
X static real cda = (float).995;
X static real cdp = (float).995;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X static real temp;
X static shortint x_pt__[14], y_pt__[14];
X extern /* Subroutine */ int gprmultiline_();
X static integer j, istat;
X static real t1[14], t2[14], t3[14], t4[14], t5[14], t6[14];
X
X
X/* STREK_PHOTON_6 draws a player photon torpedo (or erases depending */
X
X/* on dir) at the point xs, ys, zs as viewed from xc, yc, zc by a */
X/* ship with angles csa, ssa, csp, and ssp. No provision is made */
X/* for views that are both in front of and behind the viewer, other */
X/* than to do a first order correction to the projected y coord. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for photon config and saves */
X
X if (*dir) {
X
X/* use double angle formulas to update rotations */
X
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X temp = cp;
X cp = cp * cdp - sp * sdp;
X sp = sp * cdp + sdp * temp;
X
X/* rotate the points about their local frame to bring them into the
X */
X/* absolute frame */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp + *xs;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp + *ys;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp + *zs;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them into its local fra
Xme */
X
X for (j = 1; j <= 14; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)450.;
X
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)350.;
X
X/* L20: */
X }
X
X/* draw the object */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X } else {
X
X/* erase old lines by drawing over them again (i.e. change color to
X */
X/* black, or set xor raster op) */
X
X gprmultiline_(x_pt__, y_pt__, &c__14, &istat);
X }
X return 0;
X} /* strek_photon_6__ */
X
X/* Subroutine */ int strek_starbase__(xc, yc, zc, csa, csp, ssa, ssp, dir)
Xreal *xc, *yc, *zc, *csa, *csp, *ssa, *ssp;
Xlogical *dir;
X{
X /* Initialized data */
X
X static real xp[13] = { (float)0.,(float)0.,(float)0.,(float)0.,(float)
X -7.5,(float)-12.,(float)7.5,(float)12.,(float)0.,(float)0.,(float)
X 0.,(float)-15.,(float)15. };
X static real yp[13] = { (float)0.,(float)0.,(float)8.66,(float)13.855,(
X float)-4.33,(float)-6.92,(float)-4.33,(float)-6.92,(float)0.,(
X float)0.,(float)17.3,(float)-8.66,(float)-8.66 };
X static real zp[13] = { (float)10.,(float)16.,(float)-5.,(float)-8.,(float)
X -5.,(float)-8.,(float)-5.,(float)-8.,(float)0.,(float)20.,(float)
X -10.,(float)-10.,(float)-10. };
X static real radii[5] = { (float)10.,(float)4.,(float)4.,(float)4.,(float)
X 4. };
X static real sda = (float).049979;
X static real cda = (float).998749;
X static real ca = (float)1.;
X static real cp = (float)1.;
X static real sa = (float)0.;
X static real sp = (float)0.;
X
X static real temp;
X static shortint x_pt__[8], y_pt__[8];
X static integer i, j;
X extern /* Subroutine */ int gprmultiline_();
X static integer istat;
X extern /* Subroutine */ int gprcircle_();
X static real t1[13], t2[13], t3[13], t4[13], t5[13], t6[13];
X static shortint center[10] /* was [5][2] */, radius[5], xpt[2];
X
X
X/* STREK_STARBASE draws a 3-d starbase at the origin as viewed */
X/* from xc, yc, zc, at the angle csa, csp, ssa, ssp. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/* data for unrotated base */
X
X
X/* rotate and project all points */
X
X if (*dir) {
X temp = ca;
X ca = ca * cda - sa * sda;
X sa = sa * cda + sda * temp;
X for (j = 1; j <= 13; ++j) {
X t1[j - 1] = xp[j - 1] * ca - yp[j - 1] * sa * cp + zp[j - 1] * sa
X * sp;
X t2[j - 1] = xp[j - 1] * sa + yp[j - 1] * ca * cp - zp[j - 1] * ca
X * sp;
X t3[j - 1] = yp[j - 1] * sp + zp[j - 1] * cp;
X/* L10: */
X }
X
X/* form offsets from player ship and rotate them about it */
X
X for (j = 1; j <= 13; ++j) {
X t1[j - 1] -= *xc;
X t2[j - 1] -= *yc;
X t3[j - 1] -= *zc;
X t4[j - 1] = t1[j - 1] * *csa + t2[j - 1] * *ssa;
X t5[j - 1] = -(doublereal)t1[j - 1] * *ssa * *csp + t2[j - 1] * *
X csa * *csp + t3[j - 1] * *ssp;
X t6[j - 1] = t1[j - 1] * *ssa * *ssp - t2[j - 1] * *csa * *ssp +
X t3[j - 1] * *csp;
X if (t5[j - 1] < (float)5.) {
X t5[j - 1] = (float)5.;
X }
X if (j <= 8) {
X x_pt__[j - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)
X 450.;
X y_pt__[j - 1] = (float)400. - t6[j - 1] / t5[j - 1] * (float)
X 350.;
X } else {
X i = j - 8;
X center[i - 1] = t4[j - 1] / t5[j - 1] * (float)350. + (float)
X 450.;
X center[i + 4] = (float)400. - t6[j - 1] / t5[j - 1] * (float)
X 350.;
X radius[i - 1] = radii[i - 1] / t5[j - 1] * (float)350. + (
X float).5;
X }
X/* L20: */
X }
X gprmultiline_(x_pt__, y_pt__, &c__8, &istat);
X for (j = 1; j <= 5; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 4];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L30: */
X }
X } else {
X
X/* erase old figure by redrawing in black or with xor raster op */
X
X gprmultiline_(x_pt__, y_pt__, &c__8, &i);
X for (j = 1; j <= 5; ++j) {
X xpt[0] = center[j - 1];
X xpt[1] = center[j + 4];
X if (radius[j - 1] > 0) {
X gprcircle_(xpt, &radius[j - 1], &istat);
X }
X/* L40: */
X }
X }
X return 0;
X} /* strek_starbase__ */
X
E!O!F! xstrek/strek_ships_subs.c
echo xstrek/strek_startup_db.c 1>&2
sed -e 's/^X//' > xstrek/strek_startup_db.c <<'E!O!F! xstrek/strek_startup_db.c'
X/* strek_startup_db.f -- translated by f2c (version of 19 December 1990 16:50:21).
X You must link the resulting object file with the libraries:
X -lF77 -lI77 -lm -lc (in that order)
X*/
X
X#include "f2c.h"
X
X/* Table of constant values */
X
Xstatic integer c__1 = 1;
X
X/* Main program */ MAIN__()
X{
X /* Initialized data */
X
X static integer ship_avail__[3] = { 0,0,0 };
X static integer last_score__ = 0;
X static integer score = 0;
X static integer ship_retired__ = 1;
X static char ship_name__[30+1] = "unused ";
X static char user_name__[10+1] = "unused ";
X static char capt_name__[10+1] = "unused ";
X static char nick_name__[10+1] = "unused ";
X static char key_file__[256+1] = " \
X \
X \
X ";
X
X /* Format strings */
X static char fmt_110[] = "(a10,a10,a30,i10)";
X
X /* System generated locals */
X olist o__1;
X cllist cl__1;
X
X /* Builtin functions */
X integer f_open(), s_wdue(), do_uio(), e_wdue(), f_clos(), s_wsfe(),
X do_fio(), e_wsfe();
X /* Subroutine */ int s_stop();
X
X /* Local variables */
X static integer i, j;
X
X /* Fortran I/O blocks */
X static cilist io___11 = { 0, 1, 0, 0, 1 };
X static cilist io___12 = { 0, 1, 0, 0, 2 };
X static cilist io___14 = { 0, 1, 0, fmt_110, 0 };
X
X
X
X/* *******************************************************************
X*/
X/* ***** *****
X*/
X/* ***** STAR TREK VERSION 3.0 *****
X*/
X/* ***** *****
X*/
X/* ***** written by *****
X*/
X/* ***** *****
X*/
X/* ***** Justin S. Revenaugh *****
X*/
X/* ***** *****
X*/
X/* ***** 7/87 *****
X*/
X/* ***** *****
X*/
X/* ***** Massachussetts Institute of Technology *****
X*/
X/* ***** Department of Earth, Atmospheric and Planetary Science *****
X*/
X/* ***** *****
X*/
X/* *******************************************************************
X*/
X
X
X/* STREK_STARTUP_DB initializes the strek database. It creates */
X/* two files in the directory it is run in. These files are */
X/* STREK_INFO which contains the ship registry and STREK_TOP_SCORES */
X/* which contains the top ten scores. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X
X/* open and write strek_info */
X
X o__1.oerr = 0;
X o__1.ounit = 1;
X o__1.ofnmlen = 30;
X o__1.ofnm = "/usr/lib/X11/xstrek/strek_info";
X o__1.orl = 1000;
X o__1.osta = 0;
X o__1.oacc = "direct";
X o__1.ofm = "unformatted";
X o__1.oblnk = 0;
X f_open(&o__1);
X j = 1;
X s_wdue(&io___11);
X do_uio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
X e_wdue();
X s_wdue(&io___12);
X do_uio(&c__1, ship_name__, 30L);
X do_uio(&c__1, user_name__, 10L);
X do_uio(&c__1, capt_name__, 10L);
X do_uio(&c__1, nick_name__, 10L);
X do_uio(&c__1, key_file__, 256L);
X for (i = 1; i <= 3; ++i) {
X do_uio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof(integer));
X }
X do_uio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer));
X do_uio(&c__1, (char *)&score, (ftnlen)sizeof(integer));
X do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer));
X e_wdue();
X cl__1.cerr = 0;
X cl__1.cunit = 1;
X cl__1.csta = 0;
X f_clos(&cl__1);
X
X/* open and write strek_top_scores */
X
X o__1.oerr = 0;
X o__1.ounit = 1;
X o__1.ofnmlen = 36;
X o__1.ofnm = "/usr/lib/X11/xstrek/strek_top_scores";
X o__1.orl = 1000;
X o__1.osta = 0;
X o__1.oacc = 0;
X o__1.ofm = "formatted";
X o__1.oblnk = 0;
X f_open(&o__1);
X for (j = 1; j <= 10; ++j) {
X s_wsfe(&io___14);
X do_fio(&c__1, user_name__, 10L);
X do_fio(&c__1, capt_name__, 10L);
X do_fio(&c__1, ship_name__, 30L);
X do_fio(&c__1, (char *)&score, (ftnlen)sizeof(integer));
X e_wsfe();
X/* L10: */
X }
X cl__1.cerr = 0;
X cl__1.cunit = 1;
X cl__1.csta = 0;
X f_clos(&cl__1);
X s_stop("", 0L);
X} /* MAIN__ */
X
X/* Main program alias */ int strek_startup_db__ () { MAIN__ (); }
E!O!F! xstrek/strek_startup_db.c
echo xstrek/strek_stats.c 1>&2
sed -e 's/^X//' > xstrek/strek_stats.c <<'E!O!F! xstrek/strek_stats.c'
X/* strek_stats.f -- translated by f2c (version of 19 December 1990 16:50:21).
X You must link the resulting object file with the libraries:
X -lF77 -lI77 -lm -lc (in that order)
X*/
X
X#include "f2c.h"
X
X/* Table of constant values */
X
Xstatic integer c__9 = 9;
Xstatic integer c__1 = 1;
X
X/* Main program */ MAIN__()
X{
X /* Builtin functions */
X integer s_wsle(), do_lio(), e_wsle(), s_rsfe(), do_fio(), e_rsfe();
X /* Subroutine */ int s_stop();
X
X /* Local variables */
X extern /* Subroutine */ int strek_scores__();
X static char answer[1];
X extern /* Subroutine */ int strek_ships__();
X
X /* Fortran I/O blocks */
X static cilist io___1 = { 0, 6, 0, 0, 0 };
X static cilist io___2 = { 0, 6, 0, 0, 0 };
X static cilist io___3 = { 0, 6, 0, 0, 0 };
X static cilist io___4 = { 0, 6, 0, 0, 0 };
X static cilist io___5 = { 0, 6, 0, 0, 0 };
X static cilist io___6 = { 0, 5, 0, "(a)", 0 };
X
X
X
X/* *******************************************************************
X*/
X/* ***** *****
X*/
X/* ***** STAR TREK VERSION 3.0 *****
X*/
X/* ***** *****
X*/
X/* ***** written by *****
X*/
X/* ***** *****
X*/
X/* ***** Justin S. Revenaugh *****
X*/
X/* ***** *****
X*/
X/* ***** 7/87 *****
X*/
X/* ***** *****
X*/
X/* ***** Massachussetts Institute of Technology *****
X*/
X/* ***** Department of Earth, Atmospheric and Planetary Science *****
X*/
X/* ***** *****
X*/
X/* *******************************************************************
X*/
X
X/* STREK_STATS allows the user to peruse the STREK database without */
X/* playing the game. */
X
X/* version 1 */
X/* -jsr 8/85 */
X
X
X/* begin loop over options */
X
XL10:
X s_wsle(&io___1);
X do_lio(&c__9, &c__1, " ", 1L);
X e_wsle();
X s_wsle(&io___2);
X do_lio(&c__9, &c__1, "Enter <r> to view the ship registry,", 36L);
X e_wsle();
X s_wsle(&io___3);
X do_lio(&c__9, &c__1, " <s> to view the top ten scores or", 39L);
X e_wsle();
X s_wsle(&io___4);
X do_lio(&c__9, &c__1, " <return> to quit.", 23L);
X e_wsle();
X s_wsle(&io___5);
X do_lio(&c__9, &c__1, " ", 1L);
X e_wsle();
X s_rsfe(&io___6);
X do_fio(&c__1, answer, 1L);
X e_rsfe();
X if (*answer == 'r') {
X strek_ships__();
X goto L10;
X } else if (*answer == 's') {
X strek_scores__();
X goto L10;
X } else {
X s_stop("", 0L);
X }
X} /* MAIN__ */
X
X/* Main program alias */ int strek_stats__ () { MAIN__ (); }
E!O!F! xstrek/strek_stats.c
exit
=====
@work: | Matthias Pfuetzner | @home:
ZGDV, Wilhelminenstrasse 7 | 6100 Darmstadt, FRG | Lichtenbergstrasse 73
+49 6151 155-164 or -101 \ <- Tel.nr. -> / +49 6151 75717
pfuetzner at agd.fhg.de pfuetzner at zgdvda.UUCP XBR1YD3U at DDATHD21.BITNET
--
Dan Heller
------------------------------------------------
O'Reilly && Associates ZipCode Software
Senior Writer President
argv at ora.com argv at zipcode.com
More information about the Comp.sources.x
mailing list