blog_scripts.git - Applications du blog

diff options

Diffstat (limited to 'editor/dune')

0 files changed, 0 insertions, 0 deletions

href='#n72'>72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442

open StdLabels
open Note
open Brr
open Brr_note


(** Create the element in the page, and the event handler *)
let canva
  : Brr.El.t -> [> State.canva_events] Note.E.t * (float * float) option Note.S.t * Brr_canvas.Canvas.t
  = fun element ->

    (* Adapt the width to the window *)
    El.set_inline_style
      El.Style.width
      (Jstr.v "100%")
      element;

    (* See https://stackoverflow.com/a/14855870/13882826 *)
    El.set_inline_style
      El.Style.height
      (Jstr.v "100%")
      element;

    El.set_prop
      El.Prop.width
      (El.prop Elements.Prop.offsetWidth element)
      element;

    El.set_prop
      El.Prop.height
      (El.prop Elements.Prop.offsetHeight 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

    (* Mouse events *)
    let mouse = Brr_note_kit.Mouse.on_el
        ~normalize:false
        (fun x y -> (x, y)) element in

    let click =
      Brr_note_kit.Mouse.left_down mouse
      |> E.map (fun c -> `Click c) in

    let up =
      Brr_note_kit.Mouse.left_up mouse
      |> E.map (fun c -> `Out c) in

    let position = Brr_note_kit.Mouse.pos mouse in

    let pos = S.l2
        (fun b pos ->
           if b then
             Some pos
           else
             None )
        (Brr_note_kit.Mouse.left mouse)
        position in

    E.select [click; up], pos, c

let click_event el =
  Evr.on_el
    Ev.click
    Evr.unit
    el

type 'a param_events =
  { width : float S.t
  ; angle : float S.t
  ; export : unit E.t
  ; delete : unit E.t
  ; rendering : ([> State.render_event] as 'a) E.t
  }

type slider =
  { input : El.t
  ; legend : El.t }

let set_sidebar
  : El.t -> State.state -> _ param_events * slider * slider
  = fun element state ->

    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 export_event = click_event export in

    let nib_size, nib_size_event  =
      Elements.Input.slider
        ~at:At.[ type' (Jstr.v "range")
               ; v (Jstr.v "min") (Jstr.v "1")
               ; v (Jstr.v "max") (Jstr.v "50")
               ; At.value (Jstr.of_float state.width)
               ] in

    let width = El.div [] in
    let width_slider =
      { input = nib_size
      ; legend = width } in

    let input_angle, angle_event =
      Elements.Input.slider
        ~at:At.[ type' (Jstr.v "range")
               ; v (Jstr.v "min") (Jstr.v "0")
               ; v (Jstr.v "max") (Jstr.v "90")
               ; At.value (Jstr.of_float state.angle)
               ] in

    let angle = El.div [] in
    let angle_slider =
      { input = input_angle
      ; legend = angle } in

    let render =
      El.select
        [ El.option ~at:At.[value (Jstr.v "1")]
            [ txt' "Fill"]
        ; El.option ~at:At.[value (Jstr.v "3")]
            [ txt' "Ductus"]
        ] in

    let rendering' = El.div
        [ txt' "Rendering : "
        ; render ] in

    let render_event =
      Evr.on_el
        Ev.change (fun _ ->
            let raw_value = El.prop El.Prop.value render
                            |> Jstr.to_int in
            match raw_value with
            | Some 1 -> `Rendering `Fill
            | Some 2 -> `Rendering `Line
            | Some 3 -> `Rendering `Ductus
            | _ -> `Rendering `Fill
          )  rendering' in

    let () =
      El.append_children element
        [ hr ()
        ; delete
        ; export

        ; rendering'

        ; hr ()

        ; width
        ; nib_size

        ; angle
        ; input_angle

        ]
    in
    ( { delete = delete_event
      ; angle = angle_event
      ; width = nib_size_event
      ; export = export_event
      ; rendering = render_event }
    , angle_slider
    , width_slider
    )

let backgroundColor = Blog.Nord.nord0
let white = Jstr.v "#eceff4"
let green = Jstr.v "#a3be8c"

(** Redraw the canva on update *)
let on_change canva mouse_position timer state =
  let module Cd2d = Brr_canvas.C2d in

  let w, h = Brr_canvas.Canvas.(float_of_int @@ w canva, float_of_int @@ h canva) in

  let context = Cd2d.create canva in

  Cd2d.set_fill_style context (Cd2d.color backgroundColor);
  Cd2d.fill_rect context
    ~x:0.0
    ~y:0.0
    ~w
    ~h;
  Cd2d.set_stroke_style context (Cd2d.color white);
  Cd2d.set_fill_style context (Cd2d.color white);

  (* If we are in edit mode, we add a point under the cursor.

     Otherwise, we would only display the previous registered point, which can
     be far away in the past, and would give to the user a sensation of lag.

  *)
  let pos = S.rough_value mouse_position in
  let current =
    begin match state.State.mode, pos with
      | Edit, Some point ->
        let stamp = Elements.Timer.delay timer in
        State.insert_or_replace state point stamp state.current
      | _ ->
        state.current
    end
  in

  Layer.Paths.to_canva (module Path.Path_Builder) current context state.rendering;

  List.iter state.paths
    ~f:(fun path ->

        let () = match state.mode with
          | Selection (Path id)
          | Selection (Point (id, _)) ->
            begin match id = (Path.Fixed.id path) with
              | true ->
                (* If the element is the selected one, change the color *)
                Cd2d.set_fill_style context (Cd2d.color Blog.Nord.nord8);
                Cd2d.set_stroke_style context (Cd2d.color Blog.Nord.nord8)
              | false  ->
                Cd2d.set_stroke_style context (Cd2d.color white);
                Cd2d.set_fill_style context (Cd2d.color white);
            end
          | _ -> ()
        in

        Layer.Paths.to_canva (module Path.Fixed) path context state.rendering
      );

  let () = match state.mode with
    | Selection (Path id) ->
      Cd2d.set_stroke_style context (Cd2d.color white);
      List.iter
        state.paths
        ~f:(fun path ->
            if id = Path.Fixed.id path then
              Layer.Paths.to_canva (module Path.Fixed) path context `Line
          )
    | Selection (Point (id, point)) ->
      (* As before, mark the selected path *)
      Cd2d.set_stroke_style context (Cd2d.color white);

      List.iter
        state.paths
        ~f:(fun path ->
            if id = Path.Fixed.id path then
              let path = begin match pos with
                | Some pos ->

                  let pos_v2 = Gg.V2.of_tuple pos in
                  if Elements.Timer.delay timer < 0.3 then
                    path
                  else
                    let point' = Path.Point.copy point pos_v2 in
                    begin match Path.Fixed.replace_point path point' with
                      | None -> path
                      | Some p -> p
                    end
                | None -> path end in
              Layer.Paths.to_canva (module Path.Fixed) path context `Line
          );

      (* Now draw the selected point *)
      let x, y = Gg.V2.to_tuple @@ Path.Point.get_coord point in
      Cd2d.stroke_rect
        ~x:(x -. 5.)
        ~y:(y -. 5.)
        ~w:10.
        ~h:10.
        context;
    | _ -> ()
  in


  ()

let spawn_worker () =
  try
    Ok (Brr_webworkers.Worker.create (Jstr.v "worker.js"))
  with
  | Jv.Error e -> Error e

let page_main id =

  let timer, tick = Elements.Timer.create () in

  let parameters, angle_element, width_slider =
    begin match Blog.Sidebar.get () with
      | None ->
        Jv.throw (Jstr.v "No sidebar")
      | Some el ->

        Blog.Sidebar.clean el;
        set_sidebar el State.init
    end in


  let delete_event = E.map (fun () -> `Delete) parameters.delete
  and export_event = E.map (fun () -> `Export) parameters.export
  and angle_event = S.changes parameters.angle
                    |> E.map (fun value -> `Angle value)
  and width_event = S.changes parameters.width
                    |> E.map (fun value -> `Width value)
  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 ->

      match spawn_worker () with
      | Error e -> El.set_children (Jv.Id.of_jv id)
                     [ El.p El.[txt (Jv.Error.message e)]]
      | Ok worker ->

        let worker_event, worker_send = E.create () in
        let my_host = Uri.host @@ Window.location @@ G.window in
        if (Hashtbl.hash my_host) = Blog.Hash_host.expected_host then (
          let target = Brr_webworkers.Worker.as_target worker in
          Ev.listen Brr_io.Message.Ev.message
            (fun t ->
               Ev.as_type t
               |> Brr_io.Message.Ev.data
               |> worker_send)
            target);

        (* 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 =
          S.sample_filter mouse_position
            ~on:tick
            (fun pos f -> Option.map (fun p -> `Point (f, p)) pos ) in

        (* The first evaluation is the state. Which is the result of all the
           successives events to the initial state *)
        let state =
          E.select
            [ worker_event
            ; canva_events
            ; tick_event
            ; angle_event
            ; width_event
            ; delete_event
            ; export_event
            ; parameters.rendering
            ]
          |> E.map (State.do_action worker timer)
          |> Note.S.accum State.init in

        (* The seconde evaluation is the canva refresh, which only occurs when
           the mouse is updated, or on delete events  *)
        let _ =
          E.select
            [ E.map (fun _ -> ()) (S.changes mouse_position)
            ; E.map (fun _ -> ()) (S.changes parameters.angle)
            ; E.map (fun _ -> ()) (S.changes parameters.width)
            ; E.map (fun _ -> ()) parameters.rendering
            ; E.map (fun _ -> ()) worker_event
            ; parameters.delete ]
          |> fun ev -> E.log ev (fun _ -> on_change canva mouse_position timer (S.value state) )
                       |> Option.iter Logr.hold in



        (* Ajust the angle slide according to the state *)
        let angle_signal = S.map (fun s -> Jstr.of_float s.State.angle) state in
        let _ =
          Elr.def_prop
            Elements.Prop.value
            angle_signal
            angle_element.input

        and _ = Elr.def_children
            angle_element.legend
            (S.map
               (fun v ->
                  [ El.txt' "Angle : "
                  ; El.txt v
                  ; El.txt' "°" ] )
               angle_signal) in

        let width_signal = S.map (fun s -> Jstr.of_float s.State.width) state in
        let _ =
          Elr.def_prop
            Elements.Prop.value
            width_signal
            width_slider.input

        and _ = Elr.def_children
            width_slider.legend
            (S.map (fun v ->
                 [ El.txt' "Width : "
                 ; El.txt v ]
               )
                width_signal
            ) in

        (* Draw the canva for first time *)
        on_change canva mouse_position timer State.init;

        (* Hold the state *)
        let _ = Logr.hold (S.log state (fun _ -> ())) in
        ()

  end

let () =

  let open Jv in
  let drawer  = obj
      [| "run", (repr page_main)
      |] in

  set global "drawer" drawer


context:
space:
mode: