add input support

3 files changed, 120 insertions, 48 deletions

diff --git a/src/ada_chip.adb b/src/ada_chip.adb
index 1ce198a..a432178 100644
--- a/src/ada_chip.adb
+++ b/src/ada_chip.adb
@@ -46,17 +46,16 @@ procedure Ada_Chip is
    begin
       ins := CPU.Get_Opcode (State);
       case ins.Class is
-         when Flow =>
-            case ins.Value is
-               when 16#E0# => Video.Clear_Screen;
-               when 16#EE# => CPU.Ret (State);
-               when others => begin
-                  Ada.Text_IO.Put_Line ("Unknown flow instruction!");
-                  Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
-                  delay 1.0;
-                  Video.Finish;
-               end;
-            end case;
+         when Flow => case ins.Value is
+            when 16#E0# => Video.Clear_Screen;
+            when 16#EE# => CPU.Ret (State);
+            when others => begin
+               Ada.Text_IO.Put_Line ("Unknown flow instruction!");
+               Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
+               delay 1.0;
+               Video.Finish;
+            end;
+         end case;
          when Jump => CPU.Jump (State, Address (ins.Value));
          when Call => CPU.Call (State, Address (ins.Value));
          when Equal =>
@@ -95,38 +94,52 @@ procedure Ada_Chip is
          when Draw_Sprite =>
             Draw_Sprite (X_Register (ins), Y_Register (ins),
                To_Byte (ins) mod 16);
-         when Misc =>
-            case To_Byte (ins) is
-               when 16#07# =>
-                  State.Registers (X_Register (ins)) := State.Delay_Timer;
-               when 16#15# =>
-                  State.Delay_Timer := State.Registers (X_Register (ins));
-               when 16#18# => null; --  TODO: sound
-               when 16#1E# =>
-                  State.Address_Register := State.Address_Register +
-                     Address (State.Registers (X_Register (ins)));
-               when 16#29# =>
-                  State.Address_Register :=
-                     Address (State.Registers (X_Register (ins))) * 5;
-               when 16#33# => begin
-                  State.Memory (State.Address_Register) :=
-                     State.Registers (X_Register (ins)) / 100;
-                  State.Memory (State.Address_Register + 1) :=
-                     State.Registers (X_Register (ins)) / 10 mod 10;
-                  State.Memory (State.Address_Register + 2) :=
-                     State.Registers (X_Register (ins)) mod 10;
-               end;
-               when 16#55# =>
-                  CPU.Reg_Store (State, X_Register (ins));
-               when 16#65# =>
-                  CPU.Reg_Load (State, X_Register (ins));
-               when others => begin
-                  Ada.Text_IO.Put_Line ("Unknown misc instruction!");
-                  Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
-                  delay 1.0;
-                  Video.Finish;
-               end;
-            end case;
+         when Input => case To_Byte (ins) is
+            when 16#9E# =>
+               if Video.Key_Down
+                  (Video.Key (State.Registers (X_Register (ins)) mod 16))
+               then
+                  CPU.Skip (State);
+               end if;
+            when 16#A1# =>
+               if Video.Key_Up
+                  (Video.Key (State.Registers (X_Register (ins)) mod 16))
+               then
+                  CPU.Skip (State);
+               end if;
+            when others => null;
+         end case;
+         when Misc => case To_Byte (ins) is
+            when 16#07# =>
+               State.Registers (X_Register (ins)) := State.Delay_Timer;
+            when 16#15# =>
+               State.Delay_Timer := State.Registers (X_Register (ins));
+            when 16#18# => null; --  TODO: sound
+            when 16#1E# =>
+               State.Address_Register := State.Address_Register +
+                  Address (State.Registers (X_Register (ins)));
+            when 16#29# =>
+               State.Address_Register :=
+                  Address (State.Registers (X_Register (ins))) * 5;
+            when 16#33# => begin
+               State.Memory (State.Address_Register) :=
+                  State.Registers (X_Register (ins)) / 100;
+               State.Memory (State.Address_Register + 1) :=
+                  State.Registers (X_Register (ins)) / 10 mod 10;
+               State.Memory (State.Address_Register + 2) :=
+                  State.Registers (X_Register (ins)) mod 10;
+            end;
+            when 16#55# =>
+               CPU.Reg_Store (State, X_Register (ins));
+            when 16#65# =>
+               CPU.Reg_Load (State, X_Register (ins));
+            when others => begin
+               Ada.Text_IO.Put_Line ("Unknown misc instruction!");
+               Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
+               delay 1.0;
+               Video.Finish;
+            end;
+         end case;
          when others => begin
             Ada.Text_IO.Put_Line ("Unknown instruction class!");
             Ada.Text_IO.Put_Line (Opcode_Class'Image (ins.Class));
diff --git a/src/video.adb b/src/video.adb
index 0a93592..cc58e88 100644
--- a/src/video.adb
+++ b/src/video.adb
@@ -1,5 +1,6 @@
 with Sf.Window;
 with Sf.Window.Event;
+with Sf.Window.Keyboard;
 with Sf.Graphics.Color;
 
 package body Video is
@@ -27,13 +28,54 @@ package body Video is
 
    procedure Display is
       use Sf.Window.Event;
+      use Sf.Window.Keyboard;
 
       e : sfEvent;
    begin
       while RenderWindow.pollEvent (app, event => e) = sfTrue loop
-         if e.eventType = sfEvtClosed then
-            RenderWindow.close (app);
-         end if;
+         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 others => null;
+         end case;
       end loop;
 
       RenderWindow.clear (app, Color.sfWhite);
@@ -56,4 +98,14 @@ package body Video is
    begin
       RenderWindow.close (app);
    end Finish;
+
+   function Key_Down (K : Key) return Boolean is
+   begin
+      return Keys (K);
+   end Key_Down;
+
+   function Key_Up (K : Key) return Boolean is
+   begin
+      return not Keys (K);
+   end Key_Up;
 end Video;
diff --git a/src/video.ads b/src/video.ads
index 09ff6e8..b6be6c8 100644
--- a/src/video.ads
+++ b/src/video.ads
@@ -9,6 +9,9 @@ package Video is
    use Sf;
    use Sf.Graphics;
 
+   type Key is range 0 .. 15;
+   type Key_Map is array (Key'Range) of Boolean;
+
    Width  : constant := 64;
    Height : constant := 32;
    Scale  : constant := 10;
@@ -16,12 +19,16 @@ package Video is
 
    procedure Clear_Screen;
    procedure Initialize;
-   function Is_Running return Boolean;
    procedure Display;
-   function Toggle_Pixel (X, Y : sfUint32) return Boolean;
    procedure Finish;
 
+   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;
+
 private
+   Keys           : Key_Map;
    Pixels         : constant sfImage_Ptr   := Image.create (Width, Height);
    Pixels_Sprite  : constant sfSprite_Ptr  := Sprite.create;
    Pixels_Texture : constant sfTexture_Ptr :=