fenix
/
cpdf-source
mirror of https://github.com/johnwhitington/cpdf-source.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More structure tree work

This commit is contained in:
John Whitington 2024-10-03 16:18:09 +01:00
parent 163d631dc9
commit 686318718d
2 changed files with 35 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
cpdftexttopdf.ml
View File

@ -94,6 +94,30 @@ let typeset ~process_struct_tree ?subformat ?title ~papersize ~font ~fontsize te
let firstfont = hd (keep (function Cpdftype.Font _ -> true | _ -> false) tagged) in let firstfont = hd (keep (function Cpdftype.Font _ -> true | _ -> false) tagged) in
[firstfont; Cpdftype.BeginDocument] @ tagged [firstfont; Cpdftype.BeginDocument] @ tagged
in in
let pages, tags = Cpdftype.typeset ~process_struct_tree margin margin margin margin papersize pdf instrs in
iter (fun x -> Printf.printf "PAGE\n"; iter (fun (_, i) -> Printf.printf "Tag number %i\n" i) x) tags;
(* We make (tag number, page number, mcid) triples *)
let tagtriples =
flatten
(map2
(fun pn tags ->
map2 (fun (_, tagnum) mcid -> (tagnum, pn, mcid)) tags (indx0 tags))
(indx0 tags)
tags)
in
Printf.printf "(tag number, page number, mcid) triples:\n";
iter (fun (tagnum, pn, mcid) -> Printf.printf "%i, %i, %i\n" tagnum pn mcid) tagtriples;
(* Now work out the nodes and what each /K and /Pg in them is *)
let pages_and_mcids =
[]
in
Printf.printf "Pages and their MCIDs\n";
iter
(fun (page, mcids) ->
Printf.printf "Page %i\n";
iter (Printf.printf "%i ") mcids;
Printf.printf "\n")
pages_and_mcids;
if subformat = Some Cpdfua.PDFUA2 then if subformat = Some Cpdfua.PDFUA2 then
begin begin
let str = Pdf.addobj pdf Pdf.Null in let str = Pdf.addobj pdf Pdf.Null in
@ -118,11 +142,11 @@ let typeset ~process_struct_tree ?subformat ?title ~papersize ~font ~fontsize te
Pdf.addobj_given_num pdf (str, Pdf.Dictionary [("/Type", Pdf.Name "/StructTreeRoot"); ("/K", Pdf.Array [Pdf.Indirect p]); ("/ParentTree", Pdf.Indirect parent_tree)]); Pdf.addobj_given_num pdf (str, Pdf.Dictionary [("/Type", Pdf.Name "/StructTreeRoot"); ("/K", Pdf.Array [Pdf.Indirect p]); ("/ParentTree", Pdf.Indirect parent_tree)]);
Pdf.replace_chain pdf ["/Root"] ("/StructTreeRoot", (Pdf.Indirect str)) Pdf.replace_chain pdf ["/Root"] ("/StructTreeRoot", (Pdf.Indirect str))
end; end;
let pages, tags = Cpdftype.typeset ~process_struct_tree margin margin margin margin papersize pdf instrs in let pages =
let pages = map2
map (fun pn p -> if process_struct_tree then {p with Pdfpage.rest = Pdf.add_dict_entry p.Pdfpage.rest "/StructParents" (Pdf.Integer pn)} else p)
(fun p -> if process_struct_tree then {p with Pdfpage.rest = Pdf.add_dict_entry p.Pdfpage.rest "/StructParents" (Pdf.Integer 1)} else p) (indx0 pages)
pages pages
in 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

5
cpdftype.ml
View File

@ -246,7 +246,7 @@ let typeset ~process_struct_tree lmargin rmargin tmargin bmargin papersize pdf i
Hashtbl.clear width_table_cache; Hashtbl.clear width_table_cache;
let debug = false in let debug = false in
if debug then (print_endline "***input:\n\n"; print_endline (to_string i)); if debug then (print_endline "***input:\n\n"; print_endline (to_string i));
let i = number_tags 1 i in let i = number_tags 0 i in
let i = layout lmargin rmargin papersize i in let i = layout lmargin rmargin papersize i in
if debug then (print_endline "***after layout:\n\n"; print_endline (to_string i)); if debug then (print_endline "***after layout:\n\n"; print_endline (to_string i));
let i = paginate tmargin bmargin papersize i in let i = paginate tmargin bmargin papersize i in
@ -275,7 +275,8 @@ let typeset ~process_struct_tree lmargin rmargin tmargin bmargin papersize pdf i
Pdfpage.rest = make_annotations pdf !thispageannotations} Pdfpage.rest = make_annotations pdf !thispageannotations}
in in
pages := page::!pages; pages := page::!pages;
tagsout := rev !tags::!tagsout tagsout := rev !tags::!tagsout;
tags := []
in in
let rec typeset_element = function let rec typeset_element = function
| Text cps -> | Text cps ->