Chris00 / ocaml-cairo

Binding to Cairo, a 2D Vector Graphics Library.
GNU Lesser General Public License v3.0
54 stars 8 forks source link

`Path.fold` not folding over contents of path (when `to_array` in non-empty) #27

Closed geoffder closed 2 years ago

geoffder commented 2 years ago
type glyph_outline =
  { outer : (float * float) list
  ; inner : (float * float) list list
  }

let f (paths, ps, last_p) = function
    | MOVE_TO (x, y) -> paths, ps, (x, y)
    | LINE_TO (x, y) -> paths, last_p :: ps, (x, y)
    | CURVE_TO (x1, y1, x2, y2, x3, y3) ->
      let bez = Bezier2d.make' [| last_p; x1, y1; x2, y2; x3, y3 |] in
      paths, Bezier2d.curve ~rev:true ~endpoint:false ~init:ps bez, (x3, y3)
    | CLOSE_PATH -> (last_p :: ps) :: paths, [], last_p

let path_to_outlines path =
  let ps, _, _ = Path.fold path f ([], [], (0., 0.)) in
    List.rev_map (List.map @@ fun (x, y) -> x, -.y) ps

let pathdata_to_outlines data =
  let ps, _, _ = Array.fold_left f ([], [], (0., 0.)) data in
    List.rev_map (List.map @@ fun (x, y) -> x, -.y) ps

let glyph_outline ?(center = false) ?weight ~font char =
  let s = String.of_seq (Seq.return char)
  and cr = create (Image.create Image.A1 ~w:1 ~h:1) in
  select_font_face ?weight cr font;
  let te = text_extents cr s in
  if center
  then (
    let x = 0.5 -. (te.width /. 2.) -. te.x_bearing
    and y = 0.5 -. (te.height /. 2.) -. te.y_bearing in
    move_to cr x y );
  Path.text cr s;
  match pathdata_to_outlines Path.(to_array @@ copy cr) with
  (* match path_to_outlines (Path.copy cr) with *)
  | [] -> { outer = []; inner = [] }
  | outer :: inner -> { outer; inner }

The above example works as expected using the intermediate array, but using Path.fold directly (as in the commented match line) leads to an empty result.

I'm on ocaml v4.13.1, using cairo2 v0.6.2.

Thanks for providing these bindings! Very quick and simple to get started for my use case.

Chris00 commented 2 years ago

Thanks for this report. There was indeed a small typo in the function Path.fold which was causing this bug.