pdf_out.adb

with PDF_Out.Fonts,
     PDF_Out.Images;

with GID;

with Ada.Characters.Conversions,
     Ada.Characters.Handling,
     Ada.Strings.Fixed,
     Ada.Unchecked_Deallocation;

with Interfaces;

package body PDF_Out is

  use Ada.Streams.Stream_IO, Ada.Streams;
  use Interfaces;

  package CIO is new Ada.Text_IO.Integer_IO (Ada.Streams.Stream_IO.Count);

  --  Very low level part which deals with transferring data endian-proof,
  --  and floats in the IEEE format. This is needed for having PDF Writer
  --  totally portable on all systems and processor architectures.

  type Byte_buffer is array (Integer range <>) of Unsigned_8;

  --  Put numbers with correct endianess as bytes:
  generic
    type Number is mod <>;
    size : Positive;
  function Intel_x86_buffer (n : Number) return Byte_buffer;
  pragma Inline (Intel_x86_buffer);

  function Intel_x86_buffer (n : Number) return Byte_buffer is
    b : Byte_buffer (1 .. size);
    m : Number := n;
  begin
    for i in b'Range loop
      b (i) := Unsigned_8 (m and 255);
      m := m / 256;
    end loop;
    return b;
  end Intel_x86_buffer;

  function Intel_32 is new Intel_x86_buffer (Unsigned_32, 4);
  pragma Unreferenced (Intel_32);

  function Intel_16 (n : Unsigned_16) return Byte_buffer is
    pragma Inline (Intel_16);
  begin
    return (Unsigned_8 (n and 255), Unsigned_8 (Shift_Right (n, 8)));
  end Intel_16;
  pragma Unreferenced (Intel_16);

  --  Workaround for the severe xxx'Read xxx'Write performance
  --  problems in the GNAT and ObjectAda compilers (as in 2009)
  --  This is possible if and only if Byte = Stream_Element and
  --  arrays types are both packed and aligned the same way.
  --
  subtype Size_test_a is Byte_buffer (1 .. 19);
  subtype Size_test_b is Ada.Streams.Stream_Element_Array (1 .. 19);
  workaround_possible : constant Boolean :=
    Size_test_a'Size = Size_test_b'Size and
    Size_test_a'Alignment = Size_test_b'Alignment;

  procedure Block_Read
    (file          : in     Ada.Streams.Stream_IO.File_Type;
     buffer        :    out Byte_buffer;
     actually_read :    out Natural)
  is
    SE_Buffer   : Stream_Element_Array (1 .. buffer'Length);
    for SE_Buffer'Address use buffer'Address;
    pragma Import (Ada, SE_Buffer);
    Last_Read   : Stream_Element_Offset;
  begin
    if workaround_possible then
      Read (Stream (file).all, SE_Buffer, Last_Read);
      actually_read := Natural (Last_Read);
    else
      if End_Of_File (file) then
        actually_read := 0;
      else
        actually_read :=
          Integer'Min (buffer'Length, Integer (Size (file) - Index (file) + 1));
        Byte_buffer'Read (
          Stream (file),
          buffer (buffer'First .. buffer'First + actually_read - 1)
        );
      end if;
    end if;
  end Block_Read;

  procedure Block_Write
    (stream : in out Ada.Streams.Root_Stream_Type'Class;
     buffer : in     Byte_buffer)
  is
    pragma Inline (Block_Write);
    SE_Buffer   : Stream_Element_Array (1 .. buffer'Length);
    for SE_Buffer'Address use buffer'Address;
    pragma Import (Ada, SE_Buffer);
  begin
    if workaround_possible then
      Ada.Streams.Write (stream, SE_Buffer);
    else
      Byte_buffer'Write (stream'Access, buffer);
      --  ^ This was 30x to 70x slower on GNAT 2009
      --    Test in the Zip-Ada project.
    end if;
  end Block_Write;

  --  Copy a whole file into a stream, using a temporary buffer
  procedure Copy_File
    (file_name   :        String;
     into        : in out Ada.Streams.Root_Stream_Type'Class;
     buffer_size :        Positive := 1024 * 1024)
  is
    f : File_Type;
    buf : Byte_buffer (1 .. buffer_size);
    actually_read : Natural;
  begin
    Open (f, In_File, file_name);
    loop
      Block_Read (f, buf, actually_read);
      exit when actually_read = 0;  --  this is expected
      Block_Write (into, buf (1 .. actually_read));
    end loop;
    Close (f);
  end Copy_File;

  procedure W (pdf : in out PDF_Out_Stream'Class; s : String) is
  pragma Inline (W);
  begin
    String'Write (pdf.pdf_stream, s);
  end W;

  NL : constant Character := ASCII.LF;

  procedure WL (pdf : in out PDF_Out_Stream'Class; s : String) is
  begin
    W (pdf, s & NL);
  end WL;

  procedure No_Nowhere (pdf : in out PDF_Out_Stream'Class) is
  begin
    if pdf.zone = nowhere then
      New_Page (pdf);
    end if;
  end No_Nowhere;

  --  Delayed output, for internal PDF's "stream" object

  procedure Write_delayed (pdf : in out PDF_Out_Stream'Class; s : String) is
  pragma Inline (Write_delayed);
  begin
    No_Nowhere (pdf);
    Append (pdf.stream_obj_buf, s);
  end Write_delayed;

  procedure WLd (pdf : in out PDF_Out_Stream'Class; s : String) is
  pragma Inline (WLd);
  begin
    Write_delayed (pdf, s & NL);
  end WLd;

  procedure Begin_Text (pdf : in out PDF_Out_Stream'Class) is
  begin
    WLd (pdf,  "  BT");  --  Begin Text object (9.4.1, Table 107)
  end Begin_Text;

  procedure End_Text (pdf : in out PDF_Out_Stream'Class) is
  begin
    WLd (pdf,  "  ET");
  end End_Text;

  procedure Flip_To (pdf : in out PDF_Out_Stream'Class; new_state : Text_or_graphics) is
  begin
    No_Nowhere (pdf);
    --  WLd(pdf,  " % Text_or_graphics before: " & pdf.text_switch'Image);
    if pdf.text_switch /= new_state then
      pdf.text_switch := new_state;
      case new_state is
        when text     => Begin_Text (pdf);
        when graphics => End_Text (pdf);
      end case;
    end if;
    --  WLd(pdf,  " % Text_or_graphics after: " & pdf.text_switch'Image);
  end Flip_To;

  -----------------------------
  --  Direct code insertion  --
  -----------------------------

  procedure Insert_PDF_Code (pdf : in out PDF_Out_Stream; code : String) is
  begin
    WLd (pdf, "    " & code);  --  Indentation is just cosmetic...
  end Insert_PDF_Code;

  procedure Insert_Text_PDF_Code (pdf : in out PDF_Out_Stream; code : String) is
  begin
    Flip_To (pdf, text);
    Insert_PDF_Code (pdf, code);
  end Insert_Text_PDF_Code;

  procedure Insert_Graphics_PDF_Code (pdf : in out PDF_Out_Stream; code : String) is
  begin
    Flip_To (pdf, graphics);
    Insert_PDF_Code (pdf, code);
  end Insert_Graphics_PDF_Code;

  --  External stream index

  function Buffer_index (pdf : PDF_Out_Stream'Class) return Ada.Streams.Stream_IO.Count is
  begin
    return Index (pdf) - pdf.start_index;
  end Buffer_index;

  function Img (p : Integer) return String is
    s : constant String := Integer'Image (p);
  begin
    if p < 0 then
      return s;
    else
      return s (s'First + 1 .. s'Last); -- Skip the *%"%! front space
    end if;
  end Img;

  function Img (p : PDF_Index_Type) return String is
    s : constant String := PDF_Index_Type'Image (p);
  begin
    if p < 0 then
      return s;
    else
      return s (s'First + 1 .. s'Last); -- Skip the *%"%! front space
    end if;
  end Img;

  package RIO is new Ada.Text_IO.Float_IO (Real);

  --  Compact real number image, taken from TeXCAD (TeX_Number in tc.adb)
  --
  function Img (x : Real; prec : Positive := Real'Digits) return String is
    s : String (1 .. 20 + prec);
    na, nb, np : Natural;
  begin
    RIO.Put (s, x, prec, 0);
    na := s'First;
    nb := s'Last;
    np := 0;
    for i in s'Range loop
      case s (i) is
        when '.' => np := i; exit;  --   Find a decimal point
        when ' ' => na := i + 1;      -- * Trim spaces on left
        when others => null;
      end case;
    end loop;
    if np > 0 then
      while nb > np and then s (nb) = '0' loop
        nb := nb - 1;                 -- * Remove extra '0's
      end loop;
      if nb = np then
        nb := nb - 1;                 -- * Remove '.' if it is at the end
      elsif s (na .. np - 1) = "-0" then
        na := na + 1;
        s (na) := '-';               -- * Reduce "-0.x" to "-.x"
      elsif s (na .. np - 1) = "0" then
        na := na + 1;                 -- * Reduce "0.x" to ".x"
      end if;
    end if;
    return s (na .. nb);
  end Img;

  function "+"(P1, P2 : Point) return Point is
  begin
    return (P1.x + P2.x, P1.y + P2.y);
  end "+";

  function "*"(f : Real; P : Point) return Point is
  begin
    return (f * P.x, f * P.y);
  end "*";

  function "+"(P : Point; r : Rectangle) return Rectangle is
  begin
    return (P.x + r.x_min, P.y + r.y_min, r.width, r.height);
  end "+";

  function "*"(f : Real; r : Rectangle) return Rectangle is
  begin
    return (r.x_min, r.y_min, f * r.width, f * r.height);
  end "*";

  function X_Max (r : Rectangle) return Real is
  begin
    return r.x_min + r.width;
  end X_Max;

  function Y_Max (r : Rectangle) return Real is
  begin
    return r.y_min + r.height;
  end Y_Max;

  type Abs_Rel_Mode is (absolute, relative);

  function Img (p : Point) return String is
  begin
    return Img (p.x) & ' ' & Img (p.y);
  end Img;

  function Img (box : Rectangle; mode : Abs_Rel_Mode) return String is
  begin
    case mode is
      when absolute =>
        return Img (box.x_min) & ' ' & Img (box.y_min) & ' ' &
               Img (X_Max (box)) & ' ' & Img (Y_Max (box)) & ' ';
      when relative =>
        return Img (box.x_min) & ' ' & Img (box.y_min) & ' ' &
               Img (box.width) & ' ' & Img (box.height) & ' ';
    end case;
  end Img;

  procedure Dispose is new Ada.Unchecked_Deallocation (Offset_table, p_Offset_table);

  procedure New_fixed_index_object (pdf : in out PDF_Out_Stream'Class; idx : PDF_Index_Type) is
    new_table : p_Offset_table;
  begin
    if pdf.object_offset = null then
      pdf.object_offset := new Offset_table (1 .. idx);
    elsif pdf.object_offset'Last < idx then
      new_table := new Offset_table (1 .. idx * 2);
      new_table (1 .. pdf.object_offset'Last) := pdf.object_offset.all;
      Dispose (pdf.object_offset);
      pdf.object_offset := new_table;
    end if;
    pdf.object_offset (idx) := Buffer_index (pdf);
    WL (pdf, Img (idx) & " 0 obj");
  end New_fixed_index_object;

  procedure New_object (pdf : in out PDF_Out_Stream'Class) is
  begin
    pdf.objects := pdf.objects + 1;
    New_fixed_index_object (pdf, pdf.objects);
  end New_object;

  producer : constant String :=
    "Ada PDF Writer " & version & ", ref: " & reference & ", " & web &
    " , using GID (Generic Image Decoder) version " & GID.version;

  procedure Write_PDF_header (pdf : in out PDF_Out_Stream'Class) is
  begin
    pdf.is_created := True;
    pdf.start_index := Index (pdf);
    case pdf.format is
      when PDF_1_3 =>
        WL (pdf, "%PDF-1.3");
        Byte_buffer'Write (pdf.pdf_stream, (16#25#, 16#C2#, 16#A5#, 16#C2#, 16#B1#, 16#C3#, 16#AB#, 10));
    end case;
    WL (pdf, "%  --  Produced by " & producer);
  end Write_PDF_header;

  procedure New_substream (pdf : in out PDF_Out_Stream'Class) is
  begin
    pdf.stream_obj_buf := Null_Unbounded_String;
  end New_substream;

  procedure Finish_substream (pdf : in out PDF_Out_Stream'Class) is
  begin
    WL (pdf, "  << /Length" & Integer'Image (Length (pdf.stream_obj_buf)) & " >>");
    --  Length could be alternatively stored in next object,
    --  so we wouldn't need to buffer the stream - see 7.3.10, Example 3.
    --  But we prefer the buffered version, which could be compressed in a future version
    --  of this package.
    WL (pdf, "stream");
    WL (pdf, To_String (pdf.stream_obj_buf));
    WL (pdf, "endstream");
  end Finish_substream;

  --  Internal - test page for experimenting PDF constructs (and how Adobe Reader reacts to them)
  --
  procedure Test_Page (pdf : in out PDF_Out_Stream'Class) is
  begin
    WLd (pdf, "10 10 200 200 re S"); -- rectangle, stroke
    WLd (pdf, "  BT");            --  Begin Text object (9.4). Text matrix and text line matrix:= I
    WLd (pdf, "    /Ada_PDF_Std_Font_Helvetica 24 Tf");   --  F1 font, 24 pt size (9.3 Text State Parameters and Operators)
    WLd (pdf, "    0.5 0 0 rg");  --  red, nonstroking colour (Table 74)
    WLd (pdf, "    0.25 G");     --  25% gray stroking colour (Table 74)
    WLd (pdf, "    2 Tr");        --  Tr: Set rendering mode as "Fill, then stroke text" (Table 106)
    WLd (pdf, "    20 539 Td");
    WLd (pdf, "    (Hello World !) Tj"); -- Tj: Show a text string (9.4.3 Text-Showing Operators)
    WLd (pdf, "    16 TL");       --  TL: set text leading (distance between lines, 9.3.5)
    WLd (pdf, "    T*");          --  T*: Move to the start of the next line (9.4.2)
    WLd (pdf, "    20 20 200 200 re S"); -- rectangle, stroke (within text region)
    WLd (pdf, "    /Ada_PDF_Std_Font_Helvetica-Oblique 12 Tf");
    WLd (pdf, "    0 Tr");        --  Tr: Set rendering mode as default: "Fill text" (Table 106)
    WLd (pdf, "    0 g");         --  black (default)
    WLd (pdf, "    (Subtitle here.) Tj T*");
    WLd (pdf, "  ET");           --  End Text
    WLd (pdf, "30 30 200 200 re S"); -- rectangle, stroke
    WLd (pdf, "  BT");
    WLd (pdf, "    5 5 Td (Second text chunk here.) Tj T*");
    WLd (pdf, "  ET");
    WLd (pdf, "40 40 240 240 re S"); -- rectangle, stroke
    WLd (pdf, "15 15 Td (Text chunk not within BT/ET.) Tj");
  end Test_Page;

  test_page_mode : constant Boolean := False;

  procedure Insert_PDF_Font_Selection_Code (pdf : in out PDF_Out_Stream) is
  begin
    Insert_Text_PDF_Code (pdf,
      PDF_Out.Fonts.Current_Font_Dictionary_Name (pdf) &
      ' ' & Img (pdf.font_size) & " Tf " &  --  Tf: 9.3 Text State Parameters and Operators
      Img (pdf.font_size * pdf.line_spacing) & " TL"  --  TL: set text leading (9.3.5)
    );
  end Insert_PDF_Font_Selection_Code;

  procedure Font (pdf : in out PDF_Out_Stream; f : Standard_Font_Type) is
  begin
    pdf.current_font := f;
    Insert_PDF_Font_Selection_Code (pdf);
  end Font;

  procedure Font_Size (pdf : in out PDF_Out_Stream; size : Real) is
  begin
    pdf.font_size := size;
    Insert_PDF_Font_Selection_Code (pdf);
  end Font_Size;

  procedure Line_Spacing (pdf : in out PDF_Out_Stream; factor : Real) is
  begin
    pdf.line_spacing := factor;
    Insert_PDF_Font_Selection_Code (pdf);
  end Line_Spacing;

  procedure Line_Spacing_Pt (pdf : in out PDF_Out_Stream; pt : Real) is
  begin
    pdf.line_spacing := pt / pdf.font_size;
    --  !! This assumes that the font size is in Point (pt) units.
    Insert_PDF_Font_Selection_Code (pdf);
  end Line_Spacing_Pt;

  procedure Dispose is new Ada.Unchecked_Deallocation (Page_table, p_Page_table);

  procedure New_Page (pdf : in out PDF_Out_Stream) is
    new_table : p_Page_table;
  begin
    if pdf.zone /= nowhere then
      Finish_Page (pdf);
    end if;
    pdf.last_page := pdf.last_page + 1;
    pdf.current_line := 1;
    pdf.current_col := 1;
    PDF_Out.Images.Clear_local_resource_flags (pdf);
    --
    --  Page descriptor object:
    --
    New_object (pdf);
    if pdf.page_idx = null then
      pdf.page_idx := new Page_table (1 .. pdf.last_page);
    elsif pdf.page_idx'Last < pdf.last_page then
      new_table := new Page_table (1 .. pdf.last_page * 2);
      new_table (1 .. pdf.page_idx'Last) := pdf.page_idx.all;
      Dispose (pdf.page_idx);
      pdf.page_idx := new_table;
    end if;
    pdf.page_idx (pdf.last_page) := pdf.objects;
    --  Table 30 (7.7.3.3 Page Objects) for options
    WL (pdf, "  <</Type /Page");
    WL (pdf, "    /Parent " & Img (pages_idx) & " 0 R");
    --  Contents stream object is object number n+1 (our choice):
    WL (pdf, "    /Contents " & Img (pdf.objects + 1) & " 0 R");
    --  Resources: a dictionary containing any resources required by the page.
    --  Resources object is object number n+2 (our choice):
    WL (pdf, "    /Resources " & Img (pdf.objects + 2) & " 0 R");
    WL (pdf, "    /MediaBox [" & Img (pdf.page_box, absolute) & ']');
    WL (pdf, "  >>");
    WL (pdf, "endobj");
    --  Page contents object:
    --
    New_object (pdf);
    New_substream (pdf);
    if test_page_mode then
      Test_Page (pdf);
    else
      pdf.zone := in_page;
      Insert_PDF_Font_Selection_Code (pdf);
      pdf.zone := in_header;
      --  PDF_Out_Stream'Class: make the call to Page_Header dispatching
      Page_Header (PDF_Out_Stream'Class (pdf));
    end if;
    pdf.zone := in_page;
    Text_XY (pdf, pdf.page_margins.left, Y_Max (pdf.page_box) - pdf.page_margins.top);
  end New_Page;

  procedure Finish_Page (pdf : in out PDF_Out_Stream) is

    appended_object_idx : PDF_Index_Type;

    procedure Image_Item (dn : in out Dir_node) is
      img_obj : PDF_Index_Type;
    begin
      if dn.local_resource then
        if dn.pdf_object_index = 0 then
          img_obj := appended_object_idx;
          appended_object_idx := appended_object_idx + 1;
        else
          img_obj := dn.pdf_object_index;  --  image has been loaded for a previous page
        end if;
        WL (pdf, Image_name (dn.image_index) & ' ' & Img (img_obj) & " 0 R");
      end if;
    end Image_Item;

    procedure Image_List is new PDF_Out.Images.Traverse_private (Image_Item);

  begin
    if pdf.zone = nowhere then
      return;  --  We are already "between pages"
    end if;
    if test_page_mode then
      null;  --  Nothing to do anymore with test page
    else
      pdf.zone := in_footer;
      --  PDF_Out_Stream'Class: make the call to Page_Header dispatching
      Page_Footer (PDF_Out_Stream'Class (pdf));
      Flip_To (pdf, graphics);
    end if;
    pdf.zone := nowhere;
    Finish_substream (pdf);
    WL (pdf, "endobj");  --  end of page contents.
    --  Resources Dictionary (7.8.3) for the page just finished:
    New_object (pdf);
    WL (pdf, "<<");
    --  Font resources:
    PDF_Out.Fonts.Font_Dictionary (pdf);
    appended_object_idx := pdf.objects + 1;  --  Images contents to be appended after this object
    --  Image resources:
    WL (pdf, "  /XObject <<");
    Image_List (pdf);
    WL (pdf, "  >>");
    WL (pdf, ">>");
    WL (pdf, "endobj");  --  end of Resources
    PDF_Out.Images.Insert_unloaded_local_images (pdf);
  end Finish_Page;

  procedure Put (pdf  : in out PDF_Out_Stream;
                 num  : in Real;
                 fore : in Ada.Text_IO.Field := Real_IO.Default_Fore;
                 aft  : in Ada.Text_IO.Field := Real_IO.Default_Aft;
                 exp  : in Ada.Text_IO.Field := Real_IO.Default_Exp)
  is
  begin
    if exp = 0 then
      declare
        s : String (1 .. fore + 1 + aft);  --  "  123.45"
      begin
        Real_IO.Put (s, num, aft, exp);
        Put (pdf, s);
      end;
    else
      declare
        s : String (1 .. fore + 1 + aft + 1 + exp);  --  "  1.234E-01"
      begin
        Real_IO.Put (s, num, aft, exp);
        Put (pdf, s);
      end;
    end if;
  end Put;

  procedure Put (pdf   : in out PDF_Out_Stream;
                 num   : in Integer;
                 width : in Ada.Text_IO.Field       := 0;  --  ignored
                 base  : in Ada.Text_IO.Number_Base := 10)
  is
  begin
    if base = 10 then
      Put (pdf, Img (num));
    else
      declare
        use Ada.Strings.Fixed;
        s : String (1 .. 50 + 0 * width);
        --  "0*width" is just to skip a warning about width being unused
        package IIO is new Ada.Text_IO.Integer_IO (Integer);
      begin
        IIO.Put (s, num, Base => base);
        Put (pdf, Trim (s, Ada.Strings.Left));
      end;
    end if;
  end Put;

  procedure Show_Text_String (pdf : in out PDF_Out_Stream; str : String) is
  --  9.4.3 Text-Showing Operators; table 109.
  begin
    if str'Length > 0 then
      Insert_Text_PDF_Code (pdf, '(' & str & ") Tj");
    end if;
  end Show_Text_String;

  procedure Put (pdf : in out PDF_Out_Stream; str : String) is
  begin
    if test_page_mode then
      null;  --  Nothing to do (test page instead)
    else
      for i in str'Range loop
        --  We scan the string for special characters:
        case str (i) is
          when ASCII.NUL .. ASCII.HT |
               ASCII.VT .. ASCII.US =>
            --  Skip special character.
            Show_Text_String (pdf, str (str'First .. i - 1));
            Put (pdf, str (i + 1 .. str'Last));
            return;
          when ASCII.LF =>
            --  Line Feed character: display string on two or more lines.
            Show_Text_String (pdf, str (str'First .. i - 1));
            New_Line (pdf);
            Put (pdf, str (i + 1 .. str'Last));
            return;
          when '(' | ')' | '\' =>
            --  Insert a Reverse Solidus (backslash, '\') for an escape
            --  sequence. See full list in: 7.3.4.2 Literal Strings; table 3.
            Show_Text_String (pdf, str (str'First .. i - 1) & '\' & str (i));
            Put (pdf, str (i + 1 .. str'Last));
            return;
          when others =>
            null;
        end case;
      end loop;
      Show_Text_String (pdf, str);
    end if;
  end Put;

  procedure Put (pdf : in out PDF_Out_Stream; str : Unbounded_String) is
  begin
    Put (pdf, To_String (str));
  end Put;

  procedure Put_Line (pdf  : in out PDF_Out_Stream;
                      num  : in Real;
                      fore : in Ada.Text_IO.Field := Real_IO.Default_Fore;
                      aft  : in Ada.Text_IO.Field := Real_IO.Default_Aft;
                      exp  : in Ada.Text_IO.Field := Real_IO.Default_Exp)
  is
  begin
    Put (pdf, num, fore, aft, exp);
    New_Line (pdf);
  end Put_Line;

  procedure Put_Line (pdf   : in out PDF_Out_Stream;
                      num   : in Integer;
                      width : in Ada.Text_IO.Field := 0;  --  ignored
                      base  : in Ada.Text_IO.Number_Base := 10)
  is
  begin
    Put (pdf, num, width, base);
    New_Line (pdf);
  end Put_Line;

  procedure Put_Line (pdf : in out PDF_Out_Stream; str : String) is
  begin
    Put (pdf, str);
    New_Line (pdf);
  end Put_Line;

  procedure Put_Line (pdf : in out PDF_Out_Stream; str : Unbounded_String) is
  begin
    Put_Line (pdf, To_String (str));
  end Put_Line;

  procedure New_Line (pdf : in out PDF_Out_Stream; Spacing : Positive := 1) is
  begin
    pdf.current_line := pdf.current_line + 1;
    pdf.current_col := 1;
    if test_page_mode then
      null;  --  Nothing to do (test page instead)
    else
      for i in 1 .. Spacing loop
        Insert_Text_PDF_Code (pdf, "T*");
      end loop;
    end if;
  end New_Line;

  procedure Put_WS
    (pdf : in out PDF_Out_Stream; w_str : Wide_String) is
    use Ada.Characters.Conversions;
  begin
     Put (pdf, To_String (w_str));
  end Put_WS;

  procedure Put_Line_WS
    (pdf : in out PDF_Out_Stream; w_str : Wide_String)
  is
    use Ada.Characters.Conversions;
  begin
    Put_Line (pdf, To_String (w_str));
  end Put_Line_WS;

  procedure Put_Line_WS
     (pdf   : in out PDF_Out_Stream;
      w_str :        Ada.Strings.Wide_Unbounded.Unbounded_Wide_String)
  is
    use Ada.Characters.Conversions, Ada.Strings.Wide_Unbounded;
  begin
     Put_Line (pdf, To_String (To_Wide_String (w_str)));
  end Put_Line_WS;

  procedure Put_WWS
    (pdf : in out PDF_Out_Stream; ww_str : Wide_Wide_String) is
    use Ada.Characters.Conversions;
  begin
     Put (pdf, To_String (ww_str));
  end Put_WWS;

  procedure Put_Line_WWS
    (pdf : in out PDF_Out_Stream; ww_str : Wide_Wide_String)
  is
    use Ada.Characters.Conversions;
  begin
    Put_Line (pdf, To_String (ww_str));
  end Put_Line_WWS;

  procedure Put_Line_WWS
     (pdf    : in out PDF_Out_Stream;
      ww_str :        Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String)
  is
    use Ada.Characters.Conversions, Ada.Strings.Wide_Wide_Unbounded;
  begin
     Put_Line (pdf, To_String (To_Wide_Wide_String (ww_str)));
  end Put_Line_WWS;

  procedure Text_XY (pdf : in out PDF_Out_Stream; x, y : Real) is
  begin
    Flip_To (pdf, text);
    --  The following explicit End_text, Begin_text are just
    --  for resetting the text matrices (hence, position and orientation).
    End_Text (pdf);
    Begin_Text (pdf);
    Insert_PDF_Code (pdf, Img (x) & ' ' & Img (y) & " Td");  --  Td: 9.4.2 Text-Positioning Operators
    pdf.current_line := 1;
    pdf.current_col := 1;
  end Text_XY;

  procedure Put_XY (pdf : in out PDF_Out_Stream; x, y : Real; str : String) is
  begin
    Text_XY (pdf, x, y);
    Put (pdf, str);
  end Put_XY;

  function Col (pdf : in PDF_Out_Stream) return Positive is
  begin
    return pdf.current_col;
  end Col;

  function Line (pdf : in PDF_Out_Stream) return Positive is
  begin
    return pdf.current_line;
  end Line;

  function Page (pdf : in PDF_Out_Stream) return Natural is
  begin
    return Natural (pdf.last_page);  --  Issue if Integer is 16-bit and last_page > 2**15-1
  end Page;

  procedure Color (pdf : in out PDF_Out_Stream; c : Color_Type) is
  begin
    Insert_PDF_Code (pdf, Img (c.red) & ' ' & Img (c.green) & ' ' & Img (c.blue) & " rg");
    --  rg = nonstroking colour (Table 74)
  end Color;

  procedure Stroking_Color (pdf : in out PDF_Out_Stream; c : Color_Type) is
  begin
    Insert_PDF_Code (pdf, Img (c.red) & ' ' & Img (c.green) & ' ' & Img (c.blue) & " RG");
    --  RG = nonstroking colour (Table 74)
  end Stroking_Color;

  procedure Text_Rendering_Mode (pdf : in out PDF_Out_Stream; r : Rendering_Mode) is
  begin
    Insert_Text_PDF_Code (pdf, Img (Integer (Rendering_Mode'Pos (r))) & " Tr");
    --  Tr = Set rendering mode (Table 106)
  end Text_Rendering_Mode;

  function Image_name (i : Positive) return String is
  begin
    return "/Ada_PDF_Img" & Img (i);
  end Image_name;

  procedure Image (pdf : in out PDF_Out_Stream; file_name : String; target : Rectangle) is
    image_index : Positive;  --  Index in the list of images
  begin
    No_Nowhere (pdf);
    PDF_Out.Images.Image_ref (pdf, file_name, image_index);
    Insert_Graphics_PDF_Code (pdf, "q " &
      Img (target.width) & " 0 0 " & Img (target.height) &
      ' ' & Img (target.x_min) & ' ' & Img (target.y_min) & " cm " &  --  cm: Table 57
      Image_name (image_index) & " Do Q"
    );
  end Image;

  function Get_pixel_dimensions (image_file_name : String) return Rectangle is
  begin
    return PDF_Out.Images.Get_pixel_dimensions (image_file_name);
  end Get_pixel_dimensions;

  -----------------------
  --  Vector graphics  --
  -----------------------

  procedure Line_Width (pdf : in out PDF_Out_Stream; width : Real) is
  begin
    Insert_Graphics_PDF_Code (pdf, Img (width) & " w");
  end Line_Width;

  procedure Single_Line (pdf : in out PDF_Out_Stream; from, to : Point) is
  begin
    Insert_Graphics_PDF_Code (pdf,
      Img (from.x) & ' ' & Img (from.y) & " m " &
      Img (to.x) & ' ' & Img (to.y) & " l s"
    );
  end Single_Line;

  --    Table 59 - Path Construction Operators (8.5.2)
  --    Table 60 - Path-Painting Operators (8.5.3.1)

  inside_path_rule_char : constant array (Inside_path_rule) of Character := (
    nonzero_winding_number => ' ',
    even_odd               => '*'
  );

  path_drawing_operator : constant array (Path_Rendering_Mode) of Character := (
    fill             => 'F',
    stroke           => 'S',
    fill_then_stroke => 'B'
  );

  procedure Draw (pdf : in out PDF_Out_Stream; what : Rectangle; rendering : Path_Rendering_Mode) is
  begin
    Insert_Graphics_PDF_Code (pdf, Img (what, relative) & " re " & path_drawing_operator (rendering));
  end Draw;

  procedure Move (pdf : in out PDF_Out_Stream; to : Point) is
  begin
    Insert_Graphics_PDF_Code (pdf, Img (to) & " m");  --  m operator (Table 59)
  end Move;

  procedure Line (pdf : in out PDF_Out_Stream; to : Point) is
  begin
    Insert_Graphics_PDF_Code (pdf, Img (to) & " l");
  end Line;

  procedure Cubic_Bezier (pdf : in out PDF_Out_Stream; control_1, control_2 : Point; to : Point) is
  begin
    Insert_Graphics_PDF_Code (
      pdf,
      Img (control_1) & ' ' &
      Img (control_2) & ' ' &
      Img (to) & " c"
    );
  end Cubic_Bezier;

  procedure Finish_Path (
    pdf        : in out PDF_Out_Stream;
    close_path :        Boolean;
    rendering  :        Path_Rendering_Mode;  --  fill, stroke, or both
    rule       :        Inside_path_rule
  )
  is
    cmd : String := path_drawing_operator (rendering) & inside_path_rule_char (rule);
  begin
    if close_path then
      cmd := Ada.Characters.Handling.To_Lower (cmd);
    end if;
    --  Insert the s, S, f, f*, b, b*, B, B* of Table 60 - Path-Painting Operators (8.5.3.1)
    if cmd = "s*" or cmd = "S*" or cmd = "F " or cmd = "F*" then
      Insert_Graphics_PDF_Code (pdf, "n");  --  End the path object without filling or stroking it.
    else
      Insert_Graphics_PDF_Code (pdf, cmd);
    end if;
  end Finish_Path;

  --  Table 317 - Entries in the document information dictionary (14.3.3)

  procedure Title (pdf : in out PDF_Out_Stream; s : String) is
  begin
    pdf.doc_title := To_Unbounded_String (s);
  end Title;

  procedure Author (pdf : in out PDF_Out_Stream; s : String) is
  begin
    pdf.doc_author := To_Unbounded_String (s);
  end Author;

  procedure Subject (pdf : in out PDF_Out_Stream; s : String) is
  begin
    pdf.doc_subject := To_Unbounded_String (s);
  end Subject;

  procedure Keywords (pdf : in out PDF_Out_Stream; s : String) is
  begin
    pdf.doc_keywords := To_Unbounded_String (s);
  end Keywords;

  procedure Creator_Application (pdf : in out PDF_Out_Stream; s : String) is
  begin
    pdf.doc_creator := To_Unbounded_String (s);
  end Creator_Application;

  procedure Page_Header (pdf : in out PDF_Out_Stream) is
  begin
    null;  --  Default header is empty.
  end Page_Header;

  procedure Page_Footer (pdf : in out PDF_Out_Stream) is
  begin
    null;  --  Default footer is empty.
  end Page_Footer;

  procedure Left_Margin (pdf : out PDF_Out_Stream; pts : Real) is
  begin
    pdf.page_margins.left := pts;
  end Left_Margin;

  function Left_Margin (pdf : PDF_Out_Stream) return Real is
  begin
    return pdf.page_margins.left;
  end Left_Margin;

  procedure Right_Margin (pdf : out PDF_Out_Stream; pts : Real) is
  begin
    pdf.page_margins.right := pts;
  end Right_Margin;

  function Right_Margin (pdf : PDF_Out_Stream) return Real is
  begin
    return pdf.page_margins.right;
  end Right_Margin;

  procedure Top_Margin (pdf : out PDF_Out_Stream; pts : Real) is
  begin
    pdf.page_margins.top := pts;
  end Top_Margin;

  function Top_Margin (pdf : PDF_Out_Stream) return Real is
  begin
    return pdf.page_margins.top;
  end Top_Margin;

  procedure Bottom_Margin (pdf : out PDF_Out_Stream; pts : Real) is
  begin
    pdf.page_margins.bottom := pts;
  end Bottom_Margin;

  function Bottom_Margin (pdf : PDF_Out_Stream) return Real is
  begin
    return pdf.page_margins.bottom;
  end Bottom_Margin;

  procedure Margins (pdf : out PDF_Out_Stream; new_margins : Margins_Type) is
  begin
    pdf.page_margins := new_margins;
  end Margins;

  function Margins (pdf : PDF_Out_Stream) return Margins_Type is
  begin
    return pdf.page_margins;
  end Margins;

  procedure Page_Setup (pdf : in out PDF_Out_Stream; layout : Rectangle) is
    mb_x_min, mb_y_min, mb_x_max, mb_y_max : Real;
  begin
    pdf.page_box := layout;
    mb_x_min := Real'Min (pdf.maximum_box.x_min, layout.x_min);
    mb_y_min := Real'Min (pdf.maximum_box.y_min, layout.y_min);
    mb_x_max := Real'Max (X_Max (pdf.maximum_box), X_Max (layout));
    mb_y_max := Real'Max (Y_Max (pdf.maximum_box), Y_Max (layout));
    pdf.maximum_box :=
      (x_min  => mb_x_min,
        y_min  => mb_y_min,
        width  => mb_x_max - mb_x_min,
        height => mb_y_max - mb_y_min
      );
  end Page_Setup;

  function Layout (pdf : PDF_Out_Stream) return Rectangle is
  begin
    return pdf.page_box;
  end Layout;

  procedure Reset (
    pdf        : in out PDF_Out_Stream'Class;
    PDF_format :        PDF_type := Default_PDF_type
  )
  is
    dummy_pdf_with_defaults : PDF_Out_Pre_Root_Type;
  begin
    --  Check if we are trying to re-use a half-finished object (ouch!):
    if pdf.is_created and not pdf.is_closed then
      raise PDF_stream_not_closed;
    end if;
    --  We will reset everything with defaults, except this:
    dummy_pdf_with_defaults.format := PDF_format;
    --  Now we reset pdf:
    PDF_Out_Pre_Root_Type (pdf) := dummy_pdf_with_defaults;
    --  Set a default title (replaced when procedure Title is called).
    --  In Adobe Reader, this content can be copied to the clipboard.
    pdf.doc_title := "Document created with: " & To_Unbounded_String (producer);
  end Reset;

  procedure Finish (pdf : in out PDF_Out_Stream) is

    info_idx, cat_idx : PDF_Index_Type;

    procedure Info is
    begin
      New_object (pdf);
      info_idx := pdf.objects;
      WL (pdf, "  << /Producer (" & producer & ')');
      WL (pdf, "     /Title (" & To_String (pdf.doc_title) & ')');
      WL (pdf, "     /Author (" & To_String (pdf.doc_author) & ')');
      WL (pdf, "     /Subject (" & To_String (pdf.doc_subject) & ')');
      WL (pdf, "     /Keywords (" & To_String (pdf.doc_keywords) & ')');
      WL (pdf, "     /Creator (" & To_String (pdf.doc_creator) & ')');
      WL (pdf, "  >>");
      WL (pdf, "endobj");
    end Info;

    procedure Pages_dictionary is
    begin
      New_fixed_index_object (pdf, pages_idx);
      WL (pdf, "  << /Type /Pages");
      W (pdf,  "     /Kids [");
      for p in 1 .. pdf.last_page loop
        W (pdf, Img (pdf.page_idx (p)) & " 0 R ");
      end loop;
      WL (pdf, "]");
      if pdf.last_page > 0 then
        WL (pdf, "     /Count " & Img (pdf.last_page));
      end if;
      WL (pdf, "     /MediaBox [" & Img (pdf.maximum_box, absolute) & ']'
      );
      --  7.7.3.3 Page Objects - MediaBox
      --  Boundaries of the physical medium on which the page shall be displayed or printed
      --  7.7.3.4 Inheritance of Page Attributes
      --  Global page size, lower-left to upper-right, measured in points
      --  Bounding box of all pages
      WL (pdf, "  >>");
      WL (pdf, "endobj");
    end Pages_dictionary;

    procedure Catalog_dictionary is
    begin
      New_object (pdf);
      cat_idx := pdf.objects;
      WL (pdf, "  << /Type /Catalog");
      WL (pdf, "     /Pages " & Img (pages_idx) & " 0 R");
      if pdf.last_page > 0 then
        --  Open the document on page 1, fit the
        --  entire page within the window (Table 151):
        WL (pdf, "     /OpenAction [" & Img (pdf.page_idx (1)) & " 0 R /Fit]");
      end if;
      WL (pdf, "  >>");
      WL (pdf, "endobj");
    end Catalog_dictionary;

    procedure Trailer is
    begin
      WL (pdf, "trailer");
      WL (pdf, "  << /Root " & Img (cat_idx) & " 0 R");
      WL (pdf, "     /Size " & Img (pdf.objects + 1));
      WL (pdf, "     /Info " & Img (info_idx) & " 0 R");
      WL (pdf, "  >>");
    end Trailer;

    xref_offset : Ada.Streams.Stream_IO.Count;

    procedure XRef is
      s10 : String (1 .. 10);
    begin
      xref_offset := Buffer_index (pdf);
      WL (pdf, "xref");
      WL (pdf, "0 " & Img (pdf.objects + 1));
      WL (pdf, "0000000000 65535 f ");
      for i in 1 .. pdf.objects loop
        CIO.Put (s10, pdf.object_offset (i));
        for n in s10'Range loop
          if s10 (n) = ' ' then
            s10 (n) := '0';
          end if;
        end loop;
        WL (pdf, s10 & " 00000 n ");  --   <-- the trailing space is needed!
      end loop;
    end XRef;

  begin
    if pdf.last_page = 0 then
      --  No page ? Then make quickly a blank page.
      New_Page (pdf);
    end if;
    Finish_Page (pdf);
    Info;
    Pages_dictionary;
    Catalog_dictionary;
    XRef;
    Trailer;
    WL (pdf, "startxref"); -- offset of xref
    WL (pdf, Img (Integer (xref_offset)));
    WL (pdf, "%%EOF");
    Dispose (pdf.page_idx);
    Dispose (pdf.object_offset);
    PDF_Out.Images.Clear_image_directory (pdf);
    pdf.is_closed := True;
  end Finish;

  ----------------------
  -- Output to a file --
  ----------------------

  procedure Create (
    pdf        : in out PDF_Out_File;
    file_name  :        String;
    PDF_format :        PDF_type := Default_PDF_type
  )
  is
  begin
    Reset (pdf, PDF_format);
    pdf.pdf_file := new Ada.Streams.Stream_IO.File_Type;
    Create (pdf.pdf_file.all, Out_File, file_name);
    pdf.file_name := To_Unbounded_String (file_name);
    pdf.pdf_stream := PDF_Raw_Stream_Class (Stream (pdf.pdf_file.all));
    Write_PDF_header (pdf);
  end Create;

  procedure Close (pdf : in out PDF_Out_File) is
    procedure Dispose is new
      Ada.Unchecked_Deallocation (Ada.Streams.Stream_IO.File_Type, PDF_file_acc);
  begin
    Finish (PDF_Out_Stream (pdf));
    if pdf.file_name /= "nul" then  --  Test needed for OA 7.2.2 (Close raises Use_Error)
      Close (pdf.pdf_file.all);
    end if;
    Dispose (pdf.pdf_file);
  end Close;

  --  Set the index on the file
  overriding procedure Set_Index (pdf : in out PDF_Out_File;
                                  to :        Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Ada.Streams.Stream_IO.Set_Index (pdf.pdf_file.all, to);
  end Set_Index;

  --  Return the index of the file
  overriding function Index (pdf : PDF_Out_File) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Index (pdf.pdf_file.all);
  end Index;

  function Is_Open (pdf : in PDF_Out_File) return Boolean is
  begin
    if pdf.pdf_file = null then
      return False;
    end if;
    return Ada.Streams.Stream_IO.Is_Open (pdf.pdf_file.all);
  end Is_Open;

  ------------------------
  -- Output to a string --
  ------------------------
  --  Code reused from Zip_Streams

  overriding procedure Read
    (Stream : in out Unbounded_Stream;
     Item   : out Stream_Element_Array;     Last   : out Stream_Element_Offset) is
  begin
    --  Item is read from the stream. If (and only if) the stream is
    --  exhausted, Last will be < Item'Last. In that case, T'Read will
    --  raise an End_Error exception.
    --
    --  Cf: RM 13.13.1(8), RM 13.13.1(11), RM 13.13.2(37) and
    --  explanations by Tucker Taft
    --
    Last := Item'First - 1;
    --  if Item is empty, the following loop is skipped; if Stream.Loc
    --  is already indexing out of Stream.Unb, that value is also appropriate
    for i in Item'Range loop
      Item (i) := Character'Pos (Element (Stream.Unb, Stream.Loc));
      Stream.Loc := Stream.Loc + 1;
      Last := i;
    end loop;
  exception
    when Ada.Strings.Index_Error =>
      null; -- what could be read has been read; T'Read will raise End_Error
  end Read;

  overriding procedure Write
    (Stream : in out Unbounded_Stream;
     Item   : Stream_Element_Array) is
  begin
    for I in Item'Range loop
      if Length (Stream.Unb) < Stream.Loc then
        Append (Stream.Unb, Character'Val (Item (I)));
      else
        Replace_Element (Stream.Unb, Stream.Loc, Character'Val (Item (I)));
      end if;
      Stream.Loc := Stream.Loc + 1;
    end loop;
  end Write;

  procedure Set_Index (S : access Unbounded_Stream; To : Positive) is
  begin
    if Length (S.Unb) < To then
      for I in Length (S.Unb) .. To loop
        Append (S.Unb, ASCII.NUL);
      end loop;
    end if;
    S.Loc := To;
  end Set_Index;

  function Index (S : access Unbounded_Stream) return Integer is
  begin
    return S.Loc;
  end Index;

  --- ***

  procedure Create (
    pdf        : in out PDF_Out_String;
    PDF_format :        PDF_type := Default_PDF_type
  )
  is
  begin
    Reset (pdf, PDF_format);
    pdf.pdf_memory := new Unbounded_Stream;
    pdf.pdf_memory.Unb := Null_Unbounded_String;
    pdf.pdf_memory.Loc := 1;
    pdf.pdf_stream := PDF_Raw_Stream_Class (pdf.pdf_memory);
    Write_PDF_header (pdf);
  end Create;

  procedure Close (pdf : in out PDF_Out_String) is
  begin
    Finish (PDF_Out_Stream (pdf));
  end Close;

  function Contents (pdf : PDF_Out_String) return String is
  begin
    if not pdf.is_closed then
      raise PDF_stream_not_closed;
    end if;
    return To_String (pdf.pdf_memory.Unb);
  end Contents;

  --  Set the index on the PDF string stream
  overriding procedure Set_Index (pdf : in out PDF_Out_String;
                                  to :        Ada.Streams.Stream_IO.Positive_Count)
  is
  begin
    Set_Index (pdf.pdf_memory, Integer (to));
  end Set_Index;

  --  Return the index of the PDF string stream
  overriding function Index (pdf : PDF_Out_String) return Ada.Streams.Stream_IO.Count
  is
  begin
    return Ada.Streams.Stream_IO.Count (Index (pdf.pdf_memory));
  end Index;

end PDF_Out;