static SCM
scm_elev_scm_spline (const char *who,
void elev_scm_spline (size_t new_degree,
size_t degree,
ssize_t stride,
const SCM *spline,
ssize_t result_stride,
SCM *result),
SCM new_degree, SCM spline)
{
scm_t_array_handle handle;
scm_t_array_handle handle2;
scm_dynwind_begin (0);
const size_t _new_degree = scm_to_size_t (new_degree);
scm_array_get_handle (spline, &handle);
scm_dynwind_array_handle_release (&handle);
assert_c_rank_1_or_2_array (who, spline, &handle);
size_t dim;
ssize_t stride;
scm_array_handle_get_vector_dim_and_stride (who, spline, &handle,
&dim, &stride);
const SCM *_spline = scm_array_handle_elements (&handle);
if (_new_degree < dim - 1)
the_new_degree_is_not_an_elevation (who, new_degree,
scm_from_size_t (dim - 1), spline);
SCM result = scm_make_array (SCM_UNSPECIFIED,
scm_list_1 (scm_oneplus (new_degree)));
scm_array_get_handle (result, &handle2);
scm_dynwind_array_handle_release (&handle2);
SCM *_result = scm_array_handle_writable_elements (&handle2);
elev_scm_spline (_new_degree, dim - 1, stride, _spline, 1, _result);
scm_dynwind_end ();
return result;
}
static double *material_grid_array(const material_grid *g)
{
#ifdef HAVE_SCM_ARRAY_GET_HANDLE
scm_array_get_handle(g->matgrid, &cur_material_grid_array_handle);
return (double *) scm_array_handle_uniform_writable_elements(
&cur_material_grid_array_handle);
#else
CHECK(SCM_ARRAYP(g->matgrid), "bug: matgrid is not an array");
return (double *) SCM_CELL_WORD_1(SCM_ARRAY_V(g->matgrid));
#endif
}
static int
rafill (SCM dst, SCM fill)
{
scm_t_array_handle h;
size_t n, i;
ssize_t inc;
scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
i = SCM_I_ARRAY_BASE (dst);
inc = SCM_I_ARRAY_DIMS (dst)->inc;
n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
dst = SCM_I_ARRAY_V (dst);
for (; n-- > 0; i += inc)
h.vset (h.vector, i, fill);
scm_array_handle_release (&h);
return 1;
}
SCM dijkstra(SCM scm_weights, SCM scm_start, SCM scm_cut_corners_p) {
int row = scm_to_int(SCM_CAR(scm_start));
int col = scm_to_int(SCM_CAR(SCM_CDR(scm_start)));
SCM dimensions = scm_array_dimensions(scm_weights);
int rows = scm_to_int(SCM_CAR(dimensions));
int cols = scm_to_int(SCM_CAR(SCM_CDR(dimensions)));
int cut_corners_p = scm_to_bool(scm_cut_corners_p);
int * weights = calloc(rows * cols, sizeof(int *));
WeightedPoint ** weighted_paths = calloc(rows, sizeof(WeightedPoint *));
scm_t_array_handle weights_handle;
scm_array_get_handle(scm_weights, &weights_handle);
int i_row, i_col;
for(i_row = 0; i_row < rows; i_row++) {
weighted_paths[i_row] = calloc(cols, sizeof(WeightedPoint));
for(i_col = 0; i_col < cols; i_col++) {
ssize_t pos = scm_array_handle_pos(&weights_handle, scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
weights[i_row * cols + i_col] = scm_to_int(scm_array_handle_ref(&weights_handle, pos));
}
}
scm_array_handle_release(&weights_handle);
find_paths(weighted_paths, (Point){col, row}, cut_corners_p, weights, rows, cols);
SCM scm_paths = scm_make_array(scm_from_int(0), dimensions);
for(i_row = 0; i_row < rows; i_row++) {
for(i_col = 0; i_col < cols; i_col++) {
scm_array_set_x(scm_paths,
scm_list_2(scm_from_int(weighted_paths[i_row][i_col].prev.y), scm_from_int(weighted_paths[i_row][i_col] .prev.x)),
scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
}
free(weighted_paths[i_row]);
}
free(weighted_paths);
free(weights);
return scm_paths;
}
const SCM *
scm_vector_elements (SCM vec, scm_t_array_handle *h,
size_t *lenp, ssize_t *incp)
{
/* it's unsafe to access the memory of a weak vector */
if (SCM_I_WVECTP (vec))
scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
scm_array_get_handle (vec, h);
if (1 != scm_array_handle_rank (h))
{
scm_array_handle_release (h);
scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array of Scheme values");
}
if (lenp)
{
scm_t_array_dim *dim = scm_array_handle_dims (h);
*lenp = dim->ubnd - dim->lbnd + 1;
*incp = dim->inc;
}
return scm_array_handle_elements (h);
}
