aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2025-01-13 09:36:52 -0500
committerClyne Sullivan <clyne@bitgloo.com>2025-01-13 09:36:52 -0500
commit54c6831e9dd19489ce3275eb68e5781c5899c26b (patch)
tree8b17af591db76d298ebeb6fd3d37c8958414d3cd
parent3465042dc2a80f4090d6cf6b65ddc33ee4e48b55 (diff)
wip scroll support
-rw-r--r--src/ada_chip.adb20
-rw-r--r--src/isa.ads38
-rw-r--r--src/video.adb38
-rw-r--r--src/video.ads3
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;