Colourful, improved marching squares

1 files changed, 79 insertions, 14 deletions

diff --git a/src/fluid_simulator.adb b/src/fluid_simulator.adb
index f36b834..b8d47ce 100644
--- a/src/fluid_simulator.adb
+++ b/src/fluid_simulator.adb
@@ -4,6 +4,7 @@ with
     Ada.Numerics.Generic_Complex_Types,
     Ada.Containers.Vectors,
     Ada.Characters.Latin_1,
+    Ada.Strings.Fixed,
     Ada.Text_IO;
 
 procedure Fluid_Simulator is
@@ -97,32 +98,96 @@ 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
-        Liquid_Chars : String (1 .. 16) := " .,_`/[/']\\-/\#";
-        Grid : array (0 .. 80, 0 .. 25) of Boolean := (others => (others => False));
-        Output : String (1 .. 2025);
-        X, Y : Integer;
+        --  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));
-            Y := Integer (Fixed.Im (P.Place));
-            if X >= 0 and X <= 80 and Y >= 0 and Y <= 50 then
-                Grid (X, Y / 2) := True;
+            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
-                Output ((J - 1) * 81 + I) := Liquid_Chars
-                   (Boolean'Pos (Grid (I - 1, J)) + 1 +
-                    Boolean'Pos (Grid (I, J)) * 2 +
-                    Boolean'Pos (Grid (I, J - 1)) * 4 +
-                    Boolean'Pos (Grid (I - 1, J - 1)) * 8);
+                S := (J - 1) * 961 + (I - 1) * 12 + 1;
+                Output (S .. S + 11) := Lookup (Grid, I, J);
             end loop;
-            Output (J * 81) := Latin.LF;
+            Output (J * 961) := Latin.LF;
         end loop;
+        Output (24025 .. 24028) := Latin.ESC & "[0m";
         return Output;
     end Marching_Squares;