more
This commit is contained in:
parent
55b7371d07
commit
de7e442560
|
@ -270,9 +270,6 @@ let rec process_text time text m =
|
||||||
of ordered (line num, URL, startpos, endpos) data.
|
of ordered (line num, URL, startpos, endpos) data.
|
||||||
This will be used after any other %Specials have been processed, so that the
|
This will be used after any other %Specials have been processed, so that the
|
||||||
positions do not change. *)
|
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 *)
|
(* text|url]abc -> text, url, abc *)
|
||||||
let extract_url line =
|
let extract_url line =
|
||||||
|
@ -304,20 +301,8 @@ let get_urls_line line =
|
||||||
loop line;
|
loop line;
|
||||||
(implode (rev !outline), rev !urls)
|
(implode (rev !outline), rev !urls)
|
||||||
|
|
||||||
|
(* Find a coordinate for an annotation given its position in a line of text. Positions 0..(l - 1). *)
|
||||||
|
|
||||||
(* 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)
|
|
||||||
|
|
||||||
(* Return page label at pdf page num, or page number in arabic if no label *)
|
(* Return page label at pdf page num, or page number in arabic if no label *)
|
||||||
let pagelabel pdf num =
|
let pagelabel pdf num =
|
||||||
|
@ -377,10 +362,6 @@ let addtext
|
||||||
| None -> Pdf.Dictionary []
|
| None -> Pdf.Dictionary []
|
||||||
| Some d -> d
|
| Some d -> d
|
||||||
in
|
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 =
|
let calc_textwidth text =
|
||||||
match font with
|
match font with
|
||||||
| Some f ->
|
| Some f ->
|
||||||
|
@ -414,14 +395,19 @@ let addtext
|
||||||
let rawwidth = width_of_text (Pdftext.read_font pdf font) text in
|
let rawwidth = width_of_text (Pdftext.read_font pdf font) text in
|
||||||
(rawwidth *. fontsize) /. 1000.
|
(rawwidth *. fontsize) /. 1000.
|
||||||
in
|
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 =
|
let expanded_lines =
|
||||||
map
|
map
|
||||||
(function text ->
|
(function text ->
|
||||||
process_text time text (replace_pairs pdf filename bates batespad num page))
|
process_text time text (replace_pairs pdf filename bates batespad num page))
|
||||||
lines
|
lines
|
||||||
in
|
in
|
||||||
let expanded_lines, urls = (* process URLs for justification too *)
|
let expanded_lines = (* process URLs for justification too *)
|
||||||
get_urls expanded_lines
|
map (fun line -> fst (get_urls_line line)) expanded_lines
|
||||||
in
|
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
|
||||||
|
@ -445,11 +431,11 @@ let addtext
|
||||||
| Some f ->
|
| Some f ->
|
||||||
ops longest_w metrics (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
|
ops longest_w metrics (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
|
urls, x, y, hoffset, voffset
|
||||||
| None ->
|
| None ->
|
||||||
ops longest_w metrics (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
|
ops longest_w metrics (x +. shift_x) (y +. shift_y) rotate (hoffset +. joffset) voffset outline linewidth
|
||||||
fontname None colour fontsize text,
|
fontname None colour fontsize text,
|
||||||
urls
|
urls, x, y, hoffset, voffset
|
||||||
in
|
in
|
||||||
let newresources =
|
let newresources =
|
||||||
match font with
|
match font with
|
||||||
|
@ -465,13 +451,24 @@ let addtext
|
||||||
Pdf.Dictionary
|
Pdf.Dictionary
|
||||||
[("/Subtype", Pdf.Name "/Link");
|
[("/Subtype", Pdf.Name "/Link");
|
||||||
("/Rect", Pdf.Array [Pdf.Real minx; Pdf.Real miny; Pdf.Real maxx; Pdf.Real maxy]);
|
("/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);
|
("/A", Pdf.Dictionary [("/URI", Pdf.String url);
|
||||||
("/Type", Pdf.Name "/Action");
|
("/Type", Pdf.Name "/Action");
|
||||||
("/S", Pdf.Name "/URI")])]
|
("/S", Pdf.Name "/URI")])]
|
||||||
in
|
in
|
||||||
let annots =
|
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
|
in
|
||||||
let newrest =
|
let newrest =
|
||||||
if annots = [] then page.Pdfpage.rest else
|
if annots = [] then page.Pdfpage.rest else
|
||||||
|
|
Loading…
Reference in New Issue