clyne
/
ada-chip
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

array based key detection

Browse Source 
... to hopefully support more keys in the future
super-chip
Clyne 6 days ago
parent 54c6831e9d
commit 019c7b1634
Signed by: clyne
GPG Key ID: 7BA5A2980566A649
3 changed files with 73 additions and 59 deletions
Show Stats Download Patch File Download Diff File

8
src/ada_chip.adb
Unescape Escape View File

@ -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);

75
src/video.adb
Unescape Escape View File

@ -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;

49
src/video.ads
Unescape Escape View File

@ -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;

Write Preview
Loading…
Cancel
Save