SCM
gmk_scm_from_vector2 (GmkVector2 v)
{
SCM smob;
GmkVector2 *new_v = (GmkVector2 *) scm_gc_malloc (sizeof (GmkVector2), "vector2");
*new_v = v;
SCM_NEWSMOB (smob, vector2_tag, new_v);
return smob;
}
SCM
gshmup_scm_from_vector2 (GshmupVector2 v)
{
SCM smob;
GshmupVector2 *new_v = (GshmupVector2 *) malloc (sizeof (GshmupVector2));
*new_v = v;
SCM_NEWSMOB (smob, vector2_tag, new_v);
return smob;
}
/*! \brief Create a new bindable key object.
* \par Function Description
* Create and return a new gschem key object from a \a keyval and a
* set of \a modifiers. If the key combination is invalid, return
* SCM_BOOL_F.
*
* \param keyval the pressed key.
* \param modifiers the active modifiers for the key.
*
* \return a new bindable key object, or SCM_BOOL_F.
*/
static SCM
g_make_key (guint keyval, GdkModifierType modifiers)
{
SCM result = SCM_BOOL_F;
if (g_key_is_valid (keyval, modifiers)) {
GschemKey *k = g_new0 (GschemKey, 1);
k->keyval = keyval;
k->modifiers = modifiers & GDK_MODIFIER_MASK;
SCM_NEWSMOB (result, g_key_smob_tag, k);
}
return result;
}
SCM
_scm_from_ssh_key (ssh_key key, SCM parent)
{
struct key_data *key_data;
SCM key_smob;
key_data = (struct key_data *) scm_gc_malloc (sizeof (struct key_data),
"ssh key");
key_data->ssh_key = key;
key_data->parent = parent;
SCM_NEWSMOB (key_smob, key_tag, key_data);
return key_smob;
}
SCM make_llvm_basic_block(SCM scm_function, SCM scm_name)
{
SCM retval;
struct llvm_function_t *function = get_llvm_function(scm_function);
struct llvm_basic_block_t *self;
self = (struct llvm_basic_block_t *)scm_gc_calloc(sizeof(struct llvm_basic_block_t), "llvm basic block");
SCM_NEWSMOB(retval, llvm_basic_block_tag, self);
char *name = scm_to_locale_string(scm_name);
self->basic_block = LLVMAppendBasicBlock(function->function, name);
free(name);
return retval;
}
static SCM scm_all_clients(void)
{
SCM clients = SCM_EOL;
SCM smob;
client_t *client = client_list;
while (client) {
SCM_NEWSMOB(smob, client_tag, client);
clients = scm_append(scm_list_2(clients, scm_list_1(smob)));
client = client->next;
}
return clients;
}
SCM make_description(SCM scm_graph, SCM scm_op, SCM scm_name)
{
SCM retval;
struct tf_graph_t *graph = get_tf_graph(scm_graph);
struct tf_description_t *self = (struct tf_description_t *)scm_gc_calloc(sizeof(struct tf_description_t), "make-description");
SCM_NEWSMOB(retval, tf_description_tag, self);
char *op = scm_to_locale_string(scm_op);
char *name = scm_to_locale_string(scm_name);
self->description = TF_NewOperation(graph->graph, op, name);
free(name);
free(op);
return retval;
}
SCM
_scm_from_plparams (plPlotterParams * x)
{
SCM s_plparams;
assert (x != NULL);
SCM_NEWSMOB (s_plparams, plparams_tag, x);
assert (x == (plPlotterParams *) SCM_SMOB_DATA (s_plparams));
return (s_plparams);
}
SCM
_scm_from_plotter (plPlotter * x)
{
SCM s_plotter;
assert (x != NULL);
SCM_NEWSMOB (s_plotter, plotter_tag, x);
assert (x == (plPlotter *) SCM_SMOB_DATA (s_plotter));
return (s_plotter);
}
SCM make_tf_session(SCM scm_graph)
{
SCM retval;
struct tf_session_t *self = (struct tf_session_t *)scm_gc_calloc(sizeof(struct tf_session_t), "make-tf-session");
SCM_NEWSMOB(retval, tf_session_tag, self);
self->graph = get_tf_graph(scm_graph);
TF_SessionOptions *options = TF_NewSessionOptions();
self->session = TF_NewSession(self->graph->graph, options, status());
TF_DeleteSessionOptions(options);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("make-tf-session", TF_Message(_status), SCM_EOL);
return retval;
}
SCM llvm_build_select(SCM scm_function, SCM scm_condition, SCM scm_value_if, SCM scm_value_else)
{
SCM retval;
struct llvm_value_t *self;
self = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvm value");
SCM_NEWSMOB(retval, llvm_value_tag, self);
struct llvm_function_t *function = get_llvm_function(scm_function);
struct llvm_value_t *condition = get_llvm_value(scm_condition);
struct llvm_value_t *value_if = get_llvm_value(scm_value_if );
struct llvm_value_t *value_else = get_llvm_value(scm_value_else);
self->value = LLVMBuildSelect(function->builder, condition->value, value_if->value, value_else->value, "x");
return retval;
}
/*! \brief Get a smob for a page.
* \ingroup guile_c_iface
* \par Function Description
* Create a new smob representing \a page.
*
* \param page #PAGE to create a smob for.
* \return a smob representing \a page.
*/
SCM
edascm_from_page (PAGE *page)
{
SCM smob;
SCM_NEWSMOB (smob, geda_smob_tag, page);
SCM_SET_SMOB_FLAGS (smob, GEDA_SMOB_PAGE);
/* Set weak reference */
s_page_weak_ref (page, smob_weakref_notify, smob);
return smob;
}
/*! \brief Get a smob for a configuration context.
* \ingroup guile_c_iface
* \par Function Description
* Create a new smob representing \a cfg.
*
* \param cfg Configuration context to create a smob for.
* \return a smob representing \a cfg.
*/
SCM
edascm_from_config (EdaConfig *cfg)
{
SCM smob = smob_cache_lookup (cfg);
if (EDASCM_CONFIGP (smob)) {
return smob;
}
SCM_NEWSMOB (smob, geda_smob_tag, g_object_ref (cfg));
SCM_SET_SMOB_FLAGS (smob, GEDA_SMOB_CONFIG);
return smob;
}
/*! \brief Get the smob for a TOPLEVEL.
* \ingroup guile_c_iface
* \par Function Description
* Create a new smob representing \a toplevel.
*
* \param toplevel #TOPLEVEL to create a smob for.
* \return a smob representing \a toplevel.
*/
SCM
edascm_from_toplevel (TOPLEVEL *toplevel)
{
SCM smob;
SCM_NEWSMOB (smob, geda_smob_tag, toplevel);
SCM_SET_SMOB_FLAGS (smob, GEDA_SMOB_TOPLEVEL);
/* Set weak reference */
s_toplevel_weak_ref (toplevel, smob_weakref_notify, smob);
return smob;
}
SCM make_ffmpeg_input(SCM scm_file_name, SCM scm_debug)
{
SCM retval;
struct ffmpeg_t *self;
scm_dynwind_begin(0);
const char *file_name = scm_to_locale_string(scm_file_name);
scm_dynwind_free(file_name);
self = (struct ffmpeg_t *)scm_gc_calloc(sizeof(struct ffmpeg_t), "ffmpeg");
self->video_stream_idx = -1;
self->audio_stream_idx = -1;
SCM_NEWSMOB(retval, ffmpeg_tag, self);
int err;
err = avformat_open_input(&self->fmt_ctx, file_name, NULL, NULL);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-input", "Error opening file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
};
err = avformat_find_stream_info(self->fmt_ctx, NULL);
if (err < 0) {
ffmpeg_destroy(retval);
scm_misc_error("make-ffmpeg-input", "No stream information in file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
};
// TODO: only open desired streams
// Open video stream
self->video_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_VIDEO, -1, -1, NULL, 0);
if (self->video_stream_idx >= 0)
self->video_codec_ctx = open_decoder(retval, scm_file_name, video_stream(self), "video");
// Open audio stream
self->audio_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_AUDIO, -1, -1, NULL, 0);
if (self->audio_stream_idx >= 0)
self->audio_codec_ctx = open_decoder(retval, scm_file_name, audio_stream(self), "audio");
// Print debug information
if (scm_is_true(scm_debug)) av_dump_format(self->fmt_ctx, 0, file_name, 0);
// Allocate input frames
self->video_target_frame = allocate_frame(retval);
self->audio_target_frame = allocate_frame(retval);
// Initialise data packet
av_init_packet(&self->pkt);
self->pkt.data = NULL;
self->pkt.size = 0;
scm_dynwind_end();
return retval;
}
SCM Display::scm_load_image(SCM file) {
SCM smob;
#ifdef WITH_SDL
struct image *img = (struct image *) scm_gc_malloc(sizeof(struct image), "image");
img->surface = IMG_Load(scm_to_locale_string(file));
if (!img->surface) {
std::cout << "Error loading image : "
<< IMG_GetError() << std::endl;
}
#endif
SCM_NEWSMOB(smob, get()->m_tImageTag, img);
return smob;
}
SCM make_llvm_function(SCM scm_llvm, SCM scm_return_type, SCM scm_name, SCM scm_argument_types)
{
SCM retval;
struct llvm_module_t *llvm = get_llvm(scm_llvm);
struct llvm_function_t *self;
self = (struct llvm_function_t *)scm_gc_calloc(sizeof(struct llvm_function_t), "llvm function");
SCM_NEWSMOB(retval, llvm_function_tag, self);
self->builder = LLVMCreateBuilder();
char *name = scm_to_locale_string(scm_name);
self->function = LLVMAddFunction(llvm->module, name, function_type(scm_return_type, scm_argument_types));
LLVMSetFunctionCallConv(self->function, LLVMCCallConv);
free(name);
return retval;
}
static SCM
make_x ()
{
static int i = 0;
SCM s_x;
x_t *c_x;
i++;
c_x = (x_t *) scm_gc_malloc (sizeof (x_t), "x");
c_x->scm_value = scm_from_int (i);
c_x->c_value = i;
SCM_NEWSMOB (s_x, x_tag, c_x);
return s_x;
}
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;
}
static void init_env(void) {
SCM smob;
char *ver;
SOURCE_HANDLE *handle;
init_log();
init_alsa_module();
ver = scm_to_locale_string(scm_version());
log_msg("Guile version %s\n", ver);
free(ver);
init_messaging(msg_port);
init_time();
init_json();
init_scheduler();
init_audiofile();
if (use_jack) init_jackport();
init_feeds();
init_recorder();
init_stream();
init_source_mod();
init_ladspa();
init_unitgen();
fader = (SOURCE_OBJ *)my_malloc(sizeof(SOURCE_OBJ), "main fader");
handle = (SOURCE_HANDLE *)my_gc_malloc(sizeof(SOURCE_HANDLE), "mains",
"mains");
handle->body = (void *)fader;
handle->src = fader;
init_source(fader);
mains_tag = scm_make_smob_type("mains", sizeof(SOURCE_OBJ));
SCM_NEWSMOB(smob, mains_tag, handle);
scm_c_define("mains", smob);
if (use_jack) {
scm_c_define("jack-client-name",
scm_from_locale_string(client_name));
scm_c_define_gsubr("patch-out", 2, 0, 0, patch_out);
scm_c_define_gsubr("unpatch-out", 2, 0, 0, unpatch_out);
}
scm_c_define_gsubr("quit", 0, 0, 0, qmx_quit);
scm_c_define_gsubr("db", 1, 0, 0, db20);
scm_c_define_gsubr("period-duty-cycle", 0, 0, 0, get_duty_cycle);
scm_permanent_object(console_display =
scm_c_eval_string(console_display_src));
scm_permanent_object(catch_display =
scm_c_eval_string(catch_display_src));
return;
}
SCM make_Segment2_line(SCM X1, SCM Y1, SCM X2, SCM Y2)
{
SCM smob;
Segment2 * seg;
DB_PRINTF("make_Segment2_line\n");
seg = malloc(sizeof(Segment2));
seg->type = LINE;
seg->s.line.start.x = scm_to_double(X1);
seg->s.line.start.y = scm_to_double(Y1);
seg->s.line.end.x = scm_to_double(X2);
seg->s.line.end.y = scm_to_double(Y2);
SCM_NEWSMOB( smob, tag_Segment2, seg);
return smob;
}
SCM make_cell (SCM s_x, SCM s_y, SCM s_status) {
SCM smob;
struct cell *cell;
int x = scm_to_int(s_x);
int y = scm_to_int(s_y);
int status = scm_to_int(s_status);
cell = (struct cell *)scm_gc_malloc(sizeof(struct cell), "cell");
cell->x = x;
cell->y = y;
cell->status = status;
cell->update_func = SCM_BOOL_F;
SCM_NEWSMOB(smob, cell_tag, cell);
return smob;
}
static SCM
guile_sock_referrer (SCM sock, SCM referrer)
{
SCM oreferrer = SCM_EOL;
svz_socket_t *xsock, *xreferrer;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xreferrer = svz_sock_getreferrer (xsock)) != NULL)
SCM_NEWSMOB (oreferrer, guile_svz_socket_tag, xreferrer);
if (!SCM_UNBNDP (referrer))
{
scm_assert_smob_type (guile_svz_socket_tag, referrer);
xreferrer = (svz_socket_t *) SCM_SMOB_DATA (referrer);
svz_sock_setreferrer (xsock, xreferrer);
}
return oreferrer;
}
static SCM
guile_sock_parent (SCM sock, SCM parent)
{
SCM oparent = SCM_EOL;
svz_socket_t *xsock, *xparent;
scm_assert_smob_type (guile_svz_socket_tag, sock);
xsock = (svz_socket_t *) SCM_SMOB_DATA (sock);
if ((xparent = svz_sock_getparent (xsock)) != NULL)
SCM_NEWSMOB (oparent, guile_svz_socket_tag, xparent);
if (!SCM_UNBNDP (parent))
{
scm_assert_smob_type (guile_svz_socket_tag, parent);
xparent = (svz_socket_t *) SCM_SMOB_DATA (parent);
svz_sock_setparent (xsock, xparent);
}
return oparent;
}
static SCM pg_open_primitive(SCM conninfo) {
SCM smob;
struct pg_conn *pgc;
char *conninfo_s;
conninfo_s = scm_to_locale_string(conninfo);
pgc = (struct pg_conn *)scm_gc_malloc(sizeof(struct pg_conn),
"pg_conn");
pgc->conn = PQconnectdb(conninfo_s);
free(conninfo_s);
if (PQstatus(pgc->conn) != CONNECTION_OK) {
log_msg("PQ connection failed: %s\n",
PQerrorMessage(pgc->conn));
PQfinish(pgc->conn);
pgc->conn = NULL;
}
pgc->mutex = scm_make_mutex();
SCM_NEWSMOB(smob, pg_conn_tag, pgc);
return smob;
}
SCM make_Segment2_arc(SCM ROT, SCM X, SCM Y, SCM Radius, SCM startTheta, SCM endTheta)
{
SCM smob;
Segment2 * seg;
DB_PRINTF("make_Segment2_arc\n");
seg = malloc(sizeof(Segment2));
seg->type = ARC;
seg->s.arc.angle.rot = scm_to_int16 (ROT );
seg->s.arc.angle.start = scm_to_double(startTheta);
seg->s.arc.angle.end = scm_to_double(endTheta );
seg->s.arc.radius = scm_to_double(Radius );
seg->s.arc.center.x = scm_to_double(X );
seg->s.arc.center.y = scm_to_double(Y );
SCM_NEWSMOB( smob, tag_Segment2, seg);
return smob;
}
static SCM
load_sample (SCM s_file)
{
SCM smob;
const char *file = scm_to_locale_string (s_file);
Sample *sample = (Sample *) scm_gc_malloc (sizeof (Sample), "sample");
sample->sample = NULL;
SCM_NEWSMOB (smob, sample_tag, sample);
sample->sample = al_load_sample (file);
if (!sample->sample) {
fprintf (stderr, "failed to load audio sample: %s\n", file);
}
return smob;
}
SCM
_scm_from_termios (struct termios *x)
{
SCM s_termios;
assert (x != NULL);
SCM_NEWSMOB (s_termios, termios_tag, x);
assert (x == (struct termios *) SCM_SMOB_DATA (s_termios));
#if 0
if (0)
{
fprintf (stderr, "Making smob from termios based on *%p\n", x);
}
#endif
return (s_termios);
}
/*! \brief Get a smob for a page.
* \ingroup guile_c_iface
* \par Function Description
* Create a new smob representing \a page.
*
* \param page #PAGE to create a smob for.
* \return a smob representing \a page.
*/
SCM
edascm_from_page (PAGE *page)
{
SCM smob = smob_cache_lookup (page);
if (EDASCM_PAGEP (smob)) {
return smob;
}
SCM_NEWSMOB (smob, geda_smob_tag, page);
SCM_SET_SMOB_FLAGS (smob, GEDA_SMOB_PAGE);
/* Set weak reference */
s_page_weak_ref (page, smob_weakref_notify,
unpack_as_pointer (smob));
smob_cache_add (page, smob);
return smob;
}
SCM llvm_build_call(SCM scm_function, SCM scm_llvm, SCM scm_return_type, SCM scm_function_name, SCM scm_argument_types, SCM scm_values)
{
SCM retval;
struct llvm_function_t *function = get_llvm_function(scm_function);
struct llvm_module_t *llvm = get_llvm(scm_llvm);
char *function_name = scm_to_locale_string(scm_function_name);
LLVMValueRef function_pointer = LLVMAddFunction(llvm->module, function_name, function_type(scm_return_type, scm_argument_types));
free(function_name);
// LLVMAddFunctionAttr(function_pointer, LLVMExternalLinkage);
int n_values = scm_ilength(scm_values);
LLVMValueRef *values = scm_gc_malloc_pointerless(n_values * sizeof(LLVMValueRef), "llvm-build-call");
for (int i=0; i<n_values; i++) {
values[i] = get_llvm_value(scm_car(scm_values))->value;
scm_values = scm_cdr(scm_values);
};
struct llvm_value_t *result = (struct llvm_value_t *)scm_gc_calloc(sizeof(struct llvm_value_t), "llvmvalue");
SCM_NEWSMOB(retval, llvm_value_tag, result);
result->value = LLVMBuildCall(function->builder, function_pointer, values, n_values, "x");
return retval;
}
