From 99bfd4b59879420b162bb4051359afd44f112c2d Mon Sep 17 00:00:00 2001
From: John Whitington <john@coherentgraphics.co.uk>
Date: Thu, 20 Oct 2022 14:28:14 +0100
Subject: [PATCH] mor

---
 cpdftexttopdf.ml | 43 ++++++++++++++++++++++++++++---------------
 cpdftruetype.ml  |  2 +-
 2 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/cpdftexttopdf.ml b/cpdftexttopdf.ml
index fe6dec8..49de789 100644
--- a/cpdftexttopdf.ml
+++ b/cpdftexttopdf.ml
@@ -5,23 +5,38 @@ let used_characters t =
   let codepoints = Pdftext.codepoints_of_utf8 t in
     setify codepoints
 
-let rec of_utf8_with_newlines fontpack t =
+let rec of_utf8_with_newlines fontpack fontsize t =
   let items = ref [] in
-  let buf = ref [] in
+  let currfont = ref 0 in
   let codepoints = Pdftext.codepoints_of_utf8 t in
-  let charcodes_of_codepoints cs =
-    option_map
+  let currtext = ref [] in
+  let process_codepoints cs =
+    iter
       (fun u ->
          match Cpdfembed.get_char fontpack u with
-         | Some (c, _, _) -> Some (char_of_int c)
-         | None -> Printf.printf "No glyph for unicode U+%04X in this font\n" u; None)
-      cs
+         | Some (c, n, f) ->
+             Printf.printf "Charcode %i, font number %i\n" c n;
+             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
+  let buf = ref [] in
     List.iter
       (function
        | 10 (*'\n'*) ->
            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;
              buf := []
        | 13 (*'\r'*) -> ()
@@ -30,7 +45,7 @@ let rec of_utf8_with_newlines fontpack t =
       codepoints;
     (* Do last one *)
     let c = rev !buf in
-      if c <> [] then items := Text (charcodes_of_codepoints c)::!items;
+      if c <> [] then process_codepoints c;
       rev !items
 
 let typeset ~papersize ~font ~fontsize text =
@@ -44,15 +59,13 @@ let typeset ~papersize ~font ~fontsize text =
          (hd (fst embedded), embedded)
     | Cpdfembed.ExistingNamedFont -> raise (Pdf.PDFError "Can't use existing named font for text-to-PDF")
   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 =
     Pdfunits.convert
       72. (Pdfpaper.unit papersize) (Pdfunits.PdfPoint) (Pdfpaper.width papersize) /. 15.
   in
-  let pages =
-    Cpdftype.typeset
-      margin margin margin margin papersize pdf
-      ([Cpdftype.Font (font, fontsize); Cpdftype.BeginDocument] @ instrs)
-  in
+  let instrs = [Cpdftype.Font (font, fontsize); Cpdftype.BeginDocument] @ instrs in
+  Printf.printf "to_string: %s\n" (Cpdftype.to_string instrs);
+  let pages = Cpdftype.typeset margin margin margin margin papersize pdf instrs in
     let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
       Pdfpage.add_root pageroot [] pdf
diff --git a/cpdftruetype.ml b/cpdftruetype.ml
index 35af3de..eecc725 100644
--- a/cpdftruetype.ml
+++ b/cpdftruetype.ml
@@ -2,7 +2,7 @@
 open Pdfutil
 open Pdfio
 
-let fontpack_experiment = false
+let fontpack_experiment = true
 
 type t =
   {flags : int;