render and polling improvements

src/ada_chip.adb

@@ -10,7 +10,7 @@ with Video;
 procedure Ada_Chip is
    package Random_Byte is new Ada.Numerics.Discrete_Random (Byte);
 
-   Steps_Per_Frame : constant := 16;
+   Steps_Per_Frame : constant := 8;
 
    State            : CPU.Instance;
    Random_Generator : Random_Byte.Generator;
@@ -31,7 +31,10 @@ procedure Ada_Chip is
 
          for J in 0 .. 7 loop
             if Row_Pixels (7 - J) then
-               if Video.Toggle_Pixel (X + sfUint32 (J), Y + sfUint32 (I)) then
+               if Video.Toggle_Pixel
+                  ((X + sfUint32 (J)) mod Video.Width,
+                     (Y + sfUint32 (I)) mod Video.Height)
+               then
                   VF := True;
                end if;
             end if;
@@ -112,6 +115,8 @@ procedure Ada_Chip is
          when Misc => case To_Byte (ins) is
             when 16#07# =>
                State.Registers (X_Register (ins)) := State.Delay_Timer;
+            when 16#0A# =>
+               State.Registers (X_Register (ins)) := Byte (Video.Next_Key);
             when 16#15# =>
                State.Delay_Timer := State.Registers (X_Register (ins));
             when 16#18# => null; --  TODO: sound
@@ -120,7 +125,7 @@ procedure Ada_Chip is
                   Address (State.Registers (X_Register (ins)));
             when 16#29# =>
                State.Address_Register :=
-                  Address (State.Registers (X_Register (ins))) * 5;
+                  Address (State.Registers (X_Register (ins)) mod 16) * 5;
             when 16#33# => begin
                State.Memory (State.Address_Register) :=
                   State.Registers (X_Register (ins)) / 100;
@@ -158,6 +163,7 @@ begin
 
       while Video.Is_Running loop
          Video.Display;
+         Video.Poll_Events;
 
          if State.Delay_Timer > 0 then
             State.Delay_Timer := State.Delay_Timer - 1;

src/cpu.ads

@@ -8,7 +8,7 @@ package CPU is
       (Index_Type => Natural, Element_Type => Address);
 
    type Instance is record
-      Memory           : Bank := [
+      Memory           : Bank := (
          16#F0#, 16#90#, 16#90#, 16#90#, 16#F0#, -- 0
          16#20#, 16#60#, 16#20#, 16#20#, 16#70#, -- 1
          16#F0#, 16#10#, 16#F0#, 16#80#, 16#F0#, -- 2
@@ -26,7 +26,7 @@ package CPU is
          16#F0#, 16#80#, 16#F0#, 16#80#, 16#F0#, -- E
          16#F0#, 16#80#, 16#F0#, 16#80#, 16#80#, -- F
          others => 0
-      ];
+      );
       Registers        : Register_Bank;
       Program_Counter  : Address := Start_Address;
       Address_Register : Address := 0;

src/isa.ads

@@ -4,20 +4,20 @@ package ISA is
    type Register_Index is mod 2 ** 4;
    type Bank           is array (Address) of Byte;
    type Register_Bank  is array (Register_Index) of Byte;
-   type Pixel          is array (0 .. 7) of Boolean;
+   type Pixel          is array (0 .. Byte'Size - 1) of Boolean;
    pragma Pack (Pixel);
 
    type Opcode_Value is mod 2 ** 12;
+   type Opcode_Raw   is mod 2 ** 16;
    type Opcode_Class is (
       Flow, Jump, Call, Equal, Not_Equal, Compare, Set_Register, Add, Math,
       Not_Compare, Set_Address, Jump_Relative, Random, Draw_Sprite, Input, Misc
    ) with Size => 4;
-   type Opcode_Raw   is mod 2 ** 16;
    type Opcode is record
       Value : Opcode_Value;
       Class : Opcode_Class;
    end record with
-      Size => 16;
+      Size => Opcode_Raw'Size;
 
    for Opcode use record
       Value at 0 range 0 .. 11;

src/video.adb

@@ -26,7 +26,24 @@ package body Video is
       return RenderWindow.isOpen (app) = sfTrue;
    end Is_Running;
 
-   procedure Display 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;
+
+         delay 0.016;
+      end loop;
+
+      return 0; --  Only get here on program exit
+   end Next_Key;
+
+   procedure Poll_Events is
       use Sf.Window.Event;
       use Sf.Window.Keyboard;
 
@@ -77,7 +94,10 @@ package body Video is
             when others => null;
          end case;
       end loop;
+   end Poll_Events;
 
+   procedure Display is
+   begin
       RenderWindow.clear (app, Color.sfWhite);
       Texture.updateFromImage (Pixels_Texture, Pixels, 0, 0);
       RenderWindow.drawSprite (app, Pixels_Sprite);
@@ -87,9 +107,11 @@ package body Video is
    function Toggle_Pixel (X, Y : sfUint32) return Boolean is
       use Color;
 
-      P : constant sfColor := Image.getPixel (Pixels, X, Y);
+      P : sfColor;
-      R : constant Boolean := P = sfWhite;
+      R : Boolean;
    begin
+      P := Image.getPixel (Pixels, X, Y);
+      R := P = sfWhite;
       Image.setPixel (Pixels, X, Y, (if R then sfBlack else sfWhite));
       return R;
    end Toggle_Pixel;

src/video.ads

@@ -21,11 +21,13 @@ package Video is
    procedure Initialize;
    procedure Display;
    procedure Finish;
+   procedure Poll_Events;
 
    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;
+   function Next_Key return Key;
 
 private
    Keys           : Key_Map;