static void mlsdljoystick_raise_exception (char *msg)
{
static value *joystick_exn = NULL;
if(! joystick_exn)
joystick_exn = caml_named_value("SDLjoystick_exception");
raise_with_string(*joystick_exn, msg);
}
static void raise_dbm(char *errmsg)
{
static value * dbm_exn = NULL;
if (dbm_exn == NULL)
dbm_exn = caml_named_value("dbmerror");
raise_with_string(*dbm_exn, errmsg);
}
/* raise the Caml exception */
static void raise_mlgz_exn(const char *msg)
{
static value * exn = NULL;
if(exn == NULL)
exn = caml_named_value ("mlgz_exn");
raise_with_string(*exn, (char *)msg) ;
}
void ml_raise_gtk (const char *errmsg)
{
static value * exn = NULL;
if (exn == NULL)
exn = caml_named_value ("gtkerror");
raise_with_string (*exn, (char*)errmsg);
}
CAMLprim value
sdl_init_subsystem (value vf)
{
int flags = init_flag_val(vf);
if (SDL_Init(flags) < 0)
raise_with_string(*caml_named_value("SDL_init_exception"),
SDL_GetError());
return Val_unit;
}
void caml_gr_fail(char *fmt, char *arg)
{
char buffer[1024];
if (graphic_failure_exn == NULL) {
graphic_failure_exn = caml_named_value("Graphics.Graphic_failure");
if (graphic_failure_exn == NULL)
invalid_argument("Exception Graphics.Graphic_failure not initialized, must link graphics.cma");
}
sprintf(buffer, fmt, arg);
raise_with_string(*graphic_failure_exn, buffer);
}
static void raise_event_exn(char *msg)
{
static value *exn = NULL;
if(! exn){
exn = caml_named_value("sdlevent_exn");
if(! exn) {
fprintf(stderr, "exception not registered.");
abort();
}
}
raise_with_string(*exn, msg);
}
CAMLprim value
sdl_init(value auto_clean, value vf)
{
int flags = init_flag_val(vf);
int clean = Opt_arg(auto_clean, Bool_val, 0);
if (SDL_Init(flags) < 0)
raise_with_string(*caml_named_value("SDL_init_exception"),
SDL_GetError());
if(clean)
atexit(sdl_internal_quit);
return Val_unit;
}
void raise_db(const char *msg) {
raise_with_string(*caml_db_exn, msg);
}
static void raise_failure(void)
{
raise_with_string(*caml_named_value("SDL_failure"), IMG_GetError());
}
MGDesc *mgdesc_create(value ml_mg_desc) {
value ml_otrans = Field(ml_mg_desc, 0),
ml_copies_info = Field(ml_mg_desc, 1);
size_t nr_copies = Wosize_val(ml_copies_info),
nr_matrices = Wosize_val(ml_otrans),
copy_idx, matrix_idx,
matrix_nr_entries = DIM*DIM,
matrix_size = sizeof(Real)*matrix_nr_entries;
MGDesc *mg_desc = my_malloc(sizeof(MGDesc));
mg_desc->matrices = my_malloc(matrix_size*nr_matrices);
mg_desc->num_copies = nr_copies;
mg_desc->copies = my_malloc(sizeof(MGCopy)*nr_copies);
/* Initialise the matrices */
for (matrix_idx = 0; matrix_idx < nr_matrices; matrix_idx++) {
Real (*matrices)[3][3] = (Real (*)[3][3]) mg_desc->matrices,
(*matrix)[3] = matrices[matrix_idx];
value ml_matrix = Field(ml_otrans, matrix_idx);
size_t i, j;
if (Wosize_val(ml_matrix) == DIM) {
for (i = 0; i < DIM; i++) {
value ml_matrix_row = Field(ml_matrix, i);
if (Wosize_val(ml_matrix_row)/Double_wosize == DIM) {
for (j = 0; j < DIM; j++)
matrix[i][j] = Double_field(ml_matrix_row, j);
} else {
/* NOTE: bound checks are done only for array-s which are not
guaranteed to have the right number of entry by the type
system. */
mgdesc_destroy(mg_desc);
raise_with_string(*caml_named_value(my_except),
"Matrix row has wrong number of entries.");
assert(0);
}
}
} else {
mgdesc_destroy(mg_desc);
raise_with_string(*caml_named_value(my_except),
"Matrix has wrong number of rows.");
assert(0);
}
}
/* Initialise the copies */
for (copy_idx = 0; copy_idx < nr_copies; copy_idx++) {
MGCopy *mg_copy = & mg_desc->copies[copy_idx];
value ml_copy = Field(ml_copies_info, copy_idx);
size_t nr_otrans = Int_val(Field(ml_copy, 0));
value ml_translation = Field(ml_copy, 2);
/* Set the greyfactor */
mg_copy->grey_factor = Double_val(Field(ml_copy, 1));
/* Set the pointer to the transformation matrix */
if (nr_otrans < nr_matrices) {
Real *the_matrix =
(Real *) ((Real (*)[3][3]) mg_desc->matrices)[nr_otrans];
mg_copy->matrix = matrix_is_one(the_matrix) ? NULL : the_matrix;
} else {
mgdesc_destroy(mg_desc);
raise_with_string(*caml_named_value(my_except),
"Transformation index is out of bounds.");
assert(0);
}
/* Set the translation vector */
if (Wosize_val(ml_translation)/Double_wosize == DIM) {
size_t i;
for (i = 0; i < DIM; i++)
mg_copy->translation[i] = Double_field(ml_translation, i);
} else {
mgdesc_destroy(mg_desc);
raise_with_string(*caml_named_value(my_except),
"Translation vector should have dimension 3.");
assert(0);
}
}
return mg_desc;
}
/* Note: raise_with_string WILL copy the error message */
CAMLprim void tk_error(char *errmsg)
{
raise_with_string(*tkerror_exn, errmsg);
}
