add js_newthread.ml; make newthread_page beautiful

src/content/assets/js/dune

@@ -16,6 +16,15 @@
    %{target}
    (cat ../../../js_babillard.bc.js))))
 
+(rule
+ (target js_newthread.js)
+ (deps
+  (file ../../../js_newthread.bc.js))
+ (action
+  (with-stdout-to
+   %{target}
+   (cat ../../../js_newthread.bc.js))))
+
 (rule
  (target js_thread.js)
  (deps

src/dune

@@ -50,6 +50,16 @@
  (preprocess
   (pps js_of_ocaml-ppx)))
 
+(executable
+ (name js_newthread)
+ (modules js_newthread)
+ (libraries js_of_ocaml brr)
+ (modes js)
+ (js_of_ocaml
+  (javascript_files leaflet/leaflet.js))
+ (preprocess
+  (pps js_of_ocaml-ppx)))
+
 (executable
  (name js_thread)
  (modules js_thread)
@@ -114,6 +124,7 @@
   (source_tree content)
   (file content/assets/js/js_plant_map.js)
   (file content/assets/js/js_babillard.js)
+  (file content/assets/js/js_newthread.js)
   (file content/assets/js/js_thread.js))
  (action
   (with-stdout-to

src/js_newthread.ml

@@ -0,0 +1,107 @@
+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"
+
+  (* get popup object *)
+  let popup = Jv.call leaflet "popup" [||]
+
+  (* create a map *)
+  let map =
+    log "creating map@.";
+    let open Brr in
+    let _container = El.div ~at:At.[ id (Jstr.v "map") ] [] in
+    Jv.call leaflet "map" [| Jv.of_string "map" |]
+
+  (* create map's pos *)
+  let lat_lng =
+    log "making latlng@.";
+    Jv.call leaflet "latLng" [| Jv.of_float 51.505; Jv.of_float (-0.09) |]
+
+  (* set map's pos *)
+  let () =
+    log "setting view@.";
+    let _m : Jv.t = Jv.call map "setView" [| lat_lng; Jv.of_int 13 |] in
+    ()
+
+  (* create map tile layer *)
+  let tile_layer =
+    log "creating tile layer@.";
+    Jv.call leaflet "tileLayer"
+      [| Jv.of_string "https://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
+       ; Jv.obj
+           [| ( "attribution"
+              , Jv.of_string
+                  {|&copy; <a href="https://.www.openstreetmap.org/copyright">OpenStreetMap</a> contributors|}
+              )
+           |]
+      |]
+
+  (* add tile layer *)
+  let () =
+    log "adding tile layer@.";
+    let _map : Jv.t = Jv.call tile_layer "addTo" [| map |] in
+    ()
+end
+
+module Marker = struct
+  let board =
+    let board_div = Jv.get Jv.global "board" in
+    Jv.to_string
+      (Jv.call board_div "getAttribute" [| Jv.of_string "data-board" |])
+
+  let handle_geojson geojson =
+    log "handle_geojson@.";
+    log "feed geojson to leaflet@.";
+    let layer = Jv.call Leaflet.leaflet "geoJSON" [| geojson |] in
+    let _marker_layer = Jv.call layer "addTo" [| Leaflet.map |] in
+    ()
+
+  let markers_handle_response response =
+    log "markers_handle_response@.";
+    let geo_json_list_futur = Jv.call response "json" [||] in
+    ignore @@ Jv.call geo_json_list_futur "then" [| Jv.repr handle_geojson |];
+    ()
+
+  let () =
+    log "fetch thread geojson@.";
+    let window = Jv.get Jv.global "window" in
+    let link = Jv.of_string (Format.sprintf "/%s/markers" board) in
+    let fetchfutur = Jv.call window "fetch" [| link |] in
+    ignore @@ Jv.call fetchfutur "then" [| Jv.repr markers_handle_response |];
+    ()
+end
+
+let on_click e =
+  log "on_click@.";
+
+  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 "euujjj" |];
+  ignore @@ Jv.call Leaflet.popup "openOn" [| Leaflet.map |];
+
+  let lat = Jv.get lat_lng "lat" in
+  let lng = Jv.get lat_lng "lng" in
+  let lat_input = Jv.get Jv.global "lat_input" in
+  let lng_input = Jv.get Jv.global "lng_input" in
+  ignore @@ Jv.call lat_input "setAttribute" [| Jv.of_string "value"; lat |];
+  ignore @@ Jv.call lng_input "setAttribute" [| Jv.of_string "value"; lng |];
+
+  let form_div = Jv.get Jv.global "newthread-form" in
+  ignore
+  @@ Jv.call form_div "setAttribute"
+       [| Jv.of_string "style"; Jv.of_string "visibility:visible" |];
+  let board_div = Jv.get Jv.global "board" in
+  ignore
+  @@ Jv.call board_div "setAttribute"
+       [| Jv.of_string "style"; Jv.of_string "visibility:hidden" |];
+  ()
+
+(*add on_click callback to map*)
+let () =
+  ignore
+  @@ Jv.call Leaflet.map "on" [| Jv.of_string "click"; Jv.repr on_click |]

src/newthread_page.eml.html

@@ -1,6 +1,17 @@
 let f ~board request =
-<script type="text/javascript" src="/assets/js/js_babillard.js" defer="defer"></script>
 %let url = Format.asprintf "/%a/new_thread" Babillard.pp_board board in
+% begin match Dream.session "nick" request with
+% | None ->
+Login to make a new thread.
+% | Some _nick ->
+<script type="text/javascript" src="/assets/js/js_newthread.js" defer="defer"></script>
+<div id="board" data-board="babillard">Click the map to make a new thread:</div>
+<div class="row mb-3">
+    <div class="col-md-6">
+        <div id="map"></div>
+    </div>
+
+    <div class="col-md-6" id="newthread-form" style="visibility:hidden">
 <%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %>
         <input type="hidden" id="lat_input" name="lat_input">
         <input type="hidden" id="lng_input" name="lng_input">
@@ -16,6 +27,8 @@ let f ~board request =
 
         <input id="file" name="file" aria-describedby="fileHelp" type="file">
         <div id="fileHelp" class="form-text">Add a picture for your thread</div>
-        <div id="map"></div>
       <button type="submit" class="btn btn-primary">Make Thread</button>
 </form>
+    </div>
+</div>
+% end;