+ some code

.gitignore

@@ -5,3 +5,5 @@
 # Ada Library Information
 *.ali
 
+# build directory
+build

common.gpr

@@ -0,0 +1,20 @@
+abstract project Common is
+
+	for Object_Dir use "build/objects";
+	for Library_Dir use "build/lib";
+	for Exec_Dir use "build/bin";
+
+	for Create_Missing_Dirs use "True";
+
+	package Compiler is
+		for Default_Switches ("Ada") use(
+			"-gnato12",
+			"-gnatW8",
+			"-gnatyabfikltx");
+	end Compiler;
+
+	package Binder is
+		for Switches ("Ada") use ("-Es"); --  Symbolic traceback
+	end Binder;
+
+end Common;

examples/example_sdl.gpr

@@ -0,0 +1,6 @@
+with "../video_sdl";
+project Example_SDL extends "../common" is
+	for Object_Dir use "../build/objects";
+	for Exec_Dir use "../build/bin";
+	for Main use ("hello_world_sdl.adb");
+end Example_SDL;

examples/hello_world_sdl.adb

@@ -0,0 +1,5 @@
+with Video.Backends.SDL;
+procedure Hello_World_SDL is
+begin
+	null;
+end Hello_World_SDL;

source/backends/sdl/video-backends-sdl.adb

@@ -0,0 +1,13 @@
+with Interfaces.C;
+use type Interfaces.C.int;
+
+package body Video.Backends.SDL is
+
+	function SDL_Init (Flags : Interfaces.Unsigned_32) return Interfaces.C.int
+	with Import, Convention => C, External_Name => "SDL_Init";
+
+begin
+	if SDL_Init (0) < 0 then
+		raise Program_Error;
+	end if;
+end Video.Backends.SDL;

source/backends/sdl/video-backends-sdl.ads

@@ -0,0 +1,3 @@
+package Video.Backends.SDL with Elaborate_Body is
+
+end Video.Backends.SDL;

source/video-backends.ads

@@ -0,0 +1,6 @@
+--
+-- Common for all backends
+--
+
+package Video.Backends with Pure is
+end Video.Backends;

source/video-colors.adb

@@ -0,0 +1,14 @@
+package body Video.Colors is
+
+	function From_8_Bit (Value : Color_Component_8_Bit) return Color_Component is (Color_Component (Value));
+
+	function To_8_Bit (Value : Color_Component) return Color_Component_8_Bit is (Color_Component_8_Bit (Value));
+
+	function RGB_8 (
+		R, G, B : Color_Component_8_Bit;
+		A       : Color_Component_8_Bit := Color_Component_8_Bit'Last)
+		return Color is
+		((R => From_8_Bit (R), G => From_8_Bit (G), B => From_8_Bit (B), A => From_8_Bit (A)));
+
+
+end Video.Colors;

source/video-colors.ads

@@ -0,0 +1,36 @@
+--
+-- Color management
+--
+package Video.Colors with Pure is
+
+	Color_Component_Bits : constant := 8;
+	type Color_Component is private;
+	-- Universal definition for color component (like R, G, B channels or Alpha)
+	-- defined to cover the best color resolution required (e. g. 8 bit in true color systems)
+
+	subtype Color_Component_8_Bit is Integer range 0 .. 2**8 - 1;
+	-- Integer representation of a color component in range 0 .. 255;
+
+	function From_8_Bit (Value : Color_Component_8_Bit) return Color_Component with Inline;
+	-- Convert from integer reptesentation
+
+	function To_8_Bit (Value : Color_Component) return Color_Component_8_Bit with Inline;
+	-- Comvert to integer representation
+
+	type Color is record
+		R : Color_Component;
+		G : Color_Component;
+		B : Color_Component;
+		A : Color_Component;
+	end record;
+
+	function RGB_8 (
+		R, G, B : Color_Component_8_Bit;
+		A       : Color_Component_8_Bit := Color_Component_8_Bit'Last)
+		return Color with Inline;
+	-- Define color by R, G, B and alpha 8 bit components
+
+private
+	type Color_Component is range 0 .. 2**Color_Component_Bits - 1;
+
+end Video.Colors;

source/video-display-modes.ads

@@ -0,0 +1,54 @@
+--
+-- Video display modes: geomtries and timings
+--
+package Video.Display.Modes with Pure is
+
+	--                   Horiz. period
+	--   :<-------------------------------------->:
+	--   :H.Sync                                  :
+	--  >:--:<                                    :
+	--   :  :H. back                              :
+	--   :  :porch       Horiz. active            :
+	--   :  :<-->:<------------------------->:    :           V. sync
+	--   :__:____:___________________________:____:..............V.......
+	--   |  :____:___________Vsync___________:____|..............|.    ^
+	--   |  |    :       Blanking area       :    |V. back porch ^     |
+	--   |  |    :___________________________:....|..............V.    |
+	--   |H |    |  ________Border_________  |    |        ^           |
+	--   |S |    | |                       | |    |        |           |
+	--   |y |    | |                       | |    |        |           |
+	--   |n |    | |        Graphic        | |    |  Vert. |     Vert. |
+	--   |v |    | |         Area          | |    | Active |    period |
+	--   |  |    | |                       | |    |        |           |
+	--   |  |    | |                       | |    |        |           |
+	--   |  |    | |_______________________| |    |        |           |
+	--   |  |    |___________________________|....|........V.          |
+	--   |  |                                     |                    |
+	--   |__|_____________________________________|....................V.
+	--
+	-- Front porch = Period - Active - Back porch - Back porch
+	-- (for both vertical and horizontal)
+
+	type Frequency_Hz is range 0 .. 2_000_000_000;
+
+	type Polarity is (
+		Active_High,
+		Active_Low
+	);
+
+	type Video_Geometry is record
+		Pixel_Clock_Frequency_Hz : Frequency_Hz; -- Value in Hertz
+		Horizontal_Period        : Integer; -- Value in pixel clock ticks
+		Horizontal_Sync          : Integer;
+		Horizontal_Back_Porch    : Integer; -- Timing between end of HSync and start of active area
+		Horizontal_Active        : Integer;
+		Vertical_Period          : Integer; -- Vertical scan period in value in lines
+		Vertical_Sync            : Integer;
+		Vertical_Back_Porch      : Integer;
+		Vertical_Active          : Integer;
+		Horizontal_Sync_Polarity : Polarity;
+		Vertical_Sync_Polarity   : Polarity;
+		Composite_Sync_Polarity  : Polarity;
+	end record;
+
+end Video.Display.Modes;

source/video-display.ads

@@ -0,0 +1,5 @@
+--
+-- Video output
+--
+package Video.Display with Pure is
+end Video.Display;

source/video-integer_geometry.ads

@@ -0,0 +1,11 @@
+package Video.Integer_Geometry with Pure is
+
+	type Point is record
+		X, Y : Integer;
+	end record;
+
+	type Rectangle is record
+		X_Min, X_Max, Y_Min, Y_Max : Integer;
+	end record;
+
+end Video.Integer_Geometry;

source/video-rasters-generic_blits-masked.adb

@@ -0,0 +1,19 @@
+package body Video.Rasters.Generic_Blits.Masked is
+	procedure Fill_Masked (
+		Color  : in     Pixel;
+		Mask   : in     Mask_Raster;
+		Offset : in     Video.Integer_Geometry.Point;
+		Target : in out Raster;
+		Bounds : in     Video.Integer_Geometry.Rectangle)
+	is
+	begin
+		for Y in Bounds.Y_Min .. Bounds.Y_Max loop
+			for X in Bounds.X_Min .. Bounds.X_Max loop
+				if Mask (Y - Offset.Y, X - Offset.X) /= Mask_Value then
+					Target (Y, X) := Color;
+				end if;
+			end loop;
+		end loop;
+	end Fill_Masked;
+
+end Video.Rasters.Generic_Blits.Masked;

source/video-rasters-generic_blits-masked.ads

@@ -0,0 +1,17 @@
+--
+-- Generic software low level renderer for 1 bit masks
+--
+generic
+	type Mask_Pixel is (<>);
+	type Mask_Raster is array (Integer range <>, Integer range <>) of Mask_Pixel;
+	Mask_Value : in Mask_Pixel := Mask_Pixel'First; -- Masking value (typically 0)
+package Video.Rasters.Generic_Blits.Masked is
+
+	procedure Fill_Masked (
+		Color  : in     Pixel;
+		Mask   : in     Mask_Raster;
+		Offset : in     Video.Integer_Geometry.Point; -- Mask coordinate offset
+		Target : in out Raster;
+		Bounds : in     Video.Integer_Geometry.Rectangle); -- Boundary rectangle in Target coords
+
+end Video.Rasters.Generic_Blits.Masked;

source/video-rasters-generic_blits.adb

@@ -0,0 +1,16 @@
+package body Video.Rasters.Generic_Blits is
+
+	procedure Fill_Rectangle (
+		Color  : in     Pixel;
+		Target : in out Raster;
+		Bounds : in     Video.Integer_Geometry.Rectangle)
+	is
+	begin
+		for Y in Bounds.Y_Min .. Bounds.Y_Max loop
+			for X in Bounds.X_Min .. Bounds.X_Max loop
+				Target (Y, X) := Color;
+			end loop;
+		end loop;
+	end;
+
+end Video.Rasters.Generic_Blits;

source/video-rasters-generic_blits.ads

@@ -0,0 +1,15 @@
+with Video.Integer_Geometry;
+--
+-- Generic software low level renderer
+--
+generic
+	type Pixel is private;
+	type Raster is array (Integer range <>, Integer range <>) of Pixel;
+package Video.Rasters.Generic_Blits is
+
+	procedure Fill_Rectangle (
+		Color  : in     Pixel;
+		Target : in out Raster;
+		Bounds : in     Video.Integer_Geometry.Rectangle);
+
+end Video.Rasters.Generic_Blits;

source/video-rasters-indexed.ads

@@ -0,0 +1,9 @@
+package Video.Rasters.Indexed with Pure is
+
+	type Index_1_Pixel is mod 2;
+	type Index_4_Pixel is mod 16;
+
+	type Index_1_Raster is array (Integer range <>, Integer range <>) of Index_1_Pixel with Pack;
+	type Index_4_Raster is array (Integer range <>, Integer range <>) of Index_4_Pixel with Pack;
+
+end Video.Rasters.Indexed;

source/video-rasters-rgb.ads

@@ -0,0 +1,106 @@
+with Video.Colors;
+use  Video.Colors;
+
+--
+-- RGB rasters
+--
+package Video.Rasters.RGB is
+
+	-- Pixel formats
+	--  1 1 1 1 1 1
+	--  5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+	-- +---------+-----------+---------+
+	-- |    R    |     G     |    B    | RGB565 (aka RGB16)
+	-- +---------+-----------+---------+
+	-- +-+---------+---------+---------+
+	-- |A|    R    |    G    |    B    | ARGB1555
+	-- +-+---------+---------+---------+
+	--  2 2 2 2 1 1 1 1 1 1 1 1 1 1
+	--  3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+	-- +---------------+---------------+---------------+
+	-- |       R       |       G       |       B       | RGB888 (aka RGB24)
+	-- +---------------+---------------+---------------+
+	--  3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
+	--  1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+	-- +---------------+---------------+---------------+---------------+
+	-- |       A       |       R       |       G       |       B       | ARGB8888 (aka ARGB32)
+	-- +---------------+---------------+---------------+---------------+
+
+	-- RGB565
+
+	type RGB565_Pixel is record
+		R : Integer range 0 .. 2**5 - 1;
+		G : Integer range 0 .. 2**6 - 1;
+		B : Integer range 0 .. 2**5 - 1;
+	end record with Size => 16;
+	for RGB565_Pixel use record
+		R at 0 range 11 .. 15;
+		G at 0 range  5 .. 10;
+		B at 0 range  0 ..  4;
+	end record;
+
+	function RGB_8 (
+		R, G, B : Color_Component_8_Bit)
+		return RGB565_Pixel
+	is ((R => R / 8, G => G / 4, B => B / 8))
+	with Inline;
+
+	type RGB565_Raster is array (Integer range <>, Integer range <>) of RGB565_Pixel;
+
+	-- ARGB1555
+
+	type ARGB1555_Pixel is record
+		R : Integer range 0 .. 2**5 - 1;
+		G : Integer range 0 .. 2**5 - 1;
+		B : Integer range 0 .. 2**5 - 1;
+		A : Integer range 0 .. 1;
+	end record with Size => 16;
+	for ARGB1555_Pixel use record
+		R at 0 range 10 .. 14;
+		G at 0 range  5 ..  9;
+		B at 0 range  0 ..  4;
+		A at 0 range 15 .. 15;
+	end record;
+
+	function RGB_8 (
+		R, G, B : Color_Component_8_Bit;
+		A : Color_component_8_Bit := Color_Component_8_Bit'Last)
+		return ARGB1555_Pixel
+	is ((R => R / 8, G => G / 8, B => B / 8, A => A / 128))
+	with Inline;
+
+	type ARGB1555_Raster is array (Integer range <>, Integer range <>) of ARGB1555_Pixel;
+
+	-- RGB888
+
+	type RGB888_Pixel is record
+		R : Integer range 0 .. 2**8 - 1;
+		G : Integer range 0 .. 2**8 - 1;
+		B : Integer range 0 .. 2**8 - 1;
+	end record with Size => 24;
+	for RGB888_Pixel use record
+		R at 0 range 16 .. 23;
+		G at 0 range  8 .. 15;
+		B at 0 range  0 ..  7;
+	end record;
+
+	type RGB888_Raster is array (Integer range <>, Integer range <>) of RGB888_Pixel;
+
+	-- ARGB8888
+
+	type ARGB8888_Pixel is record
+		R : Integer range 0 .. 2**8 - 1;
+		G : Integer range 0 .. 2**8 - 1;
+		B : Integer range 0 .. 2**8 - 1;
+		A : Integer range 0 .. 2**8 - 1;
+	end record with Size => 32;
+	for ARGB8888_Pixel use record
+		R at 0 range 16 .. 23;
+		G at 0 range  8 .. 15;
+		B at 0 range  0 ..  7;
+		A at 0 range 24 .. 31;
+	end record;
+
+	type ARGB8888_Raster is array (Integer range <>, Integer range <>) of ARGB8888_Pixel;
+
+end Video.Rasters.RGB;

source/video-rasters.ads

@@ -0,0 +1,5 @@
+--
+-- Low level raster graphics
+--
+package Video.Rasters with Pure is
+end Video.Rasters;

source/video.ads

@@ -0,0 +1,5 @@
+--
+-- All the stuff related to graphics, images and video IO
+--
+package Video with Pure is
+end Video;

video_sdl.gpr

@@ -0,0 +1,14 @@
+project Video_SDL extends "common" is
+
+	for Library_Name use "Video_SDL";
+
+	for Source_Dirs use ("source", "source/backends/sdl");
+	for Object_Dir use "build/objects";
+
+	for Library_Kind use "static";
+
+	package Linker is
+		for Linker_Options use ("-lSDL2");
+	end Linker;
+
+end Video_SDL;