├── .gitattributes ├── .gitignore ├── .ocp-indent ├── .travis.yml ├── CHANGES.md ├── LICENSE ├── Makefile ├── README.md ├── dune ├── dune-project ├── dune-workspace.dev ├── examples ├── counters │ ├── counters.html │ ├── counters.ml │ └── dune ├── date │ ├── date.html │ ├── date.ml │ └── dune ├── demo │ ├── demo.html │ ├── demo.ml │ ├── dune │ ├── vdom_ui.ml │ └── vdom_ui.mli ├── svg │ ├── dune │ ├── svg.html │ └── svg.ml └── tippy │ ├── bindings │ ├── dune │ └── tippy.mli │ ├── dune │ ├── index.html │ ├── main.ml │ └── register.ml ├── lib ├── dune ├── js_browser.mli ├── vdom.ml ├── vdom.mli ├── vdom_blit.ml └── vdom_blit.mli └── vdom.opam /.gitattributes: -------------------------------------------------------------------------------- 1 | * text eol=lf 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .merlin 3 | _opam 4 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | match_clause=4 2 | strict_with=auto 3 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | sudo: required 3 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-opam.sh 4 | script: bash -ex .travis-opam.sh 5 | env: 6 | - OCAML_VERSION=4.08 PACKAGE=ocaml-vdom PINS="gen_js_api" 7 | - OCAML_VERSION=4.09 PACKAGE=ocaml-vdom PINS="gen_js_api" 8 | - OCAML_VERSION=4.10 PACKAGE=ocaml-vdom PINS="gen_js_api" 9 | os: 10 | - linux 11 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | Next release 2 | ============ 3 | 4 | - Synchronization algorithm purely based on the VDOM, avoid reading from the real DOM 5 | - `Vdom.autofocus_prevent_scroll` 6 | - `Vdom.onauxclick_cancel` 7 | - `Js_browser`: expose more of the DOM API 8 | 9 | 10 | 0.3 11 | === 12 | 13 | - `Vdom.on`: Custom browser event handlers with Elm-style JavaScript decoders 14 | - Fragments: virtual nodes not associated to a concrete DOM 15 | - Option to propagate browser events occurring inside custom elements to the VDOM 16 | - `Vdom.to_html`: Native conversion of the VDOM to HTML 17 | - `Vdom_blit.Cmd.after_redraw`: register a callback for after the next redraw in a command handler 18 | - Numerous additions to `Js_browser` including support for the JavaScript modules `Base64`, `Blob`, `ClassList`, `FetchResponse`, `Navigator`, `TextDecoder` 19 | 20 | Warning: this version is not fully retro-compatible with the previous one. Existing code should be adapted slightly. 21 | 22 | 0.2 23 | === 24 | 25 | - GPR#14: delay rendering (view + DOM updates) with requestAnimationFrame 26 | - GPR#15: click/dblclick handlers take a mouse_event argument (API change) 27 | - GPR#16: improve support for checkboxes 28 | - GPR#18: propagate DOM events upwards until finding a handler 29 | - GPR#21: bindings for WebSockets (contributed by Levi Roth) 30 | - GPR#22: Add window.inner{Width,Height} (contributed by 'copy') 31 | - GPR#23: Add KeyboardEvent.{code,key} (contributed by 'copy') 32 | - GPR#24: Make the vdom type covariant in the 'msg parameter (contributed by 'copy') 33 | - GPR#25: Add MouseEvent.{movementX,movementY} (contributed by 'copy') 34 | - GRP#30: Port build to dune + adds travis support 35 | - GRP#32: Disposing custom elements 36 | 37 | 0.1 38 | === 39 | 40 | - GPR#5: double click handler (contributed by Stéphane Legrand) 41 | - GPR#10: bindings for Date (contributed by Philippe Veber) 42 | - GPR#8: binding for windows.location (contributed by Philippe Veber) 43 | 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (C) 2000-2024 LexiFi 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining 6 | a copy of this software and associated documentation files (the 7 | "Software"), to deal in the Software without restriction, including 8 | without limitation the rights to use, copy, modify, merge, publish, 9 | distribute, sublicense, and/or sell copies of the Software, and to 10 | permit persons to whom the Software is furnished to do so, subject to 11 | the following conditions: 12 | 13 | The above copyright notice and this permission notice shall be 14 | included in all copies or substantial portions of the Software. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 20 | LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION 21 | OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION 22 | WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. 2 | # See the attached LICENSE file. 3 | # Copyright 2016 by LexiFi. 4 | 5 | .PHONY: all examples clean install uninstall doc 6 | 7 | all: 8 | dune build @all 9 | 10 | examples: 11 | dune build @examples/all 12 | 13 | doc: 14 | dune build @doc 15 | 16 | clean: 17 | dune clean 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | vdom: Elm architecture and (V)DOM for OCaml 2 | ================================================= 3 | 4 | [![Build Status](https://travis-ci.com/LexiFi/ocaml-vdom.svg?branch=master)](https://travis-ci.com/LexiFi/ocaml-vdom) 5 | 6 | Overview 7 | -------- 8 | 9 | This package contains: 10 | 11 | - OCaml bindings to DOM and other client-side Javascript APIs 12 | (using [gen_js_api](https://github.com/LexiFi/gen_js_api)). 13 | 14 | - An implementation of the [Elm architecture](https://guide.elm-lang.org/architecture/), where the 15 | UI is specified as a functional "view" on the current state. 16 | 17 | 18 | 19 | Dependencies 20 | ------------ 21 | 22 | - OCaml 23 | 24 | - js_of_ocaml 25 | 26 | - gen_js_api 27 | 28 | - odoc 29 | 30 | 31 | Installation (with OPAM) 32 | ------------------------ 33 | 34 | ``` 35 | opam install vdom 36 | ``` 37 | 38 | Install dependencies 39 | ------------------------ 40 | ``` 41 | opam install vdom --deps-only 42 | ``` 43 | 44 | 45 | Manual installation 46 | ------------------- 47 | 48 | ```bash 49 | git clone https://github.com/LexiFi/ocaml-vdom.git 50 | cd ocaml-vdom 51 | make all 52 | ``` 53 | 54 | 55 | DOM bindings 56 | ------------ 57 | 58 | [`Js_browser`](lib/js_browser.mli) exposes (partial) OCaml bindings of the browser's DOM and 59 | other common client-side Javascript APIs. 60 | 61 | It is implemented with 62 | [gen_js_api](https://github.com/LexiFi/gen_js_api), making it 63 | realistic to have it working with ReScript in the future. This 64 | would open the door to writing client-side web applications in OCaml 65 | that could be compiled to Javascript either with js_of_ocaml or 66 | ReScript. 67 | 68 | 69 | VDOM 70 | ---- 71 | 72 | The [Elm architecture](https://guide.elm-lang.org/architecture/) is a 73 | functional way to describe UI applications. In this architecture, the 74 | current state of the UI is represented with a single data type and a 75 | "view" function projects this state to a concrete rendering. In our 76 | case, this rendering is done to a tree-like abstraction of the browser 77 | DOM, called a VDOM (Virtual DOM). This VDOM can itself be rendered to 78 | a concrete DOM. Whenever the state changes, the view function produces 79 | a new VDOM tree, which is then diffed with the previous one to update 80 | the concrete DOM accordingly. The VDOM also specifies how DOM events 81 | are wrapped into "messages" that are processed by an "update" function 82 | to modify the current state. This function can also spawn "commands" 83 | (such as AJAX calls) whose outcome is also notified by messages. 84 | 85 | 86 | The implementation of this architecture relies on two modules: 87 | 88 | - [`Vdom`](lib/vdom.mli): definition of the VDOM tree and of "virtual 89 | applications". This is a "pure" module, which does not depend on 90 | any Javascript bindings (it could be executed on the server-side, 91 | e.g. for automated testing). 92 | 93 | - [`Vdom_blit`](lib/vdom_blit.mli): rendering of virtual applications into the actual 94 | DOM. This modules implements the initial "blit" operation 95 | (rendering a VDOM tree to the DOM) and the "diff/synchronization" 96 | algorithm. It also manages the state of a running application. 97 | `Vdom_blit` is implemented on top of `Js_browser`. 98 | 99 | 100 | 101 | This implementation of VDOM has some specificities: 102 | 103 | - Each node in the VDOM tree has a "key" string field. By default, 104 | the key corresponds to the tag name for elements but it can be 105 | overridden. The key is used by the synchronization algorithm 106 | as follows: when synchronizing the old and new children of an 107 | element, the children are first grouped by key. Two children with 108 | different keys are never synchronized, and the sequence of old and 109 | new children with a given key are synchronized in a pairwise way 110 | (first old child with key K against first new child with key K; 111 | etc...), adding or removing extra/missing children if needed. 112 | Children are also reordered in the DOM, if needed, to match the 113 | new ordering. 114 | 115 | - Event handlers are not attached on DOM nodes created when a VDOM 116 | tree is rendered. Instead, we attach fixed event handlers on the 117 | root container, and rely on event delegation. The handler 118 | corresponding to a given element and responsible for a given kind 119 | of event is searched directly in the VDOM. The rationale for this 120 | design choice is that comparing functional values is not 121 | well-defined in OCaml, so it would not be clear, when the "old" 122 | and "new" VDOMs are diffed, if the event handler on the DOM node 123 | should be refreshed. 124 | 125 | - A "bridge" structure is created in `Vdom_blit` to represent the 126 | correspondence between VDOM and DOM nodes. This structure mimics 127 | the shape of both trees and avoids having to query the concrete 128 | DOM to navigate in the tree. 129 | 130 | - No data structure is created to represent the "diff" between old 131 | and new VDOMs. Instead, the synchronization algorithm detects 132 | VDOM changes and apply them on the fly to the corresponding DOM 133 | node. 134 | 135 | - There is some special support for the "value" property. When this 136 | property is explicitly bound in the VDOM (typically on an input 137 | field), the value is forced on the element: whenever the DOM value 138 | changes, the event is potentially dispatched to an event handler, 139 | and the new VDOM property is forced on the DOM element. In 140 | particular, if the internal state is not updated by the event 141 | handler, the field becomes in practice read-only. 142 | 143 | - Some special VDOM node attributes are provided to present 144 | "superficial state changes" that are not reflected in the proper 145 | functional state (currently: giving focus to an element, or 146 | ensuring an element is visible by y-scrolling its parent). These 147 | attributes produce the corresponding DOM action when they are 148 | first put on an element (which is not completely well-defined, 149 | since this depends on the synchronization algorithm). 150 | 151 | - The "view" function is **not** applied synchronously when the 152 | state ("model") changes. Instead, a rendering (applying the 153 | "view" function and updating the actual DOM accordingly) is 154 | scheduled. This means that multiple changes can be grouped 155 | without triggering a redraw. The current strategy is to delay 156 | redrawing with [window.requestAnimationFrame](https://developer.mozilla.org/fr/docs/Web/API/Window/requestAnimationFrame), which is supposed to be available (natively, 157 | or through a polyfill). 158 | 159 | 160 | 161 | Usage 162 | ----- 163 | 164 | A simple one-module application would look like: 165 | 166 | ```ocaml 167 | open Vdom 168 | 169 | (* Definition of the vdom application *) 170 | 171 | let view model = ... (* the state->vdom rendering function *) 172 | let init = return ... (* the initial state *) 173 | let update model = function .... (* the state-updating function *) 174 | let my_app = app ~init ~update ~view () 175 | 176 | 177 | (* Driver *) 178 | 179 | open Js_browser 180 | 181 | let run () = 182 | Vdom_blit.run my_app (* run the application *) 183 | |> Vdom_blit.dom (* get its root DOM container *) 184 | |> Element.append_child (Document.body document) (* insert the DOM in the document *) 185 | 186 | let () = Window.set_onload window run 187 | ``` 188 | 189 | Use the following Dune file to compile this to JavaScript: 190 | 191 | ``` 192 | (executable 193 | (name myprog) 194 | (libraries vdom) 195 | (modes js)) 196 | ``` 197 | 198 | The resulting JavaScript file `myprog.bc.js` can be found in the `_build` directory and can then be used from a simple HTML file such as: 199 | 200 | ```html 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | ``` 209 | 210 | Examples: [`Demo`](examples/demo/demo.ml), [`Counters`](examples/counters/counters.ml). 211 | 212 | Third-party examples: 213 | - `TodoMVC` ([source](https://github.com/slegrand45/examples_ocaml_vdom/blob/master/todomvc/todomvc.ml), [demo](https://slegrand45.github.io/examples_ocaml_vdom.site/todomvc/)) 214 | - [`With Eliom service`](https://github.com/slegrand45/examples_ocsigen/blob/master/eliom/with-ocaml-vdom/simple/mixvdomandeliom.eliom). 215 | - `camel-finder` ([source](https://github.com/edwinans/camel-finder), [demo](https://edwinans.github.io/camel-finder/)) 216 | 217 | About 218 | ----- 219 | 220 | This project has been created by LexiFi initially for its internal 221 | use. It has been used in production since 2016 but no commitment is made on 222 | the stability of its interface. So please let us know if you consider 223 | using it! 224 | 225 | This ocaml-vdom package is licensed by LexiFi under the terms of the 226 | [MIT license](LICENSE). 227 | 228 | Contact: alain.frisch@lexifi.com 229 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (env 2 | (dev 3 | (flags (:standard)))) 4 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.0) 2 | 3 | (name vdom) 4 | 5 | (generate_opam_files true) 6 | 7 | (version 0.3) 8 | 9 | (maintainers "Alain Frisch ") 10 | 11 | (authors 12 | "Alain Frisch " 13 | "Marc Lasson " 14 | "Aurélien Saue ") 15 | 16 | (source 17 | (github LexiFi/ocaml-vdom)) 18 | 19 | (package 20 | (name vdom) 21 | (synopsis "DOM and VDOM for OCaml") 22 | (description 23 | "This package contains: 24 | - OCaml bindings to DOM and other client-side Javascript APIs (using gen_js_api). 25 | - An implementation of the Elm architecture, where the UI is specified as a functional \"view\" on the current state.") 26 | (license MIT) 27 | (depends 28 | (ocaml (>= 4.10)) 29 | (gen_js_api (>= 1.0.7)) 30 | ojs 31 | js_of_ocaml-compiler) 32 | (conflicts (ocaml-vdom (<> transition)))) 33 | -------------------------------------------------------------------------------- /dune-workspace.dev: -------------------------------------------------------------------------------- 1 | (lang dune 1.2) 2 | (context (opam (switch 4.08.0))) 3 | (context (opam (switch 4.09.0))) 4 | (context (opam (switch 4.10.0))) 5 | (context (opam (switch default))) 6 | -------------------------------------------------------------------------------- /examples/counters/counters.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /examples/counters/counters.ml: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | (* Inspired from https://github.com/janestreet/incr_dom/blob/master/example/incr_decr/counters.ml *) 6 | 7 | open Vdom 8 | 9 | module IntMap = Map.Make(struct type t = int let compare : int -> int -> int = compare end) 10 | 11 | type model = { 12 | counters : int IntMap.t; 13 | } 14 | 15 | let update { counters } = function 16 | | `New_counter -> { counters = IntMap.add (IntMap.cardinal counters) 0 counters } 17 | | `Update (pos, diff) -> { counters = IntMap.add pos (IntMap.find pos counters + diff) counters } 18 | 19 | let init = { counters = IntMap.empty } 20 | 21 | let button txt msg = input [] ~a:[onclick (fun _ -> msg); type_button; value txt] 22 | 23 | let view { counters } = 24 | let row (pos, value) = 25 | div [button "-" (`Update (pos, -1)); text (string_of_int value); button "+" (`Update (pos, 1))] 26 | in 27 | div (div [button "New counter" `New_counter] :: (IntMap.bindings counters |> List.map row)) 28 | 29 | 30 | let app = simple_app ~init ~view ~update () 31 | 32 | 33 | open Js_browser 34 | 35 | let run () = Vdom_blit.run app |> Vdom_blit.dom |> Element.append_child (Document.body document) 36 | let () = Window.set_onload window run 37 | -------------------------------------------------------------------------------- /examples/counters/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name counters) 3 | (libraries vdom) 4 | (modes js)) 5 | 6 | (rule (copy counters.bc.js counters.js)) 7 | 8 | (alias 9 | (name all) 10 | (deps counters.js counters.html)) 11 | -------------------------------------------------------------------------------- /examples/date/date.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /examples/date/date.ml: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | open Vdom 6 | 7 | let update _ = function 8 | | `Click -> Js_browser.Date.now () 9 | 10 | let init = 0. 11 | 12 | let view n = 13 | let t = Js_browser.Date.new_date n in 14 | div 15 | [ 16 | div [text (Printf.sprintf "protocol: %S" (Js_browser.Location.protocol (Js_browser.Window.location Js_browser.window)))]; 17 | div [text (Printf.sprintf "Number of milliseconds: %f" n)]; 18 | div [text (Printf.sprintf "ToDateString: %s" (Js_browser.Date.to_date_string t))]; 19 | div [text (Printf.sprintf "ToLocaleString: %s" (Js_browser.Date.to_locale_string t))]; 20 | div [input [] ~a:[onclick (fun _ -> `Click); type_button; value "Update"]] 21 | ] 22 | 23 | let app = simple_app ~init ~view ~update () 24 | 25 | 26 | open Js_browser 27 | 28 | let run () = Vdom_blit.run app |> Vdom_blit.dom |> Element.append_child (Document.body document) 29 | let () = Window.set_onload window run 30 | -------------------------------------------------------------------------------- /examples/date/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name date) 3 | (libraries vdom) 4 | (modes js)) 5 | 6 | (rule (copy date.bc.js date.js)) 7 | 8 | (alias 9 | (name all) 10 | (deps date.js date.html)) 11 | -------------------------------------------------------------------------------- /examples/demo/demo.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 13 | 14 | 15 | 16 | 17 | 18 | -------------------------------------------------------------------------------- /examples/demo/demo.ml: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | open Js_browser 6 | open Vdom 7 | 8 | (* Custom commands *) 9 | 10 | type 'msg Vdom.Cmd.t += 11 | | Http_get of {url: string; payload: string; on_success: (string -> 'msg)} 12 | | After of int * 'msg 13 | 14 | let http_get (type msg) ~url ~payload (on_success : _ -> msg) : msg Vdom.Cmd.t = 15 | Http_get {url; payload; on_success} 16 | 17 | let after x f = After (x, f) 18 | 19 | 20 | let button ?(a = []) txt f = input [] ~a:(onclick (fun _ -> f) :: type_button :: value txt :: a) 21 | let br = elt "br" [] 22 | 23 | 24 | module Demo1 = struct 25 | type model = 26 | { 27 | i: int; 28 | s: string; 29 | } 30 | 31 | let view {i; s} = 32 | div 33 | [ 34 | txt_span 35 | ~a:[style "font-size" (Printf.sprintf "%ipx" (i*2))] 36 | (string_of_int i); 37 | 38 | button "+" ~a:[disabled (i >= 10)] `Plus; 39 | (if i = 0 then txt_span "" else button "-" (`Set (i - 1))); 40 | br; 41 | text (string_of_int i); 42 | br; 43 | input [] 44 | ~a:[ 45 | oninput (fun s -> 46 | match int_of_string s with 47 | | exception _ -> if s <> "" then `Text "ERR" else `Noop 48 | | i -> `Set i 49 | ); 50 | value (string_of_int i) 51 | ]; 52 | br; 53 | 54 | input [] ~a:[oninput (fun s -> `Text s); value s]; 55 | 56 | map (function `Text s -> `Text (s ^ "+") | r -> r) 57 | (input [] ~a:[oninput (fun s -> `Text s); value s]); 58 | 59 | input [] ~a:[value "FIXED"]; 60 | 61 | text s; 62 | ] 63 | 64 | let init = return {i = 5; s = "Hello"} 65 | 66 | let update model = function 67 | | `Plus -> return {model with i = model.i + 1} 68 | | `Set i -> return {model with i} 69 | | `Text s -> return {model with s} 70 | | `Noop -> return model 71 | 72 | let app = {init; update; view} 73 | end 74 | 75 | 76 | module Demo2 = struct 77 | type model = 78 | { 79 | n: int; 80 | } 81 | 82 | let init = return { n = 5 } 83 | 84 | let update model = function 85 | | `Set s -> 86 | begin match int_of_string s with 87 | | exception _ -> return model 88 | | n when n >= 0 -> return {n} 89 | | _ -> return model 90 | end 91 | | `Click x -> Printf.printf "clicked %i\n" x; return model 92 | 93 | let view { n } = 94 | let rec loop acc i = 95 | if i = 0 then acc 96 | else loop (button (string_of_int i) (`Click i) :: acc) (i - 1) 97 | in 98 | let input = input ~key:"foo" [] ~a:[oninput (fun s -> `Set s)] in 99 | let buttons = loop [] n in 100 | let l = if n mod 2 = 0 then input :: buttons else buttons @ [input] in 101 | div l 102 | 103 | let app = {init; update; view} 104 | end 105 | 106 | module Demo3 = struct 107 | 108 | type foo = { x: int; y: int } 109 | type bar = { a: foo; b: foo } 110 | 111 | let init = 112 | return { a = {x=10; y=10}; b = {x=20; y=20} } 113 | ~c:[after 1000 `Inc; after 2000 `Inc] 114 | 115 | let update model = function 116 | | `Swap2 -> return { a = model.b; b = model.a } 117 | | `Swap1 -> return { a = { x = model.a.y; y = model.a.x }; b = model.b } 118 | | `Inc -> return { a = { x = model.a.x + 1; y = model.a.y }; b = model.b } 119 | | `DelayedReset -> return model ~c:[after 1000 `Reset] 120 | | `Reset -> init 121 | 122 | let show {x; y} = 123 | Printf.printf "show %i/%i\n%!" x y; 124 | elt "p" [ text (Printf.sprintf "%i/%i" x y) ] 125 | 126 | 127 | let view model = 128 | div 129 | [ 130 | button "A<->B" `Swap2; 131 | button "A.x<->A.y" `Swap1; 132 | button "A.x++" `Inc; 133 | button "Delayed reset" `DelayedReset; 134 | memo show model.a; 135 | memo show model.b; 136 | ] 137 | 138 | let app = {init; update; view} 139 | end 140 | 141 | module DemoHttp = struct 142 | 143 | type model = 144 | { 145 | url: string; 146 | focused: bool; 147 | content: [`Nothing|`Loading of string|`Data of string]; 148 | } 149 | 150 | let init = 151 | return 152 | { 153 | url = ""; 154 | focused = false; 155 | content = `Nothing; 156 | } 157 | 158 | let update model = function 159 | | `Set url -> 160 | return {model with url} 161 | | `FetchStart -> 162 | return {model with content = `Loading model.url} 163 | ~c:[after 2000 (`Fetch model.url)] 164 | | `Fetch url -> 165 | return model 166 | ~c:[http_get ~url ~payload:"" (fun r -> `Fetched r)] 167 | | `Fetched s -> 168 | return {model with content = `Data s} 169 | | `Focused b -> 170 | return {model with focused = b} 171 | 172 | let view {url; focused; content} = 173 | div 174 | [ 175 | input 176 | ~a:[ 177 | int_prop "size" (if focused then 200 else 100); 178 | value url; 179 | oninput (fun s -> `Set s); 180 | onfocus (`Focused true); 181 | onblur (`Focused false) 182 | ] 183 | []; 184 | div [button "Fetch" `FetchStart]; 185 | begin match content with 186 | | `Nothing -> text "Please type an URL to load." 187 | | `Loading url -> text (Printf.sprintf "Loading %s, please wait..." url) 188 | | `Data data -> elt "pre" [ text data ] 189 | end 190 | ] 191 | 192 | let app = {init; update; view} 193 | end 194 | 195 | 196 | module Pair = struct 197 | type ('a, 'b) msg = Left of 'a | Right of 'b 198 | let left x = Left x 199 | let right x = Right x 200 | 201 | let app app1 app2 = 202 | let init = 203 | return 204 | (fst app1.init, fst app2.init) 205 | ~c:[Cmd.map left (snd app1.init); Cmd.map right (snd app2.init)] 206 | in 207 | let view (model1, model2) = 208 | div 209 | [ 210 | map left (memo app1.view model1); 211 | map right (memo app2.view model2); 212 | ] 213 | in 214 | let update (model1, model2) = function 215 | | Left x -> 216 | let (model1, cmd) = app1.update model1 x in 217 | return (model1, model2) ~c:[Cmd.map left cmd] 218 | | Right x -> 219 | let (model2, cmd) = app2.update model2 x in 220 | return (model1, model2) ~c:[Cmd.map right cmd] 221 | in 222 | {init; update; view} 223 | end 224 | 225 | module MouseMove = struct 226 | 227 | type evt = {x: float; y: float; buttons: int} 228 | 229 | let init = return {x = 0.; y = 0.; buttons = 0} 230 | 231 | let view ({x; y; buttons} : evt) = 232 | elt "span" 233 | ~a:[ 234 | onmousemove (fun {Vdom.x; y; buttons; _} -> {x; y; buttons}); 235 | style "background-color" "red" 236 | ] 237 | [ 238 | text (Printf.sprintf "x = %f; y = %f; buttons = %i" x y buttons) 239 | ] 240 | 241 | let update _ evt = return evt 242 | 243 | let app = {init; update; view} 244 | end 245 | 246 | module Talk1 = struct 247 | type model = { x: int; y: int } 248 | type msg = Inc 249 | 250 | let button txt msg = 251 | elt "input" [] 252 | ~a:[onclick (fun _ -> msg); str_prop "type" "button"; 253 | str_prop "value" txt; 254 | ] 255 | 256 | let view {x; y} = 257 | elt "div" [ 258 | button "Increment" Inc; 259 | text (Printf.sprintf "x=%d / y=%d" x y) 260 | ] 261 | 262 | let init = { x = 0; y = 0 } 263 | 264 | let update model = function 265 | | Inc -> {model with x = model.x + 1} 266 | 267 | let app = simple_app ~init ~update ~view () 268 | end 269 | 270 | 271 | module Talk2 = struct 272 | type model = { s: string } 273 | type msg = Set of string 274 | let set s = Set s 275 | 276 | let view {s} = 277 | let v = elt "input" ~a:[str_prop "value" s; oninput set] [] in 278 | elt "div" [v; v] 279 | 280 | let init = {s = ""} 281 | 282 | let update _model = function 283 | | Set s -> {s} 284 | 285 | let app = simple_app ~init ~update ~view () 286 | end 287 | 288 | 289 | module DemoSelection = struct 290 | 291 | open Vdom_ui 292 | 293 | type model = 294 | { 295 | s: string; 296 | select: int SelectionList.model; 297 | } 298 | 299 | let init = 300 | let rec gen = function 100 -> [] | i -> i :: gen (i + 1) in 301 | { s = ""; select = SelectionList.init (gen 0) } 302 | 303 | let view {s; select} = 304 | elt "div" 305 | [ 306 | text s; 307 | SelectionList.view string_of_int (fun x -> `Internal x) (fun x -> `Select x) select; 308 | ] 309 | 310 | let update state = function 311 | | `Internal x -> {state with select = SelectionList.update state.select x} 312 | | `Select x -> {state with s = Printf.sprintf "Selection : %i" x} 313 | 314 | let app = simple_app ~init ~update ~view () 315 | end 316 | 317 | module DemoCheckbox = struct 318 | type model = 319 | { 320 | checked: bool; 321 | } 322 | 323 | let init = {checked = true} 324 | 325 | let view {checked} = 326 | div 327 | [ 328 | elt "input" [] 329 | ~a:[str_prop "type" "checkbox"; 330 | bool_prop "checked" checked; 331 | onclick (fun _ -> `Click1); 332 | ]; 333 | elt "input" [] 334 | ~a:[str_prop "type" "checkbox"; 335 | bool_prop "checked" checked; 336 | onclick (fun _ -> `Click1); 337 | ]; 338 | elt "input" [] 339 | ~a:[str_prop "type" "checkbox"; 340 | bool_prop "checked" (not checked); 341 | onclick (fun _ -> `Click1); 342 | ]; 343 | elt "input" [] 344 | ~a:[str_prop "type" "checkbox"; 345 | bool_prop "checked" checked; 346 | ]; 347 | elt "input" [] 348 | ~a:[str_prop "type" "checkbox"; 349 | bool_prop "checked" true; 350 | ]; 351 | elt "input" [] 352 | ~a:[str_prop "type" "checkbox"; 353 | onchange_checked (fun b -> `Change b); 354 | ]; 355 | ] 356 | 357 | let update model = function 358 | | `Click1 -> {checked=not model.checked} 359 | | `Change b -> {checked=b} 360 | 361 | let app = simple_app ~init ~update ~view () 362 | end 363 | 364 | 365 | module Issue18_propagation = struct 366 | open Vdom 367 | 368 | type model = Unclicked | Clicked of string 369 | 370 | type message = Click of string | Reset 371 | 372 | let view = 373 | function 374 | | Unclicked -> 375 | div ~a:[onclick (fun _ -> Click "outer"); class_ "outer"] 376 | [ 377 | div ~a:[ class_ "inner"] [text "inside the inner div"]; 378 | div ~a:[ class_ "inner"; onclick ~stop_propagation:() (fun _ -> Click "inner")] 379 | [text "inner div with own click handler"]; 380 | text "outside the inner div"; 381 | ] 382 | | Clicked s -> 383 | div ~a:[onclick (fun _ -> Reset)] [text (Printf.sprintf "Clicked: %s" s)] 384 | 385 | let init = Unclicked 386 | 387 | let update _m = function 388 | | Click s -> Clicked s 389 | | Reset -> Unclicked 390 | 391 | let app = simple_app ~init ~view ~update () 392 | 393 | end 394 | 395 | (* Custom command handlers *) 396 | 397 | let run_http_get ~url ~payload ~on_success () = 398 | let open XHR in 399 | let r = create () in 400 | open_ r "GET" url; 401 | set_response_type r "text"; 402 | set_onreadystatechange r 403 | (fun () -> 404 | match ready_state r with 405 | | Done -> on_success (response_text r) 406 | | _ -> 407 | () 408 | ); 409 | send r (Ojs.string_to_js payload) 410 | 411 | let cmd_handler ctx = function 412 | | Http_get {url; payload; on_success} -> 413 | run_http_get ~url ~payload ~on_success:(fun s -> Vdom_blit.Cmd.send_msg ctx (on_success s)) (); 414 | true 415 | | After (n, msg) -> 416 | ignore (Window.set_timeout window (fun () -> Vdom_blit.Cmd.send_msg ctx msg) n); 417 | true 418 | | _ -> 419 | false 420 | 421 | let () = Vdom_blit.(register (cmd {f = cmd_handler})) 422 | 423 | let test_dispose = true 424 | 425 | let run () = 426 | let body = Document.body document in 427 | let r app = 428 | let container = Document.create_element document "div" in 429 | let app = Vdom_blit.run ~container app in 430 | Element.append_child body container; 431 | if test_dispose then begin 432 | let button = Document.create_element document "button" in 433 | Element.append_child button (Document.create_text_node document "Dispose Application"); 434 | Element.add_event_listener button Event.Click (fun _ -> 435 | Element.remove button; 436 | Vdom_blit.dispose app; 437 | Element.append_child container (Document.create_text_node document "Disposed"); 438 | ) false; 439 | Element.append_child body button; 440 | end; 441 | Element.append_child body (Document.create_element document "hr"); 442 | in 443 | 444 | r Talk1.app; 445 | r Talk2.app; 446 | 447 | r Demo1.app; 448 | r Demo1.app; 449 | r Demo2.app; 450 | r Demo3.app; 451 | r (Pair.app DemoHttp.app Demo3.app); 452 | r MouseMove.app; 453 | r DemoSelection.app; 454 | r DemoCheckbox.app; 455 | r Issue18_propagation.app; 456 | () 457 | 458 | let () = Window.set_onload window run 459 | -------------------------------------------------------------------------------- /examples/demo/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name demo) 3 | (libraries vdom) 4 | (modes js)) 5 | 6 | (rule (copy demo.bc.js demo.js)) 7 | 8 | (alias 9 | (name all) 10 | (deps demo.js demo.html)) 11 | -------------------------------------------------------------------------------- /examples/demo/vdom_ui.ml: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | let contains ~pattern s = 6 | let rec loop i = 7 | if i < 0 then false 8 | else String.sub s i (String.length pattern) = pattern || loop (i - 1) 9 | in 10 | loop (String.length s - String.length pattern) 11 | 12 | module SelectionList = struct 13 | open Vdom 14 | 15 | type 'a model = 16 | { 17 | list: 'a list; 18 | cursor: int; 19 | filter: string; 20 | } 21 | 22 | type msg = 23 | [`Cursor of int | `Filter of string | `Nop] 24 | 25 | let view show msg select {list; cursor; filter} = 26 | let keep = contains ~pattern:filter in 27 | let instrs = List.filter (fun x -> keep (show x)) list in 28 | let l = 29 | List.mapi 30 | (fun i x -> 31 | let a = if i = cursor then 32 | [style "background-color" "#E0E0E0"; 33 | scroll_to_show ~align_top:true] else [] in 34 | div 35 | ~a:(onclick (fun _ -> select x) :: class_ "link" :: a) 36 | [ text (show x) ] 37 | ) 38 | instrs 39 | in 40 | div 41 | [ 42 | elt "input" [] ~a: 43 | [type_ "search"; str_prop "placeholder" "Search..."; 44 | class_ "searchbox"; value filter; 45 | autofocus; 46 | oninput (fun s -> msg (`Filter s)); 47 | onkeydown 48 | (fun e -> 49 | match e.which with 50 | | 38 -> msg (`Cursor (max (cursor - 1) 0)) 51 | | 40 -> msg (`Cursor (min (cursor + 1) (List.length instrs - 1))) 52 | | 33 -> msg (`Cursor (max (cursor - 15) 0)) 53 | | 34 -> msg (`Cursor (min (cursor + 15) (List.length instrs - 1))) 54 | | 36 -> msg (`Cursor 0) 55 | | 35 -> msg (`Cursor (List.length instrs - 1)) 56 | | 13 -> select (List.nth instrs cursor) 57 | | _ -> msg `Nop 58 | ) 59 | ]; 60 | div ~a:[style "width" "300px"; style "margin-top" "30px"; 61 | style "overflow-y" "scroll"; 62 | style "height" "500px"; 63 | ] l 64 | ] 65 | 66 | let update model = function 67 | | `Filter filter -> {model with filter; cursor = 0} 68 | | `Cursor cursor -> {model with cursor} 69 | | `Nop -> model 70 | 71 | let init list = {list; filter = ""; cursor = 0} 72 | end 73 | 74 | 75 | module Initializable = struct 76 | type 'a model = 77 | | Initializing 78 | | Ready of 'a 79 | 80 | type ('a, 'msg) msg = [`Got of 'a | `Internal of 'msg] 81 | 82 | let internal msg = `Internal msg 83 | let got x = `Got x 84 | 85 | let update f model msg = 86 | match model, msg with 87 | | Initializing, `Got x -> Vdom.return (Ready x) 88 | | Ready model, `Internal msg -> let m, a = f model msg in Vdom.return (Ready m) ~c:[Vdom.Cmd.map internal a] 89 | | _ -> Vdom.return model 90 | 91 | let view f = function 92 | | Initializing -> Vdom.text "Please wait..." 93 | | Ready model -> Vdom.map internal (f model) 94 | 95 | let init f = 96 | Vdom.return Initializing ~c:[Vdom.Cmd.map got f] 97 | 98 | let app ~init:i ~view:v ~update:u () = 99 | Vdom.app ~init:(init i) ~update:(update u) ~view:(view v) () 100 | end 101 | -------------------------------------------------------------------------------- /examples/demo/vdom_ui.mli: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | (** Reusable VDOM "components" *) 6 | 7 | module SelectionList: sig 8 | open Vdom 9 | 10 | type 'a model 11 | type msg 12 | 13 | val init: 'a list -> 'a model 14 | val view: ('a -> string) -> (msg -> 'msg) -> ('a -> 'msg) -> 'a model -> 'msg vdom 15 | val update: 'a model -> msg -> 'a model 16 | end 17 | 18 | 19 | module Initializable : sig 20 | type 'a model 21 | type ('a, 'msg) msg 22 | 23 | val app: 24 | init:'a Vdom.Cmd.t -> 25 | view:('a -> 'msg Vdom.vdom) -> 26 | update:('a -> 'msg -> 'a * 'msg Vdom.Cmd.t) -> 27 | unit -> 28 | ('a model, ('a, 'msg) msg) Vdom.app 29 | 30 | (* Wrap an application that requires an initialization step to get 31 | its initial state (generated as the outcome of a command). The wrapper 32 | shows a wait message as long as the initial state is not available. *) 33 | end 34 | -------------------------------------------------------------------------------- /examples/svg/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name svg) 3 | (libraries vdom) 4 | (modes js)) 5 | 6 | (rule (copy svg.bc.js svg.js)) 7 | 8 | (alias 9 | (name all) 10 | (deps svg.js svg.html)) 11 | -------------------------------------------------------------------------------- /examples/svg/svg.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /examples/svg/svg.ml: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | open Vdom 6 | 7 | let update n = function 8 | | `Click -> n mod 5 + 1 9 | 10 | let init = 1 11 | 12 | let view n = 13 | div 14 | [ 15 | text (string_of_int n); 16 | svg_elt "svg" 17 | ~a:[ 18 | int_attr "width" (n * 20); 19 | int_attr "height" (n * 20); 20 | ] 21 | [ 22 | svg_elt "circle" [] 23 | ~a:[ 24 | onclick (fun _ -> `Click); 25 | int_attr "cx" (n * 10); 26 | int_attr "cy" (n * 10); 27 | int_attr "r" (n * 10); 28 | attr "fill" (if n mod 2 = 0 then "green" else "blue"); 29 | ] 30 | ] 31 | ] 32 | 33 | let app = simple_app ~init ~view ~update () 34 | 35 | 36 | open Js_browser 37 | 38 | let run () = Vdom_blit.run app |> Vdom_blit.dom |> Element.append_child (Document.body document) 39 | let () = Window.set_onload window run 40 | -------------------------------------------------------------------------------- /examples/tippy/bindings/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets tippy.ml) 3 | (deps tippy.mli) 4 | (action 5 | (run %{bin:gen_js_api} %{deps}))) 6 | 7 | (library 8 | (name bindings) 9 | (libraries gen_js_api vdom) 10 | (modes byte)) 11 | -------------------------------------------------------------------------------- /examples/tippy/bindings/tippy.mli: -------------------------------------------------------------------------------- 1 | type t 2 | 3 | val t_of_js : Ojs.t -> t 4 | 5 | val t_to_js : t -> Ojs.t 6 | 7 | type props = { trigger: string option } 8 | 9 | type options = { content: string; trigger: string option } 10 | 11 | val create : Js_browser.Element.t -> options -> t [@@js.global "tippy"] 12 | 13 | val set_content : t -> string -> unit [@@js.call "setContent"] 14 | 15 | val set_props : t -> props -> unit [@@js.call "setProps"] 16 | 17 | val destroy : t -> unit [@@js.call] 18 | -------------------------------------------------------------------------------- /examples/tippy/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries vdom bindings) 4 | (modes js)) 5 | 6 | (rule (copy main.bc.js main.js)) 7 | 8 | (alias 9 | (name all) 10 | (deps main.js index.html)) 11 | -------------------------------------------------------------------------------- /examples/tippy/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 65 | 66 | 67 | 68 | 69 | -------------------------------------------------------------------------------- /examples/tippy/main.ml: -------------------------------------------------------------------------------- 1 | module V = Vdom 2 | 3 | let source = 4 | [ 5 | ( "Bérénice", 6 | {| 7 | Ah ! cruel ! est-il temps de me le déclarer ? 8 | Qu’avez-vous fait ? Hélas ! je me suis crue aimée. 9 | Au plaisir de vous voir mon âme accoutumée 10 | Ne vit plus que pour vous. Ignoriez-vous vos lois 11 | Quand je vous l’avouai pour la première fois ? 12 | À quel excès d’amour m’avez-vous amenée ? 13 | Que ne me disiez-vous : « Princesse infortunée, 14 | Où vas-tu t’engager, et quel est ton espoir ? 15 | Ne donne point un cœur qu’on ne peut recevoir. » 16 | Ne l’avez-vous reçu, cruel, que pour le rendre, 17 | Quand de vos seules mains ce cœur voudrait dépendre ? 18 | Tout l’empire a vingt fois conspiré contre nous. 19 | Il était temps encor : que ne me quittiez-vous ? 20 | Mille raisons alors consolaient ma misère : 21 | Je pouvais de ma mort accuser votre père, 22 | Le peuple, le sénat, tout l’empire romain, 23 | Tout l’univers, plutôt qu’une si chère main. 24 | Leur haine, dès longtemps contre moi déclarée, 25 | M’avait à mon malheur dès longtemps préparée. 26 | Je n’aurais pas, Seigneur, reçu ce coup cruel 27 | Dans le temps que j’espère un bonheur immortel, 28 | Quand votre heureux amour peut tout ce qu’il désire, 29 | Lorsque Rome se tait, quand votre père expire, 30 | Lorsque tout l’univers fléchit à vos genoux, 31 | Enfin quand je n’ai plus à redouter que vous. 32 | |} 33 | ); 34 | ( "Titus", 35 | {| 36 | Et c’est moi seul aussi qui pouvais me détruire. 37 | Je pouvais vivre alors et me laisser séduire ; 38 | Mon cœur se gardait bien d’aller dans l’avenir 39 | Chercher ce qui pouvait un jour nous désunir. 40 | Je voulais qu’à mes vœux rien ne fût invincible, 41 | Je n’examinais rien, j’espérais l’impossible. 42 | Que sais-je ? J’espérais de mourir à vos yeux, 43 | Avant que d’en venir à ces cruels adieux. 44 | Les obstacles semblaient renouveler ma flamme, 45 | Tout l’empire parlait, mais la gloire, Madame, 46 | Ne s’était point encor fait entendre à mon cœur 47 | Du ton dont elle parle au cœur d’un empereur. 48 | Je sais tous les tourments où ce dessein me livre, 49 | Je sens bien que sans vous je ne saurais plus vivre, 50 | Que mon cœur de moi-même est prêt à s’éloigner, 51 | Mais il ne s’agit plus de vivre, il faut régner. 52 | |} 53 | ); 54 | ( "Bérénice", 55 | {| 56 | Eh bien ! régnez, cruel, contentez votre gloire : 57 | Je ne dispute plus. J’attendais, pour vous croire, 58 | Que cette même bouche, après mille serments 59 | D’un amour qui devait unir tous nos moments, 60 | Cette bouche, à mes yeux s’avouant infidèle, 61 | M’ordonnât elle-même une absence éternelle. 62 | Moi-même j’ai voulu vous entendre en ce lieu. 63 | Je n’écoute plus rien, et pour jamais : adieu... 64 | Pour jamais ! Ah, Seigneur ! songez-vous en vous-même 65 | Combien ce mot cruel est affreux quand on aime ? 66 | Dans un mois, dans un an, comment souffrirons-nous, 67 | Seigneur, que tant de mers me séparent de vous ? 68 | Que le jour recommence et que le jour finisse, 69 | Sans que jamais Titus puisse voir Bérénice, 70 | Sans que de tout le jour je puisse voir Titus ? 71 | Mais quelle est mon erreur, et que de soins perdus ! 72 | L’ingrat, de mon départ consolé par avance, 73 | Daignera-t-il compter les jours de mon absence ? 74 | Ces jours si longs pour moi lui sembleront trop courts. 75 | |} 76 | ); 77 | ( "Titus", 78 | {| 79 | Je n’aurai pas, madame, à compter tant de jours : 80 | J’espère que bientôt la triste renommée 81 | Vous fera confesser que vous étiez aimée. 82 | Vous verrez que Titus n’a pu, sans expirer… 83 | |} 84 | ); 85 | ( "Bérénice", 86 | {| 87 | Ah, seigneur ! s’il est vrai, pourquoi nous séparer ? 88 | Je ne vous parle point d’un heureux hyménée. 89 | Rome à ne vous plus voir m’a-t-elle condamnée ? 90 | Pourquoi m’enviez-vous l’air que vous respirez ? 91 | |} 92 | ); 93 | ( "Titus", 94 | {| 95 | Hélas ! vous pouvez tout, madame : demeurez ; 96 | Je n’y résiste point. Mais je sens ma faiblesse : 97 | Il faudra vous combattre et vous craindre sans cesse, 98 | Et sans cesse veiller à retenir mes pas, 99 | Que vers vous à toute heure entraînent vos appas. 100 | Que dis-je ? en ce moment mon cœur, hors de lui-même, 101 | S’oublie, et se souvient seulement qu’il vous aime. 102 | |} 103 | ); 104 | ( "Bérénice", 105 | {| 106 | Eh bien, seigneur, eh bien, qu’en peut-il arriver ? 107 | Voyez-vous les Romains prêts à se soulever ? 108 | |} 109 | ); 110 | ( "Titus", 111 | {| 112 | Et qui sait de quel œil ils prendront cette injure ? 113 | S’ils parlent, si les cris succèdent au murmure, 114 | Faudra-t-il par le sang justifier mon choix ? 115 | S’ils se taisent, madame, et me vendent leurs lois, 116 | À quoi m’exposez-vous ? Par quelle complaisance 117 | Faudra-t-il quelque jour payer leur patience ? 118 | Que n’oseront-ils point alors me demander ? 119 | Maintiendrai-je des lois que je ne puis garder ? 120 | |} 121 | ); 122 | ("Bérénice", {| 123 | Vous ne comptez pour rien les pleurs de Bérénice ! 124 | |}); 125 | ("Titus", {| 126 | Je les compte pour rien ! Ah ciel ! quelle injustice ! 127 | |}); 128 | ( "Bérénice", 129 | {| 130 | Quoi ! pour d’injustes lois que vous pouvez changer, 131 | En d’éternels chagrins vous-même vous plonger ! 132 | Rome a ses droits, seigneur : n’avez-vous pas les vôtres ? 133 | Ses intérêts sont-ils plus sacrés que les nôtres ? 134 | Dites, parlez. 135 | |} 136 | ); 137 | ("Titus", {| 138 | Hélas ! que vous me déchirez ! 139 | |}); 140 | ("Bérénice", {| 141 | Vous êtes empereur, seigneur, et vous pleurez ! 142 | |}); 143 | ( "Titus", 144 | {| 145 | Oui, madame, il est vrai, je pleure, je soupire, 146 | Je frémis. Mais enfin, quand j’acceptai l’empire, 147 | Rome me fit jurer de maintenir ses droits : 148 | Je dois les maintenir. Déjà, plus d’une fois, 149 | Rome a de mes pareils exercé la constance. 150 | Ah ! si vous remontiez jusques à sa naissance, 151 | Vous les verriez toujours à ses ordres soumis : 152 | L’un, jaloux de sa foi, va chez les ennemis 153 | |} 154 | ); 155 | ] 156 | |> List.map (fun (name, txt) -> 157 | ( name, 158 | String.split_on_char '\n' txt 159 | |> List.map String.trim 160 | |> List.filter (( <> ) "") 161 | |> List.map (fun line -> String.split_on_char ' ' line) )) 162 | 163 | type model = { data: (string * string list list) list; height: int; width: int } 164 | 165 | let shuffle l = 166 | let a = Array.of_list l in 167 | let n = Array.length a in 168 | let swap i j = 169 | let t = a.(i) in 170 | a.(i) <- a.(j); 171 | a.(j) <- t 172 | in 173 | for i = n - 1 downto 1 do 174 | let j = Random.int i in 175 | swap i j 176 | done; 177 | Array.to_list a 178 | 179 | let shuffle_model model = 180 | shuffle model 181 | |> List.map (fun (name, lines) -> (name, shuffle lines |> List.map shuffle)) 182 | 183 | type msg = Shuffle | Clear | Reset | Resize of { width: int; height: int } 184 | 185 | let button msg label = 186 | V.input ~a:[ V.type_button; V.value label; V.onclick (fun _ -> msg) ] [] 187 | 188 | let t = V.text 189 | 190 | let br = V.elt "br" [] 191 | 192 | let p = V.elt "p" 193 | 194 | let col ?(a = []) = V.elt "div" ~a:(V.add_class "column" a) 195 | 196 | let row ?(a = []) = V.elt "div" ~a:(V.add_class "row" a) 197 | 198 | let tooltip txt l = 199 | V.div 200 | ~a:(V.add_class "tooltipable" []) 201 | (Register.Tippy.tooltip ~trigger:[ Click ] txt :: l) 202 | 203 | let render_paragraph lines = 204 | p 205 | ~a:(V.add_class "scrollable" []) 206 | (List.map 207 | (fun words -> 208 | List.map (fun w -> [ tooltip w [ t w ]; t " " ]) words @ [ [ br ] ] 209 | |> List.flatten 210 | ) 211 | lines 212 | |> List.flatten 213 | ) 214 | 215 | let resize = 216 | Register.Window.onresize (fun _ -> 217 | let open Js_browser in 218 | let height = Window.inner_height window |> int_of_float in 219 | let width = Window.inner_width window |> int_of_float in 220 | Some (Resize { height; width })) 221 | 222 | let view model = 223 | let container = if model.height > model.width then col else row in 224 | V.div 225 | ~a:(V.add_class "scrollable" (V.add_class "root" [])) 226 | (resize 227 | :: col 228 | [ 229 | button Shuffle "Shuffle !"; 230 | button Clear "Clear"; 231 | button Reset "Reset"; 232 | t (Printf.sprintf "h: %d w:%d" model.height model.width); 233 | ] 234 | :: List.map 235 | (fun (name, txt) -> 236 | container [ row [ t name ]; row [ render_paragraph txt ] ] 237 | ) 238 | model.data 239 | ) 240 | 241 | let init = V.return { data = source; height = 1; width = 0 } 242 | 243 | let update model = function 244 | | Shuffle -> V.return { model with data = shuffle_model model.data } 245 | | Resize { width; height } -> V.return { model with height; width } 246 | | Reset -> init 247 | | Clear -> V.return { data = []; height = 1; width = 0 } 248 | 249 | let app = V.app ~init ~view ~update () 250 | 251 | open Js_browser 252 | 253 | let run () = 254 | let container = Document.body document in 255 | ignore (Vdom_blit.run ~container app) 256 | 257 | let () = Window.set_onload window run 258 | -------------------------------------------------------------------------------- /examples/tippy/register.ml: -------------------------------------------------------------------------------- 1 | module Window = struct 2 | open Js_browser 3 | 4 | type kind = Resize 5 | 6 | let key = function Resize -> "resize" 7 | 8 | let kind = function Resize -> Event.Resize 9 | 10 | type Vdom.Custom.event += WindowEvent : Event.t -> Vdom.Custom.event 11 | 12 | type Vdom.Custom.t += WindowListener : kind -> Vdom.Custom.t 13 | 14 | type listener = { 15 | mutable last_id: int; 16 | cancel: unit -> unit; 17 | handlers: (int, Event.t -> unit) Hashtbl.t; 18 | } 19 | 20 | let onresize f : _ Vdom.vdom = 21 | let handler = function WindowEvent ev -> f ev | _ -> None in 22 | Vdom.custom ~a:[ Vdom.oncustomevent handler ] (WindowListener Resize) 23 | 24 | let listeners = Hashtbl.create 2 25 | 26 | let new_handler event handler = 27 | let key = key event in 28 | let listener = 29 | match Hashtbl.find_opt listeners key with 30 | | None -> 31 | let handlers = Hashtbl.create 2 in 32 | let callback ev = Hashtbl.iter (fun _ f -> f ev) handlers in 33 | let cancel = 34 | Window.add_cancellable_event_listener window (kind event) callback 35 | true 36 | in 37 | let listener = { cancel; handlers; last_id = 0 } in 38 | Hashtbl.add listeners key listener; 39 | listener 40 | | Some listener -> listener 41 | in 42 | let id = listener.last_id in 43 | listener.last_id <- id + 1; 44 | Hashtbl.add listener.handlers id handler; 45 | fun () -> 46 | Hashtbl.remove listener.handlers id; 47 | if Hashtbl.length listener.handlers = 0 then begin 48 | Hashtbl.remove listeners key; 49 | listener.cancel () 50 | end 51 | 52 | let handler ~send event = 53 | let dispose = 54 | new_handler event (fun x -> send (Vdom_blit.Custom.custom_event (WindowEvent x))) 55 | in 56 | let sync ct = 57 | match ct with WindowListener kind -> kind = event | _ -> false 58 | in 59 | let elt = Document.create_text_node document "" in 60 | Vdom_blit.Custom.make ~dispose ~sync elt 61 | 62 | let () = 63 | let f ctx custom = 64 | let send = Vdom_blit.Custom.send_event ctx in 65 | match custom with 66 | | WindowListener kind -> Some (handler ~send kind) 67 | | _ -> None 68 | in 69 | Vdom_blit.(register (custom f)) 70 | end 71 | 72 | module Tippy = struct 73 | type trigger = MouseEnter | Focus | Focusin | Click | Manual 74 | 75 | let string_of_trigger = function 76 | | MouseEnter -> "mouseenter" 77 | | Focus -> "focus" 78 | | Focusin -> "focusin" 79 | | Click -> "click" 80 | | Manual -> "manual" 81 | 82 | let string_of_triggers l = String.concat " " (List.map string_of_trigger l) 83 | 84 | type value = { content: string; trigger: trigger list option } 85 | 86 | type Vdom.Custom.t += Tippy of value 87 | 88 | let tooltip ?trigger content : _ Vdom.vdom = 89 | Vdom.custom (Tippy { content; trigger }) 90 | 91 | let handler ~parent value = 92 | let inst = 93 | Bindings.Tippy.create parent 94 | { 95 | content = value.content; 96 | trigger = Option.map string_of_triggers value.trigger; 97 | } 98 | in 99 | let value = ref value in 100 | let dispose () = Bindings.Tippy.destroy inst in 101 | let sync ct = 102 | match ct with 103 | | Tippy new_value -> 104 | if new_value <> !value then begin 105 | value := new_value; 106 | Bindings.Tippy.set_content inst new_value.content; 107 | Bindings.Tippy.set_props inst 108 | { trigger = Option.map string_of_triggers new_value.trigger } 109 | end; 110 | true 111 | | _ -> false 112 | in 113 | let elt = Js_browser.(Document.create_text_node document "") in 114 | Vdom_blit.Custom.make ~dispose ~sync elt 115 | 116 | let () = 117 | let f ctx attr = 118 | let parent = Vdom_blit.Custom.parent ctx in 119 | match attr with Tippy value -> Some (handler ~parent value) | _ -> None 120 | in 121 | Vdom_blit.(register (custom f)) 122 | end 123 | -------------------------------------------------------------------------------- /lib/dune: -------------------------------------------------------------------------------- 1 | (rule 2 | (targets js_browser.ml) 3 | (deps js_browser.mli) 4 | (action 5 | (run %{bin:gen_js_api} %{deps}))) 6 | 7 | (library 8 | (name vdom_base) 9 | (public_name vdom.base) 10 | (wrapped false) 11 | (modules vdom)) 12 | 13 | (library 14 | (name vdom_js) 15 | (public_name vdom) 16 | (synopsis "Virtual Dom") 17 | (libraries ojs vdom_base) 18 | (wrapped false) 19 | (modes byte) 20 | (modules vdom_blit js_browser)) 21 | -------------------------------------------------------------------------------- /lib/js_browser.mli: -------------------------------------------------------------------------------- 1 | (* This file is part of the ocaml-vdom package, released under the terms of an MIT-like license. *) 2 | (* See the attached LICENSE file. *) 3 | (* Copyright (C) 2000-2024 LexiFi *) 4 | 5 | (** {1 Bindings for the DOM and other client-side Javascript APIs} *) 6 | 7 | module Promise: sig 8 | [@@@js.stop] 9 | type 'a t 10 | val then_: ?error:(Ojs.t -> unit) -> success:('a -> unit) -> 'a t -> unit 11 | [@@@js.start] 12 | 13 | [@@@js.implem 14 | type 'a t = (Ojs.t -> 'a) * Ojs.t 15 | 16 | let t_of_js f x = (f, x) 17 | val then_: Ojs.t -> success:(Ojs.t -> unit) -> error:(Ojs.t -> unit) option -> unit[@@js.call "then"] 18 | let then_ ?error ~success (alpha_of_js, ojs) = 19 | then_ ojs ~success:(fun x -> success (alpha_of_js x)) ~error 20 | ] 21 | end 22 | 23 | module Storage : sig 24 | type t = private Ojs.t 25 | val t_of_js: Ojs.t -> t 26 | val t_to_js: t -> Ojs.t 27 | val length: t -> int [@@js.get] 28 | val key: t -> int -> string option [@@js.call] 29 | val get_item: t -> string -> string option [@@js.call] 30 | val set_item: t -> string -> string -> unit [@@js.call] 31 | val remove_item: t -> string -> unit [@@js.call] 32 | val clear: t -> unit [@@js.call] 33 | end 34 | 35 | module RegExp : sig 36 | type t = private Ojs.t 37 | val t_of_js: Ojs.t -> t 38 | val t_to_js: t -> Ojs.t 39 | 40 | val new_reg_exp: string -> ?flags:string -> unit -> t [@@js.new] 41 | end 42 | 43 | module JsString : sig 44 | type t = private Ojs.t 45 | val t_of_js: Ojs.t -> t 46 | val t_to_js: t -> Ojs.t 47 | 48 | val of_string: string -> t 49 | [@@js.custom let of_string s = Ojs.string_to_js s] 50 | 51 | val to_string: t -> string 52 | [@@js.custom let to_string x = Ojs.string_of_js x] 53 | 54 | val length: t -> int [@@js.get] 55 | val char_code_at: t -> int -> int [@@js.call] 56 | val to_lower_case: t -> t [@@js.call] 57 | val to_upper_case: t -> t [@@js.call] 58 | val concat: t -> (t list [@js.variadic]) -> t [@@js.call] 59 | val includes: t -> t -> bool [@@js.call] 60 | val ends_with: t -> t -> bool [@@js.call] 61 | val index_of: t -> t -> int [@@js.call] 62 | val repeat: t -> int -> t [@@js.call] 63 | val search: t -> RegExp.t -> int [@@js.call] 64 | val trim: t -> t [@@js.call] 65 | end 66 | 67 | module Date : sig 68 | type t = private Ojs.t 69 | val t_of_js: Ojs.t -> t 70 | val t_to_js: t -> Ojs.t 71 | 72 | val new_date: float -> t [@@js.new] 73 | val now : unit -> float [@@js.global "Date.now"] 74 | val parse : string -> t [@@js.global "Date.parse"] 75 | 76 | val get_date : t -> int [@@js.call] 77 | val get_day : t -> int [@@js.call] 78 | val get_full_year : t -> int [@@js.call] 79 | val get_hours : t -> int [@@js.call] 80 | val get_milliseconds : t -> int [@@js.call] 81 | val get_minutes : t -> int [@@js.call] 82 | val get_month : t -> int [@@js.call] 83 | val get_seconds : t -> int [@@js.call] 84 | val get_time : t -> int [@@js.call] 85 | val get_timezone_offset : t -> int [@@js.call] 86 | val get_UTC_date : t -> int [@@js.call] 87 | val get_UTC_day : t -> int [@@js.call] 88 | val get_UTC_full_year : t -> int [@@js.call] 89 | val get_UTC_hours : t -> int [@@js.call] 90 | val get_UTC_milliseconds : t -> int [@@js.call] 91 | val get_UTC_minutes : t -> int [@@js.call] 92 | val get_UTC_month : t -> int [@@js.call] 93 | val get_UTC_seconds : t -> int [@@js.call] 94 | val get_year : t -> int [@@js.call] 95 | 96 | val set_date : t -> int -> unit [@@js.call] 97 | val set_full_year : t -> int -> unit [@@js.call] 98 | val set_hours : t -> int -> unit [@@js.call] 99 | val set_milliseconds : t -> int -> unit [@@js.call] 100 | val set_minutes : t -> int -> unit [@@js.call] 101 | val set_month : t -> int -> unit [@@js.call] 102 | val set_seconds : t -> int -> unit [@@js.call] 103 | val set_time : t -> int -> unit [@@js.call] 104 | val set_UTC_date : t -> int -> unit [@@js.call] 105 | val set_UTC_full_year : t -> int -> unit [@@js.call] 106 | val set_UTC_hours : t -> int -> unit [@@js.call] 107 | val set_UTC_milliseconds : t -> int -> unit [@@js.call] 108 | val set_UTC_minutes : t -> int -> unit [@@js.call] 109 | val set_UTC_month : t -> int -> unit [@@js.call] 110 | val set_UTC_seconds : t -> int -> unit [@@js.call] 111 | val set_year : t -> int -> unit [@@js.call] 112 | 113 | val to_date_string : t -> string [@@js.call] 114 | val to_GMT_string : t -> string [@@js.call] 115 | val to_ISO_string : t -> string [@@js.call] 116 | val to_locale_string : t -> string [@@js.call] 117 | val to_string : t -> string [@@js.call] 118 | val to_time_string : t -> string [@@js.call] 119 | val to_UTC_string : t -> string [@@js.call] 120 | end 121 | 122 | module ArrayBuffer : sig 123 | type t 124 | val t_of_js: Ojs.t -> t 125 | val t_to_js: t -> Ojs.t 126 | val create: int -> t [@@js.new "ArrayBuffer"] 127 | end 128 | 129 | module Blob : sig 130 | type options 131 | val options: ?type_:string -> ?endings:string -> unit -> options [@@js.builder] 132 | 133 | type t 134 | val t_of_js: Ojs.t -> t 135 | val t_to_js: t -> Ojs.t 136 | 137 | val create: Ojs.t list -> ?options:options -> unit -> t [@@js.new "Blob"] 138 | 139 | val size: t -> int [@@js.get] 140 | val type_: t -> string [@@js.get] 141 | 142 | val text: t -> unit -> string Promise.t [@@js.call] 143 | end 144 | 145 | module File : sig 146 | type t = private Blob.t 147 | val t_of_js: Ojs.t -> t 148 | val t_to_js: t -> Ojs.t 149 | 150 | type options 151 | val options: ?type_:string -> ?last_modified:float -> unit -> options [@@js.builder] 152 | 153 | val create: Blob.t array -> string -> options -> t [@@js.new "File"] 154 | 155 | val name: t -> string [@@js.get] 156 | end 157 | 158 | module DataTransfer : sig 159 | type t = private Ojs.t 160 | val t_of_js: Ojs.t -> t 161 | val t_to_js: t -> Ojs.t 162 | val files: t -> File.t list [@@js.get] 163 | val get_data: t -> string -> string [@@js.call] 164 | end 165 | 166 | module Event : sig 167 | type t 168 | val t_of_js: Ojs.t -> t 169 | val t_to_js: t -> Ojs.t 170 | 171 | (* see https://developer.mozilla.org/en-US/docs/Web/Events *) 172 | type kind = 173 | | Abort [@js "abort"] 174 | | Afterprint [@js "afterprint"] 175 | | Animationend [@js "animationend"] 176 | | Animationiteration [@js "animationiteration"] 177 | | Animationstart [@js "animationstart"] 178 | | Appinstalled [@js "appinstalled"] 179 | | Audioend [@js "audioend"] 180 | | Audioprocess [@js "audioprocess"] 181 | | Audiostart [@js "audiostart"] 182 | | Beforeprint [@js "beforeprint"] 183 | | Beforeunload [@js "beforeunload"] 184 | | BeginEvent [@js "beginEvent"] 185 | | Blocked [@js "blocked"] 186 | | Blur [@js "blur"] 187 | | Boundary [@js "boundary"] 188 | | Cached [@js "cached"] 189 | | Canplay [@js "canplay"] 190 | | Canplaythrough [@js "canplaythrough"] 191 | | Change [@js "change"] 192 | | Chargingchange [@js "chargingchange"] 193 | | Chargingtimechange [@js "chargingtimechange"] 194 | | Checking [@js "checking"] 195 | | Click [@js "click"] 196 | | Close [@js "close"] 197 | | Complete [@js "complete"] 198 | | Compositionend [@js "compositionend"] 199 | | Compositionstart [@js "compositionstart"] 200 | | Compositionupdate [@js "compositionupdate"] 201 | | Contextmenu [@js "contextmenu"] 202 | | Copy [@js "copy"] 203 | | Cut [@js "cut"] 204 | | Dblclick [@js "dblclick"] 205 | | Devicechange [@js "devicechange"] 206 | | Devicelight [@js "devicelight"] 207 | | Devicemotion [@js "devicemotion"] 208 | | Deviceorientation [@js "deviceorientation"] 209 | | Deviceproximity [@js "deviceproximity"] 210 | | Dischargingtimechange [@js "dischargingtimechange"] 211 | | DOMActivate [@js "DOMActivate"] 212 | | DOMAttributeNameChanged [@js "DOMAttributeNameChanged"] 213 | | DOMAttrModified [@js "DOMAttrModified"] 214 | | DOMCharacterDataModified [@js "DOMCharacterDataModified"] 215 | | DOMContentLoaded [@js "DOMContentLoaded"] 216 | | DOMElementNameChanged [@js "DOMElementNameChanged"] 217 | | DOMFocusIn [@js "DOMFocusIn"] 218 | | DOMFocusOut [@js "DOMFocusOut"] 219 | | DOMNodeInserted [@js "DOMNodeInserted"] 220 | | DOMNodeInsertedIntoDocument [@js "DOMNodeInsertedIntoDocument"] 221 | | DOMNodeRemoved [@js "DOMNodeRemoved"] 222 | | DOMNodeRemovedFromDocument [@js "DOMNodeRemovedFromDocument"] 223 | | DOMSubtreeModified [@js "DOMSubtreeModified"] 224 | | Downloading [@js "downloading"] 225 | | Drag [@js "drag"] 226 | | Dragend [@js "dragend"] 227 | | Dragenter [@js "dragenter"] 228 | | Dragleave [@js "dragleave"] 229 | | Dragover [@js "dragover"] 230 | | Dragstart [@js "dragstart"] 231 | | Drop [@js "drop"] 232 | | Durationchange [@js "durationchange"] 233 | | Emptied [@js "emptied"] 234 | | End [@js "end"] 235 | | Ended [@js "ended"] 236 | | EndEvent [@js "endEvent"] 237 | | Error [@js "error"] 238 | | Focus [@js "focus"] 239 | | Focusin [@js "focusin"] 240 | | Focusout [@js "focusout"] 241 | | Fullscreenchange [@js "fullscreenchange"] 242 | | Fullscreenerror [@js "fullscreenerror"] 243 | | Gamepadconnected [@js "gamepadconnected"] 244 | | Gamepaddisconnected [@js "gamepaddisconnected"] 245 | | Gotpointercapture [@js "gotpointercapture"] 246 | | Hashchange [@js "hashchange"] 247 | | Input [@js "input"] 248 | | Invalid [@js "invalid"] 249 | | Keydown [@js "keydown"] 250 | | Keypress [@js "keypress"] 251 | | Keyup [@js "keyup"] 252 | | Languagechange [@js "languagechange"] 253 | | Levelchange [@js "levelchange"] 254 | | Load [@js "load"] 255 | | Loadeddata [@js "loadeddata"] 256 | | Loadedmetadata [@js "loadedmetadata"] 257 | | Loadend [@js "loadend"] 258 | | Loadstart [@js "loadstart"] 259 | | Lostpointercapture [@js "lostpointercapture"] 260 | | Mark [@js "mark"] 261 | | Message [@js "message"] 262 | | Messageerror [@js "messageerror"] 263 | | Mousedown [@js "mousedown"] 264 | | Mouseenter [@js "mouseenter"] 265 | | Mouseleave [@js "mouseleave"] 266 | | Mousemove [@js "mousemove"] 267 | | Mouseout [@js "mouseout"] 268 | | Mouseover [@js "mouseover"] 269 | | Mouseup [@js "mouseup"] 270 | | Nomatch [@js "nomatch"] 271 | | Notificationclick [@js "notificationclick"] 272 | | Noupdate [@js "noupdate"] 273 | | Obsolete [@js "obsolete"] 274 | | Offline [@js "offline"] 275 | | Online [@js "online"] 276 | | Open [@js "open"] 277 | | Orientationchange [@js "orientationchange"] 278 | | Pagehide [@js "pagehide"] 279 | | Pageshow [@js "pageshow"] 280 | | Paste [@js "paste"] 281 | | Pause [@js "pause"] 282 | | Play [@js "play"] 283 | | Playing [@js "playing"] 284 | | Pointercancel [@js "pointercancel"] 285 | | Pointerdown [@js "pointerdown"] 286 | | Pointerenter [@js "pointerenter"] 287 | | Pointerleave [@js "pointerleave"] 288 | | Pointerlockchange [@js "pointerlockchange"] 289 | | Pointerlockerror [@js "pointerlockerror"] 290 | | Pointermove [@js "pointermove"] 291 | | Pointerout [@js "pointerout"] 292 | | Pointerover [@js "pointerover"] 293 | | Pointerup [@js "pointerup"] 294 | | Popstate [@js "popstate"] 295 | | Progress [@js "progress"] 296 | | Push [@js "push"] 297 | | Pushsubscriptionchange [@js "pushsubscriptionchange"] 298 | | Ratechange [@js "ratechange"] 299 | | Readystatechange [@js "readystatechange"] 300 | | RepeatEvent [@js "repeatEvent"] 301 | | Reset [@js "reset"] 302 | | Resize [@js "resize"] 303 | | Resourcetimingbufferfull [@js "resourcetimingbufferfull"] 304 | | Result [@js "result"] 305 | | Resume [@js "resume"] 306 | | Scroll [@js "scroll"] 307 | | Seeked [@js "seeked"] 308 | | Seeking [@js "seeking"] 309 | | Select [@js "select"] 310 | | Selectionchange [@js "selectionchange"] 311 | | Selectstart [@js "selectstart"] 312 | | Show [@js "show"] 313 | | Slotchange [@js "slotchange"] 314 | | Soundend [@js "soundend"] 315 | | Soundstart [@js "soundstart"] 316 | | Speechend [@js "speechend"] 317 | | Speechstart [@js "speechstart"] 318 | | Stalled [@js "stalled"] 319 | | Start [@js "start"] 320 | | Storage [@js "storage"] 321 | | Submit [@js "submit"] 322 | | Success [@js "success"] 323 | | Suspend [@js "suspend"] 324 | | SVGAbort [@js "SVGAbort"] 325 | | SVGError [@js "SVGError"] 326 | | SVGLoad [@js "SVGLoad"] 327 | | SVGResize [@js "SVGResize"] 328 | | SVGScroll [@js "SVGScroll"] 329 | | SVGUnload [@js "SVGUnload"] 330 | | SVGZoom [@js "SVGZoom"] 331 | | Timeout [@js "timeout"] 332 | | Timeupdate [@js "timeupdate"] 333 | | Touchcancel [@js "touchcancel"] 334 | | Touchend [@js "touchend"] 335 | | Touchmove [@js "touchmove"] 336 | | Touchstart [@js "touchstart"] 337 | | Transitionend [@js "transitionend"] 338 | | Unload [@js "unload"] 339 | | Updateready [@js "updateready"] 340 | | Upgradeneeded [@js "upgradeneeded"] 341 | | Userproximity [@js "userproximity"] 342 | | Versionchange [@js "versionchange"] 343 | | Visibilitychange [@js "visibilitychange"] 344 | | Voiceschanged [@js "voiceschanged"] 345 | | Volumechange [@js "volumechange"] 346 | | Waiting [@js "waiting"] 347 | | Wheel [@js "wheel"] 348 | | NonStandard of string [@js.default] 349 | [@@js.enum] 350 | 351 | val target: t -> Ojs.t [@@js.get] 352 | val related_target: t -> Ojs.t option [@@js.get] 353 | val prevent_default: t -> unit [@@js.call] 354 | val stop_propagation: t -> unit [@@js.call] 355 | val type_: t -> string [@@js.get] 356 | 357 | val init_event: t -> kind -> bool -> bool -> unit [@@js.call] 358 | 359 | val client_x: t -> float (* mouse *) [@@js.get] 360 | val client_y: t -> float (* mouse *) [@@js.get] 361 | 362 | val page_x: t -> float (* mouse *) [@@js.get] 363 | val page_y: t -> float (* mouse *) [@@js.get] 364 | 365 | val screen_x: t -> int (* mouse *) [@@js.get] 366 | val screen_y: t -> int (* mouse *) [@@js.get] 367 | 368 | val movement_x: t -> int (* mouse *) [@@js.get] 369 | val movement_y: t -> int (* mouse *) [@@js.get] 370 | 371 | val buttons: t -> int (* mouse *) [@@js.get] 372 | 373 | val alt_key: t -> bool (* key *) [@@js.get] 374 | val ctrl_key: t -> bool (* key *) [@@js.get] 375 | val shift_key: t -> bool (* key *) [@@js.get] 376 | val which: t -> int (* key *) [@@js.get] 377 | val code: t -> string (* key *) [@@js.get] 378 | val key: t -> string (* key *) [@@js.get] 379 | 380 | val delta_y: t -> float (* wheel *) [@@js.get] 381 | val delta_x: t -> float (* wheel *) [@@js.get] 382 | 383 | val data_transfer: t -> DataTransfer.t (* drag/drop *) [@@js.get] 384 | val clipboard_data: t -> DataTransfer.t (* paste *) [@@js.get] 385 | 386 | val data: t -> Ojs.t (* message *) [@@js.get] 387 | val origin: t -> string (* message *) [@@js.get] 388 | 389 | val state: t -> Ojs.t (* popstate *) [@@js.get] 390 | end 391 | 392 | module Rect : sig 393 | type t 394 | val t_of_js: Ojs.t -> t 395 | val t_to_js: t -> Ojs.t 396 | 397 | val height: t -> float [@@js.get] 398 | val width: t -> float [@@js.get] 399 | val left: t -> float [@@js.get] 400 | val right: t -> float [@@js.get] 401 | val top: t -> float [@@js.get] 402 | val bottom: t -> float [@@js.get] 403 | end 404 | 405 | module SVGRect : sig 406 | type t 407 | val t_of_js: Ojs.t -> t 408 | val t_to_js: t -> Ojs.t 409 | 410 | val x: t -> float [@@js.get] 411 | val y: t -> float [@@js.get] 412 | val height: t -> float [@@js.get] 413 | val width: t -> float [@@js.get] 414 | end 415 | 416 | module Style : sig 417 | type t 418 | val t_of_js: Ojs.t -> t 419 | val t_to_js: t -> Ojs.t 420 | val set: t -> string -> string -> unit 421 | [@@js.custom 422 | let set style prop value = 423 | Ojs.set_prop_ascii (t_to_js style) prop (Ojs.string_to_js value) 424 | ] 425 | val set_color: t -> string -> unit [@@js.set] 426 | val set_border: t -> string -> unit [@@js.set] 427 | val set_background: t -> string -> unit [@@js.set] 428 | val set_background_color: t -> string -> unit [@@js.set] 429 | val set_height: t -> string -> unit [@@js.set] 430 | val set_width: t -> string -> unit [@@js.set] 431 | val set_bottom: t -> string -> unit [@@js.set] 432 | val set_left: t -> string -> unit [@@js.set] 433 | val set_top: t -> string -> unit [@@js.set] 434 | val set_right: t -> string -> unit [@@js.set] 435 | val set_position: t -> string -> unit [@@js.set] 436 | val set_cursor: t -> string -> unit [@@js.set] 437 | val set_display: t -> string -> unit [@@js.set] 438 | val set_visibility: t -> string -> unit [@@js.set] 439 | 440 | val get: t -> string -> string 441 | [@@js.custom 442 | let get style prop = 443 | Ojs.string_of_js (Ojs.get_prop_ascii (t_to_js style) prop) 444 | ] 445 | val unset: t -> string -> unit 446 | [@@js.custom 447 | let unset style prop = 448 | Ojs.set_prop_ascii (t_to_js style) prop Ojs.null 449 | ] 450 | end 451 | 452 | module ClassList : sig 453 | type t 454 | val t_of_js: Ojs.t -> t 455 | val t_to_js: t -> Ojs.t 456 | 457 | val add: t -> string -> unit [@@js.call] 458 | val remove: t -> string -> unit [@@js.call] 459 | val contains: t -> string -> bool [@@js.call] 460 | val replace: t -> string -> string -> unit [@@js.call] 461 | val toggle: t -> string -> bool -> bool [@@js.call] 462 | end 463 | 464 | module Element : sig 465 | (* Only arguments marked with a "T" may be a textNode. *) 466 | (* When element arguments are required to be a specific element, 467 | it is marked with (where 'tag' is the element's tag name). *) 468 | 469 | type t 470 | val t_of_js: Ojs.t -> t 471 | val t_to_js: t -> Ojs.t 472 | 473 | val null: t 474 | [@@js.custom 475 | let null = t_of_js Ojs.null 476 | ] 477 | 478 | val id: t -> string [@@js.get] 479 | val set_id: t -> string -> unit [@@js.set] 480 | 481 | type node_type = 482 | | ELEMENT_NODE [@js 1] 483 | | TEXT_NODE [@js 3] 484 | | PROCESSING_INSTRUCTION_NODE [@js 7] 485 | | COMMENT_NODE [@js 8] 486 | | DOCUMENT_NODE [@js 9] 487 | | DOCUMENT_TYPE_NODE [@js 10] 488 | | DOCUMENT_FRAGMENT_NODE [@js 11] 489 | [@@js.enum] 490 | 491 | val node_type: t (* T *) -> node_type [@@js.get] 492 | 493 | val clone_node: t (* T *) -> bool -> t [@@js.call] 494 | val contains: t (* T *) -> t (* T *) -> bool [@@js.call] 495 | val append_child: t -> t (* T *) -> unit [@@js.call] 496 | val insert_before: t -> t (* T *) -> t (* T *) -> unit [@@js.call] 497 | val replace_child: t -> t (* T *) -> t (* T *) -> unit [@@js.call] 498 | val remove_child: t -> t (* T *) -> unit [@@js.call] 499 | val first_child: t -> t (* May return Element.null *) [@@js.get] 500 | val last_child: t -> t (* May return Element.null *) [@@js.get] 501 | val next_sibling: t (* T *) -> t (* May return Element.null *) [@@js.get] 502 | 503 | val remove_all_children: t -> unit 504 | [@@js.custom 505 | let remove_all_children x = 506 | let rec loop child = 507 | if child = null then () 508 | else (remove_child x child; loop (first_child x)) 509 | in 510 | loop (first_child x) 511 | ] 512 | 513 | val has_child_nodes: t (* T *) -> bool [@@js.call] 514 | val add_event_listener: t (* T *) -> Event.kind -> (Event.t -> unit) -> bool -> unit [@@js.call] 515 | val add_cancellable_event_listener: t -> Event.kind -> (Event.t -> unit) -> bool -> (unit -> unit) 516 | [@@js.custom 517 | val add_event_listener_internal: t -> Event.kind -> Ojs.t -> bool -> unit 518 | [@@js.call "addEventListener"] 519 | val remove_event_listener_internal: t -> Event.kind -> Ojs.t -> bool -> unit 520 | [@@js.call "removeEventListener"] 521 | let add_cancellable_event_listener x k f c = 522 | let f = Ojs.fun_to_js 1 (fun x -> f (Event.t_of_js x)) in 523 | add_event_listener_internal x k f c; 524 | fun () -> 525 | remove_event_listener_internal x k f c 526 | ] 527 | val inner_text: t -> string [@@js.get] 528 | val get_elements_by_tag_name: t -> string -> t array [@@js.call] 529 | val get_elements_by_class_name: t -> string -> t array [@@js.call] 530 | 531 | val has_attribute: t -> string -> bool [@@js.call] 532 | val get_attribute: t -> string -> string [@@js.call] 533 | val remove_attribute: t -> string -> unit [@@js.call] 534 | val set_attribute: t -> string -> string -> unit [@@js.call] 535 | val get_bounding_client_rect: t -> Rect.t [@@js.call] 536 | val get_bounding_box: t (* svg *) -> SVGRect.t [@@js.call "getBBox"] 537 | 538 | type shadow_mode = 539 | | Open [@js "open"] 540 | | Closed [@js "closed"] 541 | [@@js.enum] 542 | 543 | [@@@js.stop] 544 | val attach_shadow: mode:shadow_mode -> t -> t 545 | [@@@js.start] 546 | [@@@js.implem 547 | type shadow_root_init = { mode: shadow_mode } [@@js] 548 | val attach_shadow: t -> shadow_root_init -> t [@@js.call] 549 | 550 | let attach_shadow ~mode element = attach_shadow element {mode} 551 | ] 552 | 553 | val normalize: t (* T *) -> unit [@@js.call] 554 | 555 | val value: t (* *) -> string [@@js.get] 556 | val set_value: t (* *) -> string -> unit [@@js.set] 557 | val select: t (*