make_structure_tree can do stags now

This commit is contained in:
John Whitington 2024-09-17 16:09:29 +01:00
parent 43fba37747
commit e16c084500
1 changed files with 12 additions and 5 deletions

View File

@ -581,6 +581,14 @@ type st =
| StItem of {kind : string; pageobjnum : int option; alt : string option; children : st list} | StItem of {kind : string; pageobjnum : int option; alt : string option; children : st list}
(* Build a tree from the MCIDs and structure tree instructions gathered *) (* Build a tree from the MCIDs and structure tree instructions gathered *)
let rec find_tree_contents a level = function
| [] -> error "not enough -end-stag"
| StDataBeginTree _ as h::t ->
find_tree_contents (h::a) (level + 1) t
| StDataEndTree::t ->
if level = 1 then (rev a, t) else find_tree_contents a (level - 1) t
| h::t -> find_tree_contents (h::a) level t
let rec make_structure_tree pageobjnums pdf pagenum = function let rec make_structure_tree pageobjnums pdf pagenum = function
| [] -> [] | [] -> []
| StDataMCID (n, mcid, alt)::t -> | StDataMCID (n, mcid, alt)::t ->
@ -589,9 +597,10 @@ let rec make_structure_tree pageobjnums pdf pagenum = function
pagenum := n; pagenum := n;
make_structure_tree pageobjnums pdf pagenum t make_structure_tree pageobjnums pdf pagenum t
| StDataBeginTree s::t -> | StDataBeginTree s::t ->
make_structure_tree pageobjnums pdf pagenum t let tree_contents, rest = find_tree_contents [] 1 t in
[StItem {kind = s; alt = None; pageobjnum = None; children = make_structure_tree pageobjnums pdf pagenum rest}]
| StDataEndTree::t -> | StDataEndTree::t ->
make_structure_tree pageobjnums pdf pagenum t error "Too many -end-tags"
let make_structure_tree pdf items = let make_structure_tree pdf items =
let pageobjnums = let pageobjnums =
@ -601,9 +610,7 @@ let make_structure_tree pdf items =
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. We have to make the objects and build
the root and its /K. For now, we just have a root which contains everything the root and its /K. *)
else on one level. Later we will use StDataBeginTree / StDataEndTree to make
more tree stuff. *)
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 =