From 8fa66b024f91e47d8b5273e8c85ec5f60fe42d5b Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Sat, 11 Jan 2025 12:14:28 -0500 Subject: [PATCH] initial upload --- .gitignore | 12 ++- ada_chip.gpr | 22 ++++++ alire.toml | 15 ++++ config/ada_chip_config.ads | 20 +++++ config/ada_chip_config.gpr | 51 +++++++++++++ config/ada_chip_config.h | 20 +++++ config/adachip_config.ads | 20 +++++ config/adachip_config.gpr | 52 +++++++++++++ config/adachip_config.h | 20 +++++ src/ada_chip.adb | 146 +++++++++++++++++++++++++++++++++++++ src/bit_ops.adb | 31 ++++++++ src/bit_ops.ads | 9 +++ src/cpu.adb | 114 +++++++++++++++++++++++++++++ src/cpu.ads | 30 ++++++++ src/isa.adb | 10 +++ src/isa.ads | 51 +++++++++++++ src/video.adb | 59 +++++++++++++++ src/video.ads | 32 ++++++++ 18 files changed, 707 insertions(+), 7 deletions(-) create mode 100644 ada_chip.gpr create mode 100644 alire.toml create mode 100644 config/ada_chip_config.ads create mode 100644 config/ada_chip_config.gpr create mode 100644 config/ada_chip_config.h create mode 100644 config/adachip_config.ads create mode 100644 config/adachip_config.gpr create mode 100644 config/adachip_config.h create mode 100644 src/ada_chip.adb create mode 100644 src/bit_ops.adb create mode 100644 src/bit_ops.ads create mode 100644 src/cpu.adb create mode 100644 src/cpu.ads create mode 100644 src/isa.adb create mode 100644 src/isa.ads create mode 100644 src/video.adb create mode 100644 src/video.ads diff --git a/.gitignore b/.gitignore index f83922d..6060e87 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,5 @@ -# ---> Ada -# Object file -*.o - -# Ada Library Information -*.ali - +alire +bin +obj +*.c8 +*.ch8 diff --git a/ada_chip.gpr b/ada_chip.gpr new file mode 100644 index 0000000..63e5968 --- /dev/null +++ b/ada_chip.gpr @@ -0,0 +1,22 @@ +with "config/adachip_config.gpr"; +project Ada_Chip is + + for Source_Dirs use ("src/", "config/"); + for Object_Dir use "obj/" & Adachip_Config.Build_Profile; + for Create_Missing_Dirs use "True"; + for Exec_Dir use "bin"; + for Main use ("ada_chip.adb"); + + package Compiler is + for Default_Switches ("Ada") use Adachip_Config.Ada_Compiler_Switches; + end Compiler; + + package Binder is + for Switches ("Ada") use ("-Es"); -- Symbolic traceback + end Binder; + + package Install is + for Artifacts (".") use ("share"); + end Install; + +end Ada_Chip; diff --git a/alire.toml b/alire.toml new file mode 100644 index 0000000..6930eb5 --- /dev/null +++ b/alire.toml @@ -0,0 +1,15 @@ +name = "ada_chip" +description = "CHIP 8 emulator written in Ada" +version = "0.1.0-dev" + +authors = ["Clyne Sullivan"] +maintainers = ["Clyne Sullivan "] +maintainers-logins = ["clyne"] +licenses = "GPL-3.0-or-later" +website = "https://code.bitgloo.com/clyne/ada-chip" +tags = [] + +executables = ["ada_chip"] + +[[depends-on]] +asfml = "^2.6.1" diff --git a/config/ada_chip_config.ads b/config/ada_chip_config.ads new file mode 100644 index 0000000..625aeb8 --- /dev/null +++ b/config/ada_chip_config.ads @@ -0,0 +1,20 @@ +-- Configuration for ada_chip generated by Alire +pragma Restrictions (No_Elaboration_Code); +pragma Style_Checks (Off); + +package Ada_Chip_Config is + pragma Pure; + + Crate_Version : constant String := "0.1.0-dev"; + Crate_Name : constant String := "ada_chip"; + + Alire_Host_OS : constant String := "linux"; + + Alire_Host_Arch : constant String := "x86_64"; + + Alire_Host_Distro : constant String := "debian"; + + type Build_Profile_Kind is (release, validation, development); + Build_Profile : constant Build_Profile_Kind := development; + +end Ada_Chip_Config; diff --git a/config/ada_chip_config.gpr b/config/ada_chip_config.gpr new file mode 100644 index 0000000..58d9276 --- /dev/null +++ b/config/ada_chip_config.gpr @@ -0,0 +1,51 @@ +-- Configuration for ada_chip generated by Alire +with "asfml.gpr"; +abstract project Ada_Chip_Config is + Crate_Version := "0.1.0-dev"; + Crate_Name := "ada_chip"; + + Alire_Host_OS := "linux"; + + Alire_Host_Arch := "x86_64"; + + Alire_Host_Distro := "debian"; + Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); + Ada_Compiler_Switches := Ada_Compiler_Switches & + ( + "-Og" -- Optimize for debug + ,"-ffunction-sections" -- Separate ELF section for each function + ,"-fdata-sections" -- Separate ELF section for each variable + ,"-g" -- Generate debug info + ,"-gnatwa" -- Enable all warnings + ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation + ,"-gnatVa" -- All validity checks + ,"-gnaty3" -- Specify indentation level of 3 + ,"-gnatya" -- Check attribute casing + ,"-gnatyA" -- Use of array index numbers in array attributes + ,"-gnatyB" -- Check Boolean operators + ,"-gnatyb" -- Blanks not allowed at statement end + ,"-gnatyc" -- Check comments + ,"-gnaty-d" -- Disable check no DOS line terminators present + ,"-gnatye" -- Check end/exit labels + ,"-gnatyf" -- No form feeds or vertical tabs + ,"-gnatyh" -- No horizontal tabs + ,"-gnatyi" -- Check if-then layout + ,"-gnatyI" -- check mode IN keywords + ,"-gnatyk" -- Check keyword casing + ,"-gnatyl" -- Check layout + ,"-gnatym" -- Check maximum line length + ,"-gnatyn" -- Check casing of entities in Standard + ,"-gnatyO" -- Check that overriding subprograms are explicitly marked as such + ,"-gnatyp" -- Check pragma casing + ,"-gnatyr" -- Check identifier references casing + ,"-gnatyS" -- Check no statements after THEN/ELSE + ,"-gnatyt" -- Check token spacing + ,"-gnatyu" -- Check unnecessary blank lines + ,"-gnatyx" -- Check extra parentheses + ,"-gnatW8" -- UTF-8 encoding for wide characters + ); + + type Build_Profile_Kind is ("release", "validation", "development"); + Build_Profile : Build_Profile_Kind := "development"; + +end Ada_Chip_Config; diff --git a/config/ada_chip_config.h b/config/ada_chip_config.h new file mode 100644 index 0000000..c0a1fa9 --- /dev/null +++ b/config/ada_chip_config.h @@ -0,0 +1,20 @@ +/* Configuration for ada_chip generated by Alire */ +#ifndef ADA_CHIP_CONFIG_H +#define ADA_CHIP_CONFIG_H + +#define CRATE_VERSION "0.1.0-dev" +#define CRATE_NAME "ada_chip" + +#define ALIRE_HOST_OS "linux" + +#define ALIRE_HOST_ARCH "x86_64" + +#define ALIRE_HOST_DISTRO "debian" + +#define BUILD_PROFILE_RELEASE 1 +#define BUILD_PROFILE_VALIDATION 2 +#define BUILD_PROFILE_DEVELOPMENT 3 + +#define BUILD_PROFILE 3 + +#endif diff --git a/config/adachip_config.ads b/config/adachip_config.ads new file mode 100644 index 0000000..1949cad --- /dev/null +++ b/config/adachip_config.ads @@ -0,0 +1,20 @@ +-- Configuration for adachip generated by Alire +pragma Restrictions (No_Elaboration_Code); +pragma Style_Checks (Off); + +package Adachip_Config is + pragma Pure; + + Crate_Version : constant String := "0.1.0-dev"; + Crate_Name : constant String := "adachip"; + + Alire_Host_OS : constant String := "linux"; + + Alire_Host_Arch : constant String := "x86_64"; + + Alire_Host_Distro : constant String := "debian"; + + type Build_Profile_Kind is (release, validation, development); + Build_Profile : constant Build_Profile_Kind := development; + +end Adachip_Config; diff --git a/config/adachip_config.gpr b/config/adachip_config.gpr new file mode 100644 index 0000000..adaade1 --- /dev/null +++ b/config/adachip_config.gpr @@ -0,0 +1,52 @@ +-- Configuration for adachip generated by Alire +with "asfml.gpr"; +abstract project Adachip_Config is + Crate_Version := "0.1.0-dev"; + Crate_Name := "adachip"; + + Alire_Host_OS := "linux"; + + Alire_Host_Arch := "x86_64"; + + Alire_Host_Distro := "debian"; + Ada_Compiler_Switches := External_As_List ("ADAFLAGS", " "); + Ada_Compiler_Switches := Ada_Compiler_Switches & + ( + "-Og" + ,"-gnat2022" + ,"-ffunction-sections" -- Separate ELF section for each function + ,"-fdata-sections" -- Separate ELF section for each variable + ,"-g" -- Generate debug info + ,"-gnatwa" -- Enable all warnings + ,"-gnatw.X" -- Disable warnings for No_Exception_Propagation + ,"-gnatVa" -- All validity checks + ,"-gnaty3" -- Specify indentation level of 3 + ,"-gnatya" -- Check attribute casing + ,"-gnatyA" -- Use of array index numbers in array attributes + ,"-gnatyB" -- Check Boolean operators + ,"-gnatyb" -- Blanks not allowed at statement end + ,"-gnatyc" -- Check comments + ,"-gnaty-d" -- Disable check no DOS line terminators present + ,"-gnatye" -- Check end/exit labels + ,"-gnatyf" -- No form feeds or vertical tabs + ,"-gnatyh" -- No horizontal tabs + ,"-gnatyi" -- Check if-then layout + ,"-gnatyI" -- check mode IN keywords + ,"-gnatyk" -- Check keyword casing + ,"-gnatyl" -- Check layout + ,"-gnatym" -- Check maximum line length + ,"-gnatyn" -- Check casing of entities in Standard + ,"-gnatyO" -- Check that overriding subprograms are explicitly marked as such + ,"-gnatyp" -- Check pragma casing + ,"-gnatyr" -- Check identifier references casing + ,"-gnatyS" -- Check no statements after THEN/ELSE + ,"-gnatyt" -- Check token spacing + ,"-gnatyu" -- Check unnecessary blank lines + ,"-gnatyx" -- Check extra parentheses + ,"-gnatW8" -- UTF-8 encoding for wide characters + ); + + type Build_Profile_Kind is ("release", "validation", "development"); + Build_Profile : Build_Profile_Kind := "development"; + +end Adachip_Config; diff --git a/config/adachip_config.h b/config/adachip_config.h new file mode 100644 index 0000000..1c5495e --- /dev/null +++ b/config/adachip_config.h @@ -0,0 +1,20 @@ +/* Configuration for adachip generated by Alire */ +#ifndef ADACHIP_CONFIG_H +#define ADACHIP_CONFIG_H + +#define CRATE_VERSION "0.1.0-dev" +#define CRATE_NAME "adachip" + +#define ALIRE_HOST_OS "linux" + +#define ALIRE_HOST_ARCH "x86_64" + +#define ALIRE_HOST_DISTRO "debian" + +#define BUILD_PROFILE_RELEASE 1 +#define BUILD_PROFILE_VALIDATION 2 +#define BUILD_PROFILE_DEVELOPMENT 3 + +#define BUILD_PROFILE 3 + +#endif diff --git a/src/ada_chip.adb b/src/ada_chip.adb new file mode 100644 index 0000000..b79db1c --- /dev/null +++ b/src/ada_chip.adb @@ -0,0 +1,146 @@ +with Ada.Command_Line; +with Ada.Numerics.Discrete_Random; +with Ada.Text_IO; +with Sf; + +with ISA; use ISA; +with CPU; +with Video; + +procedure Ada_Chip is + package Random_Byte is new Ada.Numerics.Discrete_Random (Byte); + + Steps_Per_Frame : constant := 16; + + State : CPU.Instance; + Random_Generator : Random_Byte.Generator; + + procedure Draw_Sprite (VX, VY : Register_Index; N : Byte) is + use Sf; + + X, Y : sfUint32; + Row : aliased Byte; + Row_Pixels : Pixel with Address => Row'Address; + VF : Boolean := False; + begin + X := sfUint32 (State.Registers (VX)); + Y := sfUint32 (State.Registers (VY)); + + for I in 0 .. N - 1 loop + Row := State.Memory (State.Address_Register + Address (I)); + + for J in 0 .. 7 loop + if Row_Pixels (7 - J) then + if Video.Toggle_Pixel (X + sfUint32 (J), Y + sfUint32 (I)) then + VF := True; + end if; + end if; + end loop; + end loop; + + State.Registers (15) := (if VF then 1 else 0); + end Draw_Sprite; + + procedure Run_Step is + ins : Opcode; + 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 Jump => CPU.Jump (State, Address (ins.Value)); + when Call => CPU.Call (State, Address (ins.Value)); + when Equal => + if State.Registers (X_Register (ins)) = To_Byte (ins) then + CPU.Skip (State); + end if; + when Not_Equal => + if State.Registers (X_Register (ins)) /= To_Byte (ins) then + CPU.Skip (State); + end if; + when Compare => + if State.Registers (X_Register (ins)) = + State.Registers (Y_Register (ins)) + then + CPU.Skip (State); + end if; + when Set_Register => + State.Registers (X_Register (ins)) := To_Byte (ins); + when Add => + State.Registers (X_Register (ins)) := + State.Registers (X_Register (ins)) + To_Byte (ins); + when Math => + CPU.Math (State, X_Register (ins), Y_Register (ins), + To_Byte (ins) mod 16); + when Not_Compare => + if State.Registers (X_Register (ins)) /= + State.Registers (Y_Register (ins)) + then + CPU.Skip (State); + end if; + when Set_Address => + State.Address_Register := Address (ins.Value); + when Random => + State.Registers (X_Register (ins)) := + Random_Byte.Random (Random_Generator) mod To_Byte (ins); + 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#1E# => + State.Address_Register := State.Address_Register + + Address (State.Registers (X_Register (ins))); + 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)); + delay 1.0; + Video.Finish; + end; + end case; + end Run_Step; +begin + if Ada.Command_Line.Argument_Count /= 1 then + Ada.Text_IO.Put_Line ("usage: adachip <.c8 file>"); + else + Video.Initialize; + Random_Byte.Reset (Random_Generator); + CPU.Load_File (State, Ada.Command_Line.Argument (1)); + + while Video.Is_Running loop + Video.Display; + + if State.Delay_Timer > 0 then + State.Delay_Timer := State.Delay_Timer - 1; + end if; + + for I in 0 .. Steps_Per_Frame loop + Run_Step; + end loop; + end loop; + end if; +end Ada_Chip; diff --git a/src/bit_ops.adb b/src/bit_ops.adb new file mode 100644 index 0000000..032ff6c --- /dev/null +++ b/src/bit_ops.adb @@ -0,0 +1,31 @@ +package body Bit_Ops is + function Bitwise_Or (X, Y : Byte) return Byte is + X_Bits : Pixel with Address => X'Address; + Y_Bits : Pixel with Address => Y'Address; + Bits : aliased Pixel; + Bits_Byte : Byte with Address => Bits'Address; + begin + Bits := X_Bits or Y_Bits; + return Bits_Byte; + end Bitwise_Or; + + function Bitwise_And (X, Y : Byte) return Byte is + X_Bits : Pixel with Address => X'Address; + Y_Bits : Pixel with Address => Y'Address; + Bits : aliased Pixel; + Bits_Byte : Byte with Address => Bits'Address; + begin + Bits := X_Bits and Y_Bits; + return Bits_Byte; + end Bitwise_And; + + function Bitwise_Xor (X, Y : Byte) return Byte is + X_Bits : Pixel with Address => X'Address; + Y_Bits : Pixel with Address => Y'Address; + Bits : aliased Pixel; + Bits_Byte : Byte with Address => Bits'Address; + begin + Bits := X_Bits xor Y_Bits; + return Bits_Byte; + end Bitwise_Xor; +end Bit_Ops; diff --git a/src/bit_ops.ads b/src/bit_ops.ads new file mode 100644 index 0000000..b975a8a --- /dev/null +++ b/src/bit_ops.ads @@ -0,0 +1,9 @@ +with ISA; + +package Bit_Ops is + use ISA; + + function Bitwise_Or (X, Y : Byte) return Byte; + function Bitwise_And (X, Y : Byte) return Byte; + function Bitwise_Xor (X, Y : Byte) return Byte; +end Bit_Ops; diff --git a/src/cpu.adb b/src/cpu.adb new file mode 100644 index 0000000..809e039 --- /dev/null +++ b/src/cpu.adb @@ -0,0 +1,114 @@ +with Ada.Sequential_IO; +with Ada.Text_IO; +with Bit_Ops; + +package body CPU is + function Get_Opcode (Inst : in out Instance) return Opcode is + Op : aliased Opcode_Raw; + Op_Record : Opcode with Address => Op'Address; + begin + Op := Opcode_Raw (Inst.Memory (Inst.Program_Counter)) * 2 ** 8; + Op := Op + Opcode_Raw (Inst.Memory (Inst.Program_Counter + 1)); + Inst.Program_Counter := Inst.Program_Counter + 2; + return Op_Record; + end Get_Opcode; + + procedure Reg_Store (Inst : in out Instance; VX : Register_Index) is + begin + for I in 0 .. VX loop + Inst.Memory (Inst.Address_Register + Address (I)) := + Inst.Registers (I); + end loop; + end Reg_Store; + + procedure Reg_Load (Inst : in out Instance; VX : Register_Index) is + begin + for I in 0 .. VX loop + Inst.Registers (I) := Inst.Memory + (Inst.Address_Register + Address (I)); + end loop; + end Reg_Load; + + procedure Ret (Inst : in out Instance) is + begin + Jump (Inst, Inst.Stack.Last_Element); + Inst.Stack.Delete_Last; + end Ret; + + procedure Call (Inst : in out Instance; A : Address) is + begin + Inst.Stack.Append (Inst.Program_Counter); + Jump (Inst, A); + end Call; + + procedure Jump (Inst : in out Instance; A : Address) is + begin + Inst.Program_Counter := A; + end Jump; + + procedure Skip (Inst : in out Instance) is + begin + Inst.Program_Counter := Inst.Program_Counter + 2; + end Skip; + + procedure Math (Inst : in out Instance; VX, VY : Register_Index; N : Byte) + is begin + case N is + when 0 => + Inst.Registers (VX) := Inst.Registers (VY); + when 1 => + Inst.Registers (VX) := Bit_Ops.Bitwise_Or + (Inst.Registers (VX), Inst.Registers (VY)); + when 2 => + Inst.Registers (VX) := Bit_Ops.Bitwise_And + (Inst.Registers (VX), Inst.Registers (VY)); + when 3 => + Inst.Registers (VX) := Bit_Ops.Bitwise_Xor + (Inst.Registers (VX), Inst.Registers (VY)); + when 4 => + declare + X : constant Byte := Inst.Registers (VX); + Y : constant Byte := Inst.Registers (VY); + begin + Inst.Registers (VX) := X + Y; + Inst.Registers (15) := + (if Integer (X) + Integer (Y) > Integer (X + Y) + then 1 else 0); + end; + when 5 => + declare + X : constant Byte := Inst.Registers (VX); + Y : constant Byte := Inst.Registers (VY); + begin + Inst.Registers (VX) := X - Y; + Inst.Registers (15) := (if X >= Y then 1 else 0); + end; + when 6 => + Inst.Registers (15) := Inst.Registers (VX) mod 2; + Inst.Registers (VX) := Inst.Registers (VX) / 2; + when 14 => + Inst.Registers (15) := Inst.Registers (VX) / (2 ** 7); + Inst.Registers (VX) := Inst.Registers (VX) * 2; + when others => begin + Ada.Text_IO.Put_Line ("Uh oh!"); + Ada.Text_IO.Put_Line (Byte'Image (N)); + end; + end case; + end Math; + + procedure Load_File (Inst : in out Instance; File_Name : String) is + package Byte_IO is new Ada.Sequential_IO (Byte); + + I : Address := Start_Address; + File_Handle : Byte_IO.File_Type; + begin + Byte_IO.Open (File_Handle, Byte_IO.In_File, File_Name); + + while not Byte_IO.End_Of_File (File_Handle) loop + Byte_IO.Read (File_Handle, Inst.Memory (I)); + I := I + 1; + end loop; + + Byte_IO.Close (File_Handle); + end Load_File; +end CPU; diff --git a/src/cpu.ads b/src/cpu.ads new file mode 100644 index 0000000..2fb34f2 --- /dev/null +++ b/src/cpu.ads @@ -0,0 +1,30 @@ +with Ada.Containers.Vectors; +with ISA; + +package CPU is + use ISA; + + package Address_Stack is new Ada.Containers.Vectors + (Index_Type => Natural, Element_Type => Address); + + type Instance is record + Memory : Bank; + Registers : Register_Bank; + Program_Counter : Address := Start_Address; + Address_Register : Address := 0; + Stack : Address_Stack.Vector; + Delay_Timer : Byte := 0; + end record; + + procedure Load_File (Inst : in out Instance; File_Name : String); + + function Get_Opcode (Inst : in out Instance) return Opcode; + + procedure Reg_Store (Inst : in out Instance; VX : Register_Index); + procedure Reg_Load (Inst : in out Instance; VX : Register_Index); + procedure Ret (Inst : in out Instance); + procedure Call (Inst : in out Instance; A : Address); + procedure Jump (Inst : in out Instance; A : Address); + procedure Skip (Inst : in out Instance); + procedure Math (Inst : in out Instance; VX, VY : Register_Index; N : Byte); +end CPU; diff --git a/src/isa.adb b/src/isa.adb new file mode 100644 index 0000000..5941660 --- /dev/null +++ b/src/isa.adb @@ -0,0 +1,10 @@ +package body ISA is + function To_Byte (O : Opcode) return Byte + is (Byte (O.Value mod 256)); + + function X_Register (O : Opcode) return Register_Index + is (Register_Index (O.Value / 256)); + + function Y_Register (O : Opcode) return Register_Index + is (Register_Index (O.Value / 16 mod 16)); +end ISA; diff --git a/src/isa.ads b/src/isa.ads new file mode 100644 index 0000000..656fcbf --- /dev/null +++ b/src/isa.ads @@ -0,0 +1,51 @@ +package ISA is + type Byte is mod 2 ** 8; + type Address is mod 2 ** 12; + 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; + pragma Pack (Pixel); + + type Opcode_Value is mod 2 ** 12; + 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; + + for Opcode use record + Value at 0 range 0 .. 11; + Class at 0 range 12 .. 15; + end record; + + for Opcode_Class use ( + Flow => 0, + Jump => 1, + Call => 2, + Equal => 3, + Not_Equal => 4, + Compare => 5, + Set_Register => 6, + Add => 7, + Math => 8, + Not_Compare => 9, + Set_Address => 10, + Jump_Relative => 11, + Random => 12, + Draw_Sprite => 13, + Input => 14, + Misc => 15); + + Start_Address : constant Address := 16#200#; + + function To_Byte (O : Opcode) return Byte; + + function X_Register (O : Opcode) return Register_Index; + function Y_Register (O : Opcode) return Register_Index; +end ISA; diff --git a/src/video.adb b/src/video.adb new file mode 100644 index 0000000..0a93592 --- /dev/null +++ b/src/video.adb @@ -0,0 +1,59 @@ +with Sf.Window; +with Sf.Window.Event; +with Sf.Graphics.Color; + +package body Video is + procedure Clear_Screen is + begin + for X in 0 .. sfUint32 (Width) - 1 loop + for Y in 0 .. sfUint32 (Height) - 1 loop + Image.setPixel (Pixels, X, Y, Color.sfBlack); + end loop; + end loop; + end Clear_Screen; + + procedure Initialize is + begin + Sprite.setTexture (Pixels_Sprite, Pixels_Texture); + Sprite.setPosition (Pixels_Sprite, (Float (0), Float (0))); + Sprite.setScale (Pixels_Sprite, (Float (Scale), Float (Scale))); + RenderWindow.setFramerateLimit (app, 60); + end Initialize; + + function Is_Running return Boolean is + begin + return RenderWindow.isOpen (app) = sfTrue; + end Is_Running; + + procedure Display is + use Sf.Window.Event; + + e : sfEvent; + begin + while RenderWindow.pollEvent (app, event => e) = sfTrue loop + if e.eventType = sfEvtClosed then + RenderWindow.close (app); + end if; + end loop; + + RenderWindow.clear (app, Color.sfWhite); + Texture.updateFromImage (Pixels_Texture, Pixels, 0, 0); + RenderWindow.drawSprite (app, Pixels_Sprite); + RenderWindow.display (app); + end Display; + + function Toggle_Pixel (X, Y : sfUint32) return Boolean is + use Color; + + P : constant sfColor := Image.getPixel (Pixels, X, Y); + R : constant Boolean := P = sfWhite; + begin + Image.setPixel (Pixels, X, Y, (if R then sfBlack else sfWhite)); + return R; + end Toggle_Pixel; + + procedure Finish is + begin + RenderWindow.close (app); + end Finish; +end Video; diff --git a/src/video.ads b/src/video.ads new file mode 100644 index 0000000..09ff6e8 --- /dev/null +++ b/src/video.ads @@ -0,0 +1,32 @@ +with Sf; +with Sf.Graphics; +with Sf.Graphics.Image; +with Sf.Graphics.RenderWindow; +with Sf.Graphics.Sprite; +with Sf.Graphics.Texture; + +package Video is + use Sf; + use Sf.Graphics; + + Width : constant := 64; + Height : constant := 32; + Scale : constant := 10; + Title : constant String := "Ada-Chip"; + + procedure Clear_Screen; + procedure Initialize; + function Is_Running return Boolean; + procedure Display; + function Toggle_Pixel (X, Y : sfUint32) return Boolean; + procedure Finish; + +private + Pixels : constant sfImage_Ptr := Image.create (Width, Height); + Pixels_Sprite : constant sfSprite_Ptr := Sprite.create; + Pixels_Texture : constant sfTexture_Ptr := + Texture.createFromImage (Pixels); + + app : constant sfRenderWindow_Ptr := RenderWindow.create + ((Width * Scale, Height * Scale, 32), Title); +end Video;