1---------------------------------
2-- GID - Generic Image Decoder --
3---------------------------------
4--
5-- Purpose:
6--
7--   The Generic Image Decoder is a package for decoding a broad
8--   variety of image formats, from any data stream, to any kind
9--   of medium, be it an in-memory bitmap, a GUI object,
10--   some other stream, arrays of floating-point initial data
11--   for scientific calculations, a browser element, a device,...
12--   Animations are supported.
13--
14--   The code is unconditionally portable, independent of the
15--   choice of operating system, processor, endianess and compiler.
16--
17-- Image types currently supported:
18--
19--   BMP, GIF, JPEG, PNG, PNM, TGA
20--
21-- Credits:
22--
23--   - Andr� van Splunter: GIF's LZW decoder
24--   - Martin J. Fiedler: most of the JPEG decoder (from NanoJPEG)
25--
26--   More credits in gid_work.xls, sheet "credits".
27--
28-- Copyright (c) Gautier de Montmollin 2010 .. 2016
29--
30--  Permission is hereby granted, free of charge, to any person obtaining a copy
31--  of this software and associated documentation files (the "Software"), to deal
32--  in the Software without restriction, including without limitation the rights
33--  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
34--  copies of the Software, and to permit persons to whom the Software is
35--  furnished to do so, subject to the following conditions:
36--
37--  The above copyright notice and this permission notice shall be included in
38--  all copies or substantial portions of the Software.
39--
40--  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
41--  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
42--  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
43--  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
44--  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
45--  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
46--  THE SOFTWARE.
47--
48-- NB: this is the MIT License, as found 2-May-2010 on the site
49-- http://www.opensource.org/licenses/mit-license.php
50
51with Ada.Calendar, Ada.Streams, Ada.Strings.Bounded, Ada.Finalization;
52with Interfaces;
53with System;
54
55package GID is
56
57  type Image_descriptor is private;
58
59  ---------------------------------------------------
60  -- 1) Load the image header from the data stream --
61  ---------------------------------------------------
62
63  procedure Load_image_header (
64    image   :    out Image_descriptor;
65    from    : in out Ada.Streams.Root_Stream_Type'Class;
66    try_tga :        Boolean:= False
67  );
68
69  -- try_tga: if no known signature is found, assume it might be
70  -- the TGA format (which hasn't a signature) and try to load an
71  -- image of this format
72
73  unknown_image_format,
74  known_but_unsupported_image_format,
75  unsupported_image_subformat,
76  error_in_image_data,
77  invalid_primary_color_range: exception;
78
79  ----------------------------------------------------------------------
80  -- 2) If needed, use dimensions to prepare the retrieval of the     --
81  --    image, for instance: reserving an in-memory bitmap, sizing a  --
82  --    GUI object, defining a browser element, setting up a device   --
83  ----------------------------------------------------------------------
84
85  function Pixel_width (image: Image_descriptor) return Positive;
86  function Pixel_height (image: Image_descriptor) return Positive;
87
88  -- "Unchanged" orientation has origin at top left
89
90  type Orientation is (
91    Unchanged,
92    Rotation_90, Rotation_180, Rotation_270
93  );
94
95  function Display_orientation (image: Image_descriptor) return Orientation;
96
97  --------------------------------------------------------------------
98  -- 3) Load and decode the image itself. If the image is animated, --
99  --    call Load_image_contents until next_frame is 0.0            --
100  --------------------------------------------------------------------
101
102  type Display_mode is (fast, nice);
103  -- For bitmap pictures, the result is exactly the same, but
104  -- interlaced images' larger pixels are drawn in full during decoding.
105
106  generic
107    type Primary_color_range is mod <>;
108    -- Coding of primary colors (red, green or blue)
109    --   and of opacity (also known as alpha channel), on the target "device".
110    -- Currently, only 8-bit and 16-bit are admitted.
111    --    8-bit coding is usual: TrueColor, PC graphics, etc.;
112    --   16-bit coding is seen in some high-end apps/devices/formats.
113    --
114    with procedure Set_X_Y (x, y: Natural);
115    -- After Set_X_Y, next pixel is meant to be displayed at position (x,y)
116    with procedure Put_Pixel (
117      red, green, blue : Primary_color_range;
118      alpha            : Primary_color_range
119    );
120    -- When Put_Pixel is called twice without a Set_X_Y inbetween,
121    -- the pixel must be displayed on the next X position after the last one.
122    -- [ Rationale: if the image lands into an array with contiguous pixels
123    --   on the X axis, this approach allows full address calculation to be
124    --   made only at the beginning of each row, which is much faster ]
125    --
126    with procedure Feedback (percents: Natural);
127    --
128    mode: Display_mode;
129    --
130  procedure Load_image_contents (
131    image     : in out Image_descriptor;
132    next_frame:    out Ada.Calendar.Day_Duration
133      -- ^ animation: real time lapse foreseen between the first image
134      -- and the image right after this one; 0.0 if no next frame
135  );
136
137  -------------------------------------------------------------------
138  -- Some informations about the image, not necessary for decoding --
139  -------------------------------------------------------------------
140
141  type Image_format_type is
142    ( -- Bitmap formats
143      BMP, FITS, GIF, JPEG, PNG, PNM, TGA, TIFF
144    );
145
146  function Format (image: Image_descriptor) return Image_format_type;
147  function Detailed_format (image: Image_descriptor) return String;
148  -- example: "GIF89a, interlaced"
149  function Subformat (image: Image_descriptor) return Integer;
150  -- example the 'color type' in PNG
151
152  function Bits_per_pixel (image: Image_descriptor) return Positive;
153  function RLE_encoded (image: Image_descriptor) return Boolean;
154  function Interlaced (image: Image_descriptor) return Boolean;
155  function Greyscale (image: Image_descriptor) return Boolean;
156  function Has_palette (image: Image_descriptor) return Boolean;
157  function Expect_transparency (image: Image_descriptor) return Boolean;
158
159  --------------------------------------------------------------
160  -- Information about this package - e.g. for an "about" box --
161  --------------------------------------------------------------
162
163  version   : constant String:= "06, preview 1";
164  reference : constant String:= ">= 30-Aug-2016";
165  web: constant String:= "http://gen-img-dec.sf.net/";
166  -- Hopefully the latest version is at that URL...
167
168private
169
170  use Interfaces;
171
172  subtype U8  is Unsigned_8;
173  subtype U16 is Unsigned_16;
174  subtype U32 is Unsigned_32;
175
176  package Bounded_255 is
177    new Ada.Strings.Bounded.Generic_Bounded_Length(255);
178
179  type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;
180
181  type RGB_color is record
182    red, green, blue : U8;
183  end record;
184
185  type Color_table is array (Integer range <>) of RGB_color;
186
187  type p_Color_table is access Color_table;
188
189  min_bits: constant:= Integer'Max(32, System.Word_Size);
190  -- 13.3(8): A word is the largest amount of storage that can be
191  -- conveniently and efficiently manipulated by the hardware,
192  -- given the implementation's run-time model.
193
194  type Integer_M32 is range -2**(min_bits-1) .. 2**(min_bits-1) - 1;
195  --  We define an Integer type which is at least 32 bits, but n bits
196  --  on a native n > 32 bits architecture (no performance hit on 64+
197  --  bits architectures).
198
199  subtype Natural_M32 is Integer_M32 range 0..Integer_M32'Last;
200  subtype Positive_M32 is Integer_M32 range 1..Integer_M32'Last;
201
202  type Byte_array is array(Integer range <>) of U8;
203
204  type Input_buffer is record
205    data       : Byte_array(1..1024);
206    stream     : Stream_Access:= null;
207    InBufIdx   : Positive:= 1; --  Points to next char in buffer to be read
208    MaxInBufIdx: Natural := 0; --  Count of valid chars in input buffer
209    InputEoF   : Boolean;      --  End of file indicator
210  end record;
211  -- Initial values ensure call to Fill_Buffer on first Get_Byte
212
213  -- JPEG may store data _before_ any image header (SOF), then we have
214  -- to make the image descriptor store that information, alas...
215
216  package JPEG_defs is
217
218    type Component is
219      (Y,  -- brightness
220       Cb, -- hue
221       Cr, -- saturation
222       I,  -- ??
223       Q   -- ??
224      );
225
226    type QT is array(0..63) of Natural;
227    type QT_list is array(0..7) of QT;
228
229    type Compo_set is array(Component) of Boolean;
230
231    type Info_per_component_A is record -- B is defined inside the decoder
232      qt_assoc    : Natural;
233      samples_hor : Natural;
234      samples_ver : Natural;
235      up_factor_x : Natural; -- how much we must repeat horizontally
236      up_factor_y : Natural; -- how much we must repeat vertically
237      shift_x     : Natural; -- shift for repeating pixels horizontally
238      shift_y     : Natural; -- shift for repeating pixels vertically
239    end record;
240
241    type Component_info_A is array(Component) of Info_per_component_A;
242
243    type Supported_color_space is (
244      YCbCr,  -- 3-dim color space
245      Y_Grey, -- 1-dim greyscale
246      CMYK    -- 4-dim Cyan, Magenta, Yellow, blacK
247    );
248
249    type AC_DC is (AC, DC);
250
251    type VLC_code is record
252      bits, code: U8;
253    end record;
254
255    type VLC_table is array(0..65_535) of VLC_code;
256
257    type p_VLC_table is access VLC_table;
258
259    type VLC_defs_type is array(AC_DC, 0..7) of p_VLC_table;
260
261  end JPEG_defs;
262
263  type JPEG_stuff_type is record
264    components       : JPEG_defs.Compo_set:= (others => False);
265    color_space      : JPEG_defs.Supported_color_space;
266    info             : JPEG_defs.Component_info_A;
267    max_samples_hor  : Natural;
268    max_samples_ver  : Natural;
269    qt_list          : JPEG_defs.QT_list;
270    vlc_defs         : JPEG_defs.VLC_defs_type:= (others => (others => null));
271    restart_interval : Natural; -- predictor restarts every... (0: never)
272  end record;
273
274  type Endianess_type is (little, big); -- for TIFF images
275
276  type Image_descriptor is new Ada.Finalization.Controlled with record
277    format             : Image_format_type;
278    detailed_format    : Bounded_255.Bounded_String; -- for humans only!
279    subformat_id       : Integer:= 0;
280    width, height      : Positive;
281    display_orientation: Orientation;
282    top_first          : Boolean; -- data orientation in TGA
283    bits_per_pixel     : Positive;
284    RLE_encoded        : Boolean:= False;
285    transparency       : Boolean:= False;
286    greyscale          : Boolean:= False;
287    interlaced         : Boolean:= False; -- GIF or PNG
288    endianess          : Endianess_type;  -- TIFF
289    JPEG_stuff         : JPEG_stuff_type;
290    stream             : Stream_Access;
291    buffer             : Input_buffer;
292    palette            : p_Color_table:= null;
293    first_byte         : U8;
294    next_frame         : Ada.Calendar.Day_Duration;
295  end record;
296
297  procedure Adjust (Object : in out Image_descriptor);
298  procedure Finalize (Object : in out Image_descriptor);
299
300  to_be_done: exception;
301  -- this exception should not happen, even with malformed files
302  -- its role is to pop up when a feature is set as implemented
303  -- but one aspect (e.g. palette) was forgotten.
304
305  --
306  -- Primitive tracing using Ada.Text_IO, for debugging,
307  -- or explaining internals.
308  --
309  type Trace_type is (
310    none,   -- No trace at all, no use of console from the library
311    some_t, -- Image / frame technical informations
312    full    -- Byte / pixel / compressed block details
313  );
314
315  trace: constant Trace_type:= none; -- <== Choice here
316
317  no_trace  : constant Boolean:= trace=none;
318  full_trace: constant Boolean:= trace=full;
319  some_trace: constant Boolean:= trace>=some_t;
320
321end GID;
322