Add initial prototype.
This commit is contained in:
Rod Kay
304
3-mid/opengl/private/gid/gid.ads
Normal file
304
3-mid/opengl/private/gid/gid.ads
Normal file
@@ -0,0 +1,304 @@
|
||||
---------------------------------
|
||||
-- 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, TGA
|
||||
--
|
||||
-- Credits:
|
||||
--
|
||||
-- - André van Splunter: GIF's LZW decoder
|
||||
-- - Martin J. Fiedler: most of the JPEG decoder (from NanoJPEG)
|
||||
--
|
||||
-- More credits in gid_work.xls, sheet "credits".
|
||||
--
|
||||
-- Copyright (c) Gautier de Montmollin 2010..2012
|
||||
--
|
||||
-- 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;
|
||||
|
||||
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, 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 RLE_encoded (image: Image_descriptor) return Boolean;
|
||||
function 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:= "02";
|
||||
reference : constant String:= "8-Sep-2012";
|
||||
web: constant String:= "http://sf.net/projects/gen-img-dec/";
|
||||
-- Hopefully the latest version is at that URL...
|
||||
|
||||
private
|
||||
|
||||
use Interfaces;
|
||||
|
||||
subtype U8 is Unsigned_8;
|
||||
subtype U16 is Unsigned_16;
|
||||
subtype U32 is 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 is record
|
||||
red, green, blue : U8;
|
||||
end record;
|
||||
|
||||
type Color_table is array (Integer range <>) of RGB_color;
|
||||
|
||||
type p_Color_table is access Color_table;
|
||||
|
||||
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 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;
|
||||
display_orientation: Orientation;
|
||||
bits_per_pixel : Positive;
|
||||
RLE_encoded : Boolean:= False;
|
||||
transparency : Boolean:= False;
|
||||
greyscale : Boolean:= False;
|
||||
interlaced : Boolean:= False;
|
||||
flag_1 : Boolean; -- format-specific information
|
||||
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;
|
||||
|
||||
procedure Adjust (Object : in out Image_descriptor);
|
||||
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;
|
||||
|
||||
end GID;
|
||||
Reference in New Issue
Block a user