This commit is contained in:
John Whitington 2022-10-20 14:28:14 +01:00
parent cc04a3e2c3
commit 99bfd4b598
2 changed files with 29 additions and 16 deletions

View File

@ -5,23 +5,38 @@ let used_characters t =
let codepoints = Pdftext.codepoints_of_utf8 t in let codepoints = Pdftext.codepoints_of_utf8 t in
setify codepoints setify codepoints
let rec of_utf8_with_newlines fontpack t = let rec of_utf8_with_newlines fontpack fontsize t =
let items = ref [] in let items = ref [] in
let buf = ref [] in let currfont = ref 0 in
let codepoints = Pdftext.codepoints_of_utf8 t in let codepoints = Pdftext.codepoints_of_utf8 t in
let charcodes_of_codepoints cs = let currtext = ref [] in
option_map let process_codepoints cs =
iter
(fun u -> (fun u ->
match Cpdfembed.get_char fontpack u with match Cpdfembed.get_char fontpack u with
| Some (c, _, _) -> Some (char_of_int c) | Some (c, n, f) ->
| None -> Printf.printf "No glyph for unicode U+%04X in this font\n" u; None) Printf.printf "Charcode %i, font number %i\n" c n;
cs begin if n <> !currfont then
begin
if !currtext <> [] then items := Cpdftype.Text (rev !currtext)::!items;
currtext := [];
currfont := n;
items := Cpdftype.Font (f, fontsize)::!items;
currtext := char_of_int c::!currtext;
end
else
currtext := char_of_int c::!currtext
end
| None -> Printf.printf "No glyph for unicode U+%04X in this font\n" u)
cs;
items := Cpdftype.Text (rev !currtext)::!items
in in
let buf = ref [] in
List.iter List.iter
(function (function
| 10 (*'\n'*) -> | 10 (*'\n'*) ->
let c = rev !buf in let c = rev !buf in
if c <> [] then items := Cpdftype.Text (charcodes_of_codepoints c)::!items; if c <> [] then process_codepoints c;
items := Cpdftype.NewLine::!items; items := Cpdftype.NewLine::!items;
buf := [] buf := []
| 13 (*'\r'*) -> () | 13 (*'\r'*) -> ()
@ -30,7 +45,7 @@ let rec of_utf8_with_newlines fontpack t =
codepoints; codepoints;
(* Do last one *) (* Do last one *)
let c = rev !buf in let c = rev !buf in
if c <> [] then items := Text (charcodes_of_codepoints c)::!items; if c <> [] then process_codepoints c;
rev !items rev !items
let typeset ~papersize ~font ~fontsize text = let typeset ~papersize ~font ~fontsize text =
@ -44,15 +59,13 @@ let typeset ~papersize ~font ~fontsize text =
(hd (fst embedded), embedded) (hd (fst embedded), embedded)
| Cpdfembed.ExistingNamedFont -> raise (Pdf.PDFError "Can't use existing named font for text-to-PDF") | Cpdfembed.ExistingNamedFont -> raise (Pdf.PDFError "Can't use existing named font for text-to-PDF")
in in
let instrs = of_utf8_with_newlines fontpack (Pdfio.string_of_bytes text) in let instrs = of_utf8_with_newlines fontpack fontsize (Pdfio.string_of_bytes text) in
let margin = let margin =
Pdfunits.convert Pdfunits.convert
72. (Pdfpaper.unit papersize) (Pdfunits.PdfPoint) (Pdfpaper.width papersize) /. 15. 72. (Pdfpaper.unit papersize) (Pdfunits.PdfPoint) (Pdfpaper.width papersize) /. 15.
in in
let pages = let instrs = [Cpdftype.Font (font, fontsize); Cpdftype.BeginDocument] @ instrs in
Cpdftype.typeset Printf.printf "to_string: %s\n" (Cpdftype.to_string instrs);
margin margin margin margin papersize pdf let pages = Cpdftype.typeset margin margin margin margin papersize pdf instrs in
([Cpdftype.Font (font, fontsize); Cpdftype.BeginDocument] @ instrs)
in
let pdf, pageroot = Pdfpage.add_pagetree pages pdf in let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
Pdfpage.add_root pageroot [] pdf Pdfpage.add_root pageroot [] pdf

View File

@ -2,7 +2,7 @@
open Pdfutil open Pdfutil
open Pdfio open Pdfio
let fontpack_experiment = false let fontpack_experiment = true
type t = type t =
{flags : int; {flags : int;