SCM ffmpeg_crop_audio_frame_size(SCM scm_self, SCM scm_size)
{
struct ffmpeg_t *self = get_self(scm_self);
self->audio_target_frame->nb_samples = scm_to_int(scm_size);
self->audio_packed_frame->nb_samples = scm_to_int(scm_size);
return SCM_UNSPECIFIED;
}
static SCM
make_image (SCM name, SCM s_width, SCM s_height)
{
SCM smob;
struct image *image;
int width = scm_to_int (s_width);
int height = scm_to_int (s_height);
/* Step 1: Allocate the memory block.
*/
image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
/* Step 2: Initialize it with straight code.
*/
image->width = width;
image->height = height;
image->pixels = NULL;
image->name = SCM_BOOL_F;
image->update_func = SCM_BOOL_F;
/* Step 3: Create the smob.
*/
SCM_NEWSMOB (smob, image_tag, image);
/* Step 4: Finish the initialization.
*/
image->name = name;
image->pixels = scm_gc_malloc_pointerless (width * height, "image pixels");
return smob;
}
static SCM make_board (SCM s_width, SCM s_height) {
int i;
int j;
SCM smob;
struct board *board;
int width = scm_to_int(s_width);
int height = scm_to_int(s_height);
board = (struct board *) scm_gc_malloc(sizeof(struct board), "board");
board->width = width;
board->height = height;
board->update_func = SCM_BOOL_F;
board->cell_list = SCM_EOL;
for (i = height - 1; i >= 0; i--) {
SCM row = SCM_EOL;
for (j = width - 1; j >= 0; j--) {
SCM y_offset = scm_from_int(i);
SCM x_offset = scm_from_int(j);
row = scm_cons(make_cell(x_offset, y_offset, scm_from_int(0)), row);
}
board->cell_list = scm_cons(row, board->cell_list);
}
SCM_NEWSMOB(smob, board_tag, board);
return smob;
}
/*! \brief Get the action position.
* \par Function Description
* Retrieves the current action position and stores it in \a x and \a
* y, optionally snapping it to the grid if \a snap is true. This
* should be interpreted as the position that the user was pointing
* with the mouse pointer when the current action was invoked. If
* there is no valid world position for the current action, returns
* FALSE without modifying the output variables.
*
* This should be used by actions implemented in C to figure out where
* on the schematic the user wants them to apply the action.
*
* See also the (gschem action) Scheme module.
*
* \param w_current Current gschem toplevel structure.
* \param x Location to store x coordinate.
* \param y Location to store y coordinate.
*
* \return TRUE if current action position is set, FALSE otherwise.
*/
gboolean
g_action_get_position (gboolean snap, int *x, int *y)
{
SCM s_action_position_proc;
SCM s_point;
GschemToplevel *w_current = g_current_window ();
g_assert (w_current);
/* Get the action-position procedure */
s_action_position_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"action-position"));
/* Retrieve the action position */
s_point = scm_call_0 (s_action_position_proc);
if (scm_is_false (s_point)) return FALSE;
if (x) {
*x = scm_to_int (scm_car (s_point));
if (snap) {
*x = snap_grid (w_current, *x);
}
}
if (y) {
*y = scm_to_int (scm_cdr (s_point));
if (snap) {
*y = snap_grid (w_current, *y);
}
}
return TRUE;
}
SCM TTY::New(SCM fd, SCM readable){
CheckArgType(fd, scm_integer_p, "tty-new", 1);
CheckArgType(readable, scm_integer_p, "tty-new", 2);
TTY * t = new TTY(scm_to_int(fd), scm_to_int(readable));
assert(t!=NULL);
return t->smob;
}
//
// Send as a procedure, receive as a function that returns
// arbitrary types unrelated to input is an ugly abstraction:
//
SCM
guile_comm_send (SCM world, SCM dst, SCM tag, SCM obj)
{
size_t len;
char *buf;
// extract MPI_Comm, verifies the type:
MPI_Comm comm = scm_to_comm (world);
int idst = scm_to_int (dst);
int itag = scm_to_int (tag);
// searialize the object, dont forget to free() later:
buf = scm_to_byte_string (obj, &len);
assert (len < MAX_BUF_LENGTH);
// printf ("SEND:%s\n", buf);
// send just enough elements:
int ierr = MPI_Send (buf, len, MPI_CHAR, idst, itag, comm);
assert (MPI_SUCCESS==ierr);
free (buf);
return scm_from_int (ierr);
}
SCM
guile_comm_recv (SCM world, SCM src, SCM tag)
{
char buf[MAX_BUF_LENGTH];
// extract MPI_Comm, verifies the type:
MPI_Comm comm = scm_to_comm (world);
int isrc = scm_to_int (src);
int itag = scm_to_int (tag);
MPI_Status stat;
int ierr = MPI_Recv (buf, MAX_BUF_LENGTH, MPI_CHAR, isrc, itag, comm, &stat);
assert (MPI_SUCCESS==ierr);
// printf ("RECV:%s\n", buf);
// get the size of the received data:
int ilen;
ierr = MPI_Get_count (&stat, MPI_CHAR, &ilen);
assert (MPI_SUCCESS==ierr);
return scm_from_byte_string (buf, ilen);
}
static SCM
thit_new_model(SCM s_max_rows, SCM s_bds_disc, SCM s_n_cont, SCM s_dp_weight,
SCM s_init_crosstab, SCM s_lambda_a, SCM s_lambda_b)
{
int max_rows = scm_to_int(s_max_rows);
int n_cont = scm_to_int(s_n_cont);
double dp_weight = scm_to_double(s_dp_weight);
double init_crosstab = scm_to_double(s_init_crosstab);
double lambda_a = scm_to_double(s_lambda_a);
double lambda_b = scm_to_double(s_lambda_b);
int n_disc = scm_to_int(scm_length(s_bds_disc));
gsl_vector_int *bds_disc = gsl_vector_int_alloc(n_disc);
int i, b;
for (i = 0; i < n_disc; i++) {
b = scm_to_int(scm_list_ref(s_bds_disc, scm_from_int(i)));
gsl_vector_int_set(bds_disc, i, b);
}
banmi_model_t *model = new_banmi_model(max_rows, bds_disc, n_cont, dp_weight,
init_crosstab, lambda_a, lambda_b);
SCM smob;
SCM_NEWSMOB(smob, thit_model_tag, model);
return smob;
}
SCM scm_make_select_event_set(SCM nfds ,SCM size ,SCM type)
#define FUNC_NAME "make-event-set"
{
int t;
unsigned int n = 0;
int fd;
SCM_VALIDATE_NUMBER(1 ,nfds);
SCM_VALIDATE_NUMBER(2 ,size);
SCM_VALIDATE_NUMBER(3 ,type);
t = scm_to_int(type);
n = scm_to_uint(size);
fd = scm_to_int(nfds);
scm_rag_fd_set *rfd = (scm_rag_fd_set*)scm_gc_malloc(sizeof(scm_rag_fd_set));
scm_rag_select_event_set *ses =
(scm_rag_select_event_set*)scm_gc_malloc(sizeof(scm_rag_select_event_set),
"select-event-set");
ses->type = t;
ses->count = 0;
ses->size = n;
ses->nfds = fd;
ses->set = rfd;
return scm_rag_select_event_set2scm(ses);
}
SCM __api_build_projectile_prototype(SCM name, SCM speed, SCM w, SCM h, SCM longevity, SCM dmg)
{
char *s = scm_to_locale_string(name);
projectile *p = build_projectile_prototype(s, scm_to_double(speed), scm_to_int(w), scm_to_int(h), scm_to_int(longevity), scm_to_int(dmg));
free(s);
SCM ret = scm_new_smob(__api_projectile_tag, (unsigned long) p);
scm_gc_protect_object(ret);
return ret;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_window_size(SCM width, SCM height)
{
SCM_ASSERT (scm_is_integer (width), width, SCM_ARG1, "window-size");
SCM_ASSERT (scm_is_integer (height), height, SCM_ARG2, "window-size");
default_width = scm_to_int (width);
default_height = scm_to_int (height);
return SCM_BOOL_T;
}
SCM __api_make_fx(SCM type, SCM col, SCM x, SCM y, SCM dim, SCM radius, SCM speed)
{
color c = *((color *) SCM_SMOB_DATA(col));
SCM ret = scm_new_smob(__api_effect_tag,
(unsigned long) make_fx(scm_to_int(type), c,
scm_to_double(x), scm_to_double(y), scm_to_int(dim),
scm_to_int(radius), scm_to_double(speed)));
scm_gc_protect_object(ret);
return ret;
}
SCM Display::scm_draw_image(SCM image, SCM pos) {
#ifdef WITH_SDL
struct image *img = (struct image *) SCM_SMOB_DATA(image);
SDL_Rect p;
p.x = scm_to_int(scm_car(pos));
p.y = scm_to_int(scm_cadr(pos));
printf("%d, %d", img->surface, NULL);
SDL_BlitSurface(img->surface, NULL, get()->m_pScreen, &p);
#endif
}
static LLVMTypeRef function_type(SCM scm_return_type, SCM scm_argument_types)
{
int n_arguments = scm_ilength(scm_argument_types);
LLVMTypeRef *parameters = scm_gc_malloc_pointerless(n_arguments * sizeof(LLVMTypeRef), "make-llvm-function");
for (int i=0; i<n_arguments; i++) {
parameters[i] = llvm_type(scm_to_int(scm_car(scm_argument_types)));
scm_argument_types = scm_cdr(scm_argument_types);
};
return LLVMFunctionType(llvm_type(scm_to_int(scm_return_type)), parameters, n_arguments, 0);
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_image_size(SCM width, SCM height)
{
SCM_ASSERT (scm_is_integer (width), width, SCM_ARG1, "image-size");
SCM_ASSERT (scm_is_integer (height), height, SCM_ARG2, "image-size");
/* yes this is legit, we are casting the resulting double to an int */
default_image_width = scm_to_int (width);
default_image_height = scm_to_int (height);
return SCM_BOOL_T;
}
static SCM
game_resize_display (SCM game_smob, SCM s_width, SCM s_height)
{
Game *game = check_game (game_smob);
int width = scm_to_int (s_width);
int height = scm_to_int (s_height);
al_resize_display (game->display, width, height);
return SCM_UNSPECIFIED;
}
SCM mjpeg_to_yuv420p(SCM scm_source_ptr, SCM scm_shape, SCM scm_dest_ptr, SCM scm_offsets)
{
unsigned char *source_ptr = scm_to_pointer(scm_source_ptr);
unsigned char *dest_ptr = scm_to_pointer(scm_dest_ptr);
int width = scm_to_int(scm_cadr(scm_shape));
int height = scm_to_int(scm_car(scm_shape));
int64_t offsets[3];
memset(offsets, 0, sizeof(offsets));
scm_to_long_array(scm_offsets, offsets);
decode_jpeg_raw(source_ptr, width * height * 2, Y4M_ILACE_NONE, 0, width, height,
dest_ptr + offsets[0], dest_ptr + offsets[2], dest_ptr + offsets[1]);
return SCM_UNSPECIFIED;
}
SCM negate(SCM scm_ptr, SCM scm_stride, SCM scm_size)
{
int *p = (int *)scm_to_pointer(scm_ptr);
int s = scm_to_int(scm_stride);
int n = scm_to_int(scm_size);
ret = malloc(n * sizeof(int));
int *rend = ret + n;
int *r;
for (r=ret; r!=rend; r+=s, p+=s)
*r = -*p;
free(ret);
return SCM_UNDEFINED;
}
static void image_setup(SCM scm_type, enum AVPixelFormat *format, int *width, int *height,
uint8_t *data[], int32_t pitches[], void *ptr)
{
int i;
int64_t offsets[8];
memset(offsets, 0, sizeof(offsets));
*format = scm_to_int(scm_car(scm_type));
*width = scm_to_int(scm_cadadr(scm_type));
*height = scm_to_int(scm_caadr(scm_type)),
scm_to_long_array(scm_caddr(scm_type), offsets);
scm_to_int_array(scm_cadddr(scm_type), pitches);
for (i=0; i<8; i++) data[i] = (uint8_t *)ptr + offsets[i];
}
SCM
gucu_slk_set (SCM labnum, SCM label, SCM fmt)
{
SCM_ASSERT (scm_is_integer (labnum), labnum, SCM_ARG1, "slk-set");
SCM_ASSERT (scm_is_string (label), label, SCM_ARG2, "slk-set");
SCM_ASSERT (scm_is_integer (fmt), fmt, SCM_ARG3, "slk-set");
int c_labnum = scm_to_int (labnum);
char *c_label = scm_to_locale_string (label);
int c_fmt = scm_to_int (fmt);
int ret = slk_set (c_labnum, c_label, c_fmt);
RETURNTF (ret);
}
SCM
guile_comm_init (SCM args) // MPI_Init
{
int argc, i;
char **argv;
// count number of arguments:
argc = scm_to_int (scm_length (args));
argv = malloc ((argc + 1) * sizeof (char *));
argv[argc] = NULL;
for (i = 0; i < argc; i++)
{
argv[i] = scm_to_locale_string (scm_car (args));
args = scm_cdr (args);
}
int ierr = MPI_Init (&argc, &argv);
assert (MPI_SUCCESS==ierr);
/* FIXME: In fact we dont know if MPI_Init replaced the argv
completely and who is responsible for freeing these
resources. So we do not attempt to free them. */
return scm_from_comm (MPI_COMM_WORLD);
}
SCM scm_make_epoll_event_set(SCM size ,int epfd)
#define FUNC_NAME "make-epoll-event-set"
{
unsigned int n = 0;
int i;
int t;
struct epoll_event *ee_set = NULL;
scm_rag_epoll_event_set *ees = NULL;
SCM_VALIDATE_NUMBER(1 ,size);
n = scm_to_int(size);
ee_set = (struct epoll_event*)scm_gc_malloc(n*sizeof(struct epoll_event),
"rag-epoll-event-inner-set");
// NOTE: clear ee_set array to 0, it's CRITICAL!
memset(ee_set ,0 ,n*sizeof(struct epoll_event));
ees = (scm_rag_epoll_event_set*)scm_gc_malloc(sizeof(scm_rag_epoll_event_set),
"rag-epoll-event-set");
ees->size = n;
ees->count = 0;
ees->ee_set = ee_set;
ees->epfd = epfd;
return scm_rag_epoll_event_set2scm(ees);
}
struct t_hashtable *
weechat_guile_alist_to_hashtable (SCM alist, int hashtable_size)
{
struct t_hashtable *hashtable;
int length, i;
SCM pair;
hashtable = weechat_hashtable_new (hashtable_size,
WEECHAT_HASHTABLE_STRING,
WEECHAT_HASHTABLE_STRING,
NULL,
NULL);
if (!hashtable)
return NULL;
length = scm_to_int (scm_length (alist));
for (i = 0; i < length; i++)
{
pair = scm_list_ref (alist, scm_from_int (i));
weechat_hashtable_set (hashtable,
scm_i_string_chars (scm_list_ref (pair,
scm_from_int (0))),
scm_i_string_chars (scm_list_ref (pair,
scm_from_int (1))));
}
return hashtable;
}
static SCM api_set_status(SCM s_, SCM status_)
{
servlet *s = scm_to_pointer(s_);
int status = scm_to_int(status_);
set_status(s, status);
return SCM_UNSPECIFIED;
}
SCM allocation(SCM scm_size)
{
int n = scm_to_int(scm_size);
ret = malloc(n * sizeof(int));
free(ret);
return SCM_UNDEFINED;
}
static SCM
guile_sock_no_delay (SCM sock, SCM enable)
{
svz_socket_t *xsock;
int old = 0, set = 0;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if (xsock->proto & PROTO_TCP)
{
if (!SCM_UNBNDP (enable))
{
SCM_ASSERT (scm_is_bool (enable) || scm_is_integer (enable), enable,
SCM_ARG2, FUNC_NAME);
if ((scm_is_bool (enable) && scm_is_true (enable)) ||
(scm_is_integer (enable) && scm_to_int (enable) != 0))
set = 1;
}
if (svz_tcp_nodelay (xsock->sock_desc, set, &old) < 0)
old = 0;
else if (SCM_UNBNDP (enable))
svz_tcp_nodelay (xsock->sock_desc, old, NULL);
}
return SCM_BOOL (old);
}
SCM
thit_data_augmentation_x(SCM s_model, SCM s_n_iter) {
scm_assert_smob_type(thit_model_tag, s_model);
banmi_model_t *model = (banmi_model_t*)SCM_SMOB_DATA(s_model);
int n_iter = scm_to_int(s_n_iter);
banmi_data_augmentation(rng, model, n_iter);
return SCM_BOOL_T;
}
static GncOwnerType
get_owner_type_from_option (GNCOption *option)
{
SCM odata = gnc_option_get_option_data (option);
/* The option data is enum-typed. It's just the enum value. */
return (GncOwnerType) scm_to_int(odata);
}
SCM make_tensor(SCM scm_type, SCM scm_shape, SCM scm_size, SCM scm_source)
{
SCM retval;
struct tf_tensor_t *self = (struct tf_tensor_t *)scm_gc_calloc(sizeof(struct tf_tensor_t), "make-tensor");
SCM_NEWSMOB(retval, tf_tensor_tag, self);
int type = scm_to_int(scm_type);
int num_dims = scm_to_int(scm_length(scm_shape));
int64_t *dims = scm_gc_malloc_pointerless(sizeof(int64_t) * num_dims, "make-tensor");
int count = 1;
for (int i=0; i<num_dims; i++) {
dims[i] = scm_to_int(scm_car(scm_shape));
count = count * dims[i];
scm_shape = scm_cdr(scm_shape);
};
if (type == TF_STRING) {
SCM* pointer = scm_to_pointer(scm_source);
size_t encoded_size = 0;
for (int i=0; i<count; i++) {
encoded_size += TF_StringEncodedSize(scm_c_string_length(*pointer)) + 8;
pointer++;
};
self->tensor = TF_AllocateTensor(type, dims, num_dims, encoded_size);
int64_t *offsets = TF_TensorData(self->tensor);
int offset = 0;
void *result = offsets + count;
pointer = scm_to_pointer(scm_source);
encoded_size = encoded_size - count * sizeof(int64_t);
for (int i=0; i<count; i++) {
char *str = scm_to_locale_string(*pointer);
int len = TF_StringEncodedSize(scm_c_string_length(*pointer));
*offsets++ = offset;
TF_StringEncode(str, scm_c_string_length(*pointer), result, encoded_size, status());
free(str);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("make-tensor", TF_Message(_status), SCM_EOL);
offset += len;
encoded_size -= len;
result += len;
pointer++;
};
} else {
self->tensor = TF_AllocateTensor(type, dims, num_dims, scm_to_int(scm_size));
memcpy(TF_TensorData(self->tensor), scm_to_pointer(scm_source), scm_to_int(scm_size));
};
return retval;
}
SCM tf_set_attr_type(SCM scm_description, SCM scm_name, SCM scm_type)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrType(self->description, name, scm_to_int(scm_type));
free(name);
return SCM_UNDEFINED;
}
