Some MCRs

This commit is contained in:
John Whitington 2024-10-04 13:41:47 +01:00
parent 418e3a8bcc
commit 31dec76f4b
1 changed files with 35 additions and 25 deletions

View File

@ -128,6 +128,15 @@ let typeset ~process_struct_tree ?subformat ?title ~papersize ~font ~fontsize te
Printf.printf "Paragraph:\n";
iter (fun (para, page, mcid) -> Printf.printf "Para %i, Page %i, MCID %i\n" para page mcid) parts_of_para)
nodes;
let pages =
map2
(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)
(indx0 pages)
pages
in
let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
let pdf = Pdfpage.add_root pageroot [] pdf in
let refnums = let ns = Pdf.page_reference_numbers pdf in combine (indx0 ns) ns in
if subformat = Some Cpdfua.PDFUA2 then
begin
let str = Pdf.addobj pdf Pdf.Null in
@ -147,16 +156,17 @@ let typeset ~process_struct_tree ?subformat ?title ~papersize ~font ~fontsize te
let str = Pdf.addobj pdf Pdf.Null in
let p = Pdf.addobj pdf Pdf.Null in
let parent_tree = Pdf.addobj pdf Pdf.Null in
let topks =
map
(fun parts_of_para ->
let ks =
map (fun (_, pagenumber, mcid) -> Pdf.Dictionary [("/Type", Pdf.Name "/MCR"); ("/Pg", Pdf.Indirect (unopt (lookup pagenumber refnums))); ("/MCID", Pdf.Integer mcid)]) parts_of_para
in
Pdf.Indirect (Pdf.addobj pdf (Pdf.Dictionary [("/K", Pdf.Array ks); ("/P", Pdf.Indirect str); ("/S", Pdf.Name "/P")])))
nodes
in
Pdf.addobj_given_num pdf (parent_tree, Pdf.Dictionary [("/Nums", Pdf.Array [Pdf.Integer 1; Pdf.Array [Pdf.Indirect p]])]);
Pdf.addobj_given_num pdf (p, Pdf.Dictionary [("/K", Pdf.Array [Pdf.Integer 0]); ("/P", Pdf.Indirect str); ("/S", Pdf.Name "/P")]);
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 topks); ("/ParentTree", Pdf.Indirect parent_tree)]);
Pdf.replace_chain pdf ["/Root"] ("/StructTreeRoot", (Pdf.Indirect str))
end;
let pages =
map2
(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)
(indx0 pages)
pages
in
let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
Pdfpage.add_root pageroot [] pdf
pdf