home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Usenet 1994 January
/
usenetsourcesnewsgroupsinfomagicjanuary1994.iso
/
sources
/
misc
/
volume24
/
gnuplot3
/
part23
< prev
next >
Wrap
Text File
|
1991-10-28
|
49KB
|
1,893 lines
Newsgroups: comp.sources.misc
From: gershon%gr@cs.utah.edu (Elber Gershon)
Subject: v24i045: gnuplot3 - interactive function plotting utility, Part23/26
Message-ID: <1991Oct29.031035.4185@sparky.imd.sterling.com>
X-Md4-Signature: a397e0c1865fa9e306257edf6bdbfaa2
Date: Tue, 29 Oct 1991 03:10:35 GMT
Approved: kent@sparky.imd.sterling.com
Submitted-by: gershon%gr@cs.utah.edu (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!info-gnuplot@sun.com.
X * This is a mailing list; to join it send a note to
X * pixar!info-gnuplot-request@sun.com.
X * Send bug reports to
X * pixar!bug-gnuplot@sun.com.
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!info-gnuplot@sun.com.
X * This is a mailing list; to join it send a note to
X * pixar!info-gnuplot-request@sun.com.
X * Send bug reports to
X * pixar!bug-gnuplot@sun.com.
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!info-gnuplot@sun.com.
X * This is a mailing list; to join it send a note to
X * pixar!info-gnuplot-request@sun.com.
X * Send bug reports to
X * pixar!bug-gnuplot@sun.com.
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!bug-gnuplot@sun.com"
#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!info-gnuplot@sun.com.
X * This is a mailing list; to join it send a note to
X * pixar!info-gnuplot-request@sun.com.
X * Send bug reports to
X * pixar!bug-gnuplot@sun.com.
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!info-gnuplot@sun.com.
X * This is a mailing list; to join it send a note to
X * pixar!info-gnuplot-request@sun.com.
X * Send bug reports to
X * pixar!bug-gnuplot@sun.com.
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: kent@sparky.IMD.Sterling.COM
Sterling Software, IMD UUCP: uunet!sparky!kent
Phone: (402) 291-8300 FAX: (402) 291-4362
Please send comp.sources.misc-related mail to kent@uunet.uu.net.