diff options
Diffstat (limited to 'script.ml')
| -rwxr-xr-x | script.ml | 342 |
1 files changed, 131 insertions, 211 deletions
@@ -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 |