static SCM tortoise_turn(SCM degrees)
{
const double value = scm_to_double(degrees);
direction += M_PI / 180.0 * value;
return scm_from_double(direction * 180.0 / M_PI);
}
static SCM tortoise_move(SCM length)
{
const double value = scm_to_double(length);
double newX, newY;
newX = x + value * cos(direction);
newY = y + value * sin(direction);
if(pendown)
draw_line(global_output, x, y, newX, newY);
x = newX;
y = newY;
return scm_list_2(scm_from_double(x), scm_from_double(y));
}
static SCM
game_get_time (SCM game_smob)
{
// We don't actually need to use the game struct here.
check_game (game_smob);
return scm_from_double (al_get_time ());
}
bool updateTimer(guihckContext* ctx, guihckElementId id, void* data)
{
(void) data;
bool running = scm_is_true(guihckElementGetProperty(ctx, id, "running"));
if(running)
{
double nextTimeout = scm_to_double(guihckElementGetProperty(ctx, id, "next-timeout"));
double current = guihckContextGetTime(ctx);
if(nextTimeout < 0)
{
double interval = scm_to_double(guihckElementGetProperty(ctx, id, "interval"));
guihckElementProperty(ctx, id, "next-timeout", scm_from_double(current + interval));
guihckElementProperty(ctx, id, "cycle", scm_from_int32(0));
}
else if(current >= nextTimeout)
{
int repeat = scm_to_int32(guihckElementGetProperty(ctx, id, "repeat"));
int cycle = scm_to_int32(guihckElementGetProperty(ctx, id, "cycle"));
cycle += 1;
if(repeat < 0 || repeat > cycle)
{
double interval = scm_to_double(guihckElementGetProperty(ctx, id, "interval"));
guihckElementProperty(ctx, id, "next-timeout", scm_from_double(nextTimeout + interval));
}
else
{
running = false;
guihckElementProperty(ctx, id, "next-timeout", scm_from_double(-1));
guihckElementProperty(ctx, id, "running", SCM_BOOL_F);
}
guihckElementProperty(ctx, id, "cycle", scm_from_int32(cycle));
SCM onTimeout = guihckElementGetProperty(ctx, id, "on-timeout");
guihckStackPushElement(ctx, id);
SCM expression = scm_list_2(onTimeout, scm_from_int32(cycle));
guihckContextExecuteExpression(ctx, expression);
guihckStackPopElement(ctx);
}
}
return running;
}
bool mouseAreaMouseMove(guihckContext* ctx, guihckElementId id, void* data, float sx, float sy, float dx, float dy)
{
(void) data;
(void) sx;
(void) sy;
(void) dx;
(void) dy;
bool handled = false;
SCM handler = guihckElementGetProperty(ctx, id, "on-mouse-move");
if(scm_to_bool(scm_procedure_p(handler)))
{
guihckStackPushElement(ctx, id);
SCM expression = scm_list_5(handler, scm_from_double(sx), scm_from_double(sy), scm_from_double(dx), scm_from_double(dy));
SCM result = guihckContextExecuteExpression(ctx, expression);
handled = scm_is_eq(result, SCM_BOOL_T);
guihckStackPopElement(ctx);
}
return handled;
}
bool mouseAreaMouseDown(guihckContext* ctx, guihckElementId id, void* data, int button, float x, float y)
{
(void) data;
(void) button;
(void) x;
(void) y;
bool handled = false;
guihckElementProperty(ctx, id, "pressed", SCM_BOOL_T);
SCM handler = guihckElementGetProperty(ctx, id, "on-mouse-down");
if(scm_to_bool(scm_procedure_p(handler)))
{
guihckStackPushElement(ctx, id);
SCM expression = scm_list_4(handler, scm_from_int8(button), scm_from_double(x), scm_from_double(y));
SCM result = guihckContextExecuteExpression(ctx, expression);
handled = scm_is_eq(result, SCM_BOOL_T);
guihckStackPopElement(ctx);
}
return handled;
}
SCM
thit_scm_from_vector(gsl_vector *v) {
SCM s_vector = scm_c_make_vector(v->size, SCM_BOOL_F);
int i;
for (i = 0; i < v->size; i++)
scm_vector_set_x(s_vector, scm_from_int(i),
scm_from_double(gsl_vector_get(v, i)));
return s_vector;
}
SCM calculate_context(SCM c)
{
float prob = 1.0;
int i = 0.0;
for(; i < scm_to_int(scm_length(c)); i++)
prob *= 1.0 - scm_to_double(scm_list_ref(c, scm_from_int(i)));
prob = 1 - prob;
return scm_from_double(prob);
}
//
// double guile_comm_pi (MPI_Comm world, int n);
//
SCM
guile_comm_pi (SCM world, SCM n)
{
// extract MPI_Comm, verifies the type:
MPI_Comm comm = scm_to_comm (world);
int N = scm_to_int (n);
// compute PI in parallel:
double dbl = pi (comm, N);
return scm_from_double (dbl);
}
static SCM sched_entry_time(SCM tag) {
SCM out;
char *target = scm_to_locale_string(tag);
scm_remember_upto_here_1(tag);
pthread_mutex_lock(&pmutex);
SCHED_EVENT *event = find_node(target);
free(target);
if (event != NULL)
out = time_at(scm_from_double(event->clock / (double)TIME_RES));
else out = SCM_BOOL_F;
pthread_mutex_unlock(&pmutex);
return out;
}
SCM pip_color_distance (SCM cR, SCM cG, SCM cB, SCM cR2, SCM cG2, SCM cB2)
{
double R = scm_to_double (cR);
double G = scm_to_double (cG);
double B = scm_to_double (cB);
double R2 = scm_to_double (cR2);
double G2 = scm_to_double (cG2);
double B2 = scm_to_double (cB2);
R /= 255.0;
G /= 255.0;
B /= 255.0;
R2 /= 255.0;
G2 /= 255.0;
B2 /= 255.0;
R = transform1 (R);
G = transform1 (G);
B = transform1 (B);
R2 = transform1 (R2);
G2 = transform1 (G2);
B2 = transform1 (B2);
double X = R * 0.4124 + G * 0.3576 + B * 0.1805;
double Y = R * 0.2126 + G * 0.7152 + B * 0.0722;
double Z = R * 0.0193 + G * 0.1192 + B * 0.9505;
double X2 = R2 * 0.4124 + G2 * 0.3576 + B2 * 0.1805;
double Y2 = R2 * 0.2126 + G2 * 0.7152 + B2 * 0.0722;
double Z2 = R2 * 0.0193 + G2 * 0.1192 + B2 * 0.9505;
Y /= REFY;
Z /= REFZ;
X /= REFX;
Y2 /= REFY;
Z2 /= REFZ;
X2 /= REFX;
double LL = 116.0 * transform2(Y) - 16.0;
double AA = 500.0 * (transform2(X) - transform2 (Y));
double BB = 200.0 * (transform2(Y) - transform2 (Z));
double LL2 = 116.0 * transform2(Y2) - 16.0;
double AA2 = 500.0 * (transform2(X2) - transform2 (Y2));
double BB2 = 200.0 * (transform2(Y2) - transform2 (Z2));
double dL = LL - LL2;
double dA = AA - AA2;
double dB = BB - BB2;
return scm_from_double (sqrt (dL * dL + dA * dA + dB * dB));
}
SCM
gnc_kvp_value_ptr_to_scm(KvpValue* val)
{
if (val == nullptr) return SCM_BOOL_F;
switch (val->get_type())
{
case KvpValue::Type::INT64:
return scm_from_int64(val->get<int64_t>());
break;
case KvpValue::Type::DOUBLE:
return scm_from_double (val->get<double>());
break;
case KvpValue::Type::NUMERIC:
return gnc_numeric_to_scm(val->get<gnc_numeric>());
break;
case KvpValue::Type::STRING:
{
auto string = val->get<const char*>();
return string ? scm_from_utf8_string(string) : SCM_BOOL_F;
break;
}
case KvpValue::Type::GUID:
{
auto tempguid = val->get<GncGUID*>();
return gnc_guid2scm(*tempguid);
}
break;
case KvpValue::Type::TIMESPEC:
return gnc_timespec2timepair(val->get<Timespec>());
break;
case KvpValue::Type::FRAME:
{
auto frame = val->get<KvpFrame*>();
if (frame != nullptr)
return SWIG_NewPointerObj(frame, SWIG_TypeQuery("_p_KvpFrame"), 0);
}
break;
case KvpValue::Type::GDATE:
return gnc_timespec2timepair(gdate_to_timespec(val->get<GDate>()));
/* FIXME: handle types below */
case KvpValue::Type::GLIST:
default:
break;
}
return SCM_BOOL_F;
}
static int
tick_cb (GtkWidget *widget, GdkFrameClock *frame_clock, void *user_data)
{
double cur_time;
if (quitting_flag)
return FALSE;
// cur_time = xg_timer_elapsed (timer);
cur_time = (double) gdk_frame_clock_get_frame_time (frame_clock) * 1.0e-6;
if (initialized_flag && !minimized_flag)
{
if (active_flag)
{
if (run_full_speed_flag || ((cur_time - before_draw_time) > REFRESH_RATE))
{
paint ();
if (do_after_draw_frame != SCM_UNSPECIFIED)
scm_call_1 (do_after_draw_frame, scm_from_double (after_draw_time));
draw_count ++;
before_draw_time = cur_time;
after_draw_time = (double) gdk_frame_clock_get_frame_time (frame_clock) * 1.0e-6;
if (draw_count % 1000 == 0)
{
measured_frame_rate
= 1000.0 / (after_draw_time - thousand_frames_draw_time);
thousand_frames_draw_time = after_draw_time;
g_debug ("Frame Rate: %f", measured_frame_rate);
}
}
if (!run_full_speed_flag)
xg_usleep (1000);
}
else
{
//audio_pause ();
// Figure out a way to sleep until the next gtk event comes in
}
}
return TRUE;
}
static SCM
_wrap_My_variable(SCM s_0)
{
#define FUNC_NAME "My-variable"
SCM gswig_result;
if (s_0 != SCM_UNDEFINED) {
{
My_variable = (double) scm_to_double(s_0);
}
}
{
gswig_result = scm_from_double(My_variable);
}
return gswig_result;
#undef FUNC_NAME
}
static gboolean idle_state_event_cb (void *dummy)
{
double cur_time;
if (quitting_flag)
return FALSE;
cur_time = xg_timer_elapsed (timer);
if (initialized_flag && !minimized_flag)
{
if (active_flag)
{
//audio_time_cur = cur_time;
if (run_full_speed_flag || ((cur_time - before_update_time) > UPDATE_RATE))
{
repl_tick ();
if (do_idle != SCM_UNSPECIFIED)
scm_call_1 (do_idle, scm_from_double (cur_time));
update_count ++;
before_update_time = cur_time;
after_update_time = xg_timer_elapsed (timer);
if (update_count % 1000 == 0)
{
measured_updates_rate
= 1000.0 / (after_update_time - thousand_updates_time);
thousand_updates_time = after_update_time;
g_debug ("Update Rate: %f", measured_updates_rate);
}
}
}
else
{
//audio_pause ();
// Figure out a way to sleep until the next gtk event comes in
}
/* if (!run_full_speed_flag) */
/* xg_usleep(10); */
}
return TRUE;
}
static SCM pg_decode(char *string, int dtype) {
switch (dtype) {
case 701:
case 1700:
case 700:
return scm_from_double(atof(string));
case 20:
case 21:
case 23:
return scm_from_signed_integer(atoi(string));
case 1114:
case 1184:
case 1082:
return decode_timestamp(string);
case 16:
case 1000:
return (string[0] == 't' ? SCM_BOOL_T : SCM_BOOL_F);
}
return safe_from_utf8(string);
}
static SCM g_get_duplicogram(void)
{
SCM lst = SCM_EOL;
uint64_t const nb_pkts = nb_nodups + nb_dups;
scm_dynwind_begin(0);
mutex_lock(&dup_lock);
scm_dynwind_unwind_handler(pthread_mutex_unlock_, &dup_lock.mutex, SCM_F_WIND_EXPLICITLY);
unsigned dt = bucket_width/2;
for (unsigned x = 0; x < nb_buckets; x++, dt += bucket_width) {
lst = scm_cons(
scm_cons(scm_from_uint(dt),
scm_from_double(nb_pkts > 0 ? (double)dups[x] / nb_pkts : 0.)),
lst);
}
dup_reset_locked();
scm_dynwind_end();
return lst;
}
VISIBLE SCM
scm_c_view_t1font_dict_ref (SCM view, const char *key)
{
const char *who = "scm_c_view_t1font_dict_ref";
SplineFont *sf = (SplineFont *) scm_c_view_to_SplineFont (view);
SCM result = SCM_UNDEFINED;
switch (t1font_key (who, key))
{
case _t1font_FontName:
result = scm_from_string_or_null (sf->fontname);
break;
case _t1font_PaintType:
result = scm_number_to_string (scm_from_int (sf->strokedfont ? 2 : 0),
scm_from_int (10));
break;
case _t1font_StrokeWidth:
result = scm_number_to_string (scm_from_double (sf->strokewidth),
scm_from_int (10));
break;
}
return result;
}
SCM
thit_scm_from_banmi_data(gsl_matrix_int *disc, gsl_matrix *cont, int n_rows) {
SCM s_rows = scm_c_make_vector(n_rows, SCM_BOOL_F);
int i, j;
for (i = 0; i < n_rows; i++) {
SCM this_row = scm_c_make_vector(disc->size2 + cont->size2, SCM_BOOL_F);
for (j = 0; j < disc->size2; j++) {
scm_vector_set_x(this_row, scm_from_int(j),
scm_from_int(gsl_matrix_int_get(disc, i, j)));
}
for (j = 0; j < cont->size2; j++) {
scm_vector_set_x(this_row, scm_from_int(j + disc->size2),
scm_from_double(gsl_matrix_get(cont, i, j)));
}
scm_vector_set_x(s_rows, scm_from_int(i), this_row);
}
return s_rows;
}
static void
guile_cb(char* name, char* value)
{
SCM value_scm;
char* tail;
/* try as an integer */
long int result = strtol(value, &tail, 0);
if (!(errno) && (*tail == '\0'))
value_scm = scm_from_long(result);
else
{
/* try as a float */
double result = strtod(value, &tail);
if (*tail == '\0')
value_scm = scm_from_double(result);
else
/* finally, a string */
value_scm = scm_from_locale_string(value);
}
scm_call_2(ship_item_cb, scm_from_locale_symbol(name), value_scm);
}
SCM py2scm(PyObject *value)
{
if (value == Py_None) {
return SCM_UNSPECIFIED;
}
if (PyBool_Check(value)) {
int v = PyObject_IsTrue(value);
if (v == -1)
return NULL;
return scm_from_bool(v);
}
if (PyInt_Check(value)) {
long v = PyInt_AsLong(value);
if (PyErr_Occurred())
return NULL;
return scm_from_long(v);
}
if (PyFloat_Check(value)) {
double v = PyFloat_AsDouble(value);
if (PyErr_Occurred())
return NULL;
return scm_from_double(v);
}
if (PyString_Check(value)) {
const char *s = PyString_AsString(value);
if (s == NULL)
return NULL;
return scm_from_utf8_stringn(s, PyString_Size(value));
}
if (PyUnicode_Check(value)) {
scm_dynwind_begin(0);
PyObject *utf8_str = PyUnicode_AsUTF8String(value);
if (utf8_str == NULL) {
scm_dynwind_end();
return NULL;
}
scm_dynwind_py_decref(utf8_str);
const char *s = PyString_AsString(utf8_str);
if (s == NULL) {
scm_dynwind_end();
return NULL;
}
SCM result = scm_from_utf8_stringn(s, PyString_Size(utf8_str));
scm_dynwind_end();
return result;
}
if (PySequence_Check(value)) {
unsigned int i = PySequence_Size(value);
SCM r = SCM_EOL;
while (i-- > 0) {
PyObject *item = PySequence_GetItem(value, i);
r = scm_cons(py2scm(item), r);
}
return r;
}
if (PyObject_TypeCheck(value, &ProcedureType))
return ((Procedure *)value)->proc;
if (PyCallable_Check(value)) {
SCM gsubr = scm_c_make_gsubr(
"<Python function>", 0, 0, 1, &call_callable);
Py_INCREF(value);
SCM ptr = scm_from_pointer(value, (void (*)(void *))Py_DecRef);
gsubr_alist = scm_acons(gsubr, ptr, gsubr_alist);
return gsubr;
}
char buf[BUFSIZ];
snprintf(buf, BUFSIZ, "Python type \"%.50s\" doesn't have a "
"corresponding Guile type",
value->ob_type->tp_name);
scm_error(scm_from_utf8_symbol("misc-error"), NULL, buf,
SCM_EOL, SCM_EOL);
/* does not return */
fprintf(stderr, "*** scm_error shouldn't have returned ***\n");
return SCM_UNSPECIFIED;
}
#include "player.h"
static GshmupPlayer *current_player = NULL;
SCM_VARIABLE_INIT (s_lives_per_credit, "*lives-per-credit*", scm_from_int (3));
SCM_VARIABLE_INIT (s_num_credits, "*num-credits*", scm_from_int (3));
SCM_VARIABLE_INIT (s_player_speed, "*player-speed*", scm_from_double (6));
SCM_VARIABLE (s_player_on_shoot, "*player-on-shoot*");
GshmupPlayer *
gshmup_create_player (GshmupAnimation *anim)
{
GshmupPlayer *player = (GshmupPlayer *) scm_gc_malloc (sizeof (GshmupPlayer),
"player");
player->entity = gshmup_create_entity ("Player");
player->shooting = false;
player->lives = scm_to_int (scm_variable_ref (s_lives_per_credit)) - 1;
player->credits = gshmup_get_initial_player_credits () - 1;
player->speed = scm_to_double (scm_variable_ref (s_player_speed));
player->score = 0;
player->on_shoot = scm_variable_ref (s_player_on_shoot);
player->on_game_over = NULL;
gshmup_player_stop (player);
player->entity.sprite = gshmup_create_sprite_animated (anim);
gshmup_sprite_play_animation (&player->entity.sprite);
return player;
}
void
gshmup_destroy_player (GshmupPlayer *player)
int main(int argc, char** argv)
{
if (!glfwInit())
return EXIT_FAILURE;
glfwWindowHint(GLFW_DEPTH_BITS, 24);
GLFWwindow* window = glfwCreateWindow(WIDTH, HEIGHT, "guihck-glhckElements", NULL, NULL);
if(!window)
{
return EXIT_FAILURE;
}
glfwMakeContextCurrent(window);
glfwSwapInterval(1);
glfwSetWindowCloseCallback(window, windowCloseCallback);
if(!glhckInit(argc, argv))
{
printf("GLHCK initialization error\n");
return EXIT_FAILURE;
}
glhckLogColor(0);
if(!glhckDisplayCreate(WIDTH, HEIGHT, 0))
{
printf("GLHCK display create error");
return EXIT_FAILURE;
}
glhckRenderClearColoru(128, 128, 128, 255);
guihckInit();
guihckContext* ctx = guihckContextNew();
guihckGlhckAddAllTypes(ctx);
guihckStackPushNewElement(ctx, "rectangle");
guihckStackElementProperty(ctx, "x", scm_from_double(200.0));
guihckStackElementProperty(ctx, "y", scm_from_double(100.0));
guihckStackElementProperty(ctx, "width", scm_from_double(50.0));
guihckStackElementProperty(ctx, "height", scm_from_double(75.0));
guihckStackElementProperty(ctx, "color", scm_list_3(scm_from_uint8(128), scm_from_uint8(52), scm_from_uint8(200)));
guihckStackPopElement(ctx);
guihckStackPushNewElement(ctx, "text");
guihckStackElementProperty(ctx, "x", scm_from_double(50.0));
guihckStackElementProperty(ctx, "y", scm_from_double(300.0));
guihckStackElementProperty(ctx, "text", scm_from_utf8_string("guihck rocks!"));
guihckStackElementProperty(ctx, "size", scm_from_double(100));
guihckStackElementProperty(ctx, "color", scm_list_3(scm_from_uint8(128), scm_from_uint8(52), scm_from_uint8(200)));
guihckStackPopElement(ctx);
while(RUNNING)
{
glfwPollEvents();
guihckContextUpdate(ctx);
glhckRenderClear(GLHCK_DEPTH_BUFFER_BIT | GLHCK_COLOR_BUFFER_BIT);
guihckContextRender(ctx);
glfwSwapBuffers(window);
}
guihckContextFree(ctx);
return EXIT_SUCCESS;
}
SCM square_wrapper(SCM x)
{
double t = scm_to_double(x);
return scm_from_double(t*t);
}
SCM sqrt_wrapper(SCM x)
{
return scm_from_double(sqrt(scm_to_double(x)));
}
static SCM db20(SCM db) {
return scm_from_double(pow(10.0, scm_to_double(db) / 20.0));
}
static SCM get_duty_cycle() {
if (use_jack)
return scm_from_double((double)jack_cpu_load(jack_client));
return scm_from_double(duty_cycle * 100);
}
