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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152 | --------------------------------------------------------------------------------------------------------------------
-- This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
with Ada.Real_Time;
with SDL;
with SDL.Events.Events;
with SDL.Events.Keyboards;
with SDL.Log;
with SDL.Video.Pixel_Formats;
with SDL.Video.Rectangles;
with SDL.Video.Surfaces;
with SDL.Video.Windows.Makers;
procedure Surface is
W : SDL.Video.Windows.Window;
begin
SDL.Log.Set (Category => SDL.Log.Application, Priority => SDL.Log.Debug);
if SDL.Initialise (Flags => SDL.Enable_Screen) = True then
SDL.Video.Windows.Makers.Create (Win => W,
Title => "Surface (Esc to exit)",
Position => SDL.Natural_Coordinates'(X => 100, Y => 100),
Size => SDL.Positive_Sizes'(800, 640),
Flags => SDL.Video.Windows.Resizable);
-- Main loop.
declare
Event : SDL.Events.Events.Events;
Window_Surface : SDL.Video.Surfaces.Surface;
Area : constant SDL.Video.Rectangles.Rectangle :=
(X => 10, Y => 10, Width => 50, Height => 50);
Areas : constant SDL.Video.Rectangles.Rectangle_Arrays :=
((X => 100, Y => 10, Width => 50, Height => 50),
(X => 120, Y => 20, Width => 50, Height => 50),
(X => 160, Y => 40, Width => 50, Height => 50));
Green_Area : constant SDL.Video.Rectangles.Rectangle :=
(X => 15, Y => 15, Width => 10, Height => 10);
Blue_Areas : constant SDL.Video.Rectangles.Rectangle_Arrays :=
((X => 150, Y => 15, Width => 10, Height => 10),
(X => 125, Y => 25, Width => 10, Height => 10),
(X => 165, Y => 45, Width => 10, Height => 10));
Blit_Copy_Area : constant SDL.Video.Rectangles.Rectangle :=
(X => 10, Y => 10, Width => 150, Height => 70);
Blit_Dest_Area : SDL.Video.Rectangles.Rectangle :=
(X => 10, Y => 130, Width => 100, Height => 100);
Finished : Boolean := False;
Loop_Start_Time_Goal : Ada.Real_Time.Time;
Loop_Start_Time_Real : Ada.Real_Time.Time;
Loop_Delay_Overhead_Time : Ada.Real_Time.Time_Span;
Loop_Delay_Overhead_Average : Ada.Real_Time.Time_Span :=
Ada.Real_Time.Time_Span_Zero;
Frame_Duration : constant Ada.Real_Time.Time_Span :=
Ada.Real_Time.Microseconds (16_667);
-- 60 Hz refresh rate
Loop_Debug_Iterator : Natural := 0;
use type SDL.Events.Keyboards.Key_Codes;
use type Ada.Real_Time.Time;
use type Ada.Real_Time.Time_Span;
begin
Window_Surface := W.Get_Surface;
Window_Surface.Fill (Area, SDL.Video.Pixel_Formats.To_Pixel
(Format => Window_Surface.Pixel_Format,
Red => 200,
Green => 100,
Blue => 150));
Window_Surface.Fill (Areas, SDL.Video.Pixel_Formats.To_Pixel
(Format => Window_Surface.Pixel_Format,
Red => 100,
Green => 100,
Blue => 150));
W.Update_Surface; -- Shows the above two calls.
Window_Surface.Fill (Green_Area, SDL.Video.Pixel_Formats.To_Pixel
(Format => Window_Surface.Pixel_Format,
Red => 100,
Green => 200,
Blue => 100));
W.Update_Surface_Rectangle (Rectangle => Green_Area);
Window_Surface.Fill (Blue_Areas, SDL.Video.Pixel_Formats.To_Pixel
(Format => Window_Surface.Pixel_Format,
Red => 150,
Green => 150,
Blue => 250));
W.Update_Surface_Rectangles (Rectangles => Blue_Areas);
Window_Surface.Blit_Scaled (Self_Area => Blit_Dest_Area,
Source => Window_Surface,
Source_Area => Blit_Copy_Area);
W.Update_Surface_Rectangle (Blit_Dest_Area);
-- Set next frame delay target using monotonic clock time
Loop_Start_Time_Goal := Ada.Real_Time.Clock;
SDL.Log.Put_Debug ("Frame duration: " &
Ada.Real_Time.To_Duration (Frame_Duration)'Img);
loop
Loop_Start_Time_Goal := Loop_Start_Time_Goal + Frame_Duration;
delay until Loop_Start_Time_Goal;
Loop_Start_Time_Real := Ada.Real_Time.Clock;
Loop_Delay_Overhead_Time := Loop_Start_Time_Real -
Loop_Start_Time_Goal;
Loop_Delay_Overhead_Average := (Loop_Delay_Overhead_Average +
Loop_Delay_Overhead_Time) / 2;
Loop_Debug_Iterator := Loop_Debug_Iterator + 1;
if Loop_Debug_Iterator mod 256 = 0 then
SDL.Log.Put_Debug ("Loop_Delay_Overhead_Time: " &
Ada.Real_Time.To_Duration (Loop_Delay_Overhead_Time)'Img);
SDL.Log.Put_Debug ("Loop_Delay_Overhead_Average: " &
Ada.Real_Time.To_Duration (Loop_Delay_Overhead_Average)'Img);
end if;
while SDL.Events.Events.Poll (Event) loop
case Event.Common.Event_Type is
when SDL.Events.Quit =>
Finished := True;
when SDL.Events.Keyboards.Key_Down =>
if Event.Keyboard.Key_Sym.Key_Code = SDL.Events.Keyboards.Code_Escape then
Finished := True;
end if;
when others =>
null;
end case;
end loop;
exit when Finished;
end loop;
end;
SDL.Log.Put_Debug ("");
W.Finalize;
SDL.Finalise;
end if;
end Surface;
|