From 20addbe8fd0ac4c79c8a69a4f888ec320a9ca4c3 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sat, 2 Jan 2021 16:20:42 +0100 Subject: Refactor --- script.it/script.ml | 326 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 326 insertions(+) create mode 100755 script.it/script.ml (limited to 'script.it/script.ml') diff --git a/script.it/script.ml b/script.it/script.ml new file mode 100755 index 0000000..3e52f5c --- /dev/null +++ b/script.it/script.ml @@ -0,0 +1,326 @@ +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) + ] 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 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 rendering' = El.div + [ txt' "Rendering : " + ; render ] in + + let () = + El.append_children element + [ hr () + ; delete + ; export + + ; rendering' + + ; hr () + + ; width + ; nib_size + + ; 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" + +(** 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 + ) -- cgit v1.2.3