path: root/script.it/state.ml

open StdLabels
open Brr

let backgroundColor = Blog.Nord.nord0

type mode =
  | Edit
  | Selection of int
  | 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 (int * (Path.Fixed.path array))
  ]

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 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
    )

let threshold = 20.

let check_selection
  : (float * float) -> Path.Fixed.t list -> (Gg.v2 * Path.Fixed.t * Path.Point.t * Path.Point.t) option
  = fun position paths ->
    let point = Gg.V2.of_tuple position in
    (* If the user click on a curve, select it *)
    let _, res = List.fold_left paths
        ~init:(threshold, None)
        ~f:(fun (dist, selection) path ->
            match Path.Fixed.distance point path with
            | Some (point', p, p0, p1) when p < dist ->
              dist, Some (point', path, p0, p1)
            | _ -> dist, selection
          ) in
    res

(** Update the path in the selection with the given function applied to
    every point *)
let update_selection id state f =

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


let select_segment point (p, selected, p0, p1) state =
  let angle0 = Path.Point.get_angle p0
  and angle1 = Path.Point.get_angle p1 in
  let width0 = Path.Point.get_width p0
  and width1 = Path.Point.get_width p1 in

  let dist = Gg.V2.(norm ( p - (Gg.V2.of_tuple point))) in

  let angle = angle0 +. dist *. ( angle1 -. angle0 ) in
  let width = width0 +. dist *. ( width1 -. width0 ) in

  let id = Path.Fixed.id selected in
  { state with
    mode = (Selection id)
  ; angle
  ; 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), Edit ->
      (* Add the point in the list *)
      let current = insert_or_replace
          state
          point
          delay
          state.current in
      { state with current }

    (* 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 check_selection 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 _) ->
      begin match check_selection position state.paths with
        | None ->
          { state with
            mode = Out }
        | Some selection ->
          select_segment position selection state
      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 id = Path.Fixed.id last
            and path = Path.Fixed.path last in
            let () = Brr_webworkers.Worker.post worker (`Complete (id, path)) 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 check_selection point state.paths with
            | None ->
              { state with
                mode = Out
              ; current
              }
            | Some selection ->
              select_segment point selection { state with current }

          end
      end
    | `Delete, Selection id ->
      let paths = List.filter state.paths ~f:(fun p -> Path.Fixed.id p != id) in
      { state with paths ; mode = Out}


    | `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:backgroundColor
                     (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

    (* Change the select curve with the appropriate setting *)
    | `Angle angle, Selection s ->
      let state = { state with angle } in
      update_selection s state (fun p -> Path.Point.set_angle p angle)
    | `Width width, Selection s ->
      let state = { state with width } in
      update_selection s state (fun p -> Path.Point.set_width p width)

    | `Angle angle, _ ->
      { state with angle}
    | `Width width, _ ->
      { state with width}

    | `Delete, Out
      -> state

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


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

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


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

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