sdlada_2.5.20_cd53c280/src/rwops/sdl-rwops-streams.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
70
71
72
73
74
75
76
77
--------------------------------------------------------------------------------------------------------------------
--  This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
with SDL.Error;

package body SDL.RWops.Streams is
   use type Interfaces.C.unsigned_long;

   function Open (Op : in RWops) return RWops_Stream is
   begin
      return (Ada.Streams.Root_Stream_Type with Context => Op);
   end Open;

   procedure Open (Op : in RWops; Stream : out RWops_Stream) is
   begin
      Stream.Context := Op;
   end Open;

   procedure Close (Stream : in RWops_Stream) is
   begin
      Close (Stream.Context);
   end Close;

   overriding
   procedure Read (Stream : in out RWops_Stream;
                   Item   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset)
   is
      Objects_Read : Interfaces.C.unsigned_long := 0;
   begin
      --  Re-implemented c-macro:
      --  #define SDL_RWread(ctx, ptr, size, n)   (ctx)->read(ctx, ptr, size, n)

      --  Read   : access function
      --    (context : RWops_Pointer;
      --     ptr     : System.Address;
      --     size    : Interfaces.C.unsigned_long;
      --     maxnum  : Interfaces.C.unsigned_long) return Interfaces.C.unsigned_long;

      Objects_Read := Stream.Context.Read
        (Context  => RWops_Pointer (Stream.Context),
         Ptr      => Item'Address,
         Size     => Item'Length,
         Max_Num  => 1);

      if Objects_Read = 0 then
         raise RWops_Error with SDL.Error.Get;
      end if;

      Last := Item'Length;
   end Read;

   overriding
   procedure Write (Stream : in out RWops_Stream; Item : Ada.Streams.Stream_Element_Array)
   is
      Objects_Written : Interfaces.C.unsigned_long := 0;
   begin
      --  Re-implemented c-macro:
      --  #define SDL_RWwrite(ctx, ptr, size, n)  (ctx)->write(ctx, ptr, size, n)

      --  Write  : access function
      --    (Context : RWops_Pointer;
      --     Ptr     : System.Address;
      --     Size    : Interfaces.C.unsigned_long;
      --     Num     : Interfaces.C.unsigned_long) return Interfaces.C.unsigned_long;

      Objects_Written := Stream.Context.Write
        (Context => RWops_Pointer (Stream.Context),
         Ptr     => Item'Address,
         Size    => Item'Length,
         Num     => 1);

      if Objects_Written = 0 then
         raise RWops_Error with SDL.Error.Get;
      end if;
   end Write;
end SDL.RWops.Streams;