[comp.sources.x] v11i098: Another Star Trek Game, Part12/14

pfuetz@agd.fhg.de (02/26/91)

Submitted-by: pfuetz@agd.fhg.de
Posting-number: Volume 11, Issue 98
Archive-name: xstrek/part12

#!/bin/sh
# To unshare, sh or unshar this file
echo xstrek/strek_enemy_subs.c 1>&2
sed -e 's/^X//' > xstrek/strek_enemy_subs.c <<'E!O!F! xstrek/strek_enemy_subs.c'
X/* strek_enemy_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 real c_b6 = (float)1e-7;
Xstatic real c_b7 = (float)180.;
Xstatic real c_b9 = (float).05;
Xstatic real c_b11 = (float).5;
Xstatic real c_b13 = (float)-3.5;
Xstatic real c_b14 = (float)3.5;
Xstatic real c_b19 = (float).1;
Xstatic integer c__4 = 4;
Xstatic integer c__1 = 1;
Xstatic integer c__0 = 0;
X
X/* Subroutine */ int strek_find_free_ob__(object, first, free_ob__, found)
Xlogical *object;
Xinteger *first, *free_ob__;
Xlogical *found;
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_FIND_FREE_OB finds a free (unused) object number within */
X/*    the range [first, first+2]. If no such object exists then */
X/*    found is false. Used for finding free photon objects numbers. */
X
X
X
X/*    find first free object */
X
X    *found = FALSE_;
X    if (! object[*first]) {
X	*found = TRUE_;
X	*free_ob__ = *first;
X    } else if (! object[*first + 1]) {
X	*found = TRUE_;
X	*free_ob__ = *first + 1;
X    } else if (! object[*first + 2]) {
X	*found = TRUE_;
X	*free_ob__ = *first + 2;
X    }
X    return 0;
X} /* strek_find_free_ob__ */
X
X/* Subroutine */ int strek_place_nemian__(xc, yc, zc, obx, oby, obz, oazm, 
X	oangle, ospeed, seed)
Xreal *xc, *yc, *zc, *obx, *oby, *obz, *oazm, *oangle, *ospeed, *seed;
X{
X    /* Initialized data */
X
X    static real pi = (float)3.14159265;
X
X    /* Builtin functions */
X    double sin(), cos();
X
X    /* Local variables */
X    extern /* Subroutine */ int rand_();
X    static real theta, sp, radius, phi;
X
X
X/*    STREK_PLACE_NEMIAN places a nubian freighter ship near */
X/*    the players ship. It will always fall in the distance */
X/*    range 600 - 1000. */
X
X/*    version 1 */
X/*                                          -jsr 8/85 */
X
X
X/*    find azm and angle totally at random */
X
X    rand_(seed);
X    *oazm = pi * *seed;
X    rand_(seed);
X    *oangle = pi * *seed;
X
X/*    find displacement using spherical coordinate geometry */
X
X    rand_(seed);
X    radius = *seed * (float)400. + (float)600.;
X    rand_(seed);
X    theta = pi * (float)2. * *seed;
X    rand_(seed);
X    phi = pi * *seed;
X    sp = sin(phi);
X    *obx = radius * cos(theta) * sp + *xc;
X    *oby = radius * sin(theta) * sp + *yc;
X    *obz = radius * cos(phi) + *zc;
X
X/*    pick a speed at random */
X
X    rand_(seed);
X    *ospeed = *seed * (float).15 + (float).25;
X    return 0;
X} /* strek_place_nemian__ */
X
X/* Subroutine */ int strek_place_enemy__(xc, yc, zc, obx, oby, obz, oazm, 
X	oangle, ospeed, seed)
Xreal *xc, *yc, *zc, *obx, *oby, *obz, *oazm, *oangle, *ospeed, *seed;
X{
X    /* Initialized data */
X
X    static real pi = (float)3.14159265;
X
X    /* Builtin functions */
X    double sin(), cos();
X
X    /* Local variables */
X    extern /* Subroutine */ int rand_();
X    static real theta, sp, radius, phi;
X
X
X/*    STREK_PLACE_ENEMY places a single enemy ship in the vicinity of */
X/*    the player ship. Initial azm and angle are random. */
X
X/*    version 1 */
X/*                                             -jsr 8/85 */
X
X
X/*    find displacement */
X
X    rand_(seed);
X    radius = *seed * (float)600. + (float)1e3;
X    rand_(seed);
X    theta = pi * (float)2. * *seed;
X    rand_(seed);
X    phi = pi * *seed;
X    sp = sin(phi);
X    *obx = radius * cos(theta) * sp + *xc;
X    *oby = radius * sin(theta) * sp + *yc;
X    *obz = radius * cos(phi) + *zc;
X    rand_(seed);
X    *oazm = pi * (float)2. * *seed;
X    rand_(seed);
X    *oangle = pi * *seed;
X    rand_(seed);
X    *ospeed = *seed * (float)3.5;
X    return 0;
X} /* strek_place_enemy__ */
X
X/* Subroutine */ int strek_enemy_setup__(damage, agr, kling, maxd, object, 
X	seed, two, photons)
Xreal *damage;
Xlogical *agr, *kling;
Xreal *maxd;
Xlogical *object;
Xreal *seed;
Xlogical *two;
Xinteger *photons;
X{
X    extern /* Subroutine */ int rand_();
X    static integer i, j;
X
X
X/*    STREK_ENEMY_SETUP initializes many of the enemy ship variables */
X/*    Ensures that there is only one klingon at a time. */
X
X/*    version 1 */
X/*                                              -jsr 8/85 */
X
X
X/*    set 'em up */
X
X    /* Parameter adjustments */
X    --photons;
X    --maxd;
X    --kling;
X    --agr;
X
X    /* Function Body */
X    i = 2;
X    j = 3;
X
X/*    set initial damage to zero */
X
X    damage[i] = (float)0.;
X    damage[j] = (float)0.;
X    photons[i] = 3;
X    photons[j] = 3;
X
X/*    pick aggression level. Aggressive enemies come after the player */
X/*    ship. Unaggressive enemies shoot nemians */
X
X    agr[i] = TRUE_;
X    agr[j] = TRUE_;
X    rand_(seed);
X    if (*seed > (float).9) {
X	agr[i] = FALSE_;
X    }
X    rand_(seed);
X    if (*seed > (float).9) {
X	agr[j] = FALSE_;
X    }
X    rand_(seed);
X
X/*    check for klingons */
X
X    rand_(seed);
X    if (*seed >= (float).5) {
X	kling[i] = TRUE_;
X	maxd[i] = (float)50.;
X    } else {
X	kling[i] = FALSE_;
X	kling[j] = FALSE_;
X	maxd[i] = (float)40.;
X	maxd[j] = (float)40.;
X    }
X
X/*    determine the number of 'em */
X
X    rand_(seed);
X    if (*seed > (float).5) {
X	*two = TRUE_;
X	object[i] = TRUE_;
X	object[j] = TRUE_;
X    } else {
X	*two = FALSE_;
X	object[i] = TRUE_;
X	object[j] = FALSE_;
X    }
X    if (kling[i]) {
X	*two = FALSE_;
X	object[j] = FALSE_;
X    }
X    return 0;
X} /* strek_enemy_setup__ */
X
X/* Subroutine */ int strek_move_enemy__(j, obx, oby, obz, oazm, oangle, 
X	ospeed, xc, yc, zc, azm, angle, speed, agr, object, rox, roy, roz, 
X	odamage, photons, distance, kling, count_m__, count_s__, orange, razm,
X	 rangle, brake, damage, photon_c__, phase_c__, pro_x__, pro_y__, seed,
X	 pcen)
Xinteger *j;
Xreal *obx, *oby, *obz, *oazm, *oangle, *ospeed, *xc, *yc, *zc, *azm, *angle, *
X	speed;
Xlogical *agr, *object;
Xreal *rox, *roy, *roz, *odamage;
Xinteger *photons;
Xreal *distance;
Xlogical *kling;
Xinteger *count_m__, *count_s__;
Xreal *orange, *razm, *rangle, *brake, *damage;
Xinteger *photon_c__, *phase_c__;
Xreal *pro_x__, *pro_y__, *seed;
Xshortint *pcen;
X{
X    /* Initialized data */
X
X    static real pi = (float)3.14159265;
X
X    /* System generated locals */
X    real r__1, r__2;
X
X    /* Builtin functions */
X    double sqrt(), sin(), cos(), r_sign(), atan();
X
X    /* Local variables */
X    extern /* Subroutine */ int strek_phaser_nemian__();
X    static integer free;
X    extern /* Subroutine */ int rand_();
X    static real dist, tazm;
X    static logical man_1__, man_2__, man_3__, found, shoot;
X    static real t1, t2, t3, t4, ca, sa, cp;
X    extern /* Subroutine */ int strek_phaser_ship__();
X    static real dx, dy, dz, sp;
X    extern /* Subroutine */ int strek_aim_photons__();
X    static real tangle, xt, yt, zt, rootor;
X    extern /* Subroutine */ int strek_find_free_ob__();
X    static real pox, poy, poz;
X    static integer num_forward__;
X    extern /* Subroutine */ int strek_phaser_damage__();
X
X
X/*    STREK_MOVE_ENEMY contains the enemy ship movement and attack */
X/*    logic. When chasing nemians (which is rare) there is only a */
X/*    chase algorithm. When chasing player ships there are two */
X/*    modes: 1. similar to chasing nemians, used when not in ships */
X/*    firing arc or at a distance. 2. randomly choosen dodges which */
X/*    can be: stop fast, accelerate, turn hard or a combination. */
X/*    Movement is recalculated every 10 turn. Attacks are based on */
X/*    range and the same firing limitations as the player ship, i.e. */
X/*    target in firing arc, in range and phasers active. Photons */
X/*    follow the course of the ship when shot. */
X
X/*    version 1 */
X/*                                      - jsr 8/85 */
X
X    /* Parameter adjustments */
X    --pcen;
X    --photon_c__;
X    --distance;
X
X    /* Function Body */
X
X/*    increment move and shoot counters */
X
X    ++(*count_m__);
X    ++(*count_s__);
X
X/*    if a move is indicated then do it */
X
X    if (*count_m__ >= 10) {
X	*count_m__ = 0;
X	if (! (*agr) && orange[*j] > (float)9e4) {
X
X/*    chase the nemian unless the bad guy is too close */
X
X	    if ((r__1 = ospeed[*j], dabs(r__1)) > (float).001) {
X		num_forward__ = sqrt(distance[*j + 3]) / ospeed[*j];
X	    } else {
X		num_forward__ = 20;
X	    }
X	    xt = -num_forward__ * ospeed[1] * sin(oazm[1]) * cos(oangle[1]) + 
X		    obx[1];
X	    yt = num_forward__ * ospeed[1] * cos(oazm[1]) * cos(oangle[1]) + 
X		    oby[1];
X	    zt = num_forward__ * ospeed[1] * sin(oangle[1]) + obz[1];
X	    dx = xt - obx[*j];
X	    dy = yt - oby[*j];
X	    dz = zt - obz[*j];
X	    if (dabs(dy) < (float)1e-7) {
X		dy = r_sign(&c_b6, &dy);
X	    }
X	    if (dy <= (float)0.) {
X		tazm = -(doublereal)atan(dx / dy) + c_b7 * pi / (float)180.;
X	    } else {
X		tazm = -(doublereal)atan(dx / dy);
X	    }
X/* Computing 2nd power */
X	    r__1 = dx;
X/* Computing 2nd power */
X	    r__2 = dy;
X	    dist = sqrt(r__1 * r__1 + r__2 * r__2);
X	    if (dabs(dist) < (float)1e-7) {
X		dist = r_sign(&c_b6, &dist);
X	    }
X	    tangle = atan(dz / dist);
X	    t1 = (tazm - oazm[*j]) / (float)10.;
X	    t2 = (tangle - oangle[*j]) / (float)10.;
X	    t3 = (tazm - (oazm[*j] - (float)360.)) / (float)10.;
X	    t4 = (tangle - (oangle[*j] - (float)360.)) / (float)10.;
X	    if (dabs(t3) < dabs(t1)) {
X		t1 = t3;
X	    }
X	    if (dabs(t4) < dabs(t2)) {
X		t2 = t4;
X	    }
X	    if (dabs(t1) > (float).05) {
X		t1 = r_sign(&c_b9, &t1);
X	    }
X	    if (dabs(t2) > (float).05) {
X		t2 = r_sign(&c_b9, &t2);
X	    }
X	    *razm = t1;
X	    *rangle = t2;
X
X/*    adjust speed */
X
X	    if (distance[*j + 3] > (float)3600.) {
X		*brake = ((float)3.5 - ospeed[*j]) / (float)10.;
X	    } else {
X		*brake = (ospeed[1] - ospeed[*j] + (float).5) / (float)10.;
X	    }
X
X/*    adjust max acceleration */
X
X	    t1 = dabs(*brake);
X	    if (t1 > (float).5) {
X		*brake = r_sign(&c_b11, brake);
X	    }
X	} else {
X
X/*    chase the bad guy. Two options here: */
X/*    1. in his front arc => get out of it! */
X/*    2. in his rear arc  => stay in it but approach. */
X
X/* Computing 2nd power */
X	    r__1 = *rox;
X/* Computing 2nd power */
X	    r__2 = *roz;
X	    t1 = sqrt(r__1 * r__1 + r__2 * r__2);
X	    t2 = t1 / *roy;
X	    if (*roy > (float)0. && *roy < (float)300. && t2 < (float).75 || *
X		    roy > (float)0. && *roy < (float)820. && t2 < (float).18) 
X		    {
X		rand_(seed);
X
X/*    if seed < .10 then brake hard, .10 < seed < .25 then swe
Xrve */
X/*    if .25 < seed < .50 then do both, .40 < seed < .60 then 
Xaccel */
X/*    else actively pursue. */
X
X		if (*seed < (float).1) {
X		    man_1__ = TRUE_;
X		    man_2__ = FALSE_;
X		    man_3__ = FALSE_;
X		} else if (*seed < (float).3 && *seed >= (float).1) {
X		    man_1__ = FALSE_;
X		    man_2__ = TRUE_;
X		    man_3__ = FALSE_;
X		} else if (*seed < (float).5 && *seed >= (float).3) {
X		    man_1__ = TRUE_;
X		    man_2__ = TRUE_;
X		    man_3__ = FALSE_;
X		} else if (*seed < (float).6 && *seed >= (float).5) {
X		    man_1__ = FALSE_;
X		    man_2__ = FALSE_;
X		    man_3__ = TRUE_;
X		} else if (t2 > (float).33) {
X		    goto L10;
X		} else {
X		    man_1__ = TRUE_;
X		    man_2__ = TRUE_;
X		    man_3__ = FALSE_;
X		}
X		if (man_1__ && (*speed > (float)3.5 && *roy < (float)75.)) {
X		    *brake = ((float)0. - ospeed[*j]) / (float)10.;
X		}
X		if (man_2__) {
X
X/*     get polarity of the swerve */
X
X		    rand_(seed);
X		    *razm = (float)0.;
X		    *rangle = (float)0.;
X		    if (*seed < (float).25) {
X			*razm = c_b13 * pi / (float)180.;
X		    } else if (*seed >= (float).25 && *seed < (float).5) {
X			*razm = c_b14 * pi / (float)180.;
X		    } else if (*seed >= (float).5 && *seed < (float).75) {
X			*rangle = c_b13 * pi / (float)180.;
X		    } else {
X			*rangle = c_b14 * pi / (float)180.;
X		    }
X		}
X
X/*     if man_3 then accelerate */
X
X		if (man_3__) {
X		    *brake = ((float)3.5 - ospeed[*j]) / (float)10.;
X		}
X	    } else {
XL10:
X
X/*     in rear arc then pursue */
X
X		rootor = sqrt(orange[*j]);
X		num_forward__ = sqrt(orange[*j]) / (float)20.;
X		if (num_forward__ > 20) {
X		    num_forward__ = 20;
X		}
X		xt = -num_forward__ * *speed * sin(*azm * pi / (float)180.) * 
X			cos(*angle * pi / (float)180.) + *xc;
X		yt = num_forward__ * *speed * cos(*azm * pi / (float)180.) * 
X			cos(*angle * pi / (float)180.) + *yc;
X		zt = num_forward__ * *speed * sin(*angle * pi / (float)180.) 
X			+ *zc;
X		dx = xt - obx[*j];
X		dy = yt - oby[*j];
X		dz = zt - obz[*j];
X		if (dabs(dy) < (float)1e-7) {
X		    dy = r_sign(&c_b6, &dy);
X		}
X		if (dy <= (float)0.) {
X		    tazm = -(doublereal)atan(dx / dy) + pi;
X		} else {
X		    tazm = -(doublereal)atan(dx / dy);
X		}
X/* Computing 2nd power */
X		r__1 = dx;
X/* Computing 2nd power */
X		r__2 = dy;
X		dist = sqrt(r__1 * r__1 + r__2 * r__2);
X		if (dabs(dist) < (float)1e-7) {
X		    dist = r_sign(&c_b6, &dist);
X		}
X		tangle = atan(dz / dist);
X
X/*    pick smallest angle (needed due to arctan being only in 
Xquads */
X/*    I and IV) */
X
X		t1 = (tazm - oazm[*j]) / (float)10.;
X		t2 = (tangle - oangle[*j]) / (float)10.;
X		t3 = (tazm - (oazm[*j] - (float)360.)) / (float)10.;
X		t4 = (tangle - (oangle[*j] - (float)360.)) / (float)10.;
X		if (dabs(t3) < dabs(t1)) {
X		    t1 = t3;
X		}
X		if (dabs(t4) < dabs(t2)) {
X		    t2 = t4;
X		}
X		if (dabs(t1) > (float).1) {
X		    t1 = r_sign(&c_b19, &t1);
X		}
X		if (dabs(t2) > (float).1) {
X		    t2 = r_sign(&c_b19, &t2);
X		}
X		*razm = t1;
X		*rangle = t2;
X
X/*    adjust speed */
X
X		if (distance[*j + 3] > (float)1e4) {
X		    *brake = ((float)4. - ospeed[*j]) / (float)10.;
X		} else {
X		    *brake = (*speed - ospeed[*j] + (float).75) / (float)10.;
X		}
X
X/*    adjust max acceleration */
X
X		t1 = dabs(*brake);
X		if (t1 > (float).5) {
X		    *brake = r_sign(&c_b11, brake);
X		}
X	    }
X	}
X    }
X
X/*    formulate attacks */
X
X    if (*count_s__ >= 20) {
X	*count_s__ = 0;
X
X/*    check for photon firing */
X
X	if (*kling) {
X	    if (*photons > 0 && orange[*j] < (float)102400.) {
X		strek_find_free_ob__(object, &c__4, &free, &found);
X		if (found) {
X		    t1 = *azm * pi / (float)180.;
X		    t2 = *angle * pi / (float)180.;
X		    strek_aim_photons__(xc, yc, zc, &t1, &t2, speed, &obx[*j],
X			     &oby[*j], &obz[*j], &oazm[*j], &oangle[*j], &
X			    shoot);
X		    rand_(seed);
X		    if (*seed < (float).7) {
X			if (shoot) {
X			    object[free] = TRUE_;
X			    ospeed[free] = (float)11.;
X			    obx[free] = obx[*j];
X			    oby[free] = oby[*j];
X			    obz[free] = obz[*j];
X			    oazm[free] = oazm[*j];
X			    oangle[free] = oangle[*j];
X			    odamage[free] = (float)0.;
X			    photon_c__[free - 3] = 0;
X			    --(*photons);
X			}
X		    }
X		}
X	    }
X
X/*    if ship is a klingon then consider phasers */
X
X	    if ((real) (*phase_c__) > (float)40. && orange[*j] < (float)4e4) {
X
X		xt = *xc - obx[*j];
X		yt = *yc - oby[*j];
X		zt = *zc - obz[*j];
X		ca = cos(oazm[*j]);
X		sa = sin(oazm[*j]);
X		cp = cos(oangle[*j]);
X		sp = sin(oangle[*j]);
X		pox = xt * ca + yt * sa;
X		poy = -(doublereal)xt * sa * cp + yt * ca * cp + zt * sp;
X		poz = xt * sa * sp - yt * ca * sp + zt * cp;
X		if (poy > (float)1e-7) {
X		    t1 = pox / poy;
X		    t2 = poz / poy;
X		    if (t1 < (float)1. && t2 < (float)1.) {
X			rand_(seed);
X			if (*seed > (float).2) {
X			    strek_phaser_damage__(&orange[*j], damage, seed, &
X				    c__1);
X			    strek_phaser_ship__(&pro_x__[*j], &pro_y__[*j], &
X				    pcen[1], seed);
X			    *phase_c__ = 0;
X			}
X		    }
X		}
X	    } else if (! (*agr) && ((real) (*phase_c__) > (float)60. && 
X		    distance[*j + 3] < (float)1e4)) {
X		xt = obx[1] - obx[*j];
X		yt = oby[1] - oby[*j];
X		zt = obz[1] - obz[*j];
X		ca = cos(oazm[*j]);
X		sa = sin(oazm[*j]);
X		cp = cos(oangle[*j]);
X		sp = sin(oangle[*j]);
X		pox = xt * ca + yt * sa;
X		poy = -(doublereal)xt * sa * cp + yt * ca * cp + zt * sp;
X		poz = xt * sa * sp - yt * ca * sp + zt * cp;
X		if (poy > (float)1e-7) {
X		    t1 = pox / poy;
X		    t2 = poz / poy;
X		    if (t1 < (float)1. && t2 < (float)1.) {
X			rand_(seed);
X			if (*seed > (float).6) {
X			    strek_phaser_damage__(&distance[*j + 3], &odamage[
X				    1], seed, &c__0);
X			    strek_phaser_nemian__(pro_x__, pro_y__);
X			    *phase_c__ = 0;
X			}
X		    }
X		}
X	    }
X	} else {
X
X/*    this is a romulan, either photon player or nemian */
X
X	    if (*photons > 0 && orange[*j] < (float)9e4) {
X		strek_find_free_ob__(object, &c__4, &free, &found);
X		if (found) {
X		    t1 = *azm * pi / (float)180.;
X		    t2 = *angle * pi / (float)180.;
X		    strek_aim_photons__(xc, yc, zc, &t1, &t2, speed, &obx[*j],
X			     &oby[*j], &obz[*j], &oazm[*j], &oangle[*j], &
X			    shoot);
X		    rand_(seed);
X		    if (*seed < (float).5) {
X			if (shoot) {
X			    object[free] = TRUE_;
X			    ospeed[free] = (float)11.;
X			    obx[free] = obx[*j];
X			    oby[free] = oby[*j];
X			    obz[free] = obz[*j];
X			    oazm[free] = oazm[*j];
X			    oangle[free] = oangle[*j];
X			    odamage[free] = (float)0.;
X			    photon_c__[free - 3] = 0;
X			}
X		    }
X		}
X	    } else if (distance[*j + 3] < (float)4e4) {
X		strek_find_free_ob__(object, &c__4, &free, &found);
X		if (found) {
X		    strek_aim_photons__(&obx[1], &oby[1], &obz[1], &oazm[1], &
X			    oangle[1], &ospeed[1], &obx[*j], &oby[*j], &obz[*
X			    j], &oazm[*j], &oangle[*j], &shoot);
X		    rand_(seed);
X		    if (*seed < (float).4) {
X			if (shoot) {
X			    object[free] = TRUE_;
X			    ospeed[free] = (float)11.;
X			    obx[free] = obx[*j];
X			    oby[free] = oby[*j];
X			    obz[free] = obz[*j];
X			    oazm[free] = oazm[*j];
X			    oangle[free] = oangle[*j];
X			    odamage[free] = (float)0.;
X			    photon_c__[free - 3] = 0;
X			}
X		    }
X		}
X	    }
X	}
X    }
X
X/*    adjust angles and stuff */
X
X    ospeed[*j] += *brake;
X    if (ospeed[*j] > (float)4.) {
X	ospeed[*j] = (float)4.;
X    }
X    if (ospeed[*j] < (float)0.) {
X	ospeed[*j] = (float).1;
X    }
X    oazm[*j] += *razm;
X    oangle[*j] += *rangle;
X    ++(*phase_c__);
X    return 0;
X} /* strek_move_enemy__ */
X
X/* Subroutine */ int strek_aim_photons__(xc, yc, zc, azm, angle, speed, obx, 
X	oby, obz, oazm, oangle, shoot)
Xreal *xc, *yc, *zc, *azm, *angle, *speed, *obx, *oby, *obz, *oazm, *oangle;
Xlogical *shoot;
X{
X    /* System generated locals */
X    real r__1, r__2, r__3;
X
X    /* Builtin functions */
X    double sin(), cos();
X
X    /* Local variables */
X    static real dist, a, b, c;
X    static integer j;
X    static real ca, da, db, dc, oa, ob, oc, cp, sa, dx, dy, dz, sp, ospeed, 
X	    tol;
X
X
X/*    STREK_AIM_PHOTONS projects the enemy photons, shoot is true if */
X/*    the projection falls within 40 units of the projected player */
X/*    ship. Photons do not inherit the parents ship's velocity. */
X
X/*    version 1 */
X/*                                  -jsr 8/85 */
X
X
X/*    figure all pertinent angles (note that ship angles are converted */
X/*    to radians in STREK_MOVE_ENEMY). */
X
X    sa = sin(*azm);
X    ca = cos(*azm);
X    sp = sin(*angle);
X    cp = cos(*angle);
X    a = -(doublereal)sa * cp * *speed;
X    b = ca * cp * *speed;
X    c = sp * *speed;
X    sa = sin(*oazm);
X    ca = cos(*oazm);
X    sp = sin(*oangle);
X    cp = cos(*oangle);
X    ospeed = (float)11.;
X    oa = -(doublereal)sa * cp * ospeed;
X    ob = ca * cp * ospeed;
X    oc = sp * ospeed;
X    da = a - oa;
X    db = b - ob;
X    dc = c - oc;
X    dx = *xc - *obx;
X    dy = *yc - *oby;
X    dz = *zc - *obz;
X
X/*    check for an intersection within tolerance (which is 40**2 in */
X/*    an all out attempt not to do sqrt's) */
X
X    tol = (float)900.;
X    *shoot = FALSE_;
X    j = 1;
XL10:
X    if (j > 50) {
X	return 0;
X    }
X/* Computing 2nd power */
X    r__1 = j * da + dx;
X/* Computing 2nd power */
X    r__2 = j * db + dy;
X/* Computing 2nd power */
X    r__3 = j * dc + dz;
X    dist = r__1 * r__1 + r__2 * r__2 + r__3 * r__3;
X    if (dist <= tol) {
X	*shoot = TRUE_;
X	return 0;
X    }
X    ++j;
X    goto L10;
X} /* strek_aim_photons__ */
X
E!O!F! xstrek/strek_enemy_subs.c
echo xstrek/strek_graphics_subs.c 1>&2
sed -e 's/^X//' > xstrek/strek_graphics_subs.c <<'E!O!F! xstrek/strek_graphics_subs.c'
X/* strek_graphics_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__0 = 0;
Xstatic integer c__2 = 2;
Xstatic integer c__23 = 23;
Xstatic integer c__26 = 26;
Xstatic integer c__18 = 18;
Xstatic integer c__21 = 21;
Xstatic integer c__5 = 5;
Xstatic integer c__6 = 6;
Xstatic integer c__7 = 7;
Xstatic integer c__4 = 4;
Xstatic integer c__3 = 3;
X
X/* Subroutine */ int strek_screen_init__(bitmap_desc__, font_3__, font_4__)
Xinteger *bitmap_desc__, *font_3__, *font_4__;
X{
X    /* Initialized data */
X
X    static shortint size[2] = { 1024,1024 };
X    static integer value[2] = { 0,16777215 };
X
X    /* Builtin functions */
X    /* Subroutine */ int s_stop(), s_copy();
X
X    /* Local variables */
X    extern /* Subroutine */ int gprsetfillvalue_(), gprsetdrawvalue_(), 
X	    gprsettextvalue_();
X    static char text[30];
X    static real gprright;
X    extern /* Subroutine */ int gprrectangle_(), gprinqconfig_(), 
X	    gprsetclipwindow_(), gprsetclippingactive_(), gprcircle_();
X    static integer font_1__, font_2__;
X    static real gprborrow;
X    static shortint config, radius, window[4]	/* was [2][2] */;
X    static integer status;
X    static shortint pt1[2];
X    extern /* Subroutine */ int gprsettextbackgroundvalue_();
X    static real gprcolor1024x800x4, gprcolor1024x800x8;
X    extern /* Subroutine */ int gprsetcolormap_(), gprsettextpath_();
X    static shortint xpt, ypt;
X    extern /* Subroutine */ int gprsettextfont_();
X    static real gprcolor1024x1024x4, gprcolor1024x1024x8;
X    extern /* Subroutine */ int gprinit_(), gprmove_(), gprcirclefilled_(), 
X	    gprtext_(), gprloadfontfile_();
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_SCREEN_INIT sets up the static display panels for */
X/*    STREK. Used prior to any other graphics calls. */
X
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X
X
X/*    data for screen panels */
X
X
X/*    init screen in borrow mode (1024x1024) */
X
X    gprinqconfig_(&config, &status);
X
X    gprinit_(&gprborrow, &c__1, size, &c__0, bitmap_desc__, &status);
X    if (status != 0) {
X/*        call errorprint (status) */
X	s_stop("", 0L);
X    }
X
X    if ((real) config == gprcolor1024x1024x4 || (real) config == 
X	    gprcolor1024x1024x8 || (real) config == gprcolor1024x800x4 || (
X	    real) config == gprcolor1024x800x8) {
X	gprsetcolormap_(&c__0, &c__2, value, &status);
X    }
X
X/*    load all fonts needed */
X
X    gprloadfontfile_("/sys/dm/fonts/nonie.r.8", &c__23, &font_1__, &status, 
X	    23L);
X    gprloadfontfile_("/sys/dm/fonts/scvc8x16.i.r", &c__26, &font_2__, &status,
X	     26L);
X    gprloadfontfile_("/sys/dm/fonts/scvc5x10.r.b", &c__26, font_3__, &status, 
X	    26L);
X    gprloadfontfile_("/sys/dm/fonts/f5x9", &c__18, font_4__, &status, 18L);
X    gprsettextpath_(&gprright, &status);
X/*      call gprsettextbackgroundvalue (-1,status) */
X    gprsettextbackgroundvalue_(&c__1, &status);
X
X/*    set values for draws and fills */
X
X    gprsetdrawvalue_(&c__1, &status);
X    gprsetfillvalue_(&c__1, &status);
X
X/*    fill in rectangular border */
X
X    window[0] = 0;
X    window[1] = 0;
X    window[2] = 900;
X    window[3] = 800;
X    gprrectangle_(window, &status);
X    gprsetfillvalue_(&c__0, &status);
X    window[0] = 100;
X    window[1] = 100;
X    window[2] = 700;
X    window[3] = 600;
X    gprrectangle_(window, &status);
X    window[0] = 100;
X    window[1] = 710;
X    window[2] = 700;
X    window[3] = 80;
X    gprrectangle_(window, &status);
X    gprsetfillvalue_(&c__1, &status);
X
X/*    put in text on all static panels */
X
X/*      call gprsetclippingactive (.true.,status) */
X    xpt = 15;
X    ypt = 25;
X    gprsettextfont_(&font_2__, &status);
X    gprsettextvalue_(&c__0, &status);
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Star Trek Version 3.0", 30L, 21L);
X    gprtext_(text, &c__21, &status, 30L);
X    gprsettextfont_(&font_1__, &status);
X    xpt = 10;
X    ypt = 150;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Speed", 30L, 5L);
X    gprtext_(text, &c__5, &status, 30L);
X    xpt = 10;
X    ypt = 250;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Energy", 30L, 6L);
X    gprtext_(text, &c__6, &status, 30L);
X    xpt = 10;
X    ypt = 350;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Photons", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 10;
X    ypt = 450;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Phasers", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 10;
X    ypt = 550;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Tractor", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 17;
X    ypt = 755;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Com:", 30L, 4L);
X    gprtext_(text, &c__4, &status, 30L);
X    xpt = 110;
X    ypt = 75;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "X-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 310;
X    ypt = 75;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Y-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 510;
X    ypt = 75;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Z-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 810;
X    ypt = 125;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Scanner", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 810;
X    ypt = 200;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "X-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 810;
X    ypt = 275;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Y-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 810;
X    ypt = 350;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Z-Coor:", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 810;
X    ypt = 425;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Range:", 30L, 6L);
X    gprtext_(text, &c__6, &status, 30L);
X
X/*    insert scanner windows */
X
X    gprsetfillvalue_(&c__0, &status);
X    pt1[0] = 850;
X    pt1[1] = 540;
X    radius = 45;
X    gprcirclefilled_(pt1, &radius, &status);
X    pt1[1] = 650;
X    gprcirclefilled_(pt1, &radius, &status);
X    gprsettextfont_(font_4__, &status);
X    xpt = 708;
X    ypt = 33;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Enemy 1", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 708;
X    ypt = 73;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Enemy 2", 30L, 7L);
X    gprtext_(text, &c__7, &status, 30L);
X    xpt = 819;
X    ypt = 33;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Low E", 30L, 5L);
X    gprtext_(text, &c__5, &status, 30L);
X    xpt = 815;
X    ypt = 73;
X    gprmove_(&xpt, &ypt, &status);
X    s_copy(text, "Nav On", 30L, 6L);
X    gprtext_(text, &c__6, &status, 30L);
X    xpt = 810;
X    ypt = 490;
X    s_copy(text, "X", 30L, 1L);
X    gprmove_(&xpt, &ypt, &status);
X    gprtext_(text, &c__1, &status, 30L);
X    xpt = 885;
X    ypt = 490;
X    s_copy(text, "Y", 30L, 1L);
X    gprmove_(&xpt, &ypt, &status);
X    gprtext_(text, &c__1, &status, 30L);
X    xpt = 810;
X    ypt = 600;
X    s_copy(text, "Z", 30L, 1L);
X    gprmove_(&xpt, &ypt, &status);
X    gprtext_(text, &c__1, &status, 30L);
X    xpt = 885;
X    s_copy(text, "Y", 30L, 1L);
X    gprmove_(&xpt, &ypt, &status);
X    gprtext_(text, &c__1, &status, 30L);
X    gprsettextfont_(&font_2__, &status);
X
X/*    put logo in lower right corner */
X
X    window[0] = 810;
X    window[1] = 710;
X    window[2] = 80;
X    window[3] = 80;
X    gprrectangle_(window, &status);
X    pt1[0] = 850;
X    pt1[1] = 765;
X    radius = 18;
X    gprcircle_(pt1, &radius, &status);
X    pt1[0] = 850;
X    pt1[1] = 765;
X    radius = 6;
X    gprcircle_(pt1, &radius, &status);
X    gprsetfillvalue_(&c__1, &status);
X    window[0] = 832;
X    window[1] = 715;
X    window[2] = 5;
X    window[3] = 30;
X    gprrectangle_(window, &status);
X    window[0] = 863;
X    gprrectangle_(window, &status);
X    window[0] = 847;
X    window[1] = 730;
X    window[2] = 6;
X    window[3] = 17;
X    gprrectangle_(window, &status);
X
X/*    load permanent font */
X
X    gprsettextfont_(font_4__, &status);
X    gprsettextbackgroundvalue_(&c__1, &status);
X    gprsetdrawvalue_(&c__1, &status);
X
X/*    set clipping window limits */
X
X    window[0] = 100;
X    window[1] = 100;
X    window[2] = 700;
X    window[3] = 600;
X    gprsetclipwindow_(window, &status);
X    gprsetclippingactive_(&c__1, &status);
X
X/*    return to main program */
X
X    return 0;
X} /* strek_screen_init__ */
X
X/* Subroutine */ int strek_update_panel__(speed, power, photons, phase, tract,
X	 xc, yc, zc, scan, txc, tyc, tzc, trange, scan_ob__)
Xinteger *speed, *power, *photons;
Xlogical *phase, *tract;
Xinteger *xc, *yc, *zc;
Xlogical *scan;
Xinteger *txc, *tyc, *tzc, *trange, *scan_ob__;
X{
X    /* Initialized data */
X
X    static shortint x_pt__[15] = { 10,10,10,20,20,200,400,600,820,810,810,810,
X	    810,770,770 };
X    static shortint y_pt__[15] = { 190,290,390,490,590,75,75,75,155,230,305,
X	    380,455,35,75 };
X    static char active[7+1] = " active";
X    static char down[7+1] = "  down ";
X    static integer length = 7;
X    static integer n = 1;
X    static logical absol = TRUE_;
X
X    /* Format strings */
X    static char fmt_100[] = "(i7)";
X
X    /* Builtin functions */
X    integer s_wsfi(), do_fio(), e_wsfi();
X    /* Subroutine */ int s_copy();
X
X    /* Local variables */
X    static char text[7];
X    extern /* Subroutine */ int gprsetclippingactive_();
X    static integer status;
X    extern /* Subroutine */ int gprmove_(), gprtext_();
X
X    /* Fortran I/O blocks */
X    static icilist io___30 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___31 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___32 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___33 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___34 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___35 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___36 = { 0, text, 0, "(4x, i1)", 7, 1 };
X    static icilist io___37 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___38 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___39 = { 0, text, 0, fmt_100, 7, 1 };
X    static icilist io___40 = { 0, text, 0, fmt_100, 7, 1 };
X
X
X
X/*    STREK_UPDATE PANEL writes the revised panel data (not com line). */
X/*    Assumes the proper font and text value are loaded. Font */
X/*    background shouldn't be transparent. Handles clipping window. */
X/*    Only certain portions are refreshed each pass (this routine */
X/*    or GPR text to be more specific is slow). */
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 move statements */
X
X
X/*    data for text lines */
X
X
X/*    deactivate clipping window */
X
X    gprsetclippingactive_(&c__0, &status);
X
X/*    panel numbers are encoded into text which is then written */
X
X    if (n == 1) {
X	s_wsfi(&io___30);
X	do_fio(&c__1, (char *)&(*speed), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(x_pt__, y_pt__, &status);
X	gprtext_(text, &length, &status, 7L);
X	s_wsfi(&io___31);
X	do_fio(&c__1, (char *)&(*power), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[1], &y_pt__[1], &status);
X	gprtext_(text, &length, &status, 7L);
X	s_wsfi(&io___32);
X	do_fio(&c__1, (char *)&(*photons), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[2], &y_pt__[2], &status);
X	gprtext_(text, &length, &status, 7L);
X	if (*phase) {
X	    s_copy(text, active, 7L, 7L);
X	} else {
X	    s_copy(text, down, 7L, 7L);
X	}
X	gprmove_(&x_pt__[3], &y_pt__[3], &status);
X	gprtext_(text, &length, &status, 7L);
X    } else if (n == 2) {
X	if (absol) {
X	    s_wsfi(&io___33);
X	    do_fio(&c__1, (char *)&(*xc), (ftnlen)sizeof(integer));
X	    e_wsfi();
X	    gprmove_(&x_pt__[5], &y_pt__[5], &status);
X	    gprtext_(text, &length, &status, 7L);
X	    s_wsfi(&io___34);
X	    do_fio(&c__1, (char *)&(*yc), (ftnlen)sizeof(integer));
X	    e_wsfi();
X	    gprmove_(&x_pt__[6], &y_pt__[6], &status);
X	    gprtext_(text, &length, &status, 7L);
X	    s_wsfi(&io___35);
X	    do_fio(&c__1, (char *)&(*zc), (ftnlen)sizeof(integer));
X	    e_wsfi();
X	    gprmove_(&x_pt__[7], &y_pt__[7], &status);
X	    gprtext_(text, &length, &status, 7L);
X	}
X	absol = ! absol;
X    } else if (n == 3) {
X	if (*tract) {
X	    s_copy(text, active, 7L, 7L);
X	} else {
X	    s_copy(text, down, 7L, 7L);
X	}
X	gprmove_(&x_pt__[4], &y_pt__[4], &status);
X	gprtext_(text, &length, &status, 7L);
X	if (*scan) {
X	    s_wsfi(&io___36);
X	    do_fio(&c__1, (char *)&(*scan_ob__), (ftnlen)sizeof(integer));
X	    e_wsfi();
X	} else {
X	    s_copy(text, down, 7L, 7L);
X	}
X	gprmove_(&x_pt__[8], &y_pt__[8], &status);
X	gprtext_(text, &length, &status, 7L);
X	s_wsfi(&io___37);
X	do_fio(&c__1, (char *)&(*txc), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[9], &y_pt__[9], &status);
X	gprtext_(text, &length, &status, 7L);
X    } else {
X	n = 0;
X	s_wsfi(&io___38);
X	do_fio(&c__1, (char *)&(*tyc), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[10], &y_pt__[10], &status);
X	gprtext_(text, &length, &status, 7L);
X	s_wsfi(&io___39);
X	do_fio(&c__1, (char *)&(*tzc), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[11], &y_pt__[11], &status);
X	gprtext_(text, &length, &status, 7L);
X	s_wsfi(&io___40);
X	do_fio(&c__1, (char *)&(*trange), (ftnlen)sizeof(integer));
X	e_wsfi();
X	gprmove_(&x_pt__[12], &y_pt__[12], &status);
X	gprtext_(text, &length, &status, 7L);
X    }
X    ++n;
X
X/*    formats */
X
X/* L110: */
X
X/*    reactivate clipping */
X
X    gprsetclippingactive_(&c__1, &status);
X
X/*    return to main */
X
X    return 0;
X} /* strek_update_panel__ */
X
X/* Subroutine */ int strek_flashers__(object, lock_on__, energy, 
X	bitmap_desc__)
Xlogical *object, *lock_on__;
Xreal *energy;
Xinteger *bitmap_desc__;
X{
X    /* Initialized data */
X
X    static logical old[4] = { FALSE_,FALSE_,FALSE_,FALSE_ };
X    static integer count = 0;
X    static shortint wind_1__[4]	/* was [2][2] */ = { 695,18,72,24 };
X    static shortint wind_2__[4]	/* was [2][2] */ = { 695,58,72,24 };
X    static shortint wind_3__[4]	/* was [2][2] */ = { 799,58,72,24 };
X    static shortint wind_4__[4]	/* was [2][2] */ = { 799,18,72,24 };
X    static shortint dest_1__[2] = { 695,18 };
X    static shortint dest_2__[2] = { 695,58 };
X    static shortint dest_3__[2] = { 799,58 };
X    static shortint dest_4__[2] = { 799,18 };
X    static shortint zero = 0;
X    static shortint three = 3;
X    static shortint ten = 10;
X
X    static logical low_e__;
X    extern /* Subroutine */ int gprsetclippingactive_(), gprbitblt_();
X    static integer status;
X    extern /* Subroutine */ int gprsetrasterop_();
X
X
X/*    STREK_FLASHERS flashes warning lights for ships and */
X/*    low energy. */
X
X/*    version 1 */
X/*                                      -jsr */
X
X
X/*    cycle through the four warning lights, if they need */
X/*    to be reversed then reverse them, simple huh? */
X
X    ++count;
X    if (count > 4) {
X	count = 0;
X	if (object[2] && ! old[0]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_1__, &zero, dest_1__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[0] = ! old[0];
X	} else if (! object[2] && old[0]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_1__, &zero, dest_1__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[0] = ! old[0];
X	}
X	if (object[3] && ! old[1]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_2__, &zero, dest_2__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[1] = ! old[1];
X	} else if (! object[3] && old[1]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_2__, &zero, dest_2__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[1] = ! old[1];
X	}
X	if (*lock_on__ && ! old[2]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_3__, &zero, dest_3__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[2] = ! old[2];
X	} else if (! (*lock_on__) && old[2]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_3__, &zero, dest_3__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[2] = ! old[2];
X	}
X	low_e__ = FALSE_;
X	if (*energy < (float)50.) {
X	    low_e__ = TRUE_;
X	}
X	if (low_e__ && ! old[3]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_4__, &zero, dest_4__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[3] = ! old[3];
X	} else if (! low_e__ && old[3]) {
X	    gprsetrasterop_(&zero, &ten, &status);
X	    gprsetclippingactive_(&c__0, &status);
X	    gprbitblt_(bitmap_desc__, wind_4__, &zero, dest_4__, &zero, &
X		    status);
X	    gprsetrasterop_(&zero, &three, &status);
X	    gprsetclippingactive_(&c__1, &status);
X	    old[3] = ! old[3];
X	}
X    }
X    return 0;
X} /* strek_flashers__ */
X
X/* Subroutine */ int strek_x_hairs__()
X{
X    /* Initialized data */
X
X    static shortint x_pts__[4] = { 440,460,460,440 };
X    static shortint y_pts__[4] = { 410,390,410,390 };
X    static integer num_pos__ = 4;
X    static integer count = 1;
X
X    extern /* Subroutine */ int gprmultiline_();
X    static integer status;
X
X
X/*    STREK_X_HAIRS draws the cross-hairs at the screen center. */
X/*    Since these don't move and should superimpose upon other */
X/*    objects they are redrawn instead of bit blt'ed. Assumes */
X/*    draw value is 1. */
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/*   call multiline for cross-hairs */
X
X    if (count == 3) {
X	gprmultiline_(x_pts__, y_pts__, &num_pos__, &status);
X	count = 0;
X    }
X    ++count;
X    return 0;
X} /* strek_x_hairs__ */
X
X/* Subroutine */ int strek_message__(message, num_lines__, message_len)
Xchar *message;
Xinteger *num_lines__;
Xftnlen message_len;
X{
X    /* Initialized data */
X
X    static shortint window[4]	/* was [2][2] */ = { 100,710,700,80 };
X    static shortint x_pt__ = 110;
X    static shortint y_pt__[3] = { 730,750,770 };
X    static integer length = 80;
X
X    /* System generated locals */
X    integer i__1;
X
X    /* Local variables */
X    extern /* Subroutine */ int gprsetfillvalue_(), gprsettextvalue_(), 
X	    gprrectangle_();
X    static integer j;
X    extern /* Subroutine */ int gprsetclippingactive_();
X    static integer status;
X    extern /* Subroutine */ int gprsettextbackgroundvalue_(), gprmove_(), 
X	    gprtext_();
X
X
X/*    STREK_MESSAGE prints a message in the com window. */
X/*    Message is an array of 3 char*80 strings, num_lines is the */
X/*    number to print on this call (0-3). Zero lines implies */
X/*    clearing the message block of all current messages. */
X/*    Handles the clipping window and a text value commands */
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/*    text placement data */
X
X    /* Parameter adjustments */
X    message -= 80;
X
X    /* Function Body */
X
X/*    deactivate clipping window */
X
X    gprsetclippingactive_(&c__0, &status);
X
X/*    if num_lines is zero erase message block */
X
X    if (*num_lines__ == 0) {
X	gprsetfillvalue_(&c__0, &status);
X	gprrectangle_(window, &status);
X	gprsetfillvalue_(&c__1, &status);
X	gprsetclippingactive_(&c__1, &status);
X	return 0;
X    }
X
X/*    set text values and write message */
X
X    gprsettextvalue_(&c__1, &status);
X    gprsettextbackgroundvalue_(&c__0, &status);
X    i__1 = *num_lines__;
X    for (j = 1; j <= i__1; ++j) {
X	gprmove_(&x_pt__, &y_pt__[j - 1], &status);
X	gprtext_(message + j * 80, &length, &status, 80L);
X/* L10: */
X    }
X
X/*    reset text values and clipping window */
X
X    gprsettextvalue_(&c__0, &status);
X    gprsettextbackgroundvalue_(&c__1, &status);
X    gprsetclippingactive_(&c__1, &status);
X
X/*    return to main program */
X
X    return 0;
X} /* strek_message__ */
X
X/* Subroutine */ int strek_draw_phasers__(x_pt__, y_pt__)
Xinteger *x_pt__, *y_pt__;
X{
X    extern /* Subroutine */ int gprsetdrawvalue_();
X    static real yoff;
X    static integer j;
X    static shortint xpt_l__, xpt_r__;
X    static real xoff_l__, xoff_r__;
X    static integer status;
X    static shortint ypt;
X    extern /* Subroutine */ int gprline_(), gprmove_();
X
X
X/*    STREK_DRAW_PHASERS - draws the phasers to the target point */
X/*    (x_pt,y_pt). This is all done in stop  action (light speed */
X/*    and everthing like that there). Handles all gpr actions */
X/*    needed and returns them to normal. */
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/*    find the incremental offsets of rays */
X
X    xoff_l__ = (*x_pt__ - 100) / (float)20.;
X    xoff_r__ = (*x_pt__ - 800) / (float)20.;
X    yoff = (*y_pt__ - 700) / (float)20.;
X
X/*    begin drawing lines using move and line */
X
X    for (j = 1; j <= 20; ++j) {
X	xpt_l__ = (j - 1) * xoff_l__ + 100;
X	ypt = (j - 1) * yoff + 700;
X	gprmove_(&xpt_l__, &ypt, &status);
X	xpt_l__ += xoff_l__;
X	ypt += yoff;
X	gprline_(&xpt_l__, &ypt, &status);
X	xpt_r__ = (j - 1) * xoff_r__ + 800;
X	ypt = (j - 1) * yoff + 700;
X	gprmove_(&xpt_r__, &ypt, &status);
X	xpt_r__ += xoff_r__;
X	ypt += yoff;
X	gprline_(&xpt_r__, &ypt, &status);
X/* L10: */
X    }
X
X/*    erase lines slowly */
X
X    gprsetdrawvalue_(&c__0, &status);
X    for (j = 1; j <= 20; ++j) {
X	xpt_l__ = (j - 1) * xoff_l__ + 100;
X	ypt = (j - 1) * yoff + 700;
X	gprmove_(&xpt_l__, &ypt, &status);
X	xpt_l__ += xoff_l__;
X	ypt += yoff;
X	gprline_(&xpt_l__, &ypt, &status);
X	xpt_r__ = (j - 1) * xoff_r__ + 800;
X	ypt = (j - 1) * yoff + 700;
X	gprmove_(&xpt_r__, &ypt, &status);
X	xpt_r__ += xoff_r__;
X	ypt += yoff;
X	gprline_(&xpt_r__, &ypt, &status);
X/* L20: */
X    }
X
X/*    return to calling sub */
X
X    gprsetdrawvalue_(&c__1, &status);
X    return 0;
X} /* strek_draw_phasers__ */
X
X/* Subroutine */ int strek_damage_info__(d_pct__, capt_name__, nick_name__, 
X	capt_name_len, nick_name_len)
Xreal *d_pct__;
Xchar *capt_name__, *nick_name__;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
X{
X    /* Initialized data */
X
X    static char message[80*3+1] = "  engine 1  engine 2    phaser   battery \
X  scanner   tractor                    ";
X
X    /* System generated locals */
X    address a__1[2];
X    integer i__1[2];
X
X    /* Builtin functions */
X    integer s_wsfi(), do_fio(), e_wsfi();
X    /* Subroutine */ int s_cat();
X
X    /* Local variables */
X    static integer i, j;
X    static real total;
X    extern /* Subroutine */ int strek_message__();
X
X    /* Fortran I/O blocks */
X    static icilist io___76 = { 0, message+80, 0, "(6f10.2)", 80, 1 };
X
X
X
X/*    STREK_DAMAGE_INFO documents on the com line the current */
X/*    ship damages including a diagnostic from Scotty. */
X
X/*    version 1 */
X/*                                        -jsr 8/85 */
X
X    /* Parameter adjustments */
X    --d_pct__;
X
X    /* Function Body */
X
X/*    encode damage pecentiles */
X
X    s_wsfi(&io___76);
X    for (i = 1; i <= 6; ++i) {
X	do_fio(&c__1, (char *)&d_pct__[i], (ftnlen)sizeof(real));
X    }
X    e_wsfi();
X
X/*    add percents */
X
X    total = (float)0.;
X    for (j = 1; j <= 6; ++j) {
X	total += d_pct__[j];
X/* L10: */
X    }
X
X/*    pick Scotty's message */
X
X    if (total > (float)4.8) {
X/* Writing concatenation */
X	i__1[0] = 32, a__1[0] = "Aye, there's no problem captain ";
X	i__1[1] = 10, a__1[1] = capt_name__;
X	s_cat(message + 160, a__1, i__1, &c__2, 80L);
X    } else if (total <= (float)4.8 && total > (float)3.) {
X/* Writing concatenation */
X	i__1[0] = 21, a__1[0] = "She'll hold together ";
X	i__1[1] = 10, a__1[1] = nick_name__;
X	s_cat(message + 160, a__1, i__1, &c__2, 80L);
X    } else {
X/* Writing concatenation */
X	i__1[0] = 39, a__1[0] = "She can't take much more of this abuse ";
X	i__1[1] = 10, a__1[1] = nick_name__;
X	s_cat(message + 160, a__1, i__1, &c__2, 80L);
X    }
X    strek_message__(message, &c__3, 80L);
X    return 0;
X} /* strek_damage_info__ */
X
X/* Subroutine */ int strek_number_objects__(pos_store__, orange, object, dir)
Xinteger *pos_store__;
Xreal *orange;
Xlogical *object, *dir;
X{
X    /* Initialized data */
X
X    static char text[1*10+1] = "0123456789";
X
X    static shortint x_pt__, y_pt__;
X    extern /* Subroutine */ int gprsettextvalue_();
X    static integer j, status;
X    extern /* Subroutine */ int gprsettextbackgroundvalue_(), gprmove_(), 
X	    gprtext_();
X
X
X/*    STREK_NUMBER_OBJECTS writes the unique STREK object number */
X/*    next to screen objects. Assumes proper font, raster_op and */
X/*    clip window status. */
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    /* Parameter adjustments */
X    pos_store__ -= 10;
X
X    /* Function Body */
X    if (*dir) {
X	gprsettextvalue_(&c__1, &status);
X	gprsettextbackgroundvalue_(&c__0, &status);
X    } else {
X	gprsettextvalue_(&c__0, &status);
X	gprsettextbackgroundvalue_(&c__0, &status);
X    }
X
X/*    loop over objects */
X
X    for (j = 0; j <= 9; ++j) {
X	if (object[j] && orange[j] < (float)6.4e5) {
X	    x_pt__ = pos_store__[j + 10];
X	    y_pt__ = pos_store__[j + 20];
X	    gprmove_(&x_pt__, &y_pt__, &status);
X	    gprtext_(text + j, &c__1, &status, 1L);
X	}
X/* L10: */
X    }
X    gprsettextvalue_(&c__0, &status);
X    gprsettextbackgroundvalue_(&c__1, &status);
X    return 0;
X} /* strek_number_objects__ */
X
X/* Subroutine */ int strek_scanner__(rox, roy, roz, object, dir)
Xreal *rox, *roy, *roz;
Xlogical *object, *dir;
X{
X    /* Initialized data */
X
X    static real max_ = (float)3.6e5;
X    static real check = (float)600.;
X    static real scale = (float).0666666;
X    static shortint xpt[10] = { 0,0,0,0,0,0,0,0,0,0 };
X    static shortint ypt[10] = { 0,0,0,0,0,0,0,0,0,0 };
X    static shortint xpt2[10] = { 0,0,0,0,0,0,0,0,0,0 };
X    static shortint ypt2[10] = { 0,0,0,0,0,0,0,0,0,0 };
X    static logical erase[10] = { FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,FALSE_,
X	    FALSE_,FALSE_,FALSE_,FALSE_ };
X
X    /* System generated locals */
X    real r__1, r__2, r__3;
X
X    /* Local variables */
X    static integer j;
X    extern /* Subroutine */ int gprsetclippingactive_();
X    static real check1;
X    static shortint xt, yt;
X    static integer status;
X    extern /* Subroutine */ int gprline_(), gprmove_();
X
X
X/*    STREK_SCANNER maintains the scanner windows. */
X
X/*    version 1 */
X/*                                 -jsr 8/85 */
X
X
X/*    turn off clipping */
X
X    gprsetclippingactive_(&c__0, &status);
X
X/*    if refreshing then compute projected postions */
X
X    if (*dir) {
X	for (j = 0; j <= 9; ++j) {
X	    erase[j] = FALSE_;
X	    if (object[j]) {
X		if ((r__1 = rox[j], dabs(r__1)) < check && (r__2 = roy[j], 
X			dabs(r__2)) < check && (r__3 = roz[j], dabs(r__3)) < 
X			check) {
X/* Computing 2nd power */
X		    r__1 = rox[j];
X/* Computing 2nd power */
X		    r__2 = roy[j];
X		    check1 = r__1 * r__1 + r__2 * r__2;
X		    if (check1 < max_) {
X/* Computing 2nd power */
X			r__1 = roz[j];
X/* Computing 2nd power */
X			r__2 = roy[j];
X			check1 = r__1 * r__1 + r__2 * r__2;
X			if (check1 < max_) {
X			    erase[j] = TRUE_;
X			    xpt[j] = rox[j] * scale + 850;
X			    ypt[j] = -(doublereal)roy[j] * scale + 540;
X			    xpt2[j] = roy[j] * scale + 850;
X			    ypt2[j] = -(doublereal)roz[j] * scale + 650;
X			    gprmove_(&xpt[j], &ypt[j], &status);
X			    xt = xpt[j] + 1;
X			    yt = ypt[j] + 1;
X			    gprline_(&xt, &yt, &status);
X			    gprmove_(&xpt2[j], &ypt2[j], &status);
X			    xt = xpt2[j] + 1;
X			    yt = ypt2[j] + 1;
X			    gprline_(&xt, &yt, &status);
X			}
X		    }
X		}
X	    }
X/* L10: */
X	}
X
X/*    plot a dot at the center of each (player ship) */
X
X	xt = 850;
X	yt = 540;
X	gprmove_(&xt, &yt, &status);
X	gprline_(&xt, &yt, &status);
X	yt = 650;
X	gprmove_(&xt, &yt, &status);
X	gprline_(&xt, &yt, &status);
X
X/*    using previous position erase the current lines by redrawing */
X/*    in black */
X
X    } else {
X	for (j = 0; j <= 9; ++j) {
X	    if (erase[j]) {
X		gprmove_(&xpt[j], &ypt[j], &status);
X		xt = xpt[j] + 1;
X		yt = ypt[j] + 1;
X		gprline_(&xt, &yt, &status);
X		gprmove_(&xpt2[j], &ypt2[j], &status);
X		xt = xpt2[j] + 1;
X		yt = ypt2[j] + 1;
X		gprline_(&xt, &yt, &status);
X	    }
X/* L20: */
X	}
X    }
X    gprsetclippingactive_(&c__1, &status);
X    return 0;
X} /* strek_scanner__ */
X
X/* Subroutine */ int strek_phaser_ship__(x1, y1, pcen, seed)
Xreal *x1, *y1;
Xshortint *pcen;
Xreal *seed;
X{
X    extern /* Subroutine */ int rand_(), gprsetdrawvalue_();
X    static real x_pt__, y_pt__;
X    static integer j;
X    static real xoff_1__, xoff_2__, yoff_1__, yoff_2__;
X    static integer status;
X    extern /* Subroutine */ int gprline_(), gprmove_();
X    static integer px_1__, px_2__, py_1__, py_2__;
X    static shortint xpt1, xpt2, ypt1, ypt2;
X
X
X/*    STREK_PHASER_SHIP draws phasers fire lines from an enemy */
X/*    ship to the player ship in stop time action. Lines are */
X/*    then erased. Handles all GPR calls needed . */
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/*    if ship is to far off the screen or behind the player ship */
X/*    then don't execute. */
X
X    /* Parameter adjustments */
X    --pcen;
X
X    /* Function Body */
X    x_pt__ = *x1;
X    y_pt__ = *y1;
X    if (x_pt__ == (float)1e3 && y_pt__ == (float)1e3) {
X	return 0;
X    }
X    x_pt__ = (real) pcen[1];
X    y_pt__ = (real) pcen[2];
X
X/*    randomly find position of hit on screen */
X
X    rand_(seed);
X    if (*seed < (float).25) {
X	px_1__ = 800;
X	rand_(seed);
X	py_1__ = *seed * 600 + 100;
X    } else if (*seed < (float).5 && *seed >= (float).25) {
X	px_1__ = 100;
X	rand_(seed);
X	py_1__ = *seed * 600 + 100;
X    } else if (*seed < (float).75 && *seed >= (float).5) {
X	py_1__ = 100;
X	rand_(seed);
X	px_1__ = *seed * 700 + 100;
X    } else {
X	py_1__ = 700;
X	rand_(seed);
X	px_1__ = *seed * 700 + 100;
X    }
X    rand_(seed);
X    if (*seed < (float).25) {
X	px_2__ = 800;
X	rand_(seed);
X	py_2__ = *seed * 600 + 100;
X    } else if (*seed < (float).5 && *seed >= (float).25) {
X	px_2__ = 100;
X	rand_(seed);
X	py_2__ = *seed * 600 + 100;
X    } else if (*seed < (float).75 && *seed >= (float).5) {
X	py_2__ = 100;
X	rand_(seed);
X	px_2__ = *seed * 700 + 100;
X    } else {
X	py_2__ = 700;
X	rand_(seed);
X	px_2__ = *seed * 700 + 100;
X    }
X
X/*    find the incremental offsets of rays */
X
X    xoff_1__ = (px_1__ - x_pt__) / (float)20.;
X    xoff_2__ = (px_2__ - x_pt__) / (float)20.;
X    yoff_1__ = (py_1__ - y_pt__) / (float)20.;
X    yoff_2__ = (py_2__ - y_pt__) / (float)20.;
X
X/*    begin drawing lines using move and line */
X
X    for (j = 1; j <= 20; ++j) {
X	xpt1 = x_pt__ + (j - 1) * xoff_1__;
X	ypt1 = y_pt__ + (j - 1) * yoff_1__;
X	gprmove_(&xpt1, &ypt1, &status);
X	xpt1 += xoff_1__;
X	ypt1 += yoff_1__;
X	gprline_(&xpt1, &ypt1, &status);
X	xpt2 = x_pt__ + (j - 1) * xoff_2__;
X	ypt2 = y_pt__ + (j - 1) * yoff_2__;
X	gprmove_(&xpt2, &ypt2, &status);
X	xpt2 += xoff_2__;
X	ypt2 += yoff_2__;
X	gprline_(&xpt2, &ypt2, &status);
X/* L10: */
X    }
X
X/*    erase lines slowly */
X
X    gprsetdrawvalue_(&c__0, &status);
X    for (j = 1; j <= 20; ++j) {
X	xpt1 = x_pt__ + (j - 1) * xoff_1__;
X	ypt1 = y_pt__ + (j - 1) * yoff_1__;
X	gprmove_(&xpt1, &ypt1, &status);
X	xpt1 += xoff_1__;
X	ypt1 += yoff_1__;
X	gprline_(&xpt1, &ypt1, &status);
X	xpt2 = x_pt__ + (j - 1) * xoff_2__;
X	ypt2 = y_pt__ + (j - 1) * yoff_2__;
X	gprmove_(&xpt2, &ypt2, &status);
X	xpt2 += xoff_2__;
X	ypt2 += yoff_2__;
X	gprline_(&xpt2, &ypt2, &status);
X/* L20: */
X    }
X
X/*    return to calling sub */
X
X    gprsetdrawvalue_(&c__1, &status);
X    return 0;
X} /* strek_phaser_ship__ */
X
X/* Subroutine */ int strek_phaser_nemian__(pro_x__, pro_y__)
Xreal *pro_x__, *pro_y__;
X{
X    extern /* Subroutine */ int gprsetdrawvalue_();
X    static real xoff, yoff;
X    static shortint x_pt__, y_pt__;
X    static integer j, status;
X    extern /* Subroutine */ int gprline_(), gprmove_();
X
X
X/*    STREK_PHASER_NEMIAN draws the klingon phaser fire towards */
X/*    Nemian freighters in stop action time. */
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/*    check that phasers need to be drawn */
X
X    if (pro_x__[1] == (float)1e3 || pro_y__[1] == (float)1e3) {
X	return 0;
X    }
X
X/*    form offsets */
X
X    xoff = (pro_x__[1] - pro_x__[2]) / (float)20.;
X    yoff = (pro_y__[1] - pro_y__[2]) / (float)20.;
X
X/*    draw phasers (1 line only) */
X
X    x_pt__ = pro_x__[2];
X    y_pt__ = pro_y__[2];
X    gprmove_(&x_pt__, &y_pt__, &status);
X    for (j = 1; j <= 20; ++j) {
X	x_pt__ += xoff;
X	y_pt__ += yoff;
X	gprline_(&x_pt__, &y_pt__, &status);
X/* L10: */
X    }
X
X/*    erase lines by redrawing in black */
X
X    gprsetdrawvalue_(&c__0, &status);
X    x_pt__ = pro_x__[2];
X    y_pt__ = pro_y__[2];
X    gprmove_(&x_pt__, &y_pt__, &status);
X    for (j = 1; j <= 20; ++j) {
X	x_pt__ += xoff;
X	y_pt__ += yoff;
X	gprline_(&x_pt__, &y_pt__, &status);
X/* L20: */
X    }
X
X/*    reset color and return */
X
X    gprsetdrawvalue_(&c__1, &status);
X    return 0;
X} /* strek_phaser_nemian__ */
X
E!O!F! xstrek/strek_graphics_subs.c
echo xstrek/strek_key_defs 1>&2
sed -e 's/^X//' > xstrek/strek_key_defs <<'E!O!F! xstrek/strek_key_defs'
XBackSpace	z # clear Command panel
XDelete		z # clear Command panel
XClear		z # clear Command panel
XF21		/ # pause
XPause		/ # pause
XScroll_Lock	/ # pause
XF23		/ # pause
XBreak		/ # pause
XL1		/ # pause
XF11		/ # pause
XR1		/ # pause
XR3		/ # pause
XEscape		d # dock -> finish
XKP_5		m # stop motion
XF31		m # stop motion
XLeft		h # turn left
XKP_4		h # turn left
XR10		h # turn left
XRight		j # turn right
XKP_6		j # turn right
XR12		j # turn right
XUp		u # turn up
XKP_8		u # turn up
XR8		u # turn up
XDown		n # turn down
XKP_2		n # turn down
XR14		n # turn down
XKP_Enter	f # torpedo
XKP_Add		a # add speed
Xplus		a # add speed
Xequal		a # add speed
XKP_Subtract	s # reduce speed
Xminus		s # reduce speed
Xunderscore	s # reduce speed
XHelp		i # info
E!O!F! xstrek/strek_key_defs
echo xstrek/strek_key_defs.orig 1>&2
sed -e 's/^X//' > xstrek/strek_key_defs.orig <<'E!O!F! xstrek/strek_key_defs.orig'
Xenter character definition in column 7
Xe.g.  x
Xa    
Xb    
Xc    
Xd    
Xe    
Xf    
Xg    
Xh    
Xi    
Xj    
Xk    
Xl    
Xm    
Xn    
Xo    
Xp    
Xq    
Xr    
Xs    
Xt    
Xu    
Xv    
Xw    
Xx    
Xy    
Xz    
Xl1   
Xl2   
Xl3   
Xl4   
Xl5   
Xl6   
Xl7   
Xl8   
Xl9   
Xla   
Xlb   
Xlc   
Xld   
Xle   
Xlf   
Xl1a  
Xl2a  
Xl3a  
Xl1u  
Xl2u  
Xl3u  
Xl4u  
Xl5u  
Xl6u  
Xl7u  
Xl8u  
Xl9u  
Xlau  
Xlbu  
Xlcu  
Xldu  
Xleu  
Xlfu  
Xl1au 
Xl2au 
Xl3au 
Xf1   
Xf2   
Xf3   
Xf4   
Xf5   
Xf6   
Xf7   
Xf8   
Xf1u  
Xf2u  
Xf3u  
Xf4u  
Xf5u  
Xf6u  
Xf7u  
Xf8u  
Xr1   
Xr2   
Xr3   
Xr4   
Xr5   
Xr6   
Xspace
X,    
X.    
X/    
X;    
X[    
E!O!F! xstrek/strek_key_defs.orig
echo xstrek/strek_keysym_string.c 1>&2
sed -e 's/^X//' > xstrek/strek_keysym_string.c <<'E!O!F! xstrek/strek_keysym_string.c'
X#include <stdio.h>
X#include <X11/Xlib.h>
X#include <X11/Xutil.h>
X
Xmain()
X{
X   Display              *d;
X   Window               w;
X   unsigned int         wid;
X   unsigned int         hei;
X   unsigned long        fcolor;
X   unsigned long        bcolor;
X   XWMHints             wmhints;
X   int                  index;
X   XEvent               ev;
X   XWindowAttributes    wattr;
X   int                  rx;
X   int                  ry;
X   Window               dummywin;
X   char                 *dummy_string;
X
X
X
X   d = XOpenDisplay (0);
X
X   if (d == 0)
X   {
X      printf("can't open display! bye.\n");
X      exit(1);
X   }
X
X   wid = 100;
X   hei = 100;
X
X   fcolor = WhitePixelOfScreen(DefaultScreenOfDisplay(d));
X   bcolor = BlackPixelOfScreen(DefaultScreenOfDisplay(d));
X
X   w = XCreateSimpleWindow (d, DefaultRootWindow(d),
X                            0, 0,
X                            wid,
X                            hei,
X                            2,
X                            fcolor,
X                            bcolor);
X
X   wmhints.input = True;
X   wmhints.flags = InputHint;
X
X   XSetWMHints(d, w, &wmhints);
X
X   XStoreName(d, w,"Input-Test");
X   XSetIconName(d, w, "Input-Test");
X
X   XMapRaised(d, w);
X
X   XSync(d, False);
X
X   XSelectInput(d,w, ExposureMask|PointerMotionMask|
X                     ButtonPressMask|ButtonReleaseMask|
X                     KeyPressMask| StructureNotifyMask );
X
X   XFlush(d);
X
X   while(0==0) /* endless loop */
X   {
X      if (XPending(d))
X      {
X         while (XPending(d))
X            XNextEvent(d, &ev);
X
X         switch(ev.type)
X         {
X            case KeyPress:
X            {
X               for (index=0;index<4;index++)
X	       {
X                  dummy_string = 
X                        XKeysymToString(XLookupKeysym(&ev.xkey, index));
X
X                  printf("Keysym-string(index=%d) == \"%s\".\n",
X                                                   index, dummy_string);
X	       }
X               printf("\n");
X               break;
X            }
X	    default:
X               break;
X         }
X      }
X   }
X}
E!O!F! xstrek/strek_keysym_string.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@agd.fhg.de    pfuetzner@zgdvda.UUCP    XBR1YD3U@DDATHD21.BITNET

--
Dan Heller
------------------------------------------------
O'Reilly && Associates		ZipCode Software
Senior Writer			       President
argv@ora.com			argv@zipcode.com