fenix
/
cpdf-source
mirror of https://github.com/johnwhitington/cpdf-source.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
cpdf-source/cpdftype.ml

257 lines
8.5 KiB
OCaml
Raw Blame History

(* A typesetter for cpdf. A list of elements is manipulated zero or more times
to lay it out, paginate it, and so on. It is then typeset to produce a list
of pages *)
(* FIXME We need to make Pdfstandard14 width calculations much more efficient
by caching so that we are not making a table up for each character! *)
(* FIXME We need to reintroduce kerning in Pdfstandard14. *)
(* FIXME Fix up charcode / text extractors to take fonts not fontdicts *)
open Pdfutil
(* Glue *)
type glue =
{glen : float;
gstretch : float}
(* Main type *)
type element =
Text of string (* WinAnsiEncoding *)
| HGlue of glue
| VGlue of glue
| NewLine
| NewPage
| Font of (Pdftext.font * float)
| BeginDest of Pdfdest.t
| EndDest
let to_string_elt = function
| Text t -> t
| HGlue {glen} -> "HGLUE" ^ string_of_float glen
| VGlue _ -> "VGLUE"
| NewLine -> "NewLine"
| NewPage -> "NewPage"
| Font _ -> "Font"
| BeginDest _ -> "BeginDest"
| EndDest -> "EndDest"
let to_string es = fold_left (fun a b -> a ^ "\n" ^ b) "" (map to_string_elt es)
let indent x = HGlue {glen = x; gstretch = 0.}
let newpara x = VGlue {glen = x; gstretch = 0.}
type t = element list
let of_utf8 (f, fontsize) t =
let pdf = Pdf.empty () in
let fontdict = Pdftext.write_font pdf f in
let extractor = Pdftext.charcode_extractor_of_font pdf (Pdf.Indirect fontdict) in
Pdftext.codepoints_of_utf8 t
|> option_map extractor
|> map char_of_int
|> implode
let times_roman_12 = (Pdftext.StandardFont (Pdftext.TimesRoman, Pdftext.WinAnsiEncoding), 12.)
let times_italic_10 = (Pdftext.StandardFont (Pdftext.TimesItalic, Pdftext.WinAnsiEncoding), 10.)
let times_bold_10 = (Pdftext.StandardFont (Pdftext.TimesBold, Pdftext.WinAnsiEncoding), 10.)
let example =
[Font times_roman_12;
newpara 12.; (* set up top of page correctly *)
Text (of_utf8 times_roman_12 "Jackdaws love my Sphinx of Quartz. And this, this is the second sentence to provoke a line-break. We need rather more text than one might think in this diminutive font.");
NewLine;
Text (of_utf8 times_roman_12 "After the newline... ");
newpara (12. *. 1.3);
indent 32.;
Font times_italic_10;
Text (of_utf8 times_italic_10 "The second paragraph");
NewPage;
newpara 10.; (* set up top of page *)
Font times_bold_10;
BeginDest Pdfdest.NullDestination;
Text (of_utf8 times_bold_10 "A little too bold");
EndDest
]
type state =
{mutable font : Pdftext.font option;
mutable fontsize : float;
mutable width_table : float array; (* Widths for charcodes 0..255 *)
mutable xpos : float;
mutable ypos : float;
mutable dest : Pdfdest.t option}
let initial_state () =
{font = None;
fontsize = 0.;
width_table = [||];
xpos = 0.;
ypos = 0.;
dest = None}
let font_widths f fontsize =
let w = fontsize *. (600. /. 1000.) in
Array.make 256 w
(* For now, split each text element into words, and lay them out ragged right
on one long page. Words longer than a whole line just fall off the margin.
Turn text newlines into real newlines. *)
let width_of_string ws s =
fold_left ( +. ) 0. (map (fun s -> ws.(int_of_char s)) s) (* FIXME efficiency *)
(* Split into words on spaces. Find how many words (at least one, to make
progress) fit into the available space. We set needs_newline if the next
word would overflow. Return (text, needs_newline, remaining_text) *)
(* FIXME efficiency *)
let split_text space_left widths t =
let chars = ref (explode t) in
let words = ref [] in
let space_left = ref space_left in
let return needs_newline =
(implode (flatten (rev !words)), needs_newline, implode !chars)
in
try
while !chars <> [] do
let word, rest = cleavewhile (neq ' ') !chars in
let w = width_of_string widths word in
if !words = [] || w < !space_left
then (words := (word @ [' '])::!words; space_left := !space_left -. w -. width_of_string widths [' '])
else raise Exit;
chars := if rest = [] then [] else tl rest;
done;
return false
with
Exit -> return true
let layout lmargin rmargin papersize i =
let width =
Pdfunits.convert 72. (Pdfpaper.unit papersize) Pdfunits.PdfPoint (Pdfpaper.width papersize)
in
let o = ref [] in
let s = initial_state () in
let xpos_max = width -. lmargin in
s.xpos <- lmargin;
let rec layout_element = function
| Font (f, fontsize) ->
s.width_table <- font_widths f fontsize;
o := Font (f, fontsize) :: !o
| Text text ->
if text = "" then () else
begin
let this_line, needs_newline, remaining_text =
split_text (xpos_max -. s.xpos) s.width_table text
in
o := Text this_line :: !o;
s.xpos <- s.xpos +. width_of_string s.width_table (explode this_line);
if needs_newline then layout_element NewLine;
if remaining_text <> "" then layout_element (Text remaining_text)
end
| HGlue {glen} as glue ->
s.xpos <- s.xpos +. glen;
o := glue :: !o;
if s.xpos >= xpos_max then layout_element NewLine
| NewLine ->
s.xpos <- lmargin;
o := NewLine :: !o
| x ->
o := x :: !o
in
iter layout_element i;
rev !o
(* Resolve all hglue stretches, insert NewPage as needed. *)
let paginate tmargin bmargin papersize i = i
let make_resources fontobjnums =
Pdf.Dictionary
[("/Font", Pdf.Dictionary (map (fun fo -> ("/F" ^ string_of_int fo, Pdf.Indirect fo)) fontobjnums))]
(* At this stage, just Font and Text and HGlue 0. and VGlue 0. and Newline and
NewPage elements. Split on NewPages, typeset each page, add font
dictionaries. New page only
creates a page when that page has content. *)
let typeset lmargin rmargin tmargin bmargin papersize pdf i =
print_endline "***input:\n\n";
print_endline (to_string i);
let i = layout lmargin rmargin papersize i in
print_endline "***after layout:\n\n";
print_endline (to_string i);
let i = paginate tmargin bmargin papersize i in
print_endline "***after pagination:\n\n";
print_endline (to_string i);
let height = Pdfunits.convert 72. (Pdfpaper.unit papersize) Pdfunits.PdfPoint (Pdfpaper.height papersize) in
let s = initial_state () in
s.xpos <- lmargin;
s.ypos <- tmargin;
let ops = ref [] in
let fonts = ref [] in
let thispagefontnums = ref [] in
let pages = ref [] in
let write_page () =
if !ops <> [] then
let page =
{Pdfpage.content = [Pdfops.stream_of_ops (rev !ops)];
Pdfpage.mediabox = Pdfpage.rectangle_of_paper papersize;
Pdfpage.resources = make_resources !thispagefontnums;
Pdfpage.rotate = Pdfpage.Rotate0;
Pdfpage.rest = Pdf.Dictionary []}
in
pages := page :: !pages
in
let rec typeset_element = function
| Text cps ->
ops :=
Pdfops.Op_Q
::Pdfops.Op_ET
::Pdfops.Op_Tj cps
::Pdfops.Op_BT
::Pdfops.Op_cm (Pdftransform.mktranslate s.xpos (height -. s.ypos))
::Pdfops.Op_q
::!ops
(* If a destination, add the rectangle to the pile of rectangles for this annotation. *)
| Font (f, fontsize) ->
let name, objnum =
match List.assoc_opt f !fonts with
| Some objnum -> ("/F" ^ string_of_int objnum, objnum)
| None ->
let num = Pdftext.write_font pdf f in
let n = "/F" ^ string_of_int num in
fonts := (f, num) :: !fonts;
(n, num)
in
s.font <- Some f;
s.fontsize <- fontsize;
thispagefontnums := objnum :: !thispagefontnums;
ops := Pdfops.Op_Tf (name, fontsize)::!ops
| HGlue {glen} ->
s.xpos <- s.xpos +. glen
| VGlue {glen} ->
s.ypos <- s.ypos +. glen
| NewLine ->
s.xpos <- lmargin;
typeset_element (VGlue {glen = s.fontsize *. 1.3; gstretch = 0.})
| NewPage ->
write_page ();
thispagefontnums := [];
ops := [];
s.xpos <- lmargin;
s.ypos <- tmargin
| BeginDest dest ->
s.dest <- Some dest
| EndDest ->
(* Collect together the rectangles for this annotation, merge? and output *)
s.dest <- None
in
iter typeset_element i;
write_page ();
rev !pages
let example_pdf () =
let pdf = Pdf.empty () in
let pages = typeset 20. 20. 20. 20. Pdfpaper.a4 pdf example in
let pdf, pageroot = Pdfpage.add_pagetree pages pdf in
Pdfpage.add_root pageroot [] pdf
(*let _ =
Pdfwrite.pdf_to_file (example_pdf ()) "out.pdf"*)
Reference in New Issue View Git Blame Copy Permalink