diff options
author | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-23 19:11:31 +0100 |
---|---|---|
committer | Sébastien Dailly <sebastien@chimrod.com> | 2020-12-23 19:11:31 +0100 |
commit | ec812521b31471ce9ac3d9bdf1288b1569defbc8 (patch) | |
tree | d384c959b9e9bb2a04141ab56077026fe6e7c7f3 /layer | |
parent | 6354358caa1dfbf2fe1d481f6ac5fba3775938fc (diff) |
Add svg output
Diffstat (limited to 'layer')
-rwxr-xr-x | layer/svg.ml | 68 |
1 files changed, 68 insertions, 0 deletions
diff --git a/layer/svg.ml b/layer/svg.ml new file mode 100755 index 0000000..f174acc --- /dev/null +++ b/layer/svg.ml @@ -0,0 +1,68 @@ +(** SVG representation *) + +open Brr + +module Path = Brr_canvas.C2d.Path +module V2 = Gg.V2 + + +let svg : El.cons + = fun ?d ?at childs -> + El.v ?d ?at (Jstr.v "svg") childs + +let path: El.cons + = fun ?d ?at childs -> + El.v ?d ?at (Jstr.v "path") childs + +type 'a t = Jstr.t + +let create + : unit -> 'a t + = fun () -> Jstr.empty + +(* Start a new path. *) +let move_to + : Gg.v2 -> 'a t -> 'a t + = fun point path -> + let x, y = V2.to_tuple point in + + Jstr.append path @@ + Jstr.concat ~sep:(Jstr.v " ") + [ Jstr.v " M" + ; Jstr.of_float x + ; Jstr.of_float y ] + + +let line_to + : Gg.v2 -> 'a t -> 'a t + = fun point path -> + let x, y = V2.to_tuple point in + Jstr.append path @@ + Jstr.concat ~sep:(Jstr.v " ") + [ (Jstr.v " L") + ; (Jstr.of_float x) + ; (Jstr.of_float y) ] + +let quadratic_to + : Gg.v2 -> Gg.v2 -> Gg.v2 -> 'a t -> 'a t + = fun ctrl0 ctrl1 p1 path -> + let cx, cy = V2.to_tuple ctrl0 + and cx', cy' = V2.to_tuple ctrl1 + and x, y = V2.to_tuple p1 in + Jstr.append path @@ + Jstr.concat ~sep:(Jstr.v " ") + [ (Jstr.v " C") + ; (Jstr.of_float cx) + ; (Jstr.of_float cy) + ; (Jstr.v ",") + ; (Jstr.of_float cx') + ; (Jstr.of_float cy') + ; (Jstr.v ",") + ; (Jstr.of_float x) + ; (Jstr.of_float y) ] + +let close + : 'a t -> 'a t + = fun path -> + Jstr.append path (Jstr.v " Z") + |