From 4ee0dfae75fda3a8b6347d55c728b50ce5c210d9 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Jul 2020 18:16:59 +0200 Subject: Allow to customize icons --- src/Lib/Dom/Document.ml | 3 +++ src/Lib/Dom/Element.ml | 12 +++++++----- src/Lib/Dom/Event.ml | 3 +++ src/Lib/Dom/H.ml | 49 +++++++++++++++++++++---------------------------- src/Lib/Dom/HA.ml | 23 +++++++++++++++++++++++ src/Lib/Dom/HE.ml | 7 +++++++ src/Lib/Dom/History.ml | 2 ++ src/Lib/Dom/Location.ml | 7 +++++++ src/Lib/Dom/Window.ml | 2 ++ 9 files changed, 75 insertions(+), 33 deletions(-) create mode 100644 src/Lib/Dom/Event.ml create mode 100644 src/Lib/Dom/HA.ml create mode 100644 src/Lib/Dom/HE.ml create mode 100644 src/Lib/Dom/History.ml create mode 100644 src/Lib/Dom/Location.ml create mode 100644 src/Lib/Dom/Window.ml (limited to 'src/Lib/Dom') diff --git a/src/Lib/Dom/Document.ml b/src/Lib/Dom/Document.ml index 867e28c..39c1bb4 100644 --- a/src/Lib/Dom/Document.ml +++ b/src/Lib/Dom/Document.ml @@ -12,3 +12,6 @@ let querySelectorUnsafe id = external createTextNode : string -> Dom.element = "createTextNode" [@@bs.val] [@@bs.scope "document"] + +external location : Location.location = "location" + [@@bs.val] [@@bs.scope "document"] diff --git a/src/Lib/Dom/Element.ml b/src/Lib/Dom/Element.ml index 3e3b78a..a72b783 100644 --- a/src/Lib/Dom/Element.ml +++ b/src/Lib/Dom/Element.ml @@ -1,4 +1,6 @@ -external setValue : Dom.element -> string -> unit = "value" [@@bs.set] +external set_value : Dom.element -> string -> unit = "value" [@@bs.set] + +external value : Dom.element -> string = "value" [@@bs.get] external setTextContent : Dom.element -> string -> unit = "textContent" [@@bs.set] @@ -34,9 +36,9 @@ let removeFirstChild element = true | _ -> false -let rec removeChildren element = - if removeFirstChild element then removeChildren element else () +let rec remove_children element = + if removeFirstChild element then remove_children element else () -let mountOn base element = - let () = removeChildren base in +let mount_on base element = + let () = remove_children base in appendChild base element diff --git a/src/Lib/Dom/Event.ml b/src/Lib/Dom/Event.ml new file mode 100644 index 0000000..acdc9fd --- /dev/null +++ b/src/Lib/Dom/Event.ml @@ -0,0 +1,3 @@ +external preventDefault : Dom.event -> unit = "preventDefault" [@@bs.send] + +external target : Dom.event -> Dom.element = "target" [@@bs.get] diff --git a/src/Lib/Dom/H.ml b/src/Lib/Dom/H.ml index 8183a02..d547a70 100644 --- a/src/Lib/Dom/H.ml +++ b/src/Lib/Dom/H.ml @@ -1,7 +1,10 @@ (* Element creation *) -let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () : - Dom.element = +type attribute = + | TextAttr of string * string + | EventAttr of string * (Dom.event -> unit) + +let h tag attributes children = let element = if tag == "svg" || tag == "path" then Document.createElementNS "http://www.w3.org/2000/svg" tag @@ -9,17 +12,19 @@ let h tag ?(attributes = [||]) ?(eventListeners = [||]) ?(children = [||]) () : in let () = Js.Array.forEach - (fun (name, value) -> Element.setAttribute element name value) + (fun attr -> + match attr with + | TextAttr (name, value) -> + Element.setAttribute element name value + + | EventAttr (name, eventListener) -> + Element.addEventListener element name eventListener) 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 + (fun child -> Element.appendChild element child) + children in element @@ -45,28 +50,16 @@ 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 input = h "input" -let min_ v = ("min", v) +let textarea = h "textarea" -let value v = ("value", v) +let i = h "i" -(* Event listeners *) +let a = h "a" -let onClick f = ("click", f) +let h1 = h "h1" -let onInput f = ("input", f) +let h2 = h "h2" -let onSubmit f = ("submit", f) +let h3 = h "h3" diff --git a/src/Lib/Dom/HA.ml b/src/Lib/Dom/HA.ml new file mode 100644 index 0000000..a7a45ce --- /dev/null +++ b/src/Lib/Dom/HA.ml @@ -0,0 +1,23 @@ +(* Attribute creation *) + +let id v = H.TextAttr ("id", v) + +let class_ v = H.TextAttr ("class", v) + +let viewBox v = H.TextAttr ("viewBox", v) + +let d v = H.TextAttr ("d", v) + +let type_ v = H.TextAttr ("type", v) + +let min_ v = H.TextAttr ("min", v) + +let value v = H.TextAttr ("value", v) + +let for_ v = H.TextAttr ("for", v) + +let style v = H.TextAttr ("style", v) + +let href v = H.TextAttr ("href", v) + +let autocomplete v = H.TextAttr ("autocomplete", v) diff --git a/src/Lib/Dom/HE.ml b/src/Lib/Dom/HE.ml new file mode 100644 index 0000000..098259a --- /dev/null +++ b/src/Lib/Dom/HE.ml @@ -0,0 +1,7 @@ +(* Event listeners *) + +let on_click f = H.EventAttr ("click", f) + +let on_input f = H.EventAttr ("input", f) + +let on_submit f = H.EventAttr ("submit", f) diff --git a/src/Lib/Dom/History.ml b/src/Lib/Dom/History.ml new file mode 100644 index 0000000..ce7a877 --- /dev/null +++ b/src/Lib/Dom/History.ml @@ -0,0 +1,2 @@ +external push_state : string -> string -> string -> unit -> unit = "pushState" + [@@bs.val] [@@bs.scope "history"] diff --git a/src/Lib/Dom/Location.ml b/src/Lib/Dom/Location.ml new file mode 100644 index 0000000..2c58705 --- /dev/null +++ b/src/Lib/Dom/Location.ml @@ -0,0 +1,7 @@ +external set : Dom.element -> string -> unit = "location" + [@@bs.set] + +type location + +external hash : location -> string = "hash" + [@@bs.get] diff --git a/src/Lib/Dom/Window.ml b/src/Lib/Dom/Window.ml new file mode 100644 index 0000000..3abc921 --- /dev/null +++ b/src/Lib/Dom/Window.ml @@ -0,0 +1,2 @@ +external window : Dom.element = "window" + [@@bs.val] -- cgit v1.2.3