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;
}
/*! \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;
}
static void
gdbscm_memory_port_end_input (SCM port, int offset)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
ioscm_memory_port *iomem = (ioscm_memory_port *) SCM_STREAM (port);
size_t remaining = pt->read_end - pt->read_pos;
/* Note: Use of "int offset" is specified by Guile ports API. */
if ((offset < 0 && remaining + offset > remaining)
|| (offset > 0 && remaining + offset < remaining))
{
gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
_("overflow in offset calculation"));
}
offset += remaining;
if (offset > 0)
{
pt->read_pos = pt->read_end;
/* Throw error if unread-char used at beginning of file
then attempting to write. Seems correct. */
if (!ioscm_lseek_address (iomem, -offset, SEEK_CUR))
{
gdbscm_out_of_range_error (FUNC_NAME, 0, scm_from_int (offset),
_("bad offset"));
}
}
pt->rw_active = SCM_PORT_NEITHER;
}
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;
}
/*
* Returns a list with coords of the ends of the given pin <B>object</B>.
The list is ( (x0 y0) (x1 y1) ), where the beginning is at (x0,y0) and the end at (x1,y1).
The active connection end of the pin is the beginning, so this function cares about the whichend property of the pin object. If whichend is 1, then it has to reverse the ends.
*/
SCM g_get_pin_ends(SCM object)
{
TOPLEVEL *toplevel;
OBJECT *o_current;
SCM coord1 = SCM_EOL;
SCM coord2 = SCM_EOL;
SCM coords = SCM_EOL;
/* Get toplevel and o_current */
SCM_ASSERT (g_get_data_from_object_smob (object, &toplevel, &o_current),
object, SCM_ARG1, "get-pin-ends");
/* Check that it is a pin object */
SCM_ASSERT (o_current != NULL,
object, SCM_ARG1, "get-pin-ends");
SCM_ASSERT (o_current->type == OBJ_PIN,
object, SCM_ARG1, "get-pin-ends");
SCM_ASSERT (o_current->line != NULL,
object, SCM_ARG1, "get-pin-ends");
coord1 = scm_cons(scm_from_int(o_current->line->x[0]),
scm_from_int(o_current->line->y[0]));
coord2 = scm_cons(scm_from_int(o_current->line->x[1]),
scm_from_int(o_current->line->y[1]));
if (o_current->whichend == 0) {
coords = scm_cons(coord1, scm_list(coord2));
} else {
coords = scm_cons(coord2, scm_list(coord1));
}
return coords;
}
int test_can_convert_to_slist__list_of_integers (void)
{
SCM str_list = scm_list_2(scm_from_int(1), scm_from_int(2));
int ret = _scm_can_convert_to_slist (str_list);
printf("test that _scm_can_convert_to_slist returns 0 when passed a list of integers: %d\n", ret == 0);
return ret == 0;
}
int test_scm_convert_to_slist__list_of_integers (void)
{
SCM str_list = scm_list_2(scm_from_int(1), scm_from_int(2));
struct curl_slist *ret = _scm_convert_to_slist (str_list);
printf("test that _scm_convert_to_slist returns NULL when passed a list of integers: %d\n", ret == NULL);
return ret == NULL;
}
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));
}
}
}
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;
}
static SCM make_board (SCM s_width, SCM s_height) {
int i;
int j;
SCM smob;
struct board *board;
int width = scm_to_int(s_width);
int height = scm_to_int(s_height);
board = (struct board *) scm_gc_malloc(sizeof(struct board), "board");
board->width = width;
board->height = height;
board->update_func = SCM_BOOL_F;
board->cell_list = SCM_EOL;
for (i = height - 1; i >= 0; i--) {
SCM row = SCM_EOL;
for (j = width - 1; j >= 0; j--) {
SCM y_offset = scm_from_int(i);
SCM x_offset = scm_from_int(j);
row = scm_cons(make_cell(x_offset, y_offset, scm_from_int(0)), row);
}
board->cell_list = scm_cons(row, board->cell_list);
}
SCM_NEWSMOB(smob, board_tag, board);
return smob;
}
SCM scm_ragnarok_epoll_wait(SCM event_set ,SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-epoll-wait"
{
scm_rag_epoll_event_set *es = NULL;
int fd;
int op;
int count;
long s = 0L;
long ms = 0L;
SCM cons;
int nfds;
SCM ret = SCM_EOL;
SCM_ASSERT_EPOLL_EVENT_SET(event_set);
es = (scm_rag_epoll_event_set*)SCM_SMOB_DATA(event_set);
if(!SCM_UNBNDP(second))
{
SCM_VALIDATE_NUMBER(3 ,second);
s = (long)scm_to_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(4 ,msecond);
ms = (long)scm_to_long(msecond);
}
ms += s*1000; // convert to mseconds since epoll_wait only accept msecond;
}
ms = ms ? ms : -1;
count = es->count;
if(!count)
goto end;
nfds = epoll_wait(es->epfd ,es->ee_set ,count ,ms);
if(nfds < 0)
{
RAG_ERROR1("epoll_wait" ,"epoll_wait error! errno shows %a~%",
RAG_ERR2STR(errno));
}
while(nfds > 0)
{
nfds--;
fd = es->ee_set[nfds].data.fd;
op = es->ee_set[nfds].events;
cons = scm_cons(scm_from_int(fd) ,scm_from_int(op));
ret = scm_cons(cons ,ret);
}
return ret;
end:
return SCM_EOL;
}
SCM
gucu_getyx (SCM win)
{
int y, x;
getyx (_scm_to_window (win), y, x);
return (scm_list_2 (scm_from_int (y), scm_from_int (x)));
}
/* Get the location of the virtual screen cursor */
SCM
gucu_getsyx ()
{
int y = 0, x = 0;
getsyx (y, x);
return (scm_list_2 (scm_from_int (y), scm_from_int (x)));
}
/* Return the range of the lines in the scroll region */
SCM
gucu_getscrreg (SCM win)
{
int top, bottom;
wgetscrreg (_scm_to_window (win), &top, &bottom);
return (scm_list_2 (scm_from_int (top), scm_from_int (bottom)));
}
bool call_guile_buttonpress(unsigned int button, bool ctrl, int x, int y) {
return scm_to_bool (scm_eval (scm_list_n (scm_from_locale_symbol ("on-button-press"),
scm_from_int(button),
scm_from_bool(ctrl),
scm_from_int(x),
scm_from_int(y),
SCM_UNDEFINED
), scm_interaction_environment()));
}
VISIBLE SCM
scm_rexp_interval (SCM match, SCM subexpression)
{
rexp_interval_t interv = rexp_interval (scm_to_rexp_match_t (match),
scm_to_size_t (subexpression));
return ((interv.i_start == -1) ?
SCM_BOOL_F : scm_list_2 (scm_from_int (interv.i_start),
scm_from_int (interv.i_end)));
}
SCM TTY::GetWinSize(SCM id){
assert_object_type(id);
TTY * t = (TTY *)get_object(id);
assert(t!=NULL);
int width = 0;
int height = 0;
int r = uv_tty_get_winsize(GetHandle(t), &width, &height);
if(r) Logger::Err("uv_tty_get_winsize failed! : %d", r);
return scm_list_2(scm_from_int(width), scm_from_int(height));
}
VISIBLE void
scm_gsl_error_handler_for_raising_a_gsl_error (const char *reason,
const char *file,
int line, int gsl_errno)
{
scm_raise_gsl_error (scm_list_4 (scm_from_locale_string (reason),
scm_from_locale_string (file),
scm_from_int (line),
scm_from_int (gsl_errno)));
}
static SCM
scm_srcprops_to_alist (SCM obj)
{
SCM alist = SRCPROPALIST (obj);
if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
alist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), alist);
alist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), alist);
alist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), alist);
return alist;
}
SCM
thit_scm_from_vector_int(gsl_vector_int *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_int(gsl_vector_int_get(v, i)));
return s_vector;
}
/*! \brief Indicate the verbosity level for messages.
* \par Function Description
* If the "-q" gnetlist command-line option was specified, returns -1.
* If the "-v" gnetlist command-line option was specified, returns 1.
* Otherwise, returns 0.
*/
SCM
g_get_verbosity ()
{
if (verbose_mode) {
return scm_from_int (1);
} else if (quiet_mode) {
return scm_from_int (-1);
} else {
return scm_from_int (0);
}
}
SCM scm_ragnarok_select(SCM nfds ,SCM read_set ,SCM write_set,
SCM except_set ,SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-select"
{
int n = 0;
scm_rag_fd_set *rs = NULL;
scm_rag_fd_set *ws = NULL;
scm_rag_fd_set *es = NULL;
scm_rag_fd_set *ready_set = NULL;
long s = 0L;
long ms = 0L;
int i;
struct timeval tv;
SCM ret = SCM_EOL;
SCM *prev = &ret;
SCM_VALIDATE_NUMBER(1 ,nfds);
SCM_ASSERT_EVENT_SET(read_set);
SCM_ASSERT_EVENT_SET(write_set);
SCM_ASSERT_EVENT_SET(except_set);
if(!SCM_UNBNDP(ms))
{
SCM_VALIDATE_NUMBER(5 ,second);
s = (long)scm_from_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(6 ,msecond);
ms = (long)scm_from_long(msecond);
}
}
n = scm_from_int(nfds);
rs = (scm_rag_event_set*)SMOB_DATA(read_set);
ws = (scm_rag_event_set*)SMOB_DATA(write_set);
es = (scm_rag_event_set*)SMOB_DATA(except_set);
tv.tv_sec = (long)s;
tv.tv_usec = (long)us;
ready_set = select(n ,rs->set ,ws->set ,es->set ,&tv);
for(i=0;i<n;i++)
{
if(FD_ISSET(i ,&ready_set))
{
*prev = scm_cons(scm_from_int(i) ,SCM_EOL);
prev = SCM_CDRLOC(*prev);
}
}
return ret;
}
static int print_board (SCM board_smob, SCM port, scm_print_state *pstate) {
struct board *board = (struct board *)SCM_SMOB_DATA(board_smob);
scm_puts("#<board ", port);
scm_display(scm_from_int(board->width), port);
scm_puts(":", port);
scm_display(scm_from_int(board->height), port);
scm_puts(">", port);
return 1;
}
static int print_cell (SCM cell_smob, SCM port, scm_print_state *pstate) {
struct cell *cell = (struct cell *) SCM_SMOB_DATA(cell_smob);
scm_puts("#<cell ", port);
scm_display(scm_from_int(cell->x), port);
scm_puts(":", port);
scm_display(scm_from_int(cell->y), port);
scm_puts(" ", port);
scm_display(scm_from_int(cell->status), port);
scm_puts(">", port);
return 1;
}
/* Accept character strings from the curses terminal keyboard */
SCM
gucu_wgetnstr (SCM win, SCM n)
{
SCM s_str;
int ret;
int c_n;
c_n = scm_to_int (n);
if (c_n <= 0)
scm_out_of_range ("%wgetnstr", n);
#ifdef HAVE_NCURSESW
{
wint_t *c_wstr = (wint_t *) scm_malloc (sizeof (wint_t) * (c_n + 1));
ret = wgetn_wstr (_scm_to_window (win), c_wstr, c_n);
c_wstr[c_n] = 0;
if (ret == OK)
{
s_str = _scm_sstring_from_wint_string (c_wstr);
free (c_wstr);
}
else if (ret == KEY_RESIZE)
{
s_str = scm_from_int (KEY_RESIZE);
}
else
abort ();
}
#else
{
char *c_str = (char *) scm_malloc (sizeof (char) * (c_n + 1));
ret = wgetnstr (_scm_to_window (win), c_str, c_n);
c_str[c_n] = '\0';
if (ret == OK)
{
s_str = scm_from_locale_string (c_str);
free (c_str);
}
else if (ret == KEY_RESIZE)
{
s_str = scm_from_int (KEY_RESIZE);
}
else
abort ();
}
#endif
return (s_str);
}
SCM scm_ragnarok_epoll_add_event(SCM meta_event ,SCM event_set)
#define FUNC_NAME "ragnarok-epoll-add-event"
{
scm_rag_mevent *me = NULL;
scm_rag_epoll_event *ee = NULL;
scm_rag_epoll_event_set *ees = NULL;
int fd;
int oneshot;
int mode;
int ret = 0;
SCM_ASSERT_META_EVENT(meta_event);
SCM_ASSERT_EPOLL_EVENT_SET(event_set);
me = (scm_rag_mevent*)SCM_SMOB_DATA(meta_event);
ees = (scm_rag_epoll_event_set*)SCM_SMOB_DATA(event_set);
ee = (scm_rag_epoll_event*)me->core;
if(ees->count >= ees->size)
{
RAG_ERROR1("epoll_add" ,"event set exceed! count:~a" ,scm_from_int(ees->count));
}
fd = ee->data.fd;
oneshot = me->one_shot ? EPOLLONESHOT : 0;
mode = me->mode;
switch(me->type)
{
case READ:
ee->events = EPOLLIN | mode | oneshot;
break;
case WRITE:
ee->events = EPOLLOUT | mode | oneshot;
break;
default:
RAG_ERROR1("epoll_add" ,"invalid event type: %a~%" ,scm_from_int(me->type));
}
ret = epoll_ctl(ees->epfd ,EPOLL_CTL_ADD ,fd ,ee);
if(ret < 0)
{
RAG_ERROR1("epoll_add" ,"epoll_add error! errno is %a~%" ,RAG_ERR2STR(errno));
}
ees->count++;
return SCM_BOOL_T;
}
static void
test_scm_call ()
{
SCM result;
result = scm_call (scm_c_public_ref ("guile", "+"),
scm_from_int (1),
scm_from_int (2),
SCM_UNDEFINED);
assert (scm_is_true (scm_equal_p (result, scm_from_int (3))));
result = scm_call (scm_c_public_ref ("guile", "list"),
SCM_UNDEFINED);
assert (scm_is_eq (result, SCM_EOL));
}
/* Define both the original and replacement error symbol is possible. Thus
the user is able to check symbolic errors after unsuccessful networking
function calls. */
static void
scm_socket_symbols_Win32 (socket_error_t * e)
{
while (e->error != -1)
{
if (e->error)
{
if (e->correct_str)
scm_c_define (e->correct_str, scm_from_int (e->error));
if (e->replace && e->replace_str)
scm_c_define (e->replace_str, scm_from_int (e->replace));
}
e++;
}
}
//
// Send as a procedure, receive as a function that returns
// arbitrary types unrelated to input is an ugly abstraction:
//
SCM
guile_comm_send (SCM world, SCM dst, SCM tag, SCM obj)
{
size_t len;
char *buf;
// extract MPI_Comm, verifies the type:
MPI_Comm comm = scm_to_comm (world);
int idst = scm_to_int (dst);
int itag = scm_to_int (tag);
// searialize the object, dont forget to free() later:
buf = scm_to_byte_string (obj, &len);
assert (len < MAX_BUF_LENGTH);
// printf ("SEND:%s\n", buf);
// send just enough elements:
int ierr = MPI_Send (buf, len, MPI_CHAR, idst, itag, comm);
assert (MPI_SUCCESS==ierr);
free (buf);
return scm_from_int (ierr);
}
static SCM
game_display_height (SCM game_smob)
{
Game *game = check_game (game_smob);
return scm_from_int (al_get_display_height (game->display));
}
