Working on pattern bugs

This commit is contained in:
John Whitington 2019-07-15 18:46:17 +01:00
parent d963944f70
commit 1134d88635

67
cpdf.ml
View File

@ -2192,56 +2192,45 @@ let change_boxes f pdf page =
alter any /Matrix entries in pattern dictionaries for tiled and shading alter any /Matrix entries in pattern dictionaries for tiled and shading
patterns. In addition, shadings used by Op_sh in the main page content and in patterns. In addition, shadings used by Op_sh in the main page content and in
xobjects must be altered. *) xobjects must be altered. *)
let rec change_shadings pdf tr resources =
let transform_shading s = (*let transform_shading tr s = s
s
in let change_shadings pdf tr shadingdict =
try match Pdf.direct pdf shadingdict with
let resources = | Pdf.Dictionary shadings ->
begin match Pdf.lookup_direct pdf "/Shading" resources with let shadings' =
| Some (Pdf.Dictionary shadings) -> map
let names, nums =
split
(map
(fun (name, shading) -> (fun (name, shading) ->
Printf.printf "Fixing up shading %s\n" name; Printf.printf "Fixing up shading %s\n" name;
name, Pdf.addobj pdf (transform_shading shading)) (name, Pdf.Indirect (Pdf.addobj pdf (transform_shading tr shading))))
shadings) shadings
in in
let entries = Pdf.Dictionary shadings'
map2 (fun name num -> name, Pdf.Indirect num) names nums | _ -> raise (Pdf.PDFError "not a shading dictionary")
in
Pdf.add_dict_entry resources "/Shading" (Pdf.Dictionary entries) let change_shadings_xobject pdf tr xobject =
| _ -> resources match Pdf.lookup_direct pdf "/Shading" xobject with
end | Some ss -> Pdf.add_dict_entry xobject "/Shading" (change_shadings pdf tr ss)
in | None -> xobject
let process_xobject xobject =
change_shadings pdf tr xobject let change_shadings pdf tr resources =
in match Pdf.lookup_direct pdf "/XObject" resources with
begin match Pdf.lookup_direct pdf "/XObject" resources with
| Some (Pdf.Dictionary xobjects) -> | Some (Pdf.Dictionary xobjects) ->
let names, nums = let entries =
split map
(map
(fun (name, xobject) -> (fun (name, xobject) ->
Printf.printf "Looking for shadings in xobject %s\n" name; Printf.printf "Looking for shadings in xobject %s\n" name;
name, Pdf.addobj pdf (process_xobject xobject)) name, Pdf.Indirect (Pdf.addobj pdf (change_shadings_xobject pdf tr xobject)))
xobjects) xobjects
in
let entries =
map2 (fun name num -> name, Pdf.Indirect num) names nums
in in
Pdf.add_dict_entry resources "/XObject" (Pdf.Dictionary entries) Pdf.add_dict_entry resources "/XObject" (Pdf.Dictionary entries)
| _ -> resources | _ -> resources*)
end
with
_ ->
Printf.eprintf "Error in change_shadings: returning default resources\n";
resources
(* FIXME: Why doesn't this do patterns in xobjects? Are they always in page space not xobject space? Is change_shadings a wild goose chase? *)
let change_pattern_matrices pdf tr resources = let change_pattern_matrices pdf tr resources =
try try
let resources = change_shadings pdf tr resources in (*let resources = change_shadings pdf tr resources in*)
begin match Pdf.lookup_direct pdf "/Pattern" resources with begin match Pdf.lookup_direct pdf "/Pattern" resources with
| Some (Pdf.Dictionary patterns) -> | Some (Pdf.Dictionary patterns) ->
let names, nums = let names, nums =