Source file : gid.ads
---------------------------------
-- GID - Generic Image Decoder --
---------------------------------
--
-- Purpose:
--
-- The Generic Image Decoder is a package for decoding a broad
-- variety of image formats, from any data stream, to any kind
-- of medium, be it an in-memory bitmap, a GUI object,
-- some other stream, arrays of floating-point initial data
-- for scientific calculations, a browser element, a device,...
-- Animations are supported.
--
-- The code is unconditionally portable, independent of the
-- choice of operating system, processor, endianess and compiler.
--
-- Image types currently supported:
--
-- BMP, GIF, JPEG, PNG, PNM, QOI, TGA
--
-- Credits:
--
-- - André van Splunter: GIF's LZW decoder in Ada
-- - Martin J. Fiedler: most of the JPEG decoder (from NanoJPEG)
--
-- More credits in gid_work.xls, sheet "credits".
--
-- Copyright (c) Gautier de Montmollin 2010 .. 2022
--
-- 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 2-May-2010 on the site
-- http://www.opensource.org/licenses/mit-license.php
with Ada.Calendar, Ada.Streams, Ada.Strings.Bounded, Ada.Finalization;
with Interfaces;
with System;
package GID is
type Image_descriptor is private;
---------------------------------------------------
-- 1) Load the image header from the data stream --
---------------------------------------------------
procedure Load_image_header (
image : out Image_descriptor;
from : in out Ada.Streams.Root_Stream_Type'Class;
try_tga : Boolean := False
);
-- try_tga: if no known signature is found, assume it might be
-- the TGA format (which hasn't a signature) and try to load an
-- image of this format
unknown_image_format,
known_but_unsupported_image_format,
unsupported_image_subformat,
error_in_image_data,
invalid_primary_color_range : exception;
----------------------------------------------------------------------
-- 2) If needed, use dimensions to prepare the retrieval of the --
-- image, for instance: reserving an in-memory bitmap, sizing a --
-- GUI object, defining a browser element, setting up a device --
----------------------------------------------------------------------
function Pixel_width (image : Image_descriptor) return Positive;
function Pixel_height (image : Image_descriptor) return Positive;
-- "Unchanged" orientation has origin at top left
type Orientation is (
Unchanged,
Rotation_90, Rotation_180, Rotation_270
);
function Display_orientation (image : Image_descriptor) return Orientation;
--------------------------------------------------------------------
-- 3) Load and decode the image itself. If the image is animated, --
-- call Load_image_contents until next_frame is 0.0 --
--------------------------------------------------------------------
type Display_mode is (fast, nice);
-- For bitmap pictures, the result is exactly the same, but
-- interlaced images' larger pixels are drawn in full during decoding.
generic
type Primary_color_range is mod <>;
-- Coding of primary colors (red, green or blue)
-- and of opacity (also known as alpha channel), on the target "device".
-- Currently, only 8-bit and 16-bit are admitted.
-- 8-bit coding is usual: TrueColor, PC graphics, etc.;
-- 16-bit coding is seen in some high-end apps/devices/formats.
--
with procedure Set_X_Y (x, y : Natural);
-- After Set_X_Y, next pixel is meant to be displayed at position (x,y)
with procedure Put_Pixel (
red, green, blue : Primary_color_range;
alpha : Primary_color_range
);
-- When Put_Pixel is called twice without a Set_X_Y inbetween,
-- the pixel must be displayed on the next X position after the last one.
-- [ Rationale: if the image lands into an array with contiguous pixels
-- on the X axis, this approach allows full address calculation to be
-- made only at the beginning of each row, which is much faster ]
--
with procedure Feedback (percents : Natural);
--
mode : Display_mode;
--
procedure Load_image_contents (
image : in out Image_descriptor;
next_frame : out Ada.Calendar.Day_Duration
-- ^ animation: real time lapse foreseen between the first image
-- and the image right after this one; 0.0 if no next frame
);
-------------------------------------------------------------------
-- Some informations about the image, not necessary for decoding --
-------------------------------------------------------------------
type Image_format_type is
( -- Bitmap formats
BMP, FITS, GIF, JPEG, PNG, PNM, QOI, TGA, TIFF
);
function Format (image : Image_descriptor) return Image_format_type;
function Detailed_format (image : Image_descriptor) return String;
-- example: "GIF89a, interlaced"
function Subformat (image : Image_descriptor) return Integer;
-- example the 'color type' in PNG
function Bits_per_pixel (image : Image_descriptor) return Positive;
function Is_RLE_encoded (image : Image_descriptor) return Boolean;
function Is_Interlaced (image : Image_descriptor) return Boolean;
function Greyscale (image : Image_descriptor) return Boolean;
function Has_palette (image : Image_descriptor) return Boolean;
function Expect_transparency (image : Image_descriptor) return Boolean;
----------------------------------------------------------------
-- Information about this package - e.g. for an "about" box --
----------------------------------------------------------------
version : constant String := "010";
reference : constant String := "14-Apr-2022";
web : constant String := "http://gen-img-dec.sf.net/";
-- Hopefully the latest version is at that URL..........^
-- There is a mirror too @ https://github.com/zertovitch/gid
private
subtype U8 is Interfaces.Unsigned_8;
subtype U16 is Interfaces.Unsigned_16;
subtype U32 is Interfaces.Unsigned_32;
package Bounded_255 is
new Ada.Strings.Bounded.Generic_Bounded_Length (255);
type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
type RGB_Color_8_Bit is record
red, green, blue : U8;
end record;
type Color_table is array (Integer range <>) of RGB_Color_8_Bit;
type p_Color_table is access Color_table;
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 Integer_M32 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).
subtype Natural_M32 is Integer_M32 range 0 .. Integer_M32'Last;
subtype Positive_M32 is Integer_M32 range 1 .. Integer_M32'Last;
type Byte_array is array (Integer range <>) of U8;
type Input_buffer is record
data : Byte_array (1 .. 1024);
stream : Stream_Access := null;
InBufIdx : Positive := 1; -- Points to next char in buffer to be read
MaxInBufIdx : Natural := 0; -- Count of valid chars in input buffer
InputEoF : Boolean; -- End of file indicator
end record;
-- Initial values ensure call to Fill_Buffer on first Get_Byte
-- JPEG may store data _before_ any image header (SOF), then we have
-- to make the image descriptor store that information, alas...
package JPEG_defs is
type Component is
(Y, -- brightness
Cb, -- hue
Cr, -- saturation
I, -- ??
Q -- ??
);
type QT is array (0 .. 63) of Natural;
type QT_list is array (0 .. 7) of QT;
type Compo_set is array (Component) of Boolean;
type Info_per_component_A is record -- B is defined inside the decoder
qt_assoc : Natural;
samples_hor : Natural;
samples_ver : Natural;
up_factor_x : Natural; -- how much we must repeat horizontally
up_factor_y : Natural; -- how much we must repeat vertically
shift_x : Natural; -- shift for repeating pixels horizontally
shift_y : Natural; -- shift for repeating pixels vertically
end record;
type Component_info_A is array (Component) of Info_per_component_A;
type Supported_color_space is (
YCbCr, -- 3-dim color space
Y_Grey, -- 1-dim greyscale
CMYK -- 4-dim Cyan, Magenta, Yellow, blacK
);
type AC_DC is (AC, DC);
type VLC_code is record
bits, code : U8;
end record;
type VLC_table is array (0 .. 65_535) of VLC_code;
type p_VLC_table is access VLC_table;
type VLC_defs_type is array (AC_DC, 0 .. 7) of p_VLC_table;
end JPEG_defs;
type JPEG_stuff_type is record
components : JPEG_defs.Compo_set := (others => False);
color_space : JPEG_defs.Supported_color_space;
info : JPEG_defs.Component_info_A;
max_samples_hor : Natural;
max_samples_ver : Natural;
qt_list : JPEG_defs.QT_list;
vlc_defs : JPEG_defs.VLC_defs_type := (others => (others => null));
restart_interval : Natural; -- predictor restarts every... (0: never)
end record;
type Endianess_type is (little, big); -- for TIFF images
subtype Positive_32 is Interfaces.Integer_32 range 1 .. Interfaces.Integer_32'Last;
type Image_descriptor is new Ada.Finalization.Controlled with record
format : Image_format_type;
detailed_format : Bounded_255.Bounded_String; -- for humans only!
subformat_id : Integer := 0;
width, height : Positive_32;
display_orientation : Orientation;
top_first : Boolean; -- data orientation in TGA
bits_per_pixel : Positive;
RLE_encoded : Boolean := False;
transparency : Boolean := False;
greyscale : Boolean := False;
interlaced : Boolean := False; -- GIF or PNG
endianess : Endianess_type; -- TIFF
JPEG_stuff : JPEG_stuff_type;
stream : Stream_Access;
buffer : Input_buffer;
palette : p_Color_table := null;
first_byte : U8;
next_frame : Ada.Calendar.Day_Duration;
end record;
overriding procedure Adjust (Object : in out Image_descriptor);
overriding procedure Finalize (Object : in out Image_descriptor);
to_be_done : exception;
-- this exception should not happen, even with malformed files
-- its role is to pop up when a feature is set as implemented
-- but one aspect (e.g. palette) was forgotten.
--
-- Primitive tracing using Ada.Text_IO, for debugging,
-- or explaining internals.
--
type Trace_type is (
none, -- No trace at all, no use of console from the library
some_t, -- Image / frame technical informations
full -- Byte / pixel / compressed block details
);
trace : constant Trace_type := none; -- <== Choice here
no_trace : constant Boolean := trace = none;
full_trace : constant Boolean := trace = full;
some_trace : constant Boolean := trace >= some_t;
use Interfaces;
end GID;
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.
