Source file `spatial_reference.ml`

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
open Ctypes

exception Spatial_reference_error

type t = T.t
let t = T.t
let t_opt = T.t_opt
let err = T.err Spatial_reference_error

let new_spatial_reference =
  Lib.c "OSRNewSpatialReference"
    (ptr_opt string @-> returning t)

let import_from_proj4 =
  Lib.c "OSRImportFromProj4"
    (t @-> string @-> returning err)

let import_from_wkt =
  Lib.c "OSRImportFromWkt"
    (t @-> ptr string @-> returning err)

let set_well_known_geog_cs =
  Lib.c "OSRSetWellKnownGeogCS"
    (t @-> string @-> returning err)

let destroy_spatial_reference =
  Lib.c "OSRDestroySpatialReference"
    (t @-> returning void)

let export_to_proj4 =
  Lib.c "OSRExportToProj4"
    (t @-> ptr (ptr char) @-> returning err)

let export_to_wkt =
  Lib.c "OSRExportToWkt"
    (t @-> ptr (ptr char) @-> returning err)

let export_to_pretty_wkt =
  Lib.c "OSRExportToPrettyWkt"
    (t @-> ptr (ptr char) @-> int @-> returning err)

let free =
  Lib.c "OGRFree"
    (ptr void @-> returning void)

(* Higher level, wrapping functions *)

let make kind spec =
  let sr = new_spatial_reference None in
  Gc.finalise destroy_spatial_reference sr;
  let () =
    match kind with
    | `proj4 -> import_from_proj4 sr spec
    | `wkt ->
      let spec_ptr = allocate string spec in
      import_from_wkt sr spec_ptr
    | `name -> set_well_known_geog_cs sr spec
  in
  sr

(* Based on dbuenzli's string from char array example *)
let string_of_char_ptr p =
  let b = Buffer.create 256 in
  let continue = ref true in
  let i = ref 0 in
  while !continue do
    let c = !@(p +@ !i) in
    if c = '\x00' then continue := false else Buffer.add_char b c;
    incr i
  done;
  Buffer.contents b

let to_proj4 sr =
  let s = allocate (ptr char) (from_voidp char null) in
  export_to_proj4 sr s;
  let result = string_of_char_ptr !@s in
  free (to_voidp !@s);
  result

let to_wkt ?(pretty = false) ?(simplify = false) sr =
  let s = allocate (ptr char) (from_voidp char null) in
  let f x =
    if pretty then (
      export_to_pretty_wkt sr x (if simplify then 1 else 0)
    )
    else (
      export_to_wkt sr x
    )
  in
  f s;
  let result = string_of_char_ptr !@s in
  free (to_voidp !@s);
  result