Vovanium
/
Video_library
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Minimal SDL bindigs example is working now

This commit is contained in:
Vovanium 2023-08-02 13:01:59 +03:00
parent 90be758bcb
commit 88d027950f
7 changed files with 94 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
source/examples/example_sdl_minimal.adb
View File

@ -1,18 +1,32 @@
with Video.Pixels.RGB.Renderers;
with Video.SDL_Minimal;
with Video.SDL_Minimal.Video;
with Video.SDL_Minimal.Pixels;
with Video.SDL_Minimal.Render;
with Video.SDL_Minimal.Events;
use type Video.SDL_Minimal.Events.EventType;
with Interfaces.C;
use Interfaces;
use type Interfaces.C.int;
with Example_Scene;
procedure Example_SDL_Minimal
is
Screen_Width : constant := 640;
Screen_Height : constant := 480;
Wnd : Video.SDL_Minimal.Video.Window_Access;
Rend : Video.SDL_Minimal.Render.Renderer_Access;
Screen : aliased Video.Pixels.RGB.RGB565_Array := (0 .. Screen_Height - 1 => (0 .. Screen_Width - 1 => <>));
Rend : Video.Pixels.RGB.Renderers.RGB565_Color_Renderers.Color_Renderer (Screen'Access);
Wnd : Video.SDL_Minimal.Video.Window_Ptr;
Wnd_Rend : Video.SDL_Minimal.Render.Renderer_Ptr;
Tx : Video.SDL_Minimal.Render.Texture_Ptr;
Ev : Video.SDL_Minimal.Events.Event;
procedure Catch (Err : C.int) is
begin
if Err /= 0 then
raise Program_Error;
end if;
end;
begin
Wnd := Video.SDL_Minimal.Video.CreateWindow (
Title => "Hello World",
@ -22,15 +36,30 @@ begin
H => Screen_Height,
Flags => 0);
Wnd_Rend := Video.SDL_Minimal.Render.CreateRenderer (Wnd);
Tx := Video.SDL_Minimal.Render.CreateTexture (Wnd_Rend,
Video.SDL_Minimal.Pixels.PixelFormat_RGB565,
Video.SDL_Minimal.Render.TextureAccess_Static,
Screen_Width, Screen_Height);
Example_Scene (Rend);
Catch (Video.SDL_Minimal.Render.UpdateTexture (Tx, null, Screen'Address, Screen_Width * 2));
Catch (Video.SDL_Minimal.Render.RenderClear (Wnd_Rend));
Catch (Video.SDL_Minimal.Render.RenderCopy (Wnd_Rend, Tx, null, null));
Video.SDL_Minimal.Render.RenderPresent (Wnd_Rend);
Wait : loop
while Video.SDL_Minimal.Events.PollEvent (Ev) /= 0 loop
exit Wait when Ev.Common.Kind = Video.SDL_Minimal.Events.Quit;
end loop;
end loop Wait;
Rend := Video.SDL_Minimal.Render.CreateRenderer (Wnd);
Video.SDL_Minimal.Render.DestroyTexture (Tx);
Video.SDL_Minimal.Render.DestroyRenderer (Rend);
Video.SDL_Minimal.Render.DestroyRenderer (Wnd_Rend);
Video.SDL_Minimal.Video.DestroyWindow (Wnd);

5
source/sdl_minimal/video-sdl_constants.c
View File

@ -3,6 +3,7 @@
#include <SDL2/SDL_video.h>
/* from SDL */
const Uint32 SDL_Init_Everything = SDL_INIT_EVERYTHING;
/* from SDL_events */
@ -18,6 +19,10 @@ const size_t SDL_EventSize = sizeof (SDL_Event);
const Uint32 SDL_PixelFormat_RGB565 = SDL_PIXELFORMAT_RGB565;
/* from SDL_render */
const Sint32 SDL_TextureAccess_Static = SDL_TEXTUREACCESS_STATIC;
/* from SDL_video */
const int SDL_WindowPos_Centered = SDL_WINDOWPOS_CENTERED;

2
source/sdl_minimal/video-sdl_minimal-events.ads
View File

@ -70,7 +70,7 @@ package Video.SDL_Minimal.Events is
AdaEventSize : Integer := Event'Max_Size_In_Storage_Elements;
type Event_Access is access all Event with Convention => C;
type Event_Ptr is access all Event with Convention => C;
function PollEvent (Ev : in out Event) return C.int
with Import, Convention => C, External_Name => "SDL_PollEvent";

13
source/sdl_minimal/video-sdl_minimal-rect.ads Normal file
View File

@ -0,0 +1,13 @@
with Interfaces.C;
use Interfaces;
package Video.SDL_Minimal.Rect is
type Rect is record
X, Y : C.int;
W, H : C.int;
end record with Convention => C;
type Rect_Ptr is access all Rect;
end Video.SDL_Minimal.Rect;

43
source/sdl_minimal/video-sdl_minimal-render.ads
View File

@ -1,42 +1,71 @@
with Interfaces.C;
use Interfaces;
use type Interfaces.C.int;
with System;
with Video.SDL_Minimal.Video;
use Video.SDL_Minimal.Video;
with Video.SDL_Minimal.Pixels;
use Video.SDL_Minimal.Pixels;
with Video.SDL_Minimal.Rect;
use Video.SDL_Minimal.Rect;
package Video.SDL_Minimal.Render is
type Renderer is limited private;
type Renderer_Access is access all Renderer;
type Renderer_Ptr is access all Renderer;
type Texture is limited private;
type Texture_Access is access all Texture;
type Texture_Ptr is access all Texture;
type RendererFlags is new Unsigned_32;
type TextureAccess is new Integer_32;
TextureAccess_Static : constant TextureAccess with Import, External_Name => "SDL_TextureAccess_Static";
function CreateRenderer (
Wnd : Window_Access;
Wnd : Window_Ptr;
Index : C.int := -1;
Flags : RendererFlags := 0)
return Renderer_Access
return Renderer_Ptr
with Import, Convention => C, External_Name => "SDL_CreateRenderer";
procedure DestroyRenderer (Rend : Renderer_Access)
procedure DestroyRenderer (Rend : Renderer_Ptr)
with Import, Convention => C, External_Name => "SDL_DestroyRenderer";
function RenderClear (Rend : Renderer_Ptr) return C.int
with Import, Convention => C, External_Name => "SDL_RenderClear";
function RenderCopy (
Rend : Renderer_Ptr;
Tx : Texture_Ptr;
SrcRect,
DstRect : Rect_Ptr)
return C.int
with Import, Convention => C, External_Name => "SDL_RenderCopy";
procedure RenderPresent (Rend : Renderer_Ptr)
with Import, Convention => C, External_Name => "SDL_RenderPresent";
function CreateTexture (
Rend : Renderer_Access;
Rend : Renderer_Ptr;
Format : PixelFormatEnum;
Acs : TextureAccess;
W : C.int;
H : C.int)
return Texture_Access
return Texture_Ptr
with Import, Convention => C, External_Name => "SDL_CreateTexture";
procedure DestroyTexture (Tx : Texture_Ptr)
with Import, Convention => C, External_Name => "SDL_DestroyTexture";
function UpdateTexture (
Tx : Texture_Ptr;
Rect : Rect_Ptr;
Pixels : System.Address;
Pitch : C.int)
return C.int
with Import, Convention => C, External_Name => "SDL_UpdateTexture";
private
type Renderer is null record;

4
source/sdl_minimal/video-sdl_minimal-video.adb
View File

@ -4,10 +4,10 @@ package body Video.SDL_Minimal.Video is
Title : in String;
X, Y, W, H : in C.int;
Flags : in Window_Flags)
return Window_Access
return Window_Ptr
is
T : C.Strings.chars_ptr := C.Strings.New_String (Title);
R : Window_Access;
R : Window_Ptr;
begin
R := CreateWindow (T, X, Y, W, H, Flags);
C.Strings.Free (T);

8
source/sdl_minimal/video-sdl_minimal-video.ads
View File

@ -5,7 +5,7 @@ package Video.SDL_Minimal.Video is
type Window is limited private;
type Window_Access is access all Window with Convention => C;
type Window_Ptr is access all Window with Convention => C;
WindowPos_Centered : constant C.int
with Import, External_Name => "SDL_WindowPos_Centered";
@ -16,16 +16,16 @@ package Video.SDL_Minimal.Video is
Title : in C.Strings.chars_Ptr;
X, Y, W, H : in C.int;
Flags : in Window_Flags)
return Window_Access
return Window_Ptr
with Import, Convention => C, External_Name => "SDL_CreateWindow";
function CreateWindow (
Title : in String;
X, Y, W, H : in C.int;
Flags : in Window_Flags)
return Window_Access;
return Window_Ptr;
procedure DestroyWindow (Wnd : in Window_Access)
procedure DestroyWindow (Wnd : in Window_Ptr)
with Import, Convention => C, External_Name => "SDL_DestroyWindow";
private