diff options
Diffstat (limited to 'script.it/script_event')
| -rwxr-xr-x | script.it/script_event/click.ml (renamed from script.it/script_event/out.ml) | 13 | ||||
| -rwxr-xr-x | script.it/script_event/complete_path.ml | 14 | ||||
| -rwxr-xr-x | script.it/script_event/delete.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/export.ml | 30 | ||||
| -rwxr-xr-x | script.it/script_event/mouse_down.ml | 2 | ||||
| -rwxr-xr-x | script.it/script_event/property.ml | 52 | ||||
| -rwxr-xr-x | script.it/script_event/tick.ml | 20 | 
7 files changed, 126 insertions, 7 deletions
| diff --git a/script.it/script_event/out.ml b/script.it/script_event/click.ml index b8b8599..591887b 100755 --- a/script.it/script_event/out.ml +++ b/script.it/script_event/click.ml @@ -8,8 +8,11 @@ type t = { point  : float * float           ; worker : Brr_webworkers.Worker.t           } -(** Long click, move the selected element if any *) -let longClick mouse_coord state worker = function +(** The drag function is incorrectly named, as we dont't care if we are +    selecting an element or not. + +    But, in the case we are (point, path…), we effectively move the element with the mouse. *) +let drag mouse_coord state worker = function    | State.Selection t ->      let mouse_v2 = Gg.V2.of_tuple mouse_coord in      begin match Selection.find_selection t state.State.paths with @@ -24,10 +27,10 @@ let longClick mouse_coord state worker = function          State.post worker (`TranslatePath (path, delta));          state      end -  (*  TODO Long click in out mode should translate the slate *) +  (*  TODO Long click in out mode should translate the whole slate *)    | _ -> state -let apply {point; timer ; worker} state = +let update {point; timer ; worker} state =    match state.State.mode with    | Edit -> @@ -84,5 +87,5 @@ let apply {point; timer ; worker} state =      state    | _ -> -    longClick point state worker state.mode +    drag point state worker state.mode diff --git a/script.it/script_event/complete_path.ml b/script.it/script_event/complete_path.ml new file mode 100755 index 0000000..99dd6ae --- /dev/null +++ b/script.it/script_event/complete_path.ml @@ -0,0 +1,14 @@ +open StdLabels +module State = Script_state.State + +type t = Outline.t + +let update newPath state = +  let paths = List.map +      state.State.paths +      ~f:(fun line -> +          match Outline.(newPath.id = line.id) with +          | true -> newPath +          | false -> line) in +  { state with paths } + diff --git a/script.it/script_event/delete.ml b/script.it/script_event/delete.ml index edd5d23..6aac5d2 100755 --- a/script.it/script_event/delete.ml +++ b/script.it/script_event/delete.ml @@ -7,7 +7,7 @@ module Selection = Script_state.Selection  type t = { worker : Brr_webworkers.Worker.t }  (* Click anywhere while in Out mode, we switch in edition *) -let apply { worker } state = +let update { worker } state =    match state.State.mode with    | Selection (Path id) ->      let paths = List.filter diff --git a/script.it/script_event/export.ml b/script.it/script_event/export.ml new file mode 100755 index 0000000..9e900c7 --- /dev/null +++ b/script.it/script_event/export.ml @@ -0,0 +1,30 @@ +open StdLabels +open Brr +module State = Script_state.State + +type t = unit + +let update () state = +  let my_host = Uri.host @@ Window.location @@ G.window in +  if (Hashtbl.hash my_host) = Blog.Hash_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.State.paths +           ~f:(fun path -> + +               Layer.Paths.to_svg +                 ~color:Blog.Nord.nord0 +                 (module Path.Fixed) +                 Outline.(path.path, path.back) +                 state.State.rendering + +             )) in +    let content = El.prop Elements.Prop.outerHTML svg in +    Elements.Transfert.send +      ~mime_type:(Jstr.v "image/svg+xml") +      ~filename:(Jstr.v "out.svg") +      content); +  state diff --git a/script.it/script_event/mouse_down.ml b/script.it/script_event/mouse_down.ml index 04ea2fd..98e866a 100755 --- a/script.it/script_event/mouse_down.ml +++ b/script.it/script_event/mouse_down.ml @@ -4,7 +4,7 @@ module Selection = Script_state.Selection  type t = { position : float * float           ; timer  : Elements.Timer.t } -let apply { position; timer } state = +let update { position; timer } state =    match state.State.mode with    | Out -> diff --git a/script.it/script_event/property.ml b/script.it/script_event/property.ml new file mode 100755 index 0000000..e637ab7 --- /dev/null +++ b/script.it/script_event/property.ml @@ -0,0 +1,52 @@ +module State = Script_state.State +module Selection = Script_state.Selection + +let update_property worker state value f = function +  | None -> state +  | Some (Selection.Path outline) -> +    (* Change width for the whole path *) +    let outline = { outline with +                    Outline.path = Path.Fixed.map outline.Outline.path (fun p -> +                        f p value) +                  } in +    State.post worker (`Back outline); +    state +  | Some (Point (outline, point)) -> +    let path = Path.Fixed.map +        outline.path +        (fun pt -> +           match Path.Point.id pt = Path.Point.id point with +           | false -> pt +           | true -> f pt value) +    in +    let outline = {outline with path} in +    State.post worker (`Back outline); +    state + +type t = { prop : [`Angle | `Width ] +         ; value : float +         ; worker : Brr_webworkers.Worker.t +         } + +let update { prop; value ; worker } state = +  match prop with +  | `Angle -> +    let angle = value in +    begin match state.State.mode with + +      | Selection t -> +        let state = { state with angle } in +        Selection.find_selection t state.paths +        |> update_property worker state angle Path.Point.set_angle +      | _ -> { state with angle } +    end +  | `Width -> +    let width = value in +    begin match state.State.mode with + +      | Selection t -> +        let state = { state with width } in +        Selection.find_selection t state.paths +        |> update_property worker state width Path.Point.set_width +      | _ -> { state with width } +    end diff --git a/script.it/script_event/tick.ml b/script.it/script_event/tick.ml new file mode 100755 index 0000000..c927a2a --- /dev/null +++ b/script.it/script_event/tick.ml @@ -0,0 +1,20 @@ +module State = Script_state.State + +type t = float * (float * float) + +(** Tick event + +    Tick only occurs when drawing a new path + +*) +let update (delay, point) state = +  match state.State.mode with +  | Edit -> +    (* Add the point in the list *) +    let current = State.insert_or_replace +        state +        point +        delay +        state.current in +    { state with current } +  | _ -> state | 
