diff options
Diffstat (limited to 'lib')
-rwxr-xr-x | lib/blog/dune | 21 | ||||
-rwxr-xr-x | lib/blog/hash_host/hash_blog.ml | 1 | ||||
-rwxr-xr-x | lib/blog/hash_host/hash_localhost.ml | 1 | ||||
-rwxr-xr-x | lib/blog/nord.ml | 2 | ||||
-rwxr-xr-x | lib/blog/sidebar.ml | 23 | ||||
-rwxr-xr-x | lib/elements/dune | 9 | ||||
-rwxr-xr-x | lib/elements/input.ml | 23 | ||||
-rwxr-xr-x | lib/elements/prop.ml | 20 | ||||
-rwxr-xr-x | lib/elements/timer.ml | 38 | ||||
-rwxr-xr-x | lib/elements/timer.mli | 11 | ||||
-rwxr-xr-x | lib/elements/transfert.ml | 22 | ||||
-rwxr-xr-x | lib/ppx_hash/dune | 6 | ||||
-rwxr-xr-x | lib/ppx_hash/ppx_hash.ml | 32 |
13 files changed, 209 insertions, 0 deletions
diff --git a/lib/blog/dune b/lib/blog/dune new file mode 100755 index 0000000..648990f --- /dev/null +++ b/lib/blog/dune @@ -0,0 +1,21 @@ +(rule + (targets hash_host.ml) + (enabled_if (= %{profile} dev)) + (action (copy# hash_host/hash_localhost.ml hash_host.ml))) + +(rule + (targets hash_host.ml) + (enabled_if (<> %{profile} dev)) + (action (copy# hash_host/hash_blog.ml hash_host.ml))) + +(library + (name blog) + (libraries + brr + brr.note + elements + ) + (preprocess (pps ppx_hash)) + + + ) diff --git a/lib/blog/hash_host/hash_blog.ml b/lib/blog/hash_host/hash_blog.ml new file mode 100755 index 0000000..f5e172e --- /dev/null +++ b/lib/blog/hash_host/hash_blog.ml @@ -0,0 +1 @@ +let expected_host = [%static_hash "blog.chimrod.com"] diff --git a/lib/blog/hash_host/hash_localhost.ml b/lib/blog/hash_host/hash_localhost.ml new file mode 100755 index 0000000..a41022e --- /dev/null +++ b/lib/blog/hash_host/hash_localhost.ml @@ -0,0 +1 @@ +let expected_host = [%static_hash "localhost"] diff --git a/lib/blog/nord.ml b/lib/blog/nord.ml new file mode 100755 index 0000000..f0f2772 --- /dev/null +++ b/lib/blog/nord.ml @@ -0,0 +1,2 @@ +let nord0 = Jstr.v "#2e3440" +let nord8 = Jstr.v "#81a1c1" diff --git a/lib/blog/sidebar.ml b/lib/blog/sidebar.ml new file mode 100755 index 0000000..1df0f1a --- /dev/null +++ b/lib/blog/sidebar.ml @@ -0,0 +1,23 @@ +open StdLabels +open Brr + +(** Return the sidebar *) +let get + : unit -> El.t option + = fun () -> + + List.find_opt (El.children @@ Document.body G.document) + ~f:(fun t -> El.has_tag_name El.Name.aside t) + +let rec clean + : El.t -> unit + = fun el -> + List.iter (El.children el) + ~f:(fun el -> + (* Remove the links from the sidebar, keep h1 and other stuff *) + if (El.has_tag_name (Jstr.v "nav") el) + || (El.has_tag_name (Jstr.v "ul") el) then + El.remove el + else + clean el + ) diff --git a/lib/elements/dune b/lib/elements/dune new file mode 100755 index 0000000..97d0753 --- /dev/null +++ b/lib/elements/dune @@ -0,0 +1,9 @@ +(library + (name elements) + (libraries + brr + brr.note + js_of_ocaml + ) + (preprocess (pps ppx_hash js_of_ocaml-ppx)) +) diff --git a/lib/elements/input.ml b/lib/elements/input.ml new file mode 100755 index 0000000..6ae9aa8 --- /dev/null +++ b/lib/elements/input.ml @@ -0,0 +1,23 @@ +open Brr +open Brr_note +open Note + +(** Create a slider element, and a signal with the value *) +let slider + : at:Brr.At.t list -> Brr.El.t * float S.t + + = fun ~at -> + let slider = + El.input ~at () in + + let init_value = (Jstr.to_float (El.prop El.Prop.value slider)) in + + let event = + Evr.on_el + Ev.input (fun _ -> + let raw_value = El.prop El.Prop.value slider in + Jstr.to_float raw_value) + slider + |> S.hold init_value + in + slider, event diff --git a/lib/elements/prop.ml b/lib/elements/prop.ml new file mode 100755 index 0000000..054864c --- /dev/null +++ b/lib/elements/prop.ml @@ -0,0 +1,20 @@ +open Brr + +include El.Prop + +let offsetWidth + : int t + = El.Prop.int (Jstr.v "offsetWidth") + +let offsetHeight + : int t + = El.Prop.int (Jstr.v "offsetHeight") + +let outerHTML + : Jstr.t t + = El.Prop.jstr (Jstr.v "outerHTML") + + +let value + : Jstr.t t + = El.Prop.jstr (Jstr.v "value") diff --git a/lib/elements/timer.ml b/lib/elements/timer.ml new file mode 100755 index 0000000..28516fc --- /dev/null +++ b/lib/elements/timer.ml @@ -0,0 +1,38 @@ +open Brr_note_kit + +type t = + { mutable id : Brr.G.timer_id + ; send : float Note.E.send + ; mutable counter : Time.counter + } + +let create + : unit -> (t * Brr_note_kit.Time.span Note.E.t) + = fun () -> + let event, send = Note.E.create () + and counter = (Time.counter ()) in + {id = (-1); send; counter}, event + +let stop + : t -> unit + = fun {id; _} -> + Brr.G.stop_timer id + +let start + : t -> float -> unit + = fun t d -> + let {id; send; _} = t in + t.counter <- Time.counter (); + + Brr.G.stop_timer id; + let timer_id = Brr.G.set_interval + ~ms:(int_of_float @@ d *. 1000.) + (fun () -> + + let span = Time.counter_value t.counter in + send span) in + t.id <- timer_id + + +let delay : t -> float + = fun t -> Time.counter_value t.counter diff --git a/lib/elements/timer.mli b/lib/elements/timer.mli new file mode 100755 index 0000000..0509ad0 --- /dev/null +++ b/lib/elements/timer.mli @@ -0,0 +1,11 @@ +open Brr_note_kit + +type t + +val create : unit -> t * Time.span Note.E.t + +val start: t -> float -> unit + +val stop: t -> unit + +val delay : t -> float diff --git a/lib/elements/transfert.ml b/lib/elements/transfert.ml new file mode 100755 index 0000000..ddeecd0 --- /dev/null +++ b/lib/elements/transfert.ml @@ -0,0 +1,22 @@ +open Js_of_ocaml +open Brr + +let send + : mime_type:Jstr.t -> filename:Jstr.t -> Jstr.t -> unit + = fun ~mime_type ~filename content -> + let btoa = Jv.get Jv.global "btoa" in + let base64data = Jv.apply btoa + [| Jv.of_jstr content |] in + + let mime = (Jv.Id.(of_jv @@ to_jv mime_type)) + and base64 = (Jv.Id.(of_jv @@ to_jv base64data)) + in + + let data = (Js.string "data:")##concat_3 mime (Js.string ";base64,") base64 in + + (* Create the link to download the the element, and simulate a click on it *) + let a = El.a + ~at:At.[ href Jv.Id.(of_jv @@ to_jv data) + ; v (Jstr.v "download") filename ] + [] in + El.click a diff --git a/lib/ppx_hash/dune b/lib/ppx_hash/dune new file mode 100755 index 0000000..7cb4bc8 --- /dev/null +++ b/lib/ppx_hash/dune @@ -0,0 +1,6 @@ +(library + (name ppx_hash) + (kind ppx_deriver) + (libraries ppxlib ) + (preprocess (pps ppxlib.metaquot)) + ) diff --git a/lib/ppx_hash/ppx_hash.ml b/lib/ppx_hash/ppx_hash.ml new file mode 100755 index 0000000..59584d5 --- /dev/null +++ b/lib/ppx_hash/ppx_hash.ml @@ -0,0 +1,32 @@ +open Ppxlib + +(** + + This is a simple ppx which evaluate hash for string at compilation time. + + [%static_hash "deadbeef"] is equivalent to [Hashtbl.hash "deadbeef"] + + the ppx only evaluate strings. +*) + +let name = "static_hash" + +let expand ~loc ~path:_ (value : string) = + let h = Hashtbl.hash value in + Ast_builder.Default.eint ~loc h + +let extension = + Extension.declare + name + Extension.Context.expression + Ast_pattern.(single_expr_payload (estring __)) + expand + + + +let rule = Ppxlib.Context_free.Rule.extension extension + +let () = + Driver.register_transformation + ~rules:[rule] + name |