value gamma_CAML_rates( value a, value b, value c )
{
CAMLparam3(a,b,c);
CAMLlocal1( rates );
double alpha,beta,*rate_ray,*pcut_ray;
int cats,j;
long dims[1];
alpha = Double_val( a );
beta = Double_val( b );
cats = Int_val( c );
assert( cats > 0 );
rate_ray = (double*) malloc( sizeof(double)*cats );
CHECK_MEM(rate_ray);
if( 1 == cats ){
rate_ray[0] = 1.0;
} else {
pcut_ray = (double*) malloc( sizeof(double)*cats );
CHECK_MEM(pcut_ray);
for(j=1;j<cats;++j)
pcut_ray[j-1] = gamma_pp( (double)j/(double)cats, alpha, beta );
gamma_rates( rate_ray, alpha, beta, pcut_ray, cats );
free( pcut_ray );
}
dims[0] = cats;
rates = alloc_bigarray(BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT,1,rate_ray,dims);
CAMLreturn( rates );
}
value
sankoff_CAML_get_e_array (value a) {
CAMLparam1(a);
elt_p ep;
ep = Sankoff_return_elt(a);
int num_states = ep->num_states;
long dims[1];
dims[0] = num_states;
CAMLreturn(alloc_bigarray(BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 1, ep->e, dims));
}
value
sankoff_CAML_get_states(value this_elt, value this_or_left_or_right) {
CAMLparam2(this_elt,this_or_left_or_right);
CAMLlocal1(res);
elt_p ep;
Sankoff_elt_custom_val(ep,this_elt);
int whatstate = Int_val(this_or_left_or_right);
int num_states = ep->num_states;
long dims[1];
dims[0] = num_states;
if (whatstate==1)
CAMLreturn( alloc_bigarray(BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 1, ep->states, dims));
else if (whatstate==2)
CAMLreturn( alloc_bigarray(BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 1, ep->leftstates, dims));
else if (whatstate==3)
CAMLreturn( alloc_bigarray(BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 1, ep->rightstates, dims));
else
failwith ("sankoff_CAML_get_states,must pick which state array you need (1=states,2=leftstates,3=rightstates)");
}
value
sankoff_CAML_get_tcm (value this_eltarr)
{
CAMLparam1(this_eltarr);
CAMLlocal1(res);
eltarr_p eap;
Sankoff_eltarr_custom_val(eap,this_eltarr);
int num_states=eap->num_states;
long dims[2];
dims[0] = num_states; dims[1] = num_states;
CAMLreturn(alloc_bigarray(BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 2, eap->tcm, dims));
}
CAMLprim value
ml_sqlite3_column_blob_big (value s, value i)
{
CAMLparam1(s);
CAMLlocal1(r);
intnat len;
const void * data;
len = sqlite3_column_bytes (Sqlite3_stmt_val (s), Int_val (i));
r = alloc_bigarray (BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT, 1, NULL, &len);
data = sqlite3_column_blob (Sqlite3_stmt_val (s), Int_val(i));
memcpy (Data_bigarray_val(r), data, len);
CAMLreturn(r);
}
value grappa_CAML_get_gene_bigarr (value in_genome,value num_gene)
{
CAMLparam2(in_genome,num_gene);
CAMLlocal1(res);
int NUM_GENES;
NUM_GENES = Int_val(num_gene);
struct genome_struct * g1;
long dims[1]; dims[0] = NUM_GENES;
g1 = (struct genome_struct *) Data_custom_val (in_genome);
res = alloc_bigarray (BIGARRAY_INT32 | BIGARRAY_C_LAYOUT, 1,
g1->genes,dims);
CAMLreturn(res);
}
CAMLprim value
magick_loader(value input)
{
CAMLparam1(input);
CAMLlocal2(pixel_matrix, res);
Image *image_bloc;
int image_type_code;
int components;
GLenum format;
ExceptionInfo exception;
GetExceptionInfo(&exception);
{
if (IsMagickInstantiated() == MagickFalse) {
InitializeMagick(getenv("PWD"));
}
{
ImageInfo *image_info;
image_info = CloneImageInfo((ImageInfo *) NULL);
switch (Tag_val(input))
{
/* given a filename of an image */
case 0:
(void) strcpy(image_info->filename, String_val(Field(input,0)));
image_bloc = ReadImage(image_info, &exception);
break;
/* given the image data in a buffer */
case 1:
image_bloc = BlobToImage(
image_info,
(void *)String_val(Field(input,0)),
caml_string_length(Field(input,0)),
&exception);
break;
}
DestroyImageInfo(image_info);
}
if (exception.severity != UndefinedException) {
if (image_bloc != (Image *) NULL) {
DestroyImage(image_bloc);
}
DestroyExceptionInfo(&exception);
caml_failwith( exception.reason );
/* @TODO exception.description */
}
if (image_bloc == (Image *) NULL) {
DestroyExceptionInfo(&exception);
caml_failwith("read image failed");
}
}
{
ImageType image_type;
image_type = GetImageType( image_bloc, &exception );
if (exception.severity != UndefinedException)
caml_failwith( exception.reason );
image_type_code = Val_ImageType(image_type, &components);
if ( image_type_code == 11 )
caml_failwith("getting image type failed");
}
{
unsigned long x, y;
unsigned long columns, rows;
PixelPacket pixel;
columns = image_bloc->columns;
rows = image_bloc->rows;
const PixelPacket * pixel_packet_array;
pixel_packet_array =
AcquireImagePixels(
image_bloc,
0, 0, columns, rows,
&exception );
if (exception.severity != UndefinedException) {
caml_failwith(exception.reason);
}
{
unsigned char *image;
long ndx;
long dims[3];
dims[0] = columns;
dims[1] = rows;
dims[2] = components;
pixel_matrix = alloc_bigarray(BIGARRAY_UINT8 | BIGARRAY_C_LAYOUT, 3, NULL, dims);
image = Data_bigarray_val(pixel_matrix);
for (x=0; x < columns; ++x) {
for (y=0; y < rows; ++y) {
pixel = pixel_packet_array[(columns * y) + x];
ndx = (columns * y * components) + (x * components);
switch (components) {
case 1:
image[ndx + 0] = pixel.red / SCALE;
break;
case 2:
image[ndx + 0] = pixel.red / SCALE;
image[ndx + 1] = ( MaxMap - pixel.opacity ) / SCALE;
break;
case 3:
image[ndx + 0] = pixel.red / SCALE;
image[ndx + 1] = pixel.green / SCALE;
image[ndx + 2] = pixel.blue / SCALE;
break;
case 4:
image[ndx + 0] = pixel.red / SCALE;
image[ndx + 1] = pixel.green / SCALE;
image[ndx + 2] = pixel.blue / SCALE;
image[ndx + 3] = ( MaxMap - pixel.opacity ) / SCALE;
break;
}
}
}
}
switch (components) {
case 1: format = GL_LUMINANCE; break;
case 2: format = GL_LUMINANCE_ALPHA; break;
case 3: format = GL_RGB; break;
case 4: format = GL_RGBA; break;
}
res = alloc_tuple(5);
Store_field(res, 0, pixel_matrix );
Store_field(res, 1, Val_long(columns) );
Store_field(res, 2, Val_long(rows) );
Store_field(res, 3, Val_internal_format(components) );
Store_field(res, 4, Val_pixel_data_format(format) );
}
DestroyExceptionInfo(&exception);
DestroyImage(image_bloc);
CAMLreturn(res);
}
CAMLprim value caml_ba_map_file(value vfd, value vkind, value vlayout,
value vshared, value vdim, value vstart)
{
HANDLE fd, fmap;
int flags, major_dim, mode, perm;
intnat num_dims, i;
intnat dim[MAX_NUM_DIMS];
__int64 currpos, startpos, file_size, data_size;
uintnat array_size, page, delta;
char c;
void * addr;
LARGE_INTEGER li;
SYSTEM_INFO sysinfo;
fd = Handle_val(vfd);
flags = Int_val(vkind) | Int_val(vlayout);
startpos = Int64_val(vstart);
num_dims = Wosize_val(vdim);
major_dim = flags & BIGARRAY_FORTRAN_LAYOUT ? num_dims - 1 : 0;
/* Extract dimensions from Caml array */
num_dims = Wosize_val(vdim);
if (num_dims < 1 || num_dims > MAX_NUM_DIMS)
invalid_argument("Bigarray.mmap: bad number of dimensions");
for (i = 0; i < num_dims; i++) {
dim[i] = Long_val(Field(vdim, i));
if (dim[i] == -1 && i == major_dim) continue;
if (dim[i] < 0 || dim[i] > 0x7FFFFFFFL)
invalid_argument("Bigarray.create: negative dimension");
}
/* Determine file size */
currpos = caml_ba_set_file_pointer(fd, 0, FILE_CURRENT);
if (currpos == -1) caml_ba_sys_error();
file_size = caml_ba_set_file_pointer(fd, 0, FILE_END);
if (file_size == -1) caml_ba_sys_error();
/* Determine array size in bytes (or size of array without the major
dimension if that dimension wasn't specified) */
array_size = bigarray_element_size[flags & BIGARRAY_KIND_MASK];
for (i = 0; i < num_dims; i++)
if (dim[i] != -1) array_size *= dim[i];
/* Check if the first/last dimension is unknown */
if (dim[major_dim] == -1) {
/* Determine first/last dimension from file size */
if (file_size < startpos)
failwith("Bigarray.mmap: file position exceeds file size");
data_size = file_size - startpos;
dim[major_dim] = (uintnat) (data_size / array_size);
array_size = dim[major_dim] * array_size;
if (array_size != data_size)
failwith("Bigarray.mmap: file size doesn't match array dimensions");
}
/* Restore original file position */
caml_ba_set_file_pointer(fd, currpos, FILE_BEGIN);
/* Create the file mapping */
if (Bool_val(vshared)) {
perm = PAGE_READWRITE;
mode = FILE_MAP_WRITE;
} else {
perm = PAGE_READONLY; /* doesn't work under Win98 */
mode = FILE_MAP_COPY;
}
li.QuadPart = startpos + array_size;
fmap = CreateFileMapping(fd, NULL, perm, li.HighPart, li.LowPart, NULL);
if (fmap == NULL) caml_ba_sys_error();
/* Determine offset so that the mapping starts at the given file pos */
GetSystemInfo(&sysinfo);
delta = (uintnat) (startpos % sysinfo.dwPageSize);
/* Map the mapping in memory */
li.QuadPart = startpos - delta;
addr =
MapViewOfFile(fmap, mode, li.HighPart, li.LowPart, array_size + delta);
if (addr == NULL) caml_ba_sys_error();
addr = (void *) ((uintnat) addr + delta);
/* Close the file mapping */
CloseHandle(fmap);
/* Build and return the Caml bigarray */
return alloc_bigarray(flags | BIGARRAY_MAPPED_FILE, num_dims, addr, dim);
}
