diff options
| -rwxr-xr-x | blog/dune | 1 | ||||
| -rwxr-xr-x | blog/nord.ml | 1 | ||||
| -rwxr-xr-x | blog/sidebar.ml | 93 | ||||
| -rwxr-xr-x | elements/input.ml | 29 | ||||
| -rwxr-xr-x | elements/prop.ml | 15 | ||||
| -rwxr-xr-x | layer/svg.ml | 16 | ||||
| -rwxr-xr-x | path/point.ml | 6 | ||||
| -rwxr-xr-x | path/point.mli | 2 | ||||
| -rwxr-xr-x | paths.ml | 2 | ||||
| -rwxr-xr-x | script.ml | 342 | ||||
| -rwxr-xr-x | state.ml | 221 | ||||
| -rwxr-xr-x | theme/dune | 7 | ||||
| -rwxr-xr-x | theme/nord.ml | 39 | ||||
| -rwxr-xr-x | theme/theme.ml | 1 | 
14 files changed, 398 insertions, 377 deletions
| @@ -3,6 +3,7 @@   (libraries      brr     brr.note +   color     elements     )   ) diff --git a/blog/nord.ml b/blog/nord.ml new file mode 100755 index 0000000..78c4c61 --- /dev/null +++ b/blog/nord.ml @@ -0,0 +1 @@ +let nord0 = Jstr.v "#2e3440" diff --git a/blog/sidebar.ml b/blog/sidebar.ml index 83afb13..a1293de 100755 --- a/blog/sidebar.ml +++ b/blog/sidebar.ml @@ -1,7 +1,5 @@  open StdLabels  open Brr -open Brr_note -open Note  (** Return the sidebar *)  let get @@ -24,94 +22,3 @@ let rec clean              clean el          ) -let click_event el = -  Evr.on_el -    Ev.click -    Evr.unit -    el - -let show_value = function -  | None -> El.txt' "" -  | Some input -> -    El.txt (Jstr.of_int input) - -let add_button -  : El.t -> unit E.t * unit E.t -  = fun element -> - -    let open El in - -    let delete = -      button -        [ El.i -            ~at:At.[ class' (Jstr.v "fas") -                   ; class' (Jstr.v "fa-times-circle") ] -            [] -        ; txt' "Delete "] in - -    let delete_event = click_event delete in - -    let export = -      button -        [ El.i -            ~at:At.[ class' (Jstr.v "fas") -                   ; class' (Jstr.v "fa-download") ] -            [] -        ; txt' "Download"] in -    let export_event = click_event export in - - -    let nib_size, value  = -      Elements.Input.slider -        ~at:At.[ type' (Jstr.v "range") -               ; v (Jstr.v "min") (Jstr.v "0") -               ; v (Jstr.v "max") (Jstr.v "50") -               ; id (Jstr.v "nib_size") -               ] in - -    let width = El.div [] in -    Elr.def_children -      width -      (value -       |> S.map (fun v -> -           [ txt' "Width : " -           ; show_value v ] -         ) -      ); - -    let input_angle, angle_event = -      Elements.Input.slider -        ~at:At.[ type' (Jstr.v "range") -               ; v (Jstr.v "min") (Jstr.v "0") -               ; v (Jstr.v "max") (Jstr.v "90")] in -    let angle = El.div [] in -    Elr.def_children -      angle -      (angle_event -       |> S.map (fun v -> -           [ txt' "Angle : " -           ; show_value v -           ; txt' "°" ] -         ) -      ); - -    let click = Evr.on_el Ev.click Evr.unit delete in -    let _ = click in - -    let () = -      El.append_children element -        [ hr () -        ; delete -        ; export -        ; hr () - -        ; width -        ; nib_size -        ; El.br () - -        ; angle -        ; input_angle - -        ] -    in -    delete_event, export_event diff --git a/elements/input.ml b/elements/input.ml index 790b15d..935f34a 100755 --- a/elements/input.ml +++ b/elements/input.ml @@ -3,18 +3,23 @@ open Brr_note  open Note  (** Create a slider element, and a signal with the value *) -let slider ~at = -  let slider = -    El.input ~at () in +let slider +  : at:Brr.At.t list -> Brr.El.t * float S.t -  let event = -    Evr.on_el -      Ev.input (fun _ -> -          let raw_value = El.prop El.Prop.value slider in -          Jstr.to_int raw_value) -      slider -    |> S.hold (Jstr.to_int (El.prop El.Prop.value slider)) -  in -  slider, event +  = 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/elements/prop.ml b/elements/prop.ml new file mode 100755 index 0000000..715adec --- /dev/null +++ b/elements/prop.ml @@ -0,0 +1,15 @@ +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") diff --git a/layer/svg.ml b/layer/svg.ml index f174acc..f7cc670 100755 --- a/layer/svg.ml +++ b/layer/svg.ml @@ -2,10 +2,8 @@  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 @@ -26,20 +24,19 @@ let move_to    = fun point path ->      let x, y = V2.to_tuple point in -    Jstr.append path @@      Jstr.concat ~sep:(Jstr.v " ") -      [ Jstr.v " M" +      [ path +      ; 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") +      [ path +      ; (Jstr.v "L")        ; (Jstr.of_float x)        ; (Jstr.of_float y) ] @@ -49,9 +46,9 @@ let quadratic_to      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") +      [ path +      ; (Jstr.v "C")        ; (Jstr.of_float cx)        ; (Jstr.of_float cy)        ; (Jstr.v ",") @@ -65,4 +62,3 @@ let close    : 'a t -> 'a t    = fun path ->      Jstr.append path (Jstr.v " Z") - diff --git a/path/point.ml b/path/point.ml index 808310c..abb9515 100755 --- a/path/point.ml +++ b/path/point.ml @@ -10,10 +10,10 @@ let empty =    ; angle = 0.    } -let create x y = +let create ~angle ~width ~x ~y =    { p = Gg.V2.v x y -  ; size = 10. -  ; angle = Float.neg Gg.Float.pi_div_4 +  ; size = width +  ; angle = Gg.Float.rad_of_deg (180. -. angle )    }  let copy point p = diff --git a/path/point.mli b/path/point.mli index 521eced..2c687ab 100755 --- a/path/point.mli +++ b/path/point.mli @@ -6,7 +6,7 @@ val (+): t -> Gg.v2 -> t  val get_coord : t -> Gg.v2 -val create: float -> float -> t +val create: angle:float -> width:float -> x:float -> y:float -> t  val copy : t -> Gg.v2 -> t diff --git a/paths.ml b/paths.ml new file mode 100755 index 0000000..2db8ab0 --- /dev/null +++ b/paths.ml @@ -0,0 +1,2 @@ +module Path_Builder = Path.Builder.Make(Path.Point) + @@ -1,53 +1,13 @@  open StdLabels  open Note  open Brr +open Brr_note -module Path_Builder = Path.Builder.Make(Path.Point)  module CanvaRepr = Path.FillPrinter.Make(Layer.CanvaPrinter) -module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg) -module Path_Printer = Path_Builder.Draw(CanvaRepr) -module Fixed_Printer = Path_Builder.DrawFixed(CanvaRepr) - -module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr) - -let expected_host = [%static_hash ""] - -type mode = -  | Edit -  | Selection of Path_Builder.fixedPath -  | Out - -let timer, tick = Elements.Timer.create () - -type current = Path_Builder.t - -(* - The state cannt hold functionnal values, and thus cannot be used to store - elements like timer - *) -type state = -  { mode : mode -  ; paths : Path_Builder.fixedPath list -  ; current : current -  } - -(** Events *) -type canva_events = -  [ `Click of float * float -  | `Out of float * float -  ] - -type button_events = -  [ `Delete -  | `Export -  ] - -type events = -  [ canva_events -  | button_events -  | `Point of float * (float * float) ] +module Path_Printer = Paths.Path_Builder.Draw(CanvaRepr) +module Fixed_Printer = Paths.Path_Builder.DrawFixed(CanvaRepr)  type canva_signal = Path.Point.t @@ -55,17 +15,29 @@ module Mouse = Brr_note_kit.Mouse  (** Create the element in the page, and the event handler *)  let canva -  : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t +  : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t    = fun element -> +    (* Adapt the width to the window *)      El.set_inline_style        El.Style.width        (Jstr.v "100%")        element; +    (* See https://stackoverflow.com/a/14855870/13882826 *) +    El.set_inline_style +      El.Style.height +      (Jstr.v "100%") +      element; +      El.set_prop        El.Prop.width -      (El.prop (El.Prop.int (Jstr.v "offsetWidth")) element) +      (El.prop Elements.Prop.offsetWidth element) +      element; + +    El.set_prop +      El.Prop.height +      (El.prop Elements.Prop.offsetHeight element)        element;      El.set_inline_style @@ -73,7 +45,6 @@ let canva        (Jstr.v "")        element; -      let module C = Brr_canvas.Canvas in      let c = C.of_el element in @@ -101,156 +72,99 @@ let canva      E.select [click; up], pos, c -let insert_or_replace ((x, y) as p) path = -  let point = Path.Point.create x y in -  match Path_Builder.peek path with -  | None -> -    Path_Builder.add_point -      point -      path -  | Some p1 -> -    let open Gg.V2 in - -    let p1' = Path.Point.get_coord p1 in - -    let dist = (norm (p1' - (of_tuple p))) in -    if dist < 5. then ( -      path, None -    ) else ( -      Path_Builder.add_point -        point -        path -    ) - -let check_selection position paths = -  let point = Gg.V2.of_tuple position in -  (* If the user click on a curve, select it *) -  List.fold_left paths -    ~init:None -    ~f:(fun selection path -> - -        match selection with -        | Some p -> Some p -        | None -> -          (* TODO : Add a method in the point module *) -          begin match Path_Builder.distance point path with -            | Some p when p < 20. -> -              Some path -            | _ -> None -          end -      ) - -let do_action -  : events -> state -> state -  = fun event state -> -    match event, state.mode with -    | `Point (_delay, point), Edit -> -      (* Add the point in the list *) -      let current, fixed_path = insert_or_replace -          point -          state.current in -      let paths = match fixed_path with -        | None -> state.paths -        | Some p -> p::state.paths in -      { state with current; paths } - -    (* Click anywhere while in Out mode, we switch in edition *) -    | `Click _, Out -> -      Elements.Timer.start timer 0.3; -      { state with mode = Edit } - -    (* Click anywhere while in selection mode, we either select another path, -       or switch to Out mode*) -    | `Click position, (Selection _) -> -      begin match check_selection position state.paths with -        | None -> -          { state with -            mode = Out } -        | Some selected -> - -          (* Start the timer in order to handle the mouse moves *) -          Elements.Timer.start timer 0.3; -          { state with -            mode = (Selection selected)} -      end - -    | `Out point, Edit -> -      Elements.Timer.stop timer; -      begin match Path_Builder.peek2 state.current with -        (* If there is at last two points selected, handle this as a curve -            creation *) -        | Some _ -> -          let current, fixed_path = insert_or_replace point state.current in -          let paths = match fixed_path with -            | None -> Path_Builder.to_fixed current::state.paths -            | Some p -> p::state.paths -          and current = Path_Builder.empty in -          { mode = Out -          ; paths; current } - -        (* Else, check if there is a curve undre the cursor, and remove it *) -        | None -> -          let current = Path_Builder.empty in -          begin match check_selection point state.paths with -            | None -> -              { state with -                mode = Out -              ; current -              } -            | Some selected -> -              { state with -                mode = (Selection selected) -              ; current } -          end -      end -    | `Delete, Selection s -> -      let id = Path_Builder.id s in -      let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in -      { state with paths ; mode = Out} - - -    | `Export, _ -> - -      let my_host = Uri.host @@ Window.location @@ G.window in - -      if (Hashtbl.hash my_host) = expected_host then ( -        (* Convert the path into an sVG element *) -        let svg = Layer.Svg.svg -            ~at:Brr.At.[ -                v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") -              ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] -            (List.map state.paths -               ~f:(fun path -> -                   let repr = SVGRepr.create_path (fun _ -> ()) in -                   let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in - -                   Layer.Svg.path -                     ~at:Brr.At.[ -                         v (Jstr.v "fill")   (Jstr.v "#000000") -                       ; v (Jstr.v "stroke") (Jstr.v "#000000") -                       ; v (Jstr.v "d") path ] -                     [] -                 )) in -        let content = El.prop (El.Prop.jstr @@ Jstr.v "outerHTML") svg in - -        let btoa = Jv.get Jv.global "btoa" in -        let base64data = Jv.apply btoa -            [| Jv.of_jstr content |] in - -        (* Create the link to download the the element, and simulate a click on it *) -        let a = El.a -            ~at:At.[ -                href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data)) -              ; v (Jstr.v "download") (Jstr.v "out.svg") -              ] -            [] in -        El.click a +let click_event el = +  Evr.on_el +    Ev.click +    Evr.unit +    el + +let show_value input = +  El.txt (Jstr.of_float input) + +let set_sidebar +  : El.t -> State.state -> unit E.t * float S.t * float S.t *unit E.t +  = fun element state -> + +    let open El in + +    let delete = +      button +        [ El.i +            ~at:At.[ class' (Jstr.v "fas") +                   ; class' (Jstr.v "fa-times-circle") ] +            [] +        ; txt' "Delete "] in + +    let delete_event = click_event delete in + +    let export = +      button +        [ El.i +            ~at:At.[ class' (Jstr.v "fas") +                   ; class' (Jstr.v "fa-download") ] +            [] +        ; txt' "Download"] in +    let export_event = click_event export in + +    let nib_size, nib_size_event  = +      Elements.Input.slider +        ~at:At.[ type' (Jstr.v "range") +               ; v (Jstr.v "min") (Jstr.v "1") +               ; v (Jstr.v "max") (Jstr.v "50") +               ; At.value (Jstr.of_float state.width) +               ; id (Jstr.v "nib_size") +               ] in + +    let width = El.div [] in +    Elr.def_children +      width +      (nib_size_event +       |> S.map (fun v -> +           [ txt' "Width : " +           ; show_value v ] +         )        ); -      state -    | _ -> state +    let input_angle, angle_event = +      Elements.Input.slider +        ~at:At.[ type' (Jstr.v "range") +               ; v (Jstr.v "min") (Jstr.v "1") +               ; v (Jstr.v "max") (Jstr.v "90") +               ; At.value (Jstr.of_float state.angle) +               ] in +    let angle = El.div [] in +    Elr.def_children +      angle +      (angle_event +       |> S.map (fun v -> +           [ txt' "Angle : " +           ; show_value v +           ; txt' "°" ] +         ) +      ); + +    let click = Evr.on_el Ev.click Evr.unit delete in +    let _ = click in + +    let () = +      El.append_children element +        [ hr () +        ; delete +        ; export +        ; hr () -let backgroundColor = Jstr.v "#2e3440" +        ; width +        ; nib_size +        ; El.br () + +        ; angle +        ; input_angle + +        ] +    in +    delete_event, angle_event, nib_size_event, export_event + +let backgroundColor = Blog.Nord.nord0  let white = Jstr.v "#eceff4"  let green = Jstr.v "#a3be8c"  let nord8 = Jstr.v "#81a1c1" @@ -260,7 +174,6 @@ let on_change canva mouse_position state =    let open Brr_canvas.C2d in    let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in -  let _area = Gg.V2.v w h in    let context = create canva in @@ -282,9 +195,9 @@ let on_change canva mouse_position state =    *)    let pos = S.rough_value mouse_position in    let current, paths = -    begin match state.mode, pos with +    begin match state.State.mode, pos with        | Edit, Some point -> -        begin match insert_or_replace point state.current with +        begin match State.insert_or_replace state point state.current with            | current, None -> current, state.paths            | current, Some p -> current, p::state.paths          end @@ -296,7 +209,8 @@ let on_change canva mouse_position state =    let path = CanvaRepr.get      @@ Path_Printer.draw        current -      (CanvaRepr.create_path (fun p -> fill context p)) in +      (*       (CanvaRepr.create_path (fun p -> fill context p)) in *) +      (CanvaRepr.create_path (fun _ -> () )) in    stroke context path;    List.iter paths @@ -325,24 +239,24 @@ let on_change canva mouse_position state =  let page_main id = -  let init = -    { paths = [] -    ; current = Path_Builder.empty -    ; mode = Out -    } in -  let delete_event', export_event' = +  let delete_event', angle_signal', width_signal', export_event' =      begin match Blog.Sidebar.get () with        | None ->          Jv.throw (Jstr.v "No sidebar")        | Some el ->          Blog.Sidebar.clean el; -        let event = Blog.Sidebar.add_button el in -        event +        set_sidebar el State.init      end in    let delete_event = E.map (fun () -> `Delete) delete_event' -  and export_event = E.map (fun () -> `Export) export_event' in +  and export_event = E.map (fun () -> `Export) export_event' +  and angle_event = S.changes angle_signal' +                    |> E.map (fun value -> `Angle value) +  and width_event = S.changes width_signal' +                    |> E.map (fun value -> `Width value) +  in +    (*begin match Document.find_el_by_id G.document id with*) @@ -362,15 +276,21 @@ let page_main id =        let tick_event =          S.sample_filter mouse_position -          ~on:tick +          ~on:State.tick            (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in        (* The first evaluation is the state. Which is the result of all the           successives events to the initial state *)        let state = -        E.select [canva_events; tick_event; delete_event; export_event] -        |> E.map do_action -        |> Note.S.accum init in +        E.select +          [ canva_events +          ; tick_event +          ; angle_event +          ; width_event +          ; delete_event +          ; export_event ] +        |> E.map State.do_action +        |> Note.S.accum State.init in        (* The seconde evaluation is the canva refresh, which only occurs when           the mouse is updated, or on delete events  *) @@ -383,7 +303,7 @@ let page_main id =        (* Draw the canva for first time *) -      on_change canva mouse_position init; +      on_change canva mouse_position State.init;        (* Hold the state *)        let _ = Logr.hold (S.log state (fun _ -> ())) in diff --git a/state.ml b/state.ml new file mode 100755 index 0000000..60796c8 --- /dev/null +++ b/state.ml @@ -0,0 +1,221 @@ +open StdLabels +open Brr + +module Path_Builder = Paths.Path_Builder +module SVGRepr = Path.WireFramePrinter.Make(Layer.Svg) +module SVG_Fixed_Printer = Path_Builder.DrawFixed(SVGRepr) + + +let expected_host = [%static_hash ""] + +let backgroundColor = Blog.Nord.nord0 + +let timer, tick = Elements.Timer.create () + +type mode = +  | Edit +  | Selection of Path_Builder.fixedPath +  | Out + +type current = Path_Builder.t + + +(** Events *) +type canva_events = +  [ `Click of float * float +  | `Out of float * float +  ] + +type button_events = +  [ `Delete +  | `Export +  ] + +type events = +  [ canva_events +  | button_events +  | `Point of float * (float * float) +  | `Width of float +  | `Angle of float +  ] + +(* + The state cannt hold functionnal values, and thus cannot be used to store + elements like timer + *) +type state = +  { mode : mode +  ; paths : Path_Builder.fixedPath list +  ; current : current +  ; width : float +  ; angle : float +  } + +let insert_or_replace state ((x, y) as p) path = +  let width = state.width +  and angle = state.angle in +  let point = Path.Point.create ~x ~y ~angle ~width in +  match Path_Builder.peek path with +  | None -> +    Path_Builder.add_point +      point +      path +  | Some p1 -> +    let open Gg.V2 in + +    let p1' = Path.Point.get_coord p1 in + +    let dist = (norm (p1' - (of_tuple p))) in +    if dist < 5. then ( +      path, None +    ) else ( +      Path_Builder.add_point +        point +        path +    ) + +let check_selection +  : (float * float) -> Path_Builder.fixedPath list -> Path_Builder.fixedPath option +  = fun position paths -> +    let point = Gg.V2.of_tuple position in +    (* If the user click on a curve, select it *) +    List.fold_left paths +      ~init:None +      ~f:(fun selection path -> + +          match selection with +          | Some p -> Some p +          | None -> +            (* TODO : Add a method in the point module *) +            begin match Path_Builder.distance point path with +              | Some p when p < 20. -> +                Some path +              | _ -> None +            end +        ) + + +let do_action +  : events -> state -> state +  = fun event state -> +    match event, state.mode with +    | `Point (_delay, point), Edit -> +      (* Add the point in the list *) +      let current, fixed_path = insert_or_replace +          state +          point +          state.current in +      let paths = match fixed_path with +        | None -> state.paths +        | Some p -> p::state.paths in +      { state with current; paths } + +    (* Click anywhere while in Out mode, we switch in edition *) +    | `Click _, Out -> +      Elements.Timer.start timer 0.3; +      { state with mode = Edit } + +    (* Click anywhere while in selection mode, we either select another path, +       or switch to Out mode*) +    | `Click position, (Selection _) -> +      begin match check_selection position state.paths with +        | None -> +          { state with +            mode = Out } +        | Some selected -> + +          (* Start the timer in order to handle the mouse moves *) +          Elements.Timer.start timer 0.3; +          { state with +            mode = (Selection selected)} +      end + +    | `Out point, Edit -> +      Elements.Timer.stop timer; +      begin match Path_Builder.peek2 state.current with +        (* If there is at last two points selected, handle this as a curve +            creation *) +        | Some _ -> +          let current, fixed_path = insert_or_replace state point state.current in +          let paths = match fixed_path with +            | None -> Path_Builder.to_fixed current::state.paths +            | Some p -> p::state.paths +          and current = Path_Builder.empty in +          { state with +            mode = Out +          ; paths; current } + +        (* Else, check if there is a curve undre the cursor, and remove it *) +        | None -> +          let current = Path_Builder.empty in +          begin match check_selection point state.paths with +            | None -> +              { state with +                mode = Out +              ; current +              } +            | Some selected -> +              { state with +                mode = (Selection selected) +              ; current } +          end +      end +    | `Delete, Selection s -> +      let id = Path_Builder.id s in +      let paths = List.filter state.paths ~f:(fun p -> Path_Builder.id p != id) in +      { state with paths ; mode = Out} + + +    | `Export, _ -> + +      let my_host = Uri.host @@ Window.location @@ G.window in + +      if (Hashtbl.hash my_host) = expected_host then ( +        (* Convert the path into an sVG element *) +        let svg = Layer.Svg.svg +            ~at:Brr.At.[ +                v (Jstr.v "xmlns") (Jstr.v "http://www.w3.org/2000/svg") +              ; v (Jstr.v "xmlns:xlink") (Jstr.v "http://www.w3.org/1999/xlink") ] +            (List.map state.paths +               ~f:(fun path -> +                   let repr = SVGRepr.create_path (fun _ -> ()) in +                   let path = SVGRepr.get @@ SVG_Fixed_Printer.draw path repr in + +                   Layer.Svg.path +                     ~at:Brr.At.[ +                         v (Jstr.v "fill")  backgroundColor +                       ; v (Jstr.v "stroke") backgroundColor +                       ; v (Jstr.v "d") path ] +                     [] +                 )) in +        let content = El.prop Elements.Prop.outerHTML svg in + +        let btoa = Jv.get Jv.global "btoa" in +        let base64data = Jv.apply btoa +            [| Jv.of_jstr content |] in + +        (* Create the link to download the the element, and simulate a click on it *) +        let a = El.a +            ~at:At.[ +                href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data)) +              ; v (Jstr.v "download") (Jstr.v "out.svg") +              ] +            [] in +        El.click a +      ); +      state + +    | `Angle angle, _ -> +      { state with angle} +    | `Width width, _ -> +      { state with width} + +    | _ -> state + +let init = +  { paths = [] +  ; current = Path_Builder.empty +  ; mode = Out +  ; angle = 30. +  ; width = 10. +  } diff --git a/theme/dune b/theme/dune deleted file mode 100755 index a812bef..0000000 --- a/theme/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name theme) - (libraries  -   color -   gg -   ) -  ) diff --git a/theme/nord.ml b/theme/nord.ml deleted file mode 100755 index 4748d83..0000000 --- a/theme/nord.ml +++ /dev/null @@ -1,39 +0,0 @@ -open StdLabels - -let default = Color.of_rgb 5 255 255 - -let theme = -  [| "#2e3440" -   ; "#3b4252" -   ; "#434c5e" -   ; "#4c566a" -   (* Bright *) -   ; "#d8dee9" -   ; "" -   ; "#eceff4" -   (* Frost *) -   ; "#8fbcbb" -   ; "" -   ; "" -   ; "" -   (* Aurora 11 - *) -   ; "#bf616a" (* Redd color *) -   ; "" -   ; "" -   ; "#a3be8c" (* Green color *) - - -  |] -  |> Array.map ~f:(fun f -> -      Color.of_hexstring f -      |> Option.value ~default -    ) - -let set_color t f = -  let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in -  f r g b - - -let to_gg t = -  let Color.Rgba'.{r; g; b; _ } = Color.to_rgba' (Array.get theme t) in -  Gg.Color.of_srgb (Gg.V4.v r g b 1.) diff --git a/theme/theme.ml b/theme/theme.ml deleted file mode 100755 index 39974b1..0000000 --- a/theme/theme.ml +++ /dev/null @@ -1 +0,0 @@ -module Nord = Nord | 
