Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume11/gnuplot2/part06

Text File | 1990-03-25 | 64.9 KB | 2,662 lines

Newsgroups: comp.sources.misc
organization: Pixar -- Marin County, California
subject: v11i071: Gnuplot 2.0 - 6 of 14
From: [e-mail]@pixar.UUCP (Tom Williams)
Sender: [e-mail] (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 11, Issue 71
Submitted-by: [e-mail]@pixar.UUCP (Tom Williams)
Archive-name: gnuplot2/part06

This is gnuplot.sh06

--- CUT HERE ---
#! /bin/sh
echo x - help.c
sed 's/^X//' >help.c <<'*-*-END-of-help.c-*-*'
X#include <stdio.h>
X
Xextern int errno;
X
Xextern int strcmp();
Xextern int strlen();
Xextern char *strcpy();
Xextern char *strncpy();
Xextern char *strcat();
Xextern char *strncat();
Xextern char *getenv();
Xextern FILE *fopen();
Xextern char *malloc();
X
Xextern int instring();
X
X#define    SAME    0    /* for strcmp() */
X
X#include "help.h"    /* values passed back */
X
X/* help -- help subsystem that understands defined keywords
X**
X** Looks for the desired keyword in the help file at runtime, so you
X** can give extra help or supply local customizations by merely editing
X** the help file.
X**
X** The original (single-file) idea and algorithm is by John D. Johnson,
X** Hewlett-Packard Company.  Thanx and a tip of the Hatlo hat!
X**
X** Much extension by David Kotz for use in gnutex, and then in gnuplot.
X** Added output paging support, both unix and builtin. Rewrote completely
X** to read helpfile into memory, avoiding reread of help file. 12/89.
X**
X** The help file looks like this (the question marks are really in column 1):
X**
X**     ?topic
X**     This line is printed when the user wants help on "topic".
X**     ?keyword
X**     ?Keyword
X**     ?KEYWORD
X**     These lines will be printed on the screen if the user wanted
X**     help on "keyword", "Keyword", or "KEYWORD".  No casefolding is
X**    done on the keywords.
X**     ?subject
X**     ?alias
X**     This line is printed for help on "subject" and "alias".
X**     ?
X**    ??
X**     Since there is a null keyword for this line, this section
X**     is printed when the user wants general help (when a help
X**     keyword isn't given).  A command summary is usually here.
X**    Notice that the null keyword is equivalent to a "?" keyword
X**    here, because of the '?' and '??' topic lines above.
X**   If multiple keywords are given, the first is considered the
X**   'primary' keyword. This affects a listing of available topics.
X**     ?last-subject
X**     Note that help sections are terminated by the start of the next
X**     '?' entry or by EOF.  So you can't have a leading '?' on a line
X**     of any help section.  You can re-define the magic character to
X**    recognize in column 1, though, if '?' is too useful.  (Try ^A.)
X*/
X
X#define    KEYFLAG    '?'    /* leading char in help file topic lines */
X
X/*
X** Calling sequence:
X**    int result;        # 0 == success
X**    char *keyword;        # topic to give help on
X**    char *pathname;        # path of help file
X**    result = help(keyword, pathname);
X** Sample:
X**    cmd = "search\n";
X**    helpfile = "/usr/local/lib/program/program.help";
X**    if (help(cmd, helpfile) != H_FOUND)
X**        printf("Sorry, no help for %s", cmd);
X**
X**
X** Speed this up by replacing the stdio calls with open/close/read/write.
X*/
X#ifdef    WDLEN
X#  define    PATHSIZE    WDLEN
X#else
X#  define    PATHSIZE    BUFSIZ
X#endif
X
Xtypedef int boolean;
X#ifndef TRUE
X#define TRUE (1)
X#define FALSE (0)
X#endif
X
Xtypedef struct line_s LINEBUF;
Xstruct line_s {
X    char *line;            /* the text of this line */
X    LINEBUF *next;            /* the next line */
X};
X
Xtypedef struct linkey_s LINKEY;
Xstruct linkey_s {
X    char *key;                /* the name of this key */
X    LINEBUF *text;            /* the text for this key */
X    boolean primary;        /* TRUE -> is a primary name for a text block */
X    LINKEY *next;            /* the next key in linked list */
X};
X
Xtypedef struct key_s KEY;
Xstruct key_s {
X    char *key;                /* the name of this key */
X    LINEBUF *text;            /* the text for this key */
X    boolean primary;        /* TRUE -> is a primary name for a text block */
X};
Xstatic LINKEY *keylist;        /* linked list of keys */
Xstatic KEY *keys = NULL;        /* array of keys */
Xstatic int keycount = 0;        /* number of keys */
X
Xstatic int LoadHelp();
Xstatic void sortkeys();
Xstatic int keycomp();
Xstatic LINEBUF *storeline();
Xstatic void storekey();
Xstatic KEY *FindHelp();
Xstatic boolean Ambiguous();
X
X/* Help output */
Xstatic void PrintHelp();
Xstatic void ShowSubtopics();
Xstatic void StartOutput();
Xstatic void OutLine();
Xstatic void EndOutput();
Xstatic FILE *outfile;        /* for unix pager, if any */
Xstatic int pagelines;        /* count for builtin pager */
X#define SCREENSIZE 24        /* lines on screen (most have at least 24) */
X
X/* help:
X * print a help message
X * also print available subtopics, if subtopics is TRUE
X */
Xhelp(keyword, path, subtopics)
X    char *keyword;            /* on this topic */
X    char *path;            /* from this file */
X    boolean *subtopics;        /* (in) - subtopics only? */
X                        /* (out) - are there subtopics? */
X{
X    static char oldpath[PATHSIZE] = "";    /* previous help file */
X    char *oldpathp = oldpath;    /* pointer to same */
X    int status;            /* result of LoadHelp */
X    KEY *key;                /* key that matches keyword */
X
X    /*
X    ** Load the help file if necessary (say, first time we enter this routine,
X    ** or if the help file changes from the last time we were called).
X    ** Also may occur if in-memory copy was freed.
X    ** Calling routine may access errno to determine cause of H_ERROR.
X    */
X    errno = 0;
X    if (strncmp(oldpathp, path, sizeof oldpath) != SAME)
X     FreeHelp();
X    if (keys == NULL) {
X       status = LoadHelp(path);
X       if (status == H_ERROR)
X        return(status);
X
X       /* save the new path in oldpath */
X       if (strlen(path) < sizeof oldpath)
X        (void) strcpy(oldpathp, path);
X       else {                /* not enough room in oldpath, sigh */
X          (void) strncpy(oldpathp, path, sizeof oldpath);
X          oldpath[sizeof oldpath] = NULL;
X       }
X    }
X
X    /* look for the keyword in the help file */
X    key = FindHelp(keyword);
X    if (key != NULL) {
X       /* found the keyword: print help and return */
X       PrintHelp(key, subtopics);
X       status = H_FOUND;
X    } else {
X       status = H_NOTFOUND;
X    }
X
X    return(status);
X}
X
X/* we only read the file once, into memory */
Xstatic int
XLoadHelp(path)
X    char *path;
X{
X    FILE *helpfp = NULL;
X    char buf[BUFSIZ];        /* line from help file */
X    LINEBUF *head;            /* head of text list  */
X    boolean primary;        /* first ? line of a set is primary */
X
X    if ((helpfp = fopen(path, "r")) == NULL) {
X       /* can't open help file, so error exit */
X       return (H_ERROR);
X    }
X
X    /*
X    ** The help file is open.  Look in there for the keyword.
X    */
X    (void) fgets(buf, sizeof buf, helpfp);
X    while (!feof(helpfp)) {
X       /*
X        ** Make an entry for each synonym keyword, pointing
X        ** to same buffer.
X        */
X       head = storeline( (char *)NULL ); /* make a dummy text entry */
X       primary = TRUE;
X       while (buf[0] == KEYFLAG) {
X          storekey(buf+1, head, primary);    /* store this key */
X          primary = FALSE;
X          if (fgets(buf, sizeof buf, helpfp) == (char *)NULL)
X            break;
X       }
X       /*
X        ** Now store the text for this entry.
X        ** buf already contains the first line of text.
X        */
X       while (buf[0] != KEYFLAG) {
X          /* save text line */
X          head->next = storeline(buf);
X          head = head->next;
X          if (fgets(buf, sizeof buf, helpfp) == (char *)NULL)
X            break;
X       }
X    }
X
X    (void) fclose(helpfp);
X
X    /* we sort the keys so we can use binary search later */
X    sortkeys();
X    return(H_FOUND); /* ok */
X}
X
X/* make a new line buffer and save this string there */
Xstatic LINEBUF *
Xstoreline(text)
X    char *text;
X{
X    LINEBUF *new;
X
X    new = (LINEBUF *)malloc(sizeof(LINEBUF));
X    if (new == NULL)
X     int_error("not enough memory to store help file", -1);
X    if (text != NULL) {
X       new->line = (char *) malloc((unsigned int)(strlen(text)+1));
X       if (new->line == NULL)
X        int_error("not enough memory to store help file", -1);
X       (void) strcpy(new->line, text);
X    } else
X     new->line = NULL;
X
X    new->next = NULL;
X
X    return(new);
X}
X
X/* Add this keyword to the keys list, with the given text */
Xstatic void
Xstorekey(key, buffer, primary)
X    char *key;
X    LINEBUF *buffer;
X    boolean primary;
X{
X    LINKEY *new;
X
X    key[strlen(key)-1] = '\0'; /* cut off \n  */
X
X    new = (LINKEY *)malloc(sizeof(LINKEY));
X    if (new == NULL)
X     int_error("not enough memory to store help file", -1);
X    new->key = (char *) malloc((unsigned int)(strlen(key)+1));
X    if (new->key == NULL)
X     int_error("not enough memory to store help file", -1);
X    (void) strcpy(new->key, key);
X    new->text = buffer;
X    new->primary = primary;
X
X    /* add to front of list */
X    new->next = keylist;
X    keylist = new;
X    keycount++;
X}
X
X/* we sort the keys so we can use binary search later */
X/* We have a linked list of keys and the number.
X * to sort them we need an array, so we reform them into an array,
X * and then throw away the list.
X */
Xstatic void
Xsortkeys()
X{
X    LINKEY *p,*n;            /* pointers to linked list */
X    int i;                /* index into key array */
X
X    /* allocate the array */
X    keys = (KEY *)malloc((unsigned int)((keycount+1) * sizeof(KEY)));
X    if (keys == NULL)
X     int_error("not enough memory to store help file", -1);
X
X    /* copy info from list to array, freeing list */
X    for (p = keylist, i = 0; p != NULL; p = n, i++) {
X       keys[i].key = p->key;
X       keys[i].text = p->text;
X       keys[i].primary = p->primary;
X       n = p->next;
X       free( (char *)p );
X    }
X
X    /* a null entry to terminate subtopic searches */
X    keys[keycount].key = NULL;
X    keys[keycount].text = NULL;
X
X    /* sort the array */
X    /* note that it only moves objects of size (two pointers) */
X    /* it moves no data */
X    qsort((char *)keys, keycount, sizeof(KEY), keycomp);
X}
X
Xstatic int
Xkeycomp(a, b)
X    KEY *a,*b;
X{
X    return (strcmp(a->key, b->key));
X}
X
X/* Free the help file from memory. */
X/* May be called externally if space is needed */
Xvoid
XFreeHelp()
X{
X    int i;                /* index into keys[] */
X    LINEBUF *t, *next;
X
X    if (keys == NULL)
X     return;
X
X    for (i = 0; i < keycount; i++) {
X       free( (char *)keys[i].key );
X       for (t = keys[i].text; t != NULL; t = next) {
X          free( (char *)t->line );
X          next = t->next;
X          free( (char *)t );
X       }
X       free( (char *)keys[i].text );
X    }
X    free( (char *)keys );
X    keys = NULL;
X    keycount = 0;
X}
X
X/* FindHelp:
X *  Find the key that matches the keyword.
X *  The keys[] array is sorted by key.
X *  We could use a binary search, but a linear search will aid our
X *  attempt to allow abbreviations. We search for the first thing that
X *  matches all the text we're given. If not an exact match, then
X *  it is an abbreviated match, and there must be no other abbreviated
X *  matches -- for if there are, the abbreviation is ambiguous.
X *  We print the ambiguous matches in that case, and return not found.
X */
Xstatic KEY *                /* NULL if not found */
XFindHelp(keyword)
X    char *keyword;            /* string we look for */
X{
X    KEY *key;
X    int len = strlen(keyword);
X    int compare;
X
X    for (key = keys, compare = 1; key->key != NULL && compare > 0; key++) {
X       compare = strncmp(keyword, key->key, len);
X       if (compare == 0)    /* we have a match! */
X        if (!Ambiguous(key, len)) {
X            /* non-ambiguous abbreviation */
X            (void) strcpy(keyword, key->key); /* give back the full spelling */
X            return(key);        /* found!! */
X        }
X    }
X
X    /* not found, or ambiguous */
X    return(NULL);
X}
X
X/* Ambiguous:
X * Check the key for ambiguity up to the given length.
X * It is ambiguous if it is not a complete string and there are other
X * keys following it with the same leading substring.
X */
Xstatic boolean
XAmbiguous(key, len)
X    KEY *key;
X    int len;
X{
X    char *first;
X    char *prev;
X    boolean status = FALSE;    /* assume not ambiguous */
X    int compare;
X    int sublen;
X
X    if (key->key[len] == '\0')
X     return(FALSE);
X
X    for (prev = first = key->key, compare = 0, key++;
X        key->key != NULL && compare == 0; key++) {
X       compare = strncmp(first, key->key, len);
X       if (compare == 0) {
X          /* So this key matches the first one, up to len.
X           * But is it different enough from the previous one
X           * to bother printing it as a separate choice?
X           */
X          sublen = instring(prev+len, ' ');
X          if (strncmp(key->key, prev, len+sublen) != 0) {
X             /* yup, this is different up to the next space */
X             if (!status) {
X                /* first one we have printed is special */
X                fprintf(stderr,
X                       "Ambiguous request '%.*s'; possible matches:\n",
X                       len, first);
X                fprintf(stderr, "\t%s\n", prev);
X                status = TRUE;
X             }
X             fprintf(stderr, "\t%s\n", key->key);
X             prev = key->key;
X          }
X       }
X    }
X
X    return(status);
X}
X
X/* PrintHelp:
X * print the text for key
X */
Xstatic void
XPrintHelp(key, subtopics)
X    KEY *key;
X    boolean *subtopics;        /* (in) - subtopics only? */
X                        /* (out) - are there subtopics? */
X{
X    LINEBUF *t;
X
X    StartOutput();
X
X    if (subtopics == NULL || !*subtopics) {
X       /* the first linebuf is a dummy, so we skip it */
X       for (t = key->text->next; t != NULL; t = t->next)
X        OutLine(t->line);        /* print text line */
X    }
X
X    ShowSubtopics(key, subtopics);
X    OutLine("\n");
X
X    EndOutput();
X}
X
X/* ShowSubtopics:
X *  Print a list of subtopic names
X */
X#define PER_LINE 4
X
Xstatic void
XShowSubtopics(key, subtopics)
X    KEY *key;                /* the topic */
X    boolean *subtopics;        /* (out) are there any subtopics */
X{
X    int subt = 0;            /* printed any subtopics yet? */
X    KEY *subkey;            /* subtopic key */
X    int len;                /* length of key name */
X    char line[BUFSIZ];        /* subtopic output line */
X    char *start;            /* position of subname in key name */
X    int sublen;            /* length of subname */
X    int pos;
X    char *prev = NULL;        /* the last thing we put on the list */
X
X    *line = '\0';
X    len = strlen(key->key);
X
X    for (subkey = key+1; subkey->key != NULL; subkey++) {
X       if (strncmp(subkey->key, key->key, len) == 0) {
X          /* find this subtopic name */
X          start = subkey->key + len;
X          if (len > 0)
X            if (*start == ' ')
X             start++;        /* skip space */
X            else
X             break;        /* not the same topic after all  */
X          else            /* here we are looking for main topics */
X            if (!subkey->primary)
X             continue;    /* not a main topic */
X          sublen = instring(start, ' ');
X          if (prev == NULL || strncmp(start, prev, sublen) != 0) {
X             if (subt == 0) {
X                subt++;
X                if (len)
X                  (void) sprintf(line, "\nSubtopics available for %s:\n",
X                        key->key);
X                else
X                  (void) sprintf(line, "\nHelp topics available:\n");
X                OutLine(line);
X                *line = '\0';
X                pos = 0;
X             }
X             if (pos == PER_LINE) {
X                (void) strcat(line, "\n");
X                OutLine(line);
X                *line = '\0';
X                pos = 0;
X             }
X             (void) strcat(line, "\t");
X             (void) strncat(line, start, sublen);
X             pos++;
X             prev = start;
X          }
X       } else {
X          /* new topic */
X          break;
X       }
X    }
X
X    /* put out the last line */
X    if (subt > 0 && pos > 0) {
X       (void) strcat(line, "\n");
X       OutLine(line);
X    }
X
X/*
X    if (subt == 0) {
X       OutLine("\n");
X       OutLine("No subtopics available\n");
X    }
X*/
X
X    if (subtopics)
X     *subtopics = (subt != 0);
X}
X
X
X/* StartOutput:
X * Open a file pointer to a pipe to user's $PAGER, if there is one,
X * otherwise use our own pager.
X */
Xstatic void
XStartOutput()
X{
X#ifdef unix
X    char *pager_name = getenv("PAGER");
X    extern FILE *popen();
X
X    if (pager_name != NULL && *pager_name != '\0')
X     if ((outfile = popen(pager_name, "w")) != (FILE *)NULL)
X       return;            /* success */
X    outfile = stderr;
X    /* fall through to built-in pager */
X#endif
X
X    /* built-in pager */
X    pagelines = 0;
X}
X
X/* write a line of help output  */
X/* line should contain only one \n, at the end */
Xstatic void
XOutLine(line)
X    char *line;
X{
X    int c;                /* dummy input char */
X#ifdef unix
X    if (outfile != stderr) {
X       fputs(line, outfile);
X       return;
X    }
X#endif
X
X    /* built-in dumb pager */
X    /* leave room for prompt line */
X    if (pagelines >= SCREENSIZE - 2) {
X       printf("Press return for more: ");
X       do
X        c = getchar();
X       while (c != EOF && c != '\n');
X       pagelines = 0;
X    }
X    fputs(line, stderr);
X    pagelines++;
X}
X
Xstatic void
XEndOutput()
X{
X#ifdef unix
X    extern int pclose();
X
X    if (outfile != stderr)
X     (void) pclose(outfile);
X#endif
X}
*-*-END-of-help.c-*-*
echo x - graphics.c
sed 's/^X//' >graphics.c <<'*-*-END-of-graphics.c-*-*'
X/* GNUPLOT - graphics.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <stdio.h>
X#include <math.h>
X#include <assert.h>
X#include "plot.h"
X#include "setshow.h"
X
Xextern char *strcpy(),*strncpy(),*strcat();
X
Xvoid plot_impulses();
Xvoid plot_lines();
Xvoid plot_points();
Xvoid plot_dots();
Xvoid edge_intersect();
XBOOLEAN two_edge_intersect();
X
X#ifndef max        /* Lattice C has max() in math.h, but shouldn't! */
X#define max(a,b) ((a > b) ? a : b)
X#endif
X
X#ifndef min
X#define min(a,b) ((a < b) ? a : b)
X#endif
X
X#define inrange(z,min,max) ((min<max) ? ((z>=min)&&(z<=max)) : ((z>=max)&&(z<=min)) )
X
X/* Define the boundary of the plot
X * These are computed at each call to do_plot, and are constant over
X * the period of one do_plot. They actually only change when the term
X * type changes and when the 'set size' factors change.
X */
Xstatic int xleft, xright, ybot, ytop;
X
X/* Boundary and scale factors, in user coordinates */
Xstatic double xmin, xmax, ymin, ymax;
Xstatic double xscale, yscale;
X
X/* And the functions to map from user to terminal coordinates */
X#define map_x(x) (int)(xleft+(x-xmin)*xscale+0.5) /* maps floating point x to screen */
X#define map_y(y) (int)(ybot+(y-ymin)*yscale+0.5)    /* same for y */
X
X/* (DFK) Watch for cancellation error near zero on axes labels */
X#define SIGNIF (0.01)        /* less than one hundredth of a tic mark */
X#define CheckZero(x,tic) (fabs(x) < ((tic) * SIGNIF) ? 0.0 : (x))
X#define NearlyEqual(x,y,tic) (fabs((x)-(y)) < ((tic) * SIGNIF))
X
X/* (DFK) For some reason, the Sun386i compiler screws up with the CheckLog
X * macro, so I write it as a function on that machine.
X */
X#ifndef sun386
X/* (DFK) Use 10^x if logscale is in effect, else x */
X#define CheckLog(log, x) ((log) ? pow(10., (x)) : (x))
X#else
Xstatic double
XCheckLog(log, x)
X     BOOLEAN log;
X     double x;
X{
X  if (log)
X    return(pow(10., x));
X  else
X    return(x);
X}
X#endif /* sun386 */
X
Xdouble
XLogScale(coord, islog, what, axis)
X    double coord;            /* the value */
X    BOOLEAN islog;            /* is this axis in logscale? */
X    char *what;            /* what is the coord for? */
X    char *axis;            /* which axis is this for ("x" or "y")? */
X{
X    if (islog) {
X       if (coord <= 0.0) {
X          char errbuf[100];        /* place to write error message */
X        (void) sprintf(errbuf,"%s has %s coord of %g; must be above 0 for log scale!",
X                what, axis, coord);
X          (*term_tbl[term].text)();
X          (void) fflush(outfile);
X          int_error(errbuf, NO_CARET);
X       } else
X        return(log10(coord));
X    } else {
X       return(coord);
X    }
X    return((double)NULL); /* shut lint up */
X}
X
X/* borders of plotting area */
X/* computed once on every call to do_plot */
Xboundary(scaling)
X    BOOLEAN scaling;        /* TRUE if terminal is doing the scaling */
X{
X    register struct termentry *t = &term_tbl[term];
X    xleft = (t->h_char)*12;
X    xright = (scaling ? 1 : xsize) * (t->xmax) - (t->h_char)*2 - (t->h_tic);
X    ybot = (t->v_char)*5/2 + 1;
X    ytop = (scaling ? 1 : ysize) * (t->ymax) - (t->v_char)*3/2 - 1;
X}
X
X
Xdouble dbl_raise(x,y)
Xdouble x;
Xint y;
X{
Xregister int i;
Xdouble val;
X
X    val = 1.0;
X    for (i=0; i < abs(y); i++)
X        val *= x;
X    if (y < 0 ) return (1.0/val);
X    return(val);
X}
X
X
Xdouble make_tics(tmin,tmax,logscale)
Xdouble tmin,tmax;
XBOOLEAN logscale;
X{
Xregister double xr,xnorm,tics,tic,l10;
X
X    xr = fabs(tmin-tmax);
X
X    l10 = log10(xr);
X    if (logscale) {
X        tic = dbl_raise(10.0,(l10 >= 0.0 ) ? (int)l10 : ((int)l10-1));
X        if (tic < 1.0)
X            tic = 1.0;
X    } else {
X        xnorm = pow(10.0,l10-(double)((l10 >= 0.0 ) ? (int)l10 : ((int)l10-1)));
X        if (xnorm <= 2)
X            tics = 0.2;
X        else if (xnorm <= 5)
X            tics = 0.5;
X        else tics = 1.0;
X        tic = tics * dbl_raise(10.0,(l10 >= 0.0 ) ? (int)l10 : ((int)l10-1));
X    }
X    return(tic);
X}
X
X
Xdo_plot(plots, pcount, min_x, max_x, min_y, max_y)
Xstruct curve_points *plots;
Xint pcount;            /* count of plots in linked list */
Xdouble min_x, max_x;
Xdouble min_y, max_y;
X{
Xregister struct termentry *t = &term_tbl[term];
Xregister int curve, xaxis_y, yaxis_x;
Xregister struct curve_points *this_plot;
Xregister double ytic, xtic;
Xregister int xl, yl;
X            /* only a Pyramid would have this many registers! */
Xdouble xtemp, ytemp;
Xstruct text_label *this_label;
Xstruct arrow_def *this_arrow;
XBOOLEAN scaling;
X
X/* store these in variables global to this file */
X/* otherwise, we have to pass them around a lot */
X     xmin = min_x;
X     xmax = max_x;
X     ymin = min_y;
X     ymax = max_y;
X
X    if (polar) {
X        /* will possibly change xmin, xmax, ymin, ymax */
X        polar_xform(plots,pcount);
X    }
X
X    if (ymin == VERYLARGE || ymax == -VERYLARGE)
X        int_error("all points undefined!", NO_CARET);
X
X    if (xmin == VERYLARGE || xmax == -VERYLARGE)
X        int_error("all points undefined!", NO_CARET);
X
X/*    Apply the desired viewport offsets. */
X     if (ymin < ymax) {
X        ymin -= boff;
X        ymax += toff;
X    } else {
X        ymax -= boff;
X        ymin += toff;
X    }
X     if (xmin < xmax) {
X        xmin -= loff;
X        xmax += roff;
X    } else {
X        xmax -= loff;
X        xmin += roff;
X    }
X
X/* SETUP RANGES, SCALES AND TIC PLACES */
X    if (ytics && yticdef.type == TIC_COMPUTED) {
X       ytic = make_tics(ymin,ymax,log_y);
X
X       if (autoscale_ly) {
X          if (ymin < ymax) {
X             ymin = ytic * floor(ymin/ytic);
X             ymax = ytic * ceil(ymax/ytic);
X          }
X          else {            /* reverse axis */
X             ymin = ytic * ceil(ymin/ytic);
X             ymax = ytic * floor(ymax/ytic);
X          }
X       }
X    }
X
X    if (xtics && xticdef.type == TIC_COMPUTED) {
X       xtic = make_tics(xmin,xmax,log_x);
X
X       if (autoscale_lx) {
X          if (xmin < xmax) {
X             xmin = xtic * floor(xmin/xtic);
X             xmax = xtic * ceil(xmax/xtic);
X          } else {
X             xmin = xtic * ceil(xmin/xtic);
X             xmax = xtic * floor(xmax/xtic);
X          }
X       }
X    }
X
X/*    This used be xmax == xmin, but that caused an infinite loop once. */
X    if (fabs(xmax - xmin) < zero)
X        int_error("xmin should not equal xmax!",NO_CARET);
X    if (fabs(ymax - ymin) < zero)
X        int_error("ymin should not equal ymax!",NO_CARET);
X
X/* INITIALIZE TERMINAL */
X    if (!term_init) {
X        (*t->init)();
X        term_init = TRUE;
X    }
X    screen_ok = FALSE;
X     scaling = (*t->scale)(xsize, ysize);
X    (*t->graphics)();
X
X     /* now compute boundary for plot (xleft, xright, ytop, ybot) */
X     boundary(scaling);
X
X/* SCALE FACTORS */
X    yscale = (ytop - ybot)/(ymax - ymin);
X    xscale = (xright - xleft)/(xmax - xmin);
X
X/* DRAW AXES */
X    (*t->linetype)(-1);    /* axis line type */
X    xaxis_y = map_y(0.0);
X    yaxis_x = map_x(0.0);
X
X    if (xaxis_y < ybot)
X        xaxis_y = ybot;                /* save for impulse plotting */
X    else if (xaxis_y >= ytop)
X        xaxis_y = ytop ;
X    else if (!log_y) {
X        (*t->move)(xleft,xaxis_y);
X        (*t->vector)(xright,xaxis_y);
X    }
X
X    if (!log_x && yaxis_x >= xleft && yaxis_x < xright ) {
X        (*t->move)(yaxis_x,ybot);
X        (*t->vector)(yaxis_x,ytop);
X    }
X
X/* DRAW TICS */
X    (*t->linetype)(-2); /* border linetype */
X
X    /* label y axis tics */
X     if (ytics) {
X        switch (yticdef.type) {
X           case TIC_COMPUTED: {
X               if (ymin < ymax)
X                draw_ytics(ytic * floor(ymin/ytic),
X                        ytic,
X                        ytic * ceil(ymax/ytic));
X              else
X                draw_ytics(ytic * floor(ymax/ytic),
X                        ytic,
X                        ytic * ceil(ymin/ytic));
X
X              break;
X           }
X           case TIC_SERIES: {
X              draw_ytics(yticdef.def.series.start,
X                      yticdef.def.series.incr,
X                      yticdef.def.series.end);
X              break;
X           }
X           case TIC_USER: {
X              draw_user_ytics(yticdef.def.user);
X              break;
X           }
X           default: {
X              (*t->text)();
X                (void) fflush(outfile);
X              int_error("unknown tic type in yticdef in do_plot", NO_CARET);
X              break;        /* NOTREACHED */
X           }
X        }
X    }
X
X    /* label x axis tics */
X     if (xtics) {
X        switch (xticdef.type) {
X           case TIC_COMPUTED: {
X               if (xmin < xmax)
X                draw_xtics(xtic * floor(xmin/xtic),
X                        xtic,
X                        xtic * ceil(xmax/xtic));
X              else
X                draw_xtics(xtic * floor(xmax/xtic),
X                        xtic,
X                        xtic * ceil(xmin/xtic));
X
X              break;
X           }
X           case TIC_SERIES: {
X              draw_xtics(xticdef.def.series.start,
X                      xticdef.def.series.incr,
X                      xticdef.def.series.end);
X              break;
X           }
X           case TIC_USER: {
X              draw_user_xtics(xticdef.def.user);
X              break;
X           }
X           default: {
X              (*t->text)();
X              (void) fflush(outfile);
X              int_error("unknown tic type in xticdef in do_plot", NO_CARET);
X              break;        /* NOTREACHED */
X           }
X        }
X    }
X
X/* DRAW PLOT BORDER */
X    (*t->linetype)(-2); /* border linetype */
X    (*t->move)(xleft,ybot);
X    (*t->vector)(xright,ybot);
X    (*t->vector)(xright,ytop);
X    (*t->vector)(xleft,ytop);
X    (*t->vector)(xleft,ybot);
X
X/* PLACE YLABEL */
X    if (*ylabel != NULL) {
X       if ((*t->text_angle)(1)) {
X          if ((*t->justify_text)(CENTRE)) {
X             (*t->put_text)((t->v_char),
X                         (ytop+ybot)/2, ylabel);
X          }
X          else {
X             (*t->put_text)((t->v_char),
X                         (ytop+ybot)/2-(t->h_char)*strlen(ylabel)/2,
X                         ylabel);
X          }
X       }
X       else {
X          (void)(*t->justify_text)(LEFT);
X          (*t->put_text)(0,ytop+(t->v_char), ylabel);
X       }
X       (void)(*t->text_angle)(0);
X    }
X
X/* PLACE XLABEL */
X    if (*xlabel != NULL) {
X       if ((*t->justify_text)(CENTRE))
X        (*t->put_text)( (xleft+xright)/2,
X                    ybot-2*(t->v_char), xlabel);
X       else
X        (*t->put_text)( (xleft+xright)/2 - strlen(xlabel)*(t->h_char)/2,
X                    ybot-2*(t->v_char), xlabel);
X    }
X
X/* PLACE TITLE */
X    if (*title != NULL) {
X       if ((*t->justify_text)(CENTRE))
X        (*t->put_text)( (xleft+xright)/2,
X                    ytop+(t->v_char), title);
X       else
X        (*t->put_text)( (xleft+xright)/2 - strlen(title)*(t->h_char)/2,
X                    ytop+(t->v_char), title);
X    }
X
X/* PLACE LABELS */
X    for (this_label = first_label; this_label!=NULL;
X            this_label=this_label->next ) {
X         xtemp = LogScale(this_label->x, log_x, "label", "x");
X         ytemp = LogScale(this_label->y, log_y, "label", "y");
X        if ((*t->justify_text)(this_label->pos)) {
X            (*t->put_text)(map_x(xtemp),map_y(ytemp),this_label->text);
X        }
X        else {
X            switch(this_label->pos) {
X                case  LEFT:
X                    (*t->put_text)(map_x(xtemp),map_y(ytemp),
X                        this_label->text);
X                    break;
X                case CENTRE:
X                    (*t->put_text)(map_x(xtemp)-
X                        (t->h_char)*strlen(this_label->text)/2,
X                        map_y(ytemp), this_label->text);
X                    break;
X                case RIGHT:
X                    (*t->put_text)(map_x(xtemp)-
X                        (t->h_char)*strlen(this_label->text),
X                        map_y(ytemp), this_label->text);
X                    break;
X            }
X         }
X     }
X
X/* PLACE ARROWS */
X    (*t->linetype)(0);    /* arrow line type */
X    for (this_arrow = first_arrow; this_arrow!=NULL;
X        this_arrow = this_arrow->next ) {
X       int sx = map_x(LogScale(this_arrow->sx, log_x, "arrow", "x"));
X       int sy = map_y(LogScale(this_arrow->sy, log_y, "arrow", "y"));
X       int ex = map_x(LogScale(this_arrow->ex, log_x, "arrow", "x"));
X       int ey = map_y(LogScale(this_arrow->ey, log_y, "arrow", "y"));
X
X       (*t->arrow)(sx, sy, ex, ey);
X    }
X
X
X/* DRAW CURVES */
X    if (key == -1) {
X        xl = xright  - (t->h_tic) - (t->h_char)*5;
X        yl = ytop - (t->v_tic) - (t->v_char);
X    }
X    if (key == 1) {
X        xl = map_x( LogScale(key_x, log_x, "key", "x") );
X        yl = map_y( LogScale(key_y, log_y, "key", "y") );
X    }
X
X    this_plot = plots;
X    for (curve = 0; curve < pcount; this_plot = this_plot->next_cp, curve++) {
X        (*t->linetype)(this_plot->line_type);
X        if (key != 0) {
X            if ((*t->justify_text)(RIGHT)) {
X                (*t->put_text)(xl,
X                    yl,this_plot->title);
X            }
X            else {
X                if (inrange(xl-(t->h_char)*strlen(this_plot->title),
X                         xleft, xright))
X                 (*t->put_text)(xl-(t->h_char)*strlen(this_plot->title),
X                             yl,this_plot->title);
X            }
X        }
X
X        switch(this_plot->plot_style) {
X            case IMPULSES: {
X               if (key != 0) {
X                  (*t->move)(xl+(t->h_char),yl);
X                  (*t->vector)(xl+4*(t->h_char),yl);
X               }
X               plot_impulses(this_plot, xaxis_y);
X               break;
X            }
X            case LINES: {
X               if (key != 0) {
X                  (*t->move)(xl+(int)(t->h_char),yl);
X                  (*t->vector)(xl+(int)(4*(t->h_char)),yl);
X               }
X               plot_lines(this_plot);
X               break;
X            }
X            case POINTS: {
X               if (key != 0) {
X                  (*t->point)(xl+2*(t->h_char),yl,
X                            this_plot->point_type);
X               }
X               plot_points(this_plot);
X               break;
X            }
X            case LINESPOINTS: {
X               /* put lines */
X               if (key != 0) {
X                  (*t->move)(xl+(t->h_char),yl);
X                  (*t->vector)(xl+4*(t->h_char),yl);
X               }
X               plot_lines(this_plot);
X
X               /* put points */
X               if (key != 0) {
X                  (*t->point)(xl+2*(t->h_char),yl,
X                            this_plot->point_type);
X               }
X               plot_points(this_plot);
X               break;
X            }
X            case DOTS: {
X               if (key != 0) {
X                  (*t->point)(xl+2*(t->h_char),yl, -1);
X               }
X               plot_dots(this_plot);
X               break;
X            }
X        }
X        yl = yl - (t->v_char);
X    }
X    (*t->text)();
X    (void) fflush(outfile);
X}
X
X/* plot_impulses:
X * Plot the curves in IMPULSES style
X */
Xvoid
Xplot_impulses(plot, xaxis_y)
X    struct curve_points *plot;
X    int xaxis_y;
X{
X    int i;
X    int x,y;
X    struct termentry *t = &term_tbl[term];
X
X    for (i = 0; i < plot->p_count; i++) {
X       switch (plot->points[i].type) {
X          case INRANGE: {
X             x = map_x(plot->points[i].x);
X             y = map_y(plot->points[i].y);
X             break;
X          }
X          case OUTRANGE: {
X             if (!inrange(plot->points[i].x, xmin,xmax))
X               continue;
X             x = map_x(plot->points[i].x);
X             if ((ymin < ymax
X                 && plot->points[i].y < ymin)
X                || (ymax < ymin
X                    && plot->points[i].y > ymin))
X               y = map_y(ymin);
X             if ((ymin < ymax
X                 && plot->points[i].y > ymax)
X                || (ymax<ymin
X                    && plot->points[i].y < ymax))
X               y = map_y(ymax);
X             break;
X          }
X          default:        /* just a safety */
X          case UNDEFINED: {
X             continue;
X          }
X       }
X
X       (*t->move)(x,xaxis_y);
X       (*t->vector)(x,y);
X    }
X
X}
X
X/* plot_lines:
X * Plot the curves in LINES style
X */
Xvoid
Xplot_lines(plot)
X    struct curve_points *plot;
X{
X    int i;                /* point index */
X    int x,y;                /* point in terminal coordinates */
X    struct termentry *t = &term_tbl[term];
X    enum coord_type prev = UNDEFINED; /* type of previous point */
X    double ex, ey;            /* an edge point */
X    double lx[2], ly[2];        /* two edge points */
X
X    for (i = 0; i < plot->p_count; i++) {
X       switch (plot->points[i].type) {
X          case INRANGE: {
X             x = map_x(plot->points[i].x);
X             y = map_y(plot->points[i].y);
X
X             if (prev == INRANGE) {
X                (*t->vector)(x,y);
X             } else if (prev == OUTRANGE) {
X                /* from outrange to inrange */
X                if (!clip_lines1) {
X                    (*t->move)(x,y);
X                } else {
X                    edge_intersect(plot->points, i, &ex, &ey);
X                    (*t->move)(map_x(ex), map_y(ey));
X                    (*t->vector)(x,y);
X                }
X             } else {        /* prev == UNDEFINED */
X                (*t->move)(x,y);
X                (*t->vector)(x,y);
X             }
X
X             break;
X          }
X          case OUTRANGE: {
X             if (prev == INRANGE) {
X                /* from inrange to outrange */
X                if (clip_lines1) {
X                    edge_intersect(plot->points, i, &ex, &ey);
X                    (*t->vector)(map_x(ex), map_y(ey));
X                }
X             } else if (prev == OUTRANGE) {
X                /* from outrange to outrange */
X                if (clip_lines2) {
X                    if (two_edge_intersect(plot->points, i, lx, ly)) {
X                       (*t->move)(map_x(lx[0]), map_y(ly[0]));
X                       (*t->vector)(map_x(lx[1]), map_y(ly[1]));
X                    }
X                }
X             }
X             break;
X          }
X          default:        /* just a safety */
X          case UNDEFINED: {
X             break;
X          }
X       }
X       prev = plot->points[i].type;
X    }
X}
X
X/* plot_points:
X * Plot the curves in POINTS style
X */
Xvoid
Xplot_points(plot)
X    struct curve_points *plot;
X{
X    int i;
X    int x,y;
X    struct termentry *t = &term_tbl[term];
X
X    for (i = 0; i < plot->p_count; i++) {
X       if (plot->points[i].type == INRANGE) {
X          x = map_x(plot->points[i].x);
X          y = map_y(plot->points[i].y);
X          /* do clipping if necessary */
X          if (!clip_points ||
X             (   x >= xleft + t->h_tic  && y >= ybot + t->v_tic
X              && x <= xright - t->h_tic && y <= ytop - t->v_tic))
X            (*t->point)(x,y, plot->point_type);
X       }
X    }
X}
X
X/* plot_dots:
X * Plot the curves in DOTS style
X */
Xvoid
Xplot_dots(plot)
X    struct curve_points *plot;
X{
X    int i;
X    int x,y;
X    struct termentry *t = &term_tbl[term];
X
X    for (i = 0; i < plot->p_count; i++) {
X       if (plot->points[i].type == INRANGE) {
X          x = map_x(plot->points[i].x);
X          y = map_y(plot->points[i].y);
X          /* point type -1 is a dot */
X          (*t->point)(x,y, -1);
X       }
X    }
X}
X
X/* single edge intersection algorithm */
X/* Given two points, one inside and one outside the plot, return
X * the point where an edge of the plot intersects the line segment defined
X * by the two points.
X */
Xvoid
Xedge_intersect(points, i, ex, ey)
X    struct coordinate *points; /* the points array */
X    int i;                /* line segment from point i-1 to point i */
X    double *ex, *ey;        /* the point where it crosses an edge */
X{
X    /* global xmin, xmax, ymin, xmax */
X    double ax = points[i-1].x;
X    double ay = points[i-1].y;
X    double bx = points[i].x;
X    double by = points[i].y;
X    double x, y;            /* possible intersection point */
X
X    if (by == ay) {
X       /* horizontal line */
X       /* assume inrange(by, ymin, ymax) */
X       *ey = by;        /* == ay */
X
X       if (inrange(xmax, ax, bx))
X        *ex = xmax;
X       else if (inrange(xmin, ax, bx))
X        *ex = xmin;
X       else {
X        (*term_tbl[term].text)();
X        (void) fflush(outfile);
X        int_error("error in edge_intersect", NO_CARET);
X       }
X       return;
X    } else if (bx == ax) {
X       /* vertical line */
X       /* assume inrange(bx, xmin, xmax) */
X       *ex = bx;        /* == ax */
X
X       if (inrange(ymax, ay, by))
X        *ey = ymax;
X       else if (inrange(ymin, ay, by))
X        *ey = ymin;
X       else {
X        (*term_tbl[term].text)();
X        (void) fflush(outfile);
X        int_error("error in edge_intersect", NO_CARET);
X       }
X       return;
X    }
X
X    /* slanted line of some kind */
X
X    /* does it intersect ymin edge */
X    if (inrange(ymin, ay, by) && ymin != ay && ymin != by) {
X       x = ax + (ymin-ay) * ((bx-ax) / (by-ay));
X       if (inrange(x, xmin, xmax)) {
X          *ex = x;
X          *ey = ymin;
X          return;            /* yes */
X       }
X    }
X
X    /* does it intersect ymax edge */
X    if (inrange(ymax, ay, by) && ymax != ay && ymax != by) {
X       x = ax + (ymax-ay) * ((bx-ax) / (by-ay));
X       if (inrange(x, xmin, xmax)) {
X          *ex = x;
X          *ey = ymax;
X          return;            /* yes */
X       }
X    }
X
X    /* does it intersect xmin edge */
X    if (inrange(xmin, ax, bx) && xmin != ax && xmin != bx) {
X       y = ay + (xmin-ax) * ((by-ay) / (bx-ax));
X       if (inrange(y, ymin, ymax)) {
X          *ex = xmin;
X          *ey = y;
X          return;
X       }
X    }
X
X    /* does it intersect xmax edge */
X    if (inrange(xmax, ax, bx) && xmax != ax && xmax != bx) {
X       y = ay + (xmax-ax) * ((by-ay) / (bx-ax));
X       if (inrange(y, ymin, ymax)) {
X          *ex = xmax;
X          *ey = y;
X          return;
X       }
X    }
X
X    /* It is possible for one or two of the [ab][xy] values to be -VERYLARGE.
X    * If ax=bx=-VERYLARGE or ay=by=-VERYLARGE we have already returned
X    * FALSE above. Otherwise we fall through all the tests above.
X    * If two are -VERYLARGE, it is ax=ay=-VERYLARGE or bx=by=-VERYLARGE
X    * since either a or b must be INRANGE.
X    * Note that for ax=ay=-VERYLARGE or bx=by=-VERYLARGE we can do nothing.
X    * Handle them carefully here. As yet we have no way for them to be
X    * +VERYLARGE.
X    */
X    if (ax == -VERYLARGE) {
X       if (ay != -VERYLARGE) {
X          *ex = min(xmin, xmax);
X          *ey = by;
X          return;
X       }
X    } else if (bx == -VERYLARGE) {
X       if (by != -VERYLARGE) {
X          *ex = min(xmin, xmax);
X          *ey = ay;
X          return;
X       }
X    } else if (ay == -VERYLARGE) {
X       /* note we know ax != -VERYLARGE */
X       *ex = bx;
X       *ey = min(ymin, ymax);
X       return;
X    } else if (by == -VERYLARGE) {
X       /* note we know bx != -VERYLARGE */
X       *ex = ax;
X       *ey = min(ymin, ymax);
X       return;
X    }
X
X    /* If we reach here, then either one point is (-VERYLARGE,-VERYLARGE),
X    * or the inrange point is on the edge, and
X     * the line segment from the outrange point does not cross any
X    * other edges to get there. In either case, we return the inrange
X    * point as the 'edge' intersection point. This will basically draw
X    * line.
X    */
X    if (points[i].type == INRANGE) {
X       *ex = bx;
X       *ey = by;
X    } else {
X       *ex = ax;
X       *ey = ay;
X    }
X    return;
X}
X
X/* double edge intersection algorithm */
X/* Given two points, both outside the plot, return
X * the points where an edge of the plot intersects the line segment defined
X * by the two points. There may be zero, one, two, or an infinite number
X * of intersection points. (One means an intersection at a corner, infinite
X * means overlaying the edge itself). We return FALSE when there is nothing
X * to draw (zero intersections), and TRUE when there is something to
X * draw (the one-point case is a degenerate of the two-point case and we do
X * not distinguish it - we draw it anyway).
X */
XBOOLEAN                /* any intersection? */
Xtwo_edge_intersect(points, i, lx, ly)
X    struct coordinate *points; /* the points array */
X    int i;                /* line segment from point i-1 to point i */
X    double *lx, *ly;        /* lx[2], ly[2]: points where it crosses edges */
X{
X    /* global xmin, xmax, ymin, xmax */
X    double ax = points[i-1].x;
X    double ay = points[i-1].y;
X    double bx = points[i].x;
X    double by = points[i].y;
X    double x, y;            /* possible intersection point */
X    BOOLEAN intersect = FALSE;
X
X    if (by == ay) {
X       /* horizontal line */
X       /* y coord must be in range, and line must span both xmin and xmax */
X       /* note that spanning xmin implies spanning xmax */
X       if (inrange(by, ymin, ymax) && inrange(xmin, ax, bx)) {
X          *lx++ = xmin;
X          *ly++ = by;
X          *lx++ = xmax;
X          *ly++ = by;
X          return(TRUE);
X       } else
X        return(FALSE);
X    } else if (bx == ax) {
X       /* vertical line */
X       /* x coord must be in range, and line must span both ymin and ymax */
X       /* note that spanning ymin implies spanning ymax */
X       if (inrange(bx, xmin, xmax) && inrange(ymin, ay, by)) {
X          *lx++ = bx;
X          *ly++ = ymin;
X          *lx++ = bx;
X          *ly++ = ymax;
X          return(TRUE);
X       } else
X        return(FALSE);
X    }
X
X    /* slanted line of some kind */
X    /* there can be only zero or two intersections below */
X
X    /* does it intersect ymin edge */
X    if (inrange(ymin, ay, by)) {
X       x = ax + (ymin-ay) * ((bx-ax) / (by-ay));
X       if (inrange(x, xmin, xmax)) {
X          *lx++ = x;
X          *ly++ = ymin;
X          intersect = TRUE;
X       }
X    }
X
X    /* does it intersect ymax edge */
X    if (inrange(ymax, ay, by)) {
X       x = ax + (ymax-ay) * ((bx-ax) / (by-ay));
X       if (inrange(x, xmin, xmax)) {
X          *lx++ = x;
X          *ly++ = ymax;
X          intersect = TRUE;
X       }
X    }
X
X    /* does it intersect xmin edge */
X    if (inrange(xmin, ax, bx)) {
X       y = ay + (xmin-ax) * ((by-ay) / (bx-ax));
X       if (inrange(y, ymin, ymax)) {
X          *lx++ = xmin;
X          *ly++ = y;
X          intersect = TRUE;
X       }
X    }
X
X    /* does it intersect xmax edge */
X    if (inrange(xmax, ax, bx)) {
X       y = ay + (xmax-ax) * ((by-ay) / (bx-ax));
X       if (inrange(y, ymin, ymax)) {
X          *lx++ = xmax;
X          *ly++ = y;
X          intersect = TRUE;
X       }
X    }
X
X    if (intersect)
X     return(TRUE);
X
X    /* It is possible for one or more of the [ab][xy] values to be -VERYLARGE.
X    * If ax=bx=-VERYLARGE or ay=by=-VERYLARGE we have already returned
X    * FALSE above.
X    * Note that for ax=ay=-VERYLARGE or bx=by=-VERYLARGE we can do nothing.
X    * Otherwise we fall through all the tests above.
X    * Handle them carefully here. As yet we have no way for them to be +VERYLARGE.
X    */
X    if (ax == -VERYLARGE) {
X       if (ay != -VERYLARGE
X          && inrange(by, ymin, ymax) && inrange(xmax, ax, bx)) {
X          *lx++ = xmin;
X          *ly = by;
X          *lx++ = xmax;
X          *ly = by;
X          intersect = TRUE;
X       }
X    } else if (bx == -VERYLARGE) {
X       if (by != -VERYLARGE
X          && inrange(ay, ymin, ymax) && inrange(xmax, ax, bx)) {
X          *lx++ = xmin;
X          *ly = ay;
X          *lx++ = xmax;
X          *ly = ay;
X          intersect = TRUE;
X       }
X    } else if (ay == -VERYLARGE) {
X       /* note we know ax != -VERYLARGE */
X       if (inrange(bx, xmin, xmax) && inrange(ymax, ay, by)) {
X          *lx++ = bx;
X          *ly = ymin;
X          *lx++ = bx;
X          *ly = ymax;
X          intersect = TRUE;
X       }
X    } else if (by == -VERYLARGE) {
X       /* note we know bx != -VERYLARGE */
X       if (inrange(ax, xmin, xmax) && inrange(ymax, ay, by)) {
X          *lx++ = ax;
X          *ly = ymin;
X          *lx++ = ax;
X          *ly = ymax;
X          intersect = TRUE;
X       }
X    }
X
X    return(intersect);
X}
X
X/* Polar transform of all curves */
X/* Original code by John Campbell ([e-mail]) */
Xpolar_xform (plots, pcount)
X    struct curve_points *plots;
X    int pcount;            /* count of curves in plots array */
X{
X     struct curve_points *this_plot;
X     int curve;            /* loop var, for curves */
X     register int i, p_cnt;    /* loop/limit var, for points */
X     struct coordinate *pnts;    /* abbrev. for points array */
X    double x, y;            /* new cartesian value */
X    BOOLEAN anydefined = FALSE;
X
X/*
X    Cycle through all the plots converting polar to rectangular.
X     If autoscaling, adjust max and mins. Ignore previous values.
X    If not autoscaling, use the yrange for both x and y ranges.
X*/
X    if (autoscale_ly) {
X        xmin = VERYLARGE;
X        ymin = VERYLARGE;
X        xmax = -VERYLARGE;
X        ymax = -VERYLARGE;
X        autoscale_lx = TRUE;
X    } else {
X        xmin = ymin;
X        xmax = ymax;
X    }
X
X    this_plot = plots;
X    for (curve = 0; curve < pcount; this_plot = this_plot->next_cp, curve++) {
X        p_cnt = this_plot->p_count;
X        pnts = &(this_plot->points[0]);
X
X    /*    Convert to cartesian all points in this curve. */
X        for (i = 0; i < p_cnt; i++) {
X            if (pnts[i].type != UNDEFINED) {
X                 anydefined = TRUE;
X                x = pnts[i].y*cos(pnts[i].x);
X                y = pnts[i].y*sin(pnts[i].x);
X                pnts[i].x = x;
X                pnts[i].y = y;
X                if (autoscale_ly) {
X                    if (xmin > x) xmin = x;
X                    if (xmax < x) xmax = x;
X                    if (ymin > y) ymin = y;
X                    if (ymax < y) ymax = y;
X                    pnts[i].type = INRANGE;
X                } else if(inrange(x, xmin, xmax) && inrange(y, ymin, ymax))
X                  pnts[i].type = INRANGE;
X                else
X                  pnts[i].type = OUTRANGE;
X            }
X        }
X    }
X
X    if (autoscale_lx && anydefined && fabs(xmax - xmin) < zero) {
X        /* This happens at least for the plot of 1/cos(x) (vertical line). */
X        fprintf(stderr, "Warning: empty x range [%g:%g], ", xmin,xmax);
X        if (xmin == 0.0) {
X           xmin = -1;
X           xmax = 1;
X        } else {
X           xmin *= 0.9;
X           xmax *= 1.1;
X        }
X        fprintf(stderr, "adjusting to [%g:%g]\n", xmin,xmax);
X    }
X    if (autoscale_ly && anydefined && fabs(ymax - ymin) < zero) {
X        /* This happens at least for the plot of 1/sin(x) (horiz. line). */
X        fprintf(stderr, "Warning: empty y range [%g:%g], ", ymin, ymax);
X        if (ymin == 0.0) {
X           ymin = -1;
X           ymax = 1;
X        } else {
X           ymin *= 0.9;
X           ymax *= 1.1;
X        }
X        fprintf(stderr, "adjusting to [%g:%g]\n", ymin, ymax);
X    }
X}
X
X/* DRAW_YTICS: draw a regular tic series, y axis */
Xdraw_ytics(start, incr, end)
X        double start, incr, end; /* tic series definition */
X        /* assume start < end, incr > 0 */
X{
X    double ticplace;
X    int ltic;            /* for mini log tics */
X    double lticplace;    /* for mini log tics */
X    double ticmin, ticmax;    /* for checking if tic is almost inrange */
X
X    if (end == VERYLARGE)            /* for user-def series */
X        end = max(ymin,ymax);
X
X    /* limit to right side of plot */
X    end = min(end, max(ymin,ymax));
X
X    /* to allow for rounding errors */
X    ticmin = min(ymin,ymax) - SIGNIF*incr;
X    ticmax = max(ymin,ymax) + SIGNIF*incr;
X    end = end + SIGNIF*incr;
X
X    for (ticplace = start; ticplace <= end; ticplace +=incr) {
X        if ( inrange(ticplace,ticmin,ticmax) )
X            ytick(ticplace, yformat, incr, 1.0);
X        if (log_y && incr == 1.0) {
X            /* add mini-ticks to log scale ticmarks */
X            for (ltic = 2; ltic <= 9; ltic++) {
X                lticplace = ticplace+log10((double)ltic);
X                if ( inrange(lticplace,ticmin,ticmax) )
X                    ytick(lticplace, (char *)NULL, incr, 0.5);
X            }
X        }
X    }
X}
X
X
X/* DRAW_XTICS: draw a regular tic series, x axis */
Xdraw_xtics(start, incr, end)
X        double start, incr, end; /* tic series definition */
X        /* assume start < end, incr > 0 */
X{
X    double ticplace;
X    int ltic;            /* for mini log tics */
X    double lticplace;    /* for mini log tics */
X    double ticmin, ticmax;    /* for checking if tic is almost inrange */
X
X    if (end == VERYLARGE)            /* for user-def series */
X        end = max(xmin,xmax);
X
X    /* limit to right side of plot */
X    end = min(end, max(xmin,xmax));
X
X    /* to allow for rounding errors */
X    ticmin = min(xmin,xmax) - SIGNIF*incr;
X    ticmax = max(xmin,xmax) + SIGNIF*incr;
X    end = end + SIGNIF*incr;
X
X    for (ticplace = start; ticplace <= end; ticplace +=incr) {
X        if ( inrange(ticplace,ticmin,ticmax) )
X            xtick(ticplace, xformat, incr, 1.0);
X        if (log_x && incr == 1.0) {
X            /* add mini-ticks to log scale ticmarks */
X            for (ltic = 2; ltic <= 9; ltic++) {
X                lticplace = ticplace+log10((double)ltic);
X                if ( inrange(lticplace,ticmin,ticmax) )
X                    xtick(lticplace, (char *)NULL, incr, 0.5);
X            }
X        }
X    }
X}
X
X/* DRAW_USER_YTICS: draw a user tic series, y axis */
Xdraw_user_ytics(list)
X    struct ticmark *list;    /* list of tic marks */
X{
X    double ticplace;
X    double incr = (ymax - ymin) / 10;
X    /* global xmin, xmax, xscale, ymin, ymax, yscale */
X
X    while (list != NULL) {
X       ticplace = list->position;
X       if ( inrange(ticplace, ymin, ymax)         /* in range */
X          || NearlyEqual(ticplace, ymin, incr)    /* == ymin */
X          || NearlyEqual(ticplace, ymax, incr))    /* == ymax */
X        ytick(ticplace, list->label, incr, 1.0);
X
X       list = list->next;
X    }
X}
X
X/* DRAW_USER_XTICS: draw a user tic series, x axis */
Xdraw_user_xtics(list)
X    struct ticmark *list;    /* list of tic marks */
X{
X    double ticplace;
X    double incr = (xmax - xmin) / 10;
X    /* global xmin, xmax, xscale, ymin, ymax, yscale */
X
X    while (list != NULL) {
X       ticplace = list->position;
X       if ( inrange(ticplace, xmin, xmax)         /* in range */
X          || NearlyEqual(ticplace, xmin, incr)    /* == xmin */
X          || NearlyEqual(ticplace, xmax, incr))    /* == xmax */
X        xtick(ticplace, list->label, incr, 1.0);
X
X       list = list->next;
X    }
X}
X
X/* draw and label a y-axis ticmark */
Xytick(place, text, spacing, ticscale)
X        double place;                   /* where on axis to put it */
X        char *text;                     /* optional text label */
X        double spacing;         /* something to use with checkzero */
X        float ticscale;         /* scale factor for tic mark (0..1] */
X{
X    register struct termentry *t = &term_tbl[term];
X    char ticlabel[101];
X    int ticsize = (int)((t->h_tic) * ticscale);
X
X    place = CheckZero(place,spacing); /* to fix rounding error near zero */
X    if (grid) {
X           (*t->linetype)(-1);  /* axis line type */
X           (*t->move)(xleft, map_y(place));
X           (*t->vector)(xright, map_y(place));
X           (*t->linetype)(-2); /* border linetype */
X    }
X    if (tic_in) {
X           (*t->move)(xleft, map_y(place));
X           (*t->vector)(xleft + ticsize, map_y(place));
X           (*t->move)(xright, map_y(place));
X           (*t->vector)(xright - ticsize, map_y(place));
X    } else {
X           (*t->move)(xleft, map_y(place));
X           (*t->vector)(xleft - ticsize, map_y(place));
X    }
X
X    /* label the ticmark */
X    if (text) {
X        (void) sprintf(ticlabel, text, CheckLog(log_y, place));
X        if ((*t->justify_text)(RIGHT)) {
X           (*t->put_text)(xleft-(t->h_char),
X                       map_y(place), ticlabel);
X        } else {
X           (*t->put_text)(xleft-(t->h_char)*(strlen(ticlabel)+1),
X                       map_y(place), ticlabel);
X        }
X    }
X}
X
X/* draw and label an x-axis ticmark */
Xxtick(place, text, spacing, ticscale)
X        double place;                   /* where on axis to put it */
X        char *text;                     /* optional text label */
X        double spacing;         /* something to use with checkzero */
X        float ticscale;         /* scale factor for tic mark (0..1] */
X{
X    register struct termentry *t = &term_tbl[term];
X    char ticlabel[101];
X    int ticsize = (int)((t->v_tic) * ticscale);
X
X    place = CheckZero(place,spacing); /* to fix rounding error near zero */
X    if (grid) {
X           (*t->linetype)(-1);  /* axis line type */
X           (*t->move)(map_x(place), ybot);
X           (*t->vector)(map_x(place), ytop);
X           (*t->linetype)(-2); /* border linetype */
X    }
X    if (tic_in) {
X           (*t->move)(map_x(place), ybot);
X           (*t->vector)(map_x(place), ybot + ticsize);
X           (*t->move)(map_x(place), ytop);
X           (*t->vector)(map_x(place), ytop - ticsize);
X    } else {
X           (*t->move)(map_x(place), ybot);
X           (*t->vector)(map_x(place), ybot - ticsize);
X    }
X
X    /* label the ticmark */
X    if (text) {
X       (void) sprintf(ticlabel, text, CheckLog(log_x, place));
X       if ((*t->justify_text)(CENTRE)) {
X          (*t->put_text)(map_x(place),
X                      ybot-(t->v_char), ticlabel);
X       } else {
X          (*t->put_text)(map_x(place)-(t->h_char)*strlen(ticlabel)/2,
X                      ybot-(t->v_char), ticlabel);
X       }
X    }
X}
*-*-END-of-graphics.c-*-*
echo x - internal.c
sed 's/^X//' >internal.c <<'*-*-END-of-internal.c-*-*'
X/* GNUPLOT - internal.c */
X/*
X * Copyright (C) 1986, 1987, 1990   Thomas Williams, Colin Kelley
X *
X * Permission to use, copy, and distribute this software and its
X * documentation for any purpose with or without fee is hereby granted,
X * provided that the above copyright notice appear in all copies and
X * that both that copyright notice and this permission notice appear
X * in supporting documentation.
X *
X * Permission to modify the software is granted, but not the right to
X * distribute the modified code.  Modifications are to be distributed
X * as patches to released version.
X *
X * This software  is provided "as is" without express or implied warranty.
X *
X *
X * AUTHORS
X *
X *   Original Software:
X *     Thomas Williams,  Colin Kelley.
X *
X *   Gnuplot 2.0 additions:
X *       Russell Lang, Dave Kotz, John Campbell.
X *
X * send your comments or suggestions to (pixar![e-mail]).
X *
X */
X
X#include <math.h>
X#include <stdio.h>
X#include "plot.h"
X
XBOOLEAN undefined;
X
Xchar *strcpy();
X
Xstruct value *pop(), *complex(), *integer();
Xdouble magnitude(), angle(), real();
X
Xstruct value stack[STACK_DEPTH];
X
Xint s_p = -1;   /* stack pointer */
X
X
X/*
X * System V and MSC 4.0 call this when they wants to print an error message.
X * Don't!
X */
X#ifdef MSDOS
X#ifdef __TURBOC__
Xint matherr()    /* Turbo C */
X#else
Xint matherr(x)    /* MSC 5.1 */
Xstruct exception *x;
X#endif /* TURBOC */
X#else /* MSDOS */
Xint matherr()
X#endif /* MSDOS */
X{
X    return (undefined = TRUE);        /* don't print error message */
X}
X
X
Xreset_stack()
X{
X    s_p = -1;
X}
X
X
Xcheck_stack()    /* make sure stack's empty */
X{
X    if (s_p != -1)
X        fprintf(stderr,"\nwarning:  internal error--stack not empty!\n");
X}
X
X
Xstruct value *pop(x)
Xstruct value *x;
X{
X    if (s_p  < 0 )
X        int_error("stack underflow",NO_CARET);
X    *x = stack[s_p--];
X    return(x);
X}
X
X
Xpush(x)
Xstruct value *x;
X{
X    if (s_p == STACK_DEPTH - 1)
X        int_error("stack overflow",NO_CARET);
X    stack[++s_p] = *x;
X}
X
X
X#define ERR_VAR "undefined variable: "
X
Xf_push(x)
Xunion argument *x;        /* contains pointer to value to push; */
X{
Xstatic char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
Xstruct udvt_entry *udv;
X
X    udv = x->udv_arg;
X    if (udv->udv_undef) {     /* undefined */
X        (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
X        int_error(err_str,NO_CARET);
X    }
X    push(&(udv->udv_value));
X}
X
X
Xf_pushc(x)
Xunion argument *x;
X{
X    push(&(x->v_arg));
X}
X
X
Xf_pushd(x)
Xunion argument *x;
X{
X    push(&(x->udf_arg->dummy_value));
X}
X
X
X#define ERR_FUN "undefined function: "
X
Xf_call(x)  /* execute a udf */
Xunion argument *x;
X{
Xstatic char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
Xregister struct udft_entry *udf;
X
X    udf = x->udf_arg;
X    if (!udf->at) { /* undefined */
X        (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
X                udf->udf_name);
X        int_error(err_str,NO_CARET);
X    }
X    (void) pop(&(udf->dummy_value));
X
X    execute_at(udf->at);
X}
X
X
Xstatic int_check(v)
Xstruct value *v;
X{
X    if (v->type != INT)
X        int_error("non-integer passed to boolean operator",NO_CARET);
X}
X
X
Xf_lnot()
X{
Xstruct value a;
X    int_check(pop(&a));
X    push(integer(&a,!a.v.int_val) );
X}
X
X
Xf_bnot()
X{
Xstruct value a;
X    int_check(pop(&a));
X    push( integer(&a,~a.v.int_val) );
X}
X
X
Xf_bool()
X{            /* converts top-of-stack to boolean */
X    int_check(&top_of_stack);
X    top_of_stack.v.int_val = !!top_of_stack.v.int_val;
X}
X
X
Xf_lor()
X{
Xstruct value a,b;
X    int_check(pop(&b));
X    int_check(pop(&a));
X    push( integer(&a,a.v.int_val || b.v.int_val) );
X}
X
Xf_land()
X{
Xstruct value a,b;
X    int_check(pop(&b));
X    int_check(pop(&a));
X    push( integer(&a,a.v.int_val && b.v.int_val) );
X}
X
X
Xf_bor()
X{
Xstruct value a,b;
X    int_check(pop(&b));
X    int_check(pop(&a));
X    push( integer(&a,a.v.int_val | b.v.int_val) );
X}
X
X
Xf_xor()
X{
Xstruct value a,b;
X    int_check(pop(&b));
X    int_check(pop(&a));
X    push( integer(&a,a.v.int_val ^ b.v.int_val) );
X}
X
X
Xf_band()
X{
Xstruct value a,b;
X    int_check(pop(&b));
X    int_check(pop(&a));
X    push( integer(&a,a.v.int_val & b.v.int_val) );
X}
X
X
Xf_uminus()
X{
Xstruct value a;
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            a.v.int_val = -a.v.int_val;
X            break;
X        case CMPLX:
X            a.v.cmplx_val.real =
X                -a.v.cmplx_val.real;
X            a.v.cmplx_val.imag =
X                -a.v.cmplx_val.imag;
X    }
X    push(&a);
X}
X
X
Xf_eq() /* note: floating point equality is rare because of roundoff error! */
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val ==
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val ==
X                        b.v.cmplx_val.real &&
X                       b.v.cmplx_val.imag == 0.0);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (b.v.int_val == a.v.cmplx_val.real &&
X                       a.v.cmplx_val.imag == 0.0);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real==
X                        b.v.cmplx_val.real &&
X                        a.v.cmplx_val.imag==
X                        b.v.cmplx_val.imag);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_ne()
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val !=
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val !=
X                        b.v.cmplx_val.real ||
X                       b.v.cmplx_val.imag != 0.0);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (b.v.int_val !=
X                        a.v.cmplx_val.real ||
X                       a.v.cmplx_val.imag != 0.0);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real !=
X                        b.v.cmplx_val.real ||
X                        a.v.cmplx_val.imag !=
X                        b.v.cmplx_val.imag);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_gt()
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val >
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val >
X                        b.v.cmplx_val.real);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.cmplx_val.real >
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real >
X                        b.v.cmplx_val.real);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_lt()
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val <
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val <
X                        b.v.cmplx_val.real);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.cmplx_val.real <
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real <
X                        b.v.cmplx_val.real);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_ge()
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val >=
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val >=
X                        b.v.cmplx_val.real);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.cmplx_val.real >=
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real >=
X                        b.v.cmplx_val.real);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_le()
X{
Xstruct value a, b;
X    register int result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.int_val <=
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.int_val <=
X                        b.v.cmplx_val.real);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    result = (a.v.cmplx_val.real <=
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    result = (a.v.cmplx_val.real <=
X                        b.v.cmplx_val.real);
X            }
X    }
X    push(integer(&a,result));
X}
X
X
Xf_plus()
X{
Xstruct value a, b, result;
X    (void) pop(&b);
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    (void) integer(&result,a.v.int_val +
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.int_val +
X                        b.v.cmplx_val.real,
X                       b.v.cmplx_val.imag);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    (void) complex(&result,b.v.int_val +
X                        a.v.cmplx_val.real,
X                       a.v.cmplx_val.imag);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.cmplx_val.real+
X                        b.v.cmplx_val.real,
X                        a.v.cmplx_val.imag+
X                        b.v.cmplx_val.imag);
X            }
X    }
X    push(&result);
X}
X
X
Xf_minus()
X{
Xstruct value a, b, result;
X    (void) pop(&b);
X    (void) pop(&a);        /* now do a - b */
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    (void) integer(&result,a.v.int_val -
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.int_val -
X                        b.v.cmplx_val.real,
X                       -b.v.cmplx_val.imag);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    (void) complex(&result,a.v.cmplx_val.real -
X                        b.v.int_val,
X                        a.v.cmplx_val.imag);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.cmplx_val.real-
X                        b.v.cmplx_val.real,
X                        a.v.cmplx_val.imag-
X                        b.v.cmplx_val.imag);
X            }
X    }
X    push(&result);
X}
X
X
Xf_mult()
X{
Xstruct value a, b, result;
X    (void) pop(&b);
X    (void) pop(&a);    /* now do a*b */
X
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    (void) integer(&result,a.v.int_val *
X                        b.v.int_val);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.int_val *
X                        b.v.cmplx_val.real,
X                        a.v.int_val *
X                        b.v.cmplx_val.imag);
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    (void) complex(&result,b.v.int_val *
X                        a.v.cmplx_val.real,
X                        b.v.int_val *
X                        a.v.cmplx_val.imag);
X                    break;
X                case CMPLX:
X                    (void) complex(&result,a.v.cmplx_val.real*
X                        b.v.cmplx_val.real-
X                        a.v.cmplx_val.imag*
X                        b.v.cmplx_val.imag,
X                        a.v.cmplx_val.real*
X                        b.v.cmplx_val.imag+
X                        a.v.cmplx_val.imag*
X                        b.v.cmplx_val.real);
X            }
X    }
X    push(&result);
X}
X
X
Xf_div()
X{
Xstruct value a, b, result;
Xregister double square;
X    (void) pop(&b);
X    (void) pop(&a);    /* now do a/b */
X
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    if (b.v.int_val)
X                      (void) integer(&result,a.v.int_val /
X                        b.v.int_val);
X                    else {
X                      (void) integer(&result,0);
X                      undefined = TRUE;
X                    }
X                    break;
X                case CMPLX:
X                    square = b.v.cmplx_val.real*
X                        b.v.cmplx_val.real +
X                        b.v.cmplx_val.imag*
X                        b.v.cmplx_val.imag;
X                    if (square)
X                        (void) complex(&result,a.v.int_val*
X                        b.v.cmplx_val.real/square,
X                        -a.v.int_val*
X                        b.v.cmplx_val.imag/square);
X                    else {
X                        (void) complex(&result,0.0,0.0);
X                        undefined = TRUE;
X                    }
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    if (b.v.int_val)
X
X                      (void) complex(&result,a.v.cmplx_val.real/
X                        b.v.int_val,
X                        a.v.cmplx_val.imag/
X                        b.v.int_val);
X                    else {
X                        (void) complex(&result,0.0,0.0);
X                        undefined = TRUE;
X                    }
X                    break;
X                case CMPLX:
X                    square = b.v.cmplx_val.real*
X                        b.v.cmplx_val.real +
X                        b.v.cmplx_val.imag*
X                        b.v.cmplx_val.imag;
X                    if (square)
X                    (void) complex(&result,(a.v.cmplx_val.real*
X                        b.v.cmplx_val.real+
X                        a.v.cmplx_val.imag*
X                        b.v.cmplx_val.imag)/square,
X                        (a.v.cmplx_val.imag*
X                        b.v.cmplx_val.real-
X                        a.v.cmplx_val.real*
X                        b.v.cmplx_val.imag)/
X                            square);
X                    else {
X                        (void) complex(&result,0.0,0.0);
X                        undefined = TRUE;
X                    }
X            }
X    }
X    push(&result);
X}
X
X
Xf_mod()
X{
Xstruct value a, b;
X    (void) pop(&b);
X    (void) pop(&a);    /* now do a%b */
X
X    if (a.type != INT || b.type != INT)
X        int_error("can only mod ints",NO_CARET);
X    if (b.v.int_val)
X        push(integer(&a,a.v.int_val % b.v.int_val));
X    else {
X        push(integer(&a,0));
X        undefined = TRUE;
X    }
X}
X
X
Xf_power()
X{
Xstruct value a, b, result;
Xregister int i, t, count;
Xregister double mag, ang;
X    (void) pop(&b);
X    (void) pop(&a);    /* now find a**b */
X
X    switch(a.type) {
X        case INT:
X            switch (b.type) {
X                case INT:
X                    count = abs(b.v.int_val);
X                    t = 1;
X                    for(i = 0; i < count; i++)
X                        t *= a.v.int_val;
X                    if (b.v.int_val >= 0)
X                        (void) integer(&result,t);
X                    else
X                        (void) complex(&result,1.0/t,0.0);
X                    break;
X                case CMPLX:
X                    mag =
X                      pow(magnitude(&a),fabs(b.v.cmplx_val.real));
X                    if (b.v.cmplx_val.real < 0.0)
X                        mag = 1.0/mag;
X                    ang = angle(&a)*b.v.cmplx_val.real+
X                      b.v.cmplx_val.imag;
X                    (void) complex(&result,mag*cos(ang),
X                        mag*sin(ang));
X            }
X            break;
X        case CMPLX:
X            switch (b.type) {
X                case INT:
X                    if (a.v.cmplx_val.imag == 0.0) {
X                        mag = pow(a.v.cmplx_val.real,(double)abs(b.v.int_val));
X                        if (b.v.int_val < 0)
X                            mag = 1.0/mag;
X                        (void) complex(&result,mag,0.0);
X                    }
X                    else {
X                        /* not so good, but...! */
X                        mag = pow(magnitude(&a),(double)abs(b.v.int_val));
X                        if (b.v.int_val < 0)
X                            mag = 1.0/mag;
X                        ang = angle(&a)*b.v.int_val;
X                        (void) complex(&result,mag*cos(ang),
X                            mag*sin(ang));
X                    }
X                    break;
X                case CMPLX:
X                    mag = pow(magnitude(&a),fabs(b.v.cmplx_val.real));
X                    if (b.v.cmplx_val.real < 0.0)
X                      mag = 1.0/mag;
X                    ang = angle(&a)*b.v.cmplx_val.real+ b.v.cmplx_val.imag;
X                    (void) complex(&result,mag*cos(ang),
X                        mag*sin(ang));
X            }
X    }
X    push(&result);
X}
X
X
Xf_factorial()
X{
Xstruct value a;
Xregister int i;
Xregister double val;
X
X    (void) pop(&a);    /* find a! (factorial) */
X
X    switch (a.type) {
X        case INT:
X            val = 1.0;
X            for (i = a.v.int_val; i > 1; i--)  /*fpe's should catch overflows*/
X                val *= i;
X            break;
X        default:
X            int_error("factorial (!) argument must be an integer",
X            NO_CARET);
X        }
X
X    push(complex(&a,val,0.0));
X
X}
X
X
Xint
Xf_jump(x)
Xunion argument *x;
X{
X    return(x->j_arg);
X}
X
X
Xint
Xf_jumpz(x)
Xunion argument *x;
X{
Xstruct value a;
X    int_check(&top_of_stack);
X    if (top_of_stack.v.int_val) {    /* non-zero */
X        (void) pop(&a);
X        return 1;                /* no jump */
X    }
X    else
X        return(x->j_arg);        /* leave the argument on TOS */
X}
X
X
Xint
Xf_jumpnz(x)
Xunion argument *x;
X{
Xstruct value a;
X    int_check(&top_of_stack);
X    if (top_of_stack.v.int_val)    /* non-zero */
X        return(x->j_arg);        /* leave the argument on TOS */
X    else {
X        (void) pop(&a);
X        return 1;                /* no jump */
X    }
X}
X
X
Xint
Xf_jtern(x)
Xunion argument *x;
X{
Xstruct value a;
X
X    int_check(pop(&a));
X    if (a.v.int_val)
X        return(1);                /* no jump; fall through to TRUE code */
X    else
X        return(x->j_arg);        /* go jump to FALSE code */
X}
*-*-END-of-internal.c-*-*
exit