diff options
| author | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 15:38:37 +0100 | 
|---|---|---|
| committer | Sébastien Dailly <sebastien@dailly.me> | 2022-02-07 16:01:12 +0100 | 
| commit | 77544bdfad2af41514ec1435f706fee87ea2969e (patch) | |
| tree | 4de23870e08711da25ff92e9670370fc0a74e459 /lib | |
| parent | ad526111f0dd619ae9e0e98ef2253146b58a068f (diff) | |
Added viz.js code
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 | 
