static void
apply_gammq_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
double a, x, Q;
PEPOINTRIGHT( arg[1], &rhs );
a = PEGETREAL( &rhs );
PEPOINTRIGHT( arg[0], &rhs );
x = PEGETREAL( &rhs );
if( a <= 0 || x < 0 ) {
error_top( _( "Out of range." ) );
error_sub( _( "gammq arguments must be a > 0, x >= 0." ) );
reduce_throw( rc );
}
#ifdef HAVE_GSL
Q = gsl_sf_gamma_inc_Q( a, x );
#else /*!HAVE_GSL*/
error_top( _( "Not available." ) );
error_sub( _( "No GSL library available for gammq." ) );
reduce_throw( rc );
#endif /*HAVE_GSL*/
if( !heap_real_new( rc->heap, Q, out ) )
reduce_throw( rc );
}
/* Do "dir".
*/
static void
apply_dir_call( Reduce *rc, const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
PEPOINTRIGHT( arg[0], &rhs );
if( PEISCLASS( &rhs ) )
/* This is more complex than it looks. We have to walk a class
* instance generating a list of member names, while not
* destroying the instance as we go, in the case that out will
* overwrite (rhs) arg[0].
*/
reduce_safe_pointer( rc, (reduce_safe_pointer_fn) dir_object,
&rhs, out, NULL, NULL );
else if( PEISSYMREF( &rhs ) ) {
Symbol *sym = PEGETSYMREF( &rhs );
if( is_scope( sym ) && sym->expr && sym->expr->compile ) {
PElement list;
list = *out;
heap_list_init( &list );
icontainer_map( ICONTAINER( sym->expr->compile ),
(icontainer_map_fn) dir_scope, rc, &list );
}
}
else if( PEISREAL( &rhs ) ) {
/* Assume this is a gtype and try to get the children of that
* type.
*/
GType type = PEGETREAL( &rhs );
PElement list;
list = *out;
heap_list_init( &list );
if( !g_type_name( type ) ) {
error_top( _( "No such type" ) );
error_sub( _( "GType %u not found." ),
(unsigned int) type );
reduce_throw( rc );
}
if( vips_type_map( type, dir_gtype, rc, &list ) )
reduce_throw( rc );
}
else if( PEISMANAGEDGOBJECT( &rhs ) ) {
guint n_properties;
ManagedgobjectClass *class =
MANAGEDGOBJECT_GET_CLASS( PEGETMANAGEDGOBJECT( &rhs ) );
GParamSpec **properties;
properties = g_object_class_list_properties(
G_OBJECT_CLASS( class ), &n_properties );
dir_gobject( rc, properties, n_properties, out );
g_free( properties);
}
/* Make a VipsObject.
*/
void
vo_object_new( Reduce *rc, const char *name,
PElement *required, PElement *optional, PElement *out )
{
Vo *vo;
Managedgobject *managedgobject;
if( !(vo = vo_new( rc, name )) )
reduce_throw( rc );
if( !vo_args( vo, required, optional ) ) {
vo_free( vo );
reduce_throw( rc );
}
/* Ask the object to construct.
*/
if( vips_object_build( vo->object ) ) {
error_top( _( "VIPS library error." ) );
error_sub( "%s", im_error_buffer() );
im_error_clear();
vo_free( vo );
reduce_throw( rc );
}
/* Return the constructed object.
*/
if( !(managedgobject = managedgobject_new( vo->rc->heap,
G_OBJECT( vo->object ) )) ) {
vo_free( vo );
reduce_throw( rc );
}
PEPUTP( out, ELEMENT_MANAGED, managedgobject );
#ifdef DEBUG
{
char txt[1000];
VipsBuf buf = VIPS_BUF_STATIC( txt );
vips_object_to_string( vo->object, &buf );
printf( "vo_object_new: built %s\n", vips_buf_all( &buf ) );
}
#endif /*DEBUG*/
vo_free( vo );
}
/* Do a graph_export_image call.
*/
static void
apply_graph_export_image_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
#ifdef HAVE_LIBGOFFICE
PElement rhs;
double dpi;
Plot *plot;
Imageinfo *ii;
PEPOINTRIGHT( arg[1], &rhs );
dpi = PEGETREAL( &rhs );
PEPOINTRIGHT( arg[0], &rhs );
if( !reduce_is_instanceof( rc, CLASS_PLOT, &rhs ) ) {
char txt[100];
VipsBuf buf = VIPS_BUF_STATIC( txt );
itext_value_ev( rc, &buf, &rhs );
error_top( _( "Bad argument." ) );
error_sub( _( "Argument 2 to \"%s\" should "
"be instance of \"%s\", you passed:\n %s" ),
name, CLASS_PLOT,
vips_buf_all( &buf ) );
reduce_throw( rc );
}
plot = g_object_new( TYPE_PLOT, NULL );
if( !classmodel_update_members( CLASSMODEL( plot ), &rhs ) ) {
UNREF( plot );
reduce_throw( rc );
}
if( !(ii = plot_to_image( plot, rc, dpi )) ) {
UNREF( plot );
reduce_throw( rc );
}
UNREF( plot );
PEPUTP( out, ELEMENT_MANAGED, ii );
#else /*!HAVE_LIBGOFFICE*/
PEPUTP( out, ELEMENT_BOOL, TRUE );
#endif /*HAVE_LIBGOFFICE*/
}
/* Do a image call.
*/
static void
apply_image_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
Heap *heap = rc->heap;
PElement rhs;
char buf[FILENAME_MAX];
char filename[FILENAME_MAX];
char mode[FILENAME_MAX];
char *fn;
Imageinfo *ii;
/* Get string.
*/
PEPOINTRIGHT( arg[0], &rhs );
(void) reduce_get_string( rc, &rhs, buf, FILENAME_MAX );
/* The buf might be something like n3862.pyr.tif:1, ie. contain some
* load options. Split and search just for the filename component.
*/
im_filename_split( buf, filename, mode );
/* Try to load image from given string.
*/
if( !(fn = path_find_file( filename )) )
reduce_throw( rc );
/* Reattach the mode and load.
*/
im_snprintf( buf, FILENAME_MAX, "%s:%s", fn, mode );
if( !(ii = imageinfo_new_input(
main_imageinfogroup, NULL, heap, buf )) ) {
IM_FREE( fn );
reduce_throw( rc );
}
IM_FREE( fn );
PEPUTP( out, ELEMENT_MANAGED, ii );
MANAGED_UNREF( ii );
}
static void *
dir_scope( Symbol *sym, Reduce *rc, PElement *list )
{
PElement t;
if( !heap_list_add( rc->heap, list, &t ) ||
!heap_managedstring_new( rc->heap, IOBJECT( sym )->name, &t ) )
reduce_throw( rc );
(void) heap_list_next( list );
return( NULL );
}
/* Do "print".
*/
static void
apply_print_call( Reduce *rc, const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
char txt[MAX_STRSIZE];
VipsBuf buf = VIPS_BUF_STATIC( txt );
PEPOINTRIGHT( arg[0], &rhs );
itext_value_ev( rc, &buf, &rhs );
if( !heap_managedstring_new( rc->heap, vips_buf_all( &buf ), out ) )
reduce_throw( rc );
}
/* Do a math function (eg. sin, cos, tan).
*/
static void
apply_math_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
int i;
/* Find implementation.
*/
for( i = 0; i < IM_NUMBER( math_fn ); i++ )
if( strcmp( name, math_fn[i].name ) == 0 )
break;
if( i == IM_NUMBER( math_fn ) )
error( "internal error #928456936" );
/* Get arg type ... real/complex/image
*/
PEPOINTRIGHT( arg[0], &rhs );
if( PEISIMAGE( &rhs ) ) {
/* Easy ... pass to VIPS.
*/
call_spine( rc, math_fn[i].ifn, arg, out );
}
else if( PEISREAL( &rhs ) ) {
double a = PEGETREAL( &rhs );
double b = math_fn[i].rfn( a );
if( !heap_real_new( rc->heap, b, out ) )
reduce_throw( rc );
}
else if( PEISCOMPLEX( &rhs ) ) {
error_top( _( "Not implemented." ) );
error_sub( _( "Complex math ops not implemented." ) );
reduce_throw( rc );
}
else
error( "internal error #92870653" );
}
/* Do "error".
*/
static void
apply_error_call( Reduce *rc, const char *name, HeapNode **arg, PElement *out )
{
char buf[MAX_STRSIZE];
PElement rhs;
/* Get string.
*/
PEPOINTRIGHT( arg[0], &rhs );
(void) reduce_get_string( rc, &rhs, buf, MAX_STRSIZE );
error_top( _( "Macro error." ) );
error_sub( "%s", buf );
reduce_throw( rc );
}
/* Do a read call.
*/
static void
apply_read_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
char buf[FILENAME_MAX];
/* Get string.
*/
PEPOINTRIGHT( arg[0], &rhs );
(void) reduce_get_string( rc, &rhs, buf, FILENAME_MAX );
if( !heap_file_new( rc->heap, buf, out ) )
reduce_throw( rc );
}
/* Do a _ call. Args already spotted.
*/
static void
apply_underscore_call( Reduce *rc,
const char *name, HeapNode **arg, PElement *out )
{
PElement rhs;
char text[MAX_STRSIZE];
PEPOINTRIGHT( arg[0], &rhs );
(void) reduce_get_string( rc, &rhs, text, MAX_STRSIZE );
/* Pump though gettext.
*/
if( !heap_managedstring_new( rc->heap, _( text ), out ) )
reduce_throw( rc );
}
static void
dir_gobject( Reduce *rc,
GParamSpec **properties, guint n_properties, PElement *out )
{
int i;
PElement list;
list = *out;
heap_list_init( &list );
for( i = 0; i < n_properties; i++ ) {
PElement t;
if( !heap_list_add( rc->heap, &list, &t ) ||
!heap_managedstring_new( rc->heap,
properties[i]->name, &t ) )
reduce_throw( rc );
(void) heap_list_next( &list );
}
}
VipsBuf *
trace_push( void )
{
int i;
#ifdef DEBUG
printf( "trace_push: %d\n", trace_buffer_stack_p );
#endif
if( trace_buffer_stack_p >= SPINE_SIZE ) {
error_top( _( "Overflow error." ) );
error_sub( _( "Trace buffer stack overflow." ) );
reduce_throw( reduce_context );
}
i = trace_buffer_stack_p++;
vips_buf_init_dynamic( &trace_buffer_stack[i], MAX_TRACE );
return( &trace_buffer_stack[i] );
}
/* Do "search".
*/
static void
apply_search_call( Reduce *rc, const char *name, HeapNode **arg, PElement *out )
{
char buf[MAX_STRSIZE];
PElement rhs;
char *fn;
/* Get string.
*/
PEPOINTRIGHT( arg[0], &rhs );
(void) reduce_get_string( rc, &rhs, buf, MAX_STRSIZE );
if( !(fn = path_find_file( buf )) )
/* If not found, return [].
*/
fn = im_strdup( NULL, "" );
if( !heap_managedstring_new( rc->heap, fn, out ) ) {
IM_FREE( fn );
reduce_throw( rc );
}
IM_FREE( fn );
}
/* Run a VipsOperation. Like vo_object_new(), but we return the output args
* rather than the operation.
*/
void
vo_call( Reduce *rc, const char *name,
PElement *required, PElement *optional, PElement *out )
{
Vo *vo;
PElement pe;
if( !(vo = vo_new( rc, name )) )
reduce_throw( rc );
if( !vo_args( vo, required, optional ) ) {
vo_free( vo );
reduce_throw( rc );
}
/* Ask the object to construct. This can update vo->operation with an
* old one from the cache.
*/
if( vips_cache_operation_buildp( (VipsOperation **) &vo->object ) ) {
error_top( _( "VIPS library error." ) );
error_sub( "%s", im_error_buffer() );
im_error_clear();
vips_object_unref_outputs( vo->object );
vo_free( vo );
reduce_throw( rc );
}
/* We can't build the output object directly on out, since it might be
* one of our inputs. We use the safe Element in vo for the build,
* then copy at the end.
*/
/* Empty output list.
*/
PEPOINTE( &pe, &vo->out );
heap_list_init( &pe );
/* Append required outputs.
*/
if( vips_argument_map( VIPS_OBJECT( vo->object ),
(VipsArgumentMapFn) vo_get_required_output, vo, &pe ) ) {
vips_object_unref_outputs( vo->object );
vo_free( vo );
reduce_throw( rc );
}
/* Append optional outputs.
*/
if( !vo_get_optional( vo, optional, &pe ) ) {
vips_object_unref_outputs( vo->object );
vo_free( vo );
reduce_throw( rc );
}
/* Now write the output object to out.
*/
PEPUTE( out, &vo->out );
vips_object_unref_outputs( vo->object );
vo_free( vo );
}
