path: root/script.it/state.ml

open StdLabels
open Brr

type mode =
  | Edit
  | Selection of Selection.t
  | Out

(** Events *)
type canva_events =
  [ `MouseDown of float * float
  | `Out of float * float
  ]

type button_events =
  [ `Delete
  | `Export
  ]
type render_event =
  [
    `Rendering of Layer.Paths.printer
  ]

type worker_event = Worker_messages.from_worker

type events =
  [ canva_events
  | button_events
  | render_event
  | worker_event
  | `Point of float * (float * float)
  | `Width of float
  | `Angle of float
  ]

(*
 The state cant hold functionnal values, and thus cannot be used to store
 elements like timer
 *)
type state =
  { mode : mode
  ; paths : Outline.t list
  ; current : Path.Path_Builder.t
  ; width : float
  ; angle : float
  ; rendering : Layer.Paths.printer
  ; mouse_down_position : Gg.v2
  }

let post
  : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit
  = Brr_webworkers.Worker.post

let insert_or_replace state ((x, y) as p) stamp path =
  let width = state.width
  and angle = state.angle in
  let point = Path.Point.create ~x ~y ~angle ~width ~stamp in
  match Path.Path_Builder.peek path with
  | None ->
    Path.Path_Builder.add_point
      point
      path
  | Some p1 ->
    let open Gg.V2 in

    let p1' = Path.Point.get_coord p1 in

    let dist = (norm (p1' - (of_tuple p))) in
    if dist < 5. then (
      path
    ) else (
      Path.Path_Builder.add_point
        point
        path
    )

(** Select the given segment, and modify angle and width accordingly *)
let select_segment _ (_, selected, p0, p1) state dist =

  let point' = Path.Point.mix dist (Path.Point.get_coord p0) p0 p1 in

  let angle = (Float.round @@ 10. *. Path.Point.get_angle point') /. 10.
  and width = (Float.round @@ 10. *. Path.Point.get_width point') /. 10. in

  let id = Selection.select_path selected in
  { state with
    mode = (Selection id)
  ; angle
  ; width }

(** Delete the selected element *)
let delete state worker =
  match state.mode with
  | Selection (Path id) ->
    let paths = List.filter
        state.paths
        ~f:(fun p ->
            p.Outline.id != id
          ) in
    { state with paths ; mode = Out}

  | Selection (Point (id, point)) ->
    List.iter
      state.paths
      ~f:(fun p ->
          let id' = p.Outline.id in
          match id' = id with
          | false -> ()
          | true -> post worker (`DeletePoint (point, p))
        );
    { state with mode = Selection (Path id) }
  | _ ->
    state

(** Tick event

    Tick only occurs when drawing a new path

*)
let tick (delay, point) state =
  match state.mode with
  | Edit ->
    (* Add the point in the list *)
    let current = insert_or_replace
        state
        point
        delay
        state.current in
    { state with current }
  | _ -> state

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
    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
    post worker (`Back outline);
    state

let width worker width state =
  match 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 }

let angle worker angle state =
  match 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 }


(** Short click on any element, just do nothing (each element is on MouseDown
    event) *)
let click state = function
  | _ -> state

(** Long click, move the selected element if any *)
let longClick mouse_coord state worker = function
  | Selection t ->
    let mouse_v2 = Gg.V2.of_tuple mouse_coord in
    begin match Selection.find_selection t state.paths with
      | None -> state
      | Some (Point (path, point)) ->
        let point' = Path.Point.copy point mouse_v2 in
        post worker (`TranslatePoint (point', path));
        (* Just replace the position of the selected point *)
        { state with mode = Selection (Point (path.id, point')) }
      | Some (Path path) ->
        let delta = Gg.V2.(mouse_v2 - state.mouse_down_position) in
        post worker (`TranslatePath (path, delta));
        state
    end
  (*  TODO Long click in out mode should translate the slate *)
  | _ -> state

let do_action
  : Brr_webworkers.Worker.t -> Elements.Timer.t -> events -> state -> state
  = fun worker timer event state ->
    match event, state.mode with
    | `Point (delay, point), _ ->
      tick (delay, point) state

    (* Click anywhere while in Out mode, we switch in edition *)
    | `MouseDown ((x, y) as p), Out ->
      Elements.Timer.start timer 0.3;

      let width = state.width
      and angle = state.angle in

      let stamp = 0. in
      let point =
        match Selection.get_from_paths p state.paths with
        | _, None ->
          (* Start a new path with the point clicked *)
          Path.Point.create ~x ~y ~angle ~width ~stamp
        | _, Some (p, _, _, _) ->
          (* If the point is close to an existing path, we use the closest
             point in the path instead *)
          let x, y = Gg.V2.to_tuple p in
          Path.Point.create ~x ~y ~angle ~width ~stamp
      in

      let current = Path.Path_Builder.add_point
          point
          state.current in
      { state with
        current
      ; mode = Edit
      ; mouse_down_position = Gg.V2.of_tuple (x, y)}

    (* Click anywhere while in selection mode, we either select another path,
       or switch to Out mode*)
    | `MouseDown position, (Selection (Path id))
    | `MouseDown position, (Selection (Point (id, _))) ->

      let get_any () =
        begin match Selection.get_from_paths position state.paths with
          | _, None ->
            { state with
              mode = Out
            ; mouse_down_position = Gg.V2.of_tuple position }
          | dist, Some selection ->
            let _, outline, _, _ = selection in
            if outline.Outline.id != id then (
              let mouse_down_position = Gg.V2.of_tuple position in
              select_segment position selection { state with mouse_down_position } dist
            ) else
              (* On the same segment, check for a point *)
              let selection = Selection.select_point outline (Gg.V2.of_tuple position) in
              match selection with
              | Path _ ->
                { state with
                  mode = Selection selection
                ; mouse_down_position = Gg.V2.of_tuple position }
              | Point (_, pt) ->
                (* In order to handle the point move, start the timer *)
                Elements.Timer.start timer 0.3;
                { state with
                  mode = Selection selection
                ; angle = Path.Point.get_angle pt
                ; width = Path.Point.get_width pt
                ; mouse_down_position = Gg.V2.of_tuple position }
        end
      in

      (* First, check for a point in the selected path. If any of them in
         found, check anything to select in all the elements *)
      begin match Outline.find state.paths id with
        | None -> get_any ()
        | Some outline ->
          begin match Selection.select_point outline (Gg.V2.of_tuple position) with
            | Path _ -> get_any ()
            | other ->
              Elements.Timer.start timer 0.3;
              {state with
               mode = Selection other
             ; mouse_down_position = Gg.V2.of_tuple position }
          end
      end

    | `Out point, Edit ->
      let stamp = Elements.Timer.delay timer in
      Elements.Timer.stop timer;
      begin match Path.Path_Builder.peek2 state.current with
        (* If there is at last two points selected, handle this as a curve
            creation. And we add the new point in the current path *)
        | Some _ ->

          let current = insert_or_replace state point stamp state.current in
          let path = Path.Fixed.to_fixed
              (module Path.Path_Builder)
              current in

          (* Create a copy from the path with all the interior points *)
          let back = Path.Fixed.map
              path
              (fun pt -> Path.Point.copy pt @@ Path.Point.get_coord' pt) in

          let last =
            Outline.{ path
                    ; back
                    ; id = Outline.get_id ()
                    }
          in

          (* Send to the worker for a full review *)
          let () = post worker (`Complete last) in

          let state =
            { state with
              mode = Out
            ; paths = last::state.paths
            ; current = Path.Path_Builder.empty } in
          state

        (* Else, check if there is a curve under the cursor, and remove it *)
        | None ->
          let current = Path.Path_Builder.empty in
          begin match Selection.get_from_paths point state.paths with
            | _, None ->
              { state with
                mode = Out
              ; current
              }
            | dist, Some selection ->
              select_segment point selection { state with current } dist

          end
      end

    | `Out _, mode when Elements.Timer.delay timer < 0.3 ->
      click state mode

    | `Out mouse_coord, mode ->
      longClick mouse_coord state worker mode

    | `Delete, _ ->
      delete state worker

    | `Export, _ ->
      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.paths
               ~f:(fun path ->

                   Layer.Paths.to_svg
                     ~color:Blog.Nord.nord0
                     (module Path.Fixed)
                     Outline.(path.path, path.back)
                     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

    | `Angle value , _ ->
      angle worker value state
    | `Width value, _ ->
      width worker value state


    | `Rendering rendering, _ ->
      { state with rendering}

    | `Other t, _ ->
      Console.(log [t]);
      state

    | `Complete newPath, _ ->
      let paths = List.map
          state.paths
          ~f:(fun line ->
              match Outline.(newPath.id = line.id) with
              | true -> newPath
              | false -> line) in
      { state with paths }


    (* Some non possible cases *)
    | `MouseDown _, Edit
      -> state

let init =
  { paths = []
  ; current = Path.Path_Builder.empty
  ; mode = Out
  ; angle = 30.
  ; width = 10.
  ; rendering = `Fill
  ; mouse_down_position = Gg.V2.ox
  }