ecd@cs.umn.edu@ncs-med.UUCP (Elwood C. Downey) (03/11/90)
Posting-number: Volume 11, Issue 3
Submitted-by: ecd@cs.umn.edu@ncs-med.UUCP (Elwood C. Downey)
Archive-name: ephem4.12/part02
# This is the first line of a "shell archive" file.
# This means it contains several files that can be extracted into
# the current directory when run with the sh shell, as follows:
# sh < this_file_name
# This is file 2.
echo x compiler.c
sed -e 's/^X//' << 'EOFxEOF' > compiler.c
X/* module to compile and execute a c-style arithmetic expression.
X * public entry points are compile_expr() and execute_expr().
X *
X * one reason this is so nice and tight is that all opcodes are the same size
X * (an int) and the tokens the parser returns are directly usable as opcodes,
X * for the most part. constants and variables are compiled as an opcode
X * with an offset into the auxiliary opcode tape, opx.
X */
X
X#include <math.h>
X#include "screen.h"
X
X/* parser tokens and opcodes, as necessary */
X#define HALT 0 /* good value for HALT since program is inited to 0 */
X/* binary operators (precedences in table, below) */
X#define ADD 1
X#define SUB 2
X#define MULT 3
X#define DIV 4
X#define AND 5
X#define OR 6
X#define GT 7
X#define GE 8
X#define EQ 9
X#define NE 10
X#define LT 11
X#define LE 12
X/* unary op, precedence in NEG_PREC #define, below */
X#define NEG 13
X/* symantically operands, ie, constants, variables and all functions */
X#define CONST 14
X#define VAR 15
X#define ABS 16 /* add functions if desired just like this is done */
X/* purely tokens - never get compiled as such */
X#define LPAREN 255
X#define RPAREN 254
X#define ERR (-1)
X
X/* precedence of each of the binary operators.
X * in case of a tie, compiler associates left-to-right.
X * N.B. each entry's index must correspond to its #define!
X */
Xstatic int precedence[] = {0,5,5,6,6,2,1,4,4,3,3,4,4};
X#define NEG_PREC 7 /* negation is highest */
X
X/* execute-time operand stack */
X#define MAX_STACK 16
Xstatic double stack[MAX_STACK], *sp;
X
X/* space for compiled opcodes - the "program".
X * opcodes go in lower 8 bits.
X * when an opcode has an operand (as CONST and VAR) it is really in opx[] and
X * the index is in the remaining upper bits.
X */
X#define MAX_PROG 32
Xstatic int program[MAX_PROG], *pc;
X#define OP_SHIFT 8
X#define OP_MASK 0xff
X
X/* auxiliary operand info.
X * the operands (all but lower 8 bits) of CONST and VAR are really indeces
X * into this array. thus, no point in making this any longer than you have
X * bits more than 8 in your machine's int to index into it, ie, make
X * MAX_OPX <= 1 << ((sizeof(int)-1)*8)
X * also, the fld's must refer to ones being flog'd, so not point in more
X * of these then that might be used for plotting and srching combined.
X */
X#define MAX_OPX 16
Xtypedef union {
X double opu_f; /* value when opcode is CONST */
X int opu_fld; /* rcfpack() of field when opcode is VAR */
X} OpX;
Xstatic OpX opx[MAX_OPX];
Xstatic int opxidx;
X
X/* these are global just for easy/rapid access */
Xstatic int parens_nest; /* to check that parens end up nested */
Xstatic char *err_msg; /* caller provides storage; we point at it with this */
Xstatic char *cexpr, *lcexpr; /* pointers that move along caller's expression */
Xstatic int good_prog; /* != 0 when program appears to be good */
X
X/* compile the given c-style expression.
X * return 0 and set good_prog if ok,
X * else return -1 and a reason message in errbuf.
X */
Xcompile_expr (ex, errbuf)
Xchar *ex;
Xchar *errbuf;
X{
X int instr;
X
X /* init the globals.
X * also delete any flogs used in the previous program.
X */
X cexpr = ex;
X err_msg = errbuf;
X pc = program;
X opxidx = 0;
X parens_nest = 0;
X do {
X instr = *pc++;
X if ((instr & OP_MASK) == VAR)
X flog_delete (opx[instr >> OP_SHIFT].opu_fld);
X } while (instr != HALT);
X
X pc = program;
X if (compile(0) == ERR) {
X sprintf (err_msg + strlen(err_msg), " at \"%.10s\"", lcexpr);
X good_prog = 0;
X return (-1);
X }
X *pc++ = HALT;
X good_prog = 1;
X return (0);
X}
X
X/* execute the expression previously compiled with compile_expr().
X * return 0 with *vp set to the answer if ok, else return -1 with a reason
X * why not message in errbuf.
X */
Xexecute_expr (vp, errbuf)
Xdouble *vp;
Xchar *errbuf;
X{
X int s;
X
X err_msg = errbuf;
X sp = stack + MAX_STACK; /* grows towards lower addresses */
X pc = program;
X s = execute(vp);
X if (s < 0)
X good_prog = 0;
X return (s);
X}
X
X/* this is a way for the outside world to ask whether there is currently a
X * reasonable program compiled and able to execute.
X */
Xprog_isgood()
X{
X return (good_prog);
X}
X
X/* get and return the opcode corresponding to the next token.
X * leave with lcexpr pointing at the new token, cexpr just after it.
X * also watch for mismatches parens and proper operator/operand alternation.
X */
Xstatic
Xnext_token ()
X{
X static char toomt[] = "More than %d terms";
X static char badop[] = "Illegal operator";
X int tok = ERR; /* just something illegal */
X char c;
X
X while ((c = *cexpr) == ' ')
X cexpr++;
X lcexpr = cexpr++;
X
X /* mainly check for a binary operator */
X switch (c) {
X case '\0': --cexpr; tok = HALT; break; /* keep returning HALT */
X case '+': tok = ADD; break; /* compiler knows when it's really unary */
X case '-': tok = SUB; break; /* compiler knows when it's really negate */
X case '*': tok = MULT; break;
X case '/': tok = DIV; break;
X case '(': parens_nest++; tok = LPAREN; break;
X case ')':
X if (--parens_nest < 0) {
X sprintf (err_msg, "Too many right parens");
X return (ERR);
X } else
X tok = RPAREN;
X break;
X case '|':
X if (*cexpr == '|') { cexpr++; tok = OR; }
X else { sprintf (err_msg, badop); return (ERR); }
X break;
X case '&':
X if (*cexpr == '&') { cexpr++; tok = AND; }
X else { sprintf (err_msg, badop); return (ERR); }
X break;
X case '=':
X if (*cexpr == '=') { cexpr++; tok = EQ; }
X else { sprintf (err_msg, badop); return (ERR); }
X break;
X case '!':
X if (*cexpr == '=') { cexpr++; tok = NE; }
X else { sprintf (err_msg, badop); return (ERR); }
X break;
X case '<':
X if (*cexpr == '=') { cexpr++; tok = LE; }
X else tok = LT;
X break;
X case '>':
X if (*cexpr == '=') { cexpr++; tok = GE; }
X else tok = GT;
X break;
X }
X
X if (tok != ERR)
X return (tok);
X
X /* not op so check for a constant, variable or function */
X if (isdigit(c) || c == '.') {
X if (opxidx > MAX_OPX) {
X sprintf (err_msg, toomt, MAX_OPX);
X return (ERR);
X }
X opx[opxidx].opu_f = atof (lcexpr);
X tok = CONST | (opxidx++ << OP_SHIFT);
X skip_double();
X } else if (isalpha(c)) {
X /* check list of functions */
X if (strncmp (lcexpr, "abs", 3) == 0) {
X cexpr += 2;
X tok = ABS;
X } else {
X /* not a function, so assume it's a variable */
X int fld;
X if (opxidx > MAX_OPX) {
X sprintf (err_msg, toomt, MAX_OPX);
X return (ERR);
X }
X fld = parse_fieldname ();
X if (fld < 0) {
X sprintf (err_msg, "Unknown field");
X return (ERR);
X } else {
X if (flog_add (fld) < 0) { /* register with field logger */
X sprintf (err_msg, "Sorry; too many fields");
X return (ERR);
X }
X opx[opxidx].opu_fld = fld;
X tok = VAR | (opxidx++ << OP_SHIFT);
X }
X }
X }
X
X return (tok);
X}
X
X/* move cexpr on past a double.
X * allow sci notation.
X * no need to worry about a leading '-' or '+' but allow them after an 'e'.
X * TODO: this handles all the desired cases, but also admits a bit too much
X * such as things like 1eee2...3. geeze; to skip a double right you almost
X * have to go ahead and crack it!
X */
Xstatic
Xskip_double()
X{
X int sawe = 0; /* so we can allow '-' or '+' right after an 'e' */
X
X while (1) {
X char c = *cexpr;
X if (isdigit(c) || c=='.' || (sawe && (c=='-' || c=='+'))) {
X sawe = 0;
X cexpr++;
X } else if (c == 'e') {
X sawe = 1;
X cexpr++;
X } else
X break;
X }
X}
X
X/* call this whenever you want to dig out the next (sub)expression.
X * keep compiling instructions as long as the operators are higher precedence
X * than prec, then return that "look-ahead" token that wasn't (higher prec).
X * if error, fill in a message in err_msg[] and return ERR.
X */
Xstatic
Xcompile (prec)
Xint prec;
X{
X int expect_binop = 0; /* set after we have seen any operand.
X * used by SUB so it can tell if it really
X * should be taken to be a NEG instead.
X */
X int tok = next_token ();
X
X while (1) {
X int p;
X if (tok == ERR)
X return (ERR);
X if (pc - program >= MAX_PROG) {
X sprintf (err_msg, "Program is too long");
X return (ERR);
X }
X
X /* check for special things like functions, constants and parens */
X switch (tok & OP_MASK) {
X case HALT: return (tok);
X case ADD:
X if (expect_binop)
X break; /* procede with binary addition */
X /* just skip a unary positive(?) */
X tok = next_token();
X continue;
X case SUB:
X if (expect_binop)
X break; /* procede with binary subtract */
X tok = compile (NEG_PREC);
X *pc++ = NEG;
X expect_binop = 1;
X continue;
X case ABS: /* other funcs would be handled the same too ... */
X /* eat up the function parenthesized argument */
X if (next_token() != LPAREN || compile (0) != RPAREN) {
X sprintf (err_msg, "Function arglist error");
X return (ERR);
X }
X /* then handled same as ... */
X case CONST: /* handled same as... */
X case VAR:
X *pc++ = tok;
X tok = next_token();
X expect_binop = 1;
X continue;
X case LPAREN:
X if (compile (0) != RPAREN) {
X sprintf (err_msg, "Unmatched left paren");
X return (ERR);
X }
X tok = next_token();
X expect_binop = 1;
X continue;
X case RPAREN:
X return (RPAREN);
X }
X
X /* everything else is a binary operator */
X p = precedence[tok];
X if (p > prec) {
X int newtok = compile (p);
X if (newtok == ERR)
X return (ERR);
X *pc++ = tok;
X expect_binop = 1;
X tok = newtok;
X } else
X return (tok);
X }
X}
X
X/* "run" the program[] compiled with compile().
X * if ok, return 0 and the final result,
X * else return -1 with a reason why not message in err_msg.
X */
Xstatic
Xexecute(result)
Xdouble *result;
X{
X int instr;
X
X do {
X instr = *pc++;
X switch (instr & OP_MASK) {
X /* put these in numberic order so hopefully even the dumbest
X * compiler will choose to use a jump table, not a cascade of ifs.
X */
X case HALT: break; /* outer loop will stop us */
X case ADD: sp[1] = sp[1] + sp[0]; sp++; break;
X case SUB: sp[1] = sp[1] - sp[0]; sp++; break;
X case MULT: sp[1] = sp[1] * sp[0]; sp++; break;
X case DIV: sp[1] = sp[1] / sp[0]; sp++; break;
X case AND: sp[1] = sp[1] && sp[0] ? 1 : 0; sp++; break;
X case OR: sp[1] = sp[1] || sp[0] ? 1 : 0; sp++; break;
X case GT: sp[1] = sp[1] > sp[0] ? 1 : 0; sp++; break;
X case GE: sp[1] = sp[1] >= sp[0] ? 1 : 0; sp++; break;
X case EQ: sp[1] = sp[1] == sp[0] ? 1 : 0; sp++; break;
X case NE: sp[1] = sp[1] != sp[0] ? 1 : 0; sp++; break;
X case LT: sp[1] = sp[1] < sp[0] ? 1 : 0; sp++; break;
X case LE: sp[1] = sp[1] <= sp[0] ? 1 : 0; sp++; break;
X case NEG: *sp = -*sp; break;
X case CONST: *--sp = opx[instr >> OP_SHIFT].opu_f; break;
X case VAR:
X if (flog_get (opx[instr >> OP_SHIFT].opu_fld, --sp) < 0) {
X sprintf (err_msg, "Bug! VAR field not logged");
X return (-1);
X }
X break;
X case ABS: *sp = fabs (*sp); break;
X default:
X sprintf (err_msg, "Bug! bad opcode: 0x%x", instr);
X return (-1);
X }
X if (sp < stack) {
X sprintf (err_msg, "Runtime stack overflow");
X return (-1);
X } else if (sp - stack > MAX_STACK) {
X sprintf (err_msg, "Bug! runtime stack underflow");
X return (-1);
X }
X } while (instr != HALT);
X
X /* result should now be on top of stack */
X if (sp != &stack[MAX_STACK - 1]) {
X sprintf (err_msg, "Bug! stack has %d items",MAX_STACK-(sp-stack));
X return (-1);
X }
X *result = *sp;
X return (0);
X}
X
Xstatic
Xisdigit(c)
Xchar c;
X{
X return (c >= '0' && c <= '9');
X}
X
Xstatic
Xisalpha (c)
Xchar c;
X{
X return ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
X}
X
X/* starting with lcexpr pointing at a string expected to be a field name,
X * return an rcfpack(r,c,0) of the field else -1 if bad.
X * when return, leave lcexpr alone but move cexpr to just after the name.
X */
Xstatic
Xparse_fieldname ()
X{
X int r = -1, c = -1; /* anything illegal */
X char *fn = lcexpr; /* likely faster than using the global */
X char f0, f1;
X char *dp;
X
X /* search for first thing not an alpha char.
X * leave it in f0 and leave dp pointing to it.
X */
X dp = fn;
X while (isalpha(f0 = *dp))
X dp++;
X
X /* crack the new field name.
X * when done trying, leave dp pointing at first char just after it.
X * set r and c if we recognized it.
X */
X if (f0 == '.') {
X /* planet.column pair.
X * first crack the planet portion (pointed to by fn): set r.
X * then the second portion (pointed to by dp+1): set c.
X */
X f0 = fn[0];
X f1 = fn[1];
X switch (f0) {
X case 'j':
X r = R_JUPITER;
X break;
X case 'm':
X if (f1 == 'a') r = R_MARS;
X else if (f1 == 'e') r = R_MERCURY;
X else if (f1 == 'o') r = R_MOON;
X break;
X case 'n':
X r = R_NEPTUNE;
X break;
X case 'p':
X r = R_PLUTO;
X break;
X case 's':
X if (f1 == 'a') r = R_SATURN;
X else if (f1 == 'u') r = R_SUN;
X break;
X case 'u':
X r = R_URANUS;
X break;
X case 'x':
X r = R_OBJX;
X break;
X case 'v':
X r = R_VENUS;
X break;
X }
X
X /* now crack the column (stuff after the dp) */
X dp++; /* point at good stuff just after the decimal pt */
X f0 = dp[0];
X f1 = dp[1];
X switch (f0) {
X case 'a':
X if (f1 == 'l') c = C_ALT;
X else if (f1 == 'z') c = C_AZ;
X break;
X case 'd':
X c = C_DEC;
X break;
X case 'e':
X if (f1 == 'd') c = C_EDIST;
X else if (f1 == 'l') c = C_ELONG;
X break;
X case 'h':
X if (f1 == 'l') {
X if (dp[2] == 'a') c = C_HLAT;
X else if (dp[2] == 'o') c = C_HLONG;
X } else if (f1 == 'r' || f1 == 'u') c = C_TUP;
X break;
X case 'j':
X c = C_JUPITER;
X break;
X case 'm':
X if (f1 == 'a') c = C_MARS;
X else if (f1 == 'e') c = C_MERCURY;
X else if (f1 == 'o') c = C_MOON;
X break;
X case 'n':
X c = C_NEPTUNE;
X break;
X case 'p':
X if (f1 == 'h') c = C_PHASE;
X else if (f1 == 'l') c = C_PLUTO;
X break;
X case 'r':
X if (f1 == 'a') {
X if (dp[2] == 'z') c = C_RISEAZ;
X else c = C_RA;
X } else if (f1 == 't') c = C_RISETM;
X break;
X case 's':
X if (f1 == 'a') {
X if (dp[2] == 'z') c = C_SETAZ;
X else c = C_SATURN;
X } else if (f1 == 'd') c = C_SDIST;
X else if (f1 == 'i') c = C_SIZE;
X else if (f1 == 't') c = C_SETTM;
X else if (f1 == 'u') c = C_SUN;
X break;
X case 't':
X if (f1 == 'a') c = C_TRANSALT;
X else if (f1 == 't') c = C_TRANSTM;
X break;
X case 'u':
X c = C_URANUS;
X break;
X case 'v':
X if (f1 == 'e') c = C_VENUS;
X else if (f1 == 'm') c = C_MAG;
X break;
X }
X
X /* now skip dp on past the column stuff */
X while (isalpha(*dp))
X dp++;
X } else {
X /* no decimal point; some field in the top of the screen */
X f0 = fn[0];
X f1 = fn[1];
X switch (f0) {
X case 'd':
X if (f1 == 'a') r = R_DAWN, c = C_DAWNV;
X else if (f1 == 'u') r = R_DUSK, c = C_DUSKV;
X break;
X case 'n':
X r = R_LON, c = C_LONV;
X break;
X }
X }
X
X cexpr = dp;
X if (r <= 0 || c <= 0) return (-1);
X return (rcfpack (r, c, 0));
X}
EOFxEOF
len=`wc -c < compiler.c`
if expr $len != 15015 > /dev/null
then echo Length of compiler.c is $len but it should be 15015.
fi
echo x eq_ecl.c
sed -e 's/^X//' << 'EOFxEOF' > eq_ecl.c
X#include <stdio.h>
X#include <math.h>
X#include "astro.h"
X
X#define EQtoECL 1
X#define ECLtoEQ (-1)
X
X/* given the modified Julian date, mjd, and an equitorial ra and dec, each in
X * radians, find the corresponding geocentric ecliptic latitude, *lat, and
X * longititude, *lng, also each in radians.
X * correction for the effect on the angle of the obliquity due to nutation is
X * included.
X */
Xeq_ecl (mjd, ra, dec, lat, lng)
Xdouble mjd, ra, dec;
Xdouble *lat, *lng;
X{
X ecleq_aux (EQtoECL, mjd, ra, dec, lng, lat);
X}
X
X/* given the modified Julian date, mjd, and a geocentric ecliptic latitude,
X * *lat, and longititude, *lng, each in radians, find the corresponding
X * equitorial ra and dec, also each in radians.
X * correction for the effect on the angle of the obliquity due to nutation is
X * included.
X */
Xecl_eq (mjd, lat, lng, ra, dec)
Xdouble mjd, lat, lng;
Xdouble *ra, *dec;
X{
X ecleq_aux (ECLtoEQ, mjd, lng, lat, ra, dec);
X}
X
Xstatic
Xecleq_aux (sw, mjd, x, y, p, q)
Xint sw; /* +1 for eq to ecliptic, -1 for vv. */
Xdouble mjd, x, y; /* sw==1: x==ra, y==dec. sw==-1: x==lng, y==lat. */
Xdouble *p, *q; /* sw==1: p==lng, q==lat. sw==-1: p==ra, q==dec. */
X{
X static double lastmjd; /* last mjd calculated */
X static double seps, ceps; /* sin and cos of mean obliquity */
X double sx, cx, sy, cy, ty;
X
X if (mjd != lastmjd) {
X double eps;
X double deps, dpsi;
X obliquity (mjd, &eps); /* mean obliquity for date */
X nutation (mjd, &deps, &dpsi);
X eps += deps;
X seps = sin(eps);
X ceps = cos(eps);
X lastmjd = mjd;
X }
X
X sy = sin(y);
X cy = cos(y); /* always non-negative */
X if (fabs(cy)<1e-20) cy = 1e-20; /* insure > 0 */
X ty = sy/cy;
X cx = cos(x);
X sx = sin(x);
X *q = asin((sy*ceps)-(cy*seps*sx*sw));
X *p = atan(((sx*ceps)+(ty*seps*sw))/cx);
X if (cx<0) *p += PI; /* account for atan quad ambiguity */
X range (p, 2*PI);
X}
EOFxEOF
len=`wc -c < eq_ecl.c`
if expr $len != 1891 > /dev/null
then echo Length of eq_ecl.c is $len but it should be 1891.
fi
echo x flog.c
sed -e 's/^X//' << 'EOFxEOF' > flog.c
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(), and its value as a double. you can reset the
X * list of flogs, add to and remove from the list of registered fields and log
X * a field if it has 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.
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
X#define NFLOGS 32
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;
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 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)
Xint r, c;
Xdouble val;
X{
X if (plot_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 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.
X * return 0 if found it, else -1 if not in list.
X */
Xflog_get (fld, vp)
Xint fld;
Xdouble *vp;
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 return (0);
X }
X return (-1);
X}
EOFxEOF
len=`wc -c < flog.c`
if expr $len != 2680 > /dev/null
then echo Length of flog.c is $len but it should be 2680.
fi
echo x formats.c
sed -e 's/^X//' << 'EOFxEOF' > formats.c
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 "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
X (void) flog_log (r, c, v);
X
X if (f_scrnoff)
X return;
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 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 strcpy (str, "-0");
X else
X 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 sprintf (astr, "%*s:%02d", a, str, (int)(frac+0.5));
X else
X sprintf (astr, "%*s:%0*.*f", a, str, p+3, p, frac);
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 (void) flog_log (r, c, t);
X if (f_scrnoff)
X return;
X dec_sex (t, &h, &m, &s, &tisneg);
X if (h == 0 && tisneg)
X sprintf (tstr, "%*s-0:%02d:%02d", nd-2, "", m, s);
X else
X sprintf (tstr, "%*d:%02d:%02d", nd, tisneg ? -h : h, m, s);
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 /* shadow to the plot subsystem as years. */
X mjd_year (jd, &tmp);
X (void) flog_log (r, c, tmp);
X if (f_scrnoff)
X return;
X
X mjd_cal (jd, &m, &d, &y);
X
X sprintf (dstr, "%2d/%02d/%04d", m, (int)(d), y);
X f_string (r, c, dstr);
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 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) flog_log (r, c, f);
X sprintf (str, fmt, f);
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 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 (c >= '0' && c <= '9') {
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++) && (c >= '0' && c <= '9'))
X continue;
X if (bp > bp0+1)
X *m = atoi (bp0);
X if (c == '\0')
X return;
X bp0 = bp;
X while ((c = *bp++) && (c >= '0' && c <= '9' || 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 is assumed to be a year, or any string
X * 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 int n = atoi(bp);
X
X while (c = *bp++) {
X nchar++;
X if (c >= '0' && c <= '9')
X ndig++;
X else if (c == '.')
X ndp++;
X else if (c == '-')
X nneg++;
X }
X
X return (n > 12 || (ndp == 1 && nneg <= 1 && nchar == ndig+ndp+nneg));
X}
EOFxEOF
len=`wc -c < formats.c`
if expr $len != 6850 > /dev/null
then echo Length of formats.c is $len but it should be 6850.
fi
echo x io.c
sed -e 's/^X//' << 'EOFxEOF' > io.c
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_NDELAY: does non-blocking tty reads with fcntl(O_NDELAY); otherwise
X * this is done with ioctl(..,FIONREAD..). Use which ever works on your
X * system.
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 */
X
X#define UNIX
X/* #define USE_NDELAY */
X/* #define TURBO_C */
X/* #define USE_ANSISYS */
X
X#include <stdio.h>
X#include "screen.h"
X
X#ifdef UNIX
X#include <sgtty.h>
X#include <signal.h>
X#ifdef USE_NDELAY
X#include <fcntl.h>
X#endif
X
Xextern char *tgoto();
Xstatic char *cm, *ce, *cl, *kl, *kr, *ku, *kd; /* curses sequences */
Xstatic int tloaded;
Xstatic int ttysetup;
Xstatic struct sgttyb orig_sgtty;
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 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#else
X long n;
X if (!ttysetup) setuptty();
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 curses 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 (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 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 ioctl (0, TIOCSETP, &orig_sgtty);
X#ifdef USE_NDELAY
X fcntl (0, F_SETFL, 0); /* be sure to go back to blocking read */
X#endif
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 ("Must have addressable cursor\n");
X exit(1);
X }
X
X if (!ttysetup) setuptty();
X if (tgetent (rawtbuf, tp) != 1) {
X printf ("Can't find termcap for %s\n", tp);
X exit (1);
X }
X ptr = tbuf;
X ku = egetstr ("ku", &ptr);
X kd = egetstr ("kd", &ptr);
X kl = egetstr ("kl", &ptr);
X kr = egetstr ("kr", &ptr);
X cm = egetstr ("cm", &ptr);
X ce = egetstr ("ce", &ptr);
X cl = egetstr ("cl", &ptr);
X UP = egetstr ("up", &ptr);
X if (!tgetflag ("bs"))
X BC = egetstr ("bc", &ptr);
X tloaded = 1;
X}
X
X/* like tgetstr() but discard curses delay codes, for now anyways */
Xstatic char *
Xegetstr (name, sptr)
Xchar *name;
Xchar **sptr;
X{
X extern char *tgetstr();
X register char c, *s;
X
X s = tgetstr (name, sptr);
X while (((c = *s) >= '0' && c <= '9') || c == '*')
X s += 1;
X return (s);
X}
X
X/* set up tty for char-by-char read, non-blocking */
Xstatic
Xsetuptty()
X{
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 ttysetup = 1;
X}
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#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 (c >= ' ') {
X putchar (c);
X buf[n++] = c;
X }
X }
X
X buf[n] = '\0';
X return (n);
X}
EOFxEOF
len=`wc -c < io.c`
if expr $len != 8533 > /dev/null
then echo Length of io.c is $len but it should be 8533.
fi
echo x main.c
sed -e 's/^X//' << 'EOFxEOF' > main.c
X/* main "ephem" program.
X * -------------------------------------------------------------------
X * Copyright (c) 1990 by Elwood Charles Downey
X *
X * Permission is granted to make and distribute copies of this program
X * free of charge, provided the copyright notice and this permission
X * notice are preserved on all copies. All other rights reserved.
X * -------------------------------------------------------------------
X * set options.
X * init screen and circumstances.
X * enter infinite loop updating screen and allowing operator input.
X */
X
X#include <stdio.h>
X#include <signal.h>
X#include <math.h>
X#include "astro.h"
X#include "circum.h"
X#include "screen.h"
X
Xextern char *getenv();
Xextern char *strcpy();
X
X/* shorthands for fields of a Now structure, now.
X * first undo the ones for a Now pointer from circum.h.
X */
X#undef mjd
X#undef lat
X#undef lng
X#undef tz
X#undef temp
X#undef pressure
X#undef height
X#undef epoch
X#undef tznm
X
X#define mjd now.n_mjd
X#define lat now.n_lat
X#define lng now.n_lng
X#define tz now.n_tz
X#define temp now.n_temp
X#define pressure now.n_pressure
X#define height now.n_height
X#define epoch now.n_epoch
X#define tznm now.n_tznm
X
Xstatic char *cfgfile = "ephem.cfg"; /* default config filename */
X
Xstatic Now now; /* where when and how, right now */
Xstatic double tminc; /* hrs to inc time by each loop; RTC means use clock */
Xstatic int nstep; /* steps to go before stopping */
Xstatic int optwi; /* set when want to display dawn/dusk/len-of-night */
Xstatic int oppl; /* mask of (1<<planet) bits; set when want to show it */
X
Xmain (ac, av)
Xint ac;
Xchar *av[];
X{
X void bye();
X static char freerun[] =
X "Running... press any key to stop to make changes.";
X static char prmpt[] =
X"Move to another field, RETURN to change this field, ? for help, or q to run";
X static char hlp[] =
X "arrow keys move to field; any key stops running; ^d exits; ^l redraws";
X int curr = R_NSTEP, curc = C_NSTEPV; /* must start somewhere */
X int sflag = 0; /* not silent, by default */
X int one = 1; /* use a variable so optimizer doesn't get disabled */
X int srchdone = 0; /* true when search funcs say so */
X int newcir = 2; /* set when circumstances change - means don't tminc */
X
X while ((--ac > 0) && (**++av == '-')) {
X char *s;
X for (s = *av+1; *s != '\0'; s++)
X switch (*s) {
X case 's': /* no credits "silent" (don't publish this) */
X sflag++;
X break;
X case 'c': /* set name of config file to use */
X if (--ac <= 0) usage("-c but no config file");
X cfgfile = *++av;
X break;
X default:
X usage("Bad - option");
X }
X }
X
X if (!sflag)
X credits();
X
X /* fresh screen.
X * crack config file, THEN args so args may override.
X */
X c_erase();
X read_cfgfile (cfgfile);
X read_fieldargs (ac, av);
X
X /* set up to clean up screen and tty if interrupted */
X signal (SIGINT, bye);
X
X /* update screen forever (until QUIT) */
X while (one) {
X
X nstep -= 1;
X
X /* recalculate everything and update all the fields */
X redraw_screen (newcir);
X mm_newcir (0);
X
X /* let searching functions change tminc and check for done */
X srchdone = srch_eval (mjd, &tminc) < 0;
X print_tminc(0); /* to show possibly new search increment */
X
X /* update plot file, now that all fields are up to date and
X * search function has been evaluated.
X */
X plot();
X
X /* stop loop to allow op to change parameters:
X * if a search evaluation converges (or errors out),
X * or if steps are done,
X * or if op hits any key.
X */
X newcir = 0;
X if (srchdone || nstep <= 0 || (chk_char()==0 && read_char()!=0)) {
X int fld;
X
X /* update screen with the current stuff if stopped during
X * unattended plotting since last redraw_screen() didn't.
X */
X if (plot_ison() && nstep > 0)
X redraw_screen (1);
X
X /* return nstep to default of 1 */
X if (nstep <= 0) {
X nstep = 1;
X print_nstep (0);
X }
X
X /* change fields until END.
X * update all time fields if any are changed
X * and print NEW CIRCUMSTANCES if any have changed.
X * QUIT causes bye() to be called and we never return.
X */
X while(fld = sel_fld(curr,curc,alt_menumask()|F_CHG,prmpt,hlp)) {
X if (chg_fld ((char *)0, fld)) {
X mm_now (&now, 1);
X mm_newcir(1);
X newcir = 1;
X }
X curr = unpackr (fld);
X curc = unpackc (fld);
X }
X if (nstep > 1)
X f_prompt (freerun);
X }
X
X /* increment time only if op didn't change cirumstances */
X if (!newcir)
X inc_mjd (&now, tminc);
X }
X
X return (0);
X}
X
X/* draw all the stuff on the screen, using the current menu.
X * if how_much == 0 then just update fields that need it;
X * if how_much == 1 then redraw all fields;
X * if how_much == 2 then erase the screen and redraw EVERYTHING.
X */
Xredraw_screen (how_much)
Xint how_much;
X{
X if (how_much == 2)
X c_erase();
X
X /* print the single-step message if this is the last loop */
X if (nstep < 1)
X print_updating();
X
X if (how_much == 2) {
X mm_borders();
X mm_labels();
X srch_prstate(1);
X plot_prstate(1);
X alt_labels();
X }
X
X /* if just updating changed fields while plotting unattended then
X * suppress most screen updates except
X * always show nstep to show plot loops to go and
X * always show tminc to show search convergence progress.
X */
X print_nstep(how_much);
X print_tminc(how_much);
X if (how_much == 0 && plot_ison() && nstep > 0)
X f_off();
X
X /* print all the time-related fields */
X mm_now (&now, how_much);
X
X if (optwi)
X mm_twilight (&now, how_much);
X
X /* print solar system body info */
X print_bodies (how_much);
X
X f_on();
X}
X
X/* clean up and exit for sure.
X */
Xvoid
Xbye()
X{
X c_erase();
X byetty();
X exit (0);
X}
X
Xstatic
Xusage(why)
Xchar *why;
X{
X /* don't advertise -s (silent) option */
X c_erase();
X f_string (1, 1, why);
X f_string (2, 1, "usage: [-c <configfile>] [field=value] ...\r\n");
X byetty();
X exit (1);
X}
X
X/* read cfg file, fn, if present.
X * if errors in file, call usage() (which exits).
X * try $HOME/.ephemrc as last resort.
X * skip blank lines and lines that begin with '#', '*', ' ' or '\t'.
X */
Xstatic
Xread_cfgfile(fn)
Xchar *fn;
X{
X char buf[128];
X FILE *fp;
X
X fp = fopen (fn, "r");
X if (!fp) {
X char *home = getenv ("HOME");
X if (home) {
X sprintf (buf, "%s/.ephemrc", home);
X fp = fopen (buf, "r");
X if (!fp)
X return; /* oh well */
X fn = buf; /* save fn for error report */
X }
X }
X
X while (fgets (buf, sizeof(buf), fp)) {
X switch (buf[0]) {
X case '#': case '*': case ' ': case '\t': case '\n':
X continue;
X }
X buf[strlen(buf)-1] = '\0'; /* discard trailing \n */
X if (crack_fieldset (buf) < 0) {
X char why[128];
X sprintf (why, "Unknown field spec in %s: %s\n", fn, buf);
X usage (why);
X }
X }
X fclose (fp);
X}
X
X/* process the field specs from the command line.
X * if trouble call usage() (which exits).
X */
Xstatic
Xread_fieldargs (ac, av)
Xint ac; /* number of such specs */
Xchar *av[]; /* array of strings in form <field_name value> */
X{
X while (--ac >= 0) {
X char *fs = *av++;
X if (crack_fieldset (fs) < 0) {
X char why[128];
X sprintf (why, "Unknown command line field spec: %s", fs);
X usage (why);
X }
X }
X}
X
X/* process a field spec in buf, either from config file or argv.
X * return 0 if recognized ok, else -1.
X */
Xstatic
Xcrack_fieldset (buf)
Xchar *buf;
X{
X if (strncmp ("LAT", buf, 3) == 0)
X (void) chg_fld (buf+4, rcfpack (R_LAT,C_LATV,0));
X else if (strncmp ("LONG", buf, 4) == 0)
X (void) chg_fld (buf+5, rcfpack (R_LONG,C_LONGV,0));
X else if (strncmp ("UT", buf, 2) == 0)
X (void) chg_fld (buf+3, rcfpack (R_UT,C_UTV,0));
X else if (strncmp ("UD", buf, 2) == 0)
X (void) chg_fld (buf+3, rcfpack (R_UD,C_UD,0));
X else if (strncmp ("TZONE", buf, 5) == 0)
X (void) chg_fld (buf+6, rcfpack (R_TZONE,C_TZONEV,0));
X else if (strncmp ("TZNAME", buf, 6) == 0)
X (void) chg_fld (buf+7, rcfpack (R_TZN,C_TZN,0));
X else if (strncmp ("HEIGHT", buf, 6) == 0)
X (void) chg_fld (buf+7, rcfpack (R_HEIGHT,C_HEIGHTV,0));
X else if (strncmp ("NSTEP", buf, 5) == 0)
X (void) chg_fld (buf+6, rcfpack (R_NSTEP,C_NSTEPV,0));
X else if (strncmp ("STPSZ", buf, 5) == 0)
X (void) chg_fld (buf+6, rcfpack (R_STPSZ,C_STPSZV,0));
X else if (strncmp ("TEMP", buf, 4) == 0)
X (void) chg_fld (buf+5, rcfpack (R_TEMP,C_TEMPV,0));
X else if (strncmp ("PRES", buf, 4) == 0)
X (void) chg_fld (buf+5, rcfpack (R_PRES,C_PRESV,0));
X else if (strncmp ("EPOCH", buf, 5) == 0)
X (void) chg_fld (buf+6, rcfpack (R_EPOCH,C_EPOCHV,0));
X else if (strncmp ("JD", buf, 2) == 0)
X (void) chg_fld (buf+3, rcfpack (R_JD,C_JDV,0));
X else if (strncmp ("OBJX", buf, 4) == 0)
X (void) objx_define (buf+5);
X else if (strncmp ("PROPTS", buf, 6) == 0) {
X char *bp = buf+7;
X if (buf[6] != '+')
X optwi = oppl = 0;
X while (*bp)
X switch (*bp++) {
X case 'T': optwi = 1; break;
X case 'S': oppl |= (1<<SUN); break;
X case 'M': oppl |= (1<<MOON); break;
X case 'e': oppl |= (1<<MERCURY); break;
X case 'v': oppl |= (1<<VENUS); break;
X case 'm': oppl |= (1<<MARS); break;
X case 'j': oppl |= (1<<JUPITER); break;
X case 's': oppl |= (1<<SATURN); break;
X case 'u': oppl |= (1<<URANUS); break;
X case 'n': oppl |= (1<<NEPTUNE); break;
X case 'p': oppl |= (1<<PLUTO); break;
X case 'x': oppl |= (1<<OBJX); objx_on(); break;
X }
X } else
X return (-1);
X return (0);
X}
X
X/* change the field at rcpk according to the optional string input at bp.
X * if bp is != 0 use it, else issue read_line() and use buffer.
X * then sscanf the buffer and update the corresponding (global) variable(s)
X * or do whatever a pick at that field should do.
X * return 1 if we change a field that invalidates any of the times or
X * to update all related fields.
X */
Xstatic
Xchg_fld (bp, rcpk)
Xchar *bp;
Xint rcpk;
X{
X char buf[NC];
X int deghrs = 0, mins = 0, secs = 0;
X int new = 0;
X
X /* switch on just the row/col portion */
X switch (unpackrc(rcpk)) {
X case rcfpack (R_ALTM, C_ALTM, 0):
X if (altmenu_setup() == 0) {
X print_updating();
X alt_nolabels();
X clrall_bodies();
X alt_labels();
X print_bodies(1);
X }
X break;
X case rcfpack (R_JD, C_JDV, 0):
X if (!bp) {
X static char p[] = "Julian Date (or n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else
X mjd = atof(bp) - 2415020L;
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_UD, C_UD, 0):
X if (!bp) {
X static char p[] = "utc date (m/d/y, or year.d, or n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else {
X if (decimal_year(bp)) {
X double y = atof (bp);
X year_mjd (y, &mjd);
X } else {
X double day, newmjd0;
X int month, year;
X mjd_cal (mjd, &month, &day, &year); /* init with now */
X f_sscandate (bp, &month, &day, &year);
X cal_mjd (month, day, year, &newmjd0);
X /* if don't give a fractional part to days
X * then retain current hours.
X */
X if ((long)day == day)
X mjd = newmjd0 + mjd_hr(mjd)/24.0;
X else
X mjd = newmjd0;
X }
X }
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_UT, C_UTV, 0):
X if (!bp) {
X static char p[] = "utc time (h:m:s, or n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else {
X double newutc = (mjd-mjd_day(mjd)) * 24.0;
X f_dec_sexsign (newutc, °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &newutc);
X mjd = mjd_day(mjd) + newutc/24.0;
X }
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_LD, C_LD, 0):
X if (!bp) {
X static char p[] = "local date (m/d/y, or year.d, n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else {
X if (decimal_year(bp)) {
X double y = atof (bp);
X year_mjd (y, &mjd);
X mjd += tz/24.0;
X } else {
X double day, newlmjd0;
X int month, year;
X mjd_cal (mjd-tz/24.0, &month, &day, &year); /* now */
X f_sscandate (bp, &month, &day, &year);
X cal_mjd (month, day, year, &newlmjd0);
X /* if don't give a fractional part to days
X * then retain current hours.
X */
X if ((long)day == day)
X mjd = newlmjd0 + mjd_hr(mjd-tz/24.0)/24.0;
X else
X mjd = newlmjd0;
X mjd += tz/24.0;
X }
X }
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_LT, C_LT, 0):
X if (!bp) {
X static char p[] = "local time (h:m:s, or n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else {
X double newlt = (mjd-mjd_day(mjd)) * 24.0 - tz;
X range (&newlt, 24.0);
X f_dec_sexsign (newlt, °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &newlt);
X mjd = mjd_day(mjd-tz/24.0) + (newlt + tz)/24.0;
X }
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_LST, C_LSTV, 0):
X if (!bp) {
X static char p[] = "local sidereal time (h:m:s, or n for Now): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'n' || bp[0] == 'N')
X time_fromsys (&now);
X else {
X double lst, utc;
X now_lst (&now, &lst);
X f_dec_sexsign (lst, °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &lst);
X lst -= radhr(lng); /* convert to gst */
X range (&lst, 24.0);
X gst_utc (mjd_day(mjd), lst, &utc);
X mjd = mjd_day(mjd) + utc/24.0;
X }
X set_t0 (&now);
X new = 1;
X break;
X case rcfpack (R_TZN, C_TZN, 0):
X if (!bp) {
X static char p[] = "timezone abbreviation (3 char max): ";
X f_prompt (p);
X if (read_line (buf, 3) <= 0)
X break;
X bp = buf;
X }
X strcpy (tznm, bp);
X new = 1;
X break;
X case rcfpack (R_TZONE, C_TZONEV, 0):
X if (!bp) {
X static char p[] = "hours behind utc: ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X f_dec_sexsign (tz, °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &tz);
X new = 1;
X break;
X case rcfpack (R_LONG, C_LONGV, 0):
X if (!bp) {
X static char p[] = "longitude (+ west) (d:m:s): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X f_dec_sexsign (-raddeg(lng), °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &lng);
X lng = degrad (-lng); /* want - radians west */
X new = 1;
X break;
X case rcfpack (R_LAT, C_LATV, 0):
X if (!bp) {
X static char p[] = "latitude (+ north) (d:m:s): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X f_dec_sexsign (raddeg(lat), °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &lat);
X lat = degrad (lat);
X new = 1;
X break;
X case rcfpack (R_HEIGHT, C_HEIGHTV, 0):
X if (!bp) {
X static char p[] = "height above sea level (ft): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X sscanf (bp, "%lf", &height);
X height /= 2.093e7; /* convert ft to earth radii above sea level */
X new = 1;
X break;
X case rcfpack (R_NSTEP, C_NSTEPV, 0):
X if (!bp) {
X static char p[] = "number of steps to run: ";
X f_prompt (p);
X if (read_line (buf, 8) <= 0)
X break;
X bp = buf;
X }
X sscanf (bp, "%d", &nstep);
X print_nstep (0);
X break;
X case rcfpack (R_TEMP, C_TEMPV, 0):
X if (!bp) {
X static char p[] = "temperature (deg.F): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X sscanf (bp, "%lf", &temp);
X temp = 5./9.*(temp - 32.0); /* want degs C */
X new = 1;
X break;
X case rcfpack (R_PRES, C_PRESV, 0):
X if (!bp) {
X static char p[] =
X "atmos pressure (in. Hg; 0 for no refraction correction): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X sscanf (bp, "%lf", &pressure);
X pressure *= 33.86; /* want mBar */
X new = 1;
X break;
X case rcfpack (R_EPOCH, C_EPOCHV, 0):
X if (!bp) {
X static char p[] = "epoch (year, or e for Equinox of Date): ";
X f_prompt (p);
X if (read_line (buf, PW-strlen(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'e' || bp[0] == 'E')
X epoch = EOD;
X else {
X double e;
X e = atof(bp);
X year_mjd (e, &epoch);
X }
X new = 1;
X break;
X case rcfpack (R_STPSZ, C_STPSZV, 0):
X if (!bp) {
X static char p[] =
X "step size increment (h:m:s, or <x>d for x days, or r for RTC): ";
X f_prompt (p);
X if (read_line (buf, PW-sizeof(p)) <= 0)
X break;
X bp = buf;
X }
X if (bp[0] == 'r' || bp[0] == 'R')
X tminc = RTC;
X else {
X int last = strlen (bp) - 1;
X if (bp[last] == 'd') {
X /* ends in d so treat as a number of days */
X double x;
X sscanf (bp, "%lf", &x);
X tminc = x * 24.0;
X } else {
X if (tminc == RTC)
X deghrs = mins = secs = 0;
X else
X f_dec_sexsign (tminc, °hrs, &mins, &secs);
X f_sscansex (bp, °hrs, &mins, &secs);
X sex_dec (deghrs, mins, secs, &tminc);
X }
X }
X print_tminc(0);
X set_t0 (&now);
X break;
X case rcfpack (R_PLOT, C_PLOT, 0):
X plot_setup();
X if (plot_ison())
X new = 1;
X break;
X case rcfpack (R_WATCH, C_WATCH, 0):
X watch (&now, tminc, oppl);
X /* set new reference time to what watch left it.
X * no need to set new since watch just did a redraw.
X */
X set_t0 (&now);
X break;
X case rcfpack (R_DAWN, C_DAWN, 0):
X case rcfpack (R_DUSK, C_DUSK, 0):
X case rcfpack (R_LON, C_LON, 0):
X if (optwi ^= 1) {
X print_updating();
X mm_twilight (&now, 1);
X } else {
X f_blanks (R_DAWN, C_DAWNV, 5);
X f_blanks (R_DUSK, C_DUSKV, 5);
X f_blanks (R_LON, C_LONV, 5);
X }
X break;
X case rcfpack (R_SRCH, C_SRCH, 0):
X srch_setup();
X if (srch_ison())
X new = 1;
X break;
X case rcfpack (R_SUN, C_OBJ, 0):
X if ((oppl ^= (1<<SUN)) & (1<<SUN)) {
X print_updating();
X alt_body (SUN, 1, &now);
X } else
X alt_nobody (SUN);
X break;
X case rcfpack (R_MOON, C_OBJ, 0):
X if ((oppl ^= (1<<MOON)) & (1<<MOON)) {
X print_updating();
X alt_body (MOON, 1, &now);
X } else
X alt_nobody (MOON);
X break;
X case rcfpack (R_MERCURY, C_OBJ, 0):
X if ((oppl ^= (1<<MERCURY)) & (1<<MERCURY)) {
X print_updating();
X alt_body (MERCURY, 1, &now);
X } else
X alt_nobody (MERCURY);
X break;
X case rcfpack (R_VENUS, C_OBJ, 0):
X if ((oppl ^= (1<<VENUS)) & (1<<VENUS)) {
X print_updating();
X alt_body (VENUS, 1, &now);
X } else
X alt_nobody (VENUS);
X break;
X case rcfpack (R_MARS, C_OBJ, 0):
X if ((oppl ^= (1<<MARS)) & (1<<MARS)) {
X print_updating();
X alt_body (MARS, 1, &now);
X } else
X alt_nobody (MARS);
X break;
X case rcfpack (R_JUPITER, C_OBJ, 0):
X if ((oppl ^= (1<<JUPITER)) & (1<<JUPITER)) {
X print_updating();
X alt_body (JUPITER, 1, &now);
X } else
X alt_nobody (JUPITER);
X break;
X case rcfpack (R_SATURN, C_OBJ, 0):
X if ((oppl ^= (1<<SATURN)) & (1<<SATURN)) {
X print_updating();
X alt_body (SATURN, 1, &now);
X } else
X alt_nobody (SATURN);
X break;
X case rcfpack (R_URANUS, C_OBJ, 0):
X if ((oppl ^= (1<<URANUS)) & (1<<URANUS)) {
X print_updating();
X alt_body (URANUS, 1, &now);
X } else
X alt_nobody (URANUS);
X break;
X case rcfpack (R_NEPTUNE, C_OBJ, 0):
X if ((oppl ^= (1<<NEPTUNE)) & (1<<NEPTUNE)) {
X print_updating();
X alt_body (NEPTUNE, 1, &now);
X } else
X alt_nobody (NEPTUNE);
X break;
X case rcfpack (R_PLUTO, C_OBJ, 0):
X if ((oppl ^= (1<<PLUTO)) & (1<<PLUTO)) {
X print_updating();
X alt_body (PLUTO, 1, &now);
X } else
X alt_nobody (PLUTO);
X break;
X case rcfpack (R_OBJX, C_OBJ, 0):
X /* this might change which columns are used so erase all when
X * returns and redraw if still on.
X */
X objx_setup ();
X alt_nobody (OBJX);
X if (objx_ison()) {
X oppl |= 1 << OBJX;
X print_updating();
X alt_body (OBJX, 1, &now);
X } else
X oppl &= ~(1 << OBJX); /* already erased; just clear flag */
X break;
X }
X
X return (new);
X}
X
Xstatic
Xprint_tminc(force)
Xint force;
X{
X static double last;
X
X if (force || tminc != last) {
X if (tminc == RTC)
X f_string (R_STPSZ, C_STPSZV, " RT CLOCK");
X else if (fabs(tminc) >= 24.0)
X f_double (R_STPSZ, C_STPSZV, "%6.4g dy", tminc/24.0);
X else
X f_signtime (R_STPSZ, C_STPSZV, tminc);
X last = tminc;
X }
X}
X
Xstatic
Xprint_bodies (force)
Xint force;
X{
X int p;
X
X for (p = nxtbody(-1); p != -1; p = nxtbody(p))
X if (oppl & (1<<p))
X alt_body (p, force, &now);
X}
X
Xstatic
Xclrall_bodies ()
X{
X int p;
X
X for (p = nxtbody(-1); p != -1; p = nxtbody(p))
X if (oppl & (1<<p))
X alt_nobody (p);
X}
X
Xprint_updating()
X{
X f_prompt ("Updating...");
X}
X
Xstatic
Xprint_nstep(force)
Xint force;
X{
X static int last;
X
X if (force || nstep != last) {
X char buf[16];
X sprintf (buf, "%8d", nstep);
X f_string (R_NSTEP, C_NSTEPV, buf);
X last = nstep;
X }
X}
EOFxEOF
len=`wc -c < main.c`
if expr $len != 21224 > /dev/null
then echo Length of main.c is $len but it should be 21224.
fi