[comp.sources.x] v11i097: Another Star Trek Game, Part11/14

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

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

#!/bin/sh
# To unshare, sh or unshar this file
echo xstrek/strek.doc 1>&2
sed -e 's/^X//' > xstrek/strek.doc <<'E!O!F! xstrek/strek.doc'
X
X       *********************************************************************
X       *****                                                           *****
X       *****                  STAR TREK VERSION 3.0                    *****
X       *****                                                           *****
X       *****                        written by                         *****
X       *****                                                           *****
X       *****                   Justin S. Revenaugh                     *****
X       *****                                                           *****
X       *****                          8/85                             *****
X       *****                                                           *****
X       *****           Massachusetts Institute of Technology           *****
X       *****   Department of Earth, Atmospheric and Planetary Science  *****
X       *****                                                           *****
X       *********************************************************************
X    
X    
X    
X    FEATURES
X    
X    Star Trek V. 2.0 (STREK) is a fully  three-dimensional  graphically oriented
X    space battle game. Some of its features are:  real  time  graphics  as  seen
X    through  a  limited viewport, an active scanner showing planar slices of the
X    surrounding space and a permanent data base  that  not  only  stores  player
X    names, ship names and scores but also accommodates real time ship repairs. 
X    
X    
X    INTRODUCTION
X    
X    As  the player you are captain of a Federation ship armed to the hilt with a
X    tractor beam, phaser banks  and  many  photon  torpedoes.  Your  mission  is
X    twofold:  you  are  to  eliminate enemy ships (namely Romulans and Klingons)
X    that have invaded Federation space while  also  defending  the  neutral  and
X    unarmed  Nemian Freighters. You begin (and end, if you survive) each mission
X    just outside your starbase which is impervious to all attacks. What  you  do
X    from then on is strictly up to you. 
X    
X    
X    OVERVIEW
X    
X    Your  ship,  as  well as all others, moves in three dimensions. To represent
X    this STREK uses two angles and a position vector. The position vector  is  a
X    triplet  X,  Y  and  Z. Z is defined as the spin axis of the starbase and is
X    right-handed in the sense of Z = X x Y. These positions  are  shown  on  the
X    top bar of the display panel. The starbase is always at (0, 0, 0). The first
X    angle is AZM (for azimuth), it is  the  counter-clockwise  rotation  in  the
X    plane  defined  by  X  and  Y,  measured  from  the Y axis. Thus an AZM of 0
X    implies that the ship is facing in the positive Y direction.  While  an  AZM
X    of  270  implies  the ship is facing in the positive X direction. The second
X    angle is called (confusingly) ANGLE. ANGLE  is  the  rotation  of  the  ship
X    about  the  X  axis measured from Y and positive towards Z. An ANGLE of zero
X    means the ship is not dipping but instead lies in the XY plane. An ANGLE  of
X    90  means  the ship is headed in the positive Z direction. These coordinates
X    are important mostly for internal book-keeping. What are more important  are
X    the  scanner  coordinates  which  are much more intuitive and easier to use.
X    These are defined by the  player's ship. In this frame Y  is  the  direction
X    of  ship propagation, X is positive to the right and Z positive upwards. For
X    example let's take an enemy ship to be directly in front of the player  ship
X    at  a  range  of  100  (arbitrary units). If the scanner is locked on it its
X    coordinates would be X = 0, Y = 100, Z = 0. If it appeared  to  be  slightly
X    to  the  right of center of the screen and slightly above the middle as well
X    its coordinates might be X = 50, Y = 100, Z = 50. Anything  that  is  behind
X    the player ship has a negative Y coordinate. 
X    
X    
X    CHANGING POSITIONS
X    
X    To  change  positions  one must have a velocity. The ship's initial velocity
X    is zero. To change this use either of the following keys: 'a'  which  always
X    makes  the  velocity  larger  (if  it is currently negative it makes it less
X    so), and 's' which always makes the velocity  smaller.  Both  increment  the
X    velocity  (or  speed  to  be  more correct) by 1, the ship's limit is -10 <=
X    velocity <= 10.  Any attempt to exceed these  bounds  will  be  met  with  a
X    message  from engineering.  To change the ship's AZM and ANGLE is also easy,
X    'u' rotates the ship's ANGLE positively (from Y  to  Z  as  defined  by  the
X    starbase),  'n'  rotates  the  ANGLE  negatively, 'h' rotates the ship's AZM
X    positively (from X to Y) and  'j'  which  rotates  the  AZM  negatively.  In
X    addition  there  are two turning modes: discreet and continuous. In discreet
X    mode hitting one of the above turning keys will result in a 2 degree  change
X    in  the  associated  angle.  In  continuous  mode the angle will change by 1
X    degree every turn (update loop) until another turning key is hit or  'm'  is
X    hit  which stops the rotation. To switch between these two modes use the key
X    'b' (like 'm' this  will  also  stop  continuous  rotations).  The  ship  is
X    initially in the continuous mode. 
X    
X    
X    ATTACK FUNCTIONS
X    
X    Your  ship  has  three weapons in its arsenal, namely a tractor beam, phaser
X    banks and photon torpedoes. Your tractor beam has  a  unlimited  range,  but
X    its  energy  use is proportional to the range of the object it holds. It can
X    be used to bring Nemians to the starbase  so  they  can  dock,  or  to  stop
X    photon  torpedoes  (or even re-aim your photons that will otherwise miss the
X    mark). It is omni-directional (i.e. can be used to hold objects behind  your
X    ship).  To  use  the  tractor  beam  type  't' followed by the number of the
X    object to hold (1 for Nemians, 4 through 9 for photons, this number will  be
X    displayed  briefly  at  the  center  of  the object after you type 't'). The
X    secondary input is timed, if you wait too long the 't' command  is  dropped,
X    if  you  do  successfully  lock on the com panel will respond with something
X    like 'Nemian Freighter in tractor beam'. To drop  a  tractor  beam  lock  on
X    simply  type 'r'. If the object in your tractor beam is destroyed (or docked
X    as can happen with Nemians) then the tractor lock on  will  be  dropped  for
X    you. 
X    
X    The  phasers  work  similarly  to  the  tractor  beam. They are activated by
X    typing 'p'. The number of all visible  objects  will  be  displayed  briefly
X    during  which  time  you  will  be asked which one you want to lock onto. By
X    typing the number of the object the phaser control will  aim  and  fire  the
X    phasers  automatically.   The  phasers  can  only aim at objects seen in the
X    viewport and with range less than 500. Phasers are  expensive  in  terms  of
X    energy  and  the  damage  they  do attenuates quickly with increasing target
X    range.  After  every use they will go down briefly,  during  this  time they 
X    cannot be used. 
X    
X    Photon  torpedoes are fired by typing 'f', they assume a course identical to
X    the ship's and a speed of 20. Once fired their heading can only  be  changed
X    by  rotating  them  in the tractor beam. Photons have a maximum range of 600
X    units after which they deactivate.  A  photon  torpedo  will explode when it
X    reaches a certain distance from an enemy ship, this distance  can be changed
X    by using the 'e' key and quickly answering with the desired  option.  Photon
X    damage  also  depends  on  range to the target but only upon exploding (i.e.
X    distance covered before  exploding  is  not  relevant),  thus  changing  the
X    trigger  radius  via  the 'e' key also changes the minimum expectable damage
X    (setting it to option 1 increases the minimum damage by quite a bit, but  it
X    also  increases the odds of missing the target). Photons must be at least 30
X    units away from the parent ship before exploding. Initially you have  twenty
X    photons. 
X    
X    
X    SCANNER FUNCTIONS
X    
X    Your  scanner  can  only be locked on to one object at a time, to change the
X    lock on simply type the number of the desired object. If  it  is  found  the
X    com panel will report the lock on. The objects are numbered:
X    
X     0     Starbase
X     1     Nemian Freighter
X     2     Enemy Ship
X     3     Second Enemy Ship
X     4-6   Enemy Photons
X     7-9   Player's Photons
X    
X    
X    NAVIGATION FUNCTIONS
X    
X    Your  ship's  scanner can navigate your ship for you. To summon this ability
X    type 'l' followed  quickly  by  the  object  number  you  wish  to  navigate
X    towards.   The  ship's  turning  keys  then  become inactive as the computer
X    rotates the ship.  You still control the velocity  and  must  do  so  wisely
X    else  the  computer  navigation will be poor. You should attempt to set your
X    speed low initially while the computer does gross ship adjustments.  Further
X    you  should  set  your velocity either positive or negative as will minimize
X    the amount of rotation the ship must do. For  example,  say  you  lock  onto
X    your  base  which  is  both behind and slightly below you, you would want to
X    set your velocity to -1 or -2. If it was in front of you 0, 1 or 2 would  be
X    best. 
X    
X    Lock  ons  are  automatically  dropped  when the object of the lock on has a
X    range of less than 100 units. You can drop a lock on at any time  by  typing
X    'o'. 
X    
X    
X    GENERAL FUNCTIONS
X    
X    You  can  dock  your  ship for repairs by being within 30 range units of the
X    starbase traveling at a speed of  2,  1,  0,  -1,  -2  and  typing  'd'.  If
X    successful  the  starbase will dock you and report the projected repair date
X    for your ship as well as your score. 
X    
X    You can review your current score at any time  by  typing  'c'.  Typing  'i'
X    will  display  the  damage  status  of  your ship. 
X    
X    
X    THE DISPLAY
X    
X    The ship's display is mostly self explanatory, however some  description  is
X    needed.  The  left hand panel is the weapons panel. It reports the number of
X    photon torpedoes left, the current energy status, the phaser status and  the
X    tractor  beam  status.  Phasers  can  only  be  used  when the display reads
X    'active'.  When the tractor status reads 'active' it is in use. 
X    
X    The top panel as discussed before gives the  ship  speed  and  postion  with
X    respect to the coordinate frame defined by the starbase. 
X    
X    The  right panel is the scanner panel. The scanner is up and working when it
X    reads 'active'. X Coor, Y Coor and Z  Coor  are  the  current  X,  Y  and  Z
X    coordinates  of  the  object being scanned expressed in the coordinate frame
X    defined by the  player's ship. 
X    
X    Below these you will find two circular windows. Each of these is a slice  of
X    the  surrounding  space showing the projected location of all objects within
X    a range of 600 units. The top window is interpreted as  follows.  Your  ship
X    is  in  the  center (small dot),  upward  from  the center is the positive Y
X    direction, to the right is the positive X direction, thus a  object  in  the
X    first  quadrant  is  both  ahead  and  to the right of the ship. This window
X    carries no information about Z. The bottom display again  has  the  player's
X    ship  at the center but now upward is in the positive Z direction and to the
X    right is the positive Y direction. Practice  will  make  you  more  comfort-
X    able with this display. 
X    
X    On  the  bottom  is  the communications panel wherein messages from the crew
X    will be displayed. Typing 'z' at any time  will  clear  this  panel  of  all
X    messages. 
X    
X    
X    ENERGY
X    
X    Your  ship's  engines  produce energy which is stored in the ships batteries
X    until needed. Most of the attack and navigation  functions  consume  energy,
X    as  does  damage taken as a result of enemy attacks. If your energy drops to
X    zero or less your ships life-support system may fail. If this should  happen
X    your  crew will die and the game is over, thus energy conservation is of the
X    utmost importance. 
X    
X    
X    DAMAGE
X    
X    Damage taken to the ship drops the ship's current energy and  also  curtails
X    the  output of the engines, the storage capabilities of the battery, and can
X    even deactivate the phasers, tractor beam and scanner. After you dock,  this
X    damage  must  be repaired before you can pilot the ship again. Normal damage
X    can take 1 to 2 days to repair, while severe damage  may take as many  as  5 
X    days. During this  time  the ship will be inactive and any attempt to use it
X    will be futile. 
X    
X    
X    THE ENEMY
X    
X    There are two enemies of the Federation:  the  Klingons  and  the  Romulans.
X    Both  have  ships that are comparable in arms, more maneuverable but able to
X    withstand less damage than Federation ships. They will most often rush  your
X    ship,  but  they have been known to attack the neutral Nemian Freighters who
X    you are defending.  Klingons always travel alone and have both  phasers  and
X    a small  number  of  photons,  Romulans  often travel in pairs and have only
X    photons. If you have never  watched Star  Trek it may help you to  know that
X    Klingons ships  have  a  long  neck  holding  the control deck and two large
X    rectangular engine pods. Romulans ships are sleek and small with two spheri-
X    cal pods on either side. 
X    
X    
X    NEMIANS
X    
X    Nemian freighters must be defended from the enemy ships. This  can  be  done
X    in two ways: by taking them to the starbase in your tractor beam and  making
X    them  dock (they have the same docking rules  but you needn't type 'd'),  or
X    by destroying the enemy before he can attack the Nemians. There will  always
X    be one Nemian in the  vicinity of  your  ship. Nemian ships resemble garbage 
X    trucks. 
X    
X    
X    SCORING
X    
X    Destroying Klingons and Romulans scores 300 points.
X    Destroying a Nemian (whether you or the enemy does it) scores -200 points.
X    Docking a Nemian scores 500 points.
X    
X    The top ten scores are based on cumulative scores only. 
X    
X    
X    CHANGING THE KEY DEFINITIONS
X    
X    Another  feature of STREK is the user's ability to change the definitions of
X    the keys used in STREK. Before showing how this  is  done  some  terminology
X    must  be explained.  A flag is a letter or number that STREK recognizes as a
X    command, namely 'a', 'u',  '1', etc (as given above). A keystroke or key  is
X    the  key  typed  by  the  user.  By  default  all  keystrokes  are literally
X    interpreted as flags, i.e. typing the key 'a' tells STREK  to  evaluate  the
X    'a'  flag.  While the user cannot change the interpretation of flags, he/she
X    can change the interpretation of the keystrokes. This means,  for   example,
X    that  the user can define the keyboard's <F1> key to be interpreted as a 'p'
X    flag. Thus if the user types <F1> it is the same as  typing  'p'.  In  total
X    there are 90 keys that can be redefined. 
X    
X    A  player's  key  definitions  are  kept  in a file which is loaded prior to
X    actual game play. This file can be  created  by  running  STREK_CREATE_FORM.
X    The  program  creates  a  file that contains a blank key definition form. To
X    use this form, simply type the STREK flag next to the  key  that  is  to  be
X    redefined.  All  the  keys  listed  can be redefined (even ones that are the
X    default flags such as 'a' and 'u'). If a  key's  definition  is  not  to  be
X    changed  then  leave its definition blank. As an example of a key definition
X    file see STREK_KEY_DEFS. To understand the code for the keys, i.e  what  l1,
X    r1,  f1u, etc mean, read the APOLLO documentation of the KD command (this is
X    a standard display manager command which  allows  the  user  to  change  the
X    definition of the keys). 
X    
X    
X    HELPFUL HINTS
X    
X    First  and  foremost  get  familiar  with  the  controls  and  how your ship
X    responds.  This alone will do the most for your caliber of  play.  Once  you
X    have mastered the controls the following tactics may help. 
X    
X    1. Keep The enemy ships in front of you.  Your ship's firing arc covers only
X       the portion of space visible in the viewport,  thus to  hit the enemy you
X       must be able to see him.
X    
X    2. Never sit still in space unless your ship's energy level is critical.
X    
X    3. Be aggressive, follow the enemy ships. Don't wait for them to come to you. 
X    
X    4. When your energy level drops below 300 start heading back to the starbase.
X    
X    5. Only  tractor Nemians  when you feel you can outrun the enemy. Nemians in
X       the ship's tractor beam don't last long under enemy fire.
X    
X    6. Use your  photons. Although it may be difficult to hit with them at first
X       it will become easier with practice. 
X
X
X    CHANGES IN VERSION 3.0
X
X    The displays of AZM and  ANGLE have  been  removed and replaced with several 
X    indicators  which light when  enemy ships are  under scan, energy is  low or 
X    the navigation computer is locked on. 
X
X
X    TECHNICAL DETAILS
X    
X    STREK  is written entirely in FORTRAN 77 using GPR graphics. Designed to run
X    on DN 460s and 660s, its performance on slower nodes (such as  DN  320s)  is
X    adequate at best. Compiling with the -cpu ??? option helps somewhat. 
X    
X
X    ADDENDA
X
X    Typing '/' puts the game on hold until another key is hit (if using  the key
X    redefinition  options  do  not  assign  this to a key  with an up transition
X    definition).
E!O!F! xstrek/strek.doc
echo xstrek/strek.install 1>&2
sed -e 's/^X//' > xstrek/strek.install <<'E!O!F! xstrek/strek.install'
X
X    *********************************************************************
X    *****                                                           *****
X    *****                  STAR TREK VERSION 3.0                    *****
X    *****                                                           *****
X    *****                        written by                         *****
X    *****                                                           *****
X    *****                   Justin S. Revenaugh                     *****
X    *****                                                           *****
X    *****                          7/87                             *****
X    *****                                                           *****
X    *****          Massachussetts Institute of Technology           *****
X    *****   Department of Earth, Atmospheric and Planetary Science  *****
X    *****                                                           *****
X    *********************************************************************
X
X    Strek and its six subroutine files all need to be compiled with
X    the cpu xxx switch (more later), the included file strek.bld will
X    do all compilations and binding necessary.
X
X    An addition program called STREK_STARTUP_DB must be run to initialize
X    the STREK database. To do this, simply run STREK_STARTUP_DB in the
X    directory where STREK will be kept. It will create two files: 
X    STREK_INFO and STREK_TOP_SCORES. STREK_INFO keeps the ship's registry 
X    which includes player names, ship names, scores and ship repair dates. 
X    STREK_TOP_SCORES is a record of the top ten cumulative scores.
X
X    STREK_CREATE_FORM can be used at any time, this program creates a blank
X    STREK key definition form.
X
X    STREK_PRUNE_DB should be used anytime the database grows too large.
X    This program deletes all retired ships from the registry and any ship
X    that has not been used for more than a month or so.
X
X    STREK_STATS can be run anytime. This program prints out the contents of
X    the STREK database to the screen.
E!O!F! xstrek/strek.install
echo xstrek/strek_bld 1>&2
sed -e 's/^X//' > xstrek/strek_bld <<'E!O!F! xstrek/strek_bld'
X#
X# compile all source codes
X#
Xftn strek_main -cpu ^1 
Xftn strek_db_subs -cpu ^1 -opt 4
Xftn strek_enemy_subs -cpu ^1 -opt 4
Xftn strek_ships_subs -cpu ^1 -opt 4
Xftn strek_random_subs -cpu ^1 -opt 4
Xftn strek_graphics_subs -cpu ^1 -opt 4
Xftn strek_keydef_subs -cpu ^1 -opt 4
Xftn strek_startup_db -cpu ^1 -opt 4
Xftn strek_prune_db 
Xftn strek_create_form 
Xftn strek_stats
X#
X# build the main game
X# 
Xbind <<!
Xstrek_main.bin -b strek_^1
Xstrek_db_subs.bin
Xstrek_enemy_subs.bin
Xstrek_ships_subs.bin
Xstrek_random_subs.bin
Xstrek_graphics_subs.bin
Xstrek_keydef_subs.bin
X!
X#
X# build the program to look at the database
X#
Xbind <<!
Xstrek_stats.bin -b strek_stats
Xstrek_db_subs.bin
Xstrek_graphics_subs.bin
Xstrek_keydef_subs.bin
X!
X#
X# build utilities
X#
Xbind strek_create_form.bin -b strek_create_form
Xbind strek_startup_db.bin -b strek_startup_db
Xbind strek_prune_db.bin -b strek_prune_db
X#
X# delete the bin files
X#                     
X#dlf strek_main.bin
X#dlf strek_db_subs.bin
X#dlf strek_enemy_subs.bin
X#dlf strek_ships_subs.bin
X#dlf strek_random_subs.bin
X#dlf strek_graphics_subs.bin
X#dlf strek_keydef_subs.bin
X#dlf strek_startup_db.bin
X#dlf strek_prune_db.bin
X#dlf strek_create_form.bin
X#dlf strek_stats.bin
E!O!F! xstrek/strek_bld
echo xstrek/strek_create_form.c 1>&2
sed -e 's/^X//' > xstrek/strek_create_form.c <<'E!O!F! xstrek/strek_create_form.c'
X/* strek_create_form.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    /* Initialized data */
X
X    static char key_name__[5*90+1] = "a    b    c    d    e    f    g    h  \
X  i    j    k    l    m    n    o    p    q    r    s    t    u    v    w   \
X x    y    z    l1   l2   l3   l4   l5   l6   l7   l8   l9   la   lb   lc   \
Xld   le   lf   l1a  l2a  l3a  l1u  l2u  l3u  l4u  l5u  l6u  l7u  l8u  l9u  l\
Xau  lbu  lcu  ldu  leu  lfu  l1au l2au l3au f1   f2   f3   f4   f5   f6   f7\
X   f8   f1u  f2u  f3u  f4u  f5u  f6u  f7u  f8u  r1   r2   r3   r4   r5   r6 \
X  space,    .    /    ;    [    ";
X
X    /* Format strings */
X    static char fmt_100[] = "(\002enter character definition in column 7\002)"
X	    ;
X    static char fmt_110[] = "(\002e.g.  x\002)";
X
X    /* System generated locals */
X    olist o__1;
X    cllist cl__1;
X
X    /* Builtin functions */
X    integer s_wsle(), do_lio(), e_wsle(), s_rsfe(), do_fio(), e_rsfe(), 
X	    f_open(), s_wsfe(), e_wsfe(), f_clos();
X    /* Subroutine */ int s_stop();
X
X    /* Local variables */
X    static char key_file__[256];
X    static integer j;
X
X    /* Fortran I/O blocks */
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, 6, 0, 0, 0 };
X    static cilist io___7 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___9 = { 0, 1, 0, fmt_100, 0 };
X    static cilist io___10 = { 0, 1, 0, fmt_110, 0 };
X    static cilist io___12 = { 0, 1, 0, "(a5)", 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_CREATE_FORM creates a key defs form for use in STREK */
X
X/*    version 1 */
X/*                                         -jsr 8/85 */
X
X
X/*    keynames in order */
X
X
X/*   request file pathname, open and write to it */
X
X    s_wsle(&io___2);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___3);
X    do_lio(&c__9, &c__1, "This program creates a key definition form for use\
X with", 55L);
X    e_wsle();
X    s_wsle(&io___4);
X    do_lio(&c__9, &c__1, "Strek.", 6L);
X    e_wsle();
X    s_wsle(&io___5);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___6);
X    do_lio(&c__9, &c__1, "Enter the desired pathname of the form (<256 char.\
X).", 52L);
X    e_wsle();
X    s_rsfe(&io___7);
X    do_fio(&c__1, key_file__, 256L);
X    e_rsfe();
X    o__1.oerr = 0;
X    o__1.ounit = 1;
X    o__1.ofnmlen = 256;
X    o__1.ofnm = key_file__;
X    o__1.orl = 0;
X    o__1.osta = 0;
X    o__1.oacc = 0;
X    o__1.ofm = 0;
X    o__1.oblnk = 0;
X    f_open(&o__1);
X    s_wsfe(&io___9);
X    e_wsfe();
X    s_wsfe(&io___10);
X    e_wsfe();
X    for (j = 1; j <= 90; ++j) {
X	s_wsfe(&io___12);
X	do_fio(&c__1, key_name__ + (j - 1) * 5, 5L);
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_create_form__ () { MAIN__ (); }
E!O!F! xstrek/strek_create_form.c
echo xstrek/strek_db_subs.c 1>&2
sed -e 's/^X//' > xstrek/strek_db_subs.c <<'E!O!F! xstrek/strek_db_subs.c'
X/* strek_db_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/* Common Block Declarations */
X
Xstruct {
X    char means[256];
X} key_defs__;
X
X#define key_defs__1 key_defs__
X
X/* Table of constant values */
X
Xstatic integer c__1 = 1;
Xstatic integer c__9 = 9;
Xstatic integer c__3 = 3;
Xstatic integer c__0 = 0;
X
X/* Subroutine */ int strek_write__(new_, ship_name__, user_name__, 
X	capt_name__, nick_name__, key_file__, ship_avail__, last_score__, 
X	cum_score__, ship_active__, top_ten__, ship_name_len, user_name_len, 
X	capt_name_len, nick_name_len, key_file_len)
Xlogical *new_;
Xchar *ship_name__, *user_name__, *capt_name__, *nick_name__, *key_file__;
Xinteger *ship_avail__, *last_score__, *cum_score__;
Xlogical *ship_active__, *top_ten__;
Xftnlen ship_name_len;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen key_file_len;
X{
X    /* Format strings */
X    static char fmt_110[] = "(a10,a10,a30,i10)";
X
X    /* System generated locals */
X    integer i__1;
X    olist o__1;
X    cllist cl__1;
X    alist al__1;
X    inlist ioin__1;
X
X    /* Builtin functions */
X    integer s_cmp(), f_inqu(), f_open(), s_rdue(), do_uio(), e_rdue(), s_wdue(
X	    ), e_wdue(), f_clos(), s_rsfe(), do_fio(), e_rsfe(), f_rew();
X    /* Subroutine */ int s_copy();
X    integer s_wsfe(), e_wsfe();
X
X    /* Local variables */
X    static char temp[30];
X    static integer ship_retired__, i, j, k;
X    static char ctemp[10*10];
X    static integer count;
X    static char stemp[30*10];
X    static integer num_lines__;
X    static char my_tmp__[10*10];
X    static real status;
X    static integer top_scores__[10];
X    static logical fyn;
X
X    /* Fortran I/O blocks */
X    static cilist io___4 = { 0, 1, 0, 0, 1 };
X    static cilist io___6 = { 0, 1, 0, 0, 1 };
X    static cilist io___7 = { 0, 1, 0, 0, 0 };
X    static cilist io___9 = { 0, 1, 0, 0, 1 };
X    static cilist io___11 = { 0, 1, 0, 0, 0 };
X    static cilist io___13 = { 0, 1, 0, 0, 0 };
X    static cilist io___15 = { 0, 2, 0, fmt_110, 0 };
X    static cilist io___21 = { 0, 2, 0, fmt_110, 0 };
X    static cilist io___22 = { 0, 2, 0, fmt_110, 0 };
X    static cilist io___23 = { 0, 2, 0, fmt_110, 0 };
X
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_WRITE updates the two STREK info files (strek_info and */
X/*    strek_top_scores). If (new) then a name is appended, else the */
X/*    name is updated. */
X
X
X
X/*    if ship name is blank then return */
X
X    /* Parameter adjustments */
X    --ship_avail__;
X
X    /* Function Body */
X    if (s_cmp(ship_name__, " ", 30L, 1L) == 0) {
X	*top_ten__ = FALSE_;
X	return 0;
X    }
X
X/*    open up strek_info file */
X
X    ioin__1.inerr = 0;
X    ioin__1.infilen = 30;
X    ioin__1.infile = "/usr/lib/X11/xstrek/strek_info";
X    ioin__1.inex = &fyn;
X    ioin__1.inopen = 0;
X    ioin__1.innum = 0;
X    ioin__1.innamed = 0;
X    ioin__1.inname = 0;
X    ioin__1.inacc = 0;
X    ioin__1.inseq = 0;
X    ioin__1.indir = 0;
X    ioin__1.infmt = 0;
X    ioin__1.inform = 0;
X    ioin__1.inunf = 0;
X    ioin__1.inrecl = 0;
X    ioin__1.innrec = 0;
X    ioin__1.inblank = 0;
X    f_inqu(&ioin__1);
X    if (! fyn) {
X	status = (float)1.;
X	return 0;
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 = "old";
X    o__1.oacc = "direct";
X    o__1.ofm = "unformatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X    ioin__1.inerr = 0;
X    ioin__1.infilen = 36;
X    ioin__1.infile = "/usr/lib/X11/xstrek/strek_top_scores";
X    ioin__1.inex = &fyn;
X    ioin__1.inopen = 0;
X    ioin__1.innum = 0;
X    ioin__1.innamed = 0;
X    ioin__1.inname = 0;
X    ioin__1.inacc = 0;
X    ioin__1.inseq = 0;
X    ioin__1.indir = 0;
X    ioin__1.infmt = 0;
X    ioin__1.inform = 0;
X    ioin__1.inunf = 0;
X    ioin__1.inrecl = 0;
X    ioin__1.innrec = 0;
X    ioin__1.inblank = 0;
X    f_inqu(&ioin__1);
X    if (! fyn) {
X	status = (float)1.;
X	return 0;
X    }
X    o__1.oerr = 0;
X    o__1.ounit = 2;
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 = "old";
X    o__1.oacc = 0;
X    o__1.ofm = "formatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X
X/*    if new then update num_lines and append info */
X
X    if (*ship_active__) {
X	ship_retired__ = 0;
X    } else {
X	ship_retired__ = 1;
X    }
X    if (*new_) {
X	s_rdue(&io___4);
X	do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X	e_rdue();
X	++num_lines__;
X	s_wdue(&io___6);
X	do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X	e_wdue();
X	io___7.cirec = num_lines__ + 1;
X	s_wdue(&io___7);
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], (ftnlen)sizeof(integer));
X	}
X	do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer));
X	do_uio(&c__1, (char *)&(*cum_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    } else {
X
X/*    name is old, find it and update */
X
X	s_rdue(&io___9);
X	do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X	e_rdue();
X	count = 1;
XL10:
X	io___11.cirec = count + 1;
X	s_rdue(&io___11);
X	do_uio(&c__1, temp, 30L);
X	e_rdue();
X	if (s_cmp(temp, ship_name__, 30L, 30L) == 0) {
X	    io___13.cirec = count + 1;
X	    s_wdue(&io___13);
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], (ftnlen)sizeof(
X			integer));
X	    }
X	    do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer));
X	    do_uio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer));
X	    do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer));
X	    e_wdue();
X	    goto L20;
X	}
X	if (count == num_lines__) {
X	    cl__1.cerr = 0;
X	    cl__1.cunit = 1;
X	    cl__1.csta = 0;
X	    f_clos(&cl__1);
X	}
X	++count;
X	goto L10;
XL20:
X	cl__1.cerr = 0;
X	cl__1.cunit = 1;
X	cl__1.csta = 0;
X	f_clos(&cl__1);
X    }
X
X/*    determine if the score is a top ten score */
X
X    for (j = 1; j <= 10; ++j) {
X	s_rsfe(&io___15);
X	do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L);
X	do_fio(&c__1, ctemp + (j - 1) * 10, 10L);
X	do_fio(&c__1, stemp + (j - 1) * 30, 30L);
X	do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof(integer));
X	e_rsfe();
X/* L30: */
X    }
X    al__1.aerr = 0;
X    al__1.aunit = 2;
X    f_rew(&al__1);
X    i = 1;
X    *top_ten__ = FALSE_;
XL40:
X    if (*cum_score__ > top_scores__[i - 1]) {
X	*top_ten__ = TRUE_;
X	goto L50;
X    }
X    if (i == 10) {
X	goto L50;
X    }
X    ++i;
X    goto L40;
XL50:
X    if (*top_ten__) {
X
X/*    see if ship is already on the list */
X
X	i__1 = i - 1;
X	for (j = 1; j <= i__1; ++j) {
X	    if (s_cmp(stemp + (j - 1) * 30, ship_name__, 30L, 30L) == 0) {
X		*top_ten__ = FALSE_;
X		cl__1.cerr = 0;
X		cl__1.cunit = 2;
X		cl__1.csta = 0;
X		f_clos(&cl__1);
X		return 0;
X	    }
X/* L55: */
X	}
X	for (j = i; j <= 10; ++j) {
X	    if (s_cmp(stemp + (j - 1) * 30, ship_name__, 30L, 30L) == 0) {
X
X/*    move everybody up one to delete the duplicate entry */
X
X		for (k = j; k <= 9; ++k) {
X		    s_copy(my_tmp__ + (k - 1) * 10, my_tmp__ + k * 10, 10L, 
X			    10L);
X		    s_copy(stemp + (k - 1) * 30, stemp + k * 30, 30L, 30L);
X		    s_copy(ctemp + (k - 1) * 10, ctemp + k * 10, 10L, 10L);
X		    top_scores__[k - 1] = top_scores__[k];
X/* L70: */
X		}
X	    }
X/* L60: */
X	}
X
X/*    write out the new list, note that a ship that was previously */
X/*    on the list and who's score drops as a result of a mission */
X/*    will remain on the list. */
X
X	i__1 = i - 1;
X	for (j = 1; j <= i__1; ++j) {
X	    s_wsfe(&io___21);
X	    do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L);
X	    do_fio(&c__1, ctemp + (j - 1) * 10, 10L);
X	    do_fio(&c__1, stemp + (j - 1) * 30, 30L);
X	    do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof(
X		    integer));
X	    e_wsfe();
X/* L80: */
X	}
X	s_wsfe(&io___22);
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 *)&(*cum_score__), (ftnlen)sizeof(integer));
X	e_wsfe();
X	for (j = i; j <= 9; ++j) {
X	    s_wsfe(&io___23);
X	    do_fio(&c__1, my_tmp__ + (j - 1) * 10, 10L);
X	    do_fio(&c__1, ctemp + (j - 1) * 10, 10L);
X	    do_fio(&c__1, stemp + (j - 1) * 30, 30L);
X	    do_fio(&c__1, (char *)&top_scores__[j - 1], (ftnlen)sizeof(
X		    integer));
X	    e_wsfe();
X/* L90: */
X	}
X    }
X    cl__1.cerr = 0;
X    cl__1.cunit = 2;
X    cl__1.csta = 0;
X    f_clos(&cl__1);
X    return 0;
X} /* strek_write__ */
X
X/* Subroutine */ int strek_review__(ship_name__, user_name__, capt_name__, 
X	nick_name__, ship_avail__, cum_score__, last_score__, ship_active__, 
X	key_file__, status, ship_name_len, user_name_len, capt_name_len, 
X	nick_name_len, key_file_len)
Xchar *ship_name__, *user_name__, *capt_name__, *nick_name__;
Xinteger *ship_avail__, *cum_score__, *last_score__;
Xlogical *ship_active__;
Xchar *key_file__;
Xinteger *status;
Xftnlen ship_name_len;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen key_file_len;
X{
X    /* System generated locals */
X    olist o__1;
X    cllist cl__1;
X    inlist ioin__1;
X
X    /* Builtin functions */
X    integer f_inqu(), f_open(), s_rdue(), do_uio(), e_rdue(), s_cmp(), f_clos(
X	    );
X
X    /* Local variables */
X    static char temp[30];
X    static integer ship_retired__, i, count, num_lines__;
X    static logical fyn;
X
X    /* Fortran I/O blocks */
X    static cilist io___25 = { 0, 1, 0, 0, 1 };
X    static cilist io___28 = { 0, 1, 0, 0, 0 };
X    static cilist io___30 = { 0, 1, 0, 0, 0 };
X
X
X
X/*     STREK_REVIEW reviews the STREK database which includes */
X/*     ships, shipnames, captains, cumulative scores, ship avail- */
X/*     ability times and last outing scores. File is hardwired to */
X/*     be STREK_INFO. The file structure is as follows: */
X
X/*     line 1 number of lines (i8) */
X
X/*     lines 2 - last: */
X
X/*     shipname (char*30), captain (char*10), nickname (char*10), */
X/*     ship availability (3i*4), last outing score (i*10), cumu- */
X/*     lative score (i*10), ship active toggle (i*1). */
X
X/*     The file is direct access, and all new entries are appended */
X/*     to the end. */
X
X/*     A second file called STREK_TOP_SCORES is maintained. In it */
X/*     are the current ten best scores (ascii). The file is struct- */
X/*     ered: */
X
X/*     lines 1 - 10 captains name (char*10), shipname (char*30), and */
X/*     cumulative score (i*10). */
X
X
X/*     version 1 */
X/*                                     -jsr 8/85 */
X
X
X
X/*    open up strek_info file */
X
X    /* Parameter adjustments */
X    --ship_avail__;
X
X    /* Function Body */
X    *status = 0;
X    ioin__1.inerr = 0;
X    ioin__1.infilen = 30;
X    ioin__1.infile = "/usr/lib/X11/xstrek/strek_info";
X    ioin__1.inex = &fyn;
X    ioin__1.inopen = 0;
X    ioin__1.innum = 0;
X    ioin__1.innamed = 0;
X    ioin__1.inname = 0;
X    ioin__1.inacc = 0;
X    ioin__1.inseq = 0;
X    ioin__1.indir = 0;
X    ioin__1.infmt = 0;
X    ioin__1.inform = 0;
X    ioin__1.inunf = 0;
X    ioin__1.inrecl = 0;
X    ioin__1.innrec = 0;
X    ioin__1.inblank = 0;
X    f_inqu(&ioin__1);
X    if (! fyn) {
X	*status = 1;
X	return 0;
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 = "old";
X    o__1.oacc = "direct";
X    o__1.ofm = "unformatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X
X/*    read number of lines */
X
X    s_rdue(&io___25);
X    do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X    e_rdue();
X    count = 1;
XL10:
X    io___28.cirec = count + 1;
X    s_rdue(&io___28);
X    do_uio(&c__1, temp, 30L);
X    e_rdue();
X    if (s_cmp(temp, ship_name__, 30L, 30L) == 0) {
X	io___30.cirec = count + 1;
X	s_rdue(&io___30);
X	do_uio(&c__1, temp, 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], (ftnlen)sizeof(integer));
X	}
X	do_uio(&c__1, (char *)&(*last_score__), (ftnlen)sizeof(integer));
X	do_uio(&c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer));
X	do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer));
X	e_rdue();
X	goto L20;
X    }
X    if (count == num_lines__) {
X	cl__1.cerr = 0;
X	cl__1.cunit = 1;
X	cl__1.csta = 0;
X	f_clos(&cl__1);
X	*status = 2;
X	return 0;
X    }
X    ++count;
X    goto L10;
XL20:
X    cl__1.cerr = 0;
X    cl__1.cunit = 1;
X    cl__1.csta = 0;
X    f_clos(&cl__1);
X    if (ship_retired__ == 1) {
X	*ship_active__ = FALSE_;
X    } else {
X	*ship_active__ = TRUE_;
X    }
X    return 0;
X} /* strek_review__ */
X
X/* Subroutine */ int strek_question__(user_name__, capt_name__, nick_name__, 
X	ship_name__, key_file__, new_, user_name_len, capt_name_len, 
X	nick_name_len, ship_name_len, key_file_len)
Xchar *user_name__, *capt_name__, *nick_name__, *ship_name__, *key_file__;
Xlogical *new_;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen ship_name_len;
Xftnlen key_file_len;
X{
X    /* Builtin functions */
X    /* Subroutine */ int s_copy();
X    integer s_wsle(), do_lio(), e_wsle(), s_rsfe(), do_fio(), e_rsfe(), s_cmp(
X	    );
X
X    /* Local variables */
X    static integer j;
X    extern /* Subroutine */ int strek_parse_key_defs__();
X    static logical found;
X    extern /* Subroutine */ int strek_search_name__(), getusername_();
X
X    /* Fortran I/O blocks */
X    static cilist io___33 = { 0, 6, 0, 0, 0 };
X    static cilist io___34 = { 0, 6, 0, 0, 0 };
X    static cilist io___35 = { 0, 6, 0, 0, 0 };
X    static cilist io___36 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___37 = { 0, 6, 0, 0, 0 };
X    static cilist io___38 = { 0, 6, 0, 0, 0 };
X    static cilist io___39 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___40 = { 0, 6, 0, 0, 0 };
X    static cilist io___41 = { 0, 6, 0, 0, 0 };
X    static cilist io___42 = { 0, 6, 0, 0, 0 };
X    static cilist io___43 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___45 = { 0, 6, 0, 0, 0 };
X    static cilist io___47 = { 0, 6, 0, 0, 0 };
X    static cilist io___48 = { 0, 6, 0, 0, 0 };
X    static cilist io___49 = { 0, 6, 0, 0, 0 };
X    static cilist io___50 = { 0, 6, 0, 0, 0 };
X    static cilist io___51 = { 0, 6, 0, 0, 0 };
X    static cilist io___52 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___53 = { 0, 6, 0, 0, 0 };
X
X
X
X/*    STREK_QUESTION determines if the player has a ship or if he */
X/*    is new (or just a new ship). */
X
X/*    version 1 */
X/*                                -jsr 8/85 */
X
X
X/*    key definition common */
X
X    s_copy(nick_name__, " ", 10L, 1L);
X    getusername_(user_name__, 10L);
X
X/*    question captains */
X
X    s_wsle(&io___33);
X    do_lio(&c__9, &c__1, "STAR TREK v.3", 13L);
X    e_wsle();
X    s_wsle(&io___34);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___35);
X    do_lio(&c__9, &c__1, "What is your name, captain?", 27L);
X    e_wsle();
X    s_rsfe(&io___36);
X    do_fio(&c__1, capt_name__, 10L);
X    e_rsfe();
X    strek_search_name__(user_name__, capt_name__, ship_name__, key_file__, 
X	    new_, 10L, 10L, 30L, 256L);
X    if (*new_) {
X	s_wsle(&io___37);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	s_wsle(&io___38);
X	do_lio(&c__9, &c__1, "What do your friends call you sir?", 34L);
X	e_wsle();
X	s_rsfe(&io___39);
X	do_fio(&c__1, nick_name__, 10L);
X	e_rsfe();
XL10:
X	s_wsle(&io___40);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	s_wsle(&io___41);
X	do_lio(&c__9, &c__1, "Enter pathname of your key definition file.", 
X		43L);
X	e_wsle();
X	s_wsle(&io___42);
X	do_lio(&c__9, &c__1, "<return> for no file.", 21L);
X	e_wsle();
X	s_rsfe(&io___43);
X	do_fio(&c__1, key_file__, 256L);
X	e_rsfe();
X	if (s_cmp(key_file__, " ", 256L, 1L) != 0) {
X	    strek_parse_key_defs__(key_file__, &found, 256L);
X	    if (! found) {
X		s_wsle(&io___45);
X		do_lio(&c__9, &c__1, "The key definition file was not found,\
X try again.", 49L);
X		e_wsle();
X		goto L10;
X	    }
X	} else {
X	    for (j = 1; j <= 256; ++j) {
X		key_defs__1.means[j - 1] = j;
X/* L20: */
X	    }
X	}
X    } else {
X	if (s_cmp(key_file__, " ", 256L, 1L) != 0) {
X	    strek_parse_key_defs__(key_file__, &found, 256L);
X	    if (! found) {
X		s_wsle(&io___47);
X		do_lio(&c__9, &c__1, " ", 1L);
X		e_wsle();
X		s_wsle(&io___48);
X		do_lio(&c__9, &c__1, "The key definition file was not found,",
X			 38L);
X		e_wsle();
X		s_wsle(&io___49);
X		do_lio(&c__9, &c__1, "enter the pathname of another file.", 
X			35L);
X		e_wsle();
X		s_wsle(&io___50);
X		do_lio(&c__9, &c__1, "<return> for no file.", 21L);
X		e_wsle();
X		s_wsle(&io___51);
X		do_lio(&c__9, &c__1, " ", 1L);
X		e_wsle();
X		s_rsfe(&io___52);
X		do_fio(&c__1, key_file__, 256L);
X		e_rsfe();
X		if (s_cmp(key_file__, " ", 256L, 1L) != 0) {
X		    strek_parse_key_defs__(key_file__, &found, 256L);
X		}
X		if (! found || s_cmp(key_file__, " ", 256L, 1L) == 0) {
X		    for (j = 1; j <= 256; ++j) {
X			key_defs__1.means[j - 1] = j;
X/* L30: */
X		    }
X		}
X	    }
X	} else {
X	    for (j = 1; j <= 256; ++j) {
X		key_defs__1.means[j - 1] = j;
X/* L40: */
X	    }
X	}
X    }
X    s_wsle(&io___53);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    return 0;
X} /* strek_question__ */
X
X/* Subroutine */ int strek_ships__()
X{
X    /* Initialized data */
X
X    static char retired[10+1] = "retired   ";
X
X    /* Format strings */
X    static char fmt_100[] = "(\002STAR TREK Ship Registry as of \002,i4\
X,\002/\002,i2,\002/\002,i2)";
X    static char fmt_120[] = "(1x,a30,x,i10,5x,a7,i10)";
X    static char fmt_130[] = "(1x,a30,x,i10,2x,i4,\002/\002,i2,\002/\002,i2,i\
X10)";
X
X    /* System generated locals */
X    integer i__1;
X    olist o__1;
X    cllist cl__1;
X    inlist ioin__1;
X
X    /* Builtin functions */
X    integer f_inqu(), f_open(), s_wsle(), do_lio(), e_wsle(), s_wsfe(), 
X	    do_fio(), e_wsfe(), s_rdue(), do_uio(), e_rdue(), f_clos();
X
X    /* Local variables */
X    static char key_file__[256];
X    static integer ship_retired__, i, j;
X    static shortint decoded_clock__[6];
X    static char nick_name__[10], capt_name__[10], ship_name__[30], 
X	    user_name__[10];
X    static integer cum_score__, num_lines__, ship_avail__[3];
X    extern /* Subroutine */ int caldecodelocaltime_();
X    static integer last_score__;
X    static real status;
X    static logical fyn;
X
X    /* Fortran I/O blocks */
X    static cilist io___58 = { 0, 6, 0, 0, 0 };
X    static cilist io___59 = { 0, 6, 0, 0, 0 };
X    static cilist io___60 = { 0, 6, 0, fmt_100, 0 };
X    static cilist io___62 = { 0, 6, 0, 0, 0 };
X    static cilist io___63 = { 0, 6, 0, 0, 0 };
X    static cilist io___64 = { 0, 6, 0, 0, 0 };
X    static cilist io___65 = { 0, 1, 0, 0, 1 };
X    static cilist io___68 = { 0, 1, 0, 0, 0 };
X    static cilist io___78 = { 0, 6, 0, fmt_120, 0 };
X    static cilist io___79 = { 0, 6, 0, fmt_130, 0 };
X    static cilist io___80 = { 0, 6, 0, 0, 0 };
X    static cilist io___81 = { 0, 6, 0, 0, 0 };
X
X
X
X/*    STREK_SHIPS outputs the current ship list including the */
X/*    scores of their last outings. */
X
X/*    version 1 */
X/*                                                 -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X
X
X/*    get local time */
X
X    caldecodelocaltime_(decoded_clock__);
X
X/*    open database */
X
X    ioin__1.inerr = 0;
X    ioin__1.infilen = 30;
X    ioin__1.infile = "/usr/lib/X11/xstrek/strek_info";
X    ioin__1.inex = &fyn;
X    ioin__1.inopen = 0;
X    ioin__1.innum = 0;
X    ioin__1.innamed = 0;
X    ioin__1.inname = 0;
X    ioin__1.inacc = 0;
X    ioin__1.inseq = 0;
X    ioin__1.indir = 0;
X    ioin__1.infmt = 0;
X    ioin__1.inform = 0;
X    ioin__1.inunf = 0;
X    ioin__1.inrecl = 0;
X    ioin__1.innrec = 0;
X    ioin__1.inblank = 0;
X    f_inqu(&ioin__1);
X    if (! fyn) {
X	status = (float)1.;
X	return 0;
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 = "old";
X    o__1.oacc = "direct";
X    o__1.ofm = "unformatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X
X/*    print out header */
X
X    s_wsle(&io___58);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___59);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsfe(&io___60);
X    for (i = 1; i <= 3; ++i) {
X	do_fio(&c__1, (char *)&decoded_clock__[i - 1], (ftnlen)sizeof(
X		shortint));
X    }
X    e_wsfe();
X    s_wsle(&io___62);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___63);
X    do_lio(&c__9, &c__1, "SHIP NAME                      LAST SCORE   AVAILA\
XBLE     SCORE", 63L);
X    e_wsle();
X    s_wsle(&io___64);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_rdue(&io___65);
X    do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X    e_rdue();
X    i__1 = num_lines__ + 1;
X    for (j = 2; j <= i__1; ++j) {
X	io___68.cirec = j;
X	s_rdue(&io___68);
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(
X		    integer));
X	}
X	do_uio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer));
X	do_uio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer));
X	do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer));
X	e_rdue();
X	if (ship_retired__ == 1) {
X	    s_wsfe(&io___78);
X	    do_fio(&c__1, ship_name__, 30L);
X	    do_fio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer));
X	    do_fio(&c__1, retired, 10L);
X	    do_fio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer));
X	    e_wsfe();
X	} else {
X	    s_wsfe(&io___79);
X	    do_fio(&c__1, ship_name__, 30L);
X	    do_fio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer));
X	    for (i = 1; i <= 3; ++i) {
X		do_fio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof(
X			integer));
X	    }
X	    do_fio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer));
X	    e_wsfe();
X	}
X/* L10: */
X    }
X    s_wsle(&io___80);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___81);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    cl__1.cerr = 0;
X    cl__1.cunit = 1;
X    cl__1.csta = 0;
X    f_clos(&cl__1);
X    return 0;
X} /* strek_ships__ */
X
X/* Subroutine */ int strek_scores__()
X{
X    /* Initialized data */
X
X    static char dummy1[34+1] = "     User       CAPTAIN    SHIP NA";
X    static char dummy2[34+1] = "ME                           SCORE";
X
X    /* Format strings */
X    static char fmt_100[] = "(\002 Top 10 STAR TREK Scores as of \002,i4,\
X\002/\002,i2,\002/\002,i2)";
X    static char fmt_130[] = "(a34,a34)";
X    static char fmt_110[] = "(a10,a10,a30,i10)";
X    static char fmt_120[] = "(i2,\002.\002,2x,a10,x,a10,x,a30,x,i10)";
X
X    /* System generated locals */
X    olist o__1;
X    cllist cl__1;
X    inlist ioin__1;
X
X    /* Builtin functions */
X    integer f_inqu(), f_open(), s_wsle(), do_lio(), e_wsle(), s_wsfe(), 
X	    do_fio(), e_wsfe(), s_rsfe(), e_rsfe(), f_clos();
X
X    /* Local variables */
X    static integer i, j;
X    static shortint decoded_clock__[6];
X    static char capt_name__[10], ship_name__[30], user_name__[10];
X    extern /* Subroutine */ int caldecodelocaltime_();
X    static real status;
X    static integer top_scores__;
X    static logical fyn;
X
X    /* Fortran I/O blocks */
X    static cilist io___87 = { 0, 6, 0, 0, 0 };
X    static cilist io___88 = { 0, 6, 0, fmt_100, 0 };
X    static cilist io___90 = { 0, 6, 0, 0, 0 };
X    static cilist io___91 = { 0, 6, 0, fmt_130, 0 };
X    static cilist io___92 = { 0, 6, 0, 0, 0 };
X    static cilist io___94 = { 0, 2, 0, fmt_110, 0 };
X    static cilist io___99 = { 0, 6, 0, fmt_120, 0 };
X    static cilist io___100 = { 0, 6, 0, "(a1)", 0 };
X    static cilist io___101 = { 0, 6, 0, "(a1)", 0 };
X
X
X
X/*    STREK_SCORES prints out the list of top scores currently */
X/*    in STREK_TOP_SCORES. */
X
X/*    version 1 */
X/*                                                   -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X
X/*    get local time */
X
X    caldecodelocaltime_(decoded_clock__);
X
X/*    open up top scores file and read */
X
X    ioin__1.inerr = 0;
X    ioin__1.infilen = 36;
X    ioin__1.infile = "/usr/lib/X11/xstrek/strek_top_scores";
X    ioin__1.inex = &fyn;
X    ioin__1.inopen = 0;
X    ioin__1.innum = 0;
X    ioin__1.innamed = 0;
X    ioin__1.inname = 0;
X    ioin__1.inacc = 0;
X    ioin__1.inseq = 0;
X    ioin__1.indir = 0;
X    ioin__1.infmt = 0;
X    ioin__1.inform = 0;
X    ioin__1.inunf = 0;
X    ioin__1.inrecl = 0;
X    ioin__1.innrec = 0;
X    ioin__1.inblank = 0;
X    f_inqu(&ioin__1);
X    if (! fyn) {
X	status = (float)1.;
X	return 0;
X    }
X    o__1.oerr = 0;
X    o__1.ounit = 2;
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 = "old";
X    o__1.oacc = 0;
X    o__1.ofm = "formatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X
X/*    print out header */
X
X    s_wsle(&io___87);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsfe(&io___88);
X    for (i = 1; i <= 3; ++i) {
X	do_fio(&c__1, (char *)&decoded_clock__[i - 1], (ftnlen)sizeof(
X		shortint));
X    }
X    e_wsfe();
X    s_wsle(&io___90);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsfe(&io___91);
X    do_fio(&c__1, dummy1, 34L);
X    do_fio(&c__1, dummy2, 34L);
X    e_wsfe();
X    s_wsle(&io___92);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    for (j = 1; j <= 10; ++j) {
X	s_rsfe(&io___94);
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 *)&top_scores__, (ftnlen)sizeof(integer));
X	e_rsfe();
X	s_wsfe(&io___99);
X	do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
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 *)&top_scores__, (ftnlen)sizeof(integer));
X	e_wsfe();
X/* L10: */
X    }
X/*      print*,' ' */
X    s_wsfe(&io___100);
X    do_fio(&c__1, " ", 1L);
X    e_wsfe();
X/*      print*,' ' */
X    s_wsfe(&io___101);
X    do_fio(&c__1, " ", 1L);
X    e_wsfe();
X    cl__1.cerr = 0;
X    cl__1.cunit = 2;
X    cl__1.csta = 0;
X    f_clos(&cl__1);
X    return 0;
X} /* strek_scores__ */
X
X/* Subroutine */ int strek_damage_date__(damage_days__, ship_avail__)
Xinteger *damage_days__, *ship_avail__;
X{
X    /* Initialized data */
X
X    static integer days[12] = { 31,28,31,30,31,30,31,31,30,31,30,31 };
X
X    /* System generated locals */
X    integer i__1;
X
X    /* Local variables */
X    static integer ichk, iday, ichk1, ichk2;
X    static shortint decoded_clock__[6];
X    static integer iyear, imonth;
X    extern /* Subroutine */ int caldecodelocaltime_();
X
X
X/*    STREK_DAMAGE_DATE computes the ship availability date */
X/*    given the damage repair time in whole days. This is */
X/*    used after a game but before updating STREK_INFO via */
X/*    STREK_WRITE. Note that damage date can't exceed 1 year */
X/*    and is not adjusted for leap years encountered when */
X/*    damage occurs in a non-leap year. */
X
X/*    version 1 */
X/*                                                -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X
X
X/*    days in months data */
X
X    /* Parameter adjustments */
X    --ship_avail__;
X
X    /* Function Body */
X
X/*    get local time */
X
X    caldecodelocaltime_(decoded_clock__);
X
X/*    if a leap year change days(2) */
X
X    i__1 = decoded_clock__[0];
X    ichk = i__1 % 4;
X    if (ichk == 0) {
X	days[1] = 29;
X	i__1 = decoded_clock__[0];
X	ichk1 = i__1 % 100;
X	i__1 = decoded_clock__[0];
X	ichk2 = i__1 % 400;
X	if (ichk1 == 0) {
X	    if (ichk2 == 0) {
X		days[1] = 29;
X	    } else {
X		days[1] = 28;
X	    }
X	}
X    }
X
X/*    add damage days to local time */
X
X    iday = *damage_days__ + decoded_clock__[2];
X    imonth = decoded_clock__[1];
X    if (iday > days[imonth - 1]) {
X	iday -= days[imonth - 1];
X	imonth = decoded_clock__[1] + 1;
X    }
X    if (imonth <= 12) {
X	iyear = decoded_clock__[0];
X    } else {
X	iyear = decoded_clock__[0] + 1;
X	imonth += -12;
X    }
X
X/*    load ship availability date */
X
X    ship_avail__[1] = iyear;
X    ship_avail__[2] = imonth;
X    ship_avail__[3] = iday;
X    return 0;
X} /* strek_damage_date__ */
X
X/* Subroutine */ int strek_startup__(user_name__, capt_name__, nick_name__, 
X	ship_name__, last_score__, cum_score__, key_file__, new_, 
X	user_name_len, capt_name_len, nick_name_len, ship_name_len, 
X	key_file_len)
Xchar *user_name__, *capt_name__, *nick_name__, *ship_name__;
Xinteger *last_score__, *cum_score__;
Xchar *key_file__;
Xlogical *new_;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen ship_name_len;
Xftnlen key_file_len;
X{
X    /* Builtin functions */
X    integer s_wsle(), do_lio(), e_wsle();
X    /* Subroutine */ int s_stop();
X    integer s_rsfe(), do_fio(), e_rsfe();
X
X    /* Local variables */
X    extern /* Subroutine */ int strek_scores__(), strek_review__();
X    static integer ship_avail__[3];
X    static char answer[1];
X    static integer status;
X    extern /* Subroutine */ int strek_question__();
X    static logical ship_active__;
X    extern /* Subroutine */ int strek_ships__();
X
X    /* Fortran I/O blocks */
X    static cilist io___113 = { 0, 6, 0, 0, 0 };
X    static cilist io___114 = { 0, 6, 0, 0, 0 };
X    static cilist io___115 = { 0, 6, 0, 0, 0 };
X    static cilist io___116 = { 0, 6, 0, 0, 0 };
X    static cilist io___117 = { 0, 6, 0, 0, 0 };
X    static cilist io___118 = { 0, 6, 0, 0, 0 };
X    static cilist io___119 = { 0, 6, 0, 0, 0 };
X    static cilist io___120 = { 0, 5, 0, "(a)", 0 };
X    static cilist io___122 = { 0, 6, 0, 0, 0 };
X
X
X
X/*    STREK_STARTUP initializes the strek system. The order */
X/*    of calls is: */
X
X/*    STREK_QUESTION - get captain info and ship name, */
X
X/*    STREK_REVIEW - if ship is old get it's stats. */
X
X/*    options: STREK_SHIPS - review the current ship registry, */
X/*         and STREK_SCORES - review the top 10 scores. */
X
X/*    version 1 */
X/*                                            -jsr 8/85 */
X
X
X/*    STREK is open so question the captain */
X
X    strek_question__(user_name__, capt_name__, nick_name__, ship_name__, 
X	    key_file__, new_, 10L, 10L, 10L, 30L, 256L);
X
X/*    if this is a new ship or captain set up scores */
X
X    if (*new_) {
X	*cum_score__ = 0;
X	*last_score__ = 0;
X    } else {
X
X/*    this is an old ship, check her status in the registry */
X
X	strek_review__(ship_name__, user_name__, capt_name__, nick_name__, 
X		ship_avail__, cum_score__, last_score__, &ship_active__, 
X		key_file__, &status, 30L, 10L, 10L, 10L, 256L);
X	if (status == 1) {
X	    s_wsle(&io___113);
X	    do_lio(&c__9, &c__1, "STREK_INFO doesn't exist, execution stops!",
X		     42L);
X	    e_wsle();
X	    s_wsle(&io___114);
X	    do_lio(&c__9, &c__1, "Run XSTREK_STARTUP_DB to initialize the da\
Xtabase.", 49L);
X	    e_wsle();
X	    s_wsle(&io___115);
X	    do_lio(&c__9, &c__1, " ", 1L);
X	    e_wsle();
X	    s_stop("", 0L);
X	}
X    }
X
X/*    review the registry or scores? */
X
XL10:
X    s_wsle(&io___116);
X    do_lio(&c__9, &c__1, "Enter <r> to view the ship registry,", 36L);
X    e_wsle();
X    s_wsle(&io___117);
X    do_lio(&c__9, &c__1, "      <s> to view the top ten scores or", 39L);
X    e_wsle();
X    s_wsle(&io___118);
X    do_lio(&c__9, &c__1, "      <return> to start.", 24L);
X    e_wsle();
X    s_wsle(&io___119);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_rsfe(&io___120);
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_wsle(&io___122);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X    }
X    return 0;
X} /* strek_startup__ */
X
X/* Subroutine */ int strek_ship_avail__(ship_avail__, avail)
Xinteger *ship_avail__;
Xlogical *avail;
X{
X    static shortint decoded_clock__[6];
X    extern /* Subroutine */ int caldecodelocaltime_();
X
X
X/*    STREK_SHIP_AVAIL decodes the ship available time from */
X/*    STREK_INFO and decides if the ship is ready or not. */
X/*    Dead ships are flagged in STREK_INFO and needn't */
X/*    be processed herein. */
X
X/*    If (avail) then the ship is available. */
X
X/*    version 1 */
X/*                                         -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X
X
X/*    get local time */
X
X    /* Parameter adjustments */
X    --ship_avail__;
X
X    /* Function Body */
X    caldecodelocaltime_(decoded_clock__);
X
X/*    compare dates and see if ship is ready */
X
X    if (ship_avail__[1] > decoded_clock__[0]) {
X	*avail = FALSE_;
X	return 0;
X    } else if (ship_avail__[1] < decoded_clock__[0]) {
X	*avail = TRUE_;
X	return 0;
X    } else if (ship_avail__[2] > decoded_clock__[1]) {
X	*avail = FALSE_;
X	return 0;
X    } else if (ship_avail__[2] < decoded_clock__[1]) {
X	*avail = TRUE_;
X	return 0;
X    } else if (ship_avail__[3] > decoded_clock__[2]) {
X	*avail = FALSE_;
X	return 0;
X    } else {
X	*avail = TRUE_;
X    }
X    return 0;
X} /* strek_ship_avail__ */
X
X/* Subroutine */ int strek_dock__(d_pct__, score, user_name__, capt_name__, 
X	nick_name__, ship_name__, cum_score__, key_file__, new_ship__, 
X	user_name_len, capt_name_len, nick_name_len, ship_name_len, 
X	key_file_len)
Xreal *d_pct__;
Xinteger *score;
Xchar *user_name__, *capt_name__, *nick_name__, *ship_name__;
Xinteger *cum_score__;
Xchar *key_file__;
Xlogical *new_ship__;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen ship_name_len;
Xftnlen key_file_len;
X{
X    /* Initialized data */
X
X    static real time[6] = { (float)1.25,(float)1.25,(float).75,(float).5,(
X	    float).75,(float).5 };
X    static logical active = TRUE_;
X    static integer seconds = 2;
X
X    /* Format strings */
X    static char fmt_100[] = "(\002 Your ship will be ready on \002,i4,\002\
X/\002,i2,\002/\002,i2)";
X
X    /* Builtin functions */
X    integer i_nint();
X    /* Subroutine */ int s_copy();
X    integer s_wsle(), do_lio(), e_wsle(), s_cmp(), s_wsfe(), do_fio(), e_wsfe(
X	    );
X
X    /* Local variables */
X    extern /* Subroutine */ int strek_write__();
X    static integer days;
X    extern /* Subroutine */ int timewait_();
X    static real timerelative;
X    extern /* Subroutine */ int gprterminate_(), strek_scores__();
X    static integer i, j;
X    static shortint clock[3];
X    extern /* Subroutine */ int strek_damage_date__(), calsectoclock_(), 
X	    strek_message__();
X    static real damage;
X    static integer ship_avail__[3], status;
X    static char message[80*3];
X    static logical top_ten__;
X
X    /* Fortran I/O blocks */
X    static cilist io___136 = { 0, 6, 0, 0, 0 };
X    static cilist io___137 = { 0, 6, 0, fmt_100, 0 };
X    static cilist io___139 = { 0, 6, 0, 0, 0 };
X    static cilist io___140 = { 0, 6, 0, 0, 0 };
X    static cilist io___141 = { 0, 6, 0, 0, 0 };
X    static cilist io___142 = { 0, 6, 0, 0, 0 };
X    static cilist io___143 = { 0, 6, 0, 0, 0 };
X    static cilist io___144 = { 0, 6, 0, 0, 0 };
X    static cilist io___145 = { 0, 6, 0, 0, 0 };
X
X
X
X/*    STREK_DOCK updates the STREK database after docking */
X
X/*    version 1 */
X/*                                     -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X
X    /* Parameter adjustments */
X    --d_pct__;
X
X    /* Function Body */
X
X/*    do house keeping */
X
X    *cum_score__ += *score;
X    calsectoclock_(&seconds, clock);
X
X/*    add up damage times */
X
X    damage = (float).5;
X    for (j = 1; j <= 6; ++j) {
X	damage += ((float)1. - d_pct__[j]) * time[j - 1];
X/* L10: */
X    }
X    days = i_nint(&damage);
X    strek_damage_date__(&days, ship_avail__);
X
X/*    write update info to STREK_INFO */
X
X    strek_write__(new_ship__, ship_name__, user_name__, capt_name__, 
X	    nick_name__, key_file__, ship_avail__, score, cum_score__, &
X	    active, &top_ten__, 30L, 10L, 10L, 10L, 256L);
X
X/*    write messages to screen */
X
X    s_copy(message, " ", 80L, 1L);
X    s_copy(message + 80, "Awaiting permission to dock.", 80L, 28L);
X    s_copy(message + 160, " ", 80L, 1L);
X    strek_message__(message, &c__3, 80L);
X    timewait_(&timerelative, clock, &status);
X    s_copy(message + 80, "Docking completed, good going captain. ", 80L, 39L);
X
X    strek_message__(message, &c__3, 80L);
X    timewait_(&timerelative, clock, &status);
X
X/*    terminate graphics */
X
X    gprterminate_(&c__1, &status);
X    s_wsle(&io___136);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    if (s_cmp(ship_name__, " ", 30L, 1L) != 0) {
X	s_wsfe(&io___137);
X	for (i = 1; i <= 3; ++i) {
X	    do_fio(&c__1, (char *)&ship_avail__[i - 1], (ftnlen)sizeof(
X		    integer));
X	}
X	e_wsfe();
X    }
X    s_wsle(&io___139);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___140);
X    do_lio(&c__9, &c__1, "Score for this mission: ", 24L);
X    do_lio(&c__3, &c__1, (char *)&(*score), (ftnlen)sizeof(integer));
X    e_wsle();
X    s_wsle(&io___141);
X    do_lio(&c__9, &c__1, "Cumulative score: ", 18L);
X    do_lio(&c__3, &c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer));
X    e_wsle();
X    s_wsle(&io___142);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    if (top_ten__) {
X	strek_scores__();
X	s_wsle(&io___143);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	s_wsle(&io___144);
X	do_lio(&c__9, &c__1, "Congratulations! Your score places you in the \
XTop 10.", 53L);
X	e_wsle();
X	s_wsle(&io___145);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X    }
X    return 0;
X} /* strek_dock__ */
X
X/* Subroutine */ int strek_no_energy__(num_times__, user_name__, capt_name__, 
X	nick_name__, ship_name__, key_file__, score, cum_score__, new_, 
X	user_name_len, capt_name_len, nick_name_len, ship_name_len, 
X	key_file_len)
Xinteger *num_times__;
Xchar *user_name__, *capt_name__, *nick_name__, *ship_name__, *key_file__;
Xinteger *score, *cum_score__;
Xlogical *new_;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen nick_name_len;
Xftnlen ship_name_len;
Xftnlen key_file_len;
X{
X    /* Initialized data */
X
X    static integer seconds = 5;
X    static integer ship_avail__[3] = { 0,0,0 };
X    static char message_1__[80*3+1] = "Message from engineering:            \
X                                           Sir, the battery reserves are cri\
Xtically low.                                   Non-vital subsystems being dr\
Xopped.                                             ";
X    static char message_2__[80*3+1] = "Message from engineering:            \
X                                           Main system shutdown occuring on \
Xall decks.                                     Life-support system is in dan\
Xger of failure.                                    ";
X    static char message_3__[80*3+1] = "Message from engineering:            \
X                                           Life-support system is down, oxyg\
Xen content is dropping.                        Main system shutdown complete\
X.                                                  ";
X
X    /* Builtin functions */
X    /* Subroutine */ int s_copy();
X    integer s_wsfi(), do_fio(), e_wsfi(), s_wsle(), do_lio(), e_wsle(), s_cmp(
X	    );
X    /* Subroutine */ int s_stop();
X
X    /* Local variables */
X    extern /* Subroutine */ int strek_write__(), timewait_();
X    static real timerelative;
X    extern /* Subroutine */ int gprterminate_(), strek_scores__();
X    static char blank[80*3];
X    static shortint clock[3];
X    extern /* Subroutine */ int calsectoclock_(), strek_message__();
X    static integer status;
X    static logical top_ten__;
X
X    /* Fortran I/O blocks */
X    static icilist io___152 = { 0, blank+160, 0, "(a30, a10)", 80, 1 };
X    static cilist io___157 = { 0, 6, 0, 0, 0 };
X    static cilist io___158 = { 0, 6, 0, 0, 0 };
X    static cilist io___159 = { 0, 6, 0, 0, 0 };
X    static cilist io___160 = { 0, 6, 0, 0, 0 };
X    static cilist io___161 = { 0, 6, 0, 0, 0 };
X    static cilist io___162 = { 0, 6, 0, 0, 0 };
X    static cilist io___163 = { 0, 6, 0, 0, 0 };
X    static cilist io___164 = { 0, 6, 0, 0, 0 };
X    static cilist io___165 = { 0, 6, 0, 0, 0 };
X    static cilist io___166 = { 0, 6, 0, 0, 0 };
X    static cilist io___167 = { 0, 6, 0, 0, 0 };
X    static cilist io___168 = { 0, 6, 0, 0, 0 };
X
X
X
X/*    STREK_NO_ENERGY advises the captain to cut energy use. Messages */
X/*    become more and more urgent as the number of turns w/o energy */
X/*    increases. After 150 turns the ship is retired and the database */
X/*    updated. */
X
X/*    version 1 */
X/*                                         -jsr 8/85 */
X
X/* % include '/sys/ins/base.ins.ftn' */
X/* % include '/sys/ins/cal.ins.ftn' */
X/* % include '/sys/ins/gpr.ins.ftn' */
X/* % include '/sys/ins/time.ins.ftn' */
X
X
X/*    data for message strings */
X
X    if (*num_times__ == 1) {
X	strek_message__(message_1__, &c__3, 80L);
X    } else if (*num_times__ == 50) {
X	strek_message__(message_2__, &c__3, 80L);
X    } else if (*num_times__ == 100) {
X	strek_message__(message_3__, &c__3, 80L);
X    } else if (*num_times__ == 150) {
X	s_copy(blank, "Message from chief engineer Scotty:", 80L, 35L);
X	s_copy(blank + 80, "Sir, aye can't hold on much longah.", 80L, 35L);
X	s_wsfi(&io___152);
X	do_fio(&c__1, "It looks like the game's over ", 30L);
X	do_fio(&c__1, nick_name__, 10L);
X	e_wsfi();
X	strek_message__(blank, &c__3, 80L);
X
X/*    do house keeping */
X
X	*cum_score__ += *score;
X	calsectoclock_(&seconds, clock);
X	strek_write__(new_, ship_name__, user_name__, capt_name__, 
X		nick_name__, key_file__, ship_avail__, score, cum_score__, &
X		c__0, &top_ten__, 30L, 10L, 10L, 10L, 256L);
X	timewait_(&timerelative, clock, &status);
X
X/*    terminate graphics */
X
X	gprterminate_(&c__1, &status);
X	s_wsle(&io___157);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	s_wsle(&io___158);
X	do_lio(&c__9, &c__1, "Score for this mission: ", 24L);
X	do_lio(&c__3, &c__1, (char *)&(*score), (ftnlen)sizeof(integer));
X	e_wsle();
X	s_wsle(&io___159);
X	do_lio(&c__9, &c__1, "Cumulative score: ", 18L);
X	do_lio(&c__3, &c__1, (char *)&(*cum_score__), (ftnlen)sizeof(integer))
X		;
X	e_wsle();
X	s_wsle(&io___160);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	if (top_ten__) {
X	    strek_scores__();
X	    s_wsle(&io___161);
X	    do_lio(&c__9, &c__1, " ", 1L);
X	    e_wsle();
X	    s_wsle(&io___162);
X	    do_lio(&c__9, &c__1, "Congratulations! Your score places you in \
Xthe Top 10.", 53L);
X	    e_wsle();
X	    s_wsle(&io___163);
X	    do_lio(&c__9, &c__1, "A rather hollow victory I would think.", 
X		    38L);
X	    e_wsle();
X	    s_wsle(&io___164);
X	    do_lio(&c__9, &c__1, " ", 1L);
X	    e_wsle();
X	}
X	s_wsle(&io___165);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	if (s_cmp(ship_name__, " ", 30L, 1L) != 0) {
X	    s_wsle(&io___166);
X	    do_lio(&c__9, &c__1, "Your ship, the ", 15L);
X	    do_lio(&c__9, &c__1, ship_name__, 30L);
X	    e_wsle();
X	    s_wsle(&io___167);
X	    do_lio(&c__9, &c__1, "was decommissioned after being found by Fe\
Xderation scouts.", 58L);
X	    e_wsle();
X	    s_wsle(&io___168);
X	    do_lio(&c__9, &c__1, " ", 1L);
X	    e_wsle();
X	}
X	s_stop("", 0L);
X    }
X    return 0;
X} /* strek_no_energy__ */
X
X/* Subroutine */ int strek_search_name__(user_name__, capt_name__, 
X	ship_name__, key_file__, new_, user_name_len, capt_name_len, 
X	ship_name_len, key_file_len)
Xchar *user_name__, *capt_name__, *ship_name__, *key_file__;
Xlogical *new_;
Xftnlen user_name_len;
Xftnlen capt_name_len;
Xftnlen ship_name_len;
Xftnlen key_file_len;
X{
X    /* Format strings */
X    static char fmt_100[] = "(x,i1,\002. \002,a30)";
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(), f_clos();
X    /* Subroutine */ int s_copy();
X    integer s_wsle(), do_lio(), e_wsle(), s_wsfe(), do_fio(), e_wsfe(), 
X	    s_rsle(), e_rsle(), s_rsfe(), e_rsfe();
X
X    /* Local variables */
X    static char nick[10*10], practice[30];
X    static integer ship_retired__;
X    static char temp1[30], temp2[10], temp3[10];
X    extern /* Subroutine */ int strek_ship_avail__();
X    static integer i, j;
X    static logical avail;
X    static char nick_name__[10];
X    static logical ready[10];
X    static char ships[30*10];
X    static integer count, cum_score__, num_lines__, number, ship_avail__[3], 
X	    last_score__;
X    static char key[256*10];
X
X    /* Fortran I/O blocks */
X    static cilist io___169 = { 0, 1, 0, 0, 1 };
X    static cilist io___173 = { 0, 1, 0, 0, 0 };
X    static cilist io___177 = { 0, 1, 0, 0, 0 };
X    static cilist io___189 = { 0, 6, 0, 0, 0 };
X    static cilist io___190 = { 0, 6, 0, 0, 0 };
X    static cilist io___191 = { 0, 6, 0, 0, 0 };
X    static cilist io___192 = { 0, 6, 0, fmt_100, 0 };
X    static cilist io___193 = { 0, 6, 0, fmt_100, 0 };
X    static cilist io___194 = { 0, 6, 0, 0, 0 };
X    static cilist io___195 = { 0, 6, 0, 0, 0 };
X    static cilist io___196 = { 0, 6, 0, 0, 0 };
X    static cilist io___197 = { 0, 5, 0, 0, 0 };
X    static cilist io___199 = { 0, 6, 0, 0, 0 };
X    static cilist io___200 = { 0, 6, 0, 0, 0 };
X    static cilist io___201 = { 0, 5, 0, "(a)", 0 };
X
X
X
X/*     STREK_SEARCH_NAME searches for the names of ships for a certain */
X/*     captain.  To fly a certain ship he need only type the number */
X/*     associated with it. */
X
X/*     4/86                                             -jsr */
X
X
X/*    open the info file and read off all ship names */
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 = "old";
X    o__1.oacc = "direct";
X    o__1.ofm = "unformatted";
X    o__1.oblnk = 0;
X    f_open(&o__1);
X
X/*    read number of lines */
X
X    s_rdue(&io___169);
X    do_uio(&c__1, (char *)&num_lines__, (ftnlen)sizeof(integer));
X    e_rdue();
X    count = 2;
X    i__1 = num_lines__ + 1;
X    for (i = 2; i <= i__1; ++i) {
X	io___173.cirec = i;
X	s_rdue(&io___173);
X	do_uio(&c__1, temp1, 30L);
X	do_uio(&c__1, temp3, 10L);
X	do_uio(&c__1, temp2, 10L);
X	e_rdue();
X	if (s_cmp(temp2, capt_name__, 10L, 10L) == 0 && s_cmp(temp3, 
X		user_name__, 10L, 10L) == 0) {
X	    io___177.cirec = i;
X	    s_rdue(&io___177);
X	    do_uio(&c__1, ships + (count - 1) * 30, 30L);
X	    do_uio(&c__1, temp3, 10L);
X	    do_uio(&c__1, temp2, 10L);
X	    do_uio(&c__1, nick + (count - 1) * 10, 10L);
X	    do_uio(&c__1, key + (count - 1 << 8), 256L);
X	    for (j = 1; j <= 3; ++j) {
X		do_uio(&c__1, (char *)&ship_avail__[j - 1], (ftnlen)sizeof(
X			integer));
X	    }
X	    do_uio(&c__1, (char *)&last_score__, (ftnlen)sizeof(integer));
X	    do_uio(&c__1, (char *)&cum_score__, (ftnlen)sizeof(integer));
X	    do_uio(&c__1, (char *)&ship_retired__, (ftnlen)sizeof(integer));
X	    e_rdue();
X	    strek_ship_avail__(ship_avail__, &avail);
X	    if (avail) {
X		ready[count - 1] = TRUE_;
X	    } else {
X		ready[count - 1] = FALSE_;
X	    }
X	    ++count;
X	}
X/* L10: */
X    }
X    cl__1.cerr = 0;
X    cl__1.cunit = 1;
X    cl__1.csta = 0;
X    f_clos(&cl__1);
X    --count;
X    s_copy(practice, "practice flight", 30L, 15L);
X    s_copy(ships, "initiate new ship", 30L, 17L);
X    ready[0] = TRUE_;
X    s_wsle(&io___189);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___190);
X    do_lio(&c__9, &c__1, "Ships available:", 16L);
X    e_wsle();
X    s_wsle(&io___191);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsfe(&io___192);
X    do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
X    do_fio(&c__1, practice, 30L);
X    e_wsfe();
X    i__1 = count;
X    for (i = 1; i <= i__1; ++i) {
X	if (ready[i - 1]) {
X	    s_wsfe(&io___193);
X	    do_fio(&c__1, (char *)&i, (ftnlen)sizeof(integer));
X	    do_fio(&c__1, ships + (i - 1) * 30, 30L);
X	    e_wsfe();
X	}
X/* L20: */
X    }
XL30:
X    s_wsle(&io___194);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_wsle(&io___195);
X    do_lio(&c__9, &c__1, "Enter the number of the ship you wish to fly.", 45L)
X	    ;
X    e_wsle();
X    s_wsle(&io___196);
X    do_lio(&c__9, &c__1, " ", 1L);
X    e_wsle();
X    s_rsle(&io___197);
X    do_lio(&c__3, &c__1, (char *)&number, (ftnlen)sizeof(integer));
X    e_rsle();
X    if (number == 1) {
X	s_wsle(&io___199);
X	do_lio(&c__9, &c__1, " ", 1L);
X	e_wsle();
X	s_wsle(&io___200);
X	do_lio(&c__9, &c__1, "What do you want to call your ship sir?", 39L);
X	e_wsle();
X	s_rsfe(&io___201);
X	do_fio(&c__1, ship_name__, 30L);
X	e_rsfe();
X	*new_ = TRUE_;
X    } else if (number > 1 && ready[number - 1]) {
X	*new_ = FALSE_;
X	s_copy(ship_name__, ships + (number - 1) * 30, 30L, 30L);
X	s_copy(nick_name__, nick + (number - 1) * 10, 10L, 10L);
X	s_copy(key_file__, key + (number - 1 << 8), 256L, 256L);
X    } else if (number == 0) {
X	*new_ = TRUE_;
X	s_copy(ship_name__, " ", 30L, 1L);
X    } else {
X	goto L30;
X    }
X    return 0;
X} /* strek_search_name__ */
X
E!O!F! xstrek/strek_db_subs.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