First real -add-text/UTF8 working

This commit is contained in:
John Whitington 2023-07-18 15:51:43 +01:00
parent 89908a5816
commit 8252a61430
1 changed files with 32 additions and 22 deletions

View File

@ -50,25 +50,36 @@ let colour_op_stroke = function
| Grey g -> Pdfops.Op_G g | Grey g -> Pdfops.Op_G g
| CYMK (c, y, m, k) -> Pdfops.Op_K (c, y, m, k) | CYMK (c, y, m, k) -> Pdfops.Op_K (c, y, m, k)
let ops fontpack fontname longest_w x y rotate hoffset voffset outline linewidth unique_fontname unique_extgstatename colour fontsize text = let ops fontpack fontpackpdfobjs fontname longest_w x y rotate hoffset voffset outline linewidth unique_fontname unique_extgstatename colour fontsize text =
[Pdfops.Op_q; let textops =
Pdfops.Op_BMC "/CPDFSTAMP"; match fontpack with
Pdfops.Op_cm | Some fontpack ->
(Pdftransform.matrix_of_transform let codepoints = Pdftext.codepoints_of_utf8 text in
[Pdftransform.Translate (x -. hoffset, y -. voffset); let triples = option_map (Cpdfembed.get_char fontpack) codepoints in
Pdftransform.Rotate ((0., 0.), rotate)]); let collated = Cpdfembed.collate_runs triples in
Pdfops.Op_BT; flatten
] @ (map
(if outline then [Pdfops.Op_w linewidth; Pdfops.Op_Tr 1] else [Pdfops.Op_Tr 0]) @ (fun l ->
[colour_op colour; colour_op_stroke colour] let (_, fontnum, _) = hd l in
@ [Pdfops.Op_Tf ("/F" ^ fontname ^ string_of_int (List.nth fontpackpdfobjs fontnum), fontsize);
(match unique_extgstatename with None -> [] | Some n -> [Pdfops.Op_gs n]) Pdfops.Op_Tj (implode (map (fun (charcode, _, _) -> char_of_int charcode) l))]
@ )
[Pdfops.Op_Tf (unique_fontname, fontsize); collated)
Pdfops.Op_Tj text; | None ->
Pdfops.Op_ET; [Pdfops.Op_Tf (unique_fontname, fontsize); Pdfops.Op_Tj text]
Pdfops.Op_EMC; in
Pdfops.Op_Q] [Pdfops.Op_q;
Pdfops.Op_BMC "/CPDFSTAMP";
Pdfops.Op_cm
(Pdftransform.matrix_of_transform
[Pdftransform.Translate (x -. hoffset, y -. voffset);
Pdftransform.Rotate ((0., 0.), rotate)]);
Pdfops.Op_BT]
@ (if outline then [Pdfops.Op_w linewidth; Pdfops.Op_Tr 1] else [Pdfops.Op_Tr 0])
@ [colour_op colour; colour_op_stroke colour]
@ (match unique_extgstatename with None -> [] | Some n -> [Pdfops.Op_gs n])
@ textops
@ [Pdfops.Op_ET; Pdfops.Op_EMC; Pdfops.Op_Q]
type justification = LeftJustify | CentreJustify | RightJustify type justification = LeftJustify | CentreJustify | RightJustify
@ -324,11 +335,11 @@ let addtext
in in
match font with match font with
| Some f -> | Some f ->
ops fontpack fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth ops fontpack fontpackpdfobjs fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
unique_fontname unique_extgstatename colour fontsize text, unique_fontname unique_extgstatename colour fontsize text,
urls, x, y, hoffset, voffset, text, joffset urls, x, y, hoffset, voffset, text, joffset
| None -> | None ->
ops fontpack fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth ops fontpack fontpackpdfobjs fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
fontname None colour fontsize text, fontname None colour fontsize text,
urls, x, y, hoffset, voffset, text, joffset urls, x, y, hoffset, voffset, text, joffset
in in
@ -339,7 +350,6 @@ let addtext
let fd = ref fontdict in let fd = ref fontdict in
iter iter
(fun i -> (fun i ->
(* FIXME make properly unique *)
fd := Pdf.add_dict_entry !fd ("/F" ^ fontname ^ string_of_int i) (Pdf.Indirect i)) fd := Pdf.add_dict_entry !fd ("/F" ^ fontname ^ string_of_int i) (Pdf.Indirect i))
fontpackpdfobjs; fontpackpdfobjs;
!fd !fd