sdlada_2.5.20_cd53c280/src/video/sdl-video-windows-makers.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
--------------------------------------------------------------------------------------------------------------------
--  This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
with Interfaces.C;
with Interfaces.C.Strings;
private with SDL.C_Pointers;
with SDL.Error;

package body SDL.Video.Windows.Makers is
   package C renames Interfaces.C;

   use type SDL.C_Pointers.Windows_Pointer;

   procedure Create
     (Win      : in out Window;
      Title    : in Ada.Strings.UTF_Encoding.UTF_8_String;
      Position : in SDL.Natural_Coordinates;
      Size     : in SDL.Positive_Sizes;
      Flags    : in Window_Flags := OpenGL) is

      function SDL_Create
        (Title      : C.Strings.chars_ptr;
         X, Y, W, H : in C.int;
         F          : in Window_Flags) return SDL.C_Pointers.Windows_Pointer with
        Import        => True,
        Convention    => C,
        External_Name => "SDL_CreateWindow";

      C_Title_Str : C.Strings.chars_ptr := C.Strings.New_String (Title);
   begin
      Win.Internal := SDL_Create (C_Title_Str, Position.X, Position.Y, Size.Width, Size.Height, Flags);

      C.Strings.Free (C_Title_Str);

      if Win.Internal = null then
         raise Window_Error with SDL.Error.Get;
      end if;

      Increment_Windows;
   end Create;

   procedure Create
     (Win    : in out Window;
      Title  : in Ada.Strings.UTF_Encoding.UTF_8_String;
      X      : in SDL.Natural_Coordinate;
      Y      : in SDL.Natural_Coordinate;
      Width  : in SDL.Positive_Dimension;
      Height : in SDL.Positive_Dimension;
      Flags  : in Window_Flags := OpenGL) is
   begin
      Create (Win, Title, SDL.Natural_Coordinates'(X, Y), SDL.Positive_Sizes'(Width, Height), Flags);
   end Create;

   procedure Create (Win : in out Window; Native : in Native_Window) is
      function SDL_Create_Window_From (Native : Native_Window) return SDL.C_Pointers.Windows_Pointer with
        Import        => True,
        Convention    => C,
        External_Name => "SDL_CreateWindowFrom";
   begin
      Win.Internal := SDL_Create_Window_From (Native);
      Win.Owns     := True;

      if Win.Internal = null then
         raise Window_Error with SDL.Error.Get;
      end if;

      Increment_Windows;
   end Create;
end SDL.Video.Windows.Makers;