-add-text/TTF fonts added to file

This commit is contained in:
John Whitington 2023-07-18 15:03:15 +01:00
parent 291c5391c3
commit 89908a5816
1 changed files with 26 additions and 15 deletions

View File

@ -50,7 +50,7 @@ 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 fontname longest_w x y rotate hoffset voffset outline linewidth unique_fontname unique_extgstatename colour fontsize text = let ops fontpack fontname longest_w x y rotate hoffset voffset outline linewidth unique_fontname unique_extgstatename colour fontsize text =
[Pdfops.Op_q; [Pdfops.Op_q;
Pdfops.Op_BMC "/CPDFSTAMP"; Pdfops.Op_BMC "/CPDFSTAMP";
Pdfops.Op_cm Pdfops.Op_cm
@ -302,8 +302,7 @@ let addtext
let ops, urls, x, y, hoffset, voffset, text, joffset = let ops, urls, x, y, hoffset, voffset, text, joffset =
let text = process_text time text (replace_pairs pdf endpage extract_text_font_size filename bates batespad num page) in let text = process_text time text (replace_pairs pdf endpage extract_text_font_size filename bates batespad num page) in
let text, urls = get_urls_line text in let text, urls = get_urls_line text in
(* FIXME Here we need to get (font, fontnum, charcode) triples if we have a fontpack, or fake if not. *) let lines = map (fun text -> if raw || fontpack <> None then text else charcodes_of_utf8 (Pdftext.read_font pdf fontpdfobj) text) lines in
let lines = map (fun text -> if raw then text else charcodes_of_utf8 (Pdftext.read_font pdf fontpdfobj) text) lines in
let expanded_lines = expand_lines text time pdf endpage extract_text_font_size filename bates batespad num page lines in let expanded_lines = expand_lines text time pdf endpage extract_text_font_size filename bates batespad num page lines in
let textwidth = calc_textwidth text let textwidth = calc_textwidth text
and allwidths = map calc_textwidth expanded_lines in and allwidths = map calc_textwidth expanded_lines in
@ -323,30 +322,42 @@ let addtext
then -. (cos ((pi /. 2.) -. rotate) *. voffset), sin ((pi /. 2.) -. rotate) *. voffset then -. (cos ((pi /. 2.) -. rotate) *. voffset), sin ((pi /. 2.) -. rotate) *. voffset
else hoffset, voffset else hoffset, voffset
in in
(* FIXME Here we need to pass the fontpack if available to the ops function. Can the ops function do all it needs just with this? *)
match font with match font with
| Some f -> | Some f ->
ops fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth ops fontpack 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 fontname longest_w (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth ops fontpack 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
let newresources = let newresources =
match font with match fontpack with
| Some (Pdftext.StandardFont _ as font) -> | Some fontpack ->
let newfontdict = let newfontdict =
Pdf.add_dict_entry fontdict unique_fontname (Pdf.Indirect (Pdftext.write_font pdf font)) let fd = ref fontdict in
iter
(fun i ->
(* FIXME make properly unique *)
fd := Pdf.add_dict_entry !fd ("/F" ^ fontname ^ string_of_int i) (Pdf.Indirect i))
fontpackpdfobjs;
!fd
in in
Pdf.add_dict_entry resources' "/Font" newfontdict Pdf.add_dict_entry resources' "/Font" newfontdict
| Some f -> | None ->
let newfontdict = match font with
Pdf.add_dict_entry fontdict unique_fontname fontpdfobj | Some (Pdftext.StandardFont _ as font) ->
in let newfontdict =
Pdf.add_dict_entry resources' "/Font" newfontdict Pdf.add_dict_entry fontdict unique_fontname (Pdf.Indirect (Pdftext.write_font pdf font))
| None -> page.Pdfpage.resources in
Pdf.add_dict_entry resources' "/Font" newfontdict
| Some f ->
let newfontdict =
Pdf.add_dict_entry fontdict unique_fontname fontpdfobj
in
Pdf.add_dict_entry resources' "/Font" newfontdict
| None -> page.Pdfpage.resources
in in
(* Build annotations from URL data (get_urls and some sense of metrics) *) (* Build annotations from URL data (get_urls and some sense of metrics) *)
let annot (minx, miny, maxx, maxy) url = let annot (minx, miny, maxx, maxy) url =