path: root/script.it/state.ml

open StdLabels
open Brr

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

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

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

type worker_event =
  [ `Basic of Jv.t
  | `Complete of Path.Fixed.t
  ]

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 : Path.Fixed.t list
  ; current : Path.Path_Builder.t
  ; width : float
  ; angle : float
  ; rendering : Layer.Paths.printer
  }

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
    )

(** Update the path in the selection with the given function applied to
    every point *)
let update_path_selection id paths f =
  List.map paths
    ~f:(fun path ->
        let id' = Path.Fixed.id path in
        match id = id' with
        | false -> path
        | true -> Path.Fixed.map path f
      )

let update_point_selection state path_id point f =
  let paths = List.map state.paths
      ~f:(fun p ->
          match Path.Fixed.id p = path_id with
          | false -> p
          | true ->
            Path.Fixed.map
              p
              (fun p ->
                 if (Path.Point.id p = Path.Point.id point) then
                   f p
                 else
                   p
              )
        ) in
  { state with paths }


(** 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 }

(** Handle the deletion event.

    Deletion only apply to a selection
*)
let delete state worker =
  match state.mode with
  | Selection (Path id) ->
    let paths = List.filter
        state.paths
        ~f:(fun p ->
            Path.Fixed.id p != id
          ) in
    { state with paths ; mode = Out}

  | Selection (Point (id, point)) ->
    List.iter
      state.paths
      ~f:(fun p ->
          let id' = Path.Fixed.id p in
          match id' = id with
          | false -> ()
          | true ->
            (* Send the job to the worker *)
            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 angle angle state =
  match state.mode with
  (* Change angle for the whole path *)
  | Selection (Path s) ->
    let state = { state with angle } in
    let paths = update_path_selection s state.paths (fun p -> Path.Point.set_angle p angle) in
    {state with paths }
  (* Change angle localy *)
  | Selection (Point (s, point)) ->
    let state = update_point_selection state s point
        (fun p -> Path.Point.set_angle p angle) in
    { state with angle }
  | _ ->
    { state with angle}

let width width state =
  match state.mode with
  | Selection (Path s) ->
    let state = { state with width } in
    let paths = update_path_selection s state.paths (fun p -> Path.Point.set_width p width) in
    {state with paths }
  | Selection (Point (s, point)) ->
    let state = update_point_selection state s point
        (fun p -> Path.Point.set_width p width) in
    { state with width }
  | _ ->
    { state with width }

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 *)
    | `Click ((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 }

    (* Click anywhere while in selection mode, we either select another path,
       or switch to Out mode*)
    | `Click position, (Selection (Path id))
    | `Click position, (Selection (Point (id, _))) ->
      begin match Selection.get_from_paths position state.paths with
        | _, None ->
          { state with
            mode = Out }
        | dist, Some selection ->
          let _, path, _, _ = selection in
          if Path.Fixed.id path != id then
            select_segment position selection state dist
          else
            (* On the same segment, check for a point *)
            let selection = Selection.select_point path (Gg.V2.of_tuple position) in
            match selection with
            | Path _ ->
              { state with mode = Selection selection }
            | 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
              }
      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 paths =
            let last = Path.Fixed.to_fixed
                (module Path.Path_Builder)
                current
            in

            let () = post worker (`Complete last) in
            last::state.paths
          and current = Path.Path_Builder.empty in

          { state with
            mode = Out
          ; paths; current }

        (* 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 mouse_coord, Selection (Point (id, point)) ->
      let mouse_v2 = Gg.V2.of_tuple mouse_coord in
      if Elements.Timer.delay timer < 0.3 then
        state
      else
        let point' = Path.Point.copy point mouse_v2  in
        List.iter state.paths
          ~f:(fun path ->
              let id' = Path.Fixed.id path in
              match id = id' with
              | false -> ()
              | true ->
                Option.iter
                  (fun p -> post worker (`Complete p))
                  (Path.Fixed.replace_point path point')
            );

        { state with mode = Selection (Path id) }
    | `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)
                     path
                     state.rendering

                 )) in
        let content = El.prop Elements.Prop.outerHTML svg in

        let btoa = Jv.get Jv.global "btoa" in
        let base64data = Jv.apply btoa
            [| Jv.of_jstr content |] in

        (* Create the link to download the the element, and simulate a click on it *)
        let a = El.a
            ~at:At.[
                href Jstr.( (v "data:image/svg+xml;base64,") + (Jv.Id.of_jv base64data))
              ; v (Jstr.v "download") (Jstr.v "out.svg")
              ]
            [] in
        El.click a
      );
      state

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


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


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

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


    (* Some non possible cases *)
    | `Out _, Out
    | `Out _, Selection _
    | `Click _, Edit
      -> state

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