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 :=