SCM ffmpeg_crop_audio_frame_size(SCM scm_self, SCM scm_size)
{
  struct ffmpeg_t *self = get_self(scm_self);
  self->audio_target_frame->nb_samples = scm_to_int(scm_size);
  self->audio_packed_frame->nb_samples = scm_to_int(scm_size);
  return SCM_UNSPECIFIED;
}

static SCM
make_image (SCM name, SCM s_width, SCM s_height)
{
  SCM smob;
  struct image *image;
  int width = scm_to_int (s_width);
  int height = scm_to_int (s_height);

  /* Step 1: Allocate the memory block.
   */
  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");

  /* Step 2: Initialize it with straight code.
   */
  image->width = width;
  image->height = height;
  image->pixels = NULL;
  image->name = SCM_BOOL_F;
  image->update_func = SCM_BOOL_F;

  /* Step 3: Create the smob.
   */
  SCM_NEWSMOB (smob, image_tag, image);

  /* Step 4: Finish the initialization.
   */
  image->name = name;
  image->pixels = scm_gc_malloc_pointerless (width * height, "image pixels");

  return smob;
}

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;
}

/*! \brief Get the action position.
 * \par Function Description
 * Retrieves the current action position and stores it in \a x and \a
 * y, optionally snapping it to the grid if \a snap is true.  This
 * should be interpreted as the position that the user was pointing
 * with the mouse pointer when the current action was invoked.  If
 * there is no valid world position for the current action, returns
 * FALSE without modifying the output variables.
 *
 * This should be used by actions implemented in C to figure out where
 * on the schematic the user wants them to apply the action.
 *
 * See also the (gschem action) Scheme module.
 *
 * \param w_current    Current gschem toplevel structure.
 * \param x            Location to store x coordinate.
 * \param y            Location to store y coordinate.
 *
 * \return TRUE if current action position is set, FALSE otherwise.
 */
gboolean
g_action_get_position (gboolean snap, int *x, int *y)
{
  SCM s_action_position_proc;
  SCM s_point;
  GschemToplevel *w_current = g_current_window ();

  g_assert (w_current);

  /* Get the action-position procedure */
  s_action_position_proc =
    scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
                                           "action-position"));

  /* Retrieve the action position */
  s_point = scm_call_0 (s_action_position_proc);

  if (scm_is_false (s_point)) return FALSE;

  if (x) {
    *x = scm_to_int (scm_car (s_point));
    if (snap) {
      *x = snap_grid (w_current, *x);
    }
  }
  if (y) {
    *y = scm_to_int (scm_cdr (s_point));
    if (snap) {
      *y = snap_grid (w_current, *y);
    }
  }

  return TRUE;
}

SCM TTY::New(SCM fd, SCM readable){
  CheckArgType(fd, scm_integer_p, "tty-new", 1);
  CheckArgType(readable, scm_integer_p, "tty-new", 2);
  TTY * t = new TTY(scm_to_int(fd), scm_to_int(readable));
  assert(t!=NULL);
  return t->smob;
}

//
// 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);
}

SCM
guile_comm_recv (SCM world, SCM src, SCM tag)
{
    char buf[MAX_BUF_LENGTH];

    // extract MPI_Comm, verifies the type:
    MPI_Comm comm = scm_to_comm (world);

    int isrc = scm_to_int (src);
    int itag = scm_to_int (tag);

    MPI_Status stat;

    int ierr = MPI_Recv (buf, MAX_BUF_LENGTH, MPI_CHAR, isrc, itag, comm, &stat);
    assert (MPI_SUCCESS==ierr);

    // printf ("RECV:%s\n", buf);

    // get the size of the received data:
    int ilen;
    ierr = MPI_Get_count (&stat, MPI_CHAR, &ilen);
    assert (MPI_SUCCESS==ierr);

    return scm_from_byte_string (buf, ilen);
}

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;
}

SCM scm_make_select_event_set(SCM nfds ,SCM size ,SCM type)
#define FUNC_NAME "make-event-set"
{
  int t;
  unsigned int n = 0;
  int fd;
  
  SCM_VALIDATE_NUMBER(1 ,nfds);
  SCM_VALIDATE_NUMBER(2 ,size);
  SCM_VALIDATE_NUMBER(3 ,type);
  
  t = scm_to_int(type);
  n = scm_to_uint(size);
  fd = scm_to_int(nfds);
  
  scm_rag_fd_set *rfd = (scm_rag_fd_set*)scm_gc_malloc(sizeof(scm_rag_fd_set));
  
  scm_rag_select_event_set *ses =
    (scm_rag_select_event_set*)scm_gc_malloc(sizeof(scm_rag_select_event_set),
					     "select-event-set");

  ses->type = t;
  ses->count = 0;
  ses->size = n;
  ses->nfds = fd;
  ses->set = rfd;
  
  return scm_rag_select_event_set2scm(ses);
}

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;
}

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_rc_window_size(SCM width, SCM height)
{
    SCM_ASSERT (scm_is_integer (width),  width,  SCM_ARG1, "window-size");
    SCM_ASSERT (scm_is_integer (height), height, SCM_ARG2, "window-size");

    default_width  = scm_to_int (width);
    default_height = scm_to_int (height);

    return SCM_BOOL_T;
}

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;
}

SCM Display::scm_draw_image(SCM image, SCM pos) {
#ifdef WITH_SDL
	struct image *img = (struct image *) SCM_SMOB_DATA(image);
	SDL_Rect p;
	p.x = scm_to_int(scm_car(pos));
	p.y = scm_to_int(scm_cadr(pos));
	printf("%d, %d", img->surface, NULL);
	SDL_BlitSurface(img->surface, NULL, get()->m_pScreen, &p); 
#endif
}

static LLVMTypeRef function_type(SCM scm_return_type, SCM scm_argument_types)
{
  int n_arguments = scm_ilength(scm_argument_types);
  LLVMTypeRef *parameters = scm_gc_malloc_pointerless(n_arguments * sizeof(LLVMTypeRef), "make-llvm-function");
  for (int i=0; i<n_arguments; i++) {
    parameters[i] = llvm_type(scm_to_int(scm_car(scm_argument_types)));
    scm_argument_types = scm_cdr(scm_argument_types);
  };
  return LLVMFunctionType(llvm_type(scm_to_int(scm_return_type)), parameters, n_arguments, 0);
}

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_rc_image_size(SCM width, SCM height)
{
    SCM_ASSERT (scm_is_integer (width),  width,  SCM_ARG1, "image-size");
    SCM_ASSERT (scm_is_integer (height), height, SCM_ARG2, "image-size");

    /* yes this is legit, we are casting the resulting double to an int */
    default_image_width  = scm_to_int (width);
    default_image_height = scm_to_int (height);

    return SCM_BOOL_T;
}

static SCM
game_resize_display (SCM game_smob, SCM s_width, SCM s_height)
{
    Game *game = check_game (game_smob);
    int width = scm_to_int (s_width);
    int height = scm_to_int (s_height);

    al_resize_display (game->display, width, height);

    return SCM_UNSPECIFIED;
}

SCM mjpeg_to_yuv420p(SCM scm_source_ptr, SCM scm_shape, SCM scm_dest_ptr, SCM scm_offsets)
{
  unsigned char *source_ptr = scm_to_pointer(scm_source_ptr);
  unsigned char *dest_ptr = scm_to_pointer(scm_dest_ptr);
  int width = scm_to_int(scm_cadr(scm_shape));
  int height = scm_to_int(scm_car(scm_shape));
  int64_t offsets[3];
  memset(offsets, 0, sizeof(offsets));
  scm_to_long_array(scm_offsets, offsets);
  decode_jpeg_raw(source_ptr, width * height * 2, Y4M_ILACE_NONE, 0, width, height,
                  dest_ptr + offsets[0], dest_ptr + offsets[2], dest_ptr + offsets[1]);
  return SCM_UNSPECIFIED;
}

SCM negate(SCM scm_ptr, SCM scm_stride, SCM scm_size)
{
  int *p = (int *)scm_to_pointer(scm_ptr);
  int s = scm_to_int(scm_stride);
  int n = scm_to_int(scm_size);
  ret = malloc(n * sizeof(int));
  int *rend = ret + n;
  int *r;
  for (r=ret; r!=rend; r+=s, p+=s)
    *r = -*p;
  free(ret);
  return SCM_UNDEFINED;
}

static void image_setup(SCM scm_type, enum AVPixelFormat *format, int *width, int *height,
                        uint8_t *data[], int32_t pitches[], void *ptr)
{
  int i;
  int64_t offsets[8];
  memset(offsets, 0, sizeof(offsets));
  *format = scm_to_int(scm_car(scm_type));
  *width = scm_to_int(scm_cadadr(scm_type));
  *height = scm_to_int(scm_caadr(scm_type)),
  scm_to_long_array(scm_caddr(scm_type), offsets);
  scm_to_int_array(scm_cadddr(scm_type), pitches);
  for (i=0; i<8; i++) data[i] = (uint8_t *)ptr + offsets[i];
}

SCM
gucu_slk_set (SCM labnum, SCM label, SCM fmt)
{
  SCM_ASSERT (scm_is_integer (labnum), labnum, SCM_ARG1, "slk-set");
  SCM_ASSERT (scm_is_string (label), label, SCM_ARG2, "slk-set");
  SCM_ASSERT (scm_is_integer (fmt), fmt, SCM_ARG3, "slk-set");

  int c_labnum = scm_to_int (labnum);
  char *c_label = scm_to_locale_string (label);
  int c_fmt = scm_to_int (fmt);

  int ret = slk_set (c_labnum, c_label, c_fmt);
  RETURNTF (ret);
}