aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@dailly.me>2022-02-07 15:38:37 +0100
committerSébastien Dailly <sebastien@dailly.me>2022-02-07 16:01:12 +0100
commit77544bdfad2af41514ec1435f706fee87ea2969e (patch)
tree4de23870e08711da25ff92e9670370fc0a74e459 /lib
parentad526111f0dd619ae9e0e98ef2253146b58a068f (diff)
Added viz.js code
Diffstat (limited to 'lib')
-rwxr-xr-xlib/blog/dune21
-rwxr-xr-xlib/blog/hash_host/hash_blog.ml1
-rwxr-xr-xlib/blog/hash_host/hash_localhost.ml1
-rwxr-xr-xlib/blog/nord.ml2
-rwxr-xr-xlib/blog/sidebar.ml23
-rwxr-xr-xlib/elements/dune9
-rwxr-xr-xlib/elements/input.ml23
-rwxr-xr-xlib/elements/prop.ml20
-rwxr-xr-xlib/elements/timer.ml38
-rwxr-xr-xlib/elements/timer.mli11
-rwxr-xr-xlib/elements/transfert.ml22
-rwxr-xr-xlib/ppx_hash/dune6
-rwxr-xr-xlib/ppx_hash/ppx_hash.ml32
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