+ some code
This commit is contained in:
parent
0e3735ed07
commit
42e503f9aa
|
@ -5,3 +5,5 @@
|
||||||
# Ada Library Information
|
# Ada Library Information
|
||||||
*.ali
|
*.ali
|
||||||
|
|
||||||
|
# build directory
|
||||||
|
build
|
|
@ -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;
|
|
@ -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;
|
|
@ -0,0 +1,5 @@
|
||||||
|
with Video.Backends.SDL;
|
||||||
|
procedure Hello_World_SDL is
|
||||||
|
begin
|
||||||
|
null;
|
||||||
|
end Hello_World_SDL;
|
|
@ -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;
|
|
@ -0,0 +1,3 @@
|
||||||
|
package Video.Backends.SDL with Elaborate_Body is
|
||||||
|
|
||||||
|
end Video.Backends.SDL;
|
|
@ -0,0 +1,6 @@
|
||||||
|
--
|
||||||
|
-- Common for all backends
|
||||||
|
--
|
||||||
|
|
||||||
|
package Video.Backends with Pure is
|
||||||
|
end Video.Backends;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -0,0 +1,5 @@
|
||||||
|
--
|
||||||
|
-- Video output
|
||||||
|
--
|
||||||
|
package Video.Display with Pure is
|
||||||
|
end Video.Display;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -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;
|
|
@ -0,0 +1,5 @@
|
||||||
|
--
|
||||||
|
-- Low level raster graphics
|
||||||
|
--
|
||||||
|
package Video.Rasters with Pure is
|
||||||
|
end Video.Rasters;
|
|
@ -0,0 +1,5 @@
|
||||||
|
--
|
||||||
|
-- All the stuff related to graphics, images and video IO
|
||||||
|
--
|
||||||
|
package Video with Pure is
|
||||||
|
end Video;
|
|
@ -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;
|
Loading…
Reference in New Issue