From 06b403aa92a36060e9595abfa6cfac1a77d0e1a3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= Date: Wed, 14 Sep 2022 22:36:05 +0200 Subject: [PATCH] Add syntax support for Ada MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add submodule with sublime syntax. Add corresponding tests for both Ada (in adb/ads) and for the companion tool gpr. fixes #1300 Signed-off-by: Marc Poulhiès --- .gitmodules | 3 + assets/syntaxes/02_Extra/Ada | 1 + tests/syntax-tests/highlighted/Ada/click.adb | 308 +++++++++++++++++ tests/syntax-tests/highlighted/Ada/click.ads | 339 +++++++++++++++++++ tests/syntax-tests/highlighted/Ada/click.gpr | 29 ++ tests/syntax-tests/source/Ada/LICENSE.md | 23 ++ tests/syntax-tests/source/Ada/click.adb | 308 +++++++++++++++++ tests/syntax-tests/source/Ada/click.ads | 339 +++++++++++++++++++ tests/syntax-tests/source/Ada/click.gpr | 29 ++ 9 files changed, 1379 insertions(+) create mode 160000 assets/syntaxes/02_Extra/Ada create mode 100644 tests/syntax-tests/highlighted/Ada/click.adb create mode 100644 tests/syntax-tests/highlighted/Ada/click.ads create mode 100644 tests/syntax-tests/highlighted/Ada/click.gpr create mode 100644 tests/syntax-tests/source/Ada/LICENSE.md create mode 100644 tests/syntax-tests/source/Ada/click.adb create mode 100644 tests/syntax-tests/source/Ada/click.ads create mode 100644 tests/syntax-tests/source/Ada/click.gpr diff --git a/.gitmodules b/.gitmodules index 156f4206..ea770862 100644 --- a/.gitmodules +++ b/.gitmodules @@ -244,3 +244,6 @@ url = https://github.com/victor-gp/cmd-help-sublime-syntax.git branch = main shallow = true +[submodule "assets/syntaxes/02_Extra/Ada"] + path = assets/syntaxes/02_Extra/Ada + url = https://github.com/wiremoons/ada-sublime-syntax diff --git a/assets/syntaxes/02_Extra/Ada b/assets/syntaxes/02_Extra/Ada new file mode 160000 index 00000000..e2b8fd51 --- /dev/null +++ b/assets/syntaxes/02_Extra/Ada @@ -0,0 +1 @@ +Subproject commit e2b8fd51756e0cc42172c1c3405832ce9c19b6b6 diff --git a/tests/syntax-tests/highlighted/Ada/click.adb b/tests/syntax-tests/highlighted/Ada/click.adb new file mode 100644 index 00000000..2aeb0410 --- /dev/null +++ b/tests/syntax-tests/highlighted/Ada/click.adb @@ -0,0 +1,308 @@ +with Chests.Ring_Buffers; +with USB.Device.HID.Keyboard; + +package body Click is + ---------------- + -- DEBOUNCE -- + ---------------- + + -- Ideally, in a separate package. + + -- should be [], but not fixed yet in GCC 11. + Current_Status : Key_Matrix := [others => [others => False]]; + New_Status : Key_Matrix := [others => [others => False]]; + Since : Natural := 0; + -- Nb_Bounce : Natural := 5; + + function Update (NewS : Key_Matrix) return Boolean is + begin + -- The new state is the same as the current stable state => Do nothing. + if Current_Status = NewS then + Since := 0; + return False; + end if; + + if New_Status /= NewS then + -- The new state differs from the previous + -- new state (bouncing) => reset + New_Status := NewS; + Since := 1; + else + -- The new state hasn't changed since last + -- update => towards stabilization. + Since := Since + 1; + end if; + + if Since > Nb_Bounce then + declare + Tmp : constant Key_Matrix := Current_Status; + begin + -- New state has been stable enough. + -- Latch it and notifies caller. + Current_Status := New_Status; + New_Status := Tmp; + Since := 0; + end; + + return True; + else + -- Not there yet + return False; + end if; + end Update; + + procedure Get_Matrix; + -- Could use := []; but GNAT 12 has a bug (fixed in upcoming 13) + Read_Status : Key_Matrix := [others => [others => False]]; + + function Get_Events return Events is + Num_Evt : Natural := 0; + New_S : Key_Matrix renames Read_Status; + begin + Get_Matrix; + if Update (New_S) then + for I in Current_Status'Range (1) loop + for J in Current_Status'Range (2) loop + if (not New_Status (I, J) and then Current_Status (I, J)) + or else (New_Status (I, J) and then not Current_Status (I, J)) + then + Num_Evt := Num_Evt + 1; + end if; + end loop; + end loop; + + declare + Evts : Events (Natural range 1 .. Num_Evt); + Cursor : Natural range 1 .. Num_Evt + 1 := 1; + begin + for I in Current_Status'Range (1) loop + for J in Current_Status'Range (2) loop + if not New_Status (I, J) + and then Current_Status (I, J) + then + -- Pressing I, J + Evts (Cursor) := [ + Evt => Press, + Col => I, + Row => J + ]; + Cursor := Cursor + 1; + elsif New_Status (I, J) + and then not Current_Status (I, J) + then + -- Release I, J + Evts (Cursor) := [ + Evt => Release, + Col => I, + Row => J + ]; + Cursor := Cursor + 1; + end if; + end loop; + end loop; + return Evts; + end; + end if; + + return []; + end Get_Events; + + procedure Get_Matrix is -- return Key_Matrix is + begin + for Row in Keys.Rows'Range loop + Keys.Rows (Row).Clear; + + for Col in Keys.Cols'Range loop + Read_Status (Col, Row) := not Keys.Cols (Col).Set; + end loop; + Keys.Rows (Row).Set; + end loop; + end Get_Matrix; + + -- End of DEBOUNCE + + -------------- + -- Layout -- + -------------- + + package Events_Ring_Buffers is new Chests.Ring_Buffers + (Element_Type => Event, + Capacity => 16); + + Queued_Events : Events_Ring_Buffers.Ring_Buffer; + + type Statet is (Normal_Key, Layer_Mod, None); + type State is record + Typ : Statet; + Code : Key_Code_T; + Layer_Value : Natural; + -- Col : ColR; + -- Row : RowR; + end record; + + type State_Array is array (ColR, RowR) of State; + States : State_Array := [others => [others => (Typ => None, Code => No, Layer_Value => 0)]]; + + function Kw (Code : Key_Code_T) return Action is + begin + return (T => Key, C => Code, L => 0); + end Kw; + + function Lw (V : Natural) return Action is + begin + return (T => Layer, C => No, L => V); + end Lw; + + -- FIXME: hardcoded max number of events + subtype Events_Range is Natural range 0 .. 60; + type Array_Of_Reg_Events is array (Events_Range) of Event; + + Stamp : Natural := 0; + + procedure Register_Events (L : Layout; Es : Events) is + begin + Stamp := Stamp + 1; + + Log ("Reg events: " & Stamp'Image); + Log (Es'Length'Image); + for E of Es loop + declare + begin + if Events_Ring_Buffers.Is_Full (Queued_Events) then + raise Program_Error; + end if; + + Events_Ring_Buffers.Append (Queued_Events, E); + end; + -- Log ("Reg'ed events:" & Events_Mark'Image); + Log ("Reg'ed events:" & Events_Ring_Buffers.Length (Queued_Events)'Image); + end loop; + end Register_Events; + + procedure Release (Col: Colr; Row: Rowr) is + begin + if States (Col, Row).Typ = None then + raise Program_Error; + end if; + States (Col, Row) := (Typ => None, Code => No, Layer_Value => 0); + end Release; + + function Get_Current_Layer return Natural is + L : Natural := 0; + begin + for S of States loop + if S.Typ = Layer_Mod then + L := L + S.Layer_Value; + end if; + end loop; + + return L; + end Get_Current_Layer; + + -- Tick the event. + -- Returns TRUE if it needs to stay in the queued events + -- FALSE if the event has been consumed. + + function Tick (L: Layout; E : in out Event) return Boolean is + Current_Layer : Natural := Get_Current_Layer; + A : Action renames L (Current_Layer, E.Row, E.Col); + begin + case E.Evt is + when Press => + case A.T is + when Key => + States (E.Col, E.Row) := + (Typ => Normal_Key, + Code => A.C, + Layer_Value => 0); + when Layer => + States (E.Col, E.Row) := (Typ => Layer_Mod, Layer_Value => A.L, Code => No); + when others => + raise Program_Error; + end case; + + when Release => + Release (E.Col, E.Row); + end case; + return False; + end Tick; + + Last_Was_Empty_Log : Boolean := False; + + procedure Tick (L : Layout) is + begin + for I in 1 .. Events_Ring_Buffers.Length(Queued_Events) loop + declare + E : Event := Events_Ring_Buffers.Last_Element (Queued_Events); + begin + Events_Ring_Buffers.Delete_Last (Queued_Events); + if Tick (L, E) then + Events_Ring_Buffers.Prepend (Queued_Events, E); + end if; + end; + end loop; + if not Last_Was_Empty_Log or else Events_Ring_Buffers.Length(Queued_Events) /= 0 then + Log ("End Tick layout, events: " & Events_Ring_Buffers.Length(Queued_Events)'Image); + Last_Was_Empty_Log := Events_Ring_Buffers.Length(Queued_Events) = 0; + end if; + end Tick; + + function Get_Key_Codes return Key_Codes_T is + Codes : Key_Codes_T (0 .. 10); + Wm: Natural := 0; + begin + for S of States loop + if S.Typ = Normal_Key and then + (S.Code < LCtrl or else S.Code > RGui) + then + Codes (Wm) := S.Code; + Wm := Wm + 1; + end if; + end loop; + + if Wm = 0 then + return []; + else + return Codes (0 .. Wm - 1); + end if; + end Get_Key_Codes; + + function Get_Modifiers return Key_Modifiers is + use USB.Device.HID.Keyboard; + KM : Key_Modifiers (1..8); + I : Natural := 0; + begin + for S of States loop + if S.Typ = Normal_Key then + I := I + 1; + case S.Code is + when LCtrl => + KM(I) := Ctrl_Left; + when RCtrl => + KM(I) := Ctrl_Right; + when LShift => + KM(I) := Shift_Left; + when RShift => + KM(I) := Shift_Right; + when LAlt => + KM(I) := Alt_Left; + when RAlt => + KM(I) := Alt_Right; + when LGui => + KM(I) := Meta_Left; + when RGui => + KM(I) := Meta_Right; + when others => + I := I - 1; + end case; + end if; + end loop; + return KM (1..I); + end Get_Modifiers; + + procedure Init is + begin + Events_Ring_Buffers.Clear (Queued_Events); + end Init; + +end Click; diff --git a/tests/syntax-tests/highlighted/Ada/click.ads b/tests/syntax-tests/highlighted/Ada/click.ads new file mode 100644 index 00000000..412735ae --- /dev/null +++ b/tests/syntax-tests/highlighted/Ada/click.ads @@ -0,0 +1,339 @@ +with HAL.GPIO; +with USB.Device.HID.Keyboard; + +generic + Nb_Bounce : Natural; + type ColR is (<>); + type RowR is (<>); + + type GPIOP is new HAL.GPIO.GPIO_Point with private; + + type Cols_T is array (ColR) of GPIOP; + type Rows_T is array (RowR) of GPIOP; + + Cols : Cols_T; + Rows : Rows_T; + Num_Layers : Natural; + + with procedure Log (S : String; L : Integer := 1; Deindent : Integer := 0); +package Click is + + type Keys_T is record + Cols : Cols_T; + Rows : Rows_T; + end record; + + Keys : Keys_T := + (Rows => Rows, Cols => Cols); + + type Key_Matrix is array (ColR, RowR) of Boolean; + + -------------------------- + -- Events & Debouncing -- + -------------------------- + + MaxEvents : constant Positive := 20; + + type EventT is (Press, Release); + type Event is record + Evt : EventT; + Col : ColR; + Row : RowR; + end record; + + type Events is array (Natural range <>) of Event; + + function Get_Events return Events; + function Update (NewS : Key_Matrix) return Boolean; + + ------------- + -- Layout -- + ------------- + --------------- + -- Keycodes -- + --------------- + + -- Keycodes copy/pasted from the excelent Keyberon Rust firmware: + -- https://github.com/TeXitoi/keyberon/ + + type Key_Code_T is + ( + -- The "no" key, a placeholder to express nothing. + No, -- = 0x00, + -- / Error if too much keys are pressed at + -- the same time. + ErrorRollOver, + -- / The POST fail error. + PostFail, + -- / An undefined error occured. + ErrorUndefined, + -- / `a` and `A`. + A, + B, + C, + D, + E, + F, + G, + H, + I, + J, + K, + L, + M, -- 0x10 + N, + O, + P, + Q, + R, + S, + T, + U, + V, + W, + X, + Y, + Z, + -- `1` and `!`. + Kb1, + -- `2` and `@`. + Kb2, + -- `3` and `#`. + Kb3, -- 0x20 + -- / `4` and `$`. + Kb4, + -- `5` and `%`. + Kb5, + -- `6` and `^`. + Kb6, + -- `7` and `&`. + Kb7, + -- `8` and `*`. + Kb8, + -- `9` and `(`. + Kb9, + -- `0` and `)`. + Kb0, + Enter, + Escape, + BSpace, + Tab, + Space, + -- `-` and `_`. + Minus, + -- `=` and `+`. + Equal, + -- `[` and `{`. + LBracket, + -- `]` and `}`. + RBracket, -- 0x30 + -- / `\` and `|`. + Bslash, + -- Non-US `#` and `~` (Typically near the Enter key). + NonUsHash, + -- `;` and `:`. + SColon, + -- `'` and `"`. + Quote, + -- How to have ` as code? + -- \` and `~`. + Grave, + -- `,` and `<`. + Comma, + -- `.` and `>`. + Dot, + -- `/` and `?`. + Slash, + CapsLock, + F1, + F2, + F3, + F4, + F5, + F6, + F7, -- 0x40 + F8, + F9, + F10, + F11, + F12, + PScreen, + ScrollLock, + Pause, + Insert, + Home, + PgUp, + Delete, + Endd, + PgDown, + Right, + Left, -- 0x50 + Down, + Up, + NumLock, + -- Keypad `/` + KpSlash, + -- Keypad `*` + KpAsterisk, + -- Keypad `-`. + KpMinus, + -- Keypad `+`. + KpPlus, + -- Keypad enter. + KpEnter, + -- Keypad 1. + Kp1, + Kp2, + Kp3, + Kp4, + Kp5, + Kp6, + Kp7, + Kp8, -- 0x60 + Kp9, + Kp0, + KpDot, + -- Non-US `\` and `|` (Typically near the Left-Shift key) + NonUsBslash, + Application, -- 0x65 + -- / not a key, used for errors + Power, + -- Keypad `=`. + KpEqual, + F13, + F14, + F15, + F16, + F17, + F18, + F19, + F20, + F21, -- 0x70 + F22, + F23, + F24, + Execute, + Help, + Menu, + Selectt, + Stop, + Again, + Undo, + Cut, + Copy, + Paste, + Find, + Mute, + VolUp, -- 0x80 + VolDown, + -- Deprecated. + LockingCapsLock, + -- Deprecated. + LockingNumLock, + -- Deprecated. + LockingScrollLock, + -- / Keypad `,`, also used for the + -- brazilian keypad period (.) key. + KpComma, + -- Used on AS/400 keyboard + KpEqualSign, + Intl1, + Intl2, + Intl3, + Intl4, + Intl5, + Intl6, + Intl7, + Intl8, + Intl9, + Lang1, -- 0x90 + Lang2, + Lang3, + Lang4, + Lang5, + Lang6, + Lang7, + Lang8, + Lang9, + AltErase, + SysReq, + Cancel, + Clear, + Prior, + Returnn, + Separator, + Outt, -- 0xA0 + Oper, + ClearAgain, + CrSel, + ExSel, + + -- According to QMK, 0xA5-0xDF are not + -- usable on modern keyboards + + -- Modifiers + -- Left Control. + LCtrl, -- = 0xE0, + -- / Left Shift. + LShift, + -- Left Alt. + LAlt, + -- Left GUI (the Windows key). + LGui, + -- Right Control. + RCtrl, + -- Right Shift. + RShift, + -- Right Alt (or Alt Gr).  + RAlt, + -- Right GUI (the Windows key). + RGui, -- 0xE7 + + -- Unofficial + MediaPlayPause, -- 0xE8, + MediaStopCD, + MediaPreviousSong, + MediaNextSong, + MediaEjectCD, + MediaVolUp, + MediaVolDown, + MediaMute, + MediaWWW, -- 0xF0 + MediaBack, + MediaForward, + MediaStop, + MediaFind, + MediaScrollUp, + MediaScrollDown, + MediaEdit, + MediaSleep, + MediaCoffee, + MediaRefresh, + MediaCalc -- 0xFB + ); + + type Action_Type is (Key, No_Op, Trans, Layer, Multiple_Actions); + + -- Should be a discriminated type + type Action is record + T : Action_Type; -- hould be the discriminant + C : Key_Code_T; + L : Natural; + end record; + + function Kw (Code : Key_Code_T) return Action; + function Lw (V : Natural) return Action; + + type Key_Modifiers is array (Natural range <>) of USB.Device.HID.Keyboard.Modifiers; + + type Key_Codes_T is array (Natural range <>) of Key_Code_T; + + subtype Ac is Action; + type Layout is array (0 .. Num_Layers - 1, RowR, ColR) of Action; + procedure Register_Events (L : Layout; Es : Events); + procedure Tick (L : Layout); + + function Get_Key_Codes return Key_Codes_T; + function Get_Modifiers return Key_Modifiers; + procedure Init; +end Click; diff --git a/tests/syntax-tests/highlighted/Ada/click.gpr b/tests/syntax-tests/highlighted/Ada/click.gpr new file mode 100644 index 00000000..fb7a758d --- /dev/null +++ b/tests/syntax-tests/highlighted/Ada/click.gpr @@ -0,0 +1,29 @@ +with "config/click_config.gpr"; +project Click is + + for Library_Name use "Click"; + for Library_Version use Project'Library_Name & ".so." & Click_Config.Crate_Version; + + for Source_Dirs use ("src/", "config/"); + for Object_Dir use "obj/" & Click_Config.Build_Profile; + for Create_Missing_Dirs use "True"; + for Library_Dir use "lib"; + + type Library_Type_Type is ("relocatable", "static", "static-pic"); + Library_Type : Library_Type_Type := + external ("CLICK_LIBRARY_TYPE", external ("LIBRARY_TYPE", "static")); + for Library_Kind use Library_Type; + + package Compiler is + for Default_Switches ("Ada") use Click_Config.Ada_Compiler_Switches & ("-gnatX", "-gnat2022"); + end Compiler; + + package Binder is + for Switches ("Ada") use ("-Es"); -- Symbolic traceback + end Binder; + + package Install is + for Artifacts (".") use ("share"); + end Install; + +end Click; diff --git a/tests/syntax-tests/source/Ada/LICENSE.md b/tests/syntax-tests/source/Ada/LICENSE.md new file mode 100644 index 00000000..0700ff35 --- /dev/null +++ b/tests/syntax-tests/source/Ada/LICENSE.md @@ -0,0 +1,23 @@ +The files `click.adb`, `click.ads` and `click.gpr` have been added from https://github.com/dkm/click under the following license: + +MIT License + +Copyright (c) 2022 Marc Poulhiès + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/tests/syntax-tests/source/Ada/click.adb b/tests/syntax-tests/source/Ada/click.adb new file mode 100644 index 00000000..c525beda --- /dev/null +++ b/tests/syntax-tests/source/Ada/click.adb @@ -0,0 +1,308 @@ +with Chests.Ring_Buffers; +with USB.Device.HID.Keyboard; + +package body Click is + ---------------- + -- DEBOUNCE -- + ---------------- + + -- Ideally, in a separate package. + + -- should be [], but not fixed yet in GCC 11. + Current_Status : Key_Matrix := [others => [others => False]]; + New_Status : Key_Matrix := [others => [others => False]]; + Since : Natural := 0; + -- Nb_Bounce : Natural := 5; + + function Update (NewS : Key_Matrix) return Boolean is + begin + -- The new state is the same as the current stable state => Do nothing. + if Current_Status = NewS then + Since := 0; + return False; + end if; + + if New_Status /= NewS then + -- The new state differs from the previous + -- new state (bouncing) => reset + New_Status := NewS; + Since := 1; + else + -- The new state hasn't changed since last + -- update => towards stabilization. + Since := Since + 1; + end if; + + if Since > Nb_Bounce then + declare + Tmp : constant Key_Matrix := Current_Status; + begin + -- New state has been stable enough. + -- Latch it and notifies caller. + Current_Status := New_Status; + New_Status := Tmp; + Since := 0; + end; + + return True; + else + -- Not there yet + return False; + end if; + end Update; + + procedure Get_Matrix; + -- Could use := []; but GNAT 12 has a bug (fixed in upcoming 13) + Read_Status : Key_Matrix := [others => [others => False]]; + + function Get_Events return Events is + Num_Evt : Natural := 0; + New_S : Key_Matrix renames Read_Status; + begin + Get_Matrix; + if Update (New_S) then + for I in Current_Status'Range (1) loop + for J in Current_Status'Range (2) loop + if (not New_Status (I, J) and then Current_Status (I, J)) + or else (New_Status (I, J) and then not Current_Status (I, J)) + then + Num_Evt := Num_Evt + 1; + end if; + end loop; + end loop; + + declare + Evts : Events (Natural range 1 .. Num_Evt); + Cursor : Natural range 1 .. Num_Evt + 1 := 1; + begin + for I in Current_Status'Range (1) loop + for J in Current_Status'Range (2) loop + if not New_Status (I, J) + and then Current_Status (I, J) + then + -- Pressing I, J + Evts (Cursor) := [ + Evt => Press, + Col => I, + Row => J + ]; + Cursor := Cursor + 1; + elsif New_Status (I, J) + and then not Current_Status (I, J) + then + -- Release I, J + Evts (Cursor) := [ + Evt => Release, + Col => I, + Row => J + ]; + Cursor := Cursor + 1; + end if; + end loop; + end loop; + return Evts; + end; + end if; + + return []; + end Get_Events; + + procedure Get_Matrix is -- return Key_Matrix is + begin + for Row in Keys.Rows'Range loop + Keys.Rows (Row).Clear; + + for Col in Keys.Cols'Range loop + Read_Status (Col, Row) := not Keys.Cols (Col).Set; + end loop; + Keys.Rows (Row).Set; + end loop; + end Get_Matrix; + + -- End of DEBOUNCE + + -------------- + -- Layout -- + -------------- + + package Events_Ring_Buffers is new Chests.Ring_Buffers + (Element_Type => Event, + Capacity => 16); + + Queued_Events : Events_Ring_Buffers.Ring_Buffer; + + type Statet is (Normal_Key, Layer_Mod, None); + type State is record + Typ : Statet; + Code : Key_Code_T; + Layer_Value : Natural; + -- Col : ColR; + -- Row : RowR; + end record; + + type State_Array is array (ColR, RowR) of State; + States : State_Array := [others => [others => (Typ => None, Code => No, Layer_Value => 0)]]; + + function Kw (Code : Key_Code_T) return Action is + begin + return (T => Key, C => Code, L => 0); + end Kw; + + function Lw (V : Natural) return Action is + begin + return (T => Layer, C => No, L => V); + end Lw; + + -- FIXME: hardcoded max number of events + subtype Events_Range is Natural range 0 .. 60; + type Array_Of_Reg_Events is array (Events_Range) of Event; + + Stamp : Natural := 0; + + procedure Register_Events (L : Layout; Es : Events) is + begin + Stamp := Stamp + 1; + + Log ("Reg events: " & Stamp'Image); + Log (Es'Length'Image); + for E of Es loop + declare + begin + if Events_Ring_Buffers.Is_Full (Queued_Events) then + raise Program_Error; + end if; + + Events_Ring_Buffers.Append (Queued_Events, E); + end; + -- Log ("Reg'ed events:" & Events_Mark'Image); + Log ("Reg'ed events:" & Events_Ring_Buffers.Length (Queued_Events)'Image); + end loop; + end Register_Events; + + procedure Release (Col: Colr; Row: Rowr) is + begin + if States (Col, Row).Typ = None then + raise Program_Error; + end if; + States (Col, Row) := (Typ => None, Code => No, Layer_Value => 0); + end Release; + + function Get_Current_Layer return Natural is + L : Natural := 0; + begin + for S of States loop + if S.Typ = Layer_Mod then + L := L + S.Layer_Value; + end if; + end loop; + + return L; + end Get_Current_Layer; + + -- Tick the event. + -- Returns TRUE if it needs to stay in the queued events + -- FALSE if the event has been consumed. + + function Tick (L: Layout; E : in out Event) return Boolean is + Current_Layer : Natural := Get_Current_Layer; + A : Action renames L (Current_Layer, E.Row, E.Col); + begin + case E.Evt is + when Press => + case A.T is + when Key => + States (E.Col, E.Row) := + (Typ => Normal_Key, + Code => A.C, + Layer_Value => 0); + when Layer => + States (E.Col, E.Row) := (Typ => Layer_Mod, Layer_Value => A.L, Code => No); + when others => + raise Program_Error; + end case; + + when Release => + Release (E.Col, E.Row); + end case; + return False; + end Tick; + + Last_Was_Empty_Log : Boolean := False; + + procedure Tick (L : Layout) is + begin + for I in 1 .. Events_Ring_Buffers.Length(Queued_Events) loop + declare + E : Event := Events_Ring_Buffers.Last_Element (Queued_Events); + begin + Events_Ring_Buffers.Delete_Last (Queued_Events); + if Tick (L, E) then + Events_Ring_Buffers.Prepend (Queued_Events, E); + end if; + end; + end loop; + if not Last_Was_Empty_Log or else Events_Ring_Buffers.Length(Queued_Events) /= 0 then + Log ("End Tick layout, events: " & Events_Ring_Buffers.Length(Queued_Events)'Image); + Last_Was_Empty_Log := Events_Ring_Buffers.Length(Queued_Events) = 0; + end if; + end Tick; + + function Get_Key_Codes return Key_Codes_T is + Codes : Key_Codes_T (0 .. 10); + Wm: Natural := 0; + begin + for S of States loop + if S.Typ = Normal_Key and then + (S.Code < LCtrl or else S.Code > RGui) + then + Codes (Wm) := S.Code; + Wm := Wm + 1; + end if; + end loop; + + if Wm = 0 then + return []; + else + return Codes (0 .. Wm - 1); + end if; + end Get_Key_Codes; + + function Get_Modifiers return Key_Modifiers is + use USB.Device.HID.Keyboard; + KM : Key_Modifiers (1..8); + I : Natural := 0; + begin + for S of States loop + if S.Typ = Normal_Key then + I := I + 1; + case S.Code is + when LCtrl => + KM(I) := Ctrl_Left; + when RCtrl => + KM(I) := Ctrl_Right; + when LShift => + KM(I) := Shift_Left; + when RShift => + KM(I) := Shift_Right; + when LAlt => + KM(I) := Alt_Left; + when RAlt => + KM(I) := Alt_Right; + when LGui => + KM(I) := Meta_Left; + when RGui => + KM(I) := Meta_Right; + when others => + I := I - 1; + end case; + end if; + end loop; + return KM (1..I); + end Get_Modifiers; + + procedure Init is + begin + Events_Ring_Buffers.Clear (Queued_Events); + end Init; + +end Click; diff --git a/tests/syntax-tests/source/Ada/click.ads b/tests/syntax-tests/source/Ada/click.ads new file mode 100644 index 00000000..571f3601 --- /dev/null +++ b/tests/syntax-tests/source/Ada/click.ads @@ -0,0 +1,339 @@ +with HAL.GPIO; +with USB.Device.HID.Keyboard; + +generic + Nb_Bounce : Natural; + type ColR is (<>); + type RowR is (<>); + + type GPIOP is new HAL.GPIO.GPIO_Point with private; + + type Cols_T is array (ColR) of GPIOP; + type Rows_T is array (RowR) of GPIOP; + + Cols : Cols_T; + Rows : Rows_T; + Num_Layers : Natural; + + with procedure Log (S : String; L : Integer := 1; Deindent : Integer := 0); +package Click is + + type Keys_T is record + Cols : Cols_T; + Rows : Rows_T; + end record; + + Keys : Keys_T := + (Rows => Rows, Cols => Cols); + + type Key_Matrix is array (ColR, RowR) of Boolean; + + -------------------------- + -- Events & Debouncing -- + -------------------------- + + MaxEvents : constant Positive := 20; + + type EventT is (Press, Release); + type Event is record + Evt : EventT; + Col : ColR; + Row : RowR; + end record; + + type Events is array (Natural range <>) of Event; + + function Get_Events return Events; + function Update (NewS : Key_Matrix) return Boolean; + + ------------- + -- Layout -- + ------------- + --------------- + -- Keycodes -- + --------------- + + -- Keycodes copy/pasted from the excelent Keyberon Rust firmware: + -- https://github.com/TeXitoi/keyberon/ + + type Key_Code_T is + ( + -- The "no" key, a placeholder to express nothing. + No, -- = 0x00, + -- / Error if too much keys are pressed at + -- the same time. + ErrorRollOver, + -- / The POST fail error. + PostFail, + -- / An undefined error occured. + ErrorUndefined, + -- / `a` and `A`. + A, + B, + C, + D, + E, + F, + G, + H, + I, + J, + K, + L, + M, -- 0x10 + N, + O, + P, + Q, + R, + S, + T, + U, + V, + W, + X, + Y, + Z, + -- `1` and `!`. + Kb1, + -- `2` and `@`. + Kb2, + -- `3` and `#`. + Kb3, -- 0x20 + -- / `4` and `$`. + Kb4, + -- `5` and `%`. + Kb5, + -- `6` and `^`. + Kb6, + -- `7` and `&`. + Kb7, + -- `8` and `*`. + Kb8, + -- `9` and `(`. + Kb9, + -- `0` and `)`. + Kb0, + Enter, + Escape, + BSpace, + Tab, + Space, + -- `-` and `_`. + Minus, + -- `=` and `+`. + Equal, + -- `[` and `{`. + LBracket, + -- `]` and `}`. + RBracket, -- 0x30 + -- / `\` and `|`. + Bslash, + -- Non-US `#` and `~` (Typically near the Enter key). + NonUsHash, + -- `;` and `:`. + SColon, + -- `'` and `"`. + Quote, + -- How to have ` as code? + -- \` and `~`. + Grave, + -- `,` and `<`. + Comma, + -- `.` and `>`. + Dot, + -- `/` and `?`. + Slash, + CapsLock, + F1, + F2, + F3, + F4, + F5, + F6, + F7, -- 0x40 + F8, + F9, + F10, + F11, + F12, + PScreen, + ScrollLock, + Pause, + Insert, + Home, + PgUp, + Delete, + Endd, + PgDown, + Right, + Left, -- 0x50 + Down, + Up, + NumLock, + -- Keypad `/` + KpSlash, + -- Keypad `*` + KpAsterisk, + -- Keypad `-`. + KpMinus, + -- Keypad `+`. + KpPlus, + -- Keypad enter. + KpEnter, + -- Keypad 1. + Kp1, + Kp2, + Kp3, + Kp4, + Kp5, + Kp6, + Kp7, + Kp8, -- 0x60 + Kp9, + Kp0, + KpDot, + -- Non-US `\` and `|` (Typically near the Left-Shift key) + NonUsBslash, + Application, -- 0x65 + -- / not a key, used for errors + Power, + -- Keypad `=`. + KpEqual, + F13, + F14, + F15, + F16, + F17, + F18, + F19, + F20, + F21, -- 0x70 + F22, + F23, + F24, + Execute, + Help, + Menu, + Selectt, + Stop, + Again, + Undo, + Cut, + Copy, + Paste, + Find, + Mute, + VolUp, -- 0x80 + VolDown, + -- Deprecated. + LockingCapsLock, + -- Deprecated. + LockingNumLock, + -- Deprecated. + LockingScrollLock, + -- / Keypad `,`, also used for the + -- brazilian keypad period (.) key. + KpComma, + -- Used on AS/400 keyboard + KpEqualSign, + Intl1, + Intl2, + Intl3, + Intl4, + Intl5, + Intl6, + Intl7, + Intl8, + Intl9, + Lang1, -- 0x90 + Lang2, + Lang3, + Lang4, + Lang5, + Lang6, + Lang7, + Lang8, + Lang9, + AltErase, + SysReq, + Cancel, + Clear, + Prior, + Returnn, + Separator, + Outt, -- 0xA0 + Oper, + ClearAgain, + CrSel, + ExSel, + + -- According to QMK, 0xA5-0xDF are not + -- usable on modern keyboards + + -- Modifiers + -- Left Control. + LCtrl, -- = 0xE0, + -- / Left Shift. + LShift, + -- Left Alt. + LAlt, + -- Left GUI (the Windows key). + LGui, + -- Right Control. + RCtrl, + -- Right Shift. + RShift, + -- Right Alt (or Alt Gr).  + RAlt, + -- Right GUI (the Windows key). + RGui, -- 0xE7 + + -- Unofficial + MediaPlayPause, -- 0xE8, + MediaStopCD, + MediaPreviousSong, + MediaNextSong, + MediaEjectCD, + MediaVolUp, + MediaVolDown, + MediaMute, + MediaWWW, -- 0xF0 + MediaBack, + MediaForward, + MediaStop, + MediaFind, + MediaScrollUp, + MediaScrollDown, + MediaEdit, + MediaSleep, + MediaCoffee, + MediaRefresh, + MediaCalc -- 0xFB + ); + + type Action_Type is (Key, No_Op, Trans, Layer, Multiple_Actions); + + -- Should be a discriminated type + type Action is record + T : Action_Type; -- hould be the discriminant + C : Key_Code_T; + L : Natural; + end record; + + function Kw (Code : Key_Code_T) return Action; + function Lw (V : Natural) return Action; + + type Key_Modifiers is array (Natural range <>) of USB.Device.HID.Keyboard.Modifiers; + + type Key_Codes_T is array (Natural range <>) of Key_Code_T; + + subtype Ac is Action; + type Layout is array (0 .. Num_Layers - 1, RowR, ColR) of Action; + procedure Register_Events (L : Layout; Es : Events); + procedure Tick (L : Layout); + + function Get_Key_Codes return Key_Codes_T; + function Get_Modifiers return Key_Modifiers; + procedure Init; +end Click; diff --git a/tests/syntax-tests/source/Ada/click.gpr b/tests/syntax-tests/source/Ada/click.gpr new file mode 100644 index 00000000..27f9d5aa --- /dev/null +++ b/tests/syntax-tests/source/Ada/click.gpr @@ -0,0 +1,29 @@ +with "config/click_config.gpr"; +project Click is + + for Library_Name use "Click"; + for Library_Version use Project'Library_Name & ".so." & Click_Config.Crate_Version; + + for Source_Dirs use ("src/", "config/"); + for Object_Dir use "obj/" & Click_Config.Build_Profile; + for Create_Missing_Dirs use "True"; + for Library_Dir use "lib"; + + type Library_Type_Type is ("relocatable", "static", "static-pic"); + Library_Type : Library_Type_Type := + external ("CLICK_LIBRARY_TYPE", external ("LIBRARY_TYPE", "static")); + for Library_Kind use Library_Type; + + package Compiler is + for Default_Switches ("Ada") use Click_Config.Ada_Compiler_Switches & ("-gnatX", "-gnat2022"); + end Compiler; + + package Binder is + for Switches ("Ada") use ("-Es"); -- Symbolic traceback + end Binder; + + package Install is + for Artifacts (".") use ("share"); + end Install; + +end Click;