fenix/cpdf-source
1
0
Fork 0
mirror of https://github.com/johnwhitington/cpdf-source.git synced 2025-06-05 22:09:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

more

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

42
cpdfdraw.ml
View File

@@ -46,10 +46,17 @@ type drawops =
(* Hash table of (human name, (resources name, object)) for image xobjects *) (* Hash table of (human name, (resources name, object)) for image xobjects *)
let images = null_hash () let images = null_hash ()
let gss = null_hash ()
(* Fresh XObject names. If we are stamping over another page, manage clashes later. *) (* Fresh XObject names. If we are stamping over another page, manage clashes later. *)
let fresh_xobj_name () = "/Img0" 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 let rec ops_of_drawop pdf = function
| Push -> [Pdfops.Op_q] | Push -> [Pdfops.Op_q]
| Pop -> [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); Hashtbl.add images s (fresh_xobj_name (), Pdf.addobj pdf obj);
[] []
| NewPage -> Pdfe.log ("NewPage remaining in graphic stream"); assert false | 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 = and ops_of_drawops pdf drawops =
flatten (map (ops_of_drawop 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 draw fast range pdf drawops =
let s = Pdfops.string_of_ops (ops_of_drawops pdf drawops) in 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 pdf = Cpdftweak.append_page_content s false fast range pdf in
let images = list_of_hashtbl images in let images = list_of_hashtbl images in
let resources = map (fun (_, (n, o)) -> (n, Pdf.Indirect o)) images in let image_resources = map (fun (_, (n, o)) -> (n, Pdf.Indirect o)) images in
match images with [] -> pdf | _ -> 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 = Pdfpage.pages_of_pagetree pdf in
let pages = let pages =
map map
(fun p -> (fun p ->
let new_resources = let new_resources =
let existing = let existing_xobjects =
begin match Pdf.lookup_direct pdf "/XObject" p.Pdfpage.resources with match Pdf.lookup_direct pdf "/XObject" p.Pdfpage.resources with
| Some (Pdf.Dictionary d) -> d | Some (Pdf.Dictionary d) -> d
| _ -> [] | _ -> []
end
in in
let new_xobjects = fold_right (fun (k, v) d -> add k v d) resources existing in let existing_gss =
Pdf.add_dict_entry p.Pdfpage.resources "/XObject" (Pdf.Dictionary new_xobjects) 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 in
{p with resources = new_resources}) {p with resources = new_resources})
pages pages