From de7e4425605a7a028ce2faa1e6536993569e66ea Mon Sep 17 00:00:00 2001
From: John Whitington <john@coherentgraphics.co.uk>
Date: Sat, 6 Aug 2022 16:42:28 +0200
Subject: [PATCH] more

---
 cpdfaddtext.ml | 51 ++++++++++++++++++++++++--------------------------
 1 file changed, 24 insertions(+), 27 deletions(-)

diff --git a/cpdfaddtext.ml b/cpdfaddtext.ml
index 2c4a350..4e256c3 100644
--- a/cpdfaddtext.ml
+++ b/cpdfaddtext.ml
@@ -270,9 +270,6 @@ let rec process_text time text m =
    of ordered (line num, URL, startpos, endpos) data.
    This will be used after any other %Specials have been processed, so that the
    positions do not change. *)
-let testurlline = "text before %URL[click here|https://www.coherentpdf.com/] rest of text "
-let testurllinemultiple = testurlline ^ testurlline
-let testlines = [testurllinemultiple; testurllinemultiple]
 
 (* text|url]abc -> text, url, abc *)
 let extract_url line =
@@ -304,20 +301,8 @@ let get_urls_line line =
     loop line;
     (implode (rev !outline), rev !urls)
 
- 
-(* Get all URLs for all lines *)
-let get_urls lines =
-  let urls = ref [] in
-  let linesout = ref [] in
-  let linenum = ref 0 in
-    List.iter
-      (fun l ->
-        let lineout, lineurls = get_urls_line l in
-          linesout := lineout::!linesout;
-          urls := rev (map (fun (a, b, c) -> (!linenum, a, b, c)) lineurls) @ !urls;
-          linenum += 1)
-      lines;
-    (rev !linesout, rev !urls)
+(* Find a coordinate for an annotation given its position in a line of text. Positions 0..(l - 1). *)
+
 
 (* Return page label at pdf page num, or page number in arabic if no label *) 
 let pagelabel pdf num =
@@ -377,10 +362,6 @@ let addtext
         | None -> Pdf.Dictionary []
         | Some d -> d
       in
-        let unique_fontname = Pdf.unique_key "F" fontdict in
-          let ops, urls =
-            let text = process_text time text (replace_pairs pdf filename bates batespad num page) in
-            let text = hd (fst (get_urls [text])) in
               let calc_textwidth text =
                 match font with
                 | Some f ->
@@ -414,14 +395,19 @@ let addtext
                       let rawwidth = width_of_text (Pdftext.read_font pdf font) text in
                         (rawwidth *. fontsize) /. 1000.
               in
+        let unique_fontname = Pdf.unique_key "F" fontdict in
+          let ops, urls, x, y, hoffset, voffset =
+            let text = process_text time text (replace_pairs pdf filename bates batespad num page) in
+            let text, urls = get_urls_line text in
+
                 let expanded_lines =
                   map
                     (function text ->
                        process_text time text (replace_pairs pdf filename bates batespad num page))
                     lines
                 in
-                let expanded_lines, urls = (* process URLs for justification too *)
-                  get_urls expanded_lines
+                let expanded_lines = (* process URLs for justification too *)
+                  map (fun line -> fst (get_urls_line line)) expanded_lines
                 in
                 let textwidth = calc_textwidth text
                 and allwidths = map calc_textwidth expanded_lines in
@@ -445,11 +431,11 @@ let addtext
                         | Some f ->
                             ops longest_w metrics (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
                             unique_fontname unique_extgstatename colour fontsize text,
-                            urls
+                            urls, x, y, hoffset, voffset
                         | None ->
                             ops longest_w metrics (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
                             fontname None colour fontsize text,
-                            urls
+                            urls, x, y, hoffset, voffset
           in
             let newresources =
               match font with
@@ -465,13 +451,24 @@ let addtext
               Pdf.Dictionary
                 [("/Subtype", Pdf.Name "/Link");
                  ("/Rect", Pdf.Array [Pdf.Real minx; Pdf.Real miny; Pdf.Real maxx; Pdf.Real maxy]);
-                 ("/BS", Pdf.Dictionary [("/W", Pdf.Integer 0)]);
+                 ("/BS", Pdf.Dictionary [("/W", Pdf.Integer 1)]);
                  ("/A", Pdf.Dictionary [("/URI", Pdf.String url);
                                         ("/Type", Pdf.Name "/Action");
                                         ("/S", Pdf.Name "/URI")])]
             in
             let annots =
-              map (fun (linenum, url, s, e) -> Pdf.Indirect (Pdf.addobj pdf (annot (0., 0., 100., 100.) url))) urls
+              (* FIXME All kinds of offsets / shifts to add here *)
+              let annot_coord is_end text pos =
+                let pos = pos + 1 in
+                let before = take (explode text) (if is_end then pos else pos - 1) in
+                calc_textwidth (implode before)
+              in
+                map (fun (url, s, e) ->
+                       let sx = annot_coord false text s in
+                       let ex = annot_coord true text e -. sx in
+                       let x, y = x -. hoffset, y -. voffset in
+                       let height = fontsize in
+                         Pdf.Indirect (Pdf.addobj pdf (annot (x +. sx, y, x +. ex, y +. height) url))) urls
             in
             let newrest =
               if annots = [] then page.Pdfpage.rest else