Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume24/gnuplot3/part23

Text File | 1991-10-28 | 48.3 KB | 1,893 lines

Newsgroups: comp.sources.misc
From: [e-mail] (Elber Gershon)
Subject:  v24i045:  gnuplot3 - interactive function plotting utility, Part23/26
Message-ID: <[e-mail]>
X-Md4-Signature: a397e0c1865fa9e306257edf6bdbfaa2
Date: Tue, 29 Oct 1991 03:10:35 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (Elber Gershon)
Posting-number: Volume 24, Issue 45
Archive-name: gnuplot3/part23
Environment: UNIX, MS-DOS, VMS
Supersedes: gnuplot2: Volume 11, Issue 65-79

#!/bin/sh
# this is Part.23 (part 23 of a multipart archive)
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnuplot/plot.c continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 23; then
    echo Please unpack part "$Scheck" next!
    exit 1
 else
    exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
    echo 'x - still skipping gnuplot/plot.c'
else
echo 'x - continuing file gnuplot/plot.c'
sed 's/^X//' << 'SHAR_EOF' >> 'gnuplot/plot.c' &&
X        /* VAX stuffs up stdout on SIGINT while writing to stdout,
X          so reopen stdout. */
X        if (outfile == stdout) {
X           if ( (stdout = freopen("SYS$OUTPUT","w",stdout))  == NULL) {
X              /* couldn't reopen it so try opening it instead */
X              if ( (stdout = fopen("SYS$OUTPUT","w"))  == NULL) {
X                 /* don't use int_error here - causes infinite loop! */
X                 fprintf(stderr,"Error opening SYS$OUTPUT as stdout\n");
X              }
X           }
X           outfile = stdout;
X        }
#endif                    /* VMS */
X        if (!interactive)
X         done(IO_ERROR);            /* exit on non-interactive error */
X    }
X
X     if (argc > 1) {
X        /* load filenames given as arguments */
X        while (--argc > 0) {
X           ++argv;
X           c_token = NO_CARET; /* in case of file not found */
X           load_file(fopen(*argv,"r"), *argv);
X        }
X    } else {
X        /* take commands from stdin */
X        while(TRUE)
X         com_line();
X    }
X
X     done(IO_SUCCESS);
}
X
/* Set up to catch interrupts */
interrupt_setup()
{
#ifdef MSDOS
#ifdef __TURBOC__
X        (void) signal(SIGINT, tc_interrupt);    /* go there on interrupt char */
#else
X        void ss_interrupt();
X        save_stack();                /* work-around for MSC 4.0/MSDOS 3.x bug */
X        (void) signal(SIGINT, ss_interrupt);
#endif
#else /* MSDOS */
X        (void) signal(SIGINT, inter);    /* go there on interrupt char */
#endif /* MSDOS */
}
X
X
/* Look for a gnuplot start-up file */
load_rcfile()
{
X    register FILE *plotrc;
X    static char home[80];
X    static char rcfile[sizeof(PLOTRC)+80];
X
X    /* Look for a gnuplot init file in . or home directory */
#ifdef vms
X    (void) strcpy(home,HOME);
#else /* vms */
#if defined(AMIGA_AC_5) || defined(AMIGA_LC_5_1)
X    strcpy(home,getenv(HOME));
X    {
X        int h;
X        h = strlen(home) - 1;
X        if (h >= 0) {
X            if ((home[h] != ':') && (home[h] != '/')) {
X                home[h] = '/';
X                home[h+1] = '\0';
X            }
X           }
X    }
#else /* AMIGA */
X    (void) strcat(strcpy(home,getenv(HOME)),"/");
#endif /* AMIGA */
#endif /* vms */
#ifdef NOCWDRC
X    /* inhibit check of init file in current directory for security reasons */
X    {
#else
X    (void) strcpy(rcfile, PLOTRC);
X    plotrc = fopen(rcfile,"r");
X    if (plotrc == (FILE *)NULL) {
#endif
X       (void) sprintf(rcfile, "%s%s", home, PLOTRC);
X       plotrc = fopen(rcfile,"r");
X    }
X    if (plotrc)
X     load_file(plotrc, rcfile);
}
SHAR_EOF
echo 'File gnuplot/plot.c is complete' &&
chmod 0644 gnuplot/plot.c ||
echo 'restore of gnuplot/plot.c failed'
Wc_c="`wc -c < 'gnuplot/plot.c'`"
test 8795 -eq "$Wc_c" ||
    echo 'gnuplot/plot.c: original size 8795, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/plot.h ==============
if test -f 'gnuplot/plot.h' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/plot.h (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/plot.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/plot.h' &&
/* GNUPLOT - plot.h */
/*
X * Copyright (C) 1986, 1987, 1990, 1991   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 *   Gnuplot 3.0 additions:
X *       Gershon Elber and many others.
X *
X * Send your comments or suggestions to
X *  pixar![e-mail].
X * This is a mailing list; to join it send a note to
X *  pixar![e-mail].
X * Send bug reports to
X *  pixar![e-mail].
X */
X
#define PROGRAM "G N U P L O T"
#define PROMPT "gnuplot> "
#if defined(AMIGA_LC_5_1) || defined(AMIGA_AC_5)
#define SHELL "NewShell"
#else /* AMIGA */
#define SHELL "/bin/sh"        /* used if SHELL env variable not set */
#endif /* AMIGA  */
X
#define SAMPLES 100        /* default number of samples for a plot */
#define ISO_SAMPLES 10        /* default number of isolines per splot */
#define ZERO    1e-8        /* default for 'zero' set option */
X
#ifndef TERM
/* default terminal is "unknown"; but see init_terminal */
#define TERM "unknown"
#endif
X
#define TRUE 1
#define FALSE 0
X
X
#define Pi 3.141592653589793
#define DEG2RAD (Pi / 180.0)
X
X
#define MIN_CRV_POINTS 100        /* minimum size of points[] in curve_points */
#define MIN_SRF_POINTS 1000        /* minimum size of points[] in surface_points */
X
#define MAX_LINE_LEN 1024    /* maximum number of chars allowed on line */
#define MAX_TOKENS 200
#define MAX_ID_LEN 50        /* max length of an identifier */
X
X
#define MAX_AT_LEN 150        /* max number of entries in action table */
#define STACK_DEPTH 100
#define NO_CARET (-1)
X
X
#define MAX_NUM_VAR    2    /* Ploting projection of func. of max. two vars. */
X
#define MAP3D_CARTESIAN        0    /* 3D Data mapping. */
#define MAP3D_SPHERICAL        1
#define MAP3D_CYLINDRICAL    2
X
#define CONTOUR_NONE    0    /* Where to place contour maps if at all. */
#define CONTOUR_BASE    1
#define CONTOUR_SRF    2
#define CONTOUR_BOTH    3
X
#define CONTOUR_KIND_LINEAR    0 /* See contour.h in contours subdirectory. */
#define CONTOUR_KIND_CUBIC_SPL    1
#define CONTOUR_KIND_BSPLINE    2
X
#define ANGLES_RADIANS    0
#define ANGLES_DEGREES    1
X
X
#if defined(AMIGA_LC_5_1) || defined(AMIGA_AC_5)
#define OS "Amiga "
#endif
X
X
#ifdef vms
#define OS "VMS "
#endif
X
X
#ifdef unix
#define OS "unix "
#endif
X
X
#ifdef MSDOS
#define OS "MS-DOS "
#endif
X
X
#ifndef OS
#define OS ""
#endif
X
X
/*
X * Note about VERYLARGE:  This is the upper bound double (or float, if PC)
X * numbers. This flag indicates very large numbers. It doesn't have to
X * be the absolutely biggest number on the machine.
X * If your machine doesn't have HUGE, or float.h,
X * define VERYLARGE here.
X *
X * example:
#define VERYLARGE 1e38
X */
X
#ifdef PC
#include <float.h>
#define VERYLARGE FLT_MAX
#else
#if defined( vms ) || defined( _CRAY ) || defined( NEXT )
#include <float.h>
#define VERYLARGE DBL_MAX
#else
#if defined(AMIGA_AC_5) || defined(AMIGA_LC_5_1)
#include <math.h>
#define VERYLARGE HUGE
#else
#define VERYLARGE HUGE
#endif
#endif
#endif
X
X
#define END_OF_COMMAND (c_token >= num_tokens || equals(c_token,";"))
X
#ifdef vms
X
X
#define is_comment(c) ((c) == '#' || (c) == '!')
#define is_system(c) ((c) == '$')
X
X
#else /* vms */
X
X
#define is_comment(c) ((c) == '#')
#define is_system(c) ((c) == '!')
X
X
#endif /* vms */
X
/* If you don't have vfork, then undefine this */
#if defined(NOVFORK) || defined(MSDOS)
# undef VFORK
#else
# ifdef unix
#  define VFORK
# endif
#endif
X
/*
X * memcpy() comes by many names. The default is now to assume bcopy,
X * since it is the most common case. Define
X *  MEMCPY to use memcpy(),
X *  vms to use the vms function,
X *  NOCOPY to use a handwritten version in parse.c
X */
#ifdef vms
# define memcpy(dest,src,len) lib$movc3(&len,src,dest)
#else
# if defined(MEMCPY) || defined(MSDOS)
X   /* use memcpy directly */
# else
#  ifdef NOCOPY
X    /* use the handwritten memcpy in parse.c */
#  else
X    /* assume bcopy is in use */
#   define memcpy(dest,src,len) bcopy(src,dest,len)
#  endif /* NOCOPY */
# endif /* MEMCPY || MSDOS */
#endif /* vms */
X
/*
X * In case you have MEMSET instead of BZERO. If you have something
X * else, define bzero to that something.
X */
#if defined(MEMSET) || defined(MSDOS)
#define bzero(dest,len)  (void)(memset(dest, (char)NULL, len))
#endif /* MEMSET || MSDOS */
X
/* Give the name of your gamma function, or undefine it if you have none.  */
#if defined(NOGAMMA) || defined(MSDOS)
# undef GAMMA
#else
# ifndef GAMMA
#  define GAMMA gamma
# endif /* GAMMA */
#endif /* NOGAMMA ||MSDOS */
X
#define top_of_stack stack[s_p]
X
typedef int BOOLEAN;
X
#ifdef __ZTC__
typedef int (*FUNC_PTR)(...);
#else
typedef int (*FUNC_PTR)();
#endif
X
#if defined(AMIGA_LC_5_1) || defined(AMIGA_AC_5)
enum operators {
X    PUSH, PUSHC, PUSHD1, PUSHD2, CALL, CALL2, LNOT, BNOT, UMINUS, LOR, LAND,
X    BOR, XOR, BAND, EQ, NE, GT, LT, GE, LE, PLUS, MINUS, MULT, DIV,
X    MOD, POWER, FACTORIAL, ABOOL, JUMP, JUMPZ, JUMPNZ, JTERN, SF_START
};
#else
enum operators {
X    PUSH, PUSHC, PUSHD1, PUSHD2, CALL, CALL2, LNOT, BNOT, UMINUS, LOR, LAND,
X    BOR, XOR, BAND, EQ, NE, GT, LT, GE, LE, PLUS, MINUS, MULT, DIV,
X    MOD, POWER, FACTORIAL, BOOL, JUMP, JUMPZ, JUMPNZ, JTERN, SF_START
};
#endif
X
X
#define is_jump(operator) ((operator) >=(int)JUMP && (operator) <(int)SF_START)
X
X
enum DATA_TYPES {
X    INT, CMPLX
};
X
X
enum PLOT_TYPE {
X    FUNC, DATA, FUNC3D, DATA3D
};
X
X
enum PLOT_STYLE {
X    LINES, POINTS, IMPULSES, LINESPOINTS, DOTS, ERRORBARS
};
X
enum JUSTIFY {
X    LEFT, CENTRE, RIGHT
};
X
struct cmplx {
X    double real, imag;
};
X
X
struct value {
X    enum DATA_TYPES type;
X    union {
X        int int_val;
X        struct cmplx cmplx_val;
X    } v;
};
X
X
struct lexical_unit {    /* produced by scanner */
X    BOOLEAN is_token;    /* true if token, false if a value */
X    struct value l_val;
X    int start_index;    /* index of first char in token */
X    int length;            /* length of token in chars */
};
X
X
struct ft_entry {        /* standard/internal function table entry */
X    char *f_name;        /* pointer to name of this function */
X    FUNC_PTR func;        /* address of function to call */
};
X
X
struct udft_entry {                /* user-defined function table entry */
X    struct udft_entry *next_udf;         /* pointer to next udf in linked list */
X    char udf_name[MAX_ID_LEN+1];         /* name of this function entry */
X    struct at_type *at;            /* pointer to action table to execute */
X    char *definition;             /* definition of function as typed */
X    struct value dummy_values[MAX_NUM_VAR];    /* current value of dummy variables */
};
X
X
struct udvt_entry {            /* user-defined value table entry */
X    struct udvt_entry *next_udv; /* pointer to next value in linked list */
X    char udv_name[MAX_ID_LEN+1]; /* name of this value entry */
X    BOOLEAN udv_undef;        /* true if not defined yet */
X    struct value udv_value;    /* value it has */
};
X
X
union argument {            /* p-code argument */
X    int j_arg;                /* offset for jump */
X    struct value v_arg;        /* constant value */
X    struct udvt_entry *udv_arg;    /* pointer to dummy variable */
X    struct udft_entry *udf_arg; /* pointer to udf to execute */
};
X
X
struct at_entry {            /* action table entry */
X    enum operators index;    /* index of p-code function */
X    union argument arg;
};
X
X
struct at_type {
X    int a_count;                /* count of entries in .actions[] */
X    struct at_entry actions[MAX_AT_LEN];
X        /* will usually be less than MAX_AT_LEN is malloc()'d copy */
};
X
X
/* Defines the type of a coordinate */
/* INRANGE and OUTRANGE points have an x,y point associated with them */
enum coord_type {
X    INRANGE,                /* inside plot boundary */
X    OUTRANGE,                /* outside plot boundary, but defined */
X    UNDEFINED                /* not defined at all */
};
X
#ifdef PC
typedef float coordval;        /* memory is tight on PCs! */
#else
typedef double coordval;
#endif
X
struct coordinate {
X    enum coord_type type;    /* see above */
X    coordval x, y, z;
X    coordval ylow, yhigh;    /* ignored in 3d */
};
X
struct curve_points {
X    struct curve_points *next_cp;    /* pointer to next plot in linked list */
X    enum PLOT_TYPE plot_type;
X    enum PLOT_STYLE plot_style;
X    char *title;
X    int line_type;
X    int point_type;
X     int p_max;                    /* how many points are allocated */
X    int p_count;                    /* count of points in points */
X    struct coordinate *points;
};
X
struct gnuplot_contours {
X    struct gnuplot_contours *next;
X    struct coordinate *coords;
X    int num_pts;
};
X
struct iso_curve {
X    struct iso_curve *next;
X     int p_max;                    /* how many points are allocated */
X    int p_count;                    /* count of points in points */
X    struct coordinate *points;
};
X
struct surface_points {
X    struct surface_points *next_sp;    /* pointer to next plot in linked list */
X    enum PLOT_TYPE plot_type;
X    enum PLOT_STYLE plot_style;
X    char *title;
X    int line_type;
X    int point_type;
X    int has_grid_topology;
X    int num_iso_read;  /* Data files only - num of isolines read from file. */
X    struct gnuplot_contours *contours;    /* Not NULL If have contours. */
X    struct iso_curve *iso_crvs;
};
X
struct termentry {
X    char *name;
X    char *description;
X    unsigned int xmax,ymax,v_char,h_char,v_tic,h_tic;
X    FUNC_PTR options,init,reset,text,scale,graphics,move,vector,linetype,
X        put_text,text_angle,justify_text,point,arrow;
};
X
X
struct text_label {
X    struct text_label *next;    /* pointer to next label in linked list */
X    int tag;            /* identifies the label */
X    double x,y,z;
X    enum JUSTIFY pos;
X    char text[MAX_LINE_LEN+1];
};
X
struct arrow_def {
X    struct arrow_def *next;    /* pointer to next arrow in linked list */
X    int tag;            /* identifies the arrow */
X    double sx,sy,sz;        /* start position */
X    double ex,ey,ez;        /* end position */
X    BOOLEAN head;            /* arrow has a head or not */
};
X
/* Tic-mark labelling definition; see set xtics */
struct ticdef {
X    int type;                /* one of three values below */
#define TIC_COMPUTED 1        /* default; gnuplot figures them */
#define TIC_SERIES 2        /* user-defined series */
#define TIC_USER 3            /* user-defined points */
X    union {
X       struct {            /* for TIC_SERIES */
X          double start, incr;
X          double end;        /* ymax, if VERYLARGE */
X       } series;
X       struct ticmark *user;    /* for TIC_USER */
X    } def;
};
X
/* Defines one ticmark for TIC_USER style.
X * If label==NULL, the value is printed with the usual format string.
X * else, it is used as the format string (note that it may be a constant
X * string, like "high" or "low").
X */
struct ticmark {
X    double position;        /* where on axis is this */
X    char *label;            /* optional (format) string label */
X    struct ticmark *next;    /* linked list */
};
X
/*
X * SS$_NORMAL is "normal completion", STS$M_INHIB_MSG supresses
X
X * printing a status message.
X * SS$_ABORT is the general abort status code.
X from:    Martin Minow
X    decvax!minow
X */
#ifdef    vms
#include        <ssdef.h>
#include        <stsdef.h>
#define    IO_SUCCESS    (SS$_NORMAL | STS$M_INHIB_MSG)
#define    IO_ERROR    SS$_ABORT
#endif /* vms */
X
X
#ifndef    IO_SUCCESS    /* DECUS or VMS C will have defined these already */
#define    IO_SUCCESS    0
#endif
#ifndef    IO_ERROR
#define    IO_ERROR    1
#endif
X
/* Some key global variables */
extern BOOLEAN screen_ok;
extern BOOLEAN term_init;
extern BOOLEAN undefined;
extern struct termentry term_tbl[];
X
extern char *alloc();
/* allocating and managing curve_points structures */
extern struct curve_points *cp_alloc();
extern int cp_extend();
extern int cp_free();
/* allocating and managing surface_points structures */
extern struct surface_points *sp_alloc();
extern int sp_replace();
extern int sp_free();
/* allocating and managing is_curve structures */
extern struct iso_curve *iso_alloc();
extern int iso_extend();
extern int iso_free();
SHAR_EOF
chmod 0644 gnuplot/plot.h ||
echo 'restore of gnuplot/plot.h failed'
Wc_c="`wc -c < 'gnuplot/plot.h'`"
test 11940 -eq "$Wc_c" ||
    echo 'gnuplot/plot.h: original size 11940, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/README.amiga ==============
if test -f 'gnuplot/README.amiga' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/README.amiga (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/README.amiga (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/README.amiga' &&
SOME NOTES ON GNUPLOT ON THE AMIGA ...
X
X
X
Environment Variables:
X
X   GNUFONT   You can say "setenv GNUFONT <Fontname>/<Pointsize>" to get the font
X             of your liking on the screen, e.g. "setenv GNUFONT sapphire/14".
X             Otherwise gnuplot will select the default-font you chose with
X             "Preferences".
X
X   GNUHELP   Allows you to define a pathname for the GNUPlot help file.  For
X             example, "setenv GNUHELP TEX:gnuplot.gih"
X
X   GNUPLOT   Your current directory is searched for the file ".gnuplot".
X             If you say "setenv GNUPLOT <Path>" (without the filename!)
X             GNUPlot will look for it there.
X
X   GNUTERM   You can define a default driver with "setenv GNUTERM <driver>".
X             A good choice is "setenv GNUTERM amiga" :^)
X
X   SHELL     If you don't like "NewShell" as your shell, you can say
X             "setenv SHELL <Shell>".
X
X
Stack Size:
X
X   Set your stack to at least 20000 and you'll be fine (I hope).
X   If you're using the integral feature, a stack size of at least 70000
X   is necessary (at least it is for "bivariat.demo" to execute).
X
X
X
--------------------------   LATTICE C VERSION   ------------------------------
X
X
Default paths/directories:
X
X   Gnuplot looks for the file "gnuplot.gih" in your "S:"-directory unless you
X   specify the full pathname including the filename via "setenv GNUHELP".
X
X
Bugs/deficiencies:
X
X   The SAS/C 5.1 library routine [fs]scanf will not correctly handle
X   format-strings like "%[^\n]s". Maybe this will be fixed by SAS in future
X   versions.
X
X   When using "%g" as format-string, SAS/C 5.1 [fs]printf will incorrectly
X   output "0" as "0.". This looks rather ugly as a axis-label.
X
X
SAS/C 5.1 bugs:
X
X   SAS/C 5.1 [fs]scanf will count parameters overread with the "%*s" format-
X   string as properly matched. I included a fix for this by counting the
X   "%*"-sequences in the given format-string. Therfore the "*" must immediately
X   follow the "%" (I don't know if it's legal to put something in-between
X   these two characters anyway...).
X
X   If you start a shell via the gnuplot "shell"-command you won't be able to
X   close your CLI/Shell again. This is probably due to an error in the
X   SAS/C "system"-call.
X
X   "isatty(fileno(stdin))" did not work correctly. A fix is included.
X
X   SAS/C does not seem to handle float-parameters in function-calls and
X   -declarations correctly. (This cost me at least 2 hours to figure out >:-( ).
X   See the latex- and eepic-drivers for details.
X
X
X
X
---------------------------   AZTEC C VERSION   -------------------------------
X
X
Default paths/directories:
X
X   GNUPlot looks for the "gnuplot.gih" file in "GNUPLOT:docs/gnuplot.gih" if
X   GNUHELP is not defined.   This is defined in the makefile (makefile.ami).
X
X
Terminal Drivers:
X
X   The Aztec C version can now use the "amiga.trm" driver written by
X   Carsten Steger.  Under KS/WB 2.0, a custom screen will be used with a size
X   specified by the Prefs/Overscan program.
SHAR_EOF
chmod 0644 gnuplot/README.amiga ||
echo 'restore of gnuplot/README.amiga failed'
Wc_c="`wc -c < 'gnuplot/README.amiga'`"
test 2981 -eq "$Wc_c" ||
    echo 'gnuplot/README.amiga: original size 2981, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/scanner.c ==============
if test -f 'gnuplot/scanner.c' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/scanner.c (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/scanner.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/scanner.c' &&
/* GNUPLOT - scanner.c */
/*
X * Copyright (C) 1986, 1987, 1990, 1991   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 *   Gnuplot 3.0 additions:
X *       Gershon Elber and many others.
X *
X * Send your comments or suggestions to
X *  pixar![e-mail].
X * This is a mailing list; to join it send a note to
X *  pixar![e-mail].
X * Send bug reports to
X *  pixar![e-mail].
X */
X
#include <stdio.h>
#include <ctype.h>
#include "plot.h"
X
#ifdef AMIGA_AC_5
#define O_RDONLY    0
int open(const char * _name, int _mode, ...);
int close(int);
#endif
X
#ifdef vms
X
#include stdio
#include descrip
#include errno
X
#define MAILBOX "PLOT$MAILBOX"
#define pclose(f) fclose(f)
X
#endif /* vms */
X
X
#define isident(c) (isalnum(c) || (c) == '_')
X
#ifndef STDOUT
#define STDOUT 1
#endif
X
#define LBRACE '{'
#define RBRACE '}'
X
#define APPEND_TOKEN {token[t_num].length++; current++;}
X
#define SCAN_IDENTIFIER while (isident(expression[current + 1]))\
X                APPEND_TOKEN
X
extern struct lexical_unit token[MAX_TOKENS];
X
static int t_num;    /* number of token I'm working on */
X
char *strcat(), *strcpy(), *strncpy();
X
/*
X * scanner() breaks expression[] into lexical units, storing them in token[].
X *   The total number of tokens found is returned as the function value.
X *   Scanning will stop when '\0' is found in expression[], or when token[]
X *     is full.
X *
X *     Scanning is performed by following rules:
X *
X *        Current char    token should contain
X *     -------------    -----------------------
X *        1.  alpha        all following alpha-numerics
X *        2.  digit        0 or more following digits, 0 or 1 decimal point,
X *                          0 or more digits, 0 or 1 'e' or 'E',
X *                          0 or more digits.
X *        3.  ^,+,-,/        only current char
X *            %,~,(,)
X *            [,],;,:,
X *            ?,comma
X *        4.  &,|,=,*        current char; also next if next is same
X *        5.  !,<,>        current char; also next if next is =
X *        6.  ", '        all chars up until matching quote
X *        7.  #          this token cuts off scanning of the line (DFK).
X *
X *        white space between tokens is ignored
X */
scanner(expression)
char expression[];
{
register int current;    /* index of current char in expression[] */
register int quote;
char brace;
X
X    for (current = t_num = 0;
X        t_num < MAX_TOKENS && expression[current] != '\0';
X        current++) {
again:
X        if (isspace(expression[current]))
X            continue;                        /* skip the whitespace */
X        token[t_num].start_index = current;
X        token[t_num].length = 1;
X        token[t_num].is_token = TRUE;    /* to start with...*/
X
X        if (expression[current] == '`') {
X            substitute(&expression[current],MAX_LINE_LEN - current);
X            goto again;
X        }
X        if (isalpha(expression[current])) {
X            SCAN_IDENTIFIER;
X        } else if (isdigit(expression[current]) || expression[current] == '.'){
X            token[t_num].is_token = FALSE;
X            token[t_num].length = get_num(&expression[current]);
X            current += (token[t_num].length - 1);
X        } else if (expression[current] == LBRACE) {
X            token[t_num].is_token = FALSE;
X            token[t_num].l_val.type = CMPLX;
X            if ((sscanf(&expression[++current],"%lf , %lf %c",
X                &token[t_num].l_val.v.cmplx_val.real,
X                &token[t_num].l_val.v.cmplx_val.imag,
X                &brace) != 3) || (brace != RBRACE))
X                    int_error("invalid complex constant",t_num);
X            token[t_num].length += 2;
X            while (expression[++current] != RBRACE) {
X                token[t_num].length++;
X                if (expression[current] == '\0')            /* { for vi % */
X                    int_error("no matching '}'", t_num);
X            }
X        } else if (expression[current] == '\'' || expression[current] == '\"'){
X            token[t_num].length++;
X            quote = expression[current];
X            while (expression[++current] != quote) {
X                if (!expression[current]) {
X                    expression[current] = quote;
X                    expression[current+1] = '\0';
X                    break;
X                } else
X                    token[t_num].length++;
X            }
X        } else switch (expression[current]) {
X             case '#':        /* DFK: add comments to gnuplot */
X                  goto endline; /* ignore the rest of the line */
X            case '^':
X            case '+':
X            case '-':
X            case '/':
X            case '%':
X            case '~':
X            case '(':
X            case ')':
X            case '[':
X            case ']':
X            case ';':
X            case ':':
X            case '?':
X            case ',':
X                break;
X            case '&':
X            case '|':
X            case '=':
X            case '*':
X                if (expression[current] == expression[current + 1])
X                    APPEND_TOKEN;
X                break;
X            case '!':
X            case '<':
X            case '>':
X                if (expression[current + 1] == '=')
X                    APPEND_TOKEN;
X                break;
X            default:
X                int_error("invalid character",t_num);
X            }
X        ++t_num;    /* next token if not white space */
X    }
X
endline:                    /* comments jump here to ignore line */
X
/* Now kludge an extra token which points to '\0' at end of expression[].
X   This is useful so printerror() looks nice even if we've fallen off the
X   line. */
X
X        token[t_num].start_index = current;
X        token[t_num].length = 0;
X    return(t_num);
}
X
X
get_num(str)
char str[];
{
double atof();
register int count = 0;
long atol();
register long lval;
X
X    token[t_num].is_token = FALSE;
X    token[t_num].l_val.type = INT;        /* assume unless . or E found */
X    while (isdigit(str[count]))
X        count++;
X    if (str[count] == '.') {
X        token[t_num].l_val.type = CMPLX;
X        while (isdigit(str[++count]))    /* swallow up digits until non-digit */
X            ;
X        /* now str[count] is other than a digit */
X    }
X    if (str[count] == 'e' || str[count] == 'E') {
X        token[t_num].l_val.type = CMPLX;
/* modified if statement to allow + sign in exponent
X   rjl 26 July 1988 */
X        count++;
X        if (str[count] == '-' || str[count] == '+')
X            count++;
X        if (!isdigit(str[count])) {
X            token[t_num].start_index += count;
X            int_error("expecting exponent",t_num);
X        }
X        while (isdigit(str[++count]))
X            ;
X    }
X    if (token[t_num].l_val.type == INT) {
X         lval = atol(str);
X        if ((token[t_num].l_val.v.int_val = lval) != lval)
X            int_error("integer overflow; change to floating point",t_num);
X    } else {
X        token[t_num].l_val.v.cmplx_val.imag = 0.0;
X        token[t_num].l_val.v.cmplx_val.real = atof(str);
X    }
X    return(count);
}
X
X
#ifdef MSDOS
X
#ifdef __ZTC__
substitute(char *str,int max)
#else
substitute()
#endif
{
X    int_error("substitution not supported by MS-DOS!",t_num);
}
X
#else /* MSDOS */
#ifdef AMIGA_LC_5_1
substitute()
{
X    int_error("substitution not supported by AmigaDOS!",t_num);
}
X
#else /* AMIGA_LC_5_1 */
X
substitute(str,max)            /* substitute output from ` ` */
char *str;
int max;
{
register char *last;
register int i,c;
register FILE *f;
#ifdef AMIGA_AC_5
int fd;
#else
FILE *popen();
#endif
static char pgm[MAX_LINE_LEN+1],output[MAX_LINE_LEN+1];
X
#ifdef vms
int chan;
static $DESCRIPTOR(pgmdsc,pgm);
static $DESCRIPTOR(lognamedsc,MAILBOX);
#endif /* vms */
X
X    i = 0;
X    last = str;
X    while (*(++last) != '`') {
X        if (*last == '\0')
X            int_error("unmatched `",t_num);
X        pgm[i++] = *last;
X    }
X    pgm[i] = '\0';        /* end with null */
X    max -= strlen(last);    /* max is now the max length of output sub. */
X
#ifdef vms
X      pgmdsc.dsc$w_length = i;
X       if (!((vaxc$errno = sys$crembx(0,&chan,0,0,0,0,&lognamedsc)) & 1))
X           os_error("sys$crembx failed",NO_CARET);
X
X       if (!((vaxc$errno = lib$spawn(&pgmdsc,0,&lognamedsc,&1)) & 1))
X           os_error("lib$spawn failed",NO_CARET);
X
X       if ((f = fopen(MAILBOX,"r")) == NULL)
X           os_error("mailbox open failed",NO_CARET);
#else /* vms */
#ifdef AMIGA_AC_5
X      if ((fd = open(pgm,"O_RDONLY")) == -1)
#else
X      if ((f = popen(pgm,"r")) == NULL)
#endif
X          os_error("popen failed",NO_CARET);
#endif /* vms */
X
X    i = 0;
X    while ((c = getc(f)) != EOF) {
X        output[i++] = ((c == '\n') ? ' ' : c);    /* newlines become blanks*/
X        if (i == max) {
#ifdef AMIGA_AC_5
X            (void) close(fd);
#else
X            (void) pclose(f);
#endif
X            int_error("substitution overflow", t_num);
X        }
X    }
#ifdef AMIGA_AC_5
X    (void) close(fd);
#else
X    (void) pclose(f);
#endif
X    if (i + strlen(last) > max)
X        int_error("substitution overflowed rest of line", t_num);
X    (void) strncpy(output+i,last+1,MAX_LINE_LEN-i);
X                                    /* tack on rest of line to output */
X    (void) strcpy(str,output);                /* now replace ` ` with output */
X    screen_ok = FALSE;
}
#endif /* AMIGA_LC_5_1 */
#endif /* MS-DOS */
SHAR_EOF
chmod 0644 gnuplot/scanner.c ||
echo 'restore of gnuplot/scanner.c failed'
Wc_c="`wc -c < 'gnuplot/scanner.c'`"
test 8676 -eq "$Wc_c" ||
    echo 'gnuplot/scanner.c: original size 8676, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/version.c ==============
if test -f 'gnuplot/version.c' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/version.c (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/version.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/version.c' &&
/* GNUPLOT - version.c */
/*
X * Copyright (C) 1986, 1987, 1990, 1991   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 *   Gnuplot 3.0 additions:
X *       Gershon Elber and many others.
X *
X * Send your comments or suggestions to
X *  pixar![e-mail].
X * This is a mailing list; to join it send a note to
X *  pixar![e-mail].
X * Send bug reports to
X *  pixar![e-mail].
X */
X
char version[] = "3.0 ";
char patchlevel[] = "0, Sep 29 91";
char date[] = "Sun Sep 29 16:56:36 1991";
X
/* override in Makefile */
#ifndef CONTACT
# define CONTACT "pixar![e-mail]"
#endif
char bug_email[] = CONTACT;
SHAR_EOF
chmod 0644 gnuplot/version.c ||
echo 'restore of gnuplot/version.c failed'
Wc_c="`wc -c < 'gnuplot/version.c'`"
test 1368 -eq "$Wc_c" ||
    echo 'gnuplot/version.c: original size 1368, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/setshow.h ==============
if test -f 'gnuplot/setshow.h' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/setshow.h (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/setshow.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/setshow.h' &&
/* GNUPLOT - setshow.h */
/*
X * Copyright (C) 1986, 1987, 1990, 1991   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 *   Gnuplot 3.0 additions:
X *       Gershon Elber and many others.
X *
X * Send your comments or suggestions to
X *  pixar![e-mail].
X * This is a mailing list; to join it send a note to
X *  pixar![e-mail].
X * Send bug reports to
X *  pixar![e-mail].
X */
X
/*
X * global variables to hold status of 'set' options
X *
X */
extern BOOLEAN            autoscale_r;
extern BOOLEAN            autoscale_t;
extern BOOLEAN            autoscale_u;
extern BOOLEAN            autoscale_v;
extern BOOLEAN            autoscale_x;
extern BOOLEAN            autoscale_y;
extern BOOLEAN            autoscale_z;
extern BOOLEAN            autoscale_lt;
extern BOOLEAN            autoscale_lu;
extern BOOLEAN            autoscale_lv;
extern BOOLEAN            autoscale_lx;
extern BOOLEAN            autoscale_ly;
extern BOOLEAN            autoscale_lz;
extern BOOLEAN            clip_points;
extern BOOLEAN            clip_lines1;
extern BOOLEAN            clip_lines2;
extern BOOLEAN            draw_border;
extern BOOLEAN            draw_surface;
extern BOOLEAN            timedate;
extern char            dummy_var[MAX_NUM_VAR][MAX_ID_LEN+1];
extern char            xformat[];
extern char            yformat[];
extern char            zformat[];
extern enum PLOT_STYLE data_style, func_style;
extern BOOLEAN            grid;
extern int            key;
extern double            key_x, key_y, key_z; /* user specified position for key */
extern BOOLEAN            log_x, log_y, log_z;
extern FILE*            outfile;
extern char            outstr[];
extern BOOLEAN            parametric;
extern BOOLEAN            polar;
extern int            angles_format;
extern int            mapping3d;
extern int            samples;
extern int            iso_samples;
extern float            xsize; /* scale factor for size */
extern float            ysize; /* scale factor for size */
extern float            zsize; /* scale factor for size */
extern float            surface_rot_z;
extern float            surface_rot_x;
extern float            surface_scale;
extern float            surface_zscale;
extern int            term; /* unknown term is 0 */
extern char            term_options[];
extern char            title[];
extern char            xlabel[];
extern char            ylabel[];
extern char            zlabel[];
extern int            time_xoffset;
extern int            time_yoffset;
extern int            title_xoffset;
extern int            title_yoffset;
extern int            xlabel_xoffset;
extern int            xlabel_yoffset;
extern int            ylabel_xoffset;
extern int            ylabel_yoffset;
extern int            zlabel_xoffset;
extern int            zlabel_yoffset;
extern double            rmin, rmax;
extern double            tmin, tmax, umin, umax, vmin, vmax;
extern double            xmin, xmax, ymin, ymax, zmin, zmax;
extern double            loff, roff, toff, boff;
extern int            draw_contour;
extern int            contour_pts;
extern int            contour_kind;
extern int            contour_order;
extern int            contour_levels;
extern double            zero; /* zero threshold, not 0! */
X
extern BOOLEAN xzeroaxis;
extern BOOLEAN yzeroaxis;
X
extern BOOLEAN xtics;
extern BOOLEAN ytics;
extern BOOLEAN ztics;
X
extern float ticslevel;
X
extern struct ticdef xticdef;
extern struct ticdef yticdef;
extern struct ticdef zticdef;
X
extern BOOLEAN            tic_in;
X
extern struct text_label *first_label;
extern struct arrow_def *first_arrow;
X
/* The set and show commands, in setshow.c */
extern void set_command();
extern void show_command();
/* and some accessible support functions */
extern enum PLOT_STYLE get_style();
extern BOOLEAN load_range();
extern void show_version();
SHAR_EOF
chmod 0644 gnuplot/setshow.h ||
echo 'restore of gnuplot/setshow.h failed'
Wc_c="`wc -c < 'gnuplot/setshow.h'`"
test 3968 -eq "$Wc_c" ||
    echo 'gnuplot/setshow.h: original size 3968, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= gnuplot/standard.c ==============
if test -f 'gnuplot/standard.c' -a X"$1" != X"-c"; then
    echo 'x - skipping gnuplot/standard.c (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting gnuplot/standard.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'gnuplot/standard.c' &&
/* GNUPLOT - standard.c */
/*
X * Copyright (C) 1986, 1987, 1990, 1991   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 *   Gnuplot 3.0 additions:
X *       Gershon Elber and many others.
X *
X * Send your comments or suggestions to
X *  pixar![e-mail].
X * This is a mailing list; to join it send a note to
X *  pixar![e-mail].
X * Send bug reports to
X *  pixar![e-mail].
X */
X
#include <math.h>
#include <stdio.h>
#include "plot.h"
X
#ifdef vms
#include <errno.h>
#else
extern int errno;
#endif /* vms */
X
X
extern struct value stack[STACK_DEPTH];
extern int s_p;
extern double zero;
X
struct value *pop(), *complex(), *integer();
X
double magnitude(), angle(), real(), imag();
X
/* The bessel function approximations here are from
X * "Computer Approximations"
X * by Hart, Cheney et al.
X * John Wiley & Sons, 1968
X */
X
/* There appears to be a mistake in Hart, Cheney et al. on page 149.
X * Where it list Qn(x)/x ~ P(z*z)/Q(z*z), z = 8/x, it should read
X *               Qn(x)/z ~ P(z*z)/Q(z*z), z = 8/x
X * In the functions below, Qn(x) is implementated using the later
X * equation.
X * These bessel functions are accurate to about 1e-13
X */
X
#define PI_ON_FOUR       0.78539816339744830961566084581987572
#define PI_ON_TWO        1.57079632679489661923131269163975144
#define THREE_PI_ON_FOUR 2.35619449019234492884698253745962716
#define TWO_ON_PI        0.63661977236758134307553505349005744
X
static double dzero = 0.0;
X
/* jzero for x in [0,8]
X * Index 5849, 19.22 digits precision
X */
static double pjzero[] = {
X     0.4933787251794133561816813446e+21,
X    -0.11791576291076105360384408e+21,
X     0.6382059341072356562289432465e+19,
X    -0.1367620353088171386865416609e+18,
X     0.1434354939140346111664316553e+16,
X    -0.8085222034853793871199468171e+13,
X     0.2507158285536881945555156435e+11,
X    -0.4050412371833132706360663322e+8,
X     0.2685786856980014981415848441e+5
};
X
static double qjzero[] = {
X    0.4933787251794133562113278438e+21,
X    0.5428918384092285160200195092e+19,
X    0.3024635616709462698627330784e+17,
X    0.1127756739679798507056031594e+15,
X    0.3123043114941213172572469442e+12,
X    0.669998767298223967181402866e+9,
X    0.1114636098462985378182402543e+7,
X    0.1363063652328970604442810507e+4,
X    0.1e+1
};
X
/* pzero for x in [8,inf]
X * Index 6548, 18.16 digits precision
X */
static double ppzero[] = {
X    0.2277909019730468430227002627e+5,
X    0.4134538663958076579678016384e+5,
X    0.2117052338086494432193395727e+5,
X    0.348064864432492703474453111e+4,
X    0.15376201909008354295771715e+3,
X    0.889615484242104552360748e+0
};
X
static double qpzero[] = {
X    0.2277909019730468431768423768e+5,
X    0.4137041249551041663989198384e+5,
X    0.2121535056188011573042256764e+5,
X    0.350287351382356082073561423e+4,
X    0.15711159858080893649068482e+3,
X    0.1e+1
};
X
/* qzero for x in [8,inf]
X * Index 6948, 18.33 digits precision
X */
static double pqzero[] = {
X    -0.8922660020080009409846916e+2,
X    -0.18591953644342993800252169e+3,
X    -0.11183429920482737611262123e+3,
X    -0.2230026166621419847169915e+2,
X    -0.124410267458356384591379e+1,
X    -0.8803330304868075181663e-2,
};
X
static double qqzero[] = {
X    0.571050241285120619052476459e+4,
X    0.1195113154343461364695265329e+5,
X    0.726427801692110188369134506e+4,
X    0.148872312322837565816134698e+4,
X    0.9059376959499312585881878e+2,
X    0.1e+1
};
X
X
/* yzero for x in [0,8]
X * Index 6245, 18.78 digits precision
X */
static double pyzero[] = {
X    -0.2750286678629109583701933175e+20,
X     0.6587473275719554925999402049e+20,
X    -0.5247065581112764941297350814e+19,
X     0.1375624316399344078571335453e+18,
X    -0.1648605817185729473122082537e+16,
X     0.1025520859686394284509167421e+14,
X    -0.3436371222979040378171030138e+11,
X     0.5915213465686889654273830069e+8,
X    -0.4137035497933148554125235152e+5
};
X
static double qyzero[] = {
X    0.3726458838986165881989980739e+21,
X    0.4192417043410839973904769661e+19,
X    0.2392883043499781857439356652e+17,
X    0.9162038034075185262489147968e+14,
X    0.2613065755041081249568482092e+12,
X    0.5795122640700729537380087915e+9,
X    0.1001702641288906265666651753e+7,
X    0.1282452772478993804176329391e+4,
X    0.1e+1
};
X
X
/* jone for x in [0,8]
X * Index 6050, 20.98 digits precision
X */
static double pjone[] = {
X     0.581199354001606143928050809e+21,
X    -0.6672106568924916298020941484e+20,
X     0.2316433580634002297931815435e+19,
X    -0.3588817569910106050743641413e+17,
X     0.2908795263834775409737601689e+15,
X    -0.1322983480332126453125473247e+13,
X     0.3413234182301700539091292655e+10,
X    -0.4695753530642995859767162166e+7,
X     0.270112271089232341485679099e+4
};
X
static double qjone[] = {
X    0.11623987080032122878585294e+22,
X    0.1185770712190320999837113348e+20,
X    0.6092061398917521746105196863e+17,
X    0.2081661221307607351240184229e+15,
X    0.5243710262167649715406728642e+12,
X    0.1013863514358673989967045588e+10,
X    0.1501793594998585505921097578e+7,
X    0.1606931573481487801970916749e+4,
X    0.1e+1
};
X
X
/* pone for x in [8,inf]
X * Index 6749, 18.11 digits precision
X */
static double ppone[] = {
X    0.352246649133679798341724373e+5,
X    0.62758845247161281269005675e+5,
X    0.313539631109159574238669888e+5,
X    0.49854832060594338434500455e+4,
X    0.2111529182853962382105718e+3,
X    0.12571716929145341558495e+1
};
X
static double qpone[] = {
X    0.352246649133679798068390431e+5,
X    0.626943469593560511888833731e+5,
X    0.312404063819041039923015703e+5,
X    0.4930396490181088979386097e+4,
X    0.2030775189134759322293574e+3,
X    0.1e+1
};
X
/* qone for x in [8,inf]
X * Index 7149, 18.28 digits precision
X */
static double pqone[] = {
X    0.3511751914303552822533318e+3,
X    0.7210391804904475039280863e+3,
X    0.4259873011654442389886993e+3,
X    0.831898957673850827325226e+2,
X    0.45681716295512267064405e+1,
X    0.3532840052740123642735e-1
};
X
static double qqone[] = {
X    0.74917374171809127714519505e+4,
X    0.154141773392650970499848051e+5,
X    0.91522317015169922705904727e+4,
X    0.18111867005523513506724158e+4,
X    0.1038187585462133728776636e+3,
X    0.1e+1
};
X
X
/* yone for x in [0,8]
X * Index 6444, 18.24 digits precision
X */
static double pyone[] = {
X    -0.2923821961532962543101048748e+20,
X     0.7748520682186839645088094202e+19,
X    -0.3441048063084114446185461344e+18,
X     0.5915160760490070618496315281e+16,
X    -0.4863316942567175074828129117e+14,
X     0.2049696673745662182619800495e+12,
X    -0.4289471968855248801821819588e+9,
X     0.3556924009830526056691325215e+6
};
X
static double qyone[] = {
X    0.1491311511302920350174081355e+21,
X    0.1818662841706134986885065935e+19,
X    0.113163938269888452690508283e+17,
X    0.4755173588888137713092774006e+14,
X    0.1500221699156708987166369115e+12,
X    0.3716660798621930285596927703e+9,
X    0.726914730719888456980191315e+6,
X    0.10726961437789255233221267e+4,
X    0.1e+1
};
X
X
f_real()
{
struct value a;
X    push( complex(&a,real(pop(&a)), 0.0) );
}
X
f_imag()
{
struct value a;
X    push( complex(&a,imag(pop(&a)), 0.0) );
}
X
f_arg()
{
struct value a;
X    push( complex(&a,angle(pop(&a)), 0.0) );
}
X
f_conjg()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,real(&a),-imag(&a) ));
}
X
f_sin()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,sin(real(&a))*cosh(imag(&a)), cos(real(&a))*sinh(imag(&a))) );
}
X
f_cos()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,cos(real(&a))*cosh(imag(&a)), -sin(real(&a))*sinh(imag(&a))));
}
X
f_tan()
{
struct value a;
register double den;
X    (void) pop(&a);
X    if (imag(&a) == 0.0)
X        push( complex(&a,tan(real(&a)),0.0) );
X    else {
X        den = cos(2*real(&a))+cosh(2*imag(&a));
X        if (den == 0.0) {
X            undefined = TRUE;
X            push( &a );
X        }
X        else
X            push( complex(&a,sin(2*real(&a))/den, sinh(2*imag(&a))/den) );
X    }
}
X
f_asin()
{
struct value a;
register double alpha, beta, x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0) {
X        if (fabs(x) > 1.0) {
X            undefined = TRUE;
X            push(complex(&a,0.0, 0.0));
X        } else
X            push( complex(&a,asin(x),0.0) );
X    } else {
X        beta  = sqrt((x + 1)*(x + 1) + y*y)/2 - sqrt((x - 1)*(x - 1) + y*y)/2;
X        alpha = sqrt((x + 1)*(x + 1) + y*y)/2 + sqrt((x - 1)*(x - 1) + y*y)/2;
X        push( complex(&a,asin(beta), log(alpha + sqrt(alpha*alpha-1))) );
X    }
}
X
f_acos()
{
struct value a;
register double alpha, beta, x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0) {
X        if (fabs(x) > 1.0) {
X            undefined = TRUE;
X            push(complex(&a,0.0, 0.0));
X        } else
X            push( complex(&a,acos(x),0.0) );
X    } else {
X        alpha = sqrt((x + 1)*(x + 1) + y*y)/2 + sqrt((x - 1)*(x - 1) + y*y)/2;
X        beta  = sqrt((x + 1)*(x + 1) + y*y)/2 - sqrt((x - 1)*(x - 1) + y*y)/2;
X        push( complex(&a,acos(beta), log(alpha + sqrt(alpha*alpha-1))) );
X    }
}
X
f_atan()
{
struct value a;
register double x, y;
X    (void) pop(&a);
X    x = real(&a); y = imag(&a);
X    if (y == 0.0)
X        push( complex(&a,atan(x), 0.0) );
X    else if (x == 0.0 && fabs(y) == 1.0) {
X        undefined = TRUE;
X        push(complex(&a,0.0, 0.0));
X    } else
X        push( complex(&a,atan(2*x/(1-x*x-y*y)),
X                log((x*x+(y+1)*(y+1))/(x*x+(y-1)*(y-1)))/4) );
}
X
f_sinh()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,sinh(real(&a))*cos(imag(&a)), cosh(real(&a))*sin(imag(&a))) );
}
X
f_cosh()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,cosh(real(&a))*cos(imag(&a)), sinh(real(&a))*sin(imag(&a))) );
}
X
f_tanh()
{
struct value a;
register double den;
X    (void) pop(&a);
X    den = cosh(2*real(&a)) + cos(2*imag(&a));
X    push( complex(&a,sinh(2*real(&a))/den, sin(2*imag(&a))/den) );
}
X
f_int()
{
struct value a;
X    push( integer(&a,(int)real(pop(&a))) );
}
X
X
f_abs()
{
struct value a;
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,abs(a.v.int_val)) );
X            break;
X        case CMPLX:
X            push( complex(&a,magnitude(&a), 0.0) );
X    }
}
X
f_sgn()
{
struct value a;
X    (void) pop(&a);
X    switch(a.type) {
X        case INT:
X            push( integer(&a,(a.v.int_val > 0) ? 1 :
X                    (a.v.int_val < 0) ? -1 : 0) );
X            break;
X        case CMPLX:
X            push( integer(&a,(a.v.cmplx_val.real > 0.0) ? 1 :
X                    (a.v.cmplx_val.real < 0.0) ? -1 : 0) );
X            break;
X    }
}
X
X
f_sqrt()
{
struct value a;
register double mag, ang;
X    (void) pop(&a);
X    mag = sqrt(magnitude(&a));
X    if (imag(&a) == 0.0 && real(&a) < 0.0)
X        push( complex(&a,0.0,mag) );
X    else
X    {
X        if ( (ang = angle(&a)) < 0.0)
X            ang += 2*Pi;
X        ang /= 2;
X        push( complex(&a,mag*cos(ang), mag*sin(ang)) );
X    }
}
X
X
f_exp()
{
struct value a;
register double mag, ang;
X    (void) pop(&a);
X    mag = exp(real(&a));
X    ang = imag(&a);
X    push( complex(&a,mag*cos(ang), mag*sin(ang)) );
}
X
X
f_log10()
{
struct value a;
register double l10;;
X    (void) pop(&a);
X    l10 = log(10.0);    /***** replace with a constant! ******/
X    push( complex(&a,log(magnitude(&a))/l10, angle(&a)/l10) );
}
X
X
f_log()
{
struct value a;
X    (void) pop(&a);
X    push( complex(&a,log(magnitude(&a)), angle(&a)) );
}
X
X
f_floor()
{
struct value a;
X
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,(int)floor((double)a.v.int_val)));
X            break;
X        case CMPLX:
X            push( integer(&a,(int)floor(a.v.cmplx_val.real)));
X    }
}
X
X
f_ceil()
{
struct value a;
X
X    (void) pop(&a);
X    switch (a.type) {
X        case INT:
X            push( integer(&a,(int)ceil((double)a.v.int_val)));
X            break;
X        case CMPLX:
X            push( integer(&a,(int)ceil(a.v.cmplx_val.real)));
X    }
}
X
#ifdef GAMMA
X
f_gamma()
{
extern int signgam;
register double y;
struct value a;
X
X    y = GAMMA(real(pop(&a)));
X    if (y > 88.0) {
X        undefined = TRUE;
X        push( integer(&a,0) );
X    }
X    else
X        push( complex(&a,signgam * exp(y),0.0) );
}
X
#endif /* GAMMA */
X
X
/* bessel function approximations */
double jzero(x)
double x;
{
double p, q, x2;
int n;
X
X    x2 = x * x;
X    p = pjzero[8];
X    q = qjzero[8];
X    for (n=7; n>=0; n--) {
X        p = p*x2 + pjzero[n];
X        q = q*x2 + qjzero[n];
X    }
X    return(p/q);
}
X
double pzero(x)
double x;
{
double p, q, z, z2;
int n;
X
X    z = 8.0 / x;
X    z2 = z * z;
X    p = ppzero[5];
X    q = qpzero[5];
X    for (n=4; n>=0; n--) {
X        p = p*z2 + ppzero[n];
SHAR_EOF
true || echo 'restore of gnuplot/standard.c failed'
fi
echo 'End of  part 23'
echo 'File gnuplot/standard.c is continued in part 24'
echo 24 > _shar_seq_.tmp
exit 0

exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].