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.ml | 326 -------------------------------------------------------------- 1 file changed, 326 deletions(-) delete mode 100755 script.ml (limited to 'script.ml') diff --git a/script.ml b/script.ml deleted file mode 100755 index 3e52f5c..0000000 --- a/script.ml +++ /dev/null @@ -1,326 +0,0 @@ -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