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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316 | with Ada.Characters.Latin_1;
with Ada.Containers.Ordered_Maps;
with Interfaces;
with SDL.Inputs.Keyboards;
with Mage_Config;
with Mage.Event;
with Mage.Log;
package body Mage.Input is
procedure Keyboard_Log (S : String) is
begin
Mage.Log ("mage.input.keyboard", S);
end Keyboard_Log;
use all type Keyboards.Scan_Codes;
use all type Keyboards.Key_Modifiers;
package Keyboard_Inputs renames SDL.Inputs.Keyboards;
type Keyboard_Map_Entry is record
A : Action;
M : Configurable_Modifier;
Can_Be_Held : Boolean;
end record;
package Keyboard_Maps_Pkg is new Ada.Containers.Ordered_Maps
(Keyboards.Scan_Codes, Keyboard_Map_Entry);
use Keyboard_Maps_Pkg;
subtype Keyboard_Maps is Keyboard_Maps_Pkg.Map;
Keyboard_Map : Keyboard_Maps;
package Keyboard_Modifiers_Maps_Pkg is new Ada.Containers.Ordered_Maps
(Mod_Key, Modifier);
use Keyboard_Modifiers_Maps_Pkg;
subtype Keyboard_Modifier_Maps is Keyboard_Modifiers_Maps_Pkg.Map;
Keyboard_Modifier_Map : Keyboard_Modifier_Maps;
procedure Map_Keyboard
(A : Action; Pressed : Keyboards.Scan_Codes;
Can_Be_Held : Boolean := True)
is
begin
Map_Keyboard (A, None, Pressed, Can_Be_Held);
end Map_Keyboard;
procedure Map_Keyboard
(A : Action; M : Configurable_Modifier; Pressed : Keyboards.Scan_Codes;
Can_Be_Held : Boolean := True)
is
begin
Keyboard_Map.Insert (Pressed, (A, M, Can_Be_Held));
end Map_Keyboard;
procedure Map_Keyboard (M : Existing_Modifier; Held : Mod_Key) is
begin
Keyboard_Modifier_Map.Insert (Held, M);
end Map_Keyboard;
procedure Clear (A : Action) is
C : Keyboard_Maps_Pkg.Cursor := Keyboard_Map.First;
begin
while C /= Keyboard_Maps_Pkg.No_Element loop
if Element (C).A = A then
Keyboard_Map.Delete (C);
end if;
Next (C);
end loop;
end Clear;
procedure Clear (M : Modifier) is
C : Keyboard_Modifiers_Maps_Pkg.Cursor := Keyboard_Modifier_Map.First;
begin
while C /= Keyboard_Modifiers_Maps_Pkg.No_Element loop
if Element (C) = M then
Keyboard_Modifier_Map.Delete (C);
end if;
Next (C);
end loop;
end Clear;
procedure Clear_All is
begin
Keyboard_Modifier_Map.Clear;
Keyboard_Map.Clear;
end Clear_All;
package Scan_Codes_Sets_Pkg is new Ada.Containers.Ordered_Sets
(Keyboards.Scan_Codes);
subtype Scan_Codes_Set is Scan_Codes_Sets_Pkg.Set;
Globally_Pressed : Scan_Codes_Set;
function Global_Actions return Action_Set is
-- we poll all keyboard event so that we can apply a global
-- modifier flag correctly
function Get_Modifiers return Modifier_Flags is
KM : constant Keyboards.Key_Modifiers :=
Keyboard_Inputs.Get_Modifiers;
-- Portability for MacOS: ctrl is replaced by command
-- (called GUI in SDL)
Modifier_Portable_Ctrl_Or_Command :
constant Keyboards.Key_Modifiers :=
(if Mage_Config.Alire_Host_OS = "darwin" then Keyboards.Modifier_GUI
else Keyboards.Modifier_Control);
Mod_Flags : Modifier_Flags;
procedure Apply_Modifier (MK : Mod_Key) is
C : constant Keyboard_Modifiers_Maps_Pkg.Cursor :=
Keyboard_Modifier_Map.Find (MK);
begin
if C /= Keyboard_Modifiers_Maps_Pkg.No_Element then
Mod_Flags (Element (C)) := True;
end if;
end Apply_Modifier;
begin
if (KM and Keyboards.Modifier_Shift) /= 0 then
Apply_Modifier (Shift);
end if;
if (KM and Keyboards.Modifier_Alt) /= 0 then
Apply_Modifier (Alt);
end if;
if (KM and Modifier_Portable_Ctrl_Or_Command) /= 0 then
Apply_Modifier (Ctrl);
end if;
return Mod_Flags;
end Get_Modifiers;
function To_Flags (E : Configurable_Modifier) return Modifier_Flags is
F : Modifier_Flags := (others => False);
begin
if E /= None then
F (E) := True;
end if;
return F;
end To_Flags;
Global_Mod_Flags : constant Modifier_Flags := Get_Modifiers;
-- Modifiers set globally by mod keys, to which we will add
-- local modifiers on a per-action basis
S : Action_Set;
Locally_Pressed : Scan_Codes_Set;
begin
-- Start by updating the status of all keys
declare
Evt : Mage.Event.Keyboard_Event;
use all type SDL.Events.Button_State;
use all type Interfaces.Unsigned_8;
begin
while Mage.Event.Poll_Keyboard (Evt) loop
declare
SC : constant Keyboards.Scan_Codes := Evt.Key_Sym.Scan_Code;
begin
if Evt.State = Pressed then
if Evt.Repeat = 0 then
Locally_Pressed.Insert (SC);
end if;
else
Globally_Pressed.Exclude (SC);
end if;
end;
end loop;
end;
-- Turn the pressed keys into actions
for SC of Scan_Codes_Sets_Pkg.Union (Locally_Pressed, Globally_Pressed)
loop
declare
C : constant Keyboard_Maps_Pkg.Cursor := Keyboard_Map.Find (SC);
begin
if C /= Keyboard_Maps_Pkg.No_Element then
declare
E : constant Keyboard_Map_Entry := Element (C);
procedure Insert_Current_Entry is
begin
S.Include ((E.A, To_Flags (E.M) and Global_Mod_Flags));
end Insert_Current_Entry;
begin
if E.Can_Be_Held then
Globally_Pressed.Include (SC);
Insert_Current_Entry;
elsif not Globally_Pressed.Contains (SC) then
Insert_Current_Entry;
end if;
end;
end if;
end;
end loop;
return S;
end Global_Actions;
--------------------
-- Body Internals --
--------------------
use Keyboards;
Keyboard_Layout : Keyboard_Layouts := Unknown;
function Keyboard return Keyboard_Layouts is (Keyboard_Layout);
procedure Keyboard_Apply_Presets;
procedure Keyboard (L : Keyboard_Layouts; Apply_Presets : Boolean := True)
is
begin
Keyboard_Layout := L;
if Apply_Presets then
Keyboard_Apply_Presets;
end if;
end Keyboard;
procedure Keyboard_Apply_Presets is
begin
Map_Keyboard (Up, Scan_Code_Up);
Map_Keyboard (Down, Scan_Code_Down);
Map_Keyboard (Left, Scan_Code_Left);
Map_Keyboard (Right, Scan_Code_Right);
Map_Keyboard (Fast, Shift);
Map_Keyboard (Slow, Ctrl);
case Keyboard is
when Unknown =>
null;
when QWERTY =>
Map_Keyboard (Up, Scan_Code_W);
Map_Keyboard (Left, Scan_Code_A);
when QWERTZ =>
Map_Keyboard (Up, Scan_Code_W);
Map_Keyboard (Left, Scan_Code_A);
when AZERTY =>
Map_Keyboard (Up, Scan_Code_Z);
Map_Keyboard (Left, Scan_Code_Q);
end case;
Map_Keyboard (Down, Scan_Code_S);
Map_Keyboard (Right, Scan_Code_D);
end Keyboard_Apply_Presets;
function Infer_Keyboard_Layout return Keyboard_Layouts is
-- https://gist.github.com/g2p/8597984
type Keyboard_Fingerprint is array (1 .. 3) of Character;
function Fingerprint_Keyboard return Keyboard_Fingerprint is
type Maybe_Character_And_Key_Code (Set : Boolean := False) is record
case Set is
when True =>
C : Character;
KC : Keyboards.Key_Codes;
when False =>
null;
end case;
end record;
function To_Char
(KC : Keyboards.Key_Codes; From : Keyboards.Key_Codes;
To : Character) return Character
is
Offset : constant Positive :=
Keyboards.Key_Codes'Pos (KC) - Keyboards.Key_Codes'Pos (From);
begin
return Character'Val (Character'Pos (To) + Offset);
end To_Char;
function To_Char
(SC : Keyboards.Scan_Codes;
Default : Character := Ada.Characters.Latin_1.NUL) return Character
is
KC : constant Keyboards.Key_Codes := Keyboards.To_Key_Code (SC);
Found : constant Maybe_Character_And_Key_Code :=
(case KC is when Code_0 .. Code_9 => (True, '0', Code_0),
when Code_A .. Code_Z => (True, 'a', Code_A),
when others => (Set => False));
begin
return
(if Found.Set then To_Char (KC, Found.KC, Found.C) else Default);
end To_Char;
begin
return
To_Char (Keyboards.Scan_Code_Q) & To_Char (Keyboards.Scan_Code_W) &
To_Char (Keyboards.Scan_Code_Y);
end Fingerprint_Keyboard;
FP : constant Keyboard_Fingerprint := Fingerprint_Keyboard;
Layout : constant Keyboard_Layouts :=
(if FP = "qwy" then QWERTY elsif FP = "qwz" then QWERTZ
elsif FP = "azy" then AZERTY else Unknown);
begin
Keyboard_Log
("inferred layout " & Layout'Image & " <fingerprint = """ &
String (FP) & """>");
return Layout;
end Infer_Keyboard_Layout;
begin
Keyboard (Infer_Keyboard_Layout);
end Mage.Input;
|