summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ansi_terminal.adb123
-rw-r--r--src/ansi_terminal.ads41
-rw-r--r--src/datatypes.adb15
-rw-r--r--src/datatypes.ads33
-rw-r--r--src/fluid_simulator.adb201
5 files changed, 246 insertions, 167 deletions
diff --git a/src/ansi_terminal.adb b/src/ansi_terminal.adb
new file mode 100644
index 0000000..c356c21
--- /dev/null
+++ b/src/ansi_terminal.adb
@@ -0,0 +1,123 @@
+
+with
+
+ Ada.Characters.Latin_1,
+ Ada.Strings.Fixed,
+ Ada.Text_IO;
+
+package body ANSI_Terminal is
+
+ package Latin renames Ada.Characters.Latin_1;
+ package IO renames Ada.Text_IO;
+
+
+
+ function Clear_Screen
+ return String is
+ begin
+ -- ANSI control sequence Erase in Display
+ -- Variant to clear entire screen
+ return Latin.ESC & "[2J";
+ end Clear_Screen;
+
+ function Reset_Cursor
+ return String is
+ begin
+ -- ANSI control sequence Cursor Position
+ -- Parameters to move cursor to top left corner
+ return Latin.ESC & "[1;1H";
+ end Reset_Cursor;
+
+ procedure Clear_Screen is
+ begin
+ IO.Put (Clear_Screen);
+ end Clear_Screen;
+
+ procedure Reset_Cursor is
+ begin
+ IO.Put (Reset_Cursor);
+ end Reset_Cursor;
+
+
+
+ function BG_Color_Code
+ (Value : in Natural)
+ return String
+ is
+ use Ada.Strings;
+ use Ada.Strings.Fixed;
+ begin
+ -- ANSI sequence to change text background colour
+ -- Total length is always 11 characters
+ -- It doesn't have to be, but the consistency is important for rendering
+ return Latin.ESC & "[48;5;" & Tail (Trim (Integer'Image (Value), Left), 3, '0') & "m";
+ end BG_Color_Code;
+
+
+
+ function Lookup
+ (Input : in March_Cell_Grid;
+ X, Y : in Integer)
+ return String
+ is
+ Average_Density : Natural := Integer (Quantity'Ceiling (Input (X, Y).Density / 4.0));
+ Bit_Index : Positive := Integer (Input (X, Y).Index) + 1;
+ Choice : Natural;
+ begin
+ case Average_Density is
+ when 1 .. 2 => Choice := 19; -- dark blue
+ when 3 .. 4 => Choice := 20; -- slightly less dark blue
+ when 5 .. 6 => Choice := 21; -- slightly dark blue
+ when 7 .. 8 => Choice := 12; -- blue
+ when 9 .. 10 => Choice := 14; -- cyan
+ when 11 .. 12 => Choice := 10; -- green
+ when 13 .. 14 => Choice := 11; -- yellow
+ when 15 .. 16 => Choice := 3; -- dark yellow
+ when 17 .. 18 => Choice := 9; -- red
+ when 19 .. 20 => Choice := 1; -- dark red
+ when others => Choice := 0; -- black
+ end case;
+ -- Total length should always be 12 characters
+ return BG_Color_Code (Choice) & Liquid_Chars (Bit_Index);
+ end Lookup;
+
+ function Marching_Squares
+ (Input : in Particle_Vector)
+ return String
+ is
+ -- Having the grid be one bigger around the edges simplifies calculations
+ Grid : March_Cell_Grid (0 .. 81, 0 .. 26);
+
+ -- 80 cols * 25 rows * 12 chars/cell + 24 linefeeds + 4 char color reset = 24028
+ -- Oh yeah, baby, big strings
+ Output : String (1 .. 24028);
+
+ X, Y, S : Integer;
+ begin
+ for P of Input loop
+ X := Integer (Plane.Re (P.Place) - 0.5);
+ Y := Integer (Plane.Im (P.Place) / 2.0 - 0.5);
+ if X >= 0 and X <= 80 and Y >= 0 and Y <= 25 then
+ for J in Integer range 0 .. 1 loop
+ for I in Integer range 0 .. 1 loop
+ Grid (X + I, Y + J).Index :=
+ Grid (X + I, Y + J).Index or (2 ** (I + 2 * J));
+ Grid (X + I, Y + J).Density :=
+ Grid (X + I, Y + J).Density + P.Density;
+ end loop;
+ end loop;
+ end if;
+ end loop;
+ for J in Integer range 1 .. 25 loop
+ for I in Integer range 1 .. 80 loop
+ S := (J - 1) * 961 + (I - 1) * 12 + 1;
+ Output (S .. S + 11) := Lookup (Grid, I, J);
+ end loop;
+ Output (J * 961) := Latin.LF;
+ end loop;
+ Output (24025 .. 24028) := Latin.ESC & "[0m";
+ return Output;
+ end Marching_Squares;
+
+end ANSI_Terminal;
+
diff --git a/src/ansi_terminal.ads b/src/ansi_terminal.ads
new file mode 100644
index 0000000..027f771
--- /dev/null
+++ b/src/ansi_terminal.ads
@@ -0,0 +1,41 @@
+
+with
+
+ Datatypes;
+
+package ANSI_Terminal is
+
+ function Clear_Screen
+ return String;
+
+ function Reset_Cursor
+ return String;
+
+ procedure Clear_Screen;
+ procedure Reset_Cursor;
+
+ function BG_Color_Code
+ (Value : in Natural)
+ return String;
+
+ function Marching_Squares
+ (Input : in Datatypes.Particle_Vector)
+ return String;
+
+private
+
+ use Datatypes;
+
+ Liquid_Chars : constant String (1 .. 16) := " ,.-`[//'\]\-\/#";
+
+ type Liquidex is mod 2**4;
+
+ type March_Cell is record
+ Index : Liquidex := 0;
+ Density : Quantity := 0.0;
+ end record;
+
+ type March_Cell_Grid is array (Integer range <>, Integer range <>) of March_Cell;
+
+end ANSI_Terminal;
+
diff --git a/src/datatypes.adb b/src/datatypes.adb
new file mode 100644
index 0000000..64ff017
--- /dev/null
+++ b/src/datatypes.adb
@@ -0,0 +1,15 @@
+
+package body Datatypes is
+
+
+ function Create
+ (X, Y : Quantity;
+ Solid : in Boolean)
+ return Particle is
+ begin
+ return (Place => Plane.Compose_From_Cartesian (X, Y), Solid => Solid, others => <>);
+ end Create;
+
+
+end Datatypes;
+
diff --git a/src/datatypes.ads b/src/datatypes.ads
new file mode 100644
index 0000000..50d21f9
--- /dev/null
+++ b/src/datatypes.ads
@@ -0,0 +1,33 @@
+
+with
+
+ Ada.Numerics.Generic_Complex_Types,
+ Ada.Containers.Vectors;
+
+package Datatypes is
+
+ type Quantity is digits 18;
+
+ package Plane is new Ada.Numerics.Generic_Complex_Types (Real => Quantity);
+
+ type Particle is record
+ Place : Plane.Complex;
+ Solid : Boolean;
+ Density : Quantity := 0.0;
+ Acceleration : Plane.Complex := Plane.Compose_From_Cartesian (0.0, 0.0);
+ Velocity : Plane.Complex := Plane.Compose_From_Cartesian (0.0, 0.0);
+ end record;
+
+ function Create
+ (X, Y : in Quantity;
+ Solid : in Boolean)
+ return Particle;
+
+ package Particle_Vectors is new Ada.Containers.Vectors
+ (Index_Type => Positive,
+ Element_Type => Particle);
+
+ subtype Particle_Vector is Particle_Vectors.Vector;
+
+end Datatypes;
+
diff --git a/src/fluid_simulator.adb b/src/fluid_simulator.adb
index b8d47ce..f683259 100644
--- a/src/fluid_simulator.adb
+++ b/src/fluid_simulator.adb
@@ -1,57 +1,29 @@
with
- Ada.Numerics.Generic_Complex_Types,
- Ada.Containers.Vectors,
+ Datatypes,
+ ANSI_Terminal,
Ada.Characters.Latin_1,
- Ada.Strings.Fixed,
Ada.Text_IO;
-procedure Fluid_Simulator is
-
- package Latin renames Ada.Characters.Latin_1;
- package IO renames Ada.Text_IO;
+use
+ Datatypes;
+use type
- procedure Clear_Screen is
- begin
- -- ANSI control sequence Erase in Display
- -- Variant to clear entire screen
- IO.Put (Latin.ESC & "[2J");
- end Clear_Screen;
-
- procedure Reset_Cursor is
- begin
- -- ANSI control sequence Cursor Position
- -- Parameters to move cursor to top left corner
- IO.Put (Latin.ESC & "[1;1H");
- end Reset_Cursor;
+ Datatypes.Plane.Complex,
+ Datatypes.Plane.Imaginary;
+procedure Fluid_Simulator is
+ package ANSI renames ANSI_Terminal;
+ package Latin renames Ada.Characters.Latin_1;
+ package IO renames Ada.Text_IO;
- type Quantity is digits 18;
-
- package Fixed is new Ada.Numerics.Generic_Complex_Types (Real => Quantity);
- use type Fixed.Complex;
-
- type Particle is record
- Place : Fixed.Complex;
- Solid : Boolean;
- Density : Quantity := 0.0;
- Acceleration : Fixed.Complex := Fixed.Compose_From_Cartesian (0.0, 0.0);
- Velocity : Fixed.Complex := Fixed.Compose_From_Cartesian (0.0, 0.0);
- end record;
-
- function Create
- (X, Y : Quantity;
- Solid : in Boolean)
- return Particle is
- begin
- return (Place => Fixed.Compose_From_Cartesian (X, Y), Solid => Solid, others => <>);
- end Create;
+ Particles : Particle_Vector := Particle_Vectors.Empty_Vector;
-- Constant properties of particles
Particle_Radius : constant Quantity := 2.0;
@@ -61,22 +33,14 @@ procedure Fluid_Simulator is
P0 : constant Quantity := 1.5;
-- Other constant force factors
- Gravity_Factor : constant Fixed.Complex := Fixed.Compose_From_Cartesian (0.0, 1.0);
- Pressure_Factor : constant Quantity := 4.0;
+ Gravity_Factor : constant Plane.Complex := Plane.Compose_From_Cartesian (0.0, 1.0);
+ Pressure_Factor : constant Quantity := 4.0;
Viscosity_Factor : constant Quantity := 8.0;
- package Particle_Vectors is new Ada.Containers.Vectors
- (Index_Type => Positive,
- Element_Type => Particle);
-
- Particles : Particle_Vectors.Vector := Particle_Vectors.Empty_Vector;
-
-
-
procedure Read_Input
- (Store : out Particle_Vectors.Vector)
+ (Store : out Particle_Vector)
is
Input : Character;
X, Y : Quantity := 1.0;
@@ -98,110 +62,15 @@ procedure Fluid_Simulator is
- -- Liquid_Chars : constant String (1 .. 16) := " .,_`/[/']\\-/\#";
- Liquid_Chars : constant String (1 .. 16) := " ,.-`[//'\]\-\/#";
-
- type Liquidex is mod 2**4;
-
- type March_Cell is record
- Index : Liquidex := 0;
- Density : Quantity := 0.0;
- end record;
-
- type March_Cell_Grid is array (Integer range <>, Integer range <>) of March_Cell;
-
-
-
- function BG_Color_Code
- (Value : in Natural)
- return String
- is
- use Ada.Strings;
- use Ada.Strings.Fixed;
- begin
- -- Total length is always 11 characters
- return Latin.ESC & "[48;5;" & Tail (Trim (Integer'Image (Value), Left), 3, '0') & "m";
- end BG_Color_Code;
-
-
-
- function Lookup
- (Input : in March_Cell_Grid;
- X, Y : in Integer)
- return String
- is
- Average_Density : Natural := Integer (Quantity'Ceiling (Input (X, Y).Density / 4.0));
- Bit_Index : Positive := Integer (Input (X, Y).Index) + 1;
- Choice : Natural;
- begin
- case Average_Density is
- when 1 .. 2 => Choice := 19; -- dark blue
- when 3 .. 4 => Choice := 20; -- slightly less dark blue
- when 5 .. 6 => Choice := 21; -- slightly dark blue
- when 7 .. 8 => Choice := 12; -- blue
- when 9 .. 10 => Choice := 14; -- cyan
- when 11 .. 12 => Choice := 10; -- green
- when 13 .. 14 => Choice := 11; -- yellow
- when 15 .. 16 => Choice := 3; -- dark yellow
- when 17 .. 18 => Choice := 9; -- red
- when 19 .. 20 => Choice := 1; -- dark red
- when others => Choice := 0; -- black
- end case;
- -- Total length should always be 12 characters
- return BG_Color_Code (Choice) & Liquid_Chars (Bit_Index);
- end Lookup;
-
-
-
- function Marching_Squares
- (Input : in Particle_Vectors.Vector)
- return String
- is
- -- Having the grid be one bigger around the edges simplifies calculations
- Grid : March_Cell_Grid (0 .. 81, 0 .. 26);
-
- -- 80 cols * 25 rows * 12 chars/cell + 24 linefeeds + 4 char color reset = 24028
- -- Oh yeah, baby, big strings
- Output : String (1 .. 24028);
-
- X, Y, S : Integer;
- begin
- for P of Input loop
- X := Integer (Fixed.Re (P.Place) - 0.5);
- Y := Integer (Fixed.Im (P.Place) / 2.0 - 0.5);
- if X >= 0 and X <= 80 and Y >= 0 and Y <= 25 then
- for J in Integer range 0 .. 1 loop
- for I in Integer range 0 .. 1 loop
- Grid (X + I, Y + J).Index :=
- Grid (X + I, Y + J).Index or (2 ** (I + 2 * J));
- Grid (X + I, Y + J).Density :=
- Grid (X + I, Y + J).Density + P.Density;
- end loop;
- end loop;
- end if;
- end loop;
- for J in Integer range 1 .. 25 loop
- for I in Integer range 1 .. 80 loop
- S := (J - 1) * 961 + (I - 1) * 12 + 1;
- Output (S .. S + 11) := Lookup (Grid, I, J);
- end loop;
- Output (J * 961) := Latin.LF;
- end loop;
- Output (24025 .. 24028) := Latin.ESC & "[0m";
- return Output;
- end Marching_Squares;
-
-
-
procedure Calculate_Density
- (Store : in out Particle_Vectors.Vector)
+ (Store : in out Particle_Vector)
is
Rij, W : Quantity;
begin
for P of Store loop
P.Density := (if P.Solid then 9.0 else 0.0);
for Q of Store loop
- Rij := Fixed.Modulus (P.Place - Q.Place);
+ Rij := Plane.Modulus (P.Place - Q.Place);
W := (Rij / Particle_Radius - 1.0) ** 2;
if Rij < Particle_Radius then
P.Density := P.Density + Particle_Mass * W;
@@ -210,34 +79,31 @@ procedure Fluid_Simulator is
end loop;
end Calculate_Density;
-
-
procedure Calculate_Interaction
- (Store : in out Particle_Vectors.Vector)
+ (Store : in out Particle_Vector)
is
- Displacement, Pressure, Viscosity : Fixed.Complex;
+ Displacement, Pressure, Viscosity : Plane.Complex;
Rij : Quantity;
begin
for P of Store loop
P.Acceleration := Gravity_Factor;
for Q of Store loop
Displacement := P.Place - Q.Place;
- Rij := Fixed.Modulus (Displacement);
+ Rij := Plane.Modulus (Displacement);
if Rij < Particle_Radius then
- Pressure := (P.Density + Q.Density - 2.0 * P0) * Pressure_Factor * Displacement;
+ Pressure := (P.Density + Q.Density - 2.0 * P0) *
+ Pressure_Factor * Displacement;
Viscosity := (P.Velocity - Q.Velocity) * Viscosity_Factor;
P.Acceleration := P.Acceleration +
- Fixed.Compose_From_Cartesian (1.0 - Rij / Particle_Radius) /
+ Plane.Compose_From_Cartesian (1.0 - Rij / Particle_Radius) /
P.Density * (Pressure - Viscosity);
end if;
end loop;
end loop;
end Calculate_Interaction;
-
-
procedure Update_Position
- (Store : in out Particle_Vectors.Vector) is
+ (Store : in out Particle_Vector) is
begin
for P of Store loop
if not P.Solid then
@@ -250,27 +116,28 @@ procedure Fluid_Simulator is
procedure Cull_Outside_Bounds
- (Store : in out Particle_Vectors.Vector;
- Threshold : in Quantity) is
+ (Store : in out Particle_Vector;
+ Threshold : in Quantity) is
begin
for C in reverse Store.First_Index .. Store.Last_Index loop
- if Fixed.Re (Store (C).Place) < 1.0 - Threshold or
- Fixed.Re (Store (C).Place) > 80.0 + Threshold or
- Fixed.Im (Store (C).Place) < 1.0 - Threshold or
- Fixed.Im (Store (C).Place) > 50.0 + Threshold
+ if Plane.Re (Store (C).Place) < 1.0 - Threshold or
+ Plane.Re (Store (C).Place) > 80.0 + Threshold or
+ Plane.Im (Store (C).Place) < 1.0 - Threshold or
+ Plane.Im (Store (C).Place) > 50.0 + Threshold
then
Store.Delete (C);
end if;
end loop;
end Cull_Outside_Bounds;
+
begin
Read_Input (Particles);
loop
- Clear_Screen;
- Reset_Cursor;
- IO.Put (Marching_Squares (Particles));
+ ANSI.Clear_Screen;
+ ANSI.Reset_Cursor;
+ IO.Put (ANSI.Marching_Squares (Particles));
Calculate_Density (Particles);
Calculate_Interaction (Particles);
Update_Position (Particles);
generated by cgit (git 2.30.0) at 2024-12-22 09:18:37 +0000