array based key detectionsuper-chip

... to hopefully support more keys in the future

3 files changed, 73 insertions, 59 deletions

diff --git a/src/ada_chip.adb b/src/ada_chip.adb
index cd156f7..e7993b5 100644
--- a/src/ada_chip.adb
+++ b/src/ada_chip.adb
@@ -86,7 +86,8 @@ procedure Ada_Chip is
    begin
       case Flow_Class'Enum_Val (ins.Value) is
          when Scroll_Down_0 .. Scroll_Down_15 =>
-            null;
+            Ada.Text_IO.Put_Line ("Vertical scroll not supported!");
+            Video.Finish;
          when Scroll_Right => Video.Scroll_Right;
          when Scroll_Left => Video.Scroll_Left;
          when Exit_Interpreter =>
@@ -101,7 +102,7 @@ procedure Ada_Chip is
 
    procedure Run_Input (ins : ISA.Opcode) is
       use ISA;
-      Key : constant Video.Key := Video.Key
+      Key : constant Video.Key := Video.Key'Enum_Val
          (State.Registers (X_Register (ins)) mod 16);
    begin
       case Input_Class'Enum_Val (To_Byte (ins)) is
@@ -122,7 +123,8 @@ procedure Ada_Chip is
    begin
       case Misc_Class'Enum_Val (To_Byte (ins)) is
          when Get_Delay => State.Registers (X) := Byte (Delay_Timer);
-         when Get_Key   => State.Registers (X) := Byte (Video.Next_Key);
+         when Get_Key   => State.Registers (X) :=
+            Byte (Video.Key'Enum_Rep (Video.Next_Key));
          when Set_Delay => Delay_Timer := Natural (State.Registers (X));
          when Set_Sound => Sound_Timer := Natural (State.Registers (X));
          when Reg_Store => CPU.Reg_Store (State, X);
diff --git a/src/video.adb b/src/video.adb
index 657d285..1a7fa21 100644
--- a/src/video.adb
+++ b/src/video.adb
@@ -1,6 +1,5 @@
 with Sf.Window;
 with Sf.Window.Event;
-with Sf.Window.Keyboard;
 with Sf.Graphics.Color;
 with Sf.Graphics.Image;
 with Sf.Graphics.RenderWindow;
@@ -99,24 +98,18 @@ package body Video is
 
    function Next_Key return Key is
    begin
-      while Is_Running loop
-         Poll_Events;
-
-         for I in Key'First .. Key'Last loop
-            if Keys (I) then
-               return I;
-            end if;
-         end loop;
+      Last_Key := Unknown;
 
+      while Is_Running and then Last_Key = Unknown loop
+         Poll_Events;
          delay 0.016;
       end loop;
 
-      return 0; --  Only get here on program exit
+      return Last_Key;
    end Next_Key;
 
    procedure Poll_Events is
       use Sf.Window.Event;
-      use Sf.Window.Keyboard;
 
       e : sfEvent;
    begin
@@ -124,44 +117,8 @@ package body Video is
          case e.eventType is
             when sfEvtClosed =>
                RenderWindow.close (app);
-            when sfEvtKeyPressed => case e.key.code is
-               when sfKeyNum0 => Keys (0) := True;
-               when sfKeyNum1 => Keys (1) := True;
-               when sfKeyNum2 => Keys (2) := True;
-               when sfKeyNum3 => Keys (3) := True;
-               when sfKeyNum4 => Keys (4) := True;
-               when sfKeyNum5 => Keys (5) := True;
-               when sfKeyNum6 => Keys (6) := True;
-               when sfKeyNum7 => Keys (7) := True;
-               when sfKeyNum8 => Keys (8) := True;
-               when sfKeyNum9 => Keys (9) := True;
-               when sfKeyA => Keys (10) := True;
-               when sfKeyB => Keys (11) := True;
-               when sfKeyC => Keys (12) := True;
-               when sfKeyD => Keys (13) := True;
-               when sfKeyE => Keys (14) := True;
-               when sfKeyF => Keys (15) := True;
-               when others => null;
-            end case;
-            when sfEvtKeyReleased => case e.key.code is
-               when sfKeyNum0 => Keys (0) := False;
-               when sfKeyNum1 => Keys (1) := False;
-               when sfKeyNum2 => Keys (2) := False;
-               when sfKeyNum3 => Keys (3) := False;
-               when sfKeyNum4 => Keys (4) := False;
-               when sfKeyNum5 => Keys (5) := False;
-               when sfKeyNum6 => Keys (6) := False;
-               when sfKeyNum7 => Keys (7) := False;
-               when sfKeyNum8 => Keys (8) := False;
-               when sfKeyNum9 => Keys (9) := False;
-               when sfKeyA => Keys (10) := False;
-               when sfKeyB => Keys (11) := False;
-               when sfKeyC => Keys (12) := False;
-               when sfKeyD => Keys (13) := False;
-               when sfKeyE => Keys (14) := False;
-               when sfKeyF => Keys (15) := False;
-               when others => null;
-            end case;
+            when sfEvtKeyPressed =>
+               Last_Key := Translate_Scancode (e.key.scancode);
             when others => null;
          end case;
       end loop;
@@ -194,11 +151,27 @@ package body Video is
 
    function Key_Down (K : Key) return Boolean is
    begin
-      return Keys (K);
+      return isScancodePressed (Key_Conv (K)) = sfTrue;
    end Key_Down;
 
    function Key_Up (K : Key) return Boolean is
    begin
-      return not Keys (K);
+      return not Key_Down (K);
    end Key_Up;
+
+   function Translate_Key (K : Key) return sfScancode is
+   begin
+      return Key_Conv (K);
+   end Translate_Key;
+
+   function Translate_Scancode (S : sfScancode) return Key
+   is begin
+      for I in Key_Map'Range loop
+         if Key_Conv (I) = S then
+            return I;
+         end if;
+      end loop;
+
+      return Unknown;
+   end Translate_Scancode;
 end Video;
diff --git a/src/video.ads b/src/video.ads
index 49d3c95..e293d7b 100644
--- a/src/video.ads
+++ b/src/video.ads
@@ -1,14 +1,14 @@
 with Sf;
 with Sf.Graphics;
 with Sf.Graphics.Sprite;
+with Sf.Window.Keyboard;
 
 package Video is
    use Sf;
    use Sf.Graphics;
+   use Sf.Window.Keyboard;
 
    type Model is (Chip_8, Super_Chip_10);
-   type Key is range 0 .. 15;
-   type Key_Map is array (Key'Range) of Boolean;
 
    Title  : constant String := "Ada-Chip";
 
@@ -27,16 +27,55 @@ package Video is
    procedure Scroll_Right;
    procedure Scroll_Left;
 
-   function Key_Down (K : Key) return Boolean;
-   function Key_Up (K : Key) return Boolean;
    function Is_Running return Boolean;
    function Toggle_Pixel (X, Y : sfUint32) return Boolean;
+
+   type Key is (
+      Unknown,
+      Zero, One, Two, Three, Four, Five, Six, Seven, Eight, Nine,
+      A, B, C, D, E, F
+   );
+
+   for Key use (
+      Unknown => -1,
+      Zero  => 0,
+      One   => 1,
+      Two   => 2,
+      Three => 3,
+      Four  => 4,
+      Five  => 5,
+      Six   => 6,
+      Seven => 7,
+      Eight => 8,
+      Nine  => 9,
+      A     => 10,
+      B     => 11,
+      C     => 12,
+      D     => 13,
+      E     => 14,
+      F     => 15
+   );
+
+   type Key_Map is array (Key'First .. Key'Last) of sfScancode;
+
+   function Key_Down (K : Key) return Boolean;
+   function Key_Up (K : Key) return Boolean;
    function Next_Key return Key;
 
+   function Translate_Scancode (S : sfScancode) return Key;
+   function Translate_Key (K : Key) return sfScancode;
+
 private
-   Keys           : Key_Map;
+   Last_Key       : Key;
    app            : sfRenderWindow_Ptr;
    Pixels         : sfImage_Ptr;
    Pixels_Texture : sfTexture_Ptr;
    Pixels_Sprite  : constant sfSprite_Ptr := Sprite.create;
+
+   Key_Conv : Key_Map := (
+      sfScanUnknown,
+      sfScanNum0, sfScanNum1, sfScanNum2, sfScanNum3, sfScanNum4, sfScanNum5,
+      sfScanNum6, sfScanNum7, sfScanNum8, sfScanNum9,
+      sfScanA, sfScanB, sfScanC, sfScanD, sfScanE, sfScanF
+   );
 end Video;