sdlada_2.5.20_cd53c280/src/video/sdl-video-textures.ads

  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
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
--------------------------------------------------------------------------------------------------------------------
--  This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
--  SDL.Video.Textures
--
--  Texture abstraction.
--------------------------------------------------------------------------------------------------------------------
with Ada.Finalization;
private with SDL.C_Pointers;
with SDL.Video.Palettes;
with SDL.Video.Pixel_Formats;
with SDL.Video.Pixels;
with SDL.Video.Rectangles;

package SDL.Video.Textures is
   pragma Preelaborate;

   Texture_Error : exception;

   --  Was SDL_TextureAccess.
   type Kinds is (Static, Streaming, Target) with
     Convention => C;

   type Texture is new Ada.Finalization.Limited_Controlled with private;

   function Null_Texture return Texture;

   procedure Destroy (Self : in out Texture);

   --  Get the alpha value to be multiplied (modulated) into render copy operations.
   function Get_Alpha (Self : in Texture) return SDL.Video.Palettes.Colour_Component;
   procedure Set_Alpha (Self : in out Texture; Alpha : in SDL.Video.Palettes.Colour_Component);

   function Get_Blend_Mode (Self : in Texture) return Blend_Modes;
   procedure Set_Blend_Mode (Self : in out Texture; Mode : in Blend_Modes);

   function Get_Modulate_Colour (Self : in Texture) return SDL.Video.Palettes.RGB_Colour;
   procedure Set_Modulate_Colour (Self : in out Texture; Colour : in SDL.Video.Palettes.RGB_Colour);

   --  TODO: Fix this.
   --  Lock returns access to pixel data as write-only.
   --  function Lock (Self : in out Texture; Pixel_Data : out SDL.Video.Pixels.Pixel) return Boolean with
   --  function Lock (Self : in out Texture; Area : in SDL.Video.Rectangles.Rectangle;
   --    Pixel_Data : out SDL.Video.Pixels.Pixel) return Boolean with
   --    Pre  => Self.Locked = False,
   --    Post => Result = True and then Self.Locked = True;
   --
   --  Lock should return an object representing the bitmap data. We should be able to access it like an array,
   --  e.g. (x, y) and also using an iterator, which traverses, top -> bottom, left -> right, 1 pixel at a time. We
   --  need to be able to do subimage copies using Ada's slices, e.g. bm1 (x .. x2, y .. y2) := bm2 (x .. x2, y .. y2)
   --
   --  For YV12 format:
   --

   --  package ARGB_8888_Array is new SDL.Video.Pixels.Texture_Data (Width => , Height => , Element => );
   --     procedure Lock_Texture (Self   : in out Texture;
   --                             Pixels : out SDL.Video.Pixels.Pixel_ARGB_8888_Array_Access);

   --  Lock
   --
   --  Lock the entire texture data.
   --
   --  There will be multiple pixel formats, there should only be one Lock sub-program to handle them all.
   generic
      type Pixel_Pointer_Type is private;
   procedure Lock (Self   : in out Texture;
                   Pixels : out Pixel_Pointer_Type);

   --  Lock
   --
   --  Lock a particular area of the texture data.
   generic
      type Pixel_Pointer_Type is private;
   procedure Lock_Area (Self   : in out Texture;
                        Area   : in SDL.Video.Rectangles.Rectangle;
                        Pixels : out Pixel_Pointer_Type;
                        Pitch  : out SDL.Video.Pixels.Pitches);

   procedure Unlock (Self : in out Texture);

   procedure Query (Self              : in Texture;
                    Pixel_Format_Name : out SDL.Video.Pixel_Formats.Pixel_Format_Names;
                    Kind              : out Kinds;
                    Size              : out SDL.Sizes);

   function Get_Pixel_Format (Self : in Texture) return SDL.Video.Pixel_Formats.Pixel_Format_Names;
   function Get_Kind (Self : in Texture) return Kinds;
   function Get_Size (Self : in Texture) return SDL.Sizes;

   --  SDL_UpdateTexture
   --  SDL_UpdateYUVTexture
private
   type Texture is new Ada.Finalization.Limited_Controlled with
      record
         Internal     : SDL.C_Pointers.Texture_Pointer             := null;
         Owns         : Boolean                                    := True;
         Locked       : Boolean                                    := False;
         Size         : SDL.Sizes                                  := SDL.Zero_Size;
         Pixel_Format : SDL.Video.Pixel_Formats.Pixel_Format_Names := SDL.Video.Pixel_Formats.Pixel_Format_Unknown;
      end record;

   overriding
   procedure Finalize (Self : in out Texture);

   function Get_Internal_Texture (Self : in Texture) return SDL.C_Pointers.Texture_Pointer with
     Export     => True,
     Convention => Ada;

   function Null_Texture return Texture is (Texture'(Ada.Finalization.Limited_Controlled with
                                       Internal     => null,
                                       Owns         => True,
                                       Size         => SDL.Zero_Size,
                                       Pixel_Format => Pixel_Formats.Pixel_Format_Unknown,
                                       Locked       => False));
end SDL.Video.Textures;