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

Text File | 1992-03-14 | 53.9 KB | 2,034 lines

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

Submitted-by: [e-mail] (Elwood C. Downey)
Posting-number: Volume 28, Issue 86
Archive-name: ephem/part03
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:  io.c objx.c
# Wrapped by kent@sparky on Tue Mar 10 14:34:05 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 3 (of 9)."'
if test -f 'io.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'io.c'\"
else
  echo shar: Extracting \"'io.c'\" \(21617 characters\)
  sed "s/^X//" >'io.c' <<'END_OF_FILE'
X/* this file (in principle) contains all the device-dependent code for
X * handling screen movement and reading the keyboard. public routines are:
X *   c_pos(r,c), c_erase(), c_eol();
X *   chk_char(), read_char(), read_line (buf, max); and
X *   byetty().
X * N.B. we assume output may be performed by printf(), putchar() and
X *   fputs(stdout). since these are buffered we flush first in read_char().
X */
X
X/* explanation of various conditional #define options:
X * UNIX: uses termcap for screen management.
X *   USE_TERMIO: use termio.h to control tty modes.
X *   USE_SGTTY: use sgtty.h to control tty modes.
X *   USE_NDELAY: do non-blocking tty reads with fcntl(O_NDELAY).
X *   USE_FIONREAD: do non-blocking tty reads with ioctl(FIONREAD).
X *   USE_ATTSELECT: do non-blocking reads with att's select(2) (4 args).
X *   USE_BSDSELECT: do non-blocking reads with bsd's select(2) (5 args).
X * TURBO_C: compiles for Turbo C 2.0. I'm told it works for Lattice and
X *     Microsoft too.
X *   USE_ANSISYS: default PC cursor control uses direct BIOS calls (thanks to
X *     Mr. Doug McDonald). If your PC does not work with this, however, add
X *     "device ANSI.SYS" to your config.sys file and build ephem with
X *     USE_ANSISYS.
X * VMS: uses QIO for input, TERMTABLE info for output. This code uses only
X *     standard VMS calls, i.e. it does not rely on any third-vendor termcap
X *     package or the like. The code includes recoqnition of arrow keys, it
X *     is easy to extend it to recoqnize other function keys. you don't
X *     need to #define VMS since it is inherent in the compiler.
X */
X
X/* unless you are on VMS define one of these... */
X#define UNIX
X/* #define TURBO_C */
X
X/* then if you defined UNIX you must use one of these ways to do non-blocking
X * tty reads
X */
X#define USE_FIONREAD
X/* #define USE_NDELAY */
X/* #define USE_ATTSELECT */
X/* #define USE_BSDSELECT */
X
X/* and then if you defined UNIX you must also use one of these ways to control
X * the tty modes.
X */
X#define USE_TERMIO
X/* #define USE_SGTTY */
X
X/* if you defined TURBO_C you might want this too if screen io looks garbled */
X/* #define USE_ANSISYS */
X
X#include <stdio.h>
X#include <ctype.h>
X#include "screen.h"
X
X#ifdef UNIX
X#include <signal.h>
X#ifdef USE_TERMIO
X#include <termio.h>
X#endif
X#ifdef USE_SGTTY
X#include <sgtty.h>
X#endif
X#ifdef USE_BSDSELECT
X#include <sys/time.h>
X#endif
X#ifdef USE_NDELAY
X#include <fcntl.h>
X#endif
X
Xextern char *tgoto();
Xstatic char *cm, *ce, *cl, *ks, *ke, *kl, *kr, *ku, *kd; /* termcap sequences */
Xstatic int tloaded;
Xstatic int ttysetup;
X#ifdef USE_TERMIO
Xstatic struct termio orig_tio;
X#endif
X#ifdef USE_SGTTY
Xstatic struct sgttyb orig_sgtty;
X#endif
X
X/* move cursor to row, col, 1-based.
X * we assume this also moves a visible cursor to this location.
X */
Xc_pos (r, c)
Xint r, c;
X{
X    if (!tloaded) tload();
X    fputs (tgoto (cm, c-1, r-1), stdout);
X}
X
X/* erase entire screen. */
Xc_erase()
X{
X    if (!tloaded) tload();
X    fputs (cl, stdout);
X}
X
X/* erase to end of line */
Xc_eol()
X{
X    if (!tloaded) tload();
X    fputs (ce, stdout);
X}
X
X#ifdef USE_NDELAY
Xstatic char sav_char;    /* one character read-ahead for chk_char() */
X#endif
X
X/* return 0 if there is a char that may be read without blocking, else -1 */
Xchk_char()
X{
X#ifdef USE_NDELAY
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X    if (sav_char)
X        return (0);
X    fcntl (0, F_SETFL, O_NDELAY);    /* non-blocking read. FNDELAY on BSD */
X    if (read (0, &sav_char, 1) != 1)
X        sav_char = 0;
X    return (sav_char ? 0 : -1);
X#endif
X#ifdef USE_ATTSELECT
X    int nfds, rfds, wfds, to;
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X    rfds = 1 << 0;    /* reads are on fd 0 */
X    wfds = 0;    /* not interested in any write fds */
X    nfds = 1;    /* check only fd 0 */
X    to = 0;        /* don't delay - return 0 if nothing pending */
X    return (select (nfds, &rfds, &wfds, to) == 0 ? -1 : 0);
X#endif
X#ifdef USE_BSDSELECT
X    int nfds, rfds, wfds, xfds;
X    struct timeval to;
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X    rfds = 1 << 0;    /* reads are on fd 0 */
X    wfds = 0;    /* not interested in any write fds */
X    xfds = 0;    /* not interested in any exception fds */
X    nfds = 1;    /* check only fd 0 */
X    to.tv_sec = 0;    /* don't delay - return 0 if nothing pending */
X    to.tv_usec = 0;    /* don't delay - return 0 if nothing pending */
X    return (select (nfds, &rfds, &wfds, &xfds, &to) == 0 ? -1 : 0);
X#endif
X#ifdef USE_FIONREAD
X    long n;
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X    ioctl (0, FIONREAD, &n);
X    return (n > 0 ? 0 : -1);
X#endif
X}
X
X/* read the next char, blocking if necessary, and return it. don't echo.
X * map the arrow keys if we can too into hjkl
X */
Xread_char()
X{
X    char c;
X    if (!ttysetup) setuptty();
X    fflush (stdout);
X#ifdef USE_NDELAY
X    fcntl (0, F_SETFL, 0);    /* blocking read */
X    if (sav_char) {
X        c = sav_char;
X        sav_char = 0;
X    } else
X#endif
X        read (0, &c, 1);
X    c = chk_arrow (c & 0177); /* just ASCII, please */
X    return (c);
X}
X
X/* used to time out of a read */
Xstatic got_alrm;
Xstatic
Xon_alrm()
X{
X    got_alrm = 1;
X}
X
X/* see if c is the first of any of the termcap arrow key sequences.
X * if it is, read the rest of the sequence, and return the hjkl code
X * that corresponds.
X * if no match, just return c.
X */
Xstatic
Xchk_arrow (c)
Xregister char c;
X{
X    register char *seq;
X
X    if (kl && kd && ku && kr &&
X        (c == *(seq = kl) || c == *(seq = kd) || c == *(seq = ku)
X                         || c == *(seq = kr))) {
X        char seqa[32]; /* maximum arrow escape sequence ever expected */
X        unsigned l = strlen(seq);
X        seqa[0] = c;
X        if (l > 1) {
X        extern unsigned alarm();
X        /* cautiously read rest of arrow sequence */
X        got_alrm = 0;
X        (void) signal (SIGALRM, on_alrm);
X        alarm(2);
X        read (0, seqa+1, l-1);
X        alarm(0);
X        if (got_alrm)
X            return (c);
X        }
X        seqa[l] = '\0';
X        if (strcmp (seqa, kl) == 0)
X        return ('h');
X        if (strcmp (seqa, kd) == 0)
X        return ('j');
X        if (strcmp (seqa, ku) == 0)
X        return ('k');
X        if (strcmp (seqa, kr) == 0)
X        return ('l');
X    }
X    return (c);
X}
X
X/* do whatever might be necessary to get the screen and/or tty back into shape.
X */
Xbyetty()
X{
X    /* if keypad mode switch is used, turn it off now */
X    if (ke) {
X        fputs (ke, stdout);
X        fflush (stdout);
X    }
X
X#ifdef USE_TERMIO
X    ioctl (0, TCSETA, &orig_tio);
X#endif
X#ifdef USE_SGTTY
X    ioctl (0, TIOCSETP, &orig_sgtty);
X#endif
X#ifdef USE_NDELAY
X    fcntl (0, F_SETFL, 0);    /* be sure to go back to blocking read */
X#endif
X    ttysetup = 0;
X}
X
Xstatic
Xtload()
X{
X    extern char *getenv(), *tgetstr();
X    extern char *UP, *BC;
X    char *egetstr();
X    static char tbuf[512];
X    char rawtbuf[1024];
X    char *tp;
X    char *ptr;
X
X    if (!(tp = getenv ("TERM"))) {
X        printf ("no TERM\n");
X        exit(1);
X    }
X    if (tgetent (rawtbuf, tp) != 1) {
X        printf ("Can't find termcap for %s\n", tp);
X        exit (1);
X    }
X
X    ptr = tbuf;
X
X    ku = egetstr ("ku", &ptr);
X    kd = egetstr ("kd", &ptr);
X    kl = egetstr ("kl", &ptr);
X    kr = egetstr ("kr", &ptr);
X
X    if (!(cm = egetstr ("cm", &ptr))) {
X        printf ("No termcap cm code\n");
X        exit(1);
X    }
X    if (!(ce = egetstr ("ce", &ptr))) {
X        printf ("No termcap ce code\n");
X        exit(1);
X    }
X    if (!(cl = egetstr ("cl", &ptr))) {
X        printf ("No termcap cl code\n");
X        exit(1);
X    }
X
X    UP = egetstr ("up", &ptr);
X    if (!tgetflag ("bs"))
X        BC = egetstr ("bc", &ptr);
X
X    if (!ttysetup) setuptty();
X
X    /* if keypad mode switch is used, do it now */
X    if (ks = egetstr ("ks", &ptr)) {
X        ke = egetstr ("ke", &ptr);
X        fputs (ks, stdout);
X        fflush (stdout);
X    }
X
X    tloaded = 1;
X}
X
X/* like tgetstr() but discard termcap delay codes, for now anyways */
Xstatic char *
Xegetstr (name, sptr)
Xchar *name;
Xchar **sptr;
X{
X    extern char *tgetstr();
X    char *s;
X
X    if (s = tgetstr (name, sptr)) {
X        char c;
X        while ((c = *s) == '*' || isdigit(c))
X        s += 1;
X    }
X    return (s);
X}
X
X/* set up tty for char-by-char read, non-blocking  */
Xstatic
Xsetuptty()
X{
X#ifdef USE_TERMIO
X    struct termio tio;
X
X    ioctl (0, TCGETA, &orig_tio);
X    tio = orig_tio;
X    tio.c_iflag &= ~ICRNL;    /* leave CR unchanged */
X    tio.c_oflag &= ~OPOST;    /* no output processing */
X    tio.c_lflag &= ~(ICANON|ECHO); /* no input processing, no echo */
X    tio.c_cc[VMIN] = 1;    /* return after each char */
X    tio.c_cc[VTIME] = 0;    /* no read timeout */
X    ioctl (0, TCSETA, &tio);
X#endif
X#ifdef USE_SGTTY
X    struct sgttyb sg;
X
X    ioctl (0, TIOCGETP, &orig_sgtty);
X    sg = orig_sgtty;
X    sg.sg_flags &= ~ECHO;    /* do our own echoing */
X    sg.sg_flags &= ~CRMOD;    /* leave CR and LF unchanged */
X    sg.sg_flags |= XTABS;    /* no tabs with termcap */
X    sg.sg_flags |= CBREAK;    /* wake up on each char but can still kill */
X    ioctl (0, TIOCSETP, &sg);
X#endif
X    ttysetup = 1;
X}
X/* end of #ifdef UNIX */
X#endif
X
X#ifdef TURBO_C
X#ifdef USE_ANSISYS
X#define    ESC    '\033'
X/* position cursor.
X * (ANSI: ESC [ r ; c f) (r/c are numbers given in ASCII digits)
X */
Xc_pos (r, c)
Xint r, c;
X{
X    printf ("%c[%d;%df", ESC, r, c);
X}
X
X/* erase entire screen. (ANSI: ESC [ 2 J) */
Xc_erase()
X{
X    printf ("%c[2J", ESC);
X}
X
X/* erase to end of line. (ANSI: ESC [ K) */
Xc_eol()
X{
X    printf ("%c[K", ESC);
X}
X#else
X#include <dos.h>
Xunion REGS rg;
X
X/* position cursor.
X */
Xc_pos (r, c)
Xint r, c;
X{
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.h.dh = r-1;
X        rg.h.dl = c-1;
X        int86(16,&rg,&rg);
X}
X
X/* erase entire screen.  */
Xc_erase()
X{
X        int cur_cursor, i;
X        rg.h.ah = 3;
X        rg.h.bh = 0;
X        int86(16,&rg,&rg);
X        cur_cursor = rg.x.dx;
X        for(i = 0; i < 25; i++){
X            c_pos(i+1,1);
X            rg.h.ah = 10;
X            rg.h.bh = 0;
X            rg.h.al = 32;
X            rg.x.cx = 80;
X            int86(16,&rg,&rg);
X        }
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.x.dx = cur_cursor;
X        int86(16,&rg,&rg);
X
X}
X
X/* erase to end of line.*/
Xc_eol()
X{
X        int cur_cursor, i;
X        rg.h.ah = 3;
X        rg.h.bh = 0;
X        int86(16,&rg,&rg);
X        cur_cursor = rg.x.dx;
X        rg.h.ah = 10;
X        rg.h.bh = 0;
X        rg.h.al = 32;
X        rg.x.cx = 80 - rg.h.dl;
X        int86(16,&rg,&rg);
X        rg.h.ah = 2;
X        rg.h.bh = 0;
X        rg.x.dx = cur_cursor;
X        int86(16,&rg,&rg);
X
X}
X#endif
X
X/* return 0 if there is a char that may be read without blocking, else -1 */
Xchk_char()
X{
X    return (kbhit() == 0 ? -1 : 0);
X}
X
X/* read the next char, blocking if necessary, and return it. don't echo.
X * map the arrow keys if we can too into hjkl
X */
Xread_char()
X{
X    int c;
X    fflush (stdout);
X    c = getch();
X    if (c == 0) {
X        /* get scan code; convert to direction hjkl if possible */
X        c = getch();
X        switch (c) {
X        case 0x4b: c = 'h'; break;
X        case 0x50: c = 'j'; break;
X        case 0x48: c = 'k'; break;
X        case 0x4d: c = 'l'; break;
X        }
X    }
X    return (c);
X}
X
X/* do whatever might be necessary to get the screen and/or tty back into shape.
X */
Xbyetty()
X{
X}
X/* end of #ifdef TURBO_C */
X#endif
X
X#ifdef VMS
X#include <string.h>
X#include <iodef.h>
X#include <descrip.h>
X#include <dvidef.h>
X#include <smgtrmptr.h>
X#include <starlet.h>
X#include <lib$routines.h>
X#include <smg$routines.h>
X
X/* Structured types for use in system calls */
Xtypedef struct{
X    unsigned short status;
X    unsigned short count;
X    unsigned int info;
X} io_status_block;
Xtypedef struct{
X    unsigned short buffer_length;
X    unsigned short item_code;
X    void *buffer_address;
X    unsigned short *return_length_address;
X    unsigned long terminator;
X} item_list;
X
Xstatic unsigned short ttchan = 0; /* channel number for terminal    */
Xvolatile static io_status_block iosb; /* I/O status block for operation */
X                                      /* currently in progress          */
Xvolatile static unsigned char input_buf; /* buffer to recieve input charac-*/
X                                         /* ter when operation completes   */
Xstatic void *term_entry;          /* pointer to TERMTABLE entry     */
X#define MAXCAP 10
Xstatic char ce[MAXCAP];           /* ce and cl capability strings for  */
Xstatic char cl[MAXCAP];           /* this terminal type                */
X
X/* Declaration of special keys to be recoqnized on input */
X/* Number of special keys defined */
X#define MAXKEY 4
X/* TERMTABLE capability codes for the keys */
Xstatic long capcode[MAXKEY] = {SMG$K_KEY_UP_ARROW,SMG$K_KEY_DOWN_ARROW,
X    SMG$K_KEY_RIGHT_ARROW,SMG$K_KEY_LEFT_ARROW};
X/* character codes to be returned by read_char when a special key is presssed */
Xstatic int retcode[MAXKEY] = {'k','j','l','h'};
X/* the actual capability strings from the key */
Xstatic char keycap[MAXKEY][MAXCAP];
X
Xstatic char special_buffer[MAXCAP];   /* buffer for reading special key */
Xstatic int chars_in_buffer;           /* number of characters in buffer */
X
X/* set up the structures for this I/O module */
Xinittt()
X{
X    unsigned int status;   /* system routine return status */
X    $DESCRIPTOR(tt,"TT");  /* terminal name */
X    item_list itmlst;      /* item list for $getdvi obtaining term type */
X    unsigned long devtype; /* terminal type returned form $getdvi */
X    unsigned short retlen; /* return length from $getdvi */
X    unsigned long lenret;  /* return length from smg$get_term_data */
X    unsigned long maxlen;  /* maximum return length */
X    unsigned long cap_code;/* capability code */
X#define MAXINIT 20
X    char init_string[MAXINIT];/* string to initialize terminal */
X    int key;
X
X    /* Assign a channel to the terminal */
X    if (!((status = sys$assign(&tt,&ttchan,0,0))&1)) lib$signal(status);
X
X    /* Get terminal type. Note that it is possible to use the same
X     * iosb at this stage, because no I/O is initiated yet.
X     */
X    itmlst.buffer_length = 4;
X    itmlst.item_code = DVI$_DEVTYPE;
X    itmlst.buffer_address = &devtype;
X    itmlst.return_length_address = &retlen;
X    itmlst.terminator = 0;
X    if (!((status = sys$getdviw(0,ttchan,0,&itmlst,&iosb,0,0,0))&1))
X        lib$signal(status);
X    if (!(iosb.status&1)) lib$signal(iosb.status);
X
X    /* Get the TERMTABLE entry corresponding to the terminal type */
X    if (!((status = smg$init_term_table_by_type(&devtype,
X        &term_entry))&1)) lib$signal(status);
X
X    /* Get the initialisation string and initialize terminal */
X    cap_code = SMG$K_INIT_STRING;
X    maxlen = MAXINIT - 1;
X    if (!((status = smg$get_term_data(&term_entry,&cap_code,&maxlen,
X        &lenret,init_string))&1)) lib$signal(status);
X    init_string[lenret] = '\0';
X    fputs(init_string,stdout);
X    fflush(stdout);
X
X    /* Get ce and cl capabilities, these are static */
X    cap_code = SMG$K_ERASE_TO_END_LINE;
X    maxlen = MAXCAP-1;
X    if (!((status = smg$get_term_data(&term_entry,&cap_code,&maxlen,
X        &lenret,ce))&1)) lib$signal(status);
X    ce[lenret] = '\0';
X
X    cap_code = SMG$K_ERASE_WHOLE_DISPLAY;
X    maxlen = MAXCAP-1;
X    if (!((status = smg$get_term_data(&term_entry,&cap_code,&maxlen,
X        &lenret,cl))&1)) lib$signal(status);
X    cl[lenret] = '\0';
X
X    /* Here one could obtain line drawing sequences, please feel free
X       to implement it ... */
X
X    /* Get special keys to be recoqnized on input */
X    for (key = 0;key<MAXKEY;key++)
X    {
X        maxlen = MAXCAP-1;
X        if (!((status = smg$get_term_data(&term_entry,&capcode[key],
X            &maxlen,&lenret,keycap[key]))&1)) lib$signal(status);
X        keycap[key][lenret] = '\0';
X    }
X
X    /* Initiate first input operation, NOECHO.
X     * NOFILTR allows any character to get through, this makes it
X     * possible to implement arrow recoqnition, and also makes
X     * DEL and BS get through.
X     * We don't wait for the operation to complete.
X     * Note that stdout has already been fflush'ed above.
X     */
X    if (!((status = sys$qio(0,ttchan,
X        IO$_READVBLK|IO$M_NOECHO|IO$M_NOFILTR,
X        &iosb,0,0,&input_buf,1,0,0,0,0))&1)) lib$signal(status);
X
X    /* Initialise special key buffer */
X    chars_in_buffer = 0;
X} /* inittt */
X
X
X/* return 0 if there is a char that may be read without blocking, else -1 */
Xchk_char()
X{
X    if (!ttchan) inittt();
X
X        return ( chars_in_buffer != 0 ? 0 :(iosb.status == 0 ? -1 : 0));
X}
X
X/* read the next char, blocking if necessary, and return it. don't echo.
X * map the arrow keys if we can too into hjkl
X */
Xread_char()
X{
X    unsigned int status;
X    int buf;
X    int i;
X    int found_key;
X    int key;
X    int this_len;
X    int match;
X
X    if (!ttchan) inittt();
X
X    /* If we attempted to read an special key previously, there are characters
X     * left in the buffer, return these before doing more I/O
X     */
X    if (chars_in_buffer!=0){
X        buf = special_buffer[0];
X        chars_in_buffer--;
X        for (i = 0;i<chars_in_buffer;i++)
X        {
X            special_buffer[i] = special_buffer[i+1];
X        }
X        special_buffer[chars_in_buffer] = '\0';
X    }
X    else {
X
X        /* Loop over characters read, the loop is terminated when the
X         * characters read so far do not match any of the special keys
X         * or when the characters read so far is identical to one of
X         * the special keys.
X         */
X
X        do
X        {
X            /* Wait for I/O to complete */
X            if (!((status = sys$synch(0,&iosb))&1)) lib$signal(status);
X            special_buffer[chars_in_buffer] = input_buf;
X            chars_in_buffer++;
X            special_buffer[chars_in_buffer] = '\0';
X
X            /* Initiate next input operation */
X            fflush (stdout);
X            if (!((status = sys$qio(0,ttchan,
X                IO$_READVBLK|IO$M_NOECHO|IO$M_NOFILTR,
X                &iosb,0,0,&input_buf,1,0,0,0,0))&1)) lib$signal(status);
X
X
X            /* Check for match with all special strings */
X            match = 0;
X            found_key = MAXKEY;
X            for (key = 0;key<MAXKEY;key++)
X            {
X                this_len = strlen(keycap[key]);
X                if (this_len<chars_in_buffer) continue;
X                if (!strncmp(keycap[key],special_buffer,chars_in_buffer)){
X                    match = -1;
X                    if (this_len == chars_in_buffer){
X                        found_key = key;
X                        break;
X                    }
X                }
X            }
X        }
X        while (match && (found_key == MAXKEY));
X
X        /* If one of the keys matches the input string, return the
X         * corresponding  key code
X         */
X        if (found_key != MAXKEY)
X        {
X            buf = retcode[found_key];
X            chars_in_buffer = 0;
X        }
X        else /* return first character and store the rest in the buffer */
X        {
X            buf = special_buffer[0];
X            chars_in_buffer--;
X            for (i = 0;i<chars_in_buffer;i++)
X            {
X                special_buffer[i] = special_buffer[i+1];
X            }
X        }
X        special_buffer[chars_in_buffer] = '\0';
X    }
X    return(buf);
X}
X
X/* do whatever might be necessary to get the screen and/or tty back into shape.
X */
Xbyetty()
X{
X    unsigned int status;
X
X    if (ttchan)
X    {
X        /* There is no string in SMG to send to the terminal when
X         * terminating, one could clear the screen, move the cursor to
X         * the last line, or whatever. This program clears the screen
X         * anyway before calling this routine, so we do nothing.
X         */
X
X
X
X        /* The following is not really neccessary, it will be done at program
X         * termination anyway, but if someone tries to use the I/O routines agai
X   n
X         * it might prove useful...
X         */
X        if (!((status = smg$del_term_table())&1)) lib$signal(status);
X        if (!((status = sys$dassgn(ttchan))&1)) lib$signal(status);
X        /* This also cancels any outstanding I/O on the channel */
X        ttchan = 0; /* marks terminal I/O as not initialized */
X    }
X}
X
X/* position cursor. */
Xc_pos (r, c)
Xint r, c;
X{
X    unsigned long vector[3]; /* argument vector (position)   */
X    unsigned long status;    /* system service return status */
X    long lenret;             /* length of returned string    */
X    long maxlen;             /* maximum return length        */
X    unsigned long capcode;   /* capability code              */
X    char seq[2*MAXCAP];      /* returned string              */
X
X    if (!ttchan) inittt();
X
X    /* Set cursor depends on the position, therefore we have to call
X     * get_term_data for each operation
X     */
X    vector[0] = 2;
X    vector[1] = r;
X    vector[2] = c;
X    capcode = SMG$K_SET_CURSOR_ABS;
X    maxlen = 2*MAXCAP-1;
X    if (!((status = smg$get_term_data(&term_entry,&capcode,&maxlen,
X        &lenret,seq,vector))&1)) lib$signal(status);
X    seq[lenret] = '\0';
X
X    fputs(seq,stdout);
X}
X
X/* erase entire screen. */
Xc_erase()
X{
X    if (!ttchan) inittt();
X
X    fputs(cl,stdout);
X}
X
X/* erase to end of line. */
Xc_eol()
X{
X    if (!ttchan) inittt();
X
X    fputs(ce,stdout);
X}
X/* end of #ifdef VMS */
X#endif
X
X/* read up to max chars into buf, with cannonization.
X * add trailing '\0' (buf is really max+1 chars long).
X * return count of chars read (not counting '\0').
X * assume cursor is already positioned as desired.
X * if type END when n==0 then return -1.
X */
Xread_line (buf, max)
Xchar buf[];
Xint max;
X{
X    static char erase[] = "\b \b";
X    int n, c;
X    int done;
X
X#ifdef UNIX
X    if (!ttysetup) setuptty();
X#endif
X
X    for (done = 0, n = 0; !done; )
X        switch (c = read_char()) {    /* does not echo */
X        case cntrl('h'):    /* backspace or */
X        case 0177:        /* delete are each char erase */
X        if (n > 0) {
X            fputs (erase, stdout);
X            n -= 1;
X        }
X        break;
X        case cntrl('u'):        /* line erase */
X        while (n > 0) {
X            fputs (erase, stdout);
X            n -= 1;
X        }
X        break;
X        case '\r':    /* EOL */
X        done++;
X        break;
X        default:            /* echo and store, if ok */
X        if (n == 0 && c == END)
X            return (-1);
X        if (n >= max)
X            putchar (cntrl('g'));
X        else if (isprint(c)) {
X            putchar (c);
X            buf[n++] = c;
X        }
X        }
X
X    buf[n] = '\0';
X    return (n);
X}
END_OF_FILE
  if test 21617 -ne `wc -c <'io.c'`; then
    echo shar: \"'io.c'\" unpacked with wrong size!
  fi
  # end of 'io.c'
fi
if test -f 'objx.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'objx.c'\"
else
  echo shar: Extracting \"'objx.c'\" \(29454 characters\)
  sed "s/^X//" >'objx.c' <<'END_OF_FILE'
X/* functions to save the user-definable objects, referred to as "x" and "y".
X * this way, once defined, the objects can be quieried for position just like
X * the other bodies, with obj_cir().
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 "circum.h"
X#include "screen.h"
X
Xextern char *strcat(), *strcpy(), *strncpy(), *getenv();
X
Xstatic char *dbfile;            /* !0 if set by -d option */
Xstatic char dbfdef[] = "ephem.db";     /* default database file name */
X
X/* structures to describe objects of various types.
X */
X#define    MAXNM        16    /* longest allowed object name, inc \0 */
Xtypedef struct {
X    double m_m1, m_m2;    /* either g/k or H/G, depending on... */
X    int m_whichm;    /* one of MAG_gk or MAG_HG */
X} Mag;
Xtypedef struct {
X    double f_ra;    /* ra, rads, at given epoch */
X    double f_dec;    /* dec, rads, at given epoch */
X    double f_mag;    /* visual magnitude */
X    double f_siz;    /* angular size, in arc seconds */
X    double f_epoch;    /* the given epoch, as an mjd */
X    char   f_name[MAXNM]; /* name */
X} ObjF;            /* fixed object */
Xtypedef struct {
X    double e_inc;    /* inclination, degrees */
X    double e_Om;    /* longitude of ascending node, degrees */
X    double e_om;    /* argument of perihelion, degress */
X    double e_a;        /* mean distance, aka, semi-maj axis, in AU */
X    double e_n;        /* daily motion, degrees/day */
X    double e_e;        /* eccentricity */
X    double e_M;        /* mean anomaly, ie, degrees from perihelion at... */
X    double e_cepoch;    /* epoch date (M reference), as an mjd */
X    double e_epoch;    /* equinox year (inc/Om/om reference), as an mjd */
X    Mag    e_mag;    /* magnitude */
X    double e_siz;    /* angular size, in arc seconds at 1 AU */
X    char   e_name[MAXNM]; /* name */
X} ObjE;            /* object in heliocentric elliptical orbit */
Xtypedef struct {
X    double h_ep;    /* epoch of perihelion, as an mjd */
X    double h_inc;    /* inclination, degs */
X    double h_Om;    /* longitude of ascending node, degs */
X    double h_om;    /* argument of perihelion, degs. */
X    double h_e;        /* eccentricity */
X    double h_qp;    /* perihelion distance, AU */
X    double h_epoch;    /* equinox year (inc/Om/om reference), as an mjd */
X    double h_g, h_k;    /* magnitude model coefficients */
X    double h_siz;    /* angular size, in arc seconds at 1 AU */
X    char   h_name[MAXNM]; /* name */
X} ObjH;            /* object in heliocentric parabolic trajectory */
Xtypedef struct {
X    double p_ep;    /* epoch of perihelion, as an mjd */
X    double p_inc;    /* inclination, degs */
X    double p_qp;    /* perihelion distance, AU */
X    double p_om;    /* argument of perihelion, degs. */
X    double p_Om;    /* longitude of ascending node, degs */
X    double p_epoch;    /* reference epoch, as an mjd */
X    double p_g, p_k;    /* magnitude model coefficients */
X    double p_siz;    /* angular size, in arc seconds at 1 AU */
X    char   p_name[MAXNM]; /* name */
X} ObjP;            /* object in heliocentric parabolic trajectory */
X
Xtypedef struct {
X    int  o_type;    /* current object type; see flags, below */
X    int  o_on;        /* !=0 while current object is active */
X    ObjF o_f;        /* the fixed object */
X    ObjE o_e;        /* the elliptical orbit object */
X    ObjH o_h;        /* the hyperbolic orbit object */
X    ObjP o_p;        /* the parabolic orbit object */
X} Obj;
X
X/* o_type */
X#define    FIXED        1
X#define    ELLIPTICAL    2
X#define    HYPERBOLIC    3
X#define    PARABOLIC    4
X
X/* m_whichm */
X#define    MAG_HG        0    /* using 0 makes HG the initial default */
X#define    MAG_gk        1
X
Xstatic Obj objx;
Xstatic Obj objy;
X
X#define    DY    0        /* decimal year flag for set_year() */
X#define    YMD    1        /* year/mon/day flag for set_year() */
X
X/* run when Objx or y is picked from menu.
X * we tell which by the planet code.
X * let op define object and turn it on and off.
X */
Xobj_setup(p)
Xint p;
X{
X    static char *pr[6] = { /* leave a slot for "On"/"Off" */
X        "Fixed", "Elliptical", "Hyperbolic", "Parabolic", "Lookup"
X    };
X    int f;
X    Obj *op;
X
X    op = (p == OBJX) ? &objx : &objy;
X
X    rechk:
X    /* map o_type to popup choice.
X     */
X    switch (op->o_type) {
X    case FIXED: f = 0; break;
X    case ELLIPTICAL: f = 1; break;
X    case HYPERBOLIC: f = 2; break;
X    case PARABOLIC: f = 3; break;
X    default: f = 4; break;
X    }
X
X    ask:
X    pr[5] = op->o_on ? "On" : "Off";
X    switch (f = popup (pr, f, 6)) {
X    case 0: obj_dfixed(op, 0, (char**)0); goto ask;
X    case 1: obj_delliptical(op, 0, (char**)0); goto ask;
X    case 2: obj_dhyperbolic(op, 0, (char**)0); goto ask;
X    case 3: obj_dparabolic(op, 0, (char**)0); goto ask;
X    case 4: if (obj_filelookup(p, (char *)0) == 0) obj_on(p); goto rechk;
X    case 5: op->o_on ^= 1; break;
X    }
X}
X
X/* turn "on" or "off" but don't forget facts about object the object.
X */
Xobj_on (p)
Xint p;
X{
X    if (p == OBJX)
X        objx.o_on = 1;
X    else
X        objy.o_on = 1;
X}
Xobj_off (p)
Xint p;
X{
X    if (p == OBJX)
X        objx.o_on = 0;
X    else
X        objy.o_on = 0;
X}
X
X/* return true if object is now on, else 0.
X */
Xobj_ison(p)
Xint p;
X{
X    return ((p == OBJX) ? objx.o_on : objy.o_on);
X}
X
X/* set an alternate database file name.
X * N.B. we assume the storage pointed to by name is permanent.
X */
Xobj_setdbfilename (name)
Xchar *name;
X{
X    dbfile = name;
X}
X
X/* fill in info about object x or y.
X * most arguments and conditions are the same as for plans().
X * only difference is that mag is already apparent, not absolute magnitude.
X * this is called by body_cir() for object x and y just like plans() is called
X * for the planets.
X */
Xobj_cir (jd, p, lpd0, psi0, rp0, rho0, lam, bet, siz, mag)
Xdouble jd;    /* mjd now */
Xint p;        /* OBJX or OBJY */
Xdouble *lpd0;    /* heliocentric longitude, or NOHELIO  */
Xdouble *psi0;    /* heliocentric latitude, or 0 if *lpd0 set to NOHELIO */
Xdouble *rp0;    /* distance from the sun, or 0 */
Xdouble *rho0;    /* true distance from the Earth, or 0 */
Xdouble *lam;    /* apparent geocentric ecliptic longitude */
Xdouble *bet;    /* apparent geocentric ecliptic latitude */
Xdouble *siz;    /* angular size of object, arc seconds */
Xdouble *mag;    /* APPARENT magnitude */
X{
X    Obj *op = (p == OBJX) ? &objx : &objy;
X
X    switch (op->o_type) {
X    case FIXED: {
X        double xr, xd;
X        xr = op->o_f.f_ra;
X        xd = op->o_f.f_dec;
X        if (op->o_f.f_epoch != jd)
X        precess (op->o_f.f_epoch, jd, &xr, &xd);
X        eq_ecl (jd, xr, xd, bet, lam);
X
X        *lpd0 = NOHELIO;
X        *psi0 = *rp0 = *rho0 = 0.0;
X        *mag = op->o_f.f_mag;
X        *siz = op->o_f.f_siz;
X        }
X        break;
X
X    case ELLIPTICAL: {
X        /* this is basically the same code as pelement() and plans()
X         * combined and simplified for the special case of osculating
X         * (unperturbed) elements.
X         * inputs have been changed to match the Astronomical Almanac.
X         * we have added reduction of elements using reduce_elements().
X         */
X        double dt, lg, lsn, rsn;
X        double nu, ea;
X        double ma, rp, lo, slo, clo;
X        double inc, psi, spsi, cpsi;
X        double y, lpd, rpd, ll, rho, sll, cll;
X        double om;        /* arg of perihelion */
X        double Om;        /* long of ascending node. */
X        double e;
X        int pass;
X
X        dt = 0;
X        sunpos (jd, &lsn, &rsn);
X        lg = lsn + PI;
X        e = op->o_e.e_e;
X
X        for (pass = 0; pass < 2; pass++) {
X
X        reduce_elements (op->o_e.e_epoch, jd-dt, degrad(op->o_e.e_inc),
X                degrad (op->o_e.e_om), degrad (op->o_e.e_Om),
X                &inc, &om, &Om);
X
X        ma = degrad (op->o_e.e_M
X                + (jd - op->o_e.e_cepoch - dt) * op->o_e.e_n);
X        anomaly (ma, e, &nu, &ea);
X        rp = op->o_e.e_a * (1-e*e) / (1+e*cos(nu));
X        lo = nu + om;
X        slo = sin(lo);
X        clo = cos(lo);
X        spsi = slo*sin(inc);
X        y = slo*cos(inc);
X        psi = asin(spsi);
X        lpd = atan(y/clo)+Om;
X        if (clo<0) lpd += PI;
X        range (&lpd, 2*PI);
X        cpsi = cos(psi);
X        rpd = rp*cpsi;
X        ll = lpd-lg;
X        rho = sqrt(rsn*rsn+rp*rp-2*rsn*rp*cpsi*cos(ll));
X        dt = rho*5.775518e-3;    /* light travel time, in days */
X        if (pass == 0) {
X            *lpd0 = lpd;
X            *psi0 = psi;
X            *rp0 = rp;
X            *rho0 = rho;
X        }
X        }
X
X        sll = sin(ll);
X        cll = cos(ll);
X        if (rpd < rsn)
X        *lam = atan(-1*rpd*sll/(rsn-rpd*cll))+lg+PI;
X        else
X        *lam = atan(rsn*sll/(rpd-rsn*cll))+lpd;
X        range (lam, 2*PI);
X        *bet = atan(rpd*spsi*sin(*lam-lpd)/(cpsi*rsn*sll));
X
X        if (op->o_e.e_mag.m_whichm == MAG_HG) {
X        /* the H and G parameters from the Astro. Almanac.
X         */
X        double psi_t, Psi_1, Psi_2, beta;
X        beta = acos((rp*rp + rho*rho - rsn*rsn)/ (2*rp*rho));
X        psi_t = exp(log(tan(beta/2.0))*0.63);
X        Psi_1 = exp(-3.33*psi_t);
X        psi_t = exp(log(tan(beta/2.0))*1.22);
X        Psi_2 = exp(-1.87*psi_t);
X        *mag = op->o_e.e_mag.m_m1 + 5.0*log10(rp*rho)
X            - 2.5*log10((1-op->o_e.e_mag.m_m2)*Psi_1
X            + op->o_e.e_mag.m_m2*Psi_2);
X        } else {
X        /* the g/k model of comets */
X        *mag = op->o_e.e_mag.m_m1 + 5*log10(rho)
X                    + 2.5*op->o_e.e_mag.m_m2*log10(rp);
X        }
X        *siz = op->o_e.e_siz / rho;
X        }
X        break;
X
X    case HYPERBOLIC: {
X        double dt, lg, lsn, rsn;
X        double nu, ea;
X        double ma, rp, lo, slo, clo;
X        double inc, psi, spsi, cpsi;
X        double y, lpd, rpd, ll, rho, sll, cll;
X        double om;        /* arg of perihelion */
X        double Om;        /* long of ascending node. */
X        double e;
X        double a, n;    /* semi-major axis, mean daily motion */
X        int pass;
X
X        dt = 0;
X        sunpos (jd, &lsn, &rsn);
X        lg = lsn + PI;
X        e = op->o_h.h_e;
X        a = op->o_h.h_qp/(e - 1.0);
X        n = .98563/sqrt(a*a*a);
X
X        for (pass = 0; pass < 2; pass++) {
X
X        reduce_elements (op->o_h.h_epoch, jd-dt, degrad(op->o_h.h_inc),
X                degrad (op->o_h.h_om), degrad (op->o_h.h_Om),
X                &inc, &om, &Om);
X
X        ma = degrad ((jd - op->o_h.h_ep - dt) * n);
X        anomaly (ma, e, &nu, &ea);
X        rp = a * (e*e-1.0) / (1.0+e*cos(nu));
X        lo = nu + om;
X        slo = sin(lo);
X        clo = cos(lo);
X        spsi = slo*sin(inc);
X        y = slo*cos(inc);
X        psi = asin(spsi);
X        lpd = atan(y/clo)+Om;
X        if (clo<0) lpd += PI;
X        range (&lpd, 2*PI);
X        cpsi = cos(psi);
X        rpd = rp*cpsi;
X        ll = lpd-lg;
X        rho = sqrt(rsn*rsn+rp*rp-2*rsn*rp*cpsi*cos(ll));
X        dt = rho*5.775518e-3;    /* light travel time, in days */
X        if (pass == 0) {
X            *lpd0 = lpd;
X            *psi0 = psi;
X            *rp0 = rp;
X            *rho0 = rho;
X        }
X        }
X
X        sll = sin(ll);
X        cll = cos(ll);
X        if (rpd < rsn)
X        *lam = atan(-1*rpd*sll/(rsn-rpd*cll))+lg+PI;
X        else
X        *lam = atan(rsn*sll/(rpd-rsn*cll))+lpd;
X        range (lam, 2*PI);
X        *bet = atan(rpd*spsi*sin(*lam-lpd)/(cpsi*rsn*sll));
X
X        *mag = op->o_h.h_g + 5*log10(rho) + 2.5*op->o_h.h_k*log10(rp);
X        *siz = op->o_h.h_siz / rho;
X        }
X        break;
X
X    case PARABOLIC: {
X        double inc, om, Om;
X        double lpd, psi, rp, rho;
X        double dt;
X        int pass;
X
X        /* two passes to correct lam and bet for light travel time. */
X        dt = 0.0;
X        for (pass = 0; pass < 2; pass++) {
X        reduce_elements (op->o_p.p_epoch, jd-dt, degrad(op->o_p.p_inc),
X            degrad(op->o_p.p_om), degrad(op->o_p.p_Om), &inc, &om, &Om);
X        comet (jd-dt, op->o_p.p_ep, inc, om, op->o_p.p_qp, Om,
X                    &lpd, &psi, &rp, &rho, lam, bet);
X        if (pass == 0) {
X            *lpd0 = lpd;
X            *psi0 = psi;
X            *rp0 = rp;
X            *rho0 = rho;
X        }
X        dt = rho*5.775518e-3;    /* au to light-days */
X        }
X        *mag = op->o_p.p_g + 5*log10(rho) + 2.5*op->o_p.p_k*log10(rp);
X        *siz = op->o_p.p_siz / rho;
X        }
X        break;
X
X    default:
X        f_msg ((p == OBJX) ? "Obj X is not defined"
X                   : "Obj Y is not defined");
X        break;
X    }
X}
X
X/* define obj based on the ephem.db line, s.
X * p is one of OBJX or OBJY.
X * format: name,type,[other fields, as per corresponding ObjX typedef]
X * N.B. we replace all ',' within s with '\0' IN PLACE.
X * return 0 if ok, else print reason why not with f_msg() and return -1.
X */
Xobj_define (p, s)
Xint p;    /* OBJX or OBJY */
Xchar *s;
X{
X#define    MAXARGS    20
X    char *av[MAXARGS];    /* point to each field for easy reference */
X    char c;
X    int ac;
X    Obj *op = (p == OBJX) ? &objx : &objy;
X
X    /* parse into comma separated fields */
X    ac = 0;
X    av[0] = s;
X    do {
X        c = *s++;
X        if (c == ',' || c == '\0') {
X        s[-1] = '\0';
X        av[++ac] = s;
X        }
X    } while (c);
X
X    if (ac < 2) {
X        char buf[NC];
X        if (ac > 0)
X        (void) sprintf (buf, "No type for Object %s", av[0]);
X        else
X        (void) sprintf (buf, "No fields in %s", s);
X        f_msg (buf);
X        return (-1);
X    }
X
X    /* switch out on type of object - the second field */
X    switch (av[1][0]) {
X    case 'f':
X        if (ac != 6 && ac != 7) {
X        char buf[NC];
X        (void) sprintf(buf,
X            "Need ra,dec,mag,D[,siz] for fixed object %s", av[0]);
X        f_msg (buf);
X        return (-1);
X        }
X        obj_dfixed (op, ac, av);
X        break;
X
X    case 'e':
X        if (ac != 13 && ac != 14) {
X        char buf[NC];
X        (void) sprintf (buf,
X            "Need i,O,o,a,n,e,M,E,D,H/g,G/k[,siz] for elliptical object %s",
X                                    av[0]);
X        f_msg (buf);
X        return (-1);
X        }
X        obj_delliptical (op, ac, av);
X        break;
X
X    case 'h':
X        if (ac != 11 && ac != 12) {
X        char buf[NC];
X        (void) sprintf (buf,
X            "Need T,i,O,o,e,q,D,g,k[,siz] for hyperbolic object %s", av[0]);
X        f_msg (buf);
X        return (-1);
X        }
X        obj_dhyperbolic (op, ac, av);
X        break;
X
X    case 'p':
X        if (ac != 10 && ac != 11) {
X        char buf[NC];
X        (void) sprintf (buf,
X            "Need T,i,o,q,O,D,g,k[,siz] for parabolic object %s", av[0]);
X        f_msg (buf);
X        return (-1);
X        }
X        obj_dparabolic (op, ac, av);
X        break;
X
X    default: {
X        char buf[NC];
X        (void) sprintf (buf, "Unknown type for Object %s: %s",
X                                av[0], av[1]);
X        f_msg (buf);
X        return (-1);
X        }
X    }
X
X    return (0);
X}
X
X/* if name, then look it up in the ephem database file and set p.
X * else display a table of all objects and let op pick one.
X * p is either OBJX or OBJY.
X * if -d was used use it; else if EPHEMDB env set use it, else use default.
X * return 0 if successfully set object p, else -1.
X */
Xobj_filelookup (p, name)
Xint p;            /* OBJX or OBJY */
Xchar *name;
X{
X/* redefine RCTN,NTR,NTC for column-major order if you prefer */
X#define    NLR        (NR-1)        /* number of rows of names.
X                     * leave 1 for prompt
X                     */
X#define    LCW        9        /* screen columns per name */
X#define    NLC        9        /* total number of name columns */
X#define    NL        (NLR*NLC)    /* total number of names per screen */
X#define    RCTN(r,c)    ((r)*NLC+(c))    /* row/col to index */
X#define    NTR(n)        ((n)/NLC)    /* index to row */
X#define    NTC(n)        ((n)%NLC)    /* index to col (0 based) */
X                    /* N.B. all these are 0-based */
X    static char prompt[] =
X            "RETURN to select, p/n for previous/next page, q to quit";
X    FILE *fp;
X    char *fn;
X    int i, pgn;    /* index on current screen, current page number */
X    int r, c;
X    char buf[160];    /* longer than any one database line */
X    char pb[NC];    /* prompt buffer */
X    int readahd;    /* 1 if buffer set from previous loop */
X    int choice;    /* index to selection; -1 until set */
X    int roaming;    /* 1 while just roaming around screen */
X    int abandon;    /* 1 if decide to not pick afterall */
X
X    /* open the database file */
X    if (dbfile)
X        fn = dbfile;
X    else {
X        fn = getenv ("EPHEMDB");
X        if (!fn)
X        fn = dbfdef;
X    }
X    fp = fopen (fn, "r");
X    if (!fp) {
X        (void) sprintf (buf, "Can not open database file %s", fn);
X        f_msg(buf);
X        return(-1);
X    }
X
X    /* name is specified so just search for it without any op interaction */
X    if (name) {
X        int nl = strlen (name);
X        int ret = 0;
X        while (nxt_db(buf, sizeof(buf), fp) == 0 && strncmp(buf, name, nl))
X        continue;
X        if (feof(fp)) {
X        (void) sprintf (buf, "Object %s not found", name);
X        f_msg (buf);
X        ret = -1;
X        } else
X        (void) obj_define (p, buf);
X        (void) fclose (fp);
X        return (ret);
X    }
X
X    pgn = 0;
X    readahd = 0;
X    choice = -1;
X    abandon = 0;
X
X    /* continue until a choice is made or op abandons the attempt */
X    do {
X        /* put up next screen full of names.
X         * leave top row open for messages.
X         */
X        c_erase();
X        for (i = 0; i < NL; )
X        if (readahd || nxt_db (buf, sizeof(buf), fp) == 0) {
X            char objname[LCW];
X            int ii;
X            for (ii = 0; ii < sizeof(objname)-1; ii++)
X            if ((objname[ii] = buf[ii]) == ',')
X                break;
X            objname[ii] = '\0';
X            if (i == NL-1)
X            objname[LCW-2] = '\0'; /* avoid scroll in low-r corner*/
X            f_string (NTR(i)+2, NTC(i)*LCW+1, objname);
X            i++;
X            readahd = 0;
X        } else
X            break;
X
X        /* read another to check for eof. if valid, set readahd for next
X         * time.
X         */
X        if (nxt_db (buf, sizeof(buf), fp) == 0)
X        readahd = 1;
X
X        /* let op pick one. set cursor on first one.
X         * remember these r/c are 0-based, but c_pos() is 1-based
X         */
X        (void) sprintf (pb, "Page %d%s. %s", pgn+1,
X                        feof(fp) ? " (last)" : "", prompt);
X        f_prompt(pb);
X        r = c = 0;
X        roaming = 1;
X        do {
X        c_pos (r+2, c*LCW+1);
X        switch (read_char()) {
X        case 'h': /* left */
X            if (c == 0) c = NLC;
X            c -= 1;
X            if (RCTN(r,c) >= i)
X            c = NTC(i-1);
X            break;
X        case 'j': /* down */
X            if (++r == NLR) r = 0;
X            if (RCTN(r,c) >= i)
X            r = 0;
X            break;
X        case 'k': /* up */
X            if (r == 0) r = NLR;
X            r -= 1;
X            while (RCTN(r,c) >= i)
X            r -= 1;
X            break;
X        case 'l': /* right */
X            if (++c == NLC) c = 0;
X            if (RCTN(r,c) >= i)
X            c = 0;
X            break;
X        case REDRAW:
X            /* start over and skip over prior pages' entries */
X            rewind(fp);
X            for (i = 0; i < NL*pgn; i++)
X            (void) nxt_db (buf, sizeof(buf), fp);
X            readahd = 0;
X            roaming = 0;
X            break;
X        case 'p':
X            /* if not at first page, start over and skip back one
X             * pages' entries
X             */
X            if (pgn > 0) {
X            rewind(fp);
X            pgn--;
X            for (i = 0; i < NL*pgn; i++)
X                (void) nxt_db (buf, sizeof(buf), fp);
X            readahd = 0;
X            roaming = 0;
X            }
X            break;
X        case 'n':
X            /* if not already at eof, we can go ahead another page */
X            if (!feof (fp)) {
X            pgn++;
X            roaming = 0;
X            }
X            break;
X        case END:
X            abandon = 1;
X            roaming = 0;
X            break;
X        case ' ': case '\r':
X            choice = NL*pgn + RCTN(r,c);
X            roaming = 0;
X            break;
X        }
X        } while (roaming);
X    } while (choice < 0 && !abandon);
X
X    if (choice >= 0) {
X        /* skip first choice entries; selection is the next one */
X        (void) rewind (fp);
X        for (i = 0; i < choice; i++)
X        (void) nxt_db (buf, sizeof(buf), fp);
X        (void) nxt_db (buf, sizeof(buf), fp);
X        (void) obj_define (p, buf);
X    }
X    (void) fclose (fp);
X    redraw_screen (2);
X    return (choice >= 0 ? 0 : -1);
X}
X
X/* read database file fp and put next valid entry into buf.
X * return 0 if ok, else -1
X */
Xstatic
Xnxt_db (buf, blen, fp)
Xchar buf[];
Xint blen;
XFILE *fp;
X{
X    char s;
X    while (1) {
X        if (fgets (buf, blen, fp) == 0)
X        return (-1);
X        s = buf[0];
X        if (isalpha(s))
X        return (0);
X    }
X}
X
X/* define a fixed object.
X * args in av, in order, are name, type, ra, dec, magnitude, reference epoch
X *   and optional angular size.
X * if av then it is a list of strings to use for each parameter, else must
X * ask for each (but type). the av option is for cracking the ephem.db line.
X * if asking show current settings and leave unchanged if hit RETURN.
X * END aborts without making any more changes.
X * o_type is set to FIXED.
X * N.B. we don't error check av in any way, not even for length.
X */
Xstatic
Xobj_dfixed (op, ac, av)
XObj *op;
Xint ac;
Xchar *av[];
X{
X    char buf[NC];
X    char *bp;
X    int sts;
X
X    op->o_type = FIXED;
X
X    if (set_name (av, op->o_f.f_name) < 0)
X        return;
X
X    if (av) {
X        bp = av[2];
X        sts = 1;
X    } else {
X        static char p[] = "RA (h:m:s): (";
X        f_prompt (p);
X        f_ra (R_PROMPT, C_PROMPT+sizeof(p)-1, op->o_f.f_ra);
X        (void) printf (") ");
X        sts = read_line (buf, 8+1);
X        if (sts < 0)
X        return;
X        bp = buf;
X    }
X    if (sts > 0) {
X        int h, m, s;
X        f_dec_sexsign (radhr(op->o_f.f_ra), &h, &m, &s);
X        f_sscansex (bp, &h, &m, &s);
X        sex_dec (h, m, s, &op->o_f.f_ra);
X        op->o_f.f_ra = hrrad(op->o_f.f_ra);
X    }
X
X    if (av) {
X        bp = av[3];
X        sts = 1;
X    } else {
X        static char p[] = "Dec (d:m:s): (";
X        f_prompt (p);
X        f_gangle (R_PROMPT, C_PROMPT+sizeof(p)-1, op->o_f.f_dec);
X        (void) printf (") ");
X        sts = read_line (buf, 9+1);
X        if (sts < 0)
X        return;
X        bp = buf;
X    }
X    if (sts > 0) {
X        int dg, m, s;
X        f_dec_sexsign (raddeg(op->o_f.f_dec), &dg, &m, &s);
X        f_sscansex (bp, &dg, &m, &s);
X        sex_dec (dg, m, s, &op->o_f.f_dec);
X        op->o_f.f_dec = degrad(op->o_f.f_dec);
X    }
X
X    if (set_double (av, 4, "Magnitude: ", &op->o_f.f_mag) < 0)
X        return;
X
X    if (set_year (av, 5,"Reference epoch (UT Date, m/d.d/y or year.d): ",
X                            DY, &op->o_f.f_epoch) < 0)
X        return;
X
X    if (ac == 7 || !av)
X        (void) set_double (av, 6, "Angular Size: ", &op->o_f.f_siz);
X    else
X        op->o_f.f_siz = 0.0;
X
X}
X
X/* define an object in an elliptical heliocentric orbit.
X * 13 or 14 args in av, in order, are name, type, inclination, longitude of
X *   ascending node, argument of perihelion, mean distance (aka semi-major
X *   axis), daily motion, eccentricity, mean anomaly (ie, degrees from
X *   perihelion), epoch date (ie, time of the mean anomaly value), equinox year
X *   (ie, time of inc/lon/aop), two magnitude coefficients and optional size.
X * the mag may be H/G or g/k model, set by leading g or H (use H/G if none).
X * if av then it is a list of strings to use for each parameter, else must
X * ask for each. the av option is for cracking the ephem.db line.
X * if asking show current settings and leave unchanged if hit RETURN.
X * END aborts without making any more changes.
X * o_type is set to ELLIPTICAL.
X * N.B. we don't error check av in any way, not even for length.
X */
Xstatic
Xobj_delliptical(op, ac, av)
XObj *op;
Xint ac;
Xchar *av[];
X{
X    op->o_type = ELLIPTICAL;
X
X    if (set_name (av, op->o_e.e_name) < 0)
X        return;
X
X    if (set_double (av, 2, "Inclination (degs):", &op->o_e.e_inc) < 0)
X        return;
X
X    if (set_double (av, 3, "Longitude of ascending node (degs):",
X                &op->o_e.e_Om) < 0)
X        return;
X
X    if (set_double (av, 4, "Argument of Perihelion (degs):",
X                &op->o_e.e_om) < 0)
X        return;
X
X    if (set_double (av, 5, "Mean distance (AU):", &op->o_e.e_a) < 0)
X        return;
X
X    if (set_double (av, 6, "Daily motion (degs/day):", &op->o_e.e_n) < 0)
X        return;
X
X    if (set_double (av, 7, "Eccentricity:", &op->o_e.e_e) < 0)
X        return;
X
X    if (set_double (av, 8, "Mean anomaly (degs):", &op->o_e.e_M) < 0)
X        return;
X
X    if (set_year (av, 9, "Epoch date (UT Date, m/d.d/y or year.d): ",
X                            YMD, &op->o_e.e_cepoch) < 0)
X        return;
X
X    if (set_year (av, 10, "Equinox year (UT Date, m/d.d/y or year.d): ",
X                            DY, &op->o_e.e_epoch) < 0)
X        return;
X
X    if (set_mag (av, 11, &op->o_e.e_mag) < 0)
X        return;
X
X    if (ac == 14 || !av)
X        (void) set_double (av, 13, "Angular Size @ 1 AU: ", &op->o_e.e_siz);
X    else
X        op->o_e.e_siz = 0.0;
X
X}
X
X/* define an object in heliocentric hyperbolic orbit.
X * 11 or 12 args in av, in order, are name, type, epoch of perihelion,
X *   inclination, longitude of ascending node, argument of perihelion,
X *    eccentricity, perihelion distance, reference epoch, absolute magnitude
X *    and luminosity index, and optional size.
X * if av then it is a list of strings to use for each parameter, else must
X * ask for each. the av option is for cracking the ephem.db line.
X * if asking show current settings and leave unchanged if hit RETURN.
X * END aborts without making any more changes.
X * o_type is set to HYPERBOLIC.
X * N.B. we don't error check av in any way, not even for length.
X */
Xstatic
Xobj_dhyperbolic (op, ac, av)
XObj *op;
Xint ac;
Xchar *av[];
X{
X    op->o_type = HYPERBOLIC;
X
X    if (set_name (av, op->o_h.h_name) < 0)
X        return;
X
X    if (set_year(av,2,"Epoch of perihelion (UT Date, m/d.d/y or year.d): ",
X                            YMD, &op->o_h.h_ep) < 0)
X        return;
X
X    if (set_double (av, 3, "Inclination (degs):", &op->o_h.h_inc) < 0)
X        return;
X
X    if (set_double (av, 4,
X        "Longitude of ascending node (degs):", &op->o_h.h_Om) < 0)
X        return;
X
X    if (set_double(av,5,"Argument of perihelion (degs):", &op->o_h.h_om) <0)
X        return;
X
X    if (set_double (av, 6, "Eccentricity:", &op->o_h.h_e) < 0)
X        return;
X
X    if (set_double (av, 7, "Perihelion distance (AU):", &op->o_h.h_qp) < 0)
X        return;
X
X    if (set_year (av, 8, "Reference epoch (UT Date, m/d.d/y or year.d): ",
X                            DY, &op->o_h.h_epoch) < 0)
X        return;
X
X    if (set_double (av, 9, "g:", &op->o_h.h_g) < 0)
X        return;
X
X    if (set_double (av, 10, "k:", &op->o_h.h_k) < 0)
X        return;
X
X    if (ac == 12 || !av)
X        (void) set_double (av, 11, "Angular Size @ 1 AU: ", &op->o_h.h_siz);
X    else
X        op->o_h.h_siz = 0.0;
X}
X
X/* define an object in heliocentric parabolic orbit.
X * 10 or 11 args in av, in order, are name, type, epoch of perihelion,
X *   inclination, argument of perihelion, perihelion distance, longitude of
X *   ascending node, reference epoch, absolute magnitude and luminosity index,
X *   and optional size.
X * if av then it is a list of strings to use for each parameter, else must
X * ask for each. the av option is for cracking the ephem.db line.
X * if asking show current settings and leave unchanged if hit RETURN.
X * END aborts without making any more changes.
X * o_type is set to PARABOLIC.
X * N.B. we don't error check av in any way, not even for length.
X */
Xstatic
Xobj_dparabolic(op, ac, av)
XObj *op;
Xint ac;
Xchar *av[];
X{
X    op->o_type = PARABOLIC;
X
X    if (set_name (av, op->o_p.p_name) < 0)
X        return;
X
X    if (set_year(av,2,"Epoch of perihelion (UT Date, m/d.d/y or year.d): ",
X                            YMD, &op->o_p.p_ep) < 0)
X        return;
X
X    if (set_double (av, 3, "Inclination (degs):", &op->o_p.p_inc) < 0)
X        return;
X
X    if (set_double(av,4,"Argument of perihelion (degs):", &op->o_p.p_om) <0)
X        return;
X
X    if (set_double (av, 5, "Perihelion distance (AU):", &op->o_p.p_qp) < 0)
X        return;
X
X    if (set_double (av, 6,
X        "Longitude of ascending node (degs):", &op->o_p.p_Om) < 0)
X        return;
X
X    if (set_year (av, 7, "Reference epoch (UT Date, m/d.d/y or year.d): ",
X                            DY, &op->o_p.p_epoch) < 0)
X        return;
X
X    if (set_double (av, 8, "g:", &op->o_p.p_g) < 0)
X        return;
X
X    if (set_double (av, 9, "k:", &op->o_p.p_k) < 0)
X        return;
X
X    if (ac == 11 || !av)
X        (void) set_double (av, 10, "Angular Size @ 1 AU: ", &op->o_p.p_siz);
X    else
X        op->o_p.p_siz = 0.0;
X}
X
Xstatic
Xset_double (av, vn, pr, fp)
Xchar *av[];    /* arg list */
Xint vn;        /* which arg */
Xchar *pr;    /* prompt */
Xdouble *fp;    /* ptr to double to be set */
X{
X    int sts;
X    char buf[NC];
X    char *bp;
X
X    if (av) {
X        bp = av[vn];
X        sts = 1;
X    } else {
X        f_prompt (pr);
X        f_double (R_PROMPT, C_PROMPT+1+strlen(pr), "(%g) ", *fp);
X        sts = read_line (buf, 20);
X        if (sts < 0)
X        return (-1);
X        bp = buf;
X    }
X    if (sts > 0)
X        *fp = atof (bp);
X    return (0);
X}
X
Xstatic
Xset_name (av, np)
Xchar *av[];    /* arg list */
Xchar *np;    /* name to be set */
X{
X    int sts;
X    char buf[NC];
X    char *bp;
X
X    if (av) {
X        bp = av[0];
X        sts = 1;
X    } else {
X        (void) sprintf (buf, "Name: (%s) ", np);
X        f_prompt (buf);
X        sts = read_line (buf, MAXNM-1);
X        if (sts < 0)
X        return (-1);
X        bp = buf;
X    }
X    if (sts > 0)
X        (void) strcpy (np, bp);
X    return (0);
X}
X
Xstatic
Xset_year (av, vn, pr, type, yp)
Xchar *av[];    /* arg list */
Xint vn;        /* which arg */
Xchar *pr;    /* prompt */
Xint type;    /* display type: YMD or DY */
Xdouble *yp;    /* ptr to year to be set */
X{
X    int sts;
X    char buf[NC];
X    char *bp;
X
X    if (av) {
X        bp = av[vn];
X        sts = 1;
X    } else {
X        f_prompt (pr);
X        if (type == DY) {
X        double y;
X        mjd_year (*yp, &y);
X        (void) printf ("(%g) ", y);
X        } else {
X        int m, y;
X        double d;
X        mjd_cal (*yp, &m, &d, &y);
X        (void) printf ("(%d/%g/%d) ", m, d, y);
X        }
X        sts = read_line (buf, 20);
X        if (sts < 0)
X        return (-1);
X        bp = buf;
X    }
X    if (sts > 0)
X        crack_year (bp, yp);
X    return (0);
X}
X
X/* given either a decimal year (xxxx. something) or a calendar (x/x/x)
X * convert it to an mjd and store it at *p;
X */
Xstatic
Xcrack_year (bp, p)
Xchar *bp;
Xdouble *p;
X{
X    if (decimal_year(bp)) {
X        double y = atof (bp);
X        year_mjd (y, p);
X    } else {
X        int m, y;
X        double d;
X        mjd_cal (*p, &m, &d, &y);    /* init with current */
X        f_sscandate (bp, &m, &d, &y);
X        cal_mjd (m, d, y, p);
X    }
X}
X
X/* read next two args from av and load the magnitude members m_m1 and m_m2.
X * also set m_whichm to default if this is from the .db file, ie, if av!=0.
X * #,#     -> model is unchanged
X * g#,[k]# -> g/k
X * H#,[G]# -> H/G
X */
Xstatic
Xset_mag (av, vn, mp)
Xchar *av[];    /* arg list */
Xint vn;        /* which arg. we use av[vn] and av[vn+1] */
XMag *mp;
X{
X    int sts;
X    char buf[NC];
X    char *bp;
X
X    if (av) {
X        mp->m_whichm = MAG_HG;    /* always the default for the db file */
X        bp = av[vn];
X        sts = 1;
X    } else {
X        /* show both the value and the type of the first mag param,
X         * as well as a hint as to how to set the type if desired.
X         */
X        (void) sprintf (buf, "%c: (%g) (g# H# or #) ",
X                mp->m_whichm == MAG_HG ? 'H' : 'g', mp->m_m1);
X        f_prompt (buf);
X        sts = read_line (buf, 9);
X        if (sts < 0)
X        return (-1);
X        bp = buf;
X    }
X    if (sts > 0) {
X        switch (bp[0]) {
X        case 'g':
X        mp->m_whichm = MAG_gk;
X        bp++;
X        break;
X        case 'H':
X        mp->m_whichm = MAG_HG;
X        bp++;
X        default:
X        /* leave type unchanged if no prefix */
X        break;
X        }
X        mp->m_m1 = atof (bp);
X    }
X
X    if (av) {
X        bp = av[vn+1];
X        sts = 1;
X    } else {
X        /* can't change the type in the second param */
X        (void) sprintf (buf, "%c: (%g) ",
X                mp->m_whichm == MAG_HG ? 'G' : 'k', mp->m_m2);
X        f_prompt (buf);
X        sts = read_line (buf, 9);
X        if (sts < 0)
X        return (-1);
X        bp = buf;
X    }
X    if (sts > 0) {
X        int ok = 0;
X        switch (bp[0]) {
X        case 'k':
X        if (mp->m_whichm == MAG_gk) {
X            bp++;
X            ok = 1;
X        }
X        break;
X        case 'G':
X        if (mp->m_whichm == MAG_HG) {
X            bp++;
X            ok = 1;
X        }
X        break;
X        default:
X        ok = 1;
X        break;
X        }
X        if (ok)
X        mp->m_m2 = atof (bp);
X        else {
X        f_msg ("Can't switch magnitude models at second parameter.");
X        return (-1);
X        }
X    }
X    return (0);
X}
END_OF_FILE
  if test 29454 -ne `wc -c <'objx.c'`; then
    echo shar: \"'objx.c'\" unpacked with wrong size!
  fi
  # end of 'objx.c'
fi
echo shar: End of archive 3 \(of 9\).
cp /dev/null ark3isdone
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...