First typesetting result

Changes

@@ -1,5 +1,6 @@
 2.5 (Upcoming 2022)
 
+o New operation -table-of-contents makes table of contents from bookmarks
 o When adding text or graphics, may choose CYMK or Grey instead of RGB
 o Append e.g DUP2 to a page range to make 1,2,3 --> 1,1,2,2,3,3 etc.
 o The -list-fonts operation now obeys the range

cpdftype.ml

@@ -1,6 +1,7 @@
 (* 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 *)
+open Pdfutil
 
 (* Text is represented as a list of unicode code points *)
 type text = int list
@@ -11,47 +12,148 @@ type glue =
    stretch : float}
 
 (* Main type *)
-type code =
+type element =
   Text of text
 | HGlue of glue
 | VGlue of glue
 | NewLine
 | NewPage
-| Font of Pdftext.font
+| Font of Pdftext.font * float
+
+let string_of_element = function
+  | Text t -> Pdftext.utf8_of_codepoints t
+  | HGlue _ -> "HGLUE"
+  | VGlue _ -> "VGLUE"
+  | NewLine -> "NewLine"
+  | NewPage -> "NewPage"
+  | Font _ -> "Font"
 
 let indent x = HGlue {glen = x; stretch = 0.}
-let newpara x = HGlue {glen = x; stretch = 0.}
+let newpara x = VGlue {glen = x; stretch = 0.}
 
-type t = code list
+type t = element list
 
 let of_utf8 = Pdftext.codepoints_of_utf8
 
 let example =
-  [Text (of_utf8 "Jackdaws love my Sphinx of Quartz. And this, this is the second sentence to provoke a line-break.");
+  [Font (Pdftext.StandardFont (Pdftext.TimesRoman, Pdftext.WinAnsiEncoding), 12.);
+   Text (of_utf8 "Jackdaws love my Sphinx of Quartz. And this, this is the second sentence to provoke a line-break.");
+   NewLine;
    newpara 10.;
    indent 72.;
    Text (of_utf8 "The second paragraph");
    NewPage]
 
-(* Typesetter state. Origin at top left of page *)
 type state =
-  {mutable font : Pdftext.font;
+  {mutable font : Pdftext.font option;
    mutable xpos : float;
    mutable ypos : float}
 
 let initial_state () =
-  {font = Pdftext.StandardFont (Pdftext.TimesRoman, Pdftext.WinAnsiEncoding);
+  {font = None;
    xpos = 0.;
    ypos = 0.}
 
 (* Split text into lines, resolve all hglue stretches to 0, remove Newlines. *)
+let layout_element s xpos_max fo = function
+  | _ -> ()
+
 let layout lmargin rmargin papersize i =
   i
+  (*let o = ref [] in
+  let s = initial_state () in
+  let xpos_max = Pdfpaper.width papersize -. lmargin in
+  s.xpos <- lmargin;
+  iter (layout_element s xpos_max (fun e -> o := e::!o)) i;
+  rev !o*)
 
 (* Resolve all hglue stretches, insert NewPage as needed. *)
 let paginate tmargin bmargin papersize i = i
 
-(* Split on NewPages, typeset each page, add font dictionaries *)
-let typeset papersize i =
-  [Pdfpage.blankpage papersize]
+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 =
+  let i = layout lmargin rmargin papersize i in
+  let i = paginate tmargin bmargin papersize i in
+  let height = Pdfpaper.height papersize -. tmargin in
+  let s = initial_state () in
+  s.xpos <- lmargin;
+  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
+        Printf.printf "Writing a page\n";
+        pages := page :: !pages
+  in
+  let typeset_element = function
+    | Text cps ->
+        let charcodestring =
+          match s.font with
+          | None -> failwith "font not set up"
+          | Some f ->
+              match List.assoc_opt f !fonts with
+              | Some objnum ->
+                  let extractor =
+                    Pdftext.charcode_extractor_of_font pdf (Pdf.lookup_obj pdf objnum)
+                  in
+                    implode (map char_of_int (option_map extractor cps))
+              | None -> failwith "font not found"
+        in
+          ops :=
+            Pdfops.Op_ET
+            ::Pdfops.Op_Tj charcodestring
+            ::Pdfops.Op_BT
+            ::Pdfops.Op_cm (Pdftransform.mktranslate s.xpos (height -. s.ypos))
+            ::!ops
+    | 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;
+          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 <- 0. 
+    | NewPage ->
+        write_page ();
+        ops := [];
+        s.xpos <- 0.;
+        s.ypos <- 0.
+  in
+    iter typeset_element i;
+    write_page ();
+    rev !pages
+
+let example_pdf () =
+  let pdf = Pdf.empty () in
+  let pages = typeset 50. 50. 50. 50. 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"

cpdftype.mli

@@ -4,14 +4,14 @@ type glue =
   {glen : float;
    stretch : float}
 
-type code =
+type element =
   Text of text
 | HGlue of glue
 | VGlue of glue
 | NewLine
 | NewPage
-| Font of Pdftext.font
+| Font of Pdftext.font * float
 
-type t = code list
+type t = element list
 
-val typeset : Pdfpaper.t -> t -> Pdfpage.t list
+val typeset : float -> float -> float -> float -> Pdfpaper.t -> Pdf.t -> t -> Pdfpage.t list