int Plot_y_errorbar (int n, float *x, float *top, float *bot, /*{{{*/
float terminal_length)
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_y_errorbar == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_y_errorbar operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_three_float_arrays (n, x, top, bot);
SLang_push_float (terminal_length);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_y_errorbar)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting Y errorbar");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting Y errorbar");
return -1;
}
return status;
}
/* This function is reentrant */
static int handle_signal (Signal_Type *s)
{
int status = 0;
int was_blocked;
(void) block_signal (s->sig, &was_blocked);
/* At this point, sig is blocked and the handler is about to be called.
* The pending flag can be safely set to 0 here.
*/
s->pending = 0;
if (s->handler != NULL)
{
int depth = SLstack_depth ();
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_integer (s->sig))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (s->handler)))
status = -1;
if ((status == 0)
&& (depth != SLstack_depth ()))
{
SLang_verror (SL_Application_Error, "The signal handler %s corrupted the stack", s->handler->name);
status = -1;
}
}
if (was_blocked == 0)
(void) unblock_signal (s->sig);
return status;
}
int _Plot_label_box (char *xlabel, char *ylabel, char *tlabel) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->label_axes == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: label_axes operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_string (xlabel);
SLang_push_string (ylabel);
SLang_push_string (tlabel);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->label_axes))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: label_axes failed");
return -1;
}
return status;
}
int forward_paragraph(void) /*{{{*/
{
Jed_Buffer_Hook_Type *h = CBuf->buffer_hooks;
if ((h != NULL)
&& (h->forward_paragraph_hook != NULL))
{
if (0 == SLexecute_function (h->forward_paragraph_hook))
return 1;
return -1;
}
while (1)
{
if (0 == jed_down (1))
{
eol ();
break;
}
if (is_paragraph_sep ())
break;
}
return(1);
}
static int sl_report_function (Isis_Fit_Statistic_Type *s, void *pfp, double stat, unsigned int npts, unsigned int nvpars) /*{{{*/
{
FILE *fp = (FILE *)pfp;
char *str;
if (s == NULL || s->sl_report == NULL)
return -1;
SLang_start_arg_list ();
if ((-1 == SLang_push_double (stat))
|| (-1 == SLang_push_integer ((int) npts))
|| (-1 == SLang_push_integer ((int) nvpars)))
return -1;
SLang_end_arg_list ();
if (-1 == SLexecute_function ((SLang_Name_Type *)s->sl_report))
return -1;
if (-1 == SLang_pop_slstring (&str))
return -1;
if (EOF == fputs (str, fp))
{
SLang_free_slstring (str);
return -1;
}
SLang_free_slstring (str);
return 0;
}
int Plot_query_plot_limits (float *xmin, float *xmax, float *ymin, float *ymax) /*{{{*/
{
if (pli_undefined())
return -1;
if (PLI->query_plot_limits == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: query_plot_limits operation is not supported");
return -1;
}
if (-1 == SLexecute_function (PLI->query_plot_limits))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed querying plot limits");
return -1;
}
if ((-1 == SLang_pop_float (ymax))
|| (-1 == SLang_pop_float (ymin))
|| (-1 == SLang_pop_float (xmax))
|| (-1 == SLang_pop_float (xmin)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed querying plot limits");
return -1;
}
return 0;
}
int Plot_histogram_data (int n, float *lo, float *hi, float *val) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_histogram == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_histogram operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_three_float_arrays (n, lo, hi, val);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_histogram)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting histogram");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting histogram");
return -1;
}
return status;
}
int Plot_line (int n, float *x, float *y) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_xy == NULL)
return -1;
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_xy)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting line");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting line");
return -1;
}
return status;
}
int Plot_points (int n, float *x, float *y, int symbol) /*{{{*/
{
int status = -1;
if (pli_undefined())
return -1;
if (PLI->plot_points == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: plot_points operation is not supported");
return -1;
}
SLang_start_arg_list ();
status = push_two_float_arrays (n, x, y);
SLang_push_integer (symbol);
SLang_end_arg_list ();
if ((status < 0) || (-1 == SLexecute_function (PLI->plot_points)))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed plotting points");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed plotting points");
return -1;
}
return status;
}
int Plot_subdivide (int num_x_subpanels, int num_y_subpanels) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->subdivide == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: subdivide operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (num_x_subpanels);
SLang_push_integer (num_y_subpanels);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->subdivide))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed subdividing plot device");
return -1;
}
return status;
}
int Plot_select_window (int device) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->select_window == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: select_window operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_integer (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->select_window))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed selecting plot device");
return -1;
}
return status;
}
int Plot_close (void) /*{{{*/
{
int status;
SLSig_Fun_Type *sig_func;
if (pli_undefined())
return -1;
if (PLI->close == NULL)
return -1;
sig_func = SLsignal (SIGSEGV, sig_segv);
if (SIG_ERR == sig_func)
fprintf (stderr, "warning: failed initializing signal handler for SIGSEGV\n");
if (-1 == SLexecute_function (PLI->close))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed closing plot device");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "function closing plot device did not return status integer");
return -1;
}
if (SLsignal (SIGSEGV, sig_func) == SIG_ERR)
fprintf (stderr, "warning: failed to re-set signal handler\n");
return status;
}
int Plot_open (char *device) /*{{{*/
{
int id;
if (pli_undefined())
return -1;
if (PLI->open == NULL)
return -1;
SLang_start_arg_list ();
SLang_push_string (device);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->open))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
if ((-1 == SLang_pop_integer (&id))
|| (id <= 0))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "failed opening plot device");
return -1;
}
return id;
}
static int read_plot_cursor (Cursor_Config_Type *cc, float *x, float *y, char *ch) /*{{{*/
{
if (pli_undefined())
return -1;
if (PLI->read_cursor == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: read_cursor operation is not supported");
return -1;
}
if (-1 == SLang_push_cstruct ((VOID_STAR)cc, Cursor_Config_Table))
return -1;
if (-1 == SLexecute_function (PLI->read_cursor))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: read_cursor failed");
return -1;
}
if (SLstack_depth() < 3)
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: read_cursor failed");
return -1;
}
SLang_pop_char (ch);
SLang_pop_float (y);
SLang_pop_float (x);
return 0;
}
char *Plot_configure_axis (char *opt, int is_log, int has_numbers) /*{{{*/
{
char *s;
if (pli_undefined())
return NULL;
if (PLI->configure_axis == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: configure_axis operation is not supported");
return NULL;
}
SLang_start_arg_list ();
SLang_push_string (opt);
SLang_push_integer (is_log);
SLang_push_integer (has_numbers);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->configure_axis))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
if (-1 == SLpop_string (&s))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: configure_axis failed");
return NULL;
}
return s;
}
char *Plot_get_option_string_default (void) /*{{{*/
{
char *s;
if (pli_undefined())
return NULL;
if (PLI->default_axis == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: default_axis operation is not supported");
return NULL;
}
if (-1 == SLexecute_function (PLI->default_axis))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: default_axis failed");
return NULL;
}
if (-1 == SLpop_string (&s))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: default_axis failed");
return NULL;
}
return s;
}
static void rline_call_update_hook (SLrline_Type *rli,
SLFUTURE_CONST char *prompt,
SLFUTURE_CONST char *buf,
unsigned int len,
unsigned int point, VOID_STAR cd)
{
Rline_CB_Type *cb;
(void) rli;
(void) len;
cb = (Rline_CB_Type *)cd;
if (-1 == SLang_start_arg_list ())
return;
if ((-1 == SLang_push_mmt (cb->mmt))
|| (-1 == SLang_push_string (prompt))
|| (-1 == SLang_push_string (buf))
|| (-1 == SLang_push_int ((int) point))
|| ((cb->cd != NULL) && (-1 == SLang_push_anytype (cb->cd))))
{
(void) SLang_end_arg_list ();
return;
}
(void) SLexecute_function (cb->update_hook);
}
int _Plot_set_charsize (float size) /*{{{*/
{
int status;
if (pli_undefined())
return -1;
if (PLI->set_char_size == NULL)
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__,
"plot: set_char_size operation is not supported");
return -1;
}
SLang_start_arg_list ();
SLang_push_float (size);
SLang_end_arg_list ();
if (-1 == SLexecute_function (PLI->set_char_size))
{
isis_vmesg (FAIL, I_FAILED, __FILE__, __LINE__, "plot: set_char_size failed");
return -1;
}
if (-1 == SLang_pop_integer (&status))
{
isis_vmesg (FAIL, I_ERROR, __FILE__, __LINE__, "plot: set_char_size failed");
return -1;
}
return status;
}
static int is_paragraph_sep(void) /*{{{*/
{
int ret;
Jed_Buffer_Hook_Type *h = CBuf->buffer_hooks;
if ((h != NULL)
&& (h->par_sep != NULL))
{
if ((-1 == SLexecute_function(h->par_sep))
|| (-1 == SLang_pop_integer(&ret)))
ret = -1;
return ret;
}
push_spot ();
(void) bol ();
jed_skip_whitespace ();
if (eolp ())
{
pop_spot ();
return 1;
}
pop_spot ();
return 0;
}
int _pSLcall_eos_handler (void)
{
int err, status = 0;
if ((EOS_Callback_Handler == NULL)
|| (Handler_Active))
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (EOS_Callback_Handler)))
{
status = -1;
set_bos_eos_handlers (NULL, NULL);
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
/* int _pSLcall_debug_hook (char *file, int line, char *funct) */
int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int line)
{
int status = 0, err;
if (Debug_Hook == NULL)
return 0;
if (Debug_Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Debug_Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Debug_Hook)))
{
status = -1;
set_debug_hook (NULL);
}
Debug_Handler_Active--;
if (err)
(void) _pSLang_pop_error_context (status != 0);
return status;
}
int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line)
{
int status = 0;
int err;
if (BOS_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (file))
|| (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOS_Callback_Handler)))
{
set_bos_eos_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file)
{
int status = 0, err;
if (BOF_Callback_Handler == NULL)
return 0;
if (Handler_Active)
return 0;
if ((0 != (err = _pSLang_Error))
&& (-1 == _pSLang_push_error_context ()))
return -1;
Handler_Active++;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (fun))
|| (-1 == SLang_push_string (file))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (BOF_Callback_Handler)))
{
set_bof_eof_handlers (NULL, NULL);
status = -1;
}
Handler_Active--;
if (err)
_pSLang_pop_error_context (status != 0);
return status;
}
int indent_line ()
{
int n, n1;
static int in_function;
if (in_function) return -1;
if ((CBuf->buffer_hooks != NULL)
&& (CBuf->buffer_hooks->indent_hook != NULL))
{
in_function = 1;
SLexecute_function(CBuf->buffer_hooks->indent_hook);
in_function = 0;
return 1;
}
/* CHECK_READ_ONLY */
if (CLine == CBuf->beg) return(0);
push_spot();
CLine = CLine->prev;
get_current_indent (&n);
CLine = CLine->next;
indent_to(n);
pop_spot();
/* This moves the cursor to the first non whitspace char if we are
before it. Otherwise leave it alone */
n1 = calculate_column();
get_current_indent(&n);
if (n1 <= n) point_column(n + 1);
return 1;
}
static void verb_warn_func (const char *msg)
{
if (Verb_Warn_Func != NULL)
{
if (0 == SLang_push_string ((char *) msg))
SLexecute_function (Verb_Warn_Func);
}
}
static int execute_is_ok_hook (SLang_Name_Type *hook)
{
int ret;
if (-1 == SLexecute_function (hook))
return -1;
if (-1 == SLang_pop_integer (&ret))
return -1;
return (ret != 0);
}
static int execute_fun_with_args (SLang_Name_Type *nt, unsigned int argc,
char **argv)
{
unsigned int i;
(void) SLang_start_arg_list ();
for (i = 0; i < argc; i++)
(void) SLang_push_string (argv[i]);
(void) SLang_end_arg_list ();
return SLexecute_function (nt);
}
int user_open_source (char **argv, int argc, double area,
double cosx, double cosy, double cosz)
{
char *file;
int status;
if (-1 == init_slang ())
return -1;
file = argv[0];
if ((argc == 0) || (NULL == (file = argv[0])))
{
fprintf (stderr, "No filename specified for the slang source\n");
return -1;
}
if (0 != SLang_load_file (file))
{
fprintf (stderr, "Encountered a problem loading %s\n", file);
return -1;
}
if (NULL == (Open_Source = SLang_get_function ("user_open_source")))
{
fprintf (stderr, "%s failed to define user_open_source\n", file);
return -1;
}
if (NULL == (Create_Ray = SLang_get_function ("user_create_ray")))
{
fprintf (stderr, "%s failed to define user_create_ray\n", file);
return -1;
}
if ((-1 == SLang_start_arg_list ())
|| (-1 == push_c_string_array (argv, argc))
|| (-1 == SLang_push_double (area))
|| (-1 == SLang_push_double (cosx))
|| (-1 == SLang_push_double (cosy))
|| (-1 == SLang_push_double (cosz))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (Open_Source))
|| (-1 == SLang_pop_integer (&status)))
{
SLang_verror (0, "Error occured processing user_open_source in %s", file);
return -1;
}
return status;
}
static int mark_paragraph (Line **begp, Line **endp)
{
Jed_Buffer_Hook_Type *h = CBuf->buffer_hooks;
if ((h != NULL)
&& (h->mark_paragraph_hook != NULL))
{
int point;
Line *end;
if (-1 == SLexecute_function (h->mark_paragraph_hook))
return -1;
point = Point;
end = CLine;
if (Point && eobp ())
*endp = NULL;
else
*endp = end;
(void) jed_pop_mark (1);
*begp = CLine;
if ((end == CLine) && (point == Point))
return -1;
return 0;
}
if (is_paragraph_sep())
{
pop_spot();
return -1;
}
/* find end */
forward_paragraph();
if (Point && eobp ())
*endp = NULL;
else
*endp = CLine;
/* find paragraph start */
backward_paragraph();
if (is_paragraph_sep())
(void) jed_down (1);
*begp = CLine;
return 0;
}
int user_create_ray (double *delta_t, double *energy,
double *cosx, double *cosy, double *cosz)
{
if (Num_Rays == 0)
{
if (-1 == SLexecute_function (Create_Ray))
{
SLang_verror (0, "Encountered an error processing %s\n", "user_create_ray");
return -1;
}
if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
return -1; /* done */
if ((-1 == pop_array (&CosZ_Array))
|| (-1 == pop_array (&CosY_Array))
|| (-1 == pop_array (&CosX_Array))
|| (-1 == pop_array (&Energy_Array))
|| (-1 == pop_array (&dT_Array)))
{
SLang_verror (0, "Encountered an error processing %s\n", "user_create_ray");
return -1;
}
if (Num_Rays == 0)
return -1;
if (CosX_Array.num_elements < Num_Rays)
CosX_Array.di = 0;
if (CosY_Array.num_elements < Num_Rays)
CosY_Array.di = 0;
if (CosZ_Array.num_elements < Num_Rays)
CosZ_Array.di = 0;
if (dT_Array.num_elements < Num_Rays)
dT_Array.di = 0;
if (Energy_Array.num_elements < Num_Rays)
Energy_Array.di = 0;
}
*cosx = next_element (&CosX_Array);
*cosy = next_element (&CosY_Array);
*cosz = next_element (&CosZ_Array);
*delta_t = next_element (&dT_Array);
*energy = next_element (&Energy_Array);
Num_Rays--;
return 0;
}