/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_paper_sizes(SCM scm_papername, SCM scm_width, SCM scm_height)
#define FUNC_NAME "paper-sizes"
{
int width;
int height;
char *papername;
SCM ret;
SCM_ASSERT (scm_is_string (scm_papername), scm_papername,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (scm_width) && SCM_REALP (scm_width), scm_width,
SCM_ARG2, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (scm_height) && SCM_REALP (scm_height), scm_height,
SCM_ARG3, FUNC_NAME);
papername = SCM_STRING_CHARS (scm_papername);
width = (int) (scm_to_double (scm_width) * MILS_PER_INCH);
height = (int) (scm_to_double (scm_height) * MILS_PER_INCH);
if (!s_papersizes_uniq(papername)) {
ret = SCM_BOOL_F;
} else {
s_papersizes_add_entry(papername, width, height);
ret = SCM_BOOL_T;
}
return ret;
}
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;
}
/*! \todo Finish function description!!!
* \brief
* \par Function Description
*
* \param [in] width
* \param [in] height
* \param [in] border
* \return SCM_BOOL_T always.
*/
SCM g_rc_world_size(SCM width, SCM height, SCM border)
#define FUNC_NAME "world-size"
{
int i_width, i_height, i_border;
int init_right, init_bottom;
SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
SCM_ARG2, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (border) && SCM_REALP (border), border,
SCM_ARG3, FUNC_NAME);
/* yes this is legit, we are casing the resulting double to an int */
i_width = (int) (scm_to_double (width) * MILS_PER_INCH);
i_height = (int) (scm_to_double (height) * MILS_PER_INCH);
i_border = (int) (scm_to_double (border) * MILS_PER_INCH);
PAPERSIZEtoWORLD(i_width, i_height, i_border,
&init_right, &init_bottom);
#if DEBUG
printf("%d %d\n", i_width, i_height);
printf("%d %d\n", init_right, init_bottom);
#endif
default_init_right = init_right;
default_init_bottom = init_bottom;
return SCM_BOOL_T;
}
SCM script_ogre_set_position(SCM s_obj, SCM s_x, SCM s_y, SCM s_z)
{
void *obj = (void*)scm_to_uint64(s_obj);
float x = scm_to_double(s_x), y = scm_to_double(s_y), z = scm_to_double(s_z);
ogre_set_position(obj, x, y, z);
return scm_from_int32(1);
}
SCM __api_make_projectile(SCM name, SCM x, SCM y, SCM rotation, SCM spawned_by)
{
char *s = scm_to_locale_string(name);
item *sb = (item *) SCM_SMOB_DATA(spawned_by);
projectile *p = make_projectile(s, scm_to_double(x), scm_to_double(y), scm_to_double(rotation), sb);
free(s);
SCM ret = scm_new_smob(__api_projectile_tag, (unsigned long) p);
scm_gc_protect_object(ret);
return ret;
}
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;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_paper_size(SCM width, SCM height)
#define FUNC_NAME "paper-size"
{
SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
SCM_ARG2, FUNC_NAME);
/* yes this is legit, we are casting the resulting double to an int */
default_paper_width = (int) (scm_to_double (width) * MILS_PER_INCH);
default_paper_height = (int) (scm_to_double (height) * MILS_PER_INCH);
return SCM_BOOL_T;
}
static SCM
play_sample (SCM sample_smob, SCM s_gain, SCM s_pan, SCM s_speed)
{
Sample *sample = check_sample (sample_smob);
float gain = scm_to_double (s_gain);
float pan = scm_to_double (s_pan);
float speed = scm_to_double (s_speed);
if (sample->sample) {
al_play_sample (sample->sample, gain, pan, speed, ALLEGRO_PLAYMODE_ONCE, NULL);
}
return SCM_UNSPECIFIED;
}
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);
}
SCM tf_set_attr_float(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_SetAttrFloat(self->description, name, (float)scm_to_double(scm_value));
free(name);
return SCM_UNDEFINED;
}
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;
}
SCM ambient_light_range(SCM lower_bound, SCM upper_bound)
{
io_connect_t ioPort;
int leftLight, rightLight;
io_service_t serviceObject = IOServiceGetMatchingService(kIOMasterPortDefault, IOServiceMatching("AppleLMUController"));
if (serviceObject)
{
IOServiceOpen(serviceObject, mach_task_self(), 0, &ioPort);
IOObjectRelease(serviceObject);
}
IOConnectMethodScalarIScalarO(ioPort, 0, 0, 2, &leftLight, &rightLight);
return scm_from_int(((leftLight+rightLight)/4096.0 > scm_to_double(lower_bound)) &&
((leftLight+rightLight)/4096.0 < scm_to_double(upper_bound)));
}
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;
}
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;
}
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;
}
SCM tortoise_turn(SCM s_degrees)
{
int prevValue = (int)currentDirection;
double degrees;
SCM_ASSERT(SCM_NUMBERP(s_degrees), s_degrees, SCM_ARG1, "tortoise-turn");
//degrees = SCM_NUM2DOUBLE(s_degrees);
degrees = scm_to_double(s_degrees);
currentDirection += degrees;
return SCM_MAKINUM(prevValue);
}
bool updateMouseArea(guihckContext* ctx, guihckElementId id, void* data)
{
SCM x = guihckElementGetProperty(ctx, id, "absolute-x");
SCM y = guihckElementGetProperty(ctx, id, "absolute-y");
SCM w = guihckElementGetProperty(ctx, id, "width");
SCM h = guihckElementGetProperty(ctx, id, "height");
float px, py, pw, ph;
guihckMouseAreaGetRect(ctx, *((guihckMouseAreaId*) data), &px, &py, &pw, &ph);
if(scm_to_bool(scm_real_p(x))) px = scm_to_double(x);
if(scm_to_bool(scm_real_p(y))) py = scm_to_double(y);
if(scm_to_bool(scm_real_p(w))) pw = scm_to_double(w);
if(scm_to_bool(scm_real_p(h))) ph = scm_to_double(h);
guihckMouseAreaRect(ctx, *((guihckMouseAreaId*) data), px, py, pw, ph);
return false;
}
SCM ffmpeg_seek(SCM scm_self, SCM scm_position)
{
struct ffmpeg_t *self = get_self(scm_self);
if (!is_input_context(self))
scm_misc_error("ffmpeg-seek", "Attempt to seek in FFmpeg output video", SCM_EOL);
int64_t position = (int64_t)(scm_to_double(scm_position) * AV_TIME_BASE);
av_seek_frame(self->fmt_ctx, -1, position, AVSEEK_FLAG_ANY);// TODO: check error
return scm_position;
}
KvpValue *
gnc_scm_to_kvp_value_ptr(SCM val)
{
if (scm_is_rational(val))
{
if (scm_is_exact(val) &&
(scm_is_signed_integer(val, INT64_MIN, INT64_MAX) ||
scm_is_unsigned_integer(val, INT64_MIN, INT64_MAX)))
{
return new KvpValue{scm_to_int64(val)};
}
else if (scm_is_exact(val) &&
(scm_is_signed_integer(scm_numerator(val),
INT64_MIN, INT64_MAX) ||
scm_is_unsigned_integer(scm_numerator(val),
INT64_MIN, INT64_MAX)) &&
(scm_is_signed_integer(scm_denominator(val),
INT64_MIN, INT64_MAX) ||
(scm_is_unsigned_integer(scm_denominator(val),
INT64_MIN, INT64_MAX))))
{
return new KvpValue{gnc_scm_to_numeric(val)};
}
else
{
return new KvpValue{scm_to_double(val)};
}
}
else if (gnc_guid_p(val))
{
auto guid = gnc_scm2guid(val);
auto tmpguid = guid_copy(&guid);
return new KvpValue{tmpguid};
}
else if (gnc_timepair_p(val))
{
Timespec ts = gnc_timepair2timespec(val);
return new KvpValue{ts};
}
else if (scm_is_string(val))
{
return new KvpValue{gnc_scm_to_utf8_string(val)};
}
else if (SWIG_IsPointerOfType(val, SWIG_TypeQuery("_p_KvpFrame")))
{
#define FUNC_NAME G_STRFUNC
auto vp_frame = SWIG_MustGetPtr(val,
SWIG_TypeQuery("_p_KvpFrame"), 1, 0);
KvpFrame *frame = static_cast<KvpFrame*>(vp_frame);
#undef FUNC_NAME
return new KvpValue{frame};
}
/* FIXME: add list handler here */
return NULL;
}
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);
}
SCM tf_set_attr_float_list(SCM scm_description, SCM scm_name, SCM scm_values)
{
struct tf_description_t *self = get_tf_description(scm_description);
int num_values = scm_ilength(scm_values);
float *values = scm_gc_malloc(sizeof(float) * num_values, "tf-set-attr-float-list");
for (int i=0; i<num_values; i++) {
values[i] = (float)scm_to_double(scm_car(scm_values));
scm_values = scm_cdr(scm_values);
};
char *name = scm_to_locale_string(scm_name);
TF_SetAttrFloatList(self->description, name, values, num_values);
free(name);
return SCM_UNDEFINED;
}
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));
}
KvpValue *
gnc_scm_to_kvp_value_ptr(SCM val)
{
if (scm_is_number(val))
{
/* in guile 1.8 (exact? ) only works on numbers */
if (scm_is_exact (val) && gnc_gh_gint64_p(val))
{
return new KvpValue{scm_to_int64(val)};
}
else
{
return new KvpValue{scm_to_double(val)};
}
}
else if (gnc_numeric_p(val))
{
return new KvpValue{gnc_scm_to_numeric(val)};
}
else if (gnc_guid_p(val))
{
auto guid = gnc_scm2guid(val);
auto tmpguid = guid_copy(&guid);
return new KvpValue{tmpguid};
}
else if (gnc_timepair_p(val))
{
Timespec ts = gnc_timepair2timespec(val);
return new KvpValue{ts};
}
else if (scm_is_string(val))
{
return new KvpValue{gnc_scm_to_utf8_string(val)};
}
else if (SWIG_IsPointerOfType(val, SWIG_TypeQuery("_p_KvpFrame")))
{
#define FUNC_NAME G_STRFUNC
auto vp_frame = SWIG_MustGetPtr(val,
SWIG_TypeQuery("_p_KvpFrame"), 1, 0);
KvpFrame *frame = static_cast<KvpFrame*>(vp_frame);
#undef FUNC_NAME
return new KvpValue{frame};
}
/* FIXME: add list handler here */
return NULL;
}
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
}
VISIBLE void
scm_c_view_t1font_dict_set_x (SCM view, const char *key, const char *value)
{
const char *who = "scm_c_view_t1font_dict_set_x";
SplineFont *sf = (SplineFont *) scm_c_view_to_SplineFont (view);
switch (t1font_key (who, key))
{
case _t1font_FontName:
free (sf->fontname);
sf->fontname = xstrdup (value);
break;
case _t1font_PaintType:
sf->strokedfont = (scm_to_int (scm_c_postscript_to_number (value)) == 2);
break;
case _t1font_StrokeWidth:
sf->strokewidth = scm_to_double (scm_c_postscript_to_number (value));
break;
}
}
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;
}
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 tortoise_move(SCM s_steps)
{
double oldX = currentX;
double oldY = currentY;
double newX, newY;
double steps;
SCM_ASSERT(SCM_NUMBERP(s_steps), s_steps, SCM_ARG1, "tortoise-move");
//steps = SCM_NUM2DOUBLE(s_steps);
steps = scm_to_double(s_steps);
/* first work out the new endpoint */
newX = currentX + sin(currentDirection*DEGREES_TO_RADIANS) * steps;
newY = currentY - cos(currentDirection*DEGREES_TO_RADIANS) * steps;
/* if the pen is down, draw a line */
if (penDown)
XDrawLine(theDisplay, theWindow, theGC,
(int)currentX, (int)currentY,
(int)newX, (int)newY);
/* in either case, move the tortoise */
currentX = newX;
currentY = newY;
return gh_cons(gh_double2scm(oldX), gh_cons(gh_double2scm(oldY), SCM_EOL));
}
static LLVMValueRef scm_to_llvm_value(int type, SCM scm_value)
{
switch (type) {
case SCM_FOREIGN_TYPE_FLOAT:
case SCM_FOREIGN_TYPE_DOUBLE:
return LLVMConstReal(llvm_type(type), scm_to_double(scm_value));
case SCM_FOREIGN_TYPE_BOOL:
return LLVMConstInt(llvm_type(type), scm_is_true(scm_value), 0);
case SCM_FOREIGN_TYPE_UINT8:
case SCM_FOREIGN_TYPE_UINT16:
case SCM_FOREIGN_TYPE_UINT32:
case SCM_FOREIGN_TYPE_UINT64:
return LLVMConstInt(llvm_type(type), scm_to_uint64(scm_value), 0);
case SCM_FOREIGN_TYPE_INT8:
case SCM_FOREIGN_TYPE_INT16:
case SCM_FOREIGN_TYPE_INT32:
case SCM_FOREIGN_TYPE_INT64:
return LLVMConstInt(llvm_type(type), scm_to_int64(scm_value), 1);
default:
return NULL;
};
}
// Load one of data into the model. The vararg should be a list of values with
// length equal to the number of discrete columns plus the number of continuous
// columns. The first values in the vararg are taken to be discrete, followed
// by the continuous values.
//
SCM
thit_load_row_x(SCM s_model, SCM s_varargs) {
scm_assert_smob_type(thit_model_tag, s_model);
banmi_model_t *model = (banmi_model_t*)SCM_SMOB_DATA(s_model);
int n_col = model->n_disc + model->n_cont;
int n_args = scm_to_int(scm_length(s_varargs));
if (model->n_rows == model->disc->size1)
scm_error_scm(thit_error,
scm_from_locale_string("load-row!"),
scm_from_locale_string("The model is full, can't add more rows."),
scm_list_2(scm_from_int(n_col), scm_from_int(n_args)),
SCM_BOOL_F);
if (n_args != n_col)
scm_error_scm(thit_error,
scm_from_locale_string("load-row!"),
scm_from_locale_string("Expected ~A values, got ~A."),
scm_list_2(scm_from_int(n_col), scm_from_int(n_args)),
SCM_BOOL_F);
int j, ival;
for (j = 0; j < model->n_disc; j++) {
ival = scm_to_int(scm_list_ref(s_varargs, scm_from_int(j)));
gsl_matrix_int_set(model->disc, model->n_rows, j, ival);
}
double dval;
for (j = 0; j < model->n_cont; j++) {
dval = scm_to_double(scm_list_ref(s_varargs, scm_from_int(j + model->n_disc)));
gsl_matrix_set(model->cont, model->n_rows, j, dval);
}
model->n_rows++;
return SCM_BOOL_T;
}