aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Lib/Dom/Document.ml14
-rw-r--r--src/Lib/Dom/Element.ml42
-rw-r--r--src/Lib/Dom/H.ml72
-rw-r--r--src/Lib/Leaflet.ml35
-rw-r--r--src/Main.ml3
-rw-r--r--src/View/Map.ml28
-rw-r--r--src/View/Map/MarkerForm.ml0
7 files changed, 194 insertions, 0 deletions
diff --git a/src/Lib/Dom/Document.ml b/src/Lib/Dom/Document.ml
new file mode 100644
index 0000000..867e28c
--- /dev/null
+++ b/src/Lib/Dom/Document.ml
@@ -0,0 +1,14 @@
+external createElement : string -> Dom.element = "createElement"
+ [@@bs.val] [@@bs.scope "document"]
+
+external createElementNS : string -> string -> Dom.element = "createElementNS"
+ [@@bs.val] [@@bs.scope "document"]
+
+external querySelector : string -> Dom.element Js.Nullable.t = "querySelector"
+ [@@bs.val] [@@bs.scope "document"]
+
+let querySelectorUnsafe id =
+ querySelector id |> Js.Nullable.toOption |> Js.Option.getExn
+
+external createTextNode : string -> Dom.element = "createTextNode"
+ [@@bs.val] [@@bs.scope "document"]
diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml
new file mode 100644
index 0000000..3e3b78a
--- /dev/null
+++ b/src/Lib/Dom/Element.ml
@@ -0,0 +1,42 @@
+external setValue : Dom.element -> string -> unit = "value" [@@bs.set]
+
+external setTextContent : Dom.element -> string -> unit = "textContent"
+ [@@bs.set]
+
+external setStyle : Dom.element -> string -> unit = "style" [@@bs.set]
+
+external setClassName : Dom.element -> string -> unit = "className" [@@bs.set]
+
+external setAttribute : Dom.element -> string -> string -> unit = "setAttribute"
+ [@@bs.send]
+
+external setAttributeNS : Dom.element -> string -> string -> string -> unit
+ = "setAttributeNS"
+ [@@bs.send]
+
+external addEventListener : Dom.element -> string -> (Dom.event -> unit) -> unit
+ = "addEventListener"
+ [@@bs.send]
+
+external appendChild : Dom.element -> Dom.element -> unit = "appendChild"
+ [@@bs.send]
+
+external firstChild : Dom.element -> Dom.element Js.Nullable.t = "firstChild"
+ [@@bs.get]
+
+external removeChild : Dom.element -> Dom.element -> unit = "removeChild"
+ [@@bs.send]
+
+let removeFirstChild element =
+ match Js.toOption (firstChild element) with
+ | Some child ->
+ let () = removeChild element child in
+ true
+ | _ -> false
+
+let rec removeChildren element =
+ if removeFirstChild element then removeChildren element else ()
+
+let mountOn base element =
+ let () = removeChildren base in
+ appendChild base element
diff --git a/src/Lib/Dom/H.ml b/src/Lib/Dom/H.ml
new file mode 100644
index 0000000..8183a02
--- /dev/null
+++ b/src/Lib/Dom/H.ml
@@ -0,0 +1,72 @@
+(* Element creation *)
+
+let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () :
+ Dom.element =
+ let element =
+ if tag == "svg" || tag == "path" then
+ Document.createElementNS "http://www.w3.org/2000/svg" tag
+ else Document.createElement tag
+ in
+ let () =
+ Js.Array.forEach
+ (fun (name, value) -> Element.setAttribute element name value)
+ attributes
+ in
+ let () =
+ Js.Array.forEach
+ (fun (name, eventListener) ->
+ Element.addEventListener element name eventListener)
+ eventListeners
+ in
+ let () =
+ Js.Array.forEach (fun child -> Element.appendChild element child) children
+ in
+ element
+
+(* Node creation *)
+
+let text = Document.createTextNode
+
+let div = h "div"
+
+let span = h "span"
+
+let header = h "header"
+
+let button = h "button"
+
+let section = h "section"
+
+let svg = h "svg"
+
+let path = h "path"
+
+let form = h "form"
+
+let label = h "label"
+
+let input_ = h "input"
+
+(* Attribute creation *)
+
+let id v = ("id", v)
+
+let className v = ("class", v)
+
+let viewBox v = ("viewBox", v)
+
+let d v = ("d", v)
+
+let type_ v = ("type", v)
+
+let min_ v = ("min", v)
+
+let value v = ("value", v)
+
+(* Event listeners *)
+
+let onClick f = ("click", f)
+
+let onInput f = ("input", f)
+
+let onSubmit f = ("submit", f)
diff --git a/src/Lib/Leaflet.ml b/src/Lib/Leaflet.ml
new file mode 100644
index 0000000..45e2963
--- /dev/null
+++ b/src/Lib/Leaflet.ml
@@ -0,0 +1,35 @@
+type map
+
+external map : string -> map = "map"
+ [@@bs.val] [@@bs.scope "L"]
+
+external setView : map -> float array -> int -> unit = "setView"
+ [@@bs.send]
+
+type mapEvent
+
+external on : map -> string -> (mapEvent -> unit) -> unit = "on"
+ [@@bs.send]
+
+type latLng =
+ { lat : float;
+ lng : float;
+ }
+
+external latLng : mapEvent -> latLng = "latlng"
+ [@@bs.get]
+
+type addable
+
+external tileLayer : string -> addable = "tileLayer"
+ [@@bs.val] [@@bs.scope "L"]
+
+external addTo : addable -> map -> unit = "addTo"
+ [@@bs.send]
+
+type markerInput =
+ { title : string;
+ }
+
+external marker : latLng -> markerInput -> addable = "marker"
+ [@@bs.val] [@@bs.scope "L"]
diff --git a/src/Main.ml b/src/Main.ml
new file mode 100644
index 0000000..bae9ee1
--- /dev/null
+++ b/src/Main.ml
@@ -0,0 +1,3 @@
+let () =
+ let main = Document.querySelectorUnsafe "body" in
+ Element.appendChild main (Map.render ())
diff --git a/src/View/Map.ml b/src/View/Map.ml
new file mode 100644
index 0000000..bcd0506
--- /dev/null
+++ b/src/View/Map.ml
@@ -0,0 +1,28 @@
+let render () =
+ let
+ _ =
+ Js.Global.setTimeout
+ (fun () ->
+ let map = Leaflet.map("g-Map__Content") in
+ let tileLayer = Leaflet.tileLayer "http://{s}.tile.osm.org/{z}/{x}/{y}.png" in
+ let () = Leaflet.addTo tileLayer map in
+ let () = Leaflet.setView map [| 51.505; -0.09 |] 13 in
+ Leaflet.on map "contextmenu" (fun (event) ->
+ Leaflet.addTo (Leaflet.marker (Leaflet.latLng event) { title = "Hey"; }) map))
+ 0
+ in
+ H.div
+ ~attributes:[| H.className "g-Layout__Page" |]
+ ~children: [|
+ H.div
+ ~attributes:[| H.className "g-Layout__Header" |]
+ ~children:[| H.text "Map" |]
+ ();
+ H.div
+ ~attributes:[| H.className "g-Map" |]
+ ~children:[|
+ H.div ~attributes:[| H.id "g-Map__Content" |] ()
+ |]
+ ();
+ |]
+ ()
diff --git a/src/View/Map/MarkerForm.ml b/src/View/Map/MarkerForm.ml
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/src/View/Map/MarkerForm.ml