Source Code 1994 March/Source_Code_CD-ROM_Walnut_Creek_March_1994.iso/compsrcs/misc/volume28/ephem/part07

Text File | 1992-03-14 | 53.3 KB | 2,128 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Elwood C. Downey)
Subject:  v28i090:  ephem - an interactive astronomical ephemeris, v4.28, Part07/09
Message-ID: <[e-mail]>
X-Md4-Signature: 96e65b62725b81b7c3d9c10d7ddf4c4a
Date: Tue, 10 Mar 1992 21:59:21 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Elwood C. Downey)
Posting-number: Volume 28, Issue 90
Archive-name: ephem/part07
Environment: UNIX, VMS, DOS, MAC
Supersedes: ephem-4.21: Volume 14, Issue 76-81

#! /bin/sh
# into a shell via "sh file" or similar.  To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to [e-mail] if you want that tool.
# Contents:  altmenus.c flog.c formats.c listing.c plot.c srch.c
# Wrapped by kent@sparky on Tue Mar 10 14:34:08 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo '          "shar: End of archive 7 (of 9)."'
if test -f 'altmenus.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'altmenus.c'\"
else
  echo shar: Extracting \"'altmenus.c'\" \(11329 characters\)
  sed "s/^X//" >'altmenus.c' <<'END_OF_FILE'
X/* routines for managing the alternative bottom half menus.
X * planet-specific menus are in their own files.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "astro.h"
X#include "circum.h"
X#include "screen.h"
X
Xstatic int altmenu = F_MNU1;    /* which alternate menu is up; one of F_MNUi */
Xstatic int alt2_stdhzn;    /* whether to use STDHZN (aot ADPHZN) horizon algthm  */
Xstatic int alt3_geoc;    /* whether to use geocentric (aot topocentric) vantage*/
X
X/* table of screen rows given a body #define from astro/h or screen.h */
Xstatic short bodyrow[NOBJ] = {
X    R_MERCURY, R_VENUS, R_MARS, R_JUPITER, R_SATURN,
X    R_URANUS, R_NEPTUNE, R_PLUTO, R_SUN, R_MOON, R_OBJX, R_OBJY
X};
X/* table of screen cols for third menu format, given body #define ... */
Xstatic short bodycol[NOBJ] = {
X    C_MERCURY, C_VENUS, C_MARS, C_JUPITER, C_SATURN,
X    C_URANUS, C_NEPTUNE, C_PLUTO, C_SUN, C_MOON, C_OBJX, C_OBJY
X};
X
X/* initialize altmenu; used by main from cracking the ephem startup file.
X */
Xaltmenu_init (n)
Xint n;
X{
X    altmenu = n;
X}
X
X/* let op decide which alternate menu should be up,
X * including any menu-specific setup they might require.
X * return 0 if things changed to require updating the alt menu; else -1.
X */
Xaltmenu_setup()
X{
X    static char *flds[5] = {
X        "Data", "(Rise/Set", "", "(Separations"
X    };
X    int newmenu = altmenu, newhzn = alt2_stdhzn, newgeoc = alt3_geoc;
X    int new;
X    int fn = altmenu == F_MNU3 ? 3 : altmenu == F_MNU2 ? 1 : 0;
X
X    ask:
X    flds[2]= newhzn ? "Standard hzn)" : "Adaptive hzn)";
X    flds[4]= newgeoc? "Geocentric)" : "Topocentric)";
X
X    switch (popup (flds, fn, 5)) {
X    case 0: newmenu = F_MNU1; break;
X    case 1: newmenu = F_MNU2; break;
X    case 2: newhzn ^= 1; fn = 2; goto ask;
X    case 3: newmenu = F_MNU3; break;
X    case 4: newgeoc ^= 1; fn = 4; goto ask;
X    default: return (-1);
X    }
X
X    new = 0;
X    if (newmenu != altmenu) {
X        altmenu = newmenu;
X        new++;
X    }
X    if (newhzn != alt2_stdhzn) {
X        alt2_stdhzn = newhzn;
X        if (newmenu == F_MNU2)
X        new++;
X    }
X    if (newgeoc != alt3_geoc) {
X        alt3_geoc = newgeoc;
X        if (newmenu == F_MNU3)
X        new++;
X    }
X    return (new ? 0 : -1);
X}
X
X/* erase the info for the given planet */
Xalt_nobody (p)
Xint p;
X{
X    f_eol (bodyrow[p], C_RA);
X}
X
Xalt_body (b, force, np)
Xint b;        /* which body, ala astro.h and screen.h defines */
Xint force;    /* if !0 then draw for sure, else just if changed since last */
XNow *np;
X{
X    switch (altmenu) {
X    case F_MNU1: alt1_body (b, force, np); break;
X    case F_MNU2: alt2_body (b, force, np); break;
X    case F_MNU3: alt3_body (b, force, np); break;
X    }
X}
X
X/* draw the labels for the current alternate menu format */
Xalt_labels ()
X{
X    switch (altmenu) {
X    case F_MNU1: alt1_labels (); break;
X    case F_MNU2: alt2_labels (); break;
X    case F_MNU3: alt3_labels (); break;
X    case F_MNUJ: altj_labels (); break;
X    }
X}
X
Xalt_erase ()
X{
X    int i;
X
X    for (i = R_PLANTAB; i <= NR; i++)
X        f_eol (i, 1);
X    f_string (R_ALTM, C_ALTMV, "             ");
X}
X
Xalt_menumask()
X{
X    return (altmenu);
X}
X
X/* handy function to return the next planet in the order in which they are
X * displayed in the lower half of the screen.
X * input is a given planet, return is the next planet.
X * if input is not legal, then first planet is returned; when input is the
X * last planet, then -1 is returned.
X * typical usage is something like:
X *   for (p = nxtbody(-1); p != -1; p = nxtbody(p))
X */
Xnxtbody(p)
Xint p;
X{
X    static short nxtpl[NOBJ] = {
X        VENUS, MARS, JUPITER, SATURN, URANUS,
X        NEPTUNE, PLUTO, OBJX, MOON, MERCURY, OBJY, -1
X    };
X
X    if (p < MERCURY || p >= NOBJ)
X        return (SUN);
X    else
X        return (nxtpl[p]);
X}
X
Xalt_plnames()
X{
X    f_string (R_PLANTAB,    C_OBJ,    "OCX");
X    f_string (R_SUN,    C_OBJ,    "Su");
X    f_string (R_MOON,    C_OBJ,    "Mo");
X    f_string (R_MERCURY,    C_OBJ,    "Me");
X    f_string (R_VENUS,    C_OBJ,    "Ve");
X    f_string (R_MARS,    C_OBJ,    "Ma");
X    f_string (R_JUPITER,    C_OBJ,    "Ju");
X    f_string (R_SATURN,    C_OBJ,    "Sa");
X    f_string (R_URANUS,    C_OBJ,    "Ur");
X    f_string (R_NEPTUNE,    C_OBJ,    "Ne");
X    f_string (R_PLUTO,    C_OBJ,    "Pl");
X    f_string (R_OBJX,    C_OBJ,    "X");
X    f_string (R_OBJY,    C_OBJ,    "Y");
X}
X
Xstatic
Xalt1_labels()
X{
X    f_string (R_ALTM, C_ALTMV, "  Planet Data");
X
X    alt_plnames();
X    f_string (R_PLANTAB,    C_RA+2,    "R.A.");
X    f_string (R_PLANTAB,    C_DEC+2,"Dec");
X    f_string (R_PLANTAB,    C_AZ+2,    "Az");
X    f_string (R_PLANTAB,    C_ALT+2,"Alt");
X    f_string (R_PLANTAB,    C_HLONG,"H Long");
X    f_string (R_PLANTAB,    C_HLAT,    "H Lat");
X    f_string (R_PLANTAB,    C_EDIST,"Ea Dst");
X    f_string (R_PLANTAB,    C_SDIST,"Sn Dst");
X    f_string (R_PLANTAB,    C_ELONG,"Elong");
X    f_string (R_PLANTAB,    C_SIZE,    "Size");
X    f_string (R_PLANTAB,    C_MAG,    "VMag");
X    f_string (R_PLANTAB,    C_PHASE,"Phs");
X}
X
Xstatic
Xalt2_labels()
X{
X    f_string (R_ALTM, C_ALTMV, "Rise/Set Info");
X
X    alt_plnames();
X    f_string (R_PLANTAB,    C_RISETM-2,    "Rise Time");
X    f_string (R_PLANTAB,    C_RISEAZ,    "Rise Az");
X    f_string (R_PLANTAB,    C_TRANSTM-2,    "Trans Time");
X    f_string (R_PLANTAB,    C_TRANSALT-1,    "Trans Alt");
X    f_string (R_PLANTAB,    C_SETTM-1,    "Set Time");
X    f_string (R_PLANTAB,    C_SETAZ,    "Set Az");
X    f_string (R_PLANTAB,    C_TUP-1,    "Hours Up");
X}
X
Xstatic
Xalt3_labels()
X{
X    f_string (R_ALTM, C_ALTMV, "  Separations");
X
X    alt_plnames();
X    f_string (R_PLANTAB,    C_SUN,        " Sun");
X    f_string (R_PLANTAB,    C_MOON,        "Moon");
X    f_string (R_PLANTAB,    C_MERCURY,    "Merc");
X    f_string (R_PLANTAB,    C_VENUS,    "Venus");
X    f_string (R_PLANTAB,    C_MARS,        "Mars");
X    f_string (R_PLANTAB,    C_JUPITER,    " Jup");
X    f_string (R_PLANTAB,    C_SATURN,    " Sat");
X    f_string (R_PLANTAB,    C_URANUS,    "Uranus");
X    f_string (R_PLANTAB,    C_NEPTUNE,    " Nep");
X    f_string (R_PLANTAB,    C_PLUTO,    "Pluto");
X    f_string (R_PLANTAB,    C_OBJX,        "  X");
X    f_string (R_PLANTAB,    C_OBJY,        "  Y");
X}
X
X/* print body info in first menu format */
Xstatic
Xalt1_body (p, force, np)
Xint p;        /* which body, as in astro.h/screen.h defines */
Xint force;    /* whether to print for sure or only if things have changed */
XNow *np;
X{
X    Sky sky;
X    double as = plot_ison() || srch_ison() ? 0.0 : 60.0;
X    int row = bodyrow[p];
X
X    if (body_cir (p, as, np, &sky) || force) {
X        f_ra (row, C_RA, sky.s_ra);
X        f_angle (row, C_DEC, sky.s_dec);
X        if (sky.s_hlong != NOHELIO) {
X        f_angle (row, C_HLONG, sky.s_hlong);
X        if (p != SUN)
X            f_angle (row, C_HLAT, sky.s_hlat);
X        }
X
X        if (p == MOON) {
X        /* distance is on km, show in miles */
X        f_double (R_MOON, C_EDIST, "%6.0f", sky.s_edist/1.609344);
X        } else if (sky.s_edist > 0.0) {
X        /* show distance in au */
X        f_double (row, C_EDIST,(sky.s_edist>=10.0)?"%6.3f":"%6.4f",
X                                sky.s_edist);
X        }
X        if (sky.s_sdist > 0.0)
X        f_double (row, C_SDIST, (sky.s_sdist>=9.99995)?"%6.3f":"%6.4f",
X                                sky.s_sdist);
X        if (p != SUN)
X        f_double (row, C_ELONG, "%6.1f", sky.s_elong);
X        f_double (row, C_SIZE, sky.s_size >= 99.95 ?"%4.0f":"%4.1f",
X                                sky.s_size);
X        f_double (row, C_MAG, sky.s_mag <= -9.95 ? "%4.0f" : "%4.1f",
X                                sky.s_mag);
X        if (sky.s_sdist > 0.0) {
X        /* some terminals scroll when write a char in low-right corner.
X         * TODO: is there a nicer way to handle this maybe?
X         */
X        int col = row == NR ? C_PHASE - 1 : C_PHASE;
X        /* would just do this if Turbo-C 2.0 "%?.0f" worked:
X         * f_double (row, col, "%3.0f", sky.s_phase);
X         */
X        f_int (row, col, "%3d", sky.s_phase);
X        }
X    }
X
X    f_angle (row, C_AZ, sky.s_az);
X    f_angle (row, C_ALT, sky.s_alt);
X}
X
X/* print body info in the second menu format */
Xstatic
Xalt2_body (p, force, np)
Xint p;        /* which body, as in astro.h/screen.h defines */
Xint force;    /* whether to print for sure or only if things have changed */
XNow *np;
X{
X    double ltr, lts, ltt, azr, azs, altt;
X    int row = bodyrow[p];
X    int status;
X    double tmp;
X    int today_tup = 0;
X
X    /* always recalc OBJX and Y since we don't know it's the same object */
X    if (!riset_cir (p, np, p==OBJX || p==OBJY, alt2_stdhzn?STDHZN:ADPHZN,
X        <r, <s, <t, &azr, &azs, &altt, &status) && !force)
X        return;
X
X    alt_nobody (p);
X
X    if (status & RS_ERROR) {
X        /* can not find where body is! */
X        f_string (row, C_RISETM, "?Error?");
X        return;
X    }
X    if (status & RS_CIRCUMPOLAR) {
X        /* body is up all day */
X        f_string (row, C_RISETM, "Circumpolar");
X        if (status & RS_NOTRANS)
X        f_string (row, C_TRANSTM, "No transit");
X        else {
X        f_mtime (row, C_TRANSTM, ltt);
X        if (status & RS_2TRANS)
X            f_char (row, C_TRANSTM+5, '+');
X        f_angle (row, C_TRANSALT, altt);
X        }
X        f_string (row, C_TUP, "24:00"); /*f_mtime() changes to 0:00 */
X        return;
X    }
X    if (status & RS_NEVERUP) {
X        /* body never up at all today */
X        f_string (row, C_RISETM, "Never up");
X        f_mtime (row, C_TUP, 0.0);
X        return;
X    }
X
X    if (status & RS_NORISE) {
X        /* object does not rise as such today */
X        f_string (row, C_RISETM, "Never rises");
X        ltr = 0.0; /* for TUP */
X        today_tup = 1;
X    } else {
X        f_mtime (row, C_RISETM, ltr);
X        if (status & RS_2RISES) {
X        /* object rises more than once today */
X        f_char (row, C_RISETM+5, '+');
X        }
X        f_angle (row, C_RISEAZ, azr);
X    }
X
X    if (status & RS_NOTRANS)
X        f_string (row, C_TRANSTM, "No transit");
X    else {
X        f_mtime (row, C_TRANSTM, ltt);
X        if (status & RS_2TRANS)
X        f_char (row, C_TRANSTM+5, '+');
X        f_angle (row, C_TRANSALT, altt);
X    }
X
X    if (status & RS_NOSET) {
X        /* object does not set as such today */
X        f_string (row, C_SETTM, "Never sets");
X        lts = 24.0;    /* for TUP */
X        today_tup = 1;
X    } else {
X        f_mtime (row, C_SETTM, lts);
X        if (status & RS_2SETS)
X        f_char (row, C_SETTM+5, '+');
X        f_angle (row, C_SETAZ, azs);
X    }
X
X    tmp = lts - ltr;
X    if (tmp < 0)
X        tmp = 24.0 + tmp;
X    f_mtime (row, C_TUP, tmp);
X    if (today_tup)
X        f_char (row, C_TUP+5, '+');
X}
X
X/* print body info in third menu format. this may be either the geocentric
X *   or topocentric angular separation between object p and each of the others.
X *   the latter, of course, includes effects of refraction and so can change
X *   quite rapidly near the time of each planets rise or set.
X * for now, we don't save old values so we always redo everything and ignore
X *  the "force" argument. this isn't that bad since body_cir() has memory and
X *   will avoid most computations as we hit them again in the lower triangle.
X * we are limited to only 5 columns per object. to make it fit, we display
X *   degrees:minutes if less than 100 degrees, otherwise just whole degrees.
X */
X/*ARGSUSED*/
Xstatic
Xalt3_body (p, force, np)
Xint p;        /* which body, as in astro.h/screen.h defines */
Xint force;    /* whether to print for sure or only if things have changed */
XNow *np;
X{
X    int row = bodyrow[p];
X    Sky skyp, skyq;
X    double spy, cpy, px, *qx, *qy;
X    int wantx = obj_ison(OBJX);
X    int wanty = obj_ison(OBJY);
X    double as = plot_ison() || srch_ison() ? 0.0 : 60.0;
X    int q;
X
X    (void) body_cir (p, as, np, &skyp);
X    if (alt3_geoc) {
X        /* use ra for "x", dec for "y". */
X        spy = sin (skyp.s_dec);
X        cpy = cos (skyp.s_dec);
X        px = skyp.s_ra;
X        qx = &skyq.s_ra;
X        qy = &skyq.s_dec;
X    } else {
X        /* use azimuth for "x", altitude for "y". */
X        spy = sin (skyp.s_alt);
X        cpy = cos (skyp.s_alt);
X        px = skyp.s_az;
X        qx = &skyq.s_az;
X        qy = &skyq.s_alt;
X    }
X    for (q = nxtbody(-1); q != -1; q = nxtbody(q))
X        if (q != p && (q != OBJX || wantx) && (q != OBJY || wanty)) {
X        double sep, dsep;
X        (void) body_cir (q, as, np, &skyq);
X        sep = acos(spy*sin(*qy) + cpy*cos(*qy)*cos(px-*qx));
X        dsep = raddeg(sep);
X        if (dsep >= (100.0 - 1.0/60.0/2.0))
X            f_int (row, bodycol[q], "%5d:", dsep);
X        else
X            f_angle (row, bodycol[q], sep);
X        }
X}
END_OF_FILE
  if test 11329 -ne `wc -c <'altmenus.c'`; then
    echo shar: \"'altmenus.c'\" unpacked with wrong size!
  fi
  # end of 'altmenus.c'
fi
if test -f 'flog.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'flog.c'\"
else
  echo shar: Extracting \"'flog.c'\" \(3241 characters\)
  sed "s/^X//" >'flog.c' <<'END_OF_FILE'
X/* this is a simple little package to manage the saving and retrieving of
X * field values, which we call field logging or "flogs". a flog consists of a
X * field location, ala rcfpack(), its value as a double and its value as
X * a string (ie, however it was printed). you can reset the list of flogs, add
X * to and remove from the list of registered fields and log a field if it has
X * been registered.
X *
X * this is used by the plotting and searching facilities of ephem to maintain
X * the values of the fields that are being plotted or used in search
X * expressions. it is used by the listing facility to generate listing files.
X *
X * a field can be in use for more than one
X * thing at a time (eg, all the X plot values may the same time field, or
X * searching and plotting might be on at one time using the same field) so
X * we consider the field to be in use as long a usage count is > 0.
X */
X
X#include "screen.h"
X
Xextern char *strcpy(), *strncpy();
X
X#define    NFLOGS    32        /* max number of distinct simultaneous logged
X                 * fields
X                 */
X
Xtypedef struct {
X    int fl_usagecnt;    /* number of "users" logging to this field */
X    int fl_fld;        /* an rcfpack(r,c,0) */
X    double fl_val;        /* stored value as a double */
X    char fl_str[16];    /* stored value as a formatted string.
X                 * N.B.: never overwrite last char: keep as \0
X                 */
X} FLog;
X
Xstatic FLog flog[NFLOGS];
X
X/* add fld to the list. if already there, just increment usage count.
X * return 0 if ok, else -1 if no more room.
X */
Xflog_add (fld)
Xint fld;
X{
X    FLog *flp, *unusedflp = 0;
X
X    /* scan for fld already in list, or find an unused one along the way */
X    for (flp = &flog[NFLOGS]; --flp >= flog; ) {
X        if (flp->fl_usagecnt > 0) {
X        if (flp->fl_fld == fld) {
X            flp->fl_usagecnt++;
X            return (0);
X        }
X        } else
X        unusedflp = flp;
X    }
X    if (unusedflp) {
X        unusedflp->fl_fld = fld;
X        unusedflp->fl_usagecnt = 1;
X        return (0);
X    }
X    return (-1);
X}
X
X/* decrement usage count for flog for fld. if goes to 0 take it out of list.
X * ok if not in list i guess...
X */
Xflog_delete (fld)
Xint fld;
X{
X    FLog *flp;
X
X    for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X        if (--flp->fl_usagecnt <= 0) {
X            flp->fl_usagecnt = 0;
X        }
X        break;
X        }
X}
X
X/* if plotting, listing or searching is active then
X * if rcfpack(r,c,0) is in the fld list, set its value to val.
X * return 0 if ok, else -1 if not in list.
X */
Xflog_log (r, c, val, str)
Xint r, c;
Xdouble val;
Xchar *str;
X{
X    if (plot_ison() || listing_ison() || srch_ison()) {
X        FLog *flp;
X        int fld = rcfpack (r, c, 0);
X        for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X            flp->fl_val = val;
X            (void) strncpy (flp->fl_str, str, sizeof(flp->fl_str)-1);
X            return(0);
X        }
X        return (-1);
X    } else
X        return (0);
X}
X
X/* search for fld in list. if find it, return its value and str, if str.
X * return 0 if found it, else -1 if not in list.
X */
Xflog_get (fld, vp, str)
Xint fld;
Xdouble *vp;
Xchar *str;
X{
X    FLog *flp;
X
X    for (flp = &flog[NFLOGS]; --flp >= flog; )
X        if (flp->fl_fld == fld && flp->fl_usagecnt > 0) {
X        *vp = flp->fl_val;
X        if (str)
X            (void) strcpy (str, flp->fl_str);
X        return (0);
X        }
X    return (-1);
X}
END_OF_FILE
  if test 3241 -ne `wc -c <'flog.c'`; then
    echo shar: \"'flog.c'\" unpacked with wrong size!
  fi
  # end of 'flog.c'
fi
if test -f 'formats.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'formats.c'\"
else
  echo shar: Extracting \"'formats.c'\" \(7430 characters\)
  sed "s/^X//" >'formats.c' <<'END_OF_FILE'
X/* basic formating routines.
X * all the screen oriented printing should go through here.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include <ctype.h>
X#ifdef VMS
X#include <stdlib.h>
X#endif
X#include "astro.h"
X#include "screen.h"
X
Xextern char *strcpy();
X
X/* suppress screen io if this is true, but always flog stuff.
X */
Xstatic int f_scrnoff;
Xf_on ()
X{
X    f_scrnoff = 0;
X}
Xf_off ()
X{
X    f_scrnoff = 1;
X}
X
X/* draw n blanks at the given cursor position.  */
Xf_blanks (r, c, n)
Xint r, c, n;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (r, c);
X    while (--n >= 0)
X        putchar (' ');
X}
X
X/* print the given value, v, in "sexadecimal" format at [r,c]
X * ie, in the form A:m.P, where A is a digits wide, P is p digits.
X * if p == 0, then no decimal point either.
X */
Xf_sexad (r, c, a, p, mod, v)
Xint r, c;
Xint a, p;    /* left space, min precision */
Xint mod;    /* don't let whole portion get this big */
Xdouble v;
X{
X    char astr[32], str[32];
X    long dec;
X    double frac;
X    int visneg;
X    double vsav = v;
X
X    if (v >= 0.0)
X        visneg = 0;
X    else {
X        if (v <= -0.5/60.0*pow(10.0,-1.0*p)) {
X        v = -v;
X        visneg = 1;
X        } else {
X        /* don't show as negative if less than the precision showing */
X        v = 0.0;
X        visneg = 0;
X        }
X    }
X
X    dec = v;
X    frac = (v - dec)*60.0;
X    (void) sprintf (str, "59.%.*s5", p, "999999999");
X    if (frac >= atof (str)) {
X        dec += 1;
X        frac = 0.0;
X    }
X    dec %= mod;
X    if (dec == 0 && visneg)
X        (void) strcpy (str, "-0");
X    else
X        (void) sprintf (str, "%ld", visneg ? -dec : dec);
X
X    /* would just do this if Turbo-C 2.0 %?.0f" worked:
X     * sprintf (astr, "%*s:%0*.*f", a, str, p == 0 ? 2 : p+3, p, frac);
X     */
X    if (p == 0)
X        (void) sprintf (astr, "%*s:%02d", a, str, (int)(frac+0.5));
X    else
X        (void) sprintf (astr, "%*s:%0*.*f", a, str, p+3, p, frac);
X
X    (void) flog_log (r, c, vsav, astr);
X
X    f_string (r, c, astr);
X}
X
X/* print the given value, t, in sexagesimal format at [r,c]
X * ie, in the form T:mm:ss, where T is nd digits wide.
X * N.B. we assume nd >= 2.
X */
Xf_sexag (r, c, nd, t)
Xint r, c, nd;
Xdouble t;
X{
X    char tstr[32];
X    int h, m, s;
X    int tisneg;
X
X    dec_sex (t, &h, &m, &s, &tisneg);
X    if (h == 0 && tisneg)
X        (void) sprintf (tstr, "%*s-0:%02d:%02d", nd-2, "", m, s);
X    else
X        (void) sprintf (tstr, "%*d:%02d:%02d", nd, tisneg ? -h : h, m, s);
X
X    (void) flog_log (r, c, t, tstr);
X    f_string (r, c, tstr);
X}
X
X/* print angle ra, in radians, in ra hours as hh:mm.m at [r,c]
X * N.B. we assume ra is >= 0.
X */
Xf_ra (r, c, ra)
Xint r, c;
Xdouble ra;
X{
X    f_sexad (r, c, 2, 1, 24, radhr(ra));
X}
X
X/* print time, t, as hh:mm:ss */
Xf_time (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexag (r, c, 2, t);
X}
X
X/* print time, t, as +/-hh:mm:ss (don't show leading +) */
Xf_signtime (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexag (r, c, 3, t);
X}
X
X/* print time, t, as hh:mm */
Xf_mtime (r, c, t)
Xint r, c;
Xdouble t;
X{
X    f_sexad (r, c, 2, 0, 24, t);
X}
X
X/* print angle, a, in rads, as degress at [r,c] in form ddd:mm */
Xf_angle(r, c, a)
Xint r, c;
Xdouble a;
X{
X    f_sexad (r, c, 3, 0, 360, raddeg(a));
X}
X
X/* print angle, a, in rads, as degress at [r,c] in form dddd:mm:ss */
Xf_gangle(r, c, a)
Xint r, c;
Xdouble a;
X{
X    f_sexag (r, c, 4, raddeg(a));
X}
X
X/* print the given modified Julian date, jd, as the starting date at [r,c]
X * in the form mm/dd/yyyy.
X */
Xf_date (r, c, jd)
Xint r, c;
Xdouble jd;
X{
X    char dstr[32];
X    int m, y;
X    double d, tmp;
X
X    mjd_cal (jd, &m, &d, &y);
X    (void) sprintf (dstr, "%2d/%02d/%-4d", m, (int)(d), y);
X
X    /* shadow to the plot subsystem as years. */
X    mjd_year (jd, &tmp);
X    (void) flog_log (r, c, tmp, dstr);
X    f_string (r, c, dstr);
X}
X
X/* print the given double as a rounded int, with the given format.
X * this is used to plot full precision, but display far less.
X * N.B. caller beware that we really do expect fmt to refer to an int, not
X *   a long for example. also beware of range that implies.
X */
Xf_int (row, col, fmt, f)
Xint row, col;
Xchar fmt[];
Xdouble f;
X{
X    char str[80];
X    int i;
X
X    i = (f < 0) ? (int)(f-0.5) : (int)(f+0.5);
X    (void) sprintf (str, fmt, i);
X
X    (void) flog_log (row, col, f, str);
X    f_string (row, col, str);
X}
X
Xf_char (row, col, c)
Xint row, col;
Xchar c;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (row, col);
X    putchar (c);
X}
X
Xf_string (r, c, s)
Xint r, c;
Xchar *s;
X{
X    if (f_scrnoff)
X        return;
X    c_pos (r, c);
X    (void) fputs (s, stdout);
X}
X
Xf_double (r, c, fmt, f)
Xint r, c;
Xchar *fmt;
Xdouble f;
X{
X    char str[80];
X    (void) sprintf (str, fmt, f);
X    (void) flog_log (r, c, f, str);
X    f_string (r, c, str);
X}
X
X/* print prompt line */
Xf_prompt (p)
Xchar *p;
X{
X    c_pos (R_PROMPT, C_PROMPT);
X    c_eol ();
X    c_pos (R_PROMPT, C_PROMPT);
X    (void) fputs (p, stdout);
X}
X
X/* clear from [r,c] to end of line, if we are drawing now. */
Xf_eol (r, c)
Xint r, c;
X{
X    if (!f_scrnoff) {
X        c_pos (r, c);
X        c_eol();
X    }
X}
X
X/* print a message and wait for op to hit any key */
Xf_msg (m)
Xchar *m;
X{
X    f_prompt (m);
X    (void) read_char();
X}
X
X/* crack a line of the form X?X?X into its components,
X *   where X is an integer and ? can be any character except '0-9' or '-',
X *   such as ':' or '/'.
X * only change those fields that are specified:
X *   eg:  ::10    only changes *s
X *        10    only changes *d
X *        10:0  changes *d and *m
X * if see '-' anywhere, first non-zero component will be made negative.
X */
Xf_sscansex (bp, d, m, s)
Xchar *bp;
Xint *d, *m, *s;
X{
X    char c;
X    int *p = d;
X    int *nonzp = 0;
X    int sawneg = 0;
X    int innum = 0;
X
X    while (c = *bp++)
X        if (isdigit(c)) {
X        if (!innum) {
X            *p = 0;
X            innum = 1;
X        }
X        *p = *p*10 + (c - '0');
X        if (*p && !nonzp)
X            nonzp = p;
X        } else if (c == '-') {
X        sawneg = 1;
X        } else if (c != ' ') {
X        /* advance to next component */
X        p = (p == d) ? m : s;
X        innum = 0;
X        }
X
X    if (sawneg && nonzp)
X        *nonzp = -*nonzp;
X}
X
X/* crack a floating date string, bp, of the form m/d/y, where d may be a
X *   floating point number, into its components.
X * leave any component unspecified unchanged.
X * actually, the slashes may be anything but digits or a decimal point.
X * this is functionally the same as f_sscansex() exept we allow for
X *   the day portion to be real, and we don't handle negative numbers.
X *   maybe someday we could make a combined one and use it everywhere.
X */
Xf_sscandate (bp, m, d, y)
Xchar *bp;
Xint *m, *y;
Xdouble *d;
X{
X    char *bp0, c;
X
X    bp0 = bp;
X    while ((c = *bp++) && isdigit(c))
X        continue;
X    if (bp > bp0+1)
X        *m = atoi (bp0);
X    if (c == '\0')
X        return;
X    bp0 = bp;
X    while ((c = *bp++) && (isdigit(c) || c == '.'))
X        continue;
X    if (bp > bp0+1)
X        *d = atof (bp0);
X    if (c == '\0')
X        return;
X    bp0 = bp;
X    while (c = *bp++)
X        continue;
X    if (bp > bp0+1)
X        *y = atoi (bp0);
X}
X
X/* just like dec_sex() but makes the first non-zero element negative if
X * x is negative (instead of returning a sign flag).
X */
Xf_dec_sexsign (x, h, m, s)
Xdouble x;
Xint *h, *m, *s;
X{
X    int n;
X    dec_sex (x, h, m, s, &n);
X    if (n) {
X        if (*h)
X        *h = -*h;
X        else if (*m)
X        *m = -*m;
X        else
X        *s = -*s;
X    }
X}
X
X/* return 1 if bp looks like a decimal year; else 0.
X * any number greater than 12 or less than 0 is assumed to be a year, or any
X * string with exactly one decimal point, an optional minus sign, and nothing
X * else but digits.
X */
Xdecimal_year (bp)
Xchar *bp;
X{
X    char c;
X    int ndig = 0, ndp = 0, nneg = 0, nchar = 0;
X    double y = atof(bp);
X
X    while (c = *bp++) {
X        nchar++;
X        if (isdigit(c))
X        ndig++;
X        else if (c == '.')
X        ndp++;
X        else if (c == '-')
X        nneg++;
X    }
X
X    return (y > 12 || y < 0
X            || (ndp == 1 && nneg <= 1 && nchar == ndig+ndp+nneg));
X}
END_OF_FILE
  if test 7430 -ne `wc -c <'formats.c'`; then
    echo shar: \"'formats.c'\" unpacked with wrong size!
  fi
  # end of 'formats.c'
fi
if test -f 'listing.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'listing.c'\"
else
  echo shar: Extracting \"'listing.c'\" \(7576 characters\)
  sed "s/^X//" >'listing.c' <<'END_OF_FILE'
X/* code to support the listing capabilities.
X * idea is to let the operator name a listing file and mark some fields for
X * logging. then after each screen update, the logged fields are written to
X * the listing file in the same manner as they appeared on the screen.
X *
X * format of the listing file is one line per screen update.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "screen.h"
X
Xextern char *strcpy();
X
X#ifdef VMS
X#include <perror.h>
X#include <errno.h>
X#else
Xextern char *sys_errlist[];
Xextern errno;
X#endif
X
X#define    errsys    (sys_errlist[errno])
X
X
X#define    TRACE(x)    {FILE *fp = fopen("trace","a"); fprintf x; fclose(fp);}
X
X#define    MAXLSTFLDS    10    /* max number of fields we can track.
X                 * note we can't store more than NFLOGS fields
X                 * anyway (see flog.c).
X                 */
X#define    FNLEN        (14+1)    /* longest filename; plus 1 for \0 */
X
Xstatic char lst_filename[FNLEN] = "ephem.lst";    /* default plot file name */
Xstatic FILE *lst_fp;        /* the plot file; == 0 means don't plot */
X
X/* store rcfpack()s for each field to track, in l-to-r order */
Xstatic int lstflds[MAXLSTFLDS];
Xstatic int nlstflds;        /* number of lstflds[] in actual use */
X
Xstatic int lstsrchfld;        /* set when the Search field is to be listed */
X
X/* picked the Listing label:
X * if on, just turn it off.
X * if off, turn on, define fields or select name of file to list to and do it.
X * TODO: more flexibility, more relevance.
X */
Xlisting_setup()
X{
X    if (lst_fp)
X        lst_turn_off();
X    else {
X        static char *chcs[] = {
X        "Select fields", "Display a listing file", "Begin listing"
X        };
X        static int fn;    /* start with 0, then remember for next time */
X    ask:
X        switch (popup(chcs, fn, nlstflds > 0 ? 3 : 2)) {
X        case 0: fn = 0; lst_select_fields(); goto ask;
X        case 1: fn = 1; lst_file(); goto ask;
X        case 2: fn = 2; lst_turn_on(); break;
X        default: break;
X        }
X    }
X}
X
X/* write the active listing to the current listing file, if one is open. */
Xlisting()
X{
X    if (lst_fp) {
X        int n;
X        double flx;
X        char flstr[32];
X        if (!srch_ison() && lstsrchfld) {
X        /* if searching is not on but we are listing the search
X         * funtion we must evaluate and log it ourselves here and now.
X         * lst_turn_on() insured there is a good function to eval.
X         * N.B. if searching IS on, we rely on main() having called
X         * srch_eval() BEFORE plot() so it is already evaluated.
X         */
X        double e;
X        char errmsg[128];
X        if (execute_expr (&e, errmsg) < 0) {
X            f_msg (errmsg);
X            lst_turn_off();
X            return;
X        } else {
X            (void) sprintf (flstr, "%g", e);
X            (void) flog_log (R_SRCH, C_SRCH, e, flstr);
X        }
X        }
X
X        /* list in order of original selection */
X        for (n = 0; n < nlstflds; n++)
X        if (flog_get (lstflds[n], &flx, flstr) == 0)
X            (void) fprintf (lst_fp, "%s  ", flstr);
X        (void) fprintf (lst_fp, "\n");
X    }
X}
X
Xlisting_prstate (force)
Xint force;
X{
X    static last;
X    int this = lst_fp != 0;
X
X    if (force || this != last) {
X        f_string (R_LISTING, C_LISTINGV, this ? " on" : "off");
X        last = this;
X    }
X}
X
Xlisting_ison()
X{
X    return (lst_fp != 0);
X}
X
Xstatic
Xlst_reset()
X{
X    int *lp;
X
X    for (lp = lstflds; lp < &lstflds[nlstflds]; lp++) {
X        (void) flog_delete (*lp);
X        *lp = 0;
X    }
X    nlstflds = 0;
X    lstsrchfld = 0;
X}
X
X/* let operator select the fields he wants to have in his listing.
X * register them with flog and keep rcfpack() in lstflds[] array.
X * as a special case, set lstsrchfld if Search field is selected.
X */
Xstatic
Xlst_select_fields()
X{
X    static char hlp[] = "move and RETURN to select a field, or q to quit";
X    static char sry[] = "Sorry; can not list any more fields.";
X    int f = rcfpack(R_UT,C_UTV,0); /* TODO: start where main was? */
X    int sf = rcfpack (R_SRCH,C_SRCH,0);
X    char buf[64];
X    int i;
X
X    lst_reset();
X    for (i = 0; i < MAXLSTFLDS; i++) {
X        (void) sprintf(buf,"select field for column %d or q to quit", i+1);
X        f = sel_fld (f, alt_menumask()|F_PLT, buf, hlp);
X        if (!f)
X        break;
X        if (flog_add (f) < 0) {
X        f_msg (sry);
X        break;
X        }
X        lstflds[i] = f;
X        if (f == sf)
X        lstsrchfld = 1;
X    }
X    if (i == MAXLSTFLDS)
X        f_msg (sry);
X    nlstflds = i;
X}
X
Xstatic
Xlst_turn_off ()
X{
X    (void) fclose (lst_fp);
X    lst_fp = 0;
X    listing_prstate(0);
X}
X
X/* turn on listing facility.
X * establish a file to use (and thereby set lst_fp, the "listing-is-on" flag).
X * also check that there is a srch function if it is being used.
X */
Xstatic
Xlst_turn_on ()
X{
X    int sf = rcfpack(R_SRCH, C_SRCH, 0);
X    char fn[FNLEN], fnq[NC];
X    char *optype;
X    int n;
X
X    /* insure there is a valid srch function if we are to list it */
X    for (n = 0; n < nlstflds; n++)
X        if (lstflds[n] == sf && !prog_isgood()) {
X        f_msg ("Listing search function but it is not defined.");
X        return;
X        }
X
X    /* prompt for file name, giving current as default */
X    (void) sprintf (fnq, "file to write <%s>: ", lst_filename);
X    f_prompt (fnq);
X    n = read_line (fn, sizeof(fn)-1);
X
X    /* leave plotting off if type END.
X     * reuse same fn if just type \n
X     */
X    if (n < 0)
X        return;
X    if (n > 0)
X        (void) strcpy (lst_filename, fn);
X
X    /* give option to append if file already exists */
X    optype = "w";
X    if (access (lst_filename, 2) == 0) {
X        while (1) {
X        f_prompt ("files exists; append or overwrite (a/o)?: ");
X        n = read_char();
X        if (n == 'a') {
X            optype = "a";
X            break;
X        }
X        if (n == 'o')
X            break;
X        }
X    }
X
X    /* listing is on if file opens ok */
X    lst_fp = fopen (lst_filename, optype);
X    if (!lst_fp) {
X        (void) sprintf (fnq, "can not open %s: %s", lst_filename, errsys);
X        f_msg (fnq);
X    } else {
X        /* add a title if desired */
X        static char tp[] = "Title (q to skip): ";
X        f_prompt (tp);
X        if (read_line (fnq, PW - sizeof(tp)) > 0)
X        (void) fprintf (lst_fp, "%s\n", fnq);
X    }
X
X    listing_prstate (0);
X}
X
X/* ask operator for a listing file to show. if it's ok, do it.
X */
Xstatic
Xlst_file ()
X{
X    char fn[FNLEN], fnq[64];
X    FILE *lfp;
X    int n;
X
X    /* prompt for file name, giving current as default */
X    (void) sprintf (fnq, "file to read <%s>: ", lst_filename);
X    f_prompt (fnq);
X    n = read_line (fn, sizeof(fn)-1);
X
X    /* forget it if type END.
X     * reuse same fn if just type \n
X     */
X    if (n < 0)
X        return;
X    if (n > 0)
X        (void) strcpy (lst_filename, fn);
X
X    /* show it if file opens ok */
X    lfp = fopen (lst_filename, "r");
X    if (lfp) {
X        display_listing_file (lfp);
X        (void) fclose (lfp);
X    } else {
X        char buf[NC];
X        (void) sprintf (buf, "can not open %s: %s", lst_filename, errsys);
X        f_prompt (buf);
X        (void)read_char();
X    }
X}
X
X/* display the given listing file on the screen.
X * allow for files longer than the screen.
X * N.B. do whatever you like but redraw the screen when done.
X */
Xstatic
Xdisplay_listing_file (lfp)
XFILE *lfp;
X{
X    static char eofp[] = "[End-of-file. Hit any key to resume...] ";
X    static char p[] =    "[Hit any key to continue or q to quit...] ";
X    char buf[NC+2];    /* screen width plus for '\n' and '\0' */
X    int nc, nl;
X
X    c_erase();
X    nl = 0;
X    while (1) {
X        (void) fgets (buf, sizeof(buf), lfp);
X        if (feof(lfp)) {
X        printf (eofp);
X        (void) read_char();
X        break;
X        }
X        /* make sure last char is \n, even if it's a long line */
X        nc = strlen (buf);
X        if (nc == NC+1) {
X        (void) ungetc (buf[NC], lfp);
X        buf[NC] = '\n';
X        }
X        printf ("%s\r", buf);
X        if (++nl == NR-1) {
X        /* read-ahead one char to check for eof */
X        int rach = getc (lfp);
X        if (feof(lfp)) {
X            (void) printf (eofp);
X            (void) read_char();
X            break;
X        } else
X            (void) ungetc (rach, lfp);
X        (void) printf (p);
X        if (read_char() == END)
X            break;
X        c_erase();
X        nl = 0;
X        }
X    }
X
X    redraw_screen (2);    /* full redraw */
X}
END_OF_FILE
  if test 7576 -ne `wc -c <'listing.c'`; then
    echo shar: \"'listing.c'\" unpacked with wrong size!
  fi
  # end of 'listing.c'
fi
if test -f 'plot.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'plot.c'\"
else
  echo shar: Extracting \"'plot.c'\" \(11208 characters\)
  sed "s/^X//" >'plot.c' <<'END_OF_FILE'
X/* code to support the plotting capabilities.
X * idea is to let the operator name a plot file and mark some fields for
X * logging. then after each screen update, the logged fields are written to
X * the plot file. later, the file may be plotted (very simplistically by
X * ephem, for now anyway, or by some other program entirely.).
X *
X * format of the plot file is one line per coordinate: label,x,y
X * if z was specified, it is a fourth field.
X * x,y,z are plotted using %g format.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "screen.h"
X
Xextern char *strcpy();
X
X#ifdef VMS
X#include <perror.h>
X#include <errno.h>
X#else
Xextern char *sys_errlist[];
Xextern errno;
X#endif
X
X#define    errsys    (sys_errlist[errno])
X
X
X#define    TRACE(x)    {FILE *fp = fopen("trace","a"); fprintf x; fclose(fp);}
X
X#define    MAXPLTLINES    10    /* max number of labeled lines we can track.
X                 * note we can't store more than NFLOGS fields
X                 * anyway (see flog.c).
X                 */
X#define    FNLEN        (14+1)    /* longest filename; plus 1 for \0 */
X
Xstatic char plt_filename[FNLEN] = "ephem.plt";    /* default plot file name */
Xstatic FILE *plt_fp;        /* the plot file; == 0 means don't plot */
X
X/* store the label and rcfpack()s for each line to track. */
Xtypedef struct {
X    char pl_label;
X    int pl_rcpx, pl_rcpy, pl_rcpz;
X} PltLine;
Xstatic PltLine pltlines[MAXPLTLINES];
Xstatic int npltlines;        /* number of pltlines[] in actual use */
X
Xstatic int plt_in_polar;    /*if true plot in polar coords, else cartesian*/
Xstatic int pltsrchfld;        /* set when the Search field is to be plotted */
X
X/* picked the Plot label:
X * if on, just turn it off.
X * if off, turn on, define fields or select name of file to plot and do it.
X * TODO: more flexibility, more relevance.
X */
Xplot_setup()
X{
X    if (plt_fp)
X        plt_turn_off();
X    else {
X        static char *chcs[4] = {
X        "Select fields", "Display a plot file", (char *)0,
X        "Begin plotting"
X        };
X        static int fn;    /* start with 0, then remember for next time */
X    ask:
X        chcs[2] = plt_in_polar ? "Polar coords" : "Cartesian coords";
X        switch (popup(chcs, fn, npltlines > 0 ? 4 : 3)) {
X        case 0: fn = 0; plt_select_fields(); goto ask;
X        case 1: fn = 1; plt_file(); goto ask;
X        case 2: fn = 2; plt_in_polar ^= 1; goto ask;
X        case 3: fn = 3; plt_turn_on(); break;
X        default: break;
X        }
X    }
X}
X
X/* write the active plotfields to the current plot file, if one is open. */
Xplot()
X{
X    if (plt_fp) {
X        PltLine *plp;
X        double x, y, z;
X        if (!srch_ison() && pltsrchfld) {
X        /* if searching is not on but we are plotting the search
X         * funtion we must evaluate and log it ourselves here and now.
X         * plt_turn_on() insured there is a good function to eval.
X         * N.B. if searching IS on, we rely on main() having called
X         * srch_eval() BEFORE plot() so it is already evaluated.
X         */
X        double e;
X        char errmsg[128];
X        if (execute_expr (&e, errmsg) < 0) {
X            f_msg (errmsg);
X            plt_turn_off();
X            return;
X        } else
X            (void) flog_log (R_SRCH, C_SRCH, e, "");
X        }
X        /* plot in order of original selection */
X        for (plp = pltlines; plp < &pltlines[npltlines]; plp++) {
X        if (flog_get (plp->pl_rcpx, &x, (char *)0) == 0
X            && flog_get (plp->pl_rcpy, &y, (char *)0) == 0) {
X            (void) fprintf (plt_fp, "%c,%.12g,%.12g", plp->pl_label,
X                                    x, y);
X            if (flog_get (plp->pl_rcpz, &z, (char *)0) == 0)
X            (void) fprintf (plt_fp, ",%.12g", z);
X            (void) fprintf (plt_fp, "\n");
X        }
X        }
X    }
X}
X
Xplot_prstate (force)
Xint force;
X{
X    static last;
X    int this = plt_fp != 0;
X
X    if (force || this != last) {
X        f_string (R_PLOT, C_PLOTV, this ? " on" : "off");
X        last = this;
X    }
X}
X
Xplot_ison()
X{
X    return (plt_fp != 0);
X}
X
Xstatic
Xplt_reset()
X{
X    PltLine *plp;
X
X    for (plp = &pltlines[npltlines]; --plp >= pltlines; ) {
X        (void) flog_delete (plp->pl_rcpx);
X        (void) flog_delete (plp->pl_rcpy);
X        (void) flog_delete (plp->pl_rcpz);
X        plp->pl_rcpx = plp->pl_rcpy = plp->pl_rcpz = 0;
X    }
X    npltlines = 0;
X    pltsrchfld = 0;
X}
X
X/* let operator select the fields he wants to plot.
X * register them with flog and keep rcfpack() in pltlines[] array.
X * as a special case, set pltsrchfld if Search field is selected.
X */
Xstatic
Xplt_select_fields()
X{
X    static char hlp[] = "move and RETURN to select a field, or q to quit";
X    static char sry[] = "Sorry; can not log any more fields.";
X    int f = rcfpack(R_UT,C_UTV,0); /* TODO: start where main was? */
X    int sf = rcfpack (R_SRCH, C_SRCH, 0);
X    char buf[64];
X    int i;
X    int tmpf;
X
X    plt_reset();
X    for (i = 0; i < MAXPLTLINES; i++) {
X        (void) sprintf (buf, "select x field for line %d", i+1);
X        f = sel_fld (f, alt_menumask()|F_PLT, buf, hlp);
X        if (!f)
X        break;
X        if (flog_add (f) < 0) {
X        f_msg (sry);
X        break;
X        }
X        pltlines[i].pl_rcpx = f;
X        if (f == sf)
X        pltsrchfld = 1;
X
X        (void) sprintf (buf, "select y field for line %d", i+1);
X        f = sel_fld (f, alt_menumask()|F_PLT, buf, hlp);
X        if (!f) {
X        (void) flog_delete (pltlines[i].pl_rcpx);
X        break;
X        }
X        if (flog_add (f) < 0) {
X        (void) flog_delete (pltlines[i].pl_rcpx);
X        f_msg (sry);
X        break;
X        }
X        pltlines[i].pl_rcpy = f;
X        if (f == sf)
X        pltsrchfld = 1;
X
X        (void) sprintf (buf, "select z field for line %d (q for no z)",i+1);
X        tmpf = sel_fld (f, alt_menumask()|F_PLT, buf, hlp);
X        if (tmpf) {
X        if (flog_add (tmpf) < 0) {
X            (void) flog_delete (pltlines[i].pl_rcpx);
X            (void) flog_delete (pltlines[i].pl_rcpy);
X            f_msg (sry);
X            break;
X        }
X        pltlines[i].pl_rcpz = tmpf;
X        if (tmpf == sf)
X            pltsrchfld = 1;
X        f = tmpf;
X        }
X
X        do {
X        (void) sprintf(buf,"enter a one-character label for line %d: ",
X                                    i+1);
X        f_prompt (buf);
X        } while (read_line (buf, 1) != 1);
X        pltlines[i].pl_label = *buf;
X    }
X    npltlines = i;
X}
X
Xstatic
Xplt_turn_off ()
X{
X    (void) fclose (plt_fp);
X    plt_fp = 0;
X    plot_prstate(0);
X}
X
X/* turn on plotting.
X * establish a file to use (and thereby set plt_fp, the plotting_is_on flag).
X * also check that there is a srch function if it is being plotted.
X */
Xstatic
Xplt_turn_on ()
X{
X    int sf = rcfpack(R_SRCH, C_SRCH, 0);
X    char fn[FNLEN], fnq[NC];
X    char *optype;
X    int n;
X    PltLine *plp;
X
X    /* insure there is a valid srch function if we are to plot it */
X    for (plp = &pltlines[npltlines]; --plp >= pltlines; )
X        if ((plp->pl_rcpx == sf || plp->pl_rcpy == sf || plp->pl_rcpz == sf)
X            && !prog_isgood()) {
X        f_msg ("Plotting search function but it is not defined.");
X        return;
X        }
X
X    /* prompt for file name, giving current as default */
X    (void) sprintf (fnq, "file to write <%s>: ", plt_filename);
X    f_prompt (fnq);
X    n = read_line (fn, sizeof(fn)-1);
X
X    /* leave plotting off if type END.
X     * reuse same fn if just type \n
X     */
X    if (n < 0)
X        return;
X    if (n > 0)
X        (void) strcpy (plt_filename, fn);
X
X    /* give option to append if file already exists */
X    optype = "w";
X    if (access (plt_filename, 2) == 0) {
X        while (1) {
X        f_prompt ("files exists; append or overwrite (a/o)?: ");
X        n = read_char();
X        if (n == 'a') {
X            optype = "a";
X            break;
X        }
X        if (n == 'o')
X            break;
X        }
X    }
X
X    /* plotting is on if file opens ok */
X    plt_fp = fopen (plt_filename, optype);
X    if (!plt_fp) {
X        char buf[NC];
X        (void) sprintf (buf, "can not open %s: %s", plt_filename, errsys);
X        f_prompt (buf);
X        (void)read_char();
X    } else {
X        /* add a title if desired */
X        static char tp[] = "Title (q to skip): ";
X        f_prompt (tp);
X        if (read_line (fnq, PW - sizeof(tp)) > 0)
X        (void) fprintf (plt_fp, "* %s\n", fnq);
X    }
X    plot_prstate (0);
X}
X
X/* ask operator for a file to plot. if it's ok, do it.
X */
Xstatic
Xplt_file ()
X{
X    char fn[FNLEN], fnq[64];
X    FILE *pfp;
X    int n;
X
X    /* prompt for file name, giving current as default */
X    (void) sprintf (fnq, "file to read <%s>: ", plt_filename);
X    f_prompt (fnq);
X    n = read_line (fn, sizeof(fn)-1);
X
X    /* forget it if type END.
X     * reuse same fn if just type \n
X     */
X    if (n < 0)
X        return;
X    if (n > 0)
X        (void) strcpy (plt_filename, fn);
X
X    /* do the plot if file opens ok */
X    pfp = fopen (plt_filename, "r");
X    if (pfp) {
X        if (plt_in_polar)
X        plot_polar (pfp);
X        else
X        plot_cartesian (pfp);
X        (void) fclose (pfp);
X    } else {
X        char buf[NC];
X        (void) sprintf (buf, "can not open %s: %s", plt_filename, errsys);
X        f_prompt (buf);
X        (void)read_char();
X    }
X}
X
X/* plot the given file on the screen in cartesian coords.
X * TODO: add z tags somehow
X * N.B. do whatever you like but redraw the screen when done.
X */
Xstatic
Xplot_cartesian (pfp)
XFILE *pfp;
X{
X    static char fmt[] = "%c,%lf,%lf";
X    double x, y;    /* N.B. be sure these match what scanf's %lf wants*/
X    double minx, maxx, miny, maxy;
X    char buf[128];
X    int npts = 0;
X    char c;
X
X    /* find ranges and number of points */
X    while (fgets (buf, sizeof(buf), pfp)) {
X        if (sscanf (buf, fmt, &c, &x, &y) != 3)
X        continue;
X        if (npts++ == 0) {
X        maxx = minx = x;
X        maxy = miny = y;
X        } else {
X        if (x > maxx) maxx = x;
X        else if (x < minx) minx = x;
X        if (y > maxy) maxy = y;
X        else if (y < miny) miny = y;
X        }
X    }
X
X#define    SMALL    (1e-10)
X    if (npts < 2 || fabs(minx-maxx) < SMALL || fabs(miny-maxy) < SMALL)
X        f_prompt ("At least two different points required to plot.");
X    else {
X        /* read file again, this time plotting */
X        rewind (pfp);
X        c_erase();
X        while (fgets (buf, sizeof(buf), pfp)) {
X        int row, col;
X        if (sscanf (buf, fmt, &c, &x, &y) != 3)
X            continue;
X        row = NR-(int)((NR-1)*(y-miny)/(maxy-miny)+0.5);
X        col =  1+(int)((NC-1)*(x-minx)/(maxx-minx)+0.5);
X        if (row == NR && col == NC)
X            col--;    /* avoid lower right scrolling corner */
X        f_char (row, col, c);
X        }
X
X        /* label axes */
X        f_double (1, 1, "%g", maxy);
X        f_double (NR-1, 1, "%g", miny);
X        f_double (NR, 1, "%g", minx);
X        f_double (NR, NC-10, "%g", maxx);
X    }
X
X    /* hit any key to resume... */
X    (void) read_char();
X    redraw_screen (2);    /* full redraw */
X}
X
X/* plot the given file on the screen in polar coords.
X * first numberic field in plot file is r, second is theta in degrees.
X * TODO: add z tags somehow
X * N.B. do whatever you like but redraw the screen when done.
X */
Xstatic
Xplot_polar (pfp)
XFILE *pfp;
X{
X    static char fmt[] = "%c,%lf,%lf";
X    double r, th;    /* N.B. be sure these match what scanf's %lf wants*/
X    double maxr;
X    char buf[128];
X    int npts = 0;
X    char c;
X
X    /* find ranges and number of points */
X    while (fgets (buf, sizeof(buf), pfp)) {
X        if (sscanf (buf, fmt, &c, &r, &th) != 3)
X        continue;
X        if (npts++ == 0)
X        maxr = r;
X        else
X        if (r > maxr)
X            maxr = r;
X    }
X
X    if (npts < 2)
X        f_prompt ("At least two points required to plot.");
X    else {
X        /* read file again, this time plotting */
X        rewind (pfp);
X        c_erase();
X        while (fgets (buf, sizeof(buf), pfp)) {
X        int row, col;
X        double x, y;
X        if (sscanf (buf, fmt, &c, &r, &th) != 3)
X            continue;
X        x = r * cos(th/57.2958);    /* degs to rads */
X        y = r * sin(th/57.2958);
X        row = NR-(int)((NR-1)*(y+maxr)/(2.0*maxr)+0.5);
X        col =  1+(int)((NC-1)*(x+maxr)/(2.0*maxr)/ASPECT+0.5);
X        if (row == NR && col == NC)
X            col--;    /* avoid lower right scrolling corner */
X        f_char (row, col, c);
X        }
X
X        /* label radius */
X        f_double (NR/2, NC-10, "%g", maxr);
X    }
X
X    /* hit any key to resume... */
X    (void) read_char();
X    redraw_screen (2);    /* full redraw */
X}
END_OF_FILE
  if test 11208 -ne `wc -c <'plot.c'`; then
    echo shar: \"'plot.c'\" unpacked with wrong size!
  fi
  # end of 'plot.c'
fi
if test -f 'srch.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'srch.c'\"
else
  echo shar: Extracting \"'srch.c'\" \(8160 characters\)
  sed "s/^X//" >'srch.c' <<'END_OF_FILE'
X/* this file contains functions to support iterative ephem searches.
X * we support several kinds of searching and solving algorithms.
X * values used in the evaluations come from the field logging flog.c system.
X * the expressions being evaluated are compiled and executed from compiler.c.
X */
X
X#include <stdio.h>
X#include <math.h>
X#include "screen.h"
X
Xextern char *strcpy();
X
Xstatic int (*srch_f)();
Xstatic int srch_tmscalled;
Xstatic char expbuf[NC];        /* [0] == '\0' when expression is invalid */
Xstatic double tmlimit = 1./60.;    /* search accuracy, in hrs; def is one minute */
X
X
Xsrch_setup()
X{
X    int srch_minmax(), srch_solve0(), srch_binary();
X    static char *chcs[] = {
X        "Find extreme", "Find 0", "Binary", "New function", "Accuracy",
X        "Stop"
X    };
X    static int fn;    /* start with 0, then remember for next time */
X
X    /* let op select algorithm, edit, set accuracy
X     * or stop if currently searching
X     * algorithms require a function.
X     */
X    ask:
X    switch (popup(chcs, fn, srch_f ? 6 : 5)) {
X    case 0: fn = 0;
X        if (expbuf[0] == '\0')
X            set_function();
X        srch_f = expbuf[0] ? srch_minmax : (int (*)())0;
X        if (srch_f)
X            break;
X        else
X            goto ask;
X    case 1: fn = 1;
X        if (expbuf[0] == '\0')
X            set_function();
X        srch_f = expbuf[0] ? srch_solve0 : (int (*)())0;
X        if (srch_f)
X            break;
X        else
X            goto ask;
X    case 2: fn = 2;
X        if (expbuf[0] == '\0')
X            set_function();
X        srch_f = expbuf[0] ? srch_binary : (int (*)())0;
X        if (srch_f)
X            break;
X        else
X            goto ask;
X    case 3: fn = 3; srch_f = 0; set_function(); goto ask;
X    case 4: fn = 4; srch_f = 0; set_accuracy(); goto ask;
X    case 5: srch_f = 0; srch_prstate(0); return;
X    default: return;
X    }
X
X    /* new search */
X    srch_tmscalled = 0;
X    srch_prstate (0);
X}
X
X/* if searching is in effect call the search type function.
X * it might modify *tmincp according to where it next wants to eval.
X * (remember tminc is in hours, not days).
X * if searching ends for any reason it is also turned off.
X * also, flog the new value.
X * return 0 if caller can continue or -1 if it is time to stop.
X */
Xsrch_eval(mjd, tmincp)
Xdouble mjd;
Xdouble *tmincp;
X{
X    char errbuf[128];
X    int s;
X    double v;
X
X    if (!srch_f)
X        return (0);
X
X    if (execute_expr (&v, errbuf) < 0) {
X        srch_f = 0;
X        f_msg (errbuf);
X    } else {
X        s = (*srch_f)(mjd, v, tmincp);
X        if (s < 0)
X        srch_f = 0;
X        (void) flog_log (R_SRCH, C_SRCH, v, "");
X        srch_tmscalled++;
X    }
X
X    srch_prstate (0);
X    return (s);
X}
X
X/* print state of searching. */
Xsrch_prstate (force)
Xint force;
X{
X    int srch_minmax(), srch_solve0(), srch_binary();
X    static (*last)();
X
X    if (force || srch_f != last) {
X        f_string (R_SRCH, C_SRCHV,
X            srch_f == srch_minmax   ? "Extrema" :
X            srch_f == srch_solve0   ? " Find 0" :
X            srch_f == srch_binary ?   " Binary" :
X                          "    off");
X        last = srch_f;
X    }
X}
X
Xsrch_ison()
X{
X    return (srch_f != 0);
X}
X
X/* display current expression. then if type in at least one char make it the
X * current expression IF it compiles ok.
X * TODO: editing?
X */
Xstatic
Xset_function()
X{
X    static char prompt[] = "Function: ";
X    char newexp[NC];
X    int s;
X
X    f_prompt (prompt);
X    (void) fputs (expbuf, stdout);
X    c_pos (R_PROMPT, sizeof(prompt));
X
X    s = read_line (newexp, PW-sizeof(prompt));
X    if (s >= 0) {
X        char errbuf[NC];
X        if (s > 0 && compile_expr (newexp, errbuf) < 0)
X        f_msg (errbuf);
X        else
X        (void) strcpy (expbuf, newexp);
X    }
X}
X
Xstatic
Xset_accuracy()
X{
X    static char p[] = "Desired accuracy (         hrs): ";
X    int hrs, mins, secs;
X    char buf[NC];
X
X    f_prompt (p);
X    f_time (R_PROMPT, C_PROMPT+18, tmlimit); /* place in blank spot */
X    c_pos (R_PROMPT, sizeof(p));
X    if (read_line (buf, PW-sizeof(p)) > 0) {
X        f_dec_sexsign (tmlimit, &hrs, &mins, &secs);
X        f_sscansex (buf, &hrs, &mins, &secs);
X        sex_dec (hrs, mins, secs, &tmlimit);
X    }
X}
X
X/* use successive paraboloidal fits to find when expression is at a
X * local minimum or maximum.
X */
Xstatic
Xsrch_minmax(mjd, v, tmincp)
Xdouble mjd;
Xdouble v;
Xdouble *tmincp;
X{
X    static double base;        /* for better stability */
X    static double x_1, x_2, x_3;    /* keep in increasing order */
X    static double y_1, y_2, y_3;
X    double xm, a, b;
X
X    if (srch_tmscalled == 0) {
X        base = mjd;
X        x_1 = 0.0;
X        y_1 = v;
X        return (0);
X    }
X    mjd -= base;
X    if (srch_tmscalled == 1) {
X        /* put in one of first two slots */
X        if (mjd < x_1) {
X            x_2 = x_1;  y_2 = y_1;
X        x_1 = mjd; y_1 = v;
X        } else {
X        x_2 = mjd; y_2 = v;
X        }
X        return (0);
X    }
X    if (srch_tmscalled == 2 || fabs(mjd - x_1) < fabs(mjd - x_3)) {
X        /* closer to x_1 so discard x_3.
X         * or if it's our third value we know to "discard" x_3.
X         */
X        if (mjd > x_2) {
X        x_3 = mjd; y_3 = v;
X        } else {
X        x_3 = x_2;  y_3 = y_2;
X        if (mjd > x_1) {
X            x_2 = mjd; y_2 = v;
X        } else {
X            x_2 = x_1;  y_2 = y_1;
X            x_1 = mjd; y_1 = v;
X        }
X        }
X        if (srch_tmscalled == 2)
X        return (0);
X    } else {
X        /* closer to x_3 so discard x_1 */
X        if (mjd < x_2) {
X        x_1 = mjd;  y_1 = v;
X        } else {
X        x_1 =  x_2;  y_1 = y_2;
X        if (mjd < x_3) {
X            x_2 = mjd; y_2 = v;
X        } else {
X            x_2 =  x_3; y_2 = y_3;
X            x_3 = mjd; y_3 = v;
X        }
X        }
X    }
X
X#ifdef TRACEMM
X    { char buf[NC];
X      sprintf (buf, "x_1=%g y_1=%g x_2=%g y_2=%g x_3=%g y_3=%g",
X                        x_1, y_1, x_2, y_2, x_3, y_3);
X      f_msg (buf);
X    }
X#endif
X    a = y_1*(x_2-x_3) - y_2*(x_1-x_3) + y_3*(x_1-x_2);
X    if (fabs(a) < 1e-10) {
X        /* near-0 zero denominator, ie, curve is pretty flat here,
X         * so assume we are done enough.
X         * signal this by forcing a 0 tminc.
X         */
X        *tmincp = 0.0;
X        return (-1);
X    }
X    b = (x_1*x_1)*(y_2-y_3) - (x_2*x_2)*(y_1-y_3) + (x_3*x_3)*(y_1-y_2);
X    xm = -b/(2.0*a);
X    *tmincp = (xm - mjd)*24.0;
X    return (fabs (*tmincp) < tmlimit ? -1 : 0);
X}
X
X/* use secant method to solve for time when expression passes through 0.
X */
Xstatic
Xsrch_solve0(mjd, v, tmincp)
Xdouble mjd;
Xdouble v;
Xdouble *tmincp;
X{
X    static double x0, x_1;    /* x(n-1) and x(n) */
X    static double y_0, y_1;    /* y(n-1) and y(n) */
X    double x_2;        /* x(n+1) */
X    double df;        /* y(n) - y(n-1) */
X
X    switch (srch_tmscalled) {
X    case 0: x0 = mjd; y_0 = v; return(0);
X    case 1: x_1 = mjd; y_1 = v; break;
X    default: x0 = x_1; y_0 = y_1; x_1 = mjd; y_1 = v; break;
X    }
X
X    df = y_1 - y_0;
X    if (fabs(df) < 1e-10) {
X        /* near-0 zero denominator, ie, curve is pretty flat here,
X         * so assume we are done enough.
X         * signal this by forcing a 0 tminc.
X         */
X        *tmincp = 0.0;
X        return (-1);
X    }
X    x_2 = x_1 - y_1*(x_1-x0)/df;
X    *tmincp = (x_2 - mjd)*24.0;
X    return (fabs (*tmincp) < tmlimit ? -1 : 0);
X}
X
X/* binary search for time when expression changes from its initial state.
X * if the change is outside the initial tminc range, then keep searching in that
X *    direction by tminc first before starting to divide down.
X */
Xstatic
Xsrch_binary(mjd, v, tmincp)
Xdouble mjd;
Xdouble v;
Xdouble *tmincp;
X{
X    static double lb, ub;        /* lower and upper bound */
X    static int initial_state;
X    int this_state = v >= 0.5;
X
X#define    FLUNDEF    -9e10
X
X    if (srch_tmscalled == 0) {
X        if (*tmincp >= 0.0) {
X        /* going forwards in time so first mjd is lb and no ub yet */
X        lb = mjd;
X        ub = FLUNDEF;
X        } else {
X        /* going backwards in time so first mjd is ub and no lb yet */
X        ub = mjd;
X        lb = FLUNDEF;
X        }
X        initial_state = this_state;
X        return (0);
X    }
X
X    if (ub != FLUNDEF && lb != FLUNDEF) {
X        if (this_state == initial_state)
X        lb = mjd;
X        else
X        ub = mjd;
X        *tmincp = ((lb + ub)/2.0 - mjd)*24.0;
X#ifdef TRACEBIN
X        { char buf[NC];
X          sprintf (buf, "lb=%g ub=%g tminc=%g mjd=%g is=%d ts=%d",
X                lb, ub, *tmincp, mjd, initial_state, this_state);
X          f_msg (buf);
X        }
X#endif
X        /* signal to stop if asking for time change less than TMLIMIT */
X        return (fabs (*tmincp) < tmlimit ? -1 : 0);
X    } else if (this_state != initial_state) {
X        /* gone past; turn around half way */
X        if (*tmincp >= 0.0)
X        ub = mjd;
X        else
X        lb = mjd;
X        *tmincp /= -2.0;
X        return (0);
X    } else {
X        /* just keep going, looking for first state change but we keep
X         * learning the lower (or upper, if going backwards) bound.
X         */
X        if (*tmincp >= 0.0)
X        lb = mjd;
X        else
X        ub = mjd;
X        return (0);
X    }
X}
END_OF_FILE
  if test 8160 -ne `wc -c <'srch.c'`; then
    echo shar: \"'srch.c'\" unpacked with wrong size!
  fi
  # end of 'srch.c'
fi
echo shar: End of archive 7 \(of 9\).
cp /dev/null ark7isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
    if test ! -f ark${I}isdone ; then
    MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 9 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still must unpack the following archives:
    echo "        " ${MISSING}
fi
exit 0
exit 0 # Just in case...