diff --git a/Makefile b/Makefile index c33757f..8ef69d4 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ MODS = cpdfyojson cpdfxmlm \ cpdfunicodedata cpdferror cpdfjson cpdfstrftime cpdfcoord cpdfattach \ cpdfpagespec cpdfposition cpdfpresent cpdfmetadata cpdf cpdffont cpdftype \ - cpdftexttopdf cpdftoc cpdfpad cpdfocg cpdfsqueeze cpdfspot cpdfcommand + cpdftexttopdf cpdftoc cpdfpad cpdfocg cpdfsqueeze cpdfspot cpdfpagelabels cpdfcreate cpdfcommand SOURCES = $(foreach x,$(MODS),$(x).ml $(x).mli) cpdfcommandrun.ml diff --git a/cpdf.ml b/cpdf.ml index 962e3be..5e7dc99 100644 --- a/cpdf.ml +++ b/cpdf.ml @@ -2827,66 +2827,6 @@ let draft onlyremove boxes range pdf = pagenums; Pdfpage.change_pages true !pdf (rev !pages') -let blank_document width height pages = - let pdf_pages = - map (fun () -> Pdfpage.blankpage (Pdfpaper.make Pdfunits.PdfPoint width height)) (many () pages) - in - let pdf, pageroot = Pdfpage.add_pagetree pdf_pages (Pdf.empty ()) in - Pdfpage.add_root pageroot [] pdf - -let blank_document_paper papersize pages = - let pdf_pages = - map (fun () -> Pdfpage.blankpage papersize) (many () pages) - in - let pdf, pageroot = Pdfpage.add_pagetree pdf_pages (Pdf.empty ()) in - Pdfpage.add_root pageroot [] pdf - -(* Split the given range (which is in order) into multiple contiguous ones. *) -let rec ranges_of_range curr prev = function - | [] -> begin match curr with [] -> rev prev | _ -> rev (rev curr::prev) end - | x::xs -> - match curr with - | [] -> ranges_of_range [x] prev xs - | c::cs when x = c + 1 -> ranges_of_range (x::curr) prev xs - | cs -> ranges_of_range [x] (rev cs::prev) xs - -(* Predicate which is true if at least one page range starts at page 1 *) -let page1 labels = - mem true (map (function l -> l.Pdfpagelabels.startpage = 1) labels) - -let add_page_labels pdf progress style prefix startval range = - let ranges = map extremes (ranges_of_range [] [] range) - and labels = Pdfpagelabels.read pdf in - assert (length ranges > 0); - let startval_additions = - let r = ref [] in - let sofar = ref 0 in - iter (fun (s, e) -> r := !sofar :: !r; sofar := e - s + 1 + !sofar) ranges; - rev !r - in - let labels = - if not (page1 labels) then - ref - ({Pdfpagelabels.labelstyle = Pdfpagelabels.DecimalArabic; - Pdfpagelabels.labelprefix = None; - Pdfpagelabels.startpage = 1; - Pdfpagelabels.startvalue = 1}::labels) - else - ref labels - in - iter2 - (fun (s, e) addition -> - let label = - {Pdfpagelabels.labelstyle = style; - Pdfpagelabels.labelprefix = prefix; - Pdfpagelabels.startpage = s; - Pdfpagelabels.startvalue = startval + if progress then addition else 0} - in - labels := Pdfpagelabels.add_label (Pdfpage.endpage pdf) !labels label e) - ranges - startval_additions; - Pdfpagelabels.write pdf !labels - (* Parse the new content to make sure syntactically ok, append * as required. Rewrite the content *) let append_page_content_page fast s before pdf n page = diff --git a/cpdf.mli b/cpdf.mli index 624f9a6..8a59b3d 100644 --- a/cpdf.mli +++ b/cpdf.mli @@ -235,20 +235,6 @@ val twoup_stack : bool -> Pdf.t -> Pdf.t the media box is unchanged. Bool true (fast) if assume well-formed ISO content streams. *) val twoup : bool -> Pdf.t -> Pdf.t -(** {2 Making new documents} *) - -(** Make a blank document given x and y page dimensions in points and a number of pages *) -val blank_document : float -> float -> int -> Pdf.t - -(** The same, but give a Pdfpaper.t paper size. *) -val blank_document_paper : Pdfpaper.t -> int -> Pdf.t - -(** {2 Page labels} *) - -(** Add page labels. *) -val add_page_labels : - Pdf.t -> bool -> Pdfpagelabels.labelstyle -> string option -> int -> int list -> unit - (** {2 Miscellany} *) (** Make all lines in the PDF at least a certain thickness. *) diff --git a/cpdfcommand.ml b/cpdfcommand.ml index 80432be..eb8c18e 100644 --- a/cpdfcommand.ml +++ b/cpdfcommand.ml @@ -3806,7 +3806,7 @@ let go () = | Some AddPageLabels -> let pdf = get_single_pdf args.op false in let range = parse_pagespec pdf (get_pagespec ()) in - Cpdf.add_page_labels + Cpdfpagelabels.add_page_labels pdf args.labelsprogress args.labelstyle args.labelprefix args.labelstartval range; write_pdf false pdf | Some RemovePageLabels -> diff --git a/cpdfcreate.ml b/cpdfcreate.ml new file mode 100644 index 0000000..9fc39fc --- /dev/null +++ b/cpdfcreate.ml @@ -0,0 +1,13 @@ +let blank_document width height pages = + let pdf_pages = + map (fun () -> Pdfpage.blankpage (Pdfpaper.make Pdfunits.PdfPoint width height)) (many () pages) + in + let pdf, pageroot = Pdfpage.add_pagetree pdf_pages (Pdf.empty ()) in + Pdfpage.add_root pageroot [] pdf + +let blank_document_paper papersize pages = + let pdf_pages = + map (fun () -> Pdfpage.blankpage papersize) (many () pages) + in + let pdf, pageroot = Pdfpage.add_pagetree pdf_pages (Pdf.empty ()) in + Pdfpage.add_root pageroot [] pdf diff --git a/cpdfcreate.mli b/cpdfcreate.mli new file mode 100644 index 0000000..8f666cf --- /dev/null +++ b/cpdfcreate.mli @@ -0,0 +1,7 @@ +(** {2 Making new documents} *) + +(** Make a blank document given x and y page dimensions in points and a number of pages *) +val blank_document : float -> float -> int -> Pdf.t + +(** The same, but give a Pdfpaper.t paper size. *) +val blank_document_paper : Pdfpaper.t -> int -> Pdf.t diff --git a/cpdfpagelabels.ml b/cpdfpagelabels.ml new file mode 100644 index 0000000..10fd957 --- /dev/null +++ b/cpdfpagelabels.ml @@ -0,0 +1,49 @@ +open Pdfutil + + +(* Split the given range (which is in order) into multiple contiguous ones. *) +let rec ranges_of_range curr prev = function + | [] -> begin match curr with [] -> rev prev | _ -> rev (rev curr::prev) end + | x::xs -> + match curr with + | [] -> ranges_of_range [x] prev xs + | c::cs when x = c + 1 -> ranges_of_range (x::curr) prev xs + | cs -> ranges_of_range [x] (rev cs::prev) xs + +(* Predicate which is true if at least one page range starts at page 1 *) +let page1 labels = + mem true (map (function l -> l.Pdfpagelabels.startpage = 1) labels) + +let add_page_labels pdf progress style prefix startval range = + let ranges = map extremes (ranges_of_range [] [] range) + and labels = Pdfpagelabels.read pdf in + assert (length ranges > 0); + let startval_additions = + let r = ref [] in + let sofar = ref 0 in + iter (fun (s, e) -> r := !sofar :: !r; sofar := e - s + 1 + !sofar) ranges; + rev !r + in + let labels = + if not (page1 labels) then + ref + ({Pdfpagelabels.labelstyle = Pdfpagelabels.DecimalArabic; + Pdfpagelabels.labelprefix = None; + Pdfpagelabels.startpage = 1; + Pdfpagelabels.startvalue = 1}::labels) + else + ref labels + in + iter2 + (fun (s, e) addition -> + let label = + {Pdfpagelabels.labelstyle = style; + Pdfpagelabels.labelprefix = prefix; + Pdfpagelabels.startpage = s; + Pdfpagelabels.startvalue = startval + if progress then addition else 0} + in + labels := Pdfpagelabels.add_label (Pdfpage.endpage pdf) !labels label e) + ranges + startval_additions; + Pdfpagelabels.write pdf !labels + diff --git a/cpdfpagelabels.mli b/cpdfpagelabels.mli new file mode 100644 index 0000000..3083233 --- /dev/null +++ b/cpdfpagelabels.mli @@ -0,0 +1,6 @@ +(** {2 Page labels} *) + +(** Add page labels. *) +val add_page_labels : + Pdf.t -> bool -> Pdfpagelabels.labelstyle -> string option -> int -> int list -> unit +