From 99c073648238d67e915c2974a7af6a6fbe2da9a6 Mon Sep 17 00:00:00 2001 From: Swrup Date: Mon, 17 Jan 2022 23:59:50 +0100 Subject: [PATCH] add js_newthread.ml; make newthread_page beautiful --- src/content/assets/js/dune | 9 +++ src/dune | 11 ++++ src/js_newthread.ml | 107 ++++++++++++++++++++++++++++++++++++ src/newthread_page.eml.html | 21 +++++-- 4 files changed, 144 insertions(+), 4 deletions(-) create mode 100644 src/js_newthread.ml diff --git a/src/content/assets/js/dune b/src/content/assets/js/dune index b901998..96effaf 100644 --- a/src/content/assets/js/dune +++ b/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 diff --git a/src/dune b/src/dune index 09e07d5..8862041 100644 --- a/src/dune +++ b/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 diff --git a/src/js_newthread.ml b/src/js_newthread.ml new file mode 100644 index 0000000..12ac29c --- /dev/null +++ b/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 + {|© OpenStreetMap 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 |] diff --git a/src/newthread_page.eml.html b/src/newthread_page.eml.html index a0cdff2..304148d 100644 --- a/src/newthread_page.eml.html +++ b/src/newthread_page.eml.html @@ -1,7 +1,18 @@ let f ~board request = - %let url = Format.asprintf "/%a/new_thread" Babillard.pp_board board in - <%s! Dream.form_tag ~action:url ~enctype:`Multipart_form_data request %> +% begin match Dream.session "nick" request with +% | None -> +Login to make a new thread. +% | Some _nick -> + +
Click the map to make a new thread:
+
+
+
+
+ + +
+% end;