diff --git a/.ocamlformat b/.ocamlformat index 1b64a37..c54116a 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.21.0 +version=0.24.1 assignment-operator=end-line break-cases=fit break-fun-decl=wrap diff --git a/src/image.ml b/src/image.ml index b6df556..243309b 100644 --- a/src/image.ml +++ b/src/image.ml @@ -115,7 +115,7 @@ let make_thumbnail content = Cmd.( v "convert" % "-define" % "jpeg:size=700x700" % p image_file % "-auto-orient" % "-thumbnail" % "300x300>" % "-unsharp" % "0x.5" - % "-format" % "jpg" % p thumb_file) + % "-format" % "jpg" % p thumb_file ) in let* () = OS.Cmd.run cmd in let* thumbnail = OS.File.read thumb_file in diff --git a/src/js/dune b/src/js/dune index d829312..b589c7b 100644 --- a/src/js/dune +++ b/src/js/dune @@ -15,7 +15,7 @@ (library (name js_map) (modules js_map) - (libraries js_of_ocaml brr) + (libraries js_of_ocaml brr leaflet) (js_of_ocaml (javascript_files leaflet/leaflet.js)) (preprocess @@ -32,7 +32,7 @@ (executable (name js_babillard) (modules js_babillard) - (libraries js_of_ocaml brr js_map js_post_form js_pretty_post) + (libraries js_of_ocaml brr js_map js_post_form js_pretty_post leaflet) (modes js) (preprocess (pps js_of_ocaml-ppx))) diff --git a/src/js/js_babillard.ml b/src/js/js_babillard.ml index f099977..960e665 100644 --- a/src/js/js_babillard.ml +++ b/src/js/js_babillard.ml @@ -32,7 +32,7 @@ module Visibility = struct set_visible return_button; set_invisible thread_preview_div; Option.iter set_invisible new_thread_button; - ignore @@ Jv.call Leaflet.map "closePopup" [||] + Leaflet.Map.close_popup ~popup:None map let to_babillard_mode _event = log "change_page_mode@\n"; @@ -41,7 +41,7 @@ module Visibility = struct set_invisible return_button; set_visible thread_preview_div; Option.iter set_visible new_thread_button; - ignore @@ Jv.call Leaflet.map "closePopup" [||] + Leaflet.Map.close_popup ~popup:None map let () = log "add events on return/new thread button@\n"; @@ -71,15 +71,14 @@ module Marker = struct log "on_each_feature@\n"; let feature_properties = Jv.get feature "properties" in let thread_preview = Jv.get feature_properties "content" in - ignore - @@ Jv.call layer "on" - [| Jv.of_string "click"; Jv.repr (marker_on_click thread_preview) |] + Leaflet.Layer.on Leaflet.Event.Click (marker_on_click thread_preview) layer let handle_geojson geojson = log "handle_geojson@\n"; - let dict = Jv.obj [| ("onEachFeature", Jv.repr on_each_feature) |] in - let layer = Jv.call Leaflet.leaflet "geoJSON" [| geojson; dict |] in - let _marker_layer = Jv.call layer "addTo" [| Leaflet.map |] in + let layer = + Leaflet.Layer.create_geojson geojson [ On_each_feature on_each_feature ] + in + let _marker_layer = Leaflet.Layer.add_to map layer in () let markers_handle_response response = @@ -104,22 +103,19 @@ let button = Jv.get Jv.global "submit-new-thread-button" let on_click_set_latlng e = log "on_click_set_latlng@\n"; if !Visibility.is_in_new_thread_mode then ( - let lat_lng = Jv.get e "latlng" in - ignore @@ Jv.call Leaflet.popup "setLatLng" [| lat_lng |]; - ignore - @@ Jv.call Leaflet.popup "setContent" - [| Jv.of_string "create thread here" |]; - ignore @@ Jv.call Leaflet.popup "openOn" [| Leaflet.map |]; + let latlng = Leaflet.Event.latlng e in + let popup = + Leaflet.Popup.create ~content:(Some "create thread here") + ~latlng:(Some latlng) [] + in + Leaflet.Map.open_popup popup map; - let lat = Jv.get lat_lng "lat" in - let lng = Jv.get lat_lng "lng" in + let lat = Leaflet.Latlng.lat latlng |> Jv.of_float in + let lng = Leaflet.Latlng.lng latlng |> Jv.of_float in ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |]; ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |]; ignore @@ Jv.call button "removeAttribute" [| Jv.of_string "disabled" |] ) (*add on_click callback to map*) -let () = - ignore - @@ Jv.call Leaflet.map "on" - [| Jv.of_string "click"; Jv.repr on_click_set_latlng |] +let () = Leaflet.Map.on Leaflet.Event.Click on_click_set_latlng map diff --git a/src/js/js_map.ml b/src/js/js_map.ml index 2906e08..4e5060f 100644 --- a/src/js/js_map.ml +++ b/src/js/js_map.ml @@ -1,101 +1,68 @@ let log = Format.printf -module Leaflet = struct - (* get the leaflet object *) - let leaflet = - match Jv.(find global "L") with - | Some l -> l - | None -> failwith "can't load leaflet" +let map = Leaflet.Map.create_on "map" - (* get popup object *) - let popup = Jv.call leaflet "popup" [||] +let () = + let osm_layer = Leaflet.Layer.create_tile_osm None in + Leaflet.Layer.add_to map osm_layer - (* create a map *) - let map = - log "creating map@\n"; - let open Brr in - let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in - Jv.call leaflet "map" [| Jv.of_string "map" |] +let storage = Brr_io.Storage.local Brr.G.window - (* create map tile layer *) - let tile_layer = - log "creating tile layer@\n"; - Jv.call leaflet "tileLayer" - [| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" - ; Jv.obj - [| ( "attribution" - , Jv.of_string - {|© OpenStreetMap contributors|} - ) - |] - |] +(* set map's view *) +(* try to set map's view to last position viewed by using web storage *) +let () = + log "setting view@\n"; + let lat = Brr_io.Storage.get_item storage (Jstr.of_string "lat") in + let lng = Brr_io.Storage.get_item storage (Jstr.of_string "lng") in + let zoom = Brr_io.Storage.get_item storage (Jstr.of_string "zoom") in + match (lat, lng, zoom) with + | Some lat, Some lng, Some zoom -> + let lat = Jstr.to_float lat in + let lng = Jstr.to_float lng in + let zoom = + match Jstr.to_int zoom with + | None -> failwith "view storage bug" + | Some zoom -> Some zoom + in + let latlng = Leaflet.Latlng.create lat lng in + ignore @@ Leaflet.Map.set_view latlng ~zoom map + | _ -> + let latlng = Leaflet.Latlng.create 51.505 (-0.09) in + ignore @@ Leaflet.Map.set_view latlng ~zoom:(Some 13) map - (* add tile layer *) - let () = - log "adding tile layer@\n"; - let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in - () - - let storage = Brr_io.Storage.local Brr.G.window - - (* set map's view *) - (* try to set map's view to last position viewed by using web storage *) - let () = - log "setting view@\n"; - let lat = Brr_io.Storage.get_item storage (Jstr.of_string "lat") in - let lng = Brr_io.Storage.get_item storage (Jstr.of_string "lng") in - let zoom = Brr_io.Storage.get_item storage (Jstr.of_string "zoom") in - match (lat, lng, zoom) with - | Some lat, Some lng, Some zoom -> - let latlng = - Jv.call leaflet "latLng" [| Jv.of_jstr lat; Jv.of_jstr lng |] - in - ignore @@ Jv.call map "setView" [| latlng; Jv.of_jstr zoom |] - | _ -> - let latlng = - Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |] - in - ignore @@ Jv.call map "setView" [| latlng; Jv.of_int 13 |] - - let on_moveend _event = - log "on moveend event@\n"; - let latlng = Jv.call map "getCenter" [||] in - (*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *) - let wrapped_latlng = Jv.call map "wrapLatLng" [| latlng |] in - let lat = Jv.get wrapped_latlng "lat" in - let lng = Jv.get wrapped_latlng "lng" in - match - Brr_io.Storage.set_item storage (Jstr.of_string "lat") (Jv.to_jstr lat) - with +let on_moveend _event = + log "on moveend event@\n"; + let latlng = Leaflet.Map.get_center map in + (*we need to wrap coordinates so we don't drift into a parralel universe and lose track of markers :^) *) + let wrapped_latlng = Leaflet.Map.wrap_latlng latlng map in + let lat = Leaflet.Latlng.lat latlng |> Jv.of_float |> Jv.to_jstr in + let lng = Leaflet.Latlng.lng latlng |> Jv.of_float |> Jv.to_jstr in + match Brr_io.Storage.set_item storage (Jstr.of_string "lat") lat with + | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" + | Ok () -> ( + match Brr_io.Storage.set_item storage (Jstr.of_string "lng") lng with | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" - | Ok () -> ( - match - Brr_io.Storage.set_item storage (Jstr.of_string "lng") (Jv.to_jstr lng) - with - | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" - | Ok () -> - let is_wrapped = - not @@ Jv.to_bool @@ Jv.call latlng "equals" [| wrapped_latlng |] - in - if is_wrapped then ( - log "setView to wrapped coordinate@\n"; - (* warning: calling setView in on_moveend can cause recursion *) - ignore @@ Jv.call map "setView" [| wrapped_latlng |] ) ) + | Ok () -> + let is_wrapped = not @@ Leaflet.Latlng.equals latlng wrapped_latlng in + if is_wrapped then ( + log "setView to wrapped coordinate@\n"; + (* warning: calling setView in on_moveend can cause recursion *) + Leaflet.Map.set_view wrapped_latlng ~zoom:None map ) ) - let on_zoomend _event = - log "on zoomend event@\n"; - let zoom = Jv.call map "getZoom" [||] in - match - Brr_io.Storage.set_item storage (Jstr.of_string "zoom") (Jv.to_jstr zoom) - with - | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" - | Ok () -> () +let on_zoomend _event = + log "on zoomend event@\n"; + let zoom = Leaflet.Map.get_zoom map in + match + Brr_io.Storage.set_item storage (Jstr.of_string "zoom") + (Jv.to_jstr @@ Jv.of_int zoom) + with + | (exception Jv.Error _) | Error _ -> failwith "can't set latlng storage" + | Ok () -> () - let () = - log "add on (move/zoom)end event@\n"; - ignore @@ Jv.call map "on" [| Jv.of_string "moveend"; Jv.repr on_moveend |]; - ignore @@ Jv.call map "on" [| Jv.of_string "zoomend"; Jv.repr on_zoomend |] -end +let () = + log "add on (move/zoom)end event@\n"; + Leaflet.Map.on Leaflet.Event.Move_end on_moveend map; + Leaflet.Map.on Leaflet.Event.Zoom_end on_zoomend map module Geolocalize = struct let update_location geo = @@ -105,10 +72,8 @@ module Geolocalize = struct | Ok geo -> let lat = Brr_io.Geolocation.Pos.latitude geo in let lng = Brr_io.Geolocation.Pos.longitude geo in - let latlng = - Jv.call Leaflet.leaflet "latLng" [| Jv.of_float lat; Jv.of_float lng |] - in - ignore @@ Jv.call Leaflet.map "setView" [| latlng; Jv.of_int 13 |] + let latlng = Leaflet.Latlng.create lat lng in + Leaflet.Map.set_view latlng ~zoom:(Some 13) map let geolocalize _ = log "geolocalize@\n";