1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
open Bigarray
open Base
type 'a result = ('a, [ `Msg of string ]) Result.t
type 'kind buffer = ('a, 'b, c_layout) Array1.t constraint 'kind = ('a, 'b) kind
type 'kind t =
{ width : int
; height : int
; channels : int
; offset : int
; stride : int
; data : 'kind buffer
}
type float32 = (float, float32_elt) kind
type int8 = (int, int8_unsigned_elt) kind
external load_unmanaged : ?channels:int -> string -> int8 t result = "ml_stbi_load"
external loadf_unmanaged : ?channels:int -> string -> float32 t result = "ml_stbi_loadf"
external decode_unmanaged
: ?channels:int
-> _ buffer
-> int8 t result
= "ml_stbi_load_mem"
external decodef_unmanaged
: ?channels:int
-> _ buffer
-> float32 t result
= "ml_stbi_loadf_mem"
external ml_stbi_image_free : _ buffer -> unit = "ml_stbi_image_free"
let free_unmanaged image = ml_stbi_image_free image.data
let clone buf =
let buf' = Array1.create (Array1.kind buf) c_layout (Array1.dim buf) in
Array1.blit buf buf';
buf'
;;
let manage f ?channels filename =
match f ?channels filename with
| Result.Error _ as err -> err
| Result.Ok image ->
let managed = { image with data = clone image.data } in
free_unmanaged image;
Result.Ok managed
;;
let load ?channels filename = manage load_unmanaged ?channels filename
let loadf ?channels filename = manage loadf_unmanaged ?channels filename
let decode ?channels filename = manage decode_unmanaged ?channels filename
let decodef ?channels filename = manage decodef_unmanaged ?channels filename
let image ~width ~height ~channels ?(offset = 0) ?(stride = width * channels) data =
let size = Array1.dim data in
if width < 0
then Result.Error (`Msg "width should be positive")
else if height < 0
then Result.Error (`Msg "height should be positive")
else if channels < 0 || channels > 4
then Result.Error (`Msg "channels should be between 1 and 4")
else if offset < 0
then Result.Error (`Msg "offset should be positive")
else if offset + (stride * height) > size
then Result.Error (`Msg "image does not fit in buffer")
else Result.Ok { width; height; channels; offset; stride; data }
;;
let width t = t.width
let height t = t.height
let channels t = t.channels
let data t = t.data
let validate_mipmap t1 t2 =
if t1.channels <> t2.channels
then invalid_arg "mipmap: images have different number of channels";
if t1.width / 2 <> t2.width || t1.height / 2 <> t2.height
then invalid_arg "mipmap: second image size should exactly be half of first image"
;;
external mipmap : int8 t -> int8 t -> unit = "ml_stbi_mipmap"
external mipmapf : float32 t -> float32 t -> unit = "ml_stbi_mipmapf"
let mipmap t1 t2 =
validate_mipmap t1 t2;
mipmap t1 t2
;;
let mipmapf t1 t2 =
validate_mipmap t1 t2;
mipmapf t1 t2
;;
external vflip : int8 t -> unit = "ml_stbi_vflip"
external vflipf : float32 t -> unit = "ml_stbi_vflipf"
(** Blur the image *)
external expblur : int8 t -> radius:float -> unit = "ml_stbi_expblur"