static void
game_process_event (Game *game)
{
static ALLEGRO_EVENT event;
al_wait_for_event(game->event_queue, &event);
if (event.type == ALLEGRO_EVENT_DISPLAY_CLOSE)
{
game->running = false;
}
else if (event.type == ALLEGRO_EVENT_TIMER)
{
game_update (game);
}
else if (event.type == ALLEGRO_EVENT_KEY_UP)
{
if (scm_is_true (game->on_key_released))
{
scm_call_1 (game->on_key_released, scm_from_int (event.keyboard.keycode));
}
}
else if (event.type == ALLEGRO_EVENT_KEY_DOWN)
{
if (scm_is_true (game->on_key_pressed))
{
scm_call_1 (game->on_key_pressed, scm_from_int (event.keyboard.keycode));
}
}
}
static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
SCM DLL_PUBLIC
cl_easy_perform (SCM handle, SCM bvflag, SCM headerflag)
{
handle_post_t *c_handle;
SCM data;
CURLcode status;
struct scm_flag body_sf, header_sf;
SCM_ASSERT (_scm_is_handle (handle), handle, SCM_ARG1, "%curl-easy-perform");
c_handle = _scm_to_handle (handle);
body_sf.flag = scm_is_true (bvflag);
#if SCM_MAJOR_VERSION == 2
if (body_sf.flag)
data = scm_c_make_bytevector (0);
else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#endif
body_sf.scm = data;
header_sf.flag = 0;
#if SCM_MAJOR_VERSION == 2
if (header_sf.flag)
data = scm_c_make_bytevector (0);
else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#endif
header_sf.scm = data;
if (scm_is_true (headerflag))
{
curl_easy_setopt (c_handle->handle, CURLOPT_HEADERFUNCTION, write_callback);
curl_easy_setopt (c_handle->handle, CURLOPT_HEADERDATA, &header_sf);
curl_easy_setopt (c_handle->handle, CURLOPT_ERRORBUFFER, error_string);
}
curl_easy_setopt (c_handle->handle, CURLOPT_WRITEFUNCTION, write_callback);
curl_easy_setopt (c_handle->handle, CURLOPT_WRITEDATA, &body_sf);
curl_easy_setopt (c_handle->handle, CURLOPT_ERRORBUFFER, error_string);
/* Do the transfer, and fill c_str with the result */
status = curl_easy_perform (c_handle->handle);
if (status != CURLE_OK)
{
error_code = status;
return (SCM_BOOL_F);
}
if (scm_is_true (headerflag))
return (scm_list_2 (header_sf.scm, body_sf.scm));
return (body_sf.scm);
}
static SCM
expand_eval_when (SCM expr, SCM env)
{
ASSERT_SYNTAX (scm_ilength (expr) >= 3, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (CADR (expr)) > 0, s_bad_expression, expr);
if (scm_is_true (scm_memq (sym_eval, CADR (expr)))
|| scm_is_true (scm_memq (sym_load, CADR (expr))))
return expand_sequence (CDDR (expr), env);
else
return VOID (scm_source_properties (expr));
}
static SCM
expand_env_ref_macro (SCM env, SCM x)
{
SCM var;
if (!expand_env_var_is_free (env, x))
return SCM_BOOL_F; /* lexical */
var = scm_module_variable (scm_current_module (), x);
if (scm_is_true (var) && scm_is_true (scm_variable_bound_p (var))
&& scm_is_true (scm_macro_p (scm_variable_ref (var))))
return scm_variable_ref (var);
else
return SCM_BOOL_F; /* anything else */
}
int test_cl_is_handle_p__handle (void)
{
SCM handle = cl_easy_init();
SCM ret = cl_is_handle_p(handle);
printf("test that cl_is_handle_p returns #t when passed a handle: %d\n", ret);
return scm_is_true(ret);
}
/*! \brief Evaluate a gschem action by name.
* \par Function Description
* Evaluates the action named \a action_name, which should be a UTF-8
* string naming a symbol in the user module. If evaluating the
* action fails, prints a message to the log and returns FALSE;
* otherwise, returns TRUE.
*
* \param w_current Current gschem toplevel structure.
* \param action_name Name of action to evaluate.
*
* \return TRUE on success, FALSE on failure.
*/
gboolean
g_action_eval_by_name (GschemToplevel *w_current, const gchar *action_name)
{
SCM s_eval_action_proc;
SCM s_expr;
SCM s_result;
gboolean result;
g_assert (w_current);
g_assert (action_name);
scm_dynwind_begin (0);
g_dynwind_window (w_current);
/* Get the eval-action procedure */
s_eval_action_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"eval-action!"));
/* Build expression to evaluate */
/* FIXME use SCM_SYMBOL for quote */
s_expr = scm_list_2 (s_eval_action_proc,
scm_list_2 (scm_from_utf8_symbol ("quote"),
scm_from_utf8_symbol (action_name)));
/* Evaluate and get return value */
s_result = g_scm_eval_protected (s_expr, SCM_UNDEFINED);
result = scm_is_true (s_result);
scm_dynwind_end ();
return result;
}
SCM tf_add_gradient_(SCM scm_graph, SCM scm_expression, SCM scm_variables)
{
SCM retval;
if (scm_is_true(scm_list_p(scm_variables))) {
struct tf_graph_t *graph = get_tf_graph(scm_graph);
struct tf_output_t *expression = get_tf_output(scm_expression);
int nvariables = scm_ilength(scm_variables);
TF_Output *variables = scm_gc_calloc(sizeof(TF_Output) * nvariables, "tf-add-gradient_");
for (int i=0; i<nvariables; i++) {
variables[i] = get_tf_output(scm_car(scm_variables))->output;
scm_variables = scm_cdr(scm_variables);
};
TF_Output *output = scm_gc_calloc(sizeof(TF_Output) * nvariables, "tf-add-gradient_");
TF_AddGradients(graph->graph, &expression->output, 1, variables, nvariables, NULL, status(), output);
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-add-gradient_", TF_Message(_status), SCM_EOL);
retval = SCM_EOL;
for (int i=nvariables-1; i>=0; i--) {
SCM element;
struct tf_output_t *result = scm_gc_calloc(sizeof(struct tf_output_t), "tf-add-gradient_");
SCM_NEWSMOB(element, tf_output_tag, result);
result->output = output[i];
retval = scm_cons(element, retval);
};
} else
retval = scm_car(tf_add_gradient_(scm_graph, scm_expression, scm_list_1(scm_variables)));
return retval;
}
SCM tf_run(SCM scm_session, SCM scm_input, SCM scm_output)
{
SCM retval;
if (scm_is_true(scm_list_p(scm_output))) {
struct tf_session_t *session = get_tf_session(scm_session);
int ninputs = scm_ilength(scm_input);
TF_Output *inputs = scm_gc_malloc(sizeof(TF_Output) * ninputs, "tf-run");
TF_Tensor **input_values = scm_gc_malloc(sizeof(TF_Tensor *) * ninputs, "tf-run");
for (int i=0; i<ninputs; i++) {
memcpy(&inputs[i], &get_tf_output(scm_caar(scm_input))->output, sizeof(TF_Output));
input_values[i] = get_tf_tensor(scm_cdar(scm_input))->tensor;
scm_input = scm_cdr(scm_input);
};
int noutputs = scm_ilength(scm_output);
TF_Output *output = scm_gc_malloc(sizeof(TF_Output) * noutputs, "tf-run");
TF_Tensor **output_values = scm_gc_malloc(sizeof(TF_Tensor *) * noutputs, "tf-run");
for (int i=0; i<noutputs; i++) {
output[i] = get_tf_output(scm_car(scm_output))->output;
scm_output = scm_cdr(scm_output);
};
TF_SessionRun(session->session, NULL, inputs, input_values, ninputs, output, output_values, noutputs, NULL, 0, NULL, status());
if (TF_GetCode(_status) != TF_OK)
scm_misc_error("tf-run", TF_Message(_status), SCM_EOL);
retval = SCM_EOL;
for (int i=noutputs-1; i>=0; i--) {
SCM element;
struct tf_tensor_t *result = (struct tf_tensor_t *)scm_gc_calloc(sizeof(struct tf_tensor_t), "make-tensor");
SCM_NEWSMOB(element, tf_tensor_tag, result);
result->tensor = output_values[i];
retval = scm_cons(element, retval);
};
} else
retval = scm_car(tf_run(scm_session, scm_input, scm_list_1(scm_output)));
return retval;
}
static SCM
game_run (SCM game_smob)
{
Game *game = check_game (game_smob);
if (scm_is_true (game->on_start)) {
scm_call_0 (game->on_start);
}
al_start_timer (game->timer);
game->last_update_time = al_get_time ();
while (game->running) {
game_process_event (game);
if (game->redraw && al_is_event_queue_empty (game->event_queue)) {
game->redraw = false;
game_draw (game);
}
}
game_destroy (game);
return SCM_UNSPECIFIED;
}
SCM
gfec_eval_string(const char *str, gfec_error_handler error_handler)
{
SCM result = SCM_UNDEFINED;
SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling");
if (scm_is_procedure(func))
{
char *err_msg = NULL;
SCM call_result, error = SCM_UNDEFINED;
call_result = scm_call_1 (func, scm_from_utf8_string (str));
error = scm_list_ref (call_result, scm_from_uint (1));
if (scm_is_true (error))
err_msg = gnc_scm_to_utf8_string (error);
else
result = scm_list_ref (call_result, scm_from_uint (0));
if (err_msg != NULL)
{
if (error_handler)
error_handler (err_msg);
free(err_msg);
}
}
return result;
}
static Expr* not(Expr* args) {
assert(args);
if(scm_list_len(args) != 1) return scm_mk_error("not expects 1 arg");
return scm_is_true(scm_car(args)) ? FALSE : TRUE;
}
/********************************************************************\
* gnc_is_trans_scm *
* returns true if the scm object is a scheme transaction *
* *
* Args: scm - a scheme object *
* Returns: true if scm is a scheme transaction *
\********************************************************************/
gboolean
gnc_is_trans_scm(SCM scm)
{
initialize_scm_functions();
return scm_is_true(scm_call_1(predicates.is_trans_scm, scm));
}
SCM
gfec_apply(SCM proc, SCM arglist, gfec_error_handler error_handler)
{
SCM result = SCM_UNDEFINED;
SCM func = scm_c_eval_string("gnc:apply-with-error-handling");
if (scm_is_procedure(func))
{
char *err_msg = NULL;
SCM call_result, error;
call_result = scm_call_2 (func, proc, arglist);
error = scm_list_ref (call_result, scm_from_uint (1));
if (scm_is_true (error))
err_msg = gnc_scm_to_utf8_string (error);
else
result = scm_list_ref (call_result, scm_from_uint (0));
if (err_msg != NULL)
{
if (error_handler)
error_handler (err_msg);
free(err_msg);
}
}
return result;
}
VISIBLE SCM
scm_rexp_number_of_subexpressions (SCM match)
{
return (scm_is_true (match)) ?
scm_from_size_t (rexp_num_subexpr (scm_to_rexp_match_t (match))) :
scm_from_int (0);
}
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);
}
/*! \brief Process a Scheme error into the log and/or a GError
* \par Function Description
* Process a captured Guile exception with the given \a s_key and \a
* s_args, and optionally the stack trace \a s_stack. The stack trace
* and source location are logged, and if a GError return location \a
* err is provided, it is populated with an informative error message.
*/
static void
process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err) {
char *long_message;
char *short_message;
SCM s_port, s_subr, s_message, s_message_args, s_rest, s_location;
/* Split s_args up */
s_rest = s_args;
s_subr = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message_args = scm_car (s_rest); s_rest = scm_cdr (s_rest);
/* Capture short error message */
s_port = scm_open_output_string ();
scm_display_error_message (s_message, s_message_args, s_port);
short_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Capture long error message (including possible backtrace) */
s_port = scm_open_output_string ();
if (scm_is_true (scm_stack_p (s_stack))) {
scm_puts (_("\nBacktrace:\n"), s_port);
scm_display_backtrace (s_stack, s_port, SCM_BOOL_F, SCM_BOOL_F);
scm_puts ("\n", s_port);
}
s_location = SCM_BOOL_F;
#ifdef HAVE_SCM_DISPLAY_ERROR_STACK
s_location = s_stack;
#endif /* HAVE_SCM_DISPLAY_ERROR_STACK */
#ifdef HAVE_SCM_DISPLAY_ERROR_FRAME
s_location =
scm_is_true (s_stack) ? scm_stack_ref (s_stack, SCM_INUM0) : SCM_BOOL_F;
#endif /* HAVE_SCM_DISPLAY_ERROR_FRAME */
scm_display_error (s_location, s_port, s_subr,
s_message, s_message_args, s_rest);
long_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Send long message to log */
s_log_message ("%s", long_message);
/* Populate any GError */
g_set_error (err, EDA_ERROR, EDA_ERROR_SCHEME, "%s", short_message);
}
static SCM
expand (SCM exp, SCM env)
{
if (scm_is_pair (exp))
{
SCM car;
scm_t_macro_primitive trans = NULL;
SCM macro = SCM_BOOL_F;
car = CAR (exp);
if (scm_is_symbol (car))
macro = expand_env_ref_macro (env, car);
if (scm_is_true (macro))
trans = scm_i_macro_primitive (macro);
if (trans)
return trans (exp, env);
else
{
SCM arg_exps = SCM_EOL;
SCM args = SCM_EOL;
SCM proc = CAR (exp);
for (arg_exps = CDR (exp); scm_is_pair (arg_exps);
arg_exps = CDR (arg_exps))
args = scm_cons (expand (CAR (arg_exps), env), args);
if (scm_is_null (arg_exps))
return CALL (scm_source_properties (exp),
expand (proc, env),
scm_reverse_x (args, SCM_UNDEFINED));
else
syntax_error ("expected a proper list", exp, SCM_UNDEFINED);
}
}
else if (scm_is_symbol (exp))
{
SCM gensym = expand_env_lexical_gensym (env, exp);
if (scm_is_true (gensym))
return LEXICAL_REF (SCM_BOOL_F, exp, gensym);
else
return TOPLEVEL_REF (SCM_BOOL_F, exp);
}
else
return CONST (SCM_BOOL_F, exp);
}
SCM tf_set_attr_bool(SCM scm_description, SCM scm_name, SCM scm_value)
{
struct tf_description_t *self = get_tf_description(scm_description);
char *name = scm_to_locale_string(scm_name);
TF_SetAttrBool(self->description, name, scm_is_true(scm_value));
free(name);
return SCM_UNDEFINED;
}
static SCM scm_bind_key(SCM mod_mask, SCM key, SCM proc)
{
xcb_keysym_t keysym;
if (scm_is_true(scm_number_p(key)))
keysym = scm_to_uint32(key);
else if (scm_is_true(scm_string_p(key))) {
scm_dynwind_begin(0);
char *c_key = scm_to_locale_string(key);
scm_dynwind_free(c_key);
keysym = get_keysym(c_key);
scm_dynwind_end();
}
else
return SCM_UNSPECIFIED;
bind_key(scm_to_uint16(mod_mask), keysym, proc);
return SCM_UNSPECIFIED;
}
static void
loop_set_after_draw_frame_func (SCM after_frame)
{
SCM var = scm_lookup (after_frame);
if (!scm_is_true (var) || !scm_is_true (scm_variable_p (var)))
{
g_critical ("invalid after frame func");
return;
}
SCM ref = guile_variable_ref_safe (var);
if (!scm_is_true (ref) || !scm_is_true (scm_procedure_p (ref)))
{
g_critical ("invalid after frame func");
return;
}
do_after_draw_frame = ref;
}
static void
game_draw (Game *game)
{
al_clear_to_color (al_map_rgb(0, 0, 0));
if (scm_is_true (game->on_draw))
scm_call_0 (game->on_draw);
al_flip_display ();
}
static gboolean
hook_remove_scm_runner (GHook *hook, gpointer data)
{
GncScmDangler *scm1 = data;
GncScmDangler *scm2 = hook->data;
SCM res;
res = scm_equal_p(scm1->proc, scm2->proc);
return(scm_is_true(res));
}
static void
inner_main_add_price_quotes(void *closure, int argc, char **argv)
{
SCM mod, add_quotes, scm_book, scm_result = SCM_BOOL_F;
QofSession *session = NULL;
scm_c_eval_string("(debug-set! stack 200000)");
mod = scm_c_resolve_module("gnucash price-quotes");
scm_set_current_module(mod);
load_gnucash_modules();
qof_event_suspend();
scm_c_eval_string("(gnc:price-quotes-install-sources)");
if (!gnc_quote_source_fq_installed())
{
g_print("%s", _("No quotes retrieved. Finance::Quote isn't "
"installed properly.\n"));
goto fail;
}
add_quotes = scm_c_eval_string("gnc:book-add-quotes");
session = gnc_get_current_session();
if (!session) goto fail;
qof_session_begin(session, add_quotes_file, FALSE, FALSE);
if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;
qof_session_load(session, NULL);
if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;
scm_book = gnc_book_to_scm(qof_session_get_book(session));
scm_result = scm_call_2(add_quotes, SCM_BOOL_F, scm_book);
qof_session_save(session, NULL);
if (qof_session_get_error(session) != ERR_BACKEND_NO_ERR) goto fail;
qof_session_destroy(session);
if (!scm_is_true(scm_result))
{
g_warning("Failed to add quotes to %s.", add_quotes_file);
goto fail;
}
qof_event_resume();
gnc_shutdown(0);
return;
fail:
if (session && qof_session_get_error(session) != ERR_BACKEND_NO_ERR)
g_warning("Session Error: %s", qof_session_get_error_message(session));
qof_event_resume();
gnc_shutdown(1);
}
/* Create a new plotter whose output and error are Guile ports */
SCM
gupl_newpl (SCM type, SCM outp, SCM errp, SCM param)
{
char *c_type;
FILE *c_outp, *c_errp;
plPlotter *ret;
plPlotterParams *c_param;
SCM_ASSERT (scm_is_string (type), type, SCM_ARG1, "newpl");
SCM_ASSERT (scm_is_true (scm_output_port_p (outp)), outp, SCM_ARG2,
"newpl");
SCM_ASSERT (scm_is_true (scm_output_port_p (errp)), errp, SCM_ARG3, "newpl");
SCM_ASSERT (_scm_is_plparams (param), param, SCM_ARG4, "newpl");
/* Convert the output port to a special stream */
c_outp = fopencookie (SCM2PTR (outp), "wb", port_funcs);
/* Don't buffer port here, since the underlying Guile port also has
port buffering. Double buffering causes problems. */
setvbuf (c_outp, NULL, _IONBF, 0);
if (c_outp == NULL)
scm_syserror ("newpl");
/* Convert the err port to a special stream */
c_errp = fopencookie (SCM2PTR (errp), "wb", port_funcs);
if (c_errp == NULL)
scm_out_of_range ("newpl", errp);
setvbuf (c_errp, NULL, _IONBF, 0);
c_type = scm_to_locale_string (type);
c_param = _scm_to_plparams (param);
ret = pl_newpl_r (c_type, NULL, c_outp, c_errp, c_param);
free (c_type);
if (ret == NULL)
return SCM_BOOL_F;
return _scm_from_plotter (ret);
}
static void
loop_set_game_update_func (SCM idle)
{
SCM var = scm_lookup (idle);
if (!scm_is_true (var) || !scm_is_true (scm_variable_p (var)))
{
g_critical ("invalid game update func");
return;
}
#if 0
SCM ref = guile_variable_ref_safe (var);
if (!scm_is_true (ref) || !scm_is_true (scm_procedure_p (ref)))
{
g_critical ("invalid game update func");
return;
}
#endif
scm_remember_upto_here_1(var);
do_idle = scm_variable_ref(scm_lookup(idle));
}
/*! \brief Guile callback for adding library functions.
* \par Function Description
* Callback function for the "component-library-funcs" Guile
* function, which can be used in the rc files to add a set of Guile
* procedures for listing and generating symbols.
*
* \param [in] listfunc A Scheme procedure which takes no arguments
* and returns a Scheme list of component names.
* \param [in] getfunc A Scheme procedure which takes a component
* name as an argument and returns a symbol
* encoded in a string in gEDA format, or the \b
* \#f if the component name is unknown.
* \param [in] name A descriptive name for this component source.
*
* \returns SCM_BOOL_T on success, SCM_BOOL_F otherwise.
*/
SCM g_rc_component_library_funcs (SCM listfunc, SCM getfunc, SCM name)
{
char *namestr;
SCM result = SCM_BOOL_F;
SCM_ASSERT (scm_is_true (scm_procedure_p (listfunc)), listfunc, SCM_ARG1,
"component-library-funcs");
SCM_ASSERT (scm_is_true (scm_procedure_p (getfunc)), getfunc, SCM_ARG2,
"component-library-funcs");
SCM_ASSERT (scm_is_string (name), name, SCM_ARG3,
"component-library-funcs");
namestr = scm_to_utf8_string (name);
if (s_clib_add_scm (listfunc, getfunc, namestr) != NULL) {
result = SCM_BOOL_T;
}
free (namestr);
return result;
}
static void
sf_flush (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM stream = SCM_PACK (pt->stream);
SCM f = SCM_SIMPLE_VECTOR_REF (stream, 2);
if (scm_is_true (f))
scm_call_0 (f);
}
SCM g_rc_print_color_map (SCM scm_map)
{
if (scm_map == SCM_UNDEFINED) {
return s_color_map_to_scm (print_colors);
}
SCM_ASSERT (scm_is_true (scm_list_p (scm_map)),
scm_map, SCM_ARG1, "print-color-map");
s_color_map_from_scm (print_colors, scm_map, "print-color-map");
return SCM_BOOL_T;
}
void gshmup_set_player_shooting (GshmupPlayer *player, bool shoot)
{
player->shooting = shoot;
if (shoot) {
if (scm_is_true (scm_procedure_p (player->on_shoot))) {
gshmup_schedule (player->entity.agenda, 0, player->on_shoot);
}
} else {
gshmup_clear_agenda (player->entity.agenda);
}
}
