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

add input support

Browse Source
main
Clyne 2 weeks ago
parent 5c625ca6f5
commit 7c0bbdecaf
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7
3 changed files with 120 additions and 48 deletions
Show Stats Download Patch File Download Diff File

99
src/ada_chip.adb
Unescape Escape View File

@ -46,17 +46,16 @@ procedure Ada_Chip is
begin begin
ins := CPU.Get_Opcode (State); ins := CPU.Get_Opcode (State);
case ins.Class is case ins.Class is
when Flow => when Flow => case ins.Value is
case ins.Value is when 16#E0# => Video.Clear_Screen;
when 16#E0# => Video.Clear_Screen; when 16#EE# => CPU.Ret (State);
when 16#EE# => CPU.Ret (State); when others => begin
when others => begin Ada.Text_IO.Put_Line ("Unknown flow instruction!");
Ada.Text_IO.Put_Line ("Unknown flow instruction!"); Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value));
Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value)); delay 1.0;
delay 1.0; Video.Finish;
Video.Finish; end;
end; end case;
end case;
when Jump => CPU.Jump (State, Address (ins.Value)); when Jump => CPU.Jump (State, Address (ins.Value));
when Call => CPU.Call (State, Address (ins.Value)); when Call => CPU.Call (State, Address (ins.Value));
when Equal => when Equal =>
@ -95,38 +94,52 @@ procedure Ada_Chip is
when Draw_Sprite => when Draw_Sprite =>
Draw_Sprite (X_Register (ins), Y_Register (ins), Draw_Sprite (X_Register (ins), Y_Register (ins),
To_Byte (ins) mod 16); To_Byte (ins) mod 16);
when Misc => when Input => case To_Byte (ins) is
case To_Byte (ins) is when 16#9E# =>
when 16#07# => if Video.Key_Down
State.Registers (X_Register (ins)) := State.Delay_Timer; (Video.Key (State.Registers (X_Register (ins)) mod 16))
when 16#15# => then
State.Delay_Timer := State.Registers (X_Register (ins)); CPU.Skip (State);
when 16#18# => null; -- TODO: sound end if;
when 16#1E# => when 16#A1# =>
State.Address_Register := State.Address_Register + if Video.Key_Up
Address (State.Registers (X_Register (ins))); (Video.Key (State.Registers (X_Register (ins)) mod 16))
when 16#29# => then
State.Address_Register := CPU.Skip (State);
Address (State.Registers (X_Register (ins))) * 5; end if;
when 16#33# => begin when others => null;
State.Memory (State.Address_Register) := end case;
State.Registers (X_Register (ins)) / 100; when Misc => case To_Byte (ins) is
State.Memory (State.Address_Register + 1) := when 16#07# =>
State.Registers (X_Register (ins)) / 10 mod 10; State.Registers (X_Register (ins)) := State.Delay_Timer;
State.Memory (State.Address_Register + 2) := when 16#15# =>
State.Registers (X_Register (ins)) mod 10; State.Delay_Timer := State.Registers (X_Register (ins));
end; when 16#18# => null; -- TODO: sound
when 16#55# => when 16#1E# =>
CPU.Reg_Store (State, X_Register (ins)); State.Address_Register := State.Address_Register +
when 16#65# => Address (State.Registers (X_Register (ins)));
CPU.Reg_Load (State, X_Register (ins)); when 16#29# =>
when others => begin State.Address_Register :=
Ada.Text_IO.Put_Line ("Unknown misc instruction!"); Address (State.Registers (X_Register (ins))) * 5;
Ada.Text_IO.Put_Line (Opcode_Value'Image (ins.Value)); when 16#33# => begin
delay 1.0; State.Memory (State.Address_Register) :=
Video.Finish; State.Registers (X_Register (ins)) / 100;
end; State.Memory (State.Address_Register + 1) :=
end case; 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 when others => begin
Ada.Text_IO.Put_Line ("Unknown instruction class!"); Ada.Text_IO.Put_Line ("Unknown instruction class!");
Ada.Text_IO.Put_Line (Opcode_Class'Image (ins.Class)); Ada.Text_IO.Put_Line (Opcode_Class'Image (ins.Class));

58
src/video.adb
Unescape Escape View File

@ -1,5 +1,6 @@
with Sf.Window; with Sf.Window;
with Sf.Window.Event; with Sf.Window.Event;
with Sf.Window.Keyboard;
with Sf.Graphics.Color; with Sf.Graphics.Color;
package body Video is package body Video is
@ -27,13 +28,54 @@ package body Video is
procedure Display is procedure Display is
use Sf.Window.Event; use Sf.Window.Event;
use Sf.Window.Keyboard;
e : sfEvent; e : sfEvent;
begin begin
while RenderWindow.pollEvent (app, event => e) = sfTrue loop while RenderWindow.pollEvent (app, event => e) = sfTrue loop
if e.eventType = sfEvtClosed then case e.eventType is
RenderWindow.close (app); when sfEvtClosed =>
end if; 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; end loop;
RenderWindow.clear (app, Color.sfWhite); RenderWindow.clear (app, Color.sfWhite);
@ -56,4 +98,14 @@ package body Video is
begin begin
RenderWindow.close (app); RenderWindow.close (app);
end Finish; 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; end Video;

11
src/video.ads
Unescape Escape View File

@ -9,6 +9,9 @@ package Video is
use Sf; use Sf;
use Sf.Graphics; use Sf.Graphics;
type Key is range 0 .. 15;
type Key_Map is array (Key'Range) of Boolean;
Width : constant := 64; Width : constant := 64;
Height : constant := 32; Height : constant := 32;
Scale : constant := 10; Scale : constant := 10;
@ -16,12 +19,16 @@ package Video is
procedure Clear_Screen; procedure Clear_Screen;
procedure Initialize; procedure Initialize;
function Is_Running return Boolean;
procedure Display; procedure Display;
function Toggle_Pixel (X, Y : sfUint32) return Boolean;
procedure Finish; 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 private
Keys : Key_Map;
Pixels : constant sfImage_Ptr := Image.create (Width, Height); Pixels : constant sfImage_Ptr := Image.create (Width, Height);
Pixels_Sprite : constant sfSprite_Ptr := Sprite.create; Pixels_Sprite : constant sfSprite_Ptr := Sprite.create;
Pixels_Texture : constant sfTexture_Ptr := Pixels_Texture : constant sfTexture_Ptr :=

Write Preview
Loading…
Cancel
Save