Hazatro

src/haz3lcore/Animation.re

@@ -0,0 +1,232 @@
+open Util;
+open Js_of_ocaml;
+
+/* This implements arbitrary gpu-accelerated css position
+ * and scale transition animations via the the FLIP technique
+ * (https://aerotwist.com/blog/flip-your-animations/).
+ *
+ * From the client perspective, it suffices to call the request
+ * method with a list of the DOM element ids to animate, as well
+ * as some animation settings (keyframes, duration, easing).
+ *
+ * Some common keyframes are provided in the module at the bottom */
+
+/* This is an extremely partial implementation of the Web Animations
+ * API, which currently does not have Js_of_ocaml wrappers */
+module Js = {
+  /* CSS property-value pairs */
+  type keyframe = (string, string);
+
+  type options = {
+    duration: int,
+    easing: string,
+  };
+
+  /* Options for CSS Animations API animate method */
+  type animation = {
+    options,
+    keyframes: list(keyframe),
+  };
+
+  /* Position & dimensions for a DOM element */
+  type box = {
+    top: float,
+    left: float,
+    height: float,
+    width: float,
+  };
+
+  let box_of = (elem: Js.t(Dom_html.element)): box => {
+    let container_rect = elem##getBoundingClientRect;
+    {
+      top: container_rect##.top,
+      left: container_rect##.left,
+      height: Js.Optdef.get(container_rect##.height, _ => (-1.0)),
+      width: Js.Optdef.get(container_rect##.width, _ => (-1.0)),
+    };
+  };
+
+  let client_height = (): float =>
+    Js.Optdef.get(
+      Js.Unsafe.get(Dom_html.document, "documentElement")##.clientHeight, _ =>
+      0.0
+    );
+
+  let inner_height = (): float =>
+    Js.Optdef.get(Js.Unsafe.get(Dom_html.window, "innerHeight"), _ => 0.0);
+
+  let check_visible = (client_height, inner_height, box: box): bool => {
+    let viewHeight = max(client_height, inner_height);
+    !(box.top +. box.height < 0.0 || box.top -. viewHeight >= 0.0);
+  };
+
+  let keyframes_unsafe = (keyframes: list(keyframe)): Js.t(Js.js_array('a)) =>
+    keyframes
+    |> List.map(((prop: string, value: string)) =>
+         Js.Unsafe.obj([|(prop, Js.Unsafe.inject(Js.string(value)))|])
+       )
+    |> Array.of_list
+    |> Js.array;
+
+  let options_unsafe = ({duration, easing}: options): Js.t(Js.js_array('a)) =>
+    [
+      ("duration", Js.Unsafe.inject(duration)),
+      ("easing", Js.Unsafe.inject(Js.string(easing))),
+    ]
+    |> Array.of_list
+    |> Js.Unsafe.obj;
+
+  let animate_unsafe =
+      (
+        keyframes: list(keyframe),
+        options: options,
+        elem: Js.t(Dom_html.element),
+      ) =>
+    Js.Unsafe.meth_call(
+      elem,
+      "animate",
+      [|
+        Js.Unsafe.inject(keyframes_unsafe(keyframes)),
+        Js.Unsafe.inject(options_unsafe(options)),
+      |],
+    );
+
+  let animate = ({options, keyframes}, elem: Js.t(Dom_html.element)) =>
+    if (keyframes != []) {
+      switch (animate_unsafe(keyframes, options, elem)) {
+      | exception exn =>
+        print_endline("Animation: " ++ Printexc.to_string(exn))
+      | () => ()
+      };
+    };
+};
+
+open Js;
+
+/* If an element is new, report its new metrics.
+ * Otherwise, report both new & old metrics */
+type change =
+  | New(box)
+  //| Removed(box)
+  | Existing(box, box);
+
+/* Specify a transition for an element */
+type transition = {
+  /* A unique id used as attribute for
+   * the relevant DOM element */
+  id: string,
+  /* The animation function recieves the diffs
+   * for the element's position and scale across a
+   * change, which it may use to calculate the
+   * parameters for a resulting animation */
+  animate: change => animation,
+};
+
+/* Internally, transitions must track the initial
+ * metrics for an element, gathered in the `Request ` phase */
+type transition_internal = {
+  id: string,
+  animate: change => animation,
+  box: option(box),
+};
+
+/* Elements and their corresponding animations are tracked
+ * here between when the action is used (`request`) and
+ * when the animation is executed (`go`) */
+let tracked_elems: ref(list(transition_internal)) = ref([]);
+
+let animate_elem = (({box, animate, _}, elem, new_box)): unit =>
+  switch (box, new_box) {
+  | (Some(init), Some(final)) =>
+    Js.animate(animate(Existing(init, final)), elem)
+  | (None, Some(final)) => Js.animate(animate(New(final)), elem)
+  | (Some(_init), None) =>
+    //TODO: Removed case (requires retaining old element somehow)
+    ()
+  | (None, None) => ()
+  };
+
+let filter_visible_elements = (tracked_elems: list(transition_internal)) => {
+  let client_height = client_height();
+  let inner_height = inner_height();
+  List.filter_map(
+    (tr: transition_internal) => {
+      switch (JsUtil.get_elem_by_id_opt(tr.id)) {
+      | None => None
+      | Some(elem) =>
+        let new_box = box_of(elem);
+        check_visible(client_height, inner_height, new_box)
+          ? Some((tr, elem, Some(new_box))) : None;
+      }
+    },
+    tracked_elems,
+  );
+};
+
+/* Execute animations. This is called during the
+ * render phase, after recalc but before repaint */
+let go = (): unit =>
+  if (tracked_elems^ != []) {
+    tracked_elems^ |> filter_visible_elements |> List.iter(animate_elem);
+    tracked_elems := [];
+  };
+
+/* Request animations. Call this during the MVU update */
+let request = (transitions: list(transition)): unit => {
+  tracked_elems :=
+    List.map(
+      ({id, animate}: transition) =>
+        {
+          id,
+          box: Option.map(box_of, JsUtil.get_elem_by_id_opt(id)),
+          animate,
+        },
+      transitions,
+    )
+    @ tracked_elems^;
+};
+
+module Keyframes = {
+  let transform_translate = (top: float, left: float): keyframe => (
+    "transform",
+    Printf.sprintf("translate(%fpx, %fpx)", left, top),
+  );
+
+  let translate = (init: box, final: box): list(keyframe) => {
+    [
+      transform_translate(init.top -. final.top, init.left -. final.left),
+      transform_translate(0., 0.),
+    ];
+  };
+
+  let transform_scale_uniform = (scale: float): keyframe => (
+    "transform",
+    Printf.sprintf("scale(%f, %f)", scale, scale),
+  );
+
+  let scale_from_zero: list(keyframe) = [
+    transform_scale_uniform(0.0),
+    transform_scale_uniform(1.0),
+  ];
+};
+
+let easeOutExpo = "cubic-bezier(0.16, 1, 0.3, 1)";
+let easeInOutBack = "cubic-bezier(0.68, -0.6, 0.32, 1.6)";
+let easeInOutExpo = "cubic-bezier(0.87, 0, 0.13, 1)";
+
+module Actions = {
+  let move = id => {
+    id,
+    animate: change => {
+      options: {
+        duration: 125,
+        easing: easeOutExpo,
+      },
+      keyframes:
+        switch (change) {
+        | New(_) => Keyframes.scale_from_zero
+        | Existing(init, final) => Keyframes.translate(init, final)
+        },
+    },
+  };
+};

src/haz3lcore/Measured.re

@@ -266,15 +266,18 @@ let is_indented_map = (seg: Segment.t) => {
   go(seg);
 };
 
-let last_of_token = (token: string, origin: Point.t): Point.t =>
-  /* Supports multi-line tokens e.g. projector placeholders */
-  Point.{
-    col: origin.col + StringUtil.max_line_width(token),
-    row: origin.row + StringUtil.num_linebreaks(token),
-  };
+/* Tab projectors add linebreaks after the end of their line */
+let deferred_linebreaks: ref(list(int)) = ref([]);
+
+let consume_deferred_linebreaks = () => {
+  let max_deferred_linebreaks = List.fold_left(max, 0, deferred_linebreaks^);
+  deferred_linebreaks := [];
+  max_deferred_linebreaks;
+};
 
 let of_segment =
     (seg: Segment.t, shape_of_proj: Base.projector => ProjectorCore.shape): t => {
+  deferred_linebreaks := [];
   let is_indented = is_indented_map(seg);
 
   // recursive across seg's bidelimited containers
@@ -308,11 +311,6 @@ let of_segment =
              );
         (origin, map);
       | [hd, ...tl] =>
-        let extra_rows = (token, origin, map) => {
-          let row_indent = container_indent + contained_indent;
-          let num_extra_rows = StringUtil.num_linebreaks(token);
-          add_n_rows(origin, row_indent, num_extra_rows, map);
-        };
         let (contained_indent, origin, map) =
           switch (hd) {
           | Secondary(w) when Secondary.is_linebreak(w) =>
@@ -323,16 +321,16 @@ let of_segment =
               } else {
                 contained_indent + (Id.Map.find(w.id, is_indented) ? 2 : 0);
               };
+            let num_extra_rows = 1 + consume_deferred_linebreaks();
             let last =
-              Point.{row: origin.row + 1, col: container_indent + indent};
+              Point.{
+                row: origin.row + num_extra_rows,
+                col: container_indent + indent,
+              };
             let map =
               map
               |> add_w(w, {origin, last})
-              |> add_row(
-                   origin.row,
-                   {indent: row_indent, max_col: origin.col},
-                 )
-              |> add_n_rows(origin, row_indent, 1);
+              |> add_n_rows(origin, row_indent, num_extra_rows);
             (indent, last, map);
           | Secondary(w) =>
             let wspace_length =
@@ -349,14 +347,20 @@ let of_segment =
             let shape = shape_of_proj(p);
             let num_extra_rows =
               switch (shape.vertical) {
-              | Inline => 0
-              | Block(num_lbs) => num_lbs
+              | Inline
+              | Tab(0)
+              | Block(0) => 0
+              | Tab(num_lb) =>
+                deferred_linebreaks := [num_lb, ...deferred_linebreaks^];
+                num_lb;
+              | Block(num_lb) => num_lb + consume_deferred_linebreaks()
               };
             let last = {
               col: origin.col + shape.horizontal,
               row:
                 switch (shape.vertical) {
                 | Inline => origin.row
+                | Tab(_) => origin.row
                 | Block(num_lb) => origin.row + num_lb
                 },
             };
@@ -366,6 +370,18 @@ let of_segment =
               |> add_pr(p, {origin, last});
             (contained_indent, last, map);
           | Tile(t) =>
+            let extra_rows = (token, origin, map) => {
+              let row_indent = container_indent + contained_indent;
+              let num_lb = StringUtil.num_linebreaks(token);
+              let num_extra_rows =
+                StringUtil.num_linebreaks(token) + num_lb == 0
+                  ? 0 : consume_deferred_linebreaks();
+              add_n_rows(origin, row_indent, num_extra_rows, map);
+            };
+            let last_of_token = (token: string, origin: Point.t): Point.t => {
+              col: origin.col + StringUtil.max_line_width(token),
+              row: origin.row + StringUtil.num_linebreaks(token),
+            };
             let add_shard = (origin, shard, map) => {
               let token = List.nth(t.label, shard);
               let map = extra_rows(token, origin, map);

src/haz3lcore/projectors/ProjectorCore.re

@@ -23,17 +23,24 @@ type kind =
   | Checkbox
   | Slider
   | SliderF
+  | Card
   | TextArea;
 
 /* A projector shape determines the space left for
  * that projector, and how text flows around a projector
  * in a text editor. All projectors have a horizontal
  * extend (in characters), and the vertical extent may
  * be either 1 character (Inline), or it may insert
- * an additional number of linebreaks */
+ * an additional number of linebreaks, either immediately
+ * after the projector (Block style) or defer them to
+ * the next linebreak (Tab style). In the latter case,
+ * if there are multiple Tab projectors on a line, the
+ * total extra linebreaks inserted is the maxium required
+ * to accomodate them */
 [@deriving (show({with_path: false}), sexp, yojson)]
 type vertical =
   | Inline
+  | Tab(int)
   | Block(int);
 
 [@deriving (show({with_path: false}), sexp, yojson)]
@@ -51,7 +58,13 @@ type t('syntax) = {
   model: string,
 };
 
-let livelit_projectors: list(kind) = [Checkbox, Slider, SliderF, TextArea];
+let livelit_projectors: list(kind) = [
+  Card,
+  Checkbox,
+  Slider,
+  SliderF,
+  TextArea,
+];
 
 let projectors: list(kind) = livelit_projectors @ [Fold, Info, Probe];
 
@@ -60,7 +73,8 @@ let default: shape = inline(0);
 
 let token = (shape: shape): string =>
   switch (shape.vertical) {
-  | Inline => String.make(shape.horizontal, ' ')
+  | Inline
+  | Tab(_) => String.make(shape.horizontal, ' ')
   | Block(num_lb) =>
     String.make(num_lb, '\n') ++ String.make(shape.horizontal, ' ')
   };

src/haz3lcore/projectors/ProjectorInit.re

@@ -13,6 +13,7 @@ let to_module = (kind: ProjectorCore.kind): (module Cooked) =>
   | SliderF => (module Cook(SliderFProj.M))
   | Checkbox => (module Cook(CheckboxProj.M))
   | TextArea => (module Cook(TextAreaProj.M))
+  | Card => (module Cook(CardProj.M))
   };
 
 let init =