SCM get_neighbors (SCM board_smob, SCM cell_smob) {
struct board *board;
struct cell *cell;
SCM list;
SCM neighbor;
int i;
int j;
int x;
int y;
scm_assert_smob_type(board_tag, board_smob);
scm_assert_smob_type(cell_tag, cell_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
list = SCM_EOL;
for (i = -1; i < 2; i++) {
for (j = -1; j < 2; j++) {
if (i == 0 && j == 0) {
continue;
}
x = cell->x + i;
y = cell->y + j;
if (x >= 0 && x < board->width && y >= 0 && y < board->height) {
neighbor = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(y)), scm_from_int(x));
list = scm_cons(neighbor, list);
}
}
}
return list;
}
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;
}
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;
}
SCM status_list (SCM board_smob) {
struct board *board;
struct cell *cell;
int i;
int j;
SCM cell_smob;
SCM list;
SCM row;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
list = SCM_EOL;
for (i = board->height - 1; i >= 0; i--) {
row = SCM_EOL;
for (j = board->width - 1; j >= 0; j--) {
cell_smob = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(j)), scm_from_int(i));
cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
row = scm_cons(get_status(cell_smob), row);
}
list = scm_cons(row, list);
}
return list;
}
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;
}
/*! \brief read the configuration string list for the component dialog
* \par Function Description
* This function reads the string list from the component-dialog-attributes
* configuration parameter and converts the list into a GList.
* The GList is stored in the global default_component_select_attrlist variable.
*/
SCM g_rc_component_dialog_attributes(SCM stringlist)
{
int length, i;
GList *list=NULL;
gchar *attr;
SCM_ASSERT(scm_list_p(stringlist), stringlist, SCM_ARG1, "scm_is_list failed");
length = scm_ilength(stringlist);
/* If the command is called multiple times, remove the old list before
recreating it */
g_list_foreach(default_component_select_attrlist, (GFunc)g_free, NULL);
g_list_free(default_component_select_attrlist);
/* convert the scm list into a GList */
for (i=0; i < length; i++) {
SCM_ASSERT(scm_is_string(scm_list_ref(stringlist, scm_from_int(i))),
scm_list_ref(stringlist, scm_from_int(i)), SCM_ARG1,
"list element is not a string");
attr = g_strdup(SCM_STRING_CHARS(scm_list_ref(stringlist, scm_from_int(i))));
list = g_list_prepend(list, attr);
}
default_component_select_attrlist = g_list_reverse(list);
return SCM_BOOL_T;
}
SCM get_cell (SCM board_smob, SCM s_x, SCM s_y) {
struct board *board;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
return scm_list_ref(scm_list_ref(board->cell_list, s_y), s_x);
}
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;
}
struct t_hashtable *
weechat_guile_alist_to_hashtable (SCM alist, int size, const char *type_keys,
const char *type_values)
{
struct t_hashtable *hashtable;
int length, i;
SCM pair;
char *str, *str2;
hashtable = weechat_hashtable_new (size,
type_keys,
type_values,
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));
if (strcmp (type_values, WEECHAT_HASHTABLE_STRING) == 0)
{
str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
weechat_hashtable_set (hashtable, str, str2);
if (str)
free (str);
if (str2)
free (str2);
}
else if (strcmp (type_values, WEECHAT_HASHTABLE_POINTER) == 0)
{
str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
weechat_hashtable_set (hashtable, str,
plugin_script_str2ptr (weechat_guile_plugin,
NULL, NULL, str2));
if (str)
free (str);
if (str2)
free (str2);
}
}
return hashtable;
}
/*! \todo Finish function description!!!
* \brief
* \par Function Description
*
* \param [in] attrlist
* \return SCM_BOOL_T always.
*/
SCM g_rc_always_promote_attributes(SCM attrlist)
{
GList *list=NULL;
int length, i;
gchar *attr;
gchar **attr2;
g_list_foreach(default_always_promote_attributes, (GFunc)g_free, NULL);
g_list_free(default_always_promote_attributes);
if (scm_is_string (attrlist)) {
char *temp;
s_log_message(_("WARNING: using a string for 'always-promote-attributes'"
" is deprecated. Use a list of strings instead\n"));
/* convert the space separated strings into a GList */
temp = scm_to_utf8_string (attrlist);
attr2 = g_strsplit(temp," ", 0);
free (temp);
for (i=0; attr2[i] != NULL; i++) {
if (strlen(attr2[i]) > 0) {
list = g_list_prepend(list, g_strdup(attr2[i]));
}
}
g_strfreev(attr2);
} else {
SCM_ASSERT(scm_list_p(attrlist), attrlist, SCM_ARG1, "always-promote-attributes");
length = scm_ilength(attrlist);
/* convert the scm list into a GList */
for (i=0; i < length; i++) {
char *temp;
SCM_ASSERT(scm_is_string(scm_list_ref(attrlist, scm_from_int(i))),
scm_list_ref(attrlist, scm_from_int(i)), SCM_ARG1,
"always-promote-attribute: list element is not a string");
temp = scm_to_utf8_string (scm_list_ref (attrlist, scm_from_int (i)));
attr = g_strdup(temp);
free (temp);
list = g_list_prepend(list, attr);
}
}
default_always_promote_attributes = g_list_reverse(list);
return SCM_BOOL_T;
}
SCM apply_rule (SCM board_smob, SCM rule_func) {
SCM cell;
struct board *board;
int i;
int j;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
for (i = 0; i < board->height; i++) {
for (j = 0; j < board->width; j++) {
cell = scm_list_ref(scm_list_ref(board->cell_list, scm_from_int(j)), scm_from_int(i));
scm_call_2(rule_func, cell, get_living_neighbors(board_smob, cell));
}
}
return SCM_UNSPECIFIED;
}
SCM clear_board (SCM board_smob) {
int i;
int j;
struct board *board;
struct cell *cell;
scm_assert_smob_type(board_tag, board_smob);
board = (struct board *) SCM_SMOB_DATA(board_smob);
for (i = 0; i < board->height; i++) {
SCM row = scm_list_ref(board->cell_list, scm_from_int(i));
for (j = 0; j < board->width; j++) {
cell = (struct cell *) SCM_SMOB_DATA(scm_list_ref(row, scm_from_int(j)));
cell->status = 0;
}
}
scm_remember_upto_here_1(board_smob);
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;
/* Deal with the possibility that scm_from_utf8_string will
* throw, falling back to scm_from_locale_string. If that fails, log a
* warning and punt.
*/
SCM scm_string = scm_internal_catch(SCM_BOOL_T,
gfec_string_from_utf8, (void*)str,
gfec_string_inner_handler,
(void*)str);
if (!scm_string)
{
error_handler("Contents could not be interpreted as UTF-8 or the current locale/codepage.");
return result;
}
call_result = scm_call_1 (func, scm_string);
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 void
gnc_column_view_edit_size_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
GtkWidget * rowspin;
GtkWidget * colspin;
GtkWidget * dlg;
GladeXML *xml;
SCM current;
int length;
int dlg_ret;
xml = gnc_glade_xml_new ("report.glade", "Edit Report Size");
dlg = glade_xml_get_widget (xml, "Edit Report Size");
/* get the spinner widgets */
rowspin = glade_xml_get_widget (xml, "row_spin");
colspin = glade_xml_get_widget (xml, "col_spin");
length = scm_ilength(r->contents_list);
if (length > r->contents_selected)
{
current = scm_list_ref(r->contents_list,
scm_int2num(r->contents_selected));
gtk_spin_button_set_value(GTK_SPIN_BUTTON(colspin),
(float)scm_num2int(SCM_CADR(current),
SCM_ARG1, G_STRFUNC));
gtk_spin_button_set_value(GTK_SPIN_BUTTON(rowspin),
(float)scm_num2int(SCM_CADDR(current),
SCM_ARG1, G_STRFUNC));
dlg_ret = gtk_dialog_run(GTK_DIALOG(dlg));
gtk_widget_hide(dlg);
if (dlg_ret == GTK_RESPONSE_OK)
{
current = SCM_LIST4(SCM_CAR(current),
scm_int2num(gtk_spin_button_get_value_as_int
(GTK_SPIN_BUTTON(colspin))),
scm_int2num(gtk_spin_button_get_value_as_int
(GTK_SPIN_BUTTON(rowspin))),
SCM_BOOL_F);
scm_gc_unprotect_object(r->contents_list);
r->contents_list = scm_list_set_x(r->contents_list,
scm_int2num(r->contents_selected),
current);
scm_gc_protect_object(r->contents_list);
gnc_options_dialog_changed (r->optwin);
update_display_lists(r);
}
gtk_widget_destroy(dlg);
}
}
void print_scheme_list(SCM lst){
/* Calculate the size of the list returned from Scheme */
int i, length;
length = scm_to_int(scm_length (lst));
/* Start from 1 as the zero-th element only denotes query type */
for(i = 1; i < length; i++){
SCM elm = scm_list_ref(lst, scm_from_int(i));
char *anton = scm_to_locale_string (elm);
printf("%s ", anton);
}
printf("\n");
}
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);
}
// 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;
}
SCM get_living_neighbors (SCM board_smob, SCM cell_smob) {
SCM list; struct cell *cell;
int i;
int count;
scm_assert_smob_type(board_tag, board_smob);
scm_assert_smob_type(cell_tag, cell_smob);
list = get_neighbors(board_smob, cell_smob);
count = 0;
for (i = 0; i < scm_to_int(scm_length(list)); i++) {
cell = (struct cell *) SCM_SMOB_DATA(scm_list_ref(list, scm_from_int(i)));
if (cell->status > 0) {
count++;
}
}
return scm_from_int(count);
}
/*
* Adds an attribute <B>scm_attrib_name</B> with value <B>scm_attrib_value</B> to the given <B>object</B>.
The attribute has the visibility <B>scm_vis</B> and show <B>scm_show</B> flags.
The possible values are:
- <B>scm_vis</B>: scheme boolean. Visible (TRUE) or hidden (FALSE).
- <B>scm_show</B>: a list containing what to show: "name", "value", or both.
The return value is always TRUE.
*/
SCM g_add_attrib(SCM object, SCM scm_attrib_name,
SCM scm_attrib_value, SCM scm_vis, SCM scm_show)
{
GSCHEM_TOPLEVEL *w_current=global_window_current;
TOPLEVEL *toplevel = w_current->toplevel;
OBJECT *o_current=NULL;
gboolean vis;
int show=0;
gchar *attrib_name=NULL;
gchar *attrib_value=NULL;
gchar *value=NULL;
int i;
gchar *newtext=NULL;
SCM_ASSERT (scm_is_string(scm_attrib_name), scm_attrib_name,
SCM_ARG2, "add-attribute-to-object");
SCM_ASSERT (scm_is_string(scm_attrib_value), scm_attrib_value,
SCM_ARG3, "add-attribute-to-object");
SCM_ASSERT (scm_boolean_p(scm_vis), scm_vis,
SCM_ARG4, "add-attribute-to-object");
SCM_ASSERT (scm_list_p(scm_show), scm_show,
SCM_ARG5, "add-attribute-to-object");
/* Get toplevel and o_current */
SCM_ASSERT (g_get_data_from_object_smob (object, &toplevel, &o_current),
object, SCM_ARG1, "add-attribute-to-object");
/* Get parameters */
attrib_name = SCM_STRING_CHARS(scm_attrib_name);
attrib_value = SCM_STRING_CHARS(scm_attrib_value);
vis = SCM_NFALSEP(scm_vis);
for (i=0; i<=scm_to_int(scm_length(scm_show))-1; i++) {
/* Check every element in the list. It should be a string! */
SCM_ASSERT(scm_list_ref(scm_show, scm_from_int(i)),
scm_show,
SCM_ARG5, "add-attribute-to-object");
SCM_ASSERT(scm_is_string(scm_list_ref(scm_show, scm_from_int(i))),
scm_show,
SCM_ARG5, "add-attribute-to-object");
value = SCM_STRING_CHARS(scm_list_ref(scm_show, scm_from_int(i)));
SCM_ASSERT(value, scm_show,
SCM_ARG5, "add-attribute-to-object");
/* Only "name" or "value" strings are allowed */
SCM_ASSERT(!((strcasecmp(value, "name") != 0) &&
(strcasecmp(value, "value") != 0) ), scm_show,
SCM_ARG5, "add-attribute-to-object");
/* show = 1 => show value;
show = 2 => show name;
show = 3 => show both */
if (strcasecmp(value, "value") == 0) {
show |= 1;
}
else if (strcasecmp(value, "name") == 0) {
show |= 2;
}
}
/* Show name and value (show = 3) => show=0 for gschem */
if (show == 3) {
show = 0;
}
newtext = g_strdup_printf("%s=%s", attrib_name, attrib_value);
o_attrib_add_attrib (w_current, newtext, vis, show, o_current);
g_free(newtext);
return SCM_BOOL_T;
}
static void
gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data)
{
gnc_column_view_edit * r = user_data;
SCM make_report = scm_c_eval_string("gnc:make-report");
SCM mark_report = scm_c_eval_string("gnc:report-set-needs-save?!");
SCM template_name;
SCM new_report;
SCM newlist = SCM_EOL;
SCM oldlist = r->contents_list;
int count;
int oldlength, id;
if (scm_is_list(r->available_list) &&
(scm_ilength(r->available_list) > r->available_selected))
{
template_name = scm_list_ref(r->available_list,
scm_int2num(r->available_selected));
new_report = scm_call_1(make_report, template_name);
id = scm_num2int(new_report, SCM_ARG1, G_STRFUNC);
scm_call_2(mark_report, gnc_report_find(id), SCM_BOOL_T);
oldlength = scm_ilength(r->contents_list);
if (oldlength > r->contents_selected)
{
for (count = 0; count < r->contents_selected; count++)
{
newlist = scm_cons(SCM_CAR(oldlist), newlist);
oldlist = SCM_CDR(oldlist);
}
newlist = scm_append
(scm_listify(scm_reverse(scm_cons(SCM_LIST4(new_report,
scm_int2num(1),
scm_int2num(1),
SCM_BOOL_F),
newlist)),
oldlist,
SCM_UNDEFINED));
}
else
{
newlist = scm_append
(scm_listify(oldlist,
SCM_LIST1(SCM_LIST4(new_report,
scm_int2num(1),
scm_int2num(1),
SCM_BOOL_F)),
SCM_UNDEFINED));
r->contents_selected = oldlength;
}
scm_gc_unprotect_object(r->contents_list);
r->contents_list = newlist;
scm_gc_protect_object(r->contents_list);
gnc_column_view_set_option(r->odb, "__general", "report-list",
r->contents_list);
gnc_options_dialog_changed (r->optwin);
}
update_display_lists(r);
}
static void
update_display_lists(gnc_column_view_edit * view)
{
SCM get_names = scm_c_eval_string("gnc:all-report-template-names");
SCM template_menu_name = scm_c_eval_string("gnc:report-template-menu-name/report-guid");
SCM report_menu_name = scm_c_eval_string("gnc:report-menu-name");
SCM names = scm_call_0(get_names);
SCM contents =
gnc_option_db_lookup_option(view->odb, "__general", "report-list",
SCM_BOOL_F);
SCM this_report;
SCM selection;
const gchar *name;
int row, i, id;
GtkListStore *store;
GtkTreeIter iter;
GtkTreePath *path;
GtkTreeSelection *tree_selection;
/* Update the list of available reports (left selection box). */
row = view->available_selected;
if (scm_is_list(view->available_list) && !scm_is_null (view->available_list))
{
row = MIN (row, scm_ilength (view->available_list) - 1);
selection = scm_list_ref (view->available_list, scm_int2num (row));
}
else
{
selection = SCM_UNDEFINED;
}
scm_gc_unprotect_object(view->available_list);
view->available_list = names;
scm_gc_protect_object(view->available_list);
store = GTK_LIST_STORE(gtk_tree_view_get_model(view->available));
gtk_list_store_clear(store);
if (scm_is_list(names))
{
for (i = 0; !scm_is_null(names); names = SCM_CDR(names), i++)
{
char * str;
if (scm_is_equal (SCM_CAR(names), selection))
row = i;
scm_dynwind_begin (0);
str = scm_to_locale_string (scm_call_2(template_menu_name, SCM_CAR(names),
SCM_BOOL_F));
name = _(g_strdup (str));
scm_dynwind_free (str);
scm_dynwind_end ();
gtk_list_store_append(store, &iter);
gtk_list_store_set(store, &iter,
AVAILABLE_COL_NAME, name,
AVAILABLE_COL_ROW, i,
-1);
}
}
tree_selection = gtk_tree_view_get_selection(view->available);
path = gtk_tree_path_new_from_indices(row, -1);
gtk_tree_selection_select_path(tree_selection, path);
gtk_tree_path_free(path);
/* Update the list of selected reports (right selection box). */
row = view->contents_selected;
if (scm_is_list(view->contents_list) && !scm_is_null (view->contents_list))
{
row = MIN (row, scm_ilength (view->contents_list) - 1);
selection = scm_list_ref (view->contents_list, scm_int2num (row));
}
else
{
selection = SCM_UNDEFINED;
}
scm_gc_unprotect_object(view->contents_list);
view->contents_list = contents;
scm_gc_protect_object(view->contents_list);
store = GTK_LIST_STORE(gtk_tree_view_get_model(view->contents));
gtk_list_store_clear(store);
if (scm_is_list(contents))
{
for (i = 0; !scm_is_null(contents); contents = SCM_CDR(contents), i++)
{
char * str;
if (scm_is_equal (SCM_CAR(contents), selection))
row = i;
id = scm_num2int(SCM_CAAR(contents), SCM_ARG1, G_STRFUNC);
this_report = gnc_report_find(id);
scm_dynwind_begin (0);
str = scm_to_locale_string (scm_call_1(report_menu_name, this_report));
name = _(g_strdup (str));
scm_dynwind_free (str);
scm_dynwind_end ();
gtk_list_store_append(store, &iter);
gtk_list_store_set
(store, &iter,
CONTENTS_COL_NAME, name,
CONTENTS_COL_ROW, i,
CONTENTS_COL_REPORT_COLS, scm_num2int(SCM_CADR(SCM_CAR(contents)),
SCM_ARG1, G_STRFUNC),
CONTENTS_COL_REPORT_ROWS, scm_num2int(SCM_CADDR(SCM_CAR(contents)),
SCM_ARG1, G_STRFUNC),
-1);
}
}
tree_selection = gtk_tree_view_get_selection(view->contents);
path = gtk_tree_path_new_from_indices(row, -1);
gtk_tree_selection_select_path(tree_selection, path);
// gtk_tree_view_scroll_to_cell(view->contents, path, NULL, TRUE, 0.5, 0.0);
gtk_tree_path_free(path);
}
/*! \brief Get the object bounds of the given object, excluding the object
* types or the attributes given as parameters.
* \par Function Description
* Get the object bounds without considering the attributes in
* scm_exclude_attribs, neither the object types included in
* scm_exclude_object_type
* \param [in] object_smob The object we want to know the bounds of.
* \param [in] exclude_attrib_list A list with the attribute names we don't
* want to include when calculing the bounds.
* \param [in] exclude_obj_type_list A list with the object types we don't
* want to include when calculing the bounds.
* The object types are those used in (OBJECT *)->type converted into strings.
* \return a list of the bounds of the <B>object smob</B>.
* The list has the format: ( (left right) (top bottom) )
* WARNING: top and bottom are mis-named in world-coords,
* top is the smallest "y" value, and bottom is the largest.
* Be careful! This doesn't correspond to what you'd expect,
* nor to the coordinate system who's origin is the bottom, left of the page.
*/
SCM g_get_object_bounds (SCM object_smob, SCM scm_exclude_attribs, SCM scm_exclude_object_type)
{
TOPLEVEL *toplevel=NULL;
OBJECT *object=NULL;
int left=0, right=0, bottom=0, top=0;
SCM returned = SCM_EOL;
SCM vertical = SCM_EOL;
SCM horizontal = SCM_EOL;
GList *exclude_attrib_list = NULL, *exclude_obj_type_list = NULL;
gboolean exclude_all_attribs = FALSE;
int i;
SCM_ASSERT (scm_list_p(scm_exclude_attribs), scm_exclude_attribs,
SCM_ARG2, "get-object-bounds");
SCM_ASSERT (scm_list_p(scm_exclude_object_type), scm_exclude_object_type,
SCM_ARG3, "get-object-bounds");
/* Build the exclude attrib list */
for (i=0; i <= scm_to_int(scm_length(scm_exclude_attribs))-1; i++) {
SCM_ASSERT (scm_is_string(scm_list_ref(scm_exclude_attribs, scm_from_int(i))),
scm_exclude_attribs,
SCM_ARG2, "get-object-bounds");
exclude_attrib_list = g_list_append(exclude_attrib_list,
SCM_STRING_CHARS(scm_list_ref(scm_exclude_attribs,
scm_from_int(i))));
}
/* Build the exclude object type list */
for (i=0; i <= scm_to_int(scm_length(scm_exclude_object_type))-1; i++) {
SCM_ASSERT (scm_is_string(scm_list_ref(scm_exclude_object_type, scm_from_int(i))),
scm_exclude_object_type,
SCM_ARG3, "get-object-bounds");
exclude_obj_type_list = g_list_append(exclude_obj_type_list,
SCM_STRING_CHARS(scm_list_ref(scm_exclude_object_type,
scm_from_int(i))));
}
/* Get toplevel and o_current. */
g_get_data_from_object_smob (object_smob, &toplevel, &object);
SCM_ASSERT (toplevel && object,
object_smob, SCM_ARG1, "get-object-bounds");
if (g_list_find_custom(exclude_attrib_list, "all", (GCompareFunc) &strcmp))
exclude_all_attribs = TRUE;
custom_world_get_single_object_bounds (toplevel, object,
&left, &top,
&right, &bottom,
exclude_attrib_list,
exclude_obj_type_list);
/* Free the exclude attrib_list. Don't free the nodes!! */
g_list_free(exclude_attrib_list);
/* Free the exclude attrib_list. Don't free the nodes!! */
g_list_free(exclude_obj_type_list);
horizontal = scm_cons (scm_from_int(left), scm_from_int(right));
vertical = scm_cons (scm_from_int(top), scm_from_int(bottom));
returned = scm_cons (horizontal, vertical);
return (returned);
}
/* get confinement from SCM
* in SCM, confinement is given by one of these:
* for spherical confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "sphere"
* 10.0 ;; radius of the cavity at (0, 0, 0)
* ))
* for spherical confinement with a hole,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "sphere+hole"
* 10.0 ;; radius of the cavity at (0, 0, 0)
* 1.0 ;; radius of the hole at (0, 0, 1) direction
* ))
* for cylindrical confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "cylinder" ;; the cylinder center goes through (0, 0, 0) and (x, y, z).
* 10.0 ;; radius of the cylinder
* 1.0 0.0 0.0 ;; direction vector (x, y, z) of the cylinder
* ))
* for dumbbell confinement,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "dumbbell" ;; the origin is at the center of the cylinder
* 10.0 ;; left cavity radius centered at (center1, 0, 0)
* 10.0 ;; right cavity radius centered at (center2, 0, 0)
* 2.0 ;; length of the cylinder
* 1.0 ;; cylinder radius
* ))
* for 2D hexagonal confinement with cylinder pipe,
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "hex2d"
* 10.0 ;; cavity radius
* 1.0 ;; cylinder radius
* 12.0 ;; lattice spacing
* ))
* for porous media (outside of the 3D hexagonal particle array)
* (define confinement '(
* 10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
* 1.0 ;; LJ parameter r0 in "length" (so this is dimensionless value)
* "porous"
* 10.0 ;; particle radius
* 20.0 ;; lattice spacing in x (2R for touching case)
* ))
* INPUT
* var : name of the variable.
* in the above example, set "confinement".
* OUTPUT
* returned value : struct confinement
* if NULL is returned, it failed (not defined)
*/
struct confinement *
CF_guile_get (const char *var)
{
if (guile_check_symbol (var) == 0)
{
fprintf (stderr, "CF_guile_get: %s is not defined\n", var);
return (NULL);
}
SCM scm_symbol
= scm_c_lookup (var);
SCM scm_confinement
= scm_variable_ref (scm_symbol);
if (!SCM_NFALSEP (scm_list_p (scm_confinement)))
{
fprintf (stderr, "CF_guile_get: %s is not a list\n", var);
return (NULL);
}
struct confinement *cf = NULL;
unsigned long len
= scm_num2ulong (scm_length (scm_confinement),
0, "CF_guile_get");
if (len == 0)
{
// no confinement
return (cf);
}
else if (len < 4)
{
fprintf (stderr, "CF_guile_get: %s is too short\n", var);
return (NULL);
}
double epsilon
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (0)),
"CF_guile_get");
double r0
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (1)),
"CF_guile_get");
// get the string
char *str_cf = NULL;
SCM scm_conf = scm_list_ref (scm_confinement, scm_int2num (2));
#ifdef GUILE16
size_t str_len;
if (gh_string_p (scm_conf))
{
str_cf = gh_scm2newstr (scm_conf, &str_len);
}
#else // !GUILE16
if (scm_is_string (scm_conf))
{
str_cf = scm_to_locale_string (scm_conf);
}
#endif // GUILE16
if (strcmp (str_cf, "sphere") == 0)
{
if (len != 4)
{
fprintf (stderr, "CF_guile_get:"
" for sphere, number of parameter must be 1\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
cf = CF_init (0, // sphere
R,
0.0, // r
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "sphere+hole") == 0)
{
if (len != 5)
{
fprintf (stderr, "CF_guile_get:"
" for sphere+hole, number of parameter must be 2\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
cf = CF_init (1, // sphere+hole
R,
r,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "cylinder") == 0)
{
if (len != 7)
{
fprintf (stderr, "CF_guile_get:"
" for cylinder, number of parameter must be 4\n");
}
else
{
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double x
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double y
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
double z
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
"CF_guile_get");
cf = CF_init (2, // cylinder
0.0, // R,
r,
x, y, z,
0.0, // R2
0.0, // L
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "dumbbell") == 0)
{
if (len != 7)
{
fprintf (stderr, "CF_guile_get:"
" for dumbbell, number of parameter must be 4\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double R2
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
"CF_guile_get");
cf = CF_init (3, // dumbbell
R,
r,
0.0, 0.0, 0.0, // x, y, z
R2,
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "hex2d") == 0)
{
if (len != 6)
{
fprintf (stderr, "CF_guile_get:"
" for hex2d, number of parameter must be 3\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double r
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
"CF_guile_get");
cf = CF_init (4, // hex2d
R,
r,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else if (strcmp (str_cf, "porous") == 0)
{
if (len != 5)
{
fprintf (stderr, "CF_guile_get:"
" for hex2d, number of parameter must be 2\n");
}
else
{
double R
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
"CF_guile_get");
double L
= scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
"CF_guile_get");
cf = CF_init (5, // porous
R,
0.0,
0.0, 0.0, 0.0, // x, y, z
0.0, // R2
L,
0, // flag_LJ
epsilon,
r0);
CHECK_MALLOC (cf, "CF_guile_get");
}
}
else
{
fprintf (stderr, "CF_guile_get: invalid confinement %s\n",
str_cf);
}
free (str_cf);
return (cf); // success
}
