This commit is contained in:
John Whitington 2023-04-28 14:31:42 +01:00
parent 38ee3525f3
commit efbd794d35
1 changed files with 34 additions and 8 deletions

View File

@ -46,10 +46,17 @@ type drawops =
(* Hash table of (human name, (resources name, object)) for image xobjects *)
let images = null_hash ()
let gss = null_hash ()
(* Fresh XObject names. If we are stamping over another page, manage clashes later. *)
let fresh_xobj_name () = "/Img0"
let gsnum = ref ~-1
let fresh_gs_name () =
gsnum += 1;
"/gs" ^ string_of_int !gsnum
let rec ops_of_drawop pdf = function
| Push -> [Pdfops.Op_q]
| Pop -> [Pdfops.Op_Q]
@ -92,30 +99,49 @@ let rec ops_of_drawop pdf = function
Hashtbl.add images s (fresh_xobj_name (), Pdf.addobj pdf obj);
[]
| NewPage -> Pdfe.log ("NewPage remaining in graphic stream"); assert false
| Opacity v ->
let n = fresh_gs_name () in
Hashtbl.add gss n (Pdf.Dictionary [("/ca", Pdf.Real v)]);
[Pdfops.Op_gs n]
| SOpacity v ->
let n = fresh_gs_name () in
Hashtbl.add gss n (Pdf.Dictionary [("/CA", Pdf.Real v)]);
[Pdfops.Op_gs n]
and ops_of_drawops pdf drawops =
flatten (map (ops_of_drawop pdf) drawops)
(* Draw all the accumulated operators. FIXME: Manage name clashes in Xobjects *)
(* Draw all the accumulated operators. FIXME: Manage name clashes in Xobjects etc. *)
let draw fast range pdf drawops =
let s = Pdfops.string_of_ops (ops_of_drawops pdf drawops) in
let pdf = Cpdftweak.append_page_content s false fast range pdf in
let images = list_of_hashtbl images in
let resources = map (fun (_, (n, o)) -> (n, Pdf.Indirect o)) images in
match images with [] -> pdf | _ ->
let image_resources = map (fun (_, (n, o)) -> (n, Pdf.Indirect o)) images in
let gss_resources = list_of_hashtbl gss in
Printf.printf "%i gss_resources\n" (length gss_resources);
match images, gss_resources with [], [] -> pdf | _ ->
let pages = Pdfpage.pages_of_pagetree pdf in
let pages =
map
(fun p ->
let new_resources =
let existing =
begin match Pdf.lookup_direct pdf "/XObject" p.Pdfpage.resources with
let existing_xobjects =
match Pdf.lookup_direct pdf "/XObject" p.Pdfpage.resources with
| Some (Pdf.Dictionary d) -> d
| _ -> []
end
in
let new_xobjects = fold_right (fun (k, v) d -> add k v d) resources existing in
Pdf.add_dict_entry p.Pdfpage.resources "/XObject" (Pdf.Dictionary new_xobjects)
let existing_gss =
match Pdf.lookup_direct pdf "/ExtGState" p.Pdfpage.resources with
| Some (Pdf.Dictionary d) -> d
| _ -> []
in
let new_xobjects = fold_right (fun (k, v) d -> add k v d) image_resources existing_xobjects in
let new_gss = fold_right (fun (k, v) d -> add k v d) gss_resources existing_gss in
let r =
Pdf.add_dict_entry (Pdf.add_dict_entry p.Pdfpage.resources "/XObject" (Pdf.Dictionary new_xobjects)) "/ExtGState" (Pdf.Dictionary new_gss)
in
Printf.printf "final: %s\n" (Pdfwrite.string_of_pdf r);
r
in
{p with resources = new_resources})
pages