diff options
author | Clyne Sullivan <clyne@bitgloo.com> | 2025-01-13 09:36:52 -0500 |
---|---|---|
committer | Clyne Sullivan <clyne@bitgloo.com> | 2025-01-13 09:36:52 -0500 |
commit | 54c6831e9dd19489ce3275eb68e5781c5899c26b (patch) | |
tree | 8b17af591db76d298ebeb6fd3d37c8958414d3cd | |
parent | 3465042dc2a80f4090d6cf6b65ddc33ee4e48b55 (diff) |
wip scroll support
-rw-r--r-- | src/ada_chip.adb | 20 | ||||
-rw-r--r-- | src/isa.ads | 38 | ||||
-rw-r--r-- | src/video.adb | 38 | ||||
-rw-r--r-- | src/video.ads | 3 |
4 files changed, 87 insertions, 12 deletions
diff --git a/src/ada_chip.adb b/src/ada_chip.adb index b6a7611..cd156f7 100644 --- a/src/ada_chip.adb +++ b/src/ada_chip.adb @@ -82,16 +82,20 @@ procedure Ada_Chip is end Draw_Sprite; procedure Run_Flow (ins : ISA.Opcode) is + use ISA; begin - case ins.Value is - when ISA.Clear_Screen => Video.Clear_Screen; - when ISA.Ret => CPU.Ret (State); - when ISA.Low_Res => Video.Low_Res; - when ISA.High_Res => Video.High_Res; - when others => - Ada.Text_IO.Put_Line ("Machine code calls are unsupported!"); - delay 1.0; + case Flow_Class'Enum_Val (ins.Value) is + when Scroll_Down_0 .. Scroll_Down_15 => + null; + when Scroll_Right => Video.Scroll_Right; + when Scroll_Left => Video.Scroll_Left; + when Exit_Interpreter => + Ada.Text_IO.Put_Line ("Exit interpreter not supported!"); Video.Finish; + when Clear_Screen => Video.Clear_Screen; + when Ret => CPU.Ret (State); + when Low_Res => Video.Low_Res; + when High_Res => Video.High_Res; end case; end Run_Flow; diff --git a/src/isa.ads b/src/isa.ads index e5310d3..2552995 100644 --- a/src/isa.ads +++ b/src/isa.ads @@ -43,10 +43,40 @@ package ISA is Misc => 15 ); - Clear_Screen : constant Opcode_Value := 16#E0#; - Ret : constant Opcode_Value := 16#EE#; - Low_Res : constant Opcode_Value := 16#FE#; - High_Res : constant Opcode_Value := 16#FF#; + type Flow_Class is ( + Scroll_Down_0, Scroll_Down_1, Scroll_Down_2, Scroll_Down_3, + Scroll_Down_4, Scroll_Down_5, Scroll_Down_6, Scroll_Down_7, + Scroll_Down_8, Scroll_Down_9, Scroll_Down_10, Scroll_Down_11, + Scroll_Down_12, Scroll_Down_13, Scroll_Down_14, Scroll_Down_15, + Clear_Screen, Ret, Scroll_Right, Scroll_Left, Exit_Interpreter, Low_Res, + High_Res + ); + + for Flow_Class use ( + Scroll_Down_0 => 16#C0#, + Scroll_Down_1 => 16#C1#, + Scroll_Down_2 => 16#C2#, + Scroll_Down_3 => 16#C3#, + Scroll_Down_4 => 16#C4#, + Scroll_Down_5 => 16#C5#, + Scroll_Down_6 => 16#C6#, + Scroll_Down_7 => 16#C7#, + Scroll_Down_8 => 16#C8#, + Scroll_Down_9 => 16#C9#, + Scroll_Down_10 => 16#CA#, + Scroll_Down_11 => 16#CB#, + Scroll_Down_12 => 16#CC#, + Scroll_Down_13 => 16#CD#, + Scroll_Down_14 => 16#CE#, + Scroll_Down_15 => 16#CF#, + Clear_Screen => 16#E0#, + Ret => 16#EE#, + Scroll_Right => 16#FB#, + Scroll_Left => 16#FC#, + Exit_Interpreter => 16#FD#, + Low_Res => 16#FE#, + High_Res => 16#FF# + ); type Math_Class is ( Assign, Bit_Or, Bit_And, Bit_Xor, Add, Sub_Y, Shift_Right, Sub_X, diff --git a/src/video.adb b/src/video.adb index f4ddb6b..657d285 100644 --- a/src/video.adb +++ b/src/video.adb @@ -16,6 +16,44 @@ package body Video is end loop; end Clear_Screen; + procedure Scroll_Right is + use Sf.Graphics.Color; + + SS : constant sfUint32 := 4; + Tmp : array (0 .. SS - 1) of sfColor; + begin + for J in 0 .. Height - 1 loop + for I in 0 .. SS - 1 loop + Tmp (I) := Image.getPixel (Pixels, Width - SS + I, J); + end loop; + for I in 0 .. Width - 5 loop + Image.setPixel (Pixels, I + SS, J, Image.getPixel (Pixels, I, J)); + end loop; + for I in 0 .. SS - 1 loop + Image.setPixel (Pixels, I, J, Tmp (I)); + end loop; + end loop; + end Scroll_Right; + + procedure Scroll_Left is + use Sf.Graphics.Color; + + SS : constant sfUint32 := 4; + Tmp : array (0 .. SS - 1) of sfColor; + begin + for J in 0 .. Height - 1 loop + for I in 0 .. SS - 1 loop + Tmp (I) := Image.getPixel (Pixels, I, J); + end loop; + for I in SS .. Width - 1 loop + Image.setPixel (Pixels, I - SS, J, Image.getPixel (Pixels, I, J)); + end loop; + for I in 0 .. SS - 1 loop + Image.setPixel (Pixels, Width - SS + I, J, Tmp (I)); + end loop; + end loop; + end Scroll_Left; + procedure Low_Res is begin Video.Width := 64; diff --git a/src/video.ads b/src/video.ads index ec9b212..49d3c95 100644 --- a/src/video.ads +++ b/src/video.ads @@ -24,6 +24,9 @@ package Video is procedure Finish; procedure Poll_Events; + 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; |