diff options
| -rwxr-xr-x | blog/dune | 8 | ||||
| -rwxr-xr-x | blog/sidebar.ml | 131 | ||||
| -rwxr-xr-x | dune | 3 | ||||
| -rwxr-xr-x | path/builder.ml | 12 | ||||
| -rwxr-xr-x | path/builder.mli | 4 | ||||
| -rwxr-xr-x | script.ml | 68 |
6 files changed, 205 insertions, 21 deletions
diff --git a/blog/dune b/blog/dune new file mode 100755 index 0000000..532a7ee --- /dev/null +++ b/blog/dune @@ -0,0 +1,8 @@ +(library + (name blog) + (libraries + brr + brr.note + js_of_ocaml-tyxml) + (preprocess (pps tyxml-ppx)) + ) diff --git a/blog/sidebar.ml b/blog/sidebar.ml new file mode 100755 index 0000000..ed4b856 --- /dev/null +++ b/blog/sidebar.ml @@ -0,0 +1,131 @@ +open StdLabels +open Brr +open Brr_note +open Note + +(** Return the sidebar *) +let get + : unit -> El.t option + = fun () -> + + List.find_opt (El.children @@ Document.body G.document) + ~f:(fun t -> El.has_tag_name El.Name.aside t) + +let rec clean + : El.t -> unit + = fun el -> + List.iter (El.children el) + ~f:(fun el -> + (* Remove the links from the sidebar, keep h1 and other stuff *) + if (El.has_tag_name (Jstr.v "nav") el) + || (El.has_tag_name (Jstr.v "ul") el) then + El.remove el + else + clean el + ) + +(** Create a slider element, and the event on change *) +let slider ~at = + let slider = + El.input ~at () in + + let event = + Evr.on_el + Ev.input + (fun _ -> + let raw_value = El.prop El.Prop.value slider in + Jstr.to_int raw_value) + slider + in + slider, event + +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 + = 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 nib_size, value = + 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.set_children + width + ~on:(value + |> E.map (fun v -> + [ txt' "Width : " + ; show_value v ] + ) + ); + + let input_angle, angle_event = + 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.set_children + angle + ~on:(angle_event + |> E.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 @@ -9,10 +9,11 @@ messages messages_json worker - path shapes tools events + blog + path ) (modes js) (preprocess (pps js_of_ocaml-ppx)) diff --git a/path/builder.ml b/path/builder.ml index b77c60a..3ccad9c 100755 --- a/path/builder.ml +++ b/path/builder.ml @@ -328,7 +328,6 @@ module Make(Point:P) = struct Repr.stop repr end - let box : bezier -> Gg.box2 = fun bezier -> @@ -338,7 +337,6 @@ module Make(Point:P) = struct |> (fun b -> Gg.Box2.add_pt b bezier.ctrl0) |> (fun b -> Gg.Box2.add_pt b bezier.ctrl1) - let distance : Gg.v2 -> fixedPath -> float option = fun point beziers -> @@ -353,6 +351,7 @@ module Make(Point:P) = struct begin match Gg.Box2.mem point box with | false -> res | true -> + (* TODO Evaluate the normal *) res end | Curve bezier -> @@ -373,12 +372,9 @@ module Make(Point:P) = struct | None -> Some distance | Some d -> if d < distance then res else (Some distance) end - - ) - - - - + let id + : fixedPath -> int + = fun {id; _} -> id end diff --git a/path/builder.mli b/path/builder.mli index 42f433e..557cdfa 100755 --- a/path/builder.mli +++ b/path/builder.mli @@ -32,7 +32,6 @@ end module Make(P:P) : sig - type bezier type t type fixedPath @@ -72,4 +71,7 @@ module Make(P:P) : sig (** Return the shortest distance between the mouse and a point *) val distance : Gg.v2 -> fixedPath -> float option + + val id + : fixedPath -> int end @@ -6,6 +6,7 @@ module Timer = Events.Timer module Repr = Path.FillPrinter + module Path_Builder = Path.Builder.Make(Path.Point) module Path_Printer = Path_Builder.Draw(Repr) module Fixed_Printer = Path_Builder.DrawFixed(Repr) @@ -35,8 +36,12 @@ type canva_events = | `Out of float * float ] +type button_events = + [ `Delete ] + type events = [ canva_events + | button_events | `Point of float * (float * float) ] type canva_signal = Path.Point.t @@ -47,6 +52,23 @@ module Mouse = Brr_note_kit.Mouse let canva : Brr.El.t -> [> canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t = fun element -> + + El.set_inline_style + El.Style.width + (Jstr.v "100%") + element; + + El.set_prop + El.Prop.width + (El.prop (El.Prop.int (Jstr.v "offsetWidth")) 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 @@ -176,8 +198,10 @@ let do_action ; 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} | _ -> state let backgroundColor = Jstr.v "#2e3440" @@ -261,11 +285,32 @@ let page_main id = ; mode = Out } in + let delete_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 + end in + let delete_event = E.map (fun () -> `Delete) delete_event' 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 = @@ -276,24 +321,25 @@ let page_main id = (* 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] + E.select [canva_events; tick_event; delete_event] |> E.map do_action |> Note.S.accum init in (* The seconde evaluation is the canva refresh, which only occurs when - the mouse is updated *) - let v = - E.map (fun _ -> state) (S.changes mouse_position) - |> E.map (fun x -> on_change canva mouse_position (S.value x) ) - |> fun ev -> E.log ev (fun _ -> ()) in + the mouse is updated, or on delete events *) + let _ = + E.select + [ E.map (fun _ -> ()) (S.changes mouse_position) + ; 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 init; + (* Hold the state *) let _ = Logr.hold (S.log state (fun _ -> ())) in - let _ = match v with - | None -> () - | Some log -> Logr.hold log in () end |