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 | --------------------------------------------------------------------------------------------------------------------
-- This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
with Ada.Real_Time; use Ada.Real_Time;
with SDL;
with SDL.Events.Events;
with SDL.Events.Keyboards;
with SDL.Inputs.Mice;
with SDL.Log;
with SDL.Video.Pixel_Formats;
with SDL.Video.Renderers.Makers;
with SDL.Video.Textures.Makers;
with SDL.Video.Windows.Makers;
procedure Mouse is
Window_Size : constant SDL.Positive_Sizes := SDL.Positive_Sizes'(800, 640);
W : SDL.Video.Windows.Window;
Renderer : SDL.Video.Renderers.Renderer;
Texture : SDL.Video.Textures.Texture;
Loop_Start_Time_Goal : Ada.Real_Time.Time;
Frame_Duration : constant Ada.Real_Time.Time_Span :=
Ada.Real_Time.Microseconds (16_667);
-- 60 Hz refresh rate (set to anything you like)
begin
SDL.Log.Set (Category => SDL.Log.Application, Priority => SDL.Log.Debug);
if SDL.Initialise = True then
SDL.Video.Windows.Makers.Create (Win => W,
Title => "Mouse",
Position => SDL.Natural_Coordinates'(X => 300, Y => 300),
Size => Window_Size,
Flags => SDL.Video.Windows.Resizable);
SDL.Video.Renderers.Makers.Create (Renderer, W);
SDL.Video.Textures.Makers.Create (Tex => Texture,
Renderer => Renderer,
Format => SDL.Video.Pixel_Formats.Pixel_Format_ARGB_8888,
Kind => SDL.Video.Textures.Streaming,
Size => Window_Size);
-- Main loop.
declare
Event : SDL.Events.Events.Events;
Finished : Boolean := False;
Mouse_Shown : Boolean := True;
Warp_Rel : Boolean := True;
Warp_Screen : Boolean := False;
begin
-- Set next frame delay target using monotonic clock time
Loop_Start_Time_Goal := Ada.Real_Time.Clock;
loop
-- Limit event loop to 60 Hz using realtime "delay until"
Loop_Start_Time_Goal := Loop_Start_Time_Goal + Frame_Duration;
delay until Loop_Start_Time_Goal;
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 =>
case Event.Keyboard.Key_Sym.Key_Code is
when SDL.Events.Keyboards.Code_Escape =>
Finished := True;
when SDL.Events.Keyboards.Code_M =>
Mouse_Shown := not Mouse_Shown;
SDL.Inputs.Mice.Show_Cursor (Mouse_Shown);
SDL.Log.Put_Debug ("Mouse Shown : " & Boolean'Image (Mouse_Shown));
when SDL.Events.Keyboards.Code_R =>
Warp_Rel := True;
SDL.Log.Put_Debug ("Mouse warp relative: " & Boolean'Image (Warp_Rel));
when SDL.Events.Keyboards.Code_A =>
Warp_Rel := False;
SDL.Log.Put_Debug ("Mouse warp relative: " & Boolean'Image (Warp_Rel));
when SDL.Events.Keyboards.Code_W =>
SDL.Log.Put_Debug ("Warping mouse!");
if Warp_Screen then
SDL.Inputs.Mice.Warp ((0, 0));
else
SDL.Inputs.Mice.Warp (W, (0, 0));
end if;
when SDL.Events.Keyboards.Code_S =>
Warp_Screen := not Warp_Screen;
SDL.Log.Put_Debug ("Mouse warp to " & (if Warp_Screen then "screen!" else "window!"));
when others =>
null;
end case;
when others =>
null;
end case;
end loop;
Renderer.Clear;
Renderer.Copy (Texture);
Renderer.Present;
exit when Finished;
end loop;
end;
W.Finalize;
SDL.Finalise;
end if;
end Mouse;
|