leaflet/src/icon.ml

(* BSD-2-Clause License *)

type t = Jv.t

let to_jv = Fun.id

let of_jv = Fun.id

type opt =
  | Icon_retina_url of string
  | Icon_size of Point.t
  | Icon_anchor of Point.t
  | Popup_anchor of Point.t
  | Tooltip_anchor of Point.t
  | Shadow_url of string
  | Shadow_retina_url of string
  | Shadow_size of Point.t
  | Shadow_anchor of Point.t
  | Class_name of string
  | Cross_origin of string option

let to_string = function
  | Icon_retina_url _ -> "iconRetinaUrl"
  | Icon_size _ -> "iconSize"
  | Icon_anchor _ -> "iconAnchor"
  | Popup_anchor _ -> "popupAnchor"
  | Tooltip_anchor _ -> "tooltipAnchor"
  | Shadow_url _ -> "shadowUrl"
  | Shadow_retina_url _ -> "shadowRetinaUrl"
  | Shadow_size _ -> "shadowSize"
  | Shadow_anchor _ -> "shadowAnchor"
  | Class_name _ -> "className"
  | Cross_origin _ -> "crossOrigin"

let opt_to_jv = function
  | Icon_size p
  | Icon_anchor p
  | Popup_anchor p
  | Tooltip_anchor p
  | Shadow_size p
  | Shadow_anchor p ->
    Point.to_jv p
  | Icon_retina_url s | Shadow_url s | Shadow_retina_url s | Class_name s ->
    Jv.of_string s
  | Cross_origin o -> (
    match o with Some s -> Jv.of_string s | None -> Jv.of_bool false )

let create icon_url options =
  let l = List.map (fun o -> (to_string o, opt_to_jv o)) options in
  let l = Array.of_list @@ (("iconUrl", Jv.of_string icon_url) :: l) in
  Jv.call Global.leaflet "icon" [| Jv.obj l |]

let create_div ~html ~bg_pos options =
  let l = List.map (fun o -> (to_string o, opt_to_jv o)) options in
  let div_options =
    let html =
      match html with
      | None -> []
      | Some html -> [ ("html", Jv.of_string html) ]
    in
    let bg_pos =
      match bg_pos with
      | None -> []
      | Some bg_pos -> [ ("bgPos", Point.to_jv bg_pos) ]
    in
    html @ bg_pos
  in
  let l = Array.of_list @@ div_options @ l in
  Jv.call Global.leaflet "divIcon" [| Jv.obj l |]