First rewrite of write_structure_tree

This commit is contained in:
John Whitington 2024-09-18 14:04:50 +01:00
parent d57575850c
commit cc01c8ddc1

View File

@ -609,8 +609,7 @@ let make_structure_tree pdf items =
in in
make_structure_tree pageobjnums pdf (ref 0) items make_structure_tree pageobjnums pdf (ref 0) items
(* Write such a structure tree to a PDF. We have to make the objects and build (* Write such a structure tree to a PDF. *)
the root and its /K. *)
let write_structure_tree pdf st = let write_structure_tree pdf st =
let parentmap = ref [] in let parentmap = ref [] in
let add_parentmap pon this_objnum = let add_parentmap pon this_objnum =
@ -619,10 +618,13 @@ let write_structure_tree pdf st =
| Some objnums -> parentmap := add pon (this_objnum::objnums) !parentmap | Some objnums -> parentmap := add pon (this_objnum::objnums) !parentmap
in in
let struct_tree_root = Pdf.addobj pdf Pdf.Null in let struct_tree_root = Pdf.addobj pdf Pdf.Null in
let items = let rec mktree struct_tree_parent = function
map | StItem {kind; pageobjnum; alt; children} ->
(function StItem {kind; pageobjnum; alt; children} ->
let this_objnum = Pdf.addobj pdf Pdf.Null in let this_objnum = Pdf.addobj pdf Pdf.Null in
begin match pageobjnum with
| Some p -> add_parentmap p this_objnum
| _ -> ()
end;
let alt = let alt =
match alt with match alt with
| Some s -> [("/Alt", Pdf.String s)] | Some s -> [("/Alt", Pdf.String s)]
@ -634,18 +636,19 @@ let write_structure_tree pdf st =
| None -> [] | None -> []
in in
let this_obj = let this_obj =
Pdf.Dictionary (alt @ page @ Pdf.Dictionary
[("/S", Pdf.Name kind); (alt
("/P", Pdf.Indirect struct_tree_root); @ page
("/K", Pdf.Array (map (function StMCID x -> begin match pageobjnum with Some p -> add_parentmap p this_objnum | _ -> () end; Pdf.Integer x @ [("/S", Pdf.Name kind);
| _ -> assert false) children))]) ("/P", Pdf.Indirect struct_tree_parent);
("/K", Pdf.Array (map (mktree this_objnum) children))])
in in
Pdf.addobj_given_num pdf (this_objnum, this_obj); Pdf.addobj_given_num pdf (this_objnum, this_obj);
Pdf.Indirect this_objnum Pdf.Indirect this_objnum
| _ -> assert false | StMCID x ->
) Pdf.Integer x
st
in in
let items = map (mktree struct_tree_root) st in
iter iter
(fun (pon, _) -> (fun (pon, _) ->
Pdf.addobj_given_num pdf (pon, Pdf.add_dict_entry (Pdf.lookup_obj pdf pon) "/StructParents" (Pdf.Integer pon))) Pdf.addobj_given_num pdf (pon, Pdf.add_dict_entry (Pdf.lookup_obj pdf pon) "/StructParents" (Pdf.Integer pon)))