open StdLabels open Note open Brr open Brr_note module Mouse = Brr_note_kit.Mouse let get_height el = match El.at (Jstr.v "height") el with | None -> 0 | Some att -> Option.value ~default:0 (Jstr.to_int att) (** Create the element in the page, and the event handler *) let canva : 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 Elements.Prop.offsetWidth element) element; El.set_prop El.Prop.height (El.prop Elements.Prop.offsetHeight element) element; El.set_inline_style El.Style.width (Jstr.v "") element; let module C = Brr_canvas.Canvas in let c = C.of_el element in (* Mouse events *) let mouse = Brr_note_kit.Mouse.on_el ~normalize:false (fun x y -> (x, y)) element in let click = Brr_note_kit.Mouse.left_down mouse |> E.map (fun c -> `Click c) in let up = Brr_note_kit.Mouse.left_up mouse |> E.map (fun c -> `Out c) in let position = Mouse.pos mouse in let pos = S.l2 (fun b pos -> if b then Some pos else None ) (Mouse.left mouse) position in E.select [click; up], pos, c 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 ] ) ); 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") ; 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 br = El.br () in let render = El.select [ El.option ~at:At.[value (Jstr.v "Fill")] [ txt' "Fill"] ; El.option ~at:At.[value (Jstr.v "Wireframe")] [ txt' "Wireframe"] ; El.option ~at:At.[value (Jstr.v "Ductus")] [ txt' "Ductus"] ] in let () = El.append_children element [ hr () ; delete ; export ; hr () ; width ; nib_size ; angle ; input_angle ; br ; render ] 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" (** Redraw the canva on update *) let on_change canva mouse_position state = let module Cd2d = Brr_canvas.C2d in let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in let context = Cd2d.create canva in Cd2d.set_fill_style context (Cd2d.color backgroundColor); Cd2d.fill_rect context ~x:0.0 ~y:0.0 ~w ~h; Cd2d.set_stroke_style context (Cd2d.color white); Cd2d.set_fill_style context (Cd2d.color white); (* If we are in edit mode, we add a point under the cursor. Otherwise, we would only display the previous registered point, which can be far away in the past, and would give to the user a sensation of lag. *) let pos = S.rough_value mouse_position in let current = begin match state.State.mode, pos with | Edit, Some point -> State.insert_or_replace state point state.current | _ -> state.current end in let repr = `Fill in Path.to_canva (module Path.Path_Builder) current context repr; List.iter state.paths ~f:(fun path -> let () = match state.mode with | Selection id -> begin match id = (Path.Fixed.id path) with | true -> (* If the element is the selected one, change the color *) Cd2d.set_fill_style context (Cd2d.color Blog.Nord.nord8); Cd2d.set_stroke_style context (Cd2d.color Blog.Nord.nord8) | false -> Cd2d.set_stroke_style context (Cd2d.color white); Cd2d.set_fill_style context (Cd2d.color white); end | _ -> () in Path.to_canva (module Path.Fixed) path context repr ); () let page_main id = 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; 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' 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*) begin match (Jv.is_none id) with | true -> Console.(error [str "No element with id '%s' found"; id]) | false -> (* Add the events to the canva : - The mouse position is a signal used for both the update and the canva refresh - Get also the click event for starting to draw *) let canva_events, mouse_position, canva = canva (Jv.Id.of_jv id) in let tick_event = S.sample_filter mouse_position ~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 ; 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 *) let _ = E.select [ E.map (fun _ -> ()) (S.changes mouse_position) ; E.map (fun _ -> ()) (S.changes angle_signal') ; E.map (fun _ -> ()) (S.changes width_signal') ; delete_event' ] |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position (S.value state) ) |> Option.iter Logr.hold in (* Draw the canva for first time *) on_change canva mouse_position State.init; (* Hold the state *) let _ = Logr.hold (S.log state (fun _ -> ())) in () end let () = if Brr_webworkers.Worker.ami () then () else ( let open Jv in let drawer = obj [| "run", (repr page_main) |] in set global "drawer" drawer )