2 Look at Bigarray module:
4 http://caml.inria.fr/pub/docs/manual-ocaml/manual043.html
5 http://pauillac.inria.fr/cdrom/www/caml/ocaml/htmlman/manual042.html
6 http://jhenrikson.org/forklift/checkout/doc/higher_order.html
10 http://webcvs.freedesktop.org/cairo/cairo-ocaml/test/basket.ml?revision=1.7&view=markup
13 prerr_endline "Bigarray, PPM and PNG (ARGB32) " ;
15 Bigarray.Array2.create Bigarray.int32 Bigarray.c_layout
16 (int_of_float y_inches * 72) (int_of_float x_inches * 72) in
17 Bigarray.Array2.fill arr 0xffffffl ;
18 let s = Cairo_bigarray.of_bigarr_32 ~alpha:true arr in
19 let c = Cairo.create s in
21 do_file_out "basket.ppm"
22 (fun oc -> Cairo_bigarray.write_ppm_int32 oc arr) ;
23 Cairo_png.surface_write_to_file s "basket.png"
27 ===========================================================================
29 Actually many scientific OCaml libraries use the bigarray module. It
30 is also the case of Lacaml (a binding to LAPACK) or FFTW (a binding
33 Now I do not understand why you could not have a function
35 val read_array1 : t -> ('a,'b,'c) Bigarray.Array1.t -> int
37 Sndfile.read_array1 f a read data from the file f into the supplied
38 bigarray a and return the number of float values read.
40 For multi-channel files, the array length must be an integer
41 multiple of the number of channels.
43 The idea is that the read function adapts the type of the bigarray
44 passed (if possible; if not, raise an exception). One could also
45 require that a Bigarray.Array2.t is used with one of its dimensions
46 being the number of channels (if possible allowing easy slicing to
47 extract a given channel).
49 Same goes for a write function.
51 BTW, the last part of the comment is a bit laconic: one wonders "or
52 what ?". An exception is raised ? The array slots with higher
53 indexes are never filled ? Garbage can be returned ? etc.
55 > I was particularly interested if there was any utility to providing
56 > functions for accessing shorts or ints. So far noone has come up
57 > with a need for these.
59 I did not follow thoroughly the discussion but there is an Int32
60 module and the C interface has "Int32_val(v)" and "Int64_val(v)". To
61 create a caml Int32.t (resp. Int64.t), you must allocate a custom
62 block containing an "int32" (resp. int64). See section 18 of the
67 ===========================================================================
70 (* cairo_bigarray.mli *)
76 ('a, 'b, c_layout) Array2.t -> Cairo.format ->
77 width:int -> height:int -> stride:int -> Cairo.image_surface
79 val of_bigarr_32 : alpha:bool -> (int32, int32_elt, c_layout) Array2.t -> Cairo.image_surface
80 val of_bigarr_24 : (int, int_elt, c_layout) Array2.t -> Cairo.image_surface
81 val of_bigarr_8 : (int, int8_unsigned_elt, c_layout) Array2.t -> Cairo.image_surface
83 val write_ppm_int32 : out_channel -> (int32, int32_elt, c_layout) Array2.t -> unit
84 val write_ppm_int : out_channel -> (int, int_elt, c_layout) Array2.t -> unit
92 (* cairo_bigarray.ml *)
97 external bigarray_kind_float : ('a, 'b, c_layout) Array2.t -> bool
98 = "ml_bigarray_kind_float"
99 external bigarray_byte_size : ('a, 'b, c_layout) Array2.t -> int
100 = "ml_bigarray_byte_size"
102 external image_surface_create :
103 ('a, 'b, c_layout) Array2.t ->
104 Cairo.format -> width:int -> height:int -> stride:int ->
105 Cairo.image_surface = "ml_cairo_image_surface_create_for_data"
108 let of_bigarr arr format ~width ~height ~stride =
109 if bigarray_kind_float arr
110 then invalid_arg "wrong Bigarray kind" ;
111 if bigarray_byte_size arr < stride * height
112 then invalid_arg "Bigarray too small" ;
113 image_surface_create arr format width height stride
115 let of_bigarr_32 ~alpha (arr : (int32, int32_elt, c_layout) Array2.t) =
116 let h = Array2.dim1 arr in
117 let w = Array2.dim2 arr in
119 (if alpha then Cairo.FORMAT_ARGB32 else Cairo.FORMAT_RGB24)
122 let of_bigarr_24 (arr : (int, int_elt, c_layout) Array2.t) =
123 if Sys.word_size <> 32
124 then failwith "your ints have 63 bits" ;
125 let h = Array2.dim1 arr in
126 let w = Array2.dim2 arr in
131 let of_bigarr_8 (arr : (int, int8_unsigned_elt, c_layout) Array2.t) =
132 let h = Array2.dim1 arr in
133 let w = Array2.dim2 arr in
138 let output_pixel oc p =
139 let r = (p lsr 16) land 0xff in
141 let g = (p lsr 8) land 0xff in
143 let b = p land 0xff in
146 let write_ppm_int32 oc (arr : (int32, int32_elt, c_layout) Array2.t) =
147 let h = Array2.dim1 arr in
148 let w = Array2.dim2 arr in
149 Printf.fprintf oc "P6 %d %d 255\n" w h ;
152 output_pixel oc (Int32.to_int arr.{i, j})
157 let write_ppm_int oc (arr : (int, int_elt, c_layout) Array2.t) =
158 let h = Array2.dim1 arr in
159 let w = Array2.dim2 arr in
160 Printf.fprintf oc "P6 %d %d 255\n" w h ;
163 output_pixel oc arr.{i, j}