Source file : pdf_out.ads
-------------------------------------------------------------------------------------
--
-- PDF_OUT - A low level package for writing Adobe Acrobat PDF (*) files
--
-- Pure Ada 95 code, 100% portable: OS-, CPU- and compiler- independent.
--
-- Version / date / download info: see the version, reference, web strings
-- defined at the end of the public part of this package.
-- Legal licensing note:
-- Copyright (c) 2014 .. 2023 Gautier de Montmollin
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.
-- NB: this is the MIT License, as found 12-Sep-2007 on the site
-- http://www.opensource.org/licenses/mit-license.php
-- (*) All Trademarks mentioned are properties of their respective owners.
-------------------------------------------------------------------------------------
--
-- Follow the steps below to create a PDF document stream.
-- You can also get inspiration from the demos, tests & tools.
--
-- 1. Create
--
-- 2. | Put (pdf, data),
-- | New_Line (pdf), ... : other "Text_IO"-like (full list below)
-- | Image (pdf, ...) : raster images
-- | Move/Line/... : vector graphics
-- | New_Page (pdf)
--
-- 3. Close
--
-- 4. (PDF_Out_String only) function Contents returns the full .pdf
--
-- Header and footer are set up by overriding the corresponding methods.
--
-- Note: the standard PDF measurement unit is a "point", set as 1/72 inch.
--
-- All technical references are to PDF 1.7 format, ISO 32000-1:2008 standard
-- https://opensource.adobe.com/dc-acrobat-sdk-docs/standards/pdfstandards/pdf/PDF32000_2008.pdf
--
--------------------------------------------------------------------------
with Ada.Streams.Stream_IO,
Ada.Strings.Unbounded,
Ada.Strings.Wide_Unbounded,
Ada.Strings.Wide_Wide_Unbounded,
Ada.Text_IO;
with System;
package PDF_Out is
-------------------------------------------------------------------
-- The abstract PDF output stream root type. --
-- From this package, you can use the following derived types: --
-- * PDF_Out_File : output in a file --
-- * PDF_Out_String : output in a string --
-- Of course you can define your own derived types. --
-------------------------------------------------------------------
type PDF_Out_Stream is abstract tagged private;
PDF_stream_not_created,
PDF_stream_not_closed,
Not_implemented : exception;
type PDF_type is (
PDF_1_3 -- PDF 1.3
);
Default_PDF_type : constant PDF_type := PDF_1_3;
type Real is digits System.Max_Digits;
package Real_IO is new Ada.Text_IO.Float_IO (Real);
type Point is record
x, y : Real;
end record;
function "+"(P1, P2 : Point) return Point;
pragma Inline ("+");
function "*"(f : Real; P : Point) return Point;
pragma Inline ("*");
type Rectangle is record
x_min, y_min,
width, height : Real;
end record;
function "+"(P : Point; r : Rectangle) return Rectangle;
pragma Inline ("+");
-- Scaling. r.x_min and r.y_min are preserved.
function "*"(f : Real; r : Rectangle) return Rectangle;
pragma Inline ("*");
function X_Max (r : Rectangle) return Real;
function Y_Max (r : Rectangle) return Real;
use Ada.Strings.Unbounded;
------------------------------
-- (2) Document contents: --
------------------------------
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);
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);
procedure Put (pdf : in out PDF_Out_Stream; str : String);
procedure Put (pdf : in out PDF_Out_Stream; str : Unbounded_String);
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);
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);
procedure Put_Line (pdf : in out PDF_Out_Stream; str : String);
procedure Put_Line (pdf : in out PDF_Out_Stream; str : Unbounded_String);
procedure New_Line (pdf : in out PDF_Out_Stream; Spacing : Positive := 1);
procedure New_Page (pdf : in out PDF_Out_Stream);
-- Support for Wide_String's, usually containing UTF-16 or UCS-2 strings.
-- Caution: only the ISO-8859-1 (Latin-1) subset is currently supported.
procedure Put_WS (pdf : in out PDF_Out_Stream; w_str : Wide_String);
procedure Put_Line_WS
(pdf : in out PDF_Out_Stream; w_str : Wide_String);
procedure Put_Line_WS
(pdf : in out PDF_Out_Stream;
w_str : Ada.Strings.Wide_Unbounded.Unbounded_Wide_String);
-- Support for Wide_Wide_String's, containing UTF-32 strings.
-- Caution: only the ISO-8859-1 (Latin-1) subset is currently supported.
procedure Put_WWS (pdf : in out PDF_Out_Stream; ww_str : Wide_Wide_String);
procedure Put_Line_WWS
(pdf : in out PDF_Out_Stream; ww_str : Wide_Wide_String);
procedure Put_Line_WWS
(pdf : in out PDF_Out_Stream;
ww_str : Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);
-- Call to Finish_Page is optional, but can be necessary in some circumstances,
-- for instance for displaying the footer correctly before changing page
-- orientation or margins for the following pages.
procedure Finish_Page (pdf : in out PDF_Out_Stream);
procedure Text_XY (pdf : in out PDF_Out_Stream; x, y : Real);
procedure Put_XY (pdf : in out PDF_Out_Stream; x, y : Real; str : String);
function Col (pdf : in PDF_Out_Stream) return Positive;
function Line (pdf : in PDF_Out_Stream) return Positive;
function Page (pdf : in PDF_Out_Stream) return Natural;
type Font_Type is
( -- The 14 standard fonts
Courier,
Courier_Bold,
Courier_Bold_Oblique,
Courier_Oblique,
Helvetica,
Helvetica_Bold,
Helvetica_Bold_Oblique,
Helvetica_Oblique,
Symbol,
Times_Bold,
Times_Bold_Italic,
Times_Italic,
Times_Roman,
Zapf_Dingbats,
-- Fonts imported into the PDF document
External_Font
);
subtype Standard_Font_Type is Font_Type range Courier .. Zapf_Dingbats;
-- Select one of the Adobe PDF standard fonts.
-- The encoding is on 8 bits and follows the "Windows Code Page 1252"
-- encoding (called WinAnsiEncoding in the PDF standard).
-- See Annex D, especially "Table D.1 - Latin-text encodings" for details.
procedure Font (pdf : in out PDF_Out_Stream; f : Standard_Font_Type);
-- Set the font size.
-- In general the size is a scale factor (see Table 105, Tf operator).
-- For standard fonts the unit seems to be the Point (pt).
procedure Font_Size (pdf : in out PDF_Out_Stream; size : Real);
procedure Line_Spacing (pdf : in out PDF_Out_Stream; factor : Real); -- as multiple of font size
default_line_spacing : constant := 1.2;
procedure Line_Spacing_Pt (pdf : in out PDF_Out_Stream; pt : Real); -- in Point (pt) units
--------------
-- Colors --
--------------
-- 0.0 = minimum intensity
-- 1.0 = maximum intensity.
subtype Color_Value is Real range 0.0 .. 1.0;
type Color_Type is record
red, green, blue : Color_Value;
end record;
black : constant Color_Type := (0.0, 0.0, 0.0);
procedure Color (pdf : in out PDF_Out_Stream; c : Color_Type);
procedure Stroking_Color (pdf : in out PDF_Out_Stream; c : Color_Type);
type Rendering_Mode is (
fill, stroke, fill_then_stroke, invisible,
-- Same, but also add text to path for clipping.
fill_and_add_to_path,
stroke_and_add_to_path,
fill_then_stroke_and_add_to_path,
add_to_path
);
procedure Text_Rendering_Mode (pdf : in out PDF_Out_Stream; r : Rendering_Mode);
----------------
-- Graphics --
----------------
-- Insert an image from a file
procedure Image (pdf : in out PDF_Out_Stream; file_name : String; target : Rectangle);
-- For calibrating the target rectangle in the Image procedure, you may need this:
function Get_pixel_dimensions (image_file_name : String) return Rectangle;
-- Caution: scaling is up to you! The rectangle returned by the function
-- is (0.0, 0.0, width, height), with 1 pixel = 1pt.
-----------------------
-- Vector graphics --
-----------------------
initial_line_width : constant := 1.0; -- See Table 52, 8.4.1
procedure Line_Width (pdf : in out PDF_Out_Stream; width : Real);
-- Draw a single line segment:
procedure Single_Line (pdf : in out PDF_Out_Stream; from, to : Point);
subtype Path_Rendering_Mode is Rendering_Mode range fill .. fill_then_stroke;
-- Draw simple figures.
-- Rectangle:
procedure Draw
(pdf : in out PDF_Out_Stream;
what : Rectangle;
rendering : Path_Rendering_Mode);
-- Paths:
type Inside_path_rule is (nonzero_winding_number, even_odd);
-- Rule to determine how to fill areas within a (non-trivial) path.
-- See 8.5.3.3.2 and 8.5.3.3.3 of PDF specification
procedure Move (pdf : in out PDF_Out_Stream; to : Point);
procedure Line (pdf : in out PDF_Out_Stream; to : Point);
procedure Cubic_Bezier
(pdf : in out PDF_Out_Stream;
control_1, control_2 : Point;
to : Point);
-- All lines and curves and the eventual filling inside the path
-- will be drawn when path is completed, with Finish_Path:
procedure Finish_Path (
pdf : in out PDF_Out_Stream;
close_path : Boolean;
rendering : Path_Rendering_Mode; -- fill, stroke, or both
rule : Inside_path_rule
);
------------
-- Misc --
------------
-- In the likely case some PDF feature is not yet implemented in
-- this package, you can insert direct PDF code - at your own risk ;-).
--
-- NB: the state the PDF machine is either in text-writing
-- mode, or graphics mode. To make outputs compliant with the PDF
-- standard, if you want to insert graphics code, please
-- use the Insert_Graphics_PDF_Code below. For text-related stuff,
-- use Insert_Text_PDF_Code.
--
procedure Insert_PDF_Code (pdf : in out PDF_Out_Stream; code : String);
pragma Inline (Insert_PDF_Code);
-- This is for direct text PDF code insertion (text-writing mode
-- will be switched on). In PDF language these are the T... commands.
--
procedure Insert_Text_PDF_Code (pdf : in out PDF_Out_Stream; code : String);
-- This is for direct graphics PDF code insertion (text-writing mode
-- will be switched off for the graphics output).
--
procedure Insert_Graphics_PDF_Code (pdf : in out PDF_Out_Stream; code : String);
-- Image (representation in digits) functions for numbers, designed to
-- take the least possible room, albeit without loss of precision.
-- Useful for inserting PDF code.
function Img (p : Integer) return String;
function Img (x : Real; prec : Positive := Real'Digits) return String;
-- Document information
procedure Title (pdf : in out PDF_Out_Stream; s : String);
procedure Author (pdf : in out PDF_Out_Stream; s : String);
procedure Subject (pdf : in out PDF_Out_Stream; s : String);
procedure Keywords (pdf : in out PDF_Out_Stream; s : String);
procedure Creator_Application (pdf : in out PDF_Out_Stream; s : String);
-------------------
-- Page layout --
-------------------
-- You need to override the Header and Footer methods
-- for setting up your custom header and footer. By default they do nothing.
procedure Page_Header (pdf : in out PDF_Out_Stream);
procedure Page_Footer (pdf : in out PDF_Out_Stream);
-- They have to be called before New_Page in order to influence the next page.
-- For the first page, call them before any output (typically right after Create).
--
procedure Left_Margin (pdf : out PDF_Out_Stream; pts : Real);
function Left_Margin (pdf : PDF_Out_Stream) return Real;
procedure Right_Margin (pdf : out PDF_Out_Stream; pts : Real);
function Right_Margin (pdf : PDF_Out_Stream) return Real;
procedure Top_Margin (pdf : out PDF_Out_Stream; pts : Real);
function Top_Margin (pdf : PDF_Out_Stream) return Real;
procedure Bottom_Margin (pdf : out PDF_Out_Stream; pts : Real);
function Bottom_Margin (pdf : PDF_Out_Stream) return Real;
--
type Margins_Type is record
left, right, top, bottom : Real;
end record;
-- Some distances in Points
one_cm : constant := 72.0 / 2.54;
cm_2_5 : constant := one_cm * 2.5;
one_inch : constant := 72.0;
cm_2_5_margins : constant Margins_Type := (cm_2_5, cm_2_5, cm_2_5, cm_2_5);
procedure Margins (pdf : out PDF_Out_Stream; new_margins : Margins_Type);
function Margins (pdf : PDF_Out_Stream) return Margins_Type;
-- A4 is 21.0 x 29.7 cm
A4_portrait : constant Rectangle := (0.0, 0.0, 21.0 * one_cm, 29.7 * one_cm);
A4_landscape : constant Rectangle := (0.0, 0.0, A4_portrait.height, A4_portrait.width);
procedure Page_Setup (pdf : in out PDF_Out_Stream; layout : Rectangle);
function Layout (pdf : PDF_Out_Stream) return Rectangle;
-- Set_Index and Index are not directly useful for PDF_Out users.
-- They are private indeed, but they must be visible (RM 3.9.3(10)).
-- Set the index on the stream
procedure Set_Index (pdf : in out PDF_Out_Stream;
to : Ada.Streams.Stream_IO.Positive_Count)
is abstract;
-- Return the index of the stream
function Index (pdf : PDF_Out_Stream) return Ada.Streams.Stream_IO.Count
is abstract;
-------------------------------------------------------------------
-- Here are derived stream types, pre-defined in this package. --
-------------------------------------------------------------------
-- * Output to a file:
type PDF_Out_File is new PDF_Out_Stream with private;
procedure Create
(pdf : in out PDF_Out_File;
file_name : String;
PDF_format : PDF_type := Default_PDF_type);
procedure Close (pdf : in out PDF_Out_File);
function Is_Open (pdf : in PDF_Out_File) return Boolean;
-- * Output to a string (to be compressed, packaged, transmitted, ... ):
type PDF_Out_String is new PDF_Out_Stream with private;
procedure Create
(pdf : in out PDF_Out_String;
PDF_format : PDF_type := Default_PDF_type);
procedure Close (pdf : in out PDF_Out_String);
function Contents (pdf : PDF_Out_String) return String;
----------------------------------------------------------------
-- Information about this package - e.g. for an "about" box --
----------------------------------------------------------------
version : constant String := "006";
reference : constant String := "25-Jun-2023";
-- Hopefully the latest version is at one of those URLs:
web : constant String := "https://apdf.sourceforge.io/";
web2 : constant String := "https://sourceforge.net/projects/apdf/";
web3 : constant String := "https://github.com/zertovitch/ada-pdf-writer";
web4 : constant String := "https://alire.ada.dev/crates/apdf";
private
min_bits : constant := Integer'Max (32, System.Word_Size);
-- 13.3(8): A word is the largest amount of storage that can be
-- conveniently and efficiently manipulated by the hardware,
-- given the implementation's run-time model.
type PDF_Index_Type is range -2**(min_bits - 1) .. 2**(min_bits - 1) - 1;
-- We define an Integer type which is at least 32 bits, but n bits
-- on a native n > 32 bits architecture (no performance hit on 64+
-- bits architectures).
type Offset_table is array (PDF_Index_Type range <>) of Ada.Streams.Stream_IO.Count;
type p_Offset_table is access Offset_table;
type Page_table is array (PDF_Index_Type range <>) of PDF_Index_Type; -- object ID's of pages
type p_Page_table is access Page_table;
-- Some unique objects like Pages need to have a pre-determined index,
-- otherwise single Page objects don't know their parent's index.
pages_idx : constant PDF_Index_Type := 1;
last_fix_obj_idx : constant PDF_Index_Type := 1;
type Dir_node;
type p_Dir_node is access Dir_node;
type Dir_node (name_len : Natural) is record
left, right : p_Dir_node;
file_name : String (1 .. name_len);
image_index : Positive;
pdf_object_index : PDF_Index_Type := 0; -- 0 = not yet insterted into the PDF stream
local_resource : Boolean; -- All True items to be listed into Resource dictionary
end record;
type Page_zone is (nowhere, in_page, in_header, in_footer);
type Text_or_graphics is (text, graphics);
------------------------------------------
-- Raw Streams, with 'Read and 'Write --
------------------------------------------
type PDF_Raw_Stream_Class is access all Ada.Streams.Root_Stream_Type'Class;
-- We have a concrete type as hidden ancestor of the PDF_Out_Stream root
-- type. A variable of that type is initialized with default values and
-- can help re-initialize a PDF_Out_Stream when re-used several times.
-- See the Reset procedure in body.
-- The abstract PDF_Out_Stream could have default values, but using a
-- variable of this type to reset values is not Ada compliant (LRM:3.9.3(8))
--
type PDF_Out_Pre_Root_Type is tagged record
pdf_stream : PDF_Raw_Stream_Class;
start_index : Ada.Streams.Stream_IO.Count;
is_created : Boolean := False;
is_closed : Boolean := False;
format : PDF_type := Default_PDF_type;
zone : Page_zone := nowhere;
text_switch : Text_or_graphics := graphics;
last_page : PDF_Index_Type := 0;
current_line : Positive := 1; -- Mostly for Ada.Text_IO compatibility
current_col : Positive := 1; -- Mostly for Ada.Text_IO compatibility
page_idx : p_Page_table := null; -- page_idx(p): Object ID of page p
page_box : Rectangle := A4_portrait;
maximum_box : Rectangle := A4_portrait;
page_margins : Margins_Type := cm_2_5_margins;
objects : PDF_Index_Type := last_fix_obj_idx;
object_offset : p_Offset_table := null;
stream_obj_buf : Unbounded_String;
img_dir_tree : p_Dir_node := null;
img_count : Natural := 0;
current_font : Font_Type := Helvetica;
font_size : Real := 11.0;
line_spacing : Real := default_line_spacing;
ext_font_name : Unbounded_String;
doc_title : Unbounded_String; -- Document information (14.3.3)
doc_author : Unbounded_String; -- Document information (14.3.3)
doc_subject : Unbounded_String; -- Document information (14.3.3)
doc_keywords : Unbounded_String; -- Document information (14.3.3)
doc_creator : Unbounded_String; -- Document information (14.3.3) : creator application
end record;
type PDF_Out_Stream is abstract new PDF_Out_Pre_Root_Type with null record;
-- For child packages
function Image_name (i : Positive) return String;
procedure New_object (pdf : in out PDF_Out_Stream'Class);
procedure WL (pdf : in out PDF_Out_Stream'Class; s : String);
pragma Inline (WL);
procedure Copy_File (
file_name : String;
into : in out Ada.Streams.Root_Stream_Type'Class;
buffer_size : Positive := 1024 * 1024
);
------------------------
-- Output to a file --
------------------------
type PDF_file_acc is
access Ada.Streams.Stream_IO.File_Type;
type PDF_Out_File is new PDF_Out_Stream with record
pdf_file : PDF_file_acc := null; -- access to the "physical" PDF file
file_name : Unbounded_String;
end record;
-- Set the index on the file
overriding procedure Set_Index (pdf : in out PDF_Out_File;
to : Ada.Streams.Stream_IO.Positive_Count);
-- Return the index of the file
overriding function Index (pdf : PDF_Out_File) return Ada.Streams.Stream_IO.Count;
--------------------------
-- Output to a string --
--------------------------
-- Code reused from Zip_Streams
--- *** We define here a complete in-memory stream:
type Unbounded_Stream is new Ada.Streams.Root_Stream_Type with
record
Unb : Ada.Strings.Unbounded.Unbounded_String;
Loc : Integer := 1;
end record;
-- Read data from the stream.
overriding procedure Read
(Stream : in out Unbounded_Stream;
Item : out Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset);
-- write data to the stream, starting from the current index.
-- Data will be overwritten from index is already available.
overriding procedure Write
(Stream : in out Unbounded_Stream;
Item : Ada.Streams.Stream_Element_Array);
-- Set the index on the stream
procedure Set_Index (S : access Unbounded_Stream; To : Positive);
-- returns the index of the stream
function Index (S : access Unbounded_Stream) return Integer;
--- ***
type Unbounded_Stream_Acc is access Unbounded_Stream;
type PDF_Out_String is new PDF_Out_Stream with record
pdf_memory : Unbounded_Stream_Acc;
end record;
-- 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);
-- Return the index of the PDF string stream
overriding function Index (pdf : PDF_Out_String) return Ada.Streams.Stream_IO.Count;
end PDF_Out;
Ada PDF Writer: Ada package for writing PDF files (.pdf).
Ada programming.
Some news about Ada PDF Writer and other Ada projects
on Gautier's blog.
