-chop implementation finished

This commit is contained in:
John Whitington 2023-11-29 11:11:09 +00:00
parent 87320f2082
commit 65e5b391e2
1 changed files with 18 additions and 9 deletions

View File

@ -4,6 +4,7 @@ open Cpdferror
(* Chop a single page into pieces. We prefer the cropbox when available. We set (* Chop a single page into pieces. We prefer the cropbox when available. We set
mediabox only, and delete any other boxes. We delete /Annots, since mediabox only, and delete any other boxes. We delete /Annots, since
duplicate annotations are not allowed. *) duplicate annotations are not allowed. *)
let get_box pdf page = let get_box pdf page =
match Pdf.lookup_direct pdf "/CropBox" page.Pdfpage.rest with match Pdf.lookup_direct pdf "/CropBox" page.Pdfpage.rest with
| Some r -> Pdf.parse_rectangle pdf r | Some r -> Pdf.parse_rectangle pdf r
@ -14,28 +15,37 @@ let erase_boxes d =
f (f (f (f (f d "/CropBox") "/BleedBox") "/TrimBox") "/ArtBox") "/Annots" f (f (f (f (f d "/CropBox") "/BleedBox") "/TrimBox") "/ArtBox") "/Annots"
let make_pages x y columns btt rtl w h ps move_page = let make_pages x y columns btt rtl w h ps move_page =
for ty = y - 1 downto 0 do for tx = 0 to x - 1 do if columns then
ps =| move_page (w *. float_of_int tx) (h *. float_of_int ty) let column tx =
done done if btt then
for ty = 0 to y - 1 do ps =| move_page (w *. float_of_int tx) (h *. float_of_int ty) done
else
for ty = y - 1 downto 0 do ps =| move_page (w *. float_of_int tx) (h *. float_of_int ty) done
in
if rtl then for tx = x - 1 downto 0 do column tx done else for tx = 0 to x - 1 do column tx done
else
let row ty =
if rtl then
for tx = x - 1 downto 0 do ps =| move_page (w *. float_of_int tx) (h *. float_of_int ty) done
else
for tx = 0 to x - 1 do ps =| move_page (w *. float_of_int tx) (h *. float_of_int ty) done
in
if btt then for ty = 0 to y - 1 do row ty done else for ty = y - 1 downto 0 do row ty done
let chop_boxes pdf x y columns btt rtl p = let chop_boxes pdf x y columns btt rtl p =
if x < 1 || y < 1 then Cpdferror.error "chop_boxes bad specification" else if x < 1 || y < 1 then error "chop_boxes bad specification" else
let move_page mx my p w h dx dy = let move_page mx my p w h dx dy =
(*Printf.printf "move_page by %f %f\n" dx dy;*)
let nminx, nminy, nmaxx, nmaxy = (mx +. dx, my +. dy, mx +. w +. dx, my +. h +. dy) in let nminx, nminy, nmaxx, nmaxy = (mx +. dx, my +. dy, mx +. w +. dx, my +. h +. dy) in
(*Printf.printf "new box: %f, %f, %f, %f\n" nminx nminy nmaxx nmaxy;*)
{p with {p with
Pdfpage.mediabox = Pdf.Array [Pdf.Real nminx; Pdf.Real nminy; Pdf.Real nmaxx; Pdf.Real nmaxy]; Pdfpage.mediabox = Pdf.Array [Pdf.Real nminx; Pdf.Real nminy; Pdf.Real nmaxx; Pdf.Real nmaxy];
Pdfpage.rest = erase_boxes p.Pdfpage.rest} Pdfpage.rest = erase_boxes p.Pdfpage.rest}
in in
let minx, miny, maxx, maxy = get_box pdf p in let minx, miny, maxx, maxy = get_box pdf p in
(*Printf.printf "minx, miny, maxx, maxy = %f, %f, %f, %f\n" minx miny maxx maxy;*)
let w, h = (maxx -. minx) /. float_of_int x, (maxy -. miny) /. float_of_int y in let w, h = (maxx -. minx) /. float_of_int x, (maxy -. miny) /. float_of_int y in
let ps = ref [] in let ps = ref [] in
make_pages x y columns btt rtl w h ps (move_page minx miny p w h); make_pages x y columns btt rtl w h ps (move_page minx miny p w h);
rev !ps rev !ps
(* Chop pages in the range into pieces *)
let chop ~x ~y ~columns ~btt ~rtl pdf range = let chop ~x ~y ~columns ~btt ~rtl pdf range =
let pages = Pdfpage.pages_of_pagetree pdf in let pages = Pdfpage.pages_of_pagetree pdf in
let pages_out = let pages_out =
@ -56,5 +66,4 @@ let chop ~x ~y ~columns ~btt ~rtl pdf range =
(ilist 1 (Pdfpage.endpage pdf)) (ilist 1 (Pdfpage.endpage pdf))
pages) pages)
in in
(*iter (fun (a, b) -> Printf.printf "%i -> %i\n" a b) changes;*)
Pdfpage.change_pages ~changes true pdf pages_out Pdfpage.change_pages ~changes true pdf pages_out