From 6f0b8e2f66a8ac1f98960816e8b62d3a73c7f26e Mon Sep 17 00:00:00 2001
From: John Whitington <john@coherentgraphics.co.uk>
Date: Sun, 21 Nov 2021 14:15:06 -0800
Subject: [PATCH] more

---
 cpdfcommand.ml | 42 +++++++++++++++++++++++++++++++++++++++---
 cpdftype.ml    | 10 ++++++----
 cpdftype.mli   |  2 ++
 3 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/cpdfcommand.ml b/cpdfcommand.ml
index 4903638..989caaf 100644
--- a/cpdfcommand.ml
+++ b/cpdfcommand.ml
@@ -2913,8 +2913,10 @@ let of_utf8 (f, fontsize) t =
   let pdf = Pdf.empty () in
   let fontdict = Pdftext.write_font pdf f in
   let extractor = Pdftext.charcode_extractor_of_font pdf (Pdf.Indirect fontdict) in
-  let charcodes = Pdftext.codepoints_of_utf8 t in
-  implode (map char_of_int (option_map extractor charcodes))
+       Pdftext.codepoints_of_utf8 t
+    |> option_map extractor
+    |> map char_of_int
+    |> implode
 
 let typeset text =
   let pdf = Pdf.empty () in
@@ -2928,6 +2930,38 @@ let typeset text =
     let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
       Pdfpage.add_root pageroot [] pdf
 
+let typeset_table_of_contents pdf =
+  let f = (Pdftext.StandardFont (Pdftext.Courier, Pdftext.WinAnsiEncoding), 10.) in
+  let firstpage = hd (Pdfpage.pages_of_pagetree pdf) in
+  let firstpage_papersize =
+    let width, height =
+      match Pdf.parse_rectangle firstpage.Pdfpage.mediabox with
+        xmin, ymin, xmax, ymax -> (xmax -. xmin, ymax -. ymin)
+    in
+      Pdfpaper.make Pdfunits.PdfPoint width height
+  in
+  let lines =
+    map
+      (fun mark ->
+         [Cpdftype.BeginDest mark.Pdfmarks.target;
+          Cpdftype.HGlue {Cpdftype.glen = float mark.Pdfmarks.level *. 20.; Cpdftype.gstretch = 0.};
+          Cpdftype.Text (of_utf8 f mark.Pdfmarks.text);
+          Cpdftype.EndDest;
+          Cpdftype.NewLine])
+      (Pdfmarks.read_bookmarks pdf)
+  in
+  print_string (Cpdftype.to_string (flatten lines));
+  let toc_pages =
+    Cpdftype.typeset 50. 50. 50. 50. firstpage_papersize pdf
+      ([Cpdftype.Font f] @ flatten lines)
+  in
+   let original_pages = Pdfpage.pages_of_pagetree pdf in
+    let changes =
+      let toc_pages_len = length toc_pages in
+        map (fun n -> (n, n + toc_pages_len)) (indx original_pages)
+    in
+      Pdfpage.change_pages ~changes true pdf (toc_pages @ original_pages)
+
 (* Main function *)
 let go () =
   match args.op with
@@ -3849,7 +3883,9 @@ let go () =
       let pdf = get_single_pdf args.op true in
         Cpdffont.print_font_table pdf fontname args.copyfontpage
   | Some TableOfContents ->
-      Printf.printf "Making a table of contents...\n"
+      let pdf = get_single_pdf args.op false in
+      let pdf = typeset_table_of_contents pdf in
+        write_pdf false pdf
   | Some (Typeset filename) ->
       let text = Pdfio.bytes_of_input_channel (open_in filename) in
       let pdf = typeset text in
diff --git a/cpdftype.ml b/cpdftype.ml
index d0fa107..8e70274 100644
--- a/cpdftype.ml
+++ b/cpdftype.ml
@@ -25,9 +25,9 @@ type element =
 | BeginDest of Pdfdest.t
 | EndDest
 
-let string_of_element = function
+let to_string_elt = function
   | Text t -> t
-  | HGlue _ -> "HGLUE"
+  | HGlue {glen} -> "HGLUE" ^ string_of_float glen
   | VGlue _ -> "VGLUE"
   | NewLine -> "NewLine"
   | NewPage -> "NewPage"
@@ -35,6 +35,8 @@ let string_of_element = function
   | BeginDest _ -> "BeginDest"
   | EndDest -> "EndDest"
 
+let to_string es = fold_left (fun a b -> a ^ "\n" ^ b) "" (map to_string_elt es)
+
 let indent x = HGlue {glen = x; gstretch = 0.}
 let newpara x = VGlue {glen = x; gstretch = 0.}
 
@@ -216,5 +218,5 @@ let example_pdf () =
     let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
       Pdfpage.add_root pageroot [] pdf
 
-let _ =
-  Pdfwrite.pdf_to_file (example_pdf ()) "out.pdf"
+(*let _ =
+  Pdfwrite.pdf_to_file (example_pdf ()) "out.pdf"*)
diff --git a/cpdftype.mli b/cpdftype.mli
index 8fb2d57..0c5db7f 100644
--- a/cpdftype.mli
+++ b/cpdftype.mli
@@ -14,4 +14,6 @@ type element =
 
 type t = element list
 
+val to_string : t -> string
+
 val typeset : float -> float -> float -> float -> Pdfpaper.t -> Pdf.t -> t -> Pdfpage.t list