summaryrefslogtreecommitdiff
path: root/script.it/worker.ml
blob: 31508696d6890a85de3b0575e2a644e572529292 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
open StdLabels
open Js_of_ocaml

type message = [
  | `Complete of (int * (Path.Fixed.path array))
]

exception Empty_Element

let get_point
  : Path.Fixed.path -> Gg.v2
  = function
    | Empty -> raise Empty_Element
    | Line (_, p1) -> Path.Point.get_coord p1
    | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p1

let first_point
  : Path.Fixed.path -> Gg.v2
  = function
    | Empty -> raise Empty_Element
    | Line (p0, _) -> Path.Point.get_coord p0
    | Curve bezier -> Path.Point.get_coord bezier.Path.Fixed.p0

let assoc_point
  : Shapes.Bezier.t -> Path.Fixed.path -> Path.Fixed.path
  = fun bezier -> function
    | Empty -> raise Empty_Element
    | Line (p0, p1)
    | Curve {p0; p1; _} ->
      let p0' = Path.Point.copy p0 bezier.Shapes.Bezier.p0
      and p1' = Path.Point.copy p1 bezier.Shapes.Bezier.p1 in
      Curve
        { Path.Fixed.p0 = p0'
        ; Path.Fixed.p1 = p1'
        ; Path.Fixed.ctrl0 = bezier.Shapes.Bezier.ctrl0
        ; Path.Fixed.ctrl1 = bezier.Shapes.Bezier.ctrl1
        }

let execute (command: [> message]) =
  match command with
  | `Complete (id, paths) ->
    (* Convert all the points in list *)
    let points = List.init
        ~len:((Array.length paths) )
        ~f:(fun i -> get_point (Array.get paths i)) in
    let p0 = first_point (Array.get paths 0)in

    let points = p0::points in

    (* We process the whole curve in a single block *)
    begin match Shapes.Bspline.to_bezier points with
      | Error `InvalidPath -> ()
      | Ok beziers ->

        (* Now for each point, reassociate the same point information,
           We should have as many points as before *)
        let rebuilded = Array.map2 beziers paths ~f:assoc_point in
        Worker.post_message (`Complete (id, rebuilded))
    end
  | any ->
    Worker.post_message (`Other any)

let () =
  Worker.set_onmessage execute