Add initial prototype.

2022-07-31 17:34:54 +10:00
commit 54a53b2ac0
1421 changed files with 358874 additions and 0 deletions
--- a/4-high/gel/source/concrete/gel-keyboard-local.adb
+++ b/4-high/gel/source/concrete/gel-keyboard-local.adb
@@ -0,0 +1,107 @@
+with
+     ada.unchecked_Deallocation;
+
+package body gel.Keyboard.local
+is
+
+   package body Forge
+   is
+      function to_Keyboard (of_Name : in String) return Item
+      is
+      begin
+         return Self : constant Item := (lace.Subject.local.Forge.to_Subject (of_Name)
+                                         with no_Modifiers)
+         do
+            null;
+         end return;
+      end to_Keyboard;
+
+
+      function new_Keyboard (of_Name : in String) return View
+      is
+      begin
+         return new Item' (to_Keyboard (of_Name));
+      end new_Keyboard;
+
+   end Forge;
+
+
+
+   procedure free (Self : in out View)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (Item'Class, View);
+   begin
+      Self.destroy;
+      deallocate (Self);
+   end free;
+
+
+   --------------
+   --- Attributes
+   --
+
+   overriding
+   function Modifiers (Self : in Item) return Modifier_Set
+   is
+   begin
+      return Self.Modifiers;
+   end Modifiers;
+
+
+   --------------
+   --- Operations
+   --
+
+   overriding
+   procedure emit_key_press_Event (Self : in out Item;   Key      : in keyboard.Key;
+                                                         key_Code : in Integer)
+   is
+      the_key_press_Event : key_press_Event;
+   begin
+      case Key is
+         when LSHIFT    => Self.Modifiers (LSHIFT) := True;
+         when RSHIFT    => Self.Modifiers (RSHIFT) := True;
+         when LCTRL     => Self.Modifiers (LCTRL)  := True;
+         when RCTRL     => Self.Modifiers (RCTRL)  := True;
+         when LALT      => Self.Modifiers (LALT)   := True;
+         when RALT      => Self.Modifiers (RALT)   := True;
+         when LMETA     => Self.Modifiers (LMETA)  := True;
+         when RMETA     => Self.Modifiers (RMETA)  := True;
+         when NUMLOCK   => Self.Modifiers (NUM)    := True;
+         when CAPSLOCK  => Self.Modifiers (CAPS)   := True;
+         when MODE      => Self.Modifiers (MODE)   := True;
+         when others    => null;
+      end case;
+
+      the_key_press_Event := ((Key, Self.Modifiers),  key_Code);
+      Self.emit (the_key_press_Event);
+   end emit_key_press_Event;
+
+
+
+   overriding
+   procedure emit_key_release_Event (Self : in out Item;   Key : in keyboard.Key)
+   is
+      the_key_release_Event : key_release_Event;
+   begin
+      case Key is
+         when LSHIFT    => Self.Modifiers (LSHIFT) := False;
+         when RSHIFT    => Self.Modifiers (RSHIFT) := False;
+         when LCTRL     => Self.Modifiers (LCTRL)  := False;
+         when RCTRL     => Self.Modifiers (RCTRL)  := False;
+         when LALT      => Self.Modifiers (LALT)   := False;
+         when RALT      => Self.Modifiers (RALT)   := False;
+         when LMETA     => Self.Modifiers (LMETA)  := False;
+         when RMETA     => Self.Modifiers (RMETA)  := False;
+         when NUMLOCK   => Self.Modifiers (NUM)    := False;
+         when CAPSLOCK  => Self.Modifiers (CAPS)   := False;
+         when MODE      => Self.Modifiers (MODE)   := False;
+         when others    => null;
+      end case;
+
+      the_key_release_Event := (modified_Key => (Key, Self.Modifiers));
+      Self.emit (the_key_release_Event);
+   end emit_key_release_Event;
+
+
+end gel.Keyboard.local;