gfxtest/hw-gfx-gma-gfx_test.adb

with Ada.Numerics.Discrete_Random;
with Ada.Unchecked_Conversion;
with Ada.Command_Line;
with Interfaces.C;

with HW.Time;
with HW.Debug;
with HW.PCI.Dev;
with HW.MMIO_Range;
with HW.GFX.GMA.Config;
with HW.GFX.GMA.Registers;
with HW.GFX.GMA.Display_Probing;

package body HW.GFX.GMA.GFX_Test
is
   pragma Disable_Atomic_Synchronization;

   Primary_Delay_MS     : constant := 8_000;
   Secondary_Delay_MS   : constant := 4_000;
   HP_Delay_MS          : constant :=   500;
   Seed                 : constant := 12345;

   package Rand_P is new Ada.Numerics.Discrete_Random (Natural);
   function Rand (Gen : Rand_P.Generator)
      return Int32 is (Int32 (Rand_P.Random (Gen)));

   Start_X : constant := 0;
   Start_Y : constant := 0;

   package Dev is new PCI.Dev (PCI.Address'(0, 2, 0));

   type GTT_Entry is record
      Addr  : GTT_Address_Type;
      Valid : Boolean;
   end record;
   GTT_Backup : array (GTT_Range) of GTT_Entry;
   GTT_Backup_Count : Natural;

   procedure Backup_GTT
   is
   begin
      GMA.GTT_Entry_Count (GTT_Backup_Count);
      if GTT_Backup_Count = 0 then
         Debug.Put_Line ("WARNING: GTT size is 0, skipping GTT backup.");
         return;
      end if;
      for Idx in GTT_Range range 0 .. GTT_Backup_Count - 1 loop
         Read_GTT (GTT_Backup (Idx).Addr, GTT_Backup (Idx).Valid, Idx);
      end loop;
   end Backup_GTT;

   procedure Restore_GTT
   is
   begin
      if GTT_Backup_Count = 0 then
         return;
      end if;
      for Idx in GTT_Range range 0 .. GTT_Backup_Count - 1 loop
         Write_GTT (Idx, GTT_Backup (Idx).Addr, GTT_Backup (Idx).Valid);
      end loop;
   end Restore_GTT;

   type Pixel_Type is record
      Red   : Byte;
      Green : Byte;
      Blue  : Byte;
      Alpha : Byte;
   end record;

   for Pixel_Type use record
      Blue  at 0 range 0 .. 7;
      Green at 1 range 0 .. 7;
      Red   at 2 range 0 .. 7;
      Alpha at 3 range 0 .. 7;
   end record;

   White : constant Pixel_Type := (255, 255, 255, 255);
   Black : constant Pixel_Type := (  0,   0,   0, 255);
   Red   : constant Pixel_Type := (255,   0,   0, 255);
   Green : constant Pixel_Type := (  0, 255,   0, 255);
   Blue  : constant Pixel_Type := (  0,   0, 255, 255);

   function Pixel_To_Word (P : Pixel_Type) return Word32
   with
      SPARK_Mode => Off
   is
      function To_Word is new Ada.Unchecked_Conversion (Pixel_Type, Word32);
   begin
      return To_Word (P);
   end Pixel_To_Word;

   Max_W          : constant := 4096;
   Max_H          : constant := 2160;
   FB_Align       : constant := 16#0004_0000#;
   Cursor_Align   : constant := 16#0001_0000#;
   Max_Cursor_Wid : constant := 256;
   subtype Screen_Index is Natural range 0 .. 3 *
      (Max_W * Max_H + FB_Align / 4 +
       3 * Max_Cursor_Wid * Max_Cursor_Wid + Cursor_Align / 4)
      - 1;
   type Screen_Type is array (Screen_Index) of Word32;

   function Screen_Offset (FB : Framebuffer_Type) return Natural is
     (Natural (Phys_Offset (FB) / 4));

   package Screen is new MMIO_Range (0, Word32, Screen_Index, Screen_Type);

   Screen_Backup : Screen_Type;

   procedure Backup_Screen (FB : Framebuffer_Type)
   is
      First : constant Screen_Index := Screen_Offset (FB);
      Last  : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
   begin
      for Idx in Screen_Index range First .. Last loop
         Screen.Read (Screen_Backup (Idx), Idx);
      end loop;
   end Backup_Screen;

   procedure Restore_Screen (FB : Framebuffer_Type)
   is
      First : constant Screen_Index := Screen_Offset (FB);
      Last  : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
   begin
      for Idx in Screen_Index range First .. Last loop
         Screen.Write (Idx, Screen_Backup (Idx));
      end loop;
   end Restore_Screen;

   function Drawing_Width (FB : Framebuffer_Type) return Natural is
     (Natural (FB.Width + 2 * Start_X));

   function Drawing_Height (FB : Framebuffer_Type) return Natural is
     (Natural (FB.Height + 2 * Start_Y));

   function Corner_Fill
     (X, Y  : Natural;
      FB    : Framebuffer_Type;
      Pipe  : Pipe_Index)
      return Pixel_Type
   is
      Xrel : constant Integer :=
        (if X < 32 then X else X - (Drawing_Width (FB) - 32));
      Yrel : constant Integer :=
        (if Y < 32 then Y else Y - (Drawing_Height (FB) - 32));

      function Color (Idx : Natural) return Pixel_Type is
        (case (Idx + Pipe_Index'Pos (Pipe)) mod 4 is
            when 0 => Blue,   when      1 => Black,
            when 3 => Green,  when others => Red);
   begin
      return
        (if Xrel mod 16 = 0 or Xrel = 31 or Yrel mod 16 = 0 or Yrel = 31 then
            White
         elsif Yrel < 16 then
           (if Xrel < 16 then Color (0) else Color (1))
         else
           (if Xrel < 16 then Color (3) else Color (2)));
   end Corner_Fill;

   function Fill
     (X, Y        : Natural;
      Framebuffer : Framebuffer_Type;
      Pipe        : Pipe_Index)
      return Pixel_Type
   is
      use type HW.Byte;

      Xp : constant Natural := X * 256 / Drawing_Width (Framebuffer);
      Yp : constant Natural := Y * 256 / Drawing_Height (Framebuffer);
      Xn : constant Natural := 255 - Xp;
      Yn : constant Natural := 255 - Yp;

      function Map (X, Y : Natural) return Byte is
      begin
         return Byte (X * Y / 255);
      end Map;
   begin
      return
        (case Pipe is
         when GMA.Primary   => (Map (Xn, Yn), Map (Xp, Yn), Map (Xp, Yp), 255),
         when GMA.Secondary => (Map (Xn, Yp), Map (Xn, Yn), Map (Xp, Yn), 255),
         when GMA.Tertiary  => (Map (Xp, Yp), Map (Xn, Yp), Map (Xn, Yn), 255));
   end Fill;

   procedure Test_Screen
     (Framebuffer : Framebuffer_Type;
      Pipe        : GMA.Pipe_Index)
   is
      P        : Pixel_Type;
      -- We have pixel offset wheras the framebuffer has a byte offset
      Offset_Y : Natural := Screen_Offset (Framebuffer);
      Offset   : Natural;

      function Top_Test (X, Y : Natural) return Boolean
      is
         C     : constant Natural := Drawing_Width (Framebuffer) / 2;
         S_Y   : constant Natural := 3 * (Y - Start_Y) / 2;
         Left  : constant Integer := X - C + S_Y;
         Right : constant Integer := X - C - S_Y;
      begin
         return
            (Y - Start_Y) < 12 and
            ((-1 <= Left and Left <= 0) or
             (0 <= Right and Right <= 1));
      end Top_Test;
   begin
      for Y in 0 .. Drawing_Height (Framebuffer) - 1 loop
         Offset := Offset_Y;
         for X in 0 .. Drawing_Width (Framebuffer) - 1 loop
            if (X < 32 or X >= Drawing_Width (Framebuffer) - 32) and
               (Y < 32 or Y >= Drawing_Height (Framebuffer) - 32)
            then
               P := Corner_Fill (X, Y, Framebuffer, Pipe);
            elsif Framebuffer.Rotation /= No_Rotation and then
                  Top_Test (X, Y)
            then
               P := White;
            elsif Y mod 16 = 0 or X mod 16 = 0 then
               P := Black;
            else
               P := Fill (X, Y, Framebuffer, Pipe);
            end if;
            Screen.Write (Offset, Pixel_To_Word (P));
            Offset := Offset + 1;
         end loop;
         Offset_Y := Offset_Y + Natural (Framebuffer.Stride);
      end loop;
   end Test_Screen;

   function Donut (X, Y, Max : Cursor_Pos) return Byte
   is
      ZZ : constant Int32 := Max * Max * 2;
      Dist_Center : constant Int32 := ((X * X + Y * Y) * 255) / ZZ;
      Dist_Circle : constant Int32 := Dist_Center - 20;
   begin
      return Byte (255 - Int32'Min (255, 6 * abs Dist_Circle + 64));
   end Donut;

   procedure Draw_Cursor (Pipe : Pipe_Index; Rotation : Rotation_Type; Cursor : Cursor_Type)
   is
      use type HW.Byte;
      Width : constant Width_Type := Cursor_Width (Cursor.Size);
      GTT_Offset : constant GTT_Range :=
        (if Rotation = Rotated_90 or Rotation = Rotated_270 then
            Cursor.GTT_Offset - GTT_Rotation_Offset
         else
            Cursor.GTT_Offset);
      Screen_Offset : Natural := Natural (Shift_Left (Word32 (GTT_Offset), 12) / 4);
   begin
      if Cursor.Mode /= ARGB_Cursor then
         return;
      end if;
      for Y in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
         for X in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
            declare
               D : constant Byte := Donut (X, Y, Width / 2);
            begin
               -- Hardware seems to expect pre-multiplied alpha (i.e.
               -- color components already contain the alpha).
               Screen.Write
                 (Index => Screen_Offset,
                  Value => Pixel_To_Word (
                    (Red   => (if Pipe = Secondary then D / 2 else 0),
                     Green => (if Pipe = Tertiary  then D / 2 else 0),
                     Blue  => (if Pipe = Primary   then D / 2 else 0),
                     Alpha => D)));
               Screen_Offset := Screen_Offset + 1;
            end;
         end loop;
      end loop;
   end Draw_Cursor;

   procedure Calc_Framebuffer
     (FB       :    out Framebuffer_Type;
      Mode     : in     Mode_Type;
      Rotation : in     Rotation_Type;
      Offset   : in out Word32)
   is
      Width : constant Width_Type := Mode.H_Visible;
      Height : constant Height_Type := Mode.V_Visible;
   begin
      Offset := (Offset + FB_Align - 1) and not (FB_Align - 1);
      if Rotation = Rotated_90 or Rotation = Rotated_270 then
         FB :=
           (Width    => Height,
            Height   => Width,
            Start_X  => Start_X,
            Start_Y  => Start_Y,
            BPC      => 8,
            Stride   => Div_Round_Up (Height + 2 * Start_X, 32) * 32,
            V_Stride => Div_Round_Up (Width + 2 * Start_Y, 32) * 32,
            Tiling   => Y_Tiled,
            Rotation => Rotation,
            Offset   => Offset + Word32 (GTT_Rotation_Offset) * GTT_Page_Size);
      else
         FB :=
           (Width    => Width,
            Height   => Height,
            Start_X  => Start_X,
            Start_Y  => Start_Y,
            BPC      => 8,
            Stride   => Div_Round_Up (Width + 2 * Start_X, 16) * 16,
            V_Stride => Height + 2 * Start_Y,
            Tiling   => Linear,
            Rotation => Rotation,
            Offset   => Offset);
      end if;
      Offset := Offset + Word32 (FB_Size (FB));
   end Calc_Framebuffer;

   type Cursor_Array is array (Cursor_Size) of Cursor_Type;
   Cursors : array (Pipe_Index) of Cursor_Array;

   procedure Prepare_Cursors
     (Cursors  :    out Cursor_Array;
      Rotation : in     Rotation_Type;
      Offset   : in out Word32)
   is
      GMA_Phys_Base_Mask : constant := 16#fff0_0000#;

      Phys_Base : Word32;
      Success : Boolean;
   begin
      if Config.GMA_Base_Is_64bit then
         Dev.Read32 (Phys_Base, Config.GMA_Phys_Base_Index + 4);
         if Phys_Base /= 0 then
            pragma Debug (Debug.Put_Line ("Cannot handle 64-bit DSM yet."));
            return;
         end if;
      end if;

      Dev.Read32 (Phys_Base, Config.GMA_Phys_Base_Index);
      Phys_Base := Phys_Base and GMA_Phys_Base_Mask;
      Success := Phys_Base /= GMA_Phys_Base_Mask and Phys_Base /= 0;
      if not Success then
         Debug.Put_Line ("Failed to read stolen memory base.");
         return;
      end if;

      for Size in Cursor_Size loop
         Offset := (Offset + Cursor_Align - 1) and not (Cursor_Align - 1);
         declare
            Width : constant Width_Type := Cursor_Width (Size);
            Height : Width_Type renames Width;

            Phys_End : constant Word32 := Offset + Word32 (Width * Height) * 4;
            GTT_Start : constant GTT_Range := GTT_Range (Shift_Right (Offset, 12));
            GTT_End   : constant GTT_Range := GTT_Range (Shift_Right (Phys_End, 12));
            -- 90 degree rotations use a special framebuffer mapping w/ GTT_Rotation_Offset:
            Scanout_Offset : constant GTT_Range :=
              (if Rotation in Rotated_90 | Rotated_270 then GTT_Rotation_Offset else 0);
         begin
            Cursors (Size) :=
              (Mode        => ARGB_Cursor,
               Size        => Size,
               Center_X    => Width,
               Center_Y    => Height,
               GTT_Offset  => GTT_Start + Scanout_Offset);

            while Offset < Phys_End loop
               GMA.Write_GTT
                 (GTT_Page       => GTT_Range (Offset / GTT_Page_Size),
                  Device_Address => GTT_Address_Type (Phys_Base + Offset),
                  Valid          => True);
               Offset := Offset + GTT_Page_Size;
            end loop;

            if Rotation in Rotated_90 | Rotated_270 then
               -- In case of y-tiled surfaces (needed for 90 degree rotations),
               -- the fence makes the framebuffer writeable like a linear one.
               Registers.Add_Fence
                 (First_Page  => GTT_Start,
                  Last_Page   => GTT_End - 1,
                  Tiling      => Y_Tiled,
                  Pitch       => Natural (Width / Tile_Width (Y_Tiled)),
                  Success     => Success);

               -- Though, for the scanout of the rotated surface, we have to add
               -- a special,  rotated framebuffer mapping.  For each linear page
               -- index we calculate `Phys_Addr` column-wise from bottom to top.
               declare
                  subtype Rotated_Pages is GTT_Range range
                     GTT_Start + GTT_Rotation_Offset .. GTT_End - 1 + GTT_Rotation_Offset;

                  Bytes_Per_Row : constant GTT_Address_Type :=
                     GTT_Address_Type (Tile_Rows (Y_Tiled) * Width * 4);
                  V_Pages : constant GTT_Range := GTT_Range (Height / Tile_Rows (Y_Tiled));
                  V_Bytes : constant GTT_Address_Type :=
                     GTT_Address_Type (V_Pages) * Bytes_Per_Row;

                  Phys_Addr : GTT_Address_Type := GTT_Address_Type (Phys_Base + Phys_End);
               begin
                  for Page in Rotated_Pages loop
                     Phys_Addr := Phys_Addr - Bytes_Per_Row;

                     Registers.Write_GTT
                       (GTT_Page       => Page,
                        Device_Address => Phys_Addr,
                        Valid          => True);

                     if (Page - Rotated_Pages'First + 1) mod V_Pages = 0 then
                        Phys_Addr := Phys_Addr + GTT_Page_Size + V_Bytes;
                     end if;
                  end loop;
               end;
            end if;
         end;
      end loop;
   end Prepare_Cursors;

   Pipes : GMA.Pipe_Configs;

   procedure Prepare_Configs (Rotation : Rotation_Type; Gen : Rand_P.Generator)
   is
      use type HW.GFX.GMA.Port_Type;

      Offset : Word32 := 0;
      Success : Boolean;
   begin
      GMA.Display_Probing.Scan_Ports (Pipes);

      for Pipe in GMA.Pipe_Index loop
         if Pipes (Pipe).Port /= GMA.Disabled then
            Calc_Framebuffer
              (FB       => Pipes (Pipe).Framebuffer,
               Mode     => Pipes (Pipe).Mode,
               Rotation => Rotation,
               Offset   => Offset);
            GMA.Setup_Default_FB
              (FB       => Pipes (Pipe).Framebuffer,
               Clear    => False,
               Success  => Success);
            if not Success then
               Pipes (Pipe).Port := GMA.Disabled;
            end if;
         end if;
         Prepare_Cursors (Cursors (Pipe), Rotation, Offset);
         Pipes (Pipe).Cursor := Cursors (Pipe) (Cursor_Size'Val (Rand (Gen) mod 3));
      end loop;

      GMA.Dump_Configs (Pipes);
   end Prepare_Configs;

   procedure Script_Cursors
     (Pipes          : in out GMA.Pipe_Configs;
      Hotplug_List   :    out Display_Probing.Port_List;
      Total_Deadline : in     Time.T;
      Time_MS        : in     Natural)
   is
      type Corner is (UL, UR, LR, LL);
      type Cursor_Script_Entry is record
         Rel : Corner;
         X, Y : Int32;
      end record;
      Cursor_Script : constant array (Natural range 0 .. 19) of Cursor_Script_Entry :=
        ((UL,  16,  16), (UL,  16,  16), (UL,  16,  16), (UL, -32,   0), (UL,  16,  16),
         (UR, -16,  16), (UR, -16,  16), (UR, -16,  16), (UR,   0, -32), (UR, -16,  16),
         (LR, -16, -16), (LR, -16, -16), (LR, -16, -16), (LR,  32,   0), (LR, -16, -16),
         (LL,  16, -16), (LL,  16, -16), (LL,  16, -16), (LL,   0,  32), (LL,  16, -16));

      Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
      HP_Deadline : Time.T := Time.MS_From_Now (HP_Delay_MS);
      Timed_Out : Boolean := False;
      Cnt : Word32 := 0;
   begin
      Hotplug_List := (others => Disabled);
      loop
         for Pipe in Pipe_Index loop
            exit when Pipes (Pipe).Port = GMA.Disabled;
            declare
               C : Cursor_Type renames Pipes (Pipe).Cursor;
               FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
               Width : constant Width_Type := FB.Width;
               Height : constant Height_Type := FB.Height;
               CS : Cursor_Script_Entry renames Cursor_Script
                 (Natural (Cnt) mod (Cursor_Script'Last + 1));
            begin
               C.Center_X := CS.X;
               C.Center_Y := CS.Y;
               case CS.Rel is
                  when UL  => null;
                  when UR  => C.Center_X := CS.X + Width;
                  when LR  => C.Center_X := CS.X + Width;
                              C.Center_Y := CS.Y + Height;
                  when LL  => C.Center_Y := CS.Y + Height;
               end case;
               GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
            end;
         end loop;

         Timed_Out := Time.Timed_Out (HP_Deadline);
         if Timed_Out then
            HP_Deadline := Time.MS_From_Now (HP_Delay_MS);
            GMA.Display_Probing.Hotplug_Events (Hotplug_List);
            if Hotplug_List (Hotplug_List'First) /= Disabled then
               return;
            end if;
         end if;

         Timed_Out := Time.Timed_Out (Total_Deadline);
         exit when Timed_Out;
         Timed_Out := Time.Timed_Out (Deadline);
         exit when Timed_Out;
         Time.M_Delay (160);
         Cnt := Cnt + 1;
      end loop;
   end Script_Cursors;

   type Cursor_Info is record
      X_Velo, Y_Velo : Int32;
      X_Acc, Y_Acc : Int32;
      Color : Pipe_Index;
      Size : Cursor_Size;
   end record;
   function Cursor_Rand (Gen : Rand_P.Generator)
      return Int32 is (Rand (Gen) mod 51 - 25);
   Cursor_Infos : array (Pipe_Index) of Cursor_Info;

   procedure Move_Cursors
     (Pipes          : in out GMA.Pipe_Configs;
      Hotplug_List   :    out Display_Probing.Port_List;
      Total_Deadline : in     Time.T;
      Time_MS        : in     Natural;
      Gen            : in     Rand_P.Generator)
   is
      procedure Select_New_Cursor
        (P  : in     Pipe_Index;
         C  : in out Cursor_Type;
         CI : in out Cursor_Info)
      is
         Old_C : constant Cursor_Type := C;
      begin
         -- change either size or color
         if Rand (Gen) mod 2 = 0 then
            CI.Color := Pipe_Index'Val
              ((Pipe_Index'Pos (CI.Color) + 1 + Rand (Gen) mod 2) mod 3);
         else
            CI.Size := Cursor_Size'Val
              ((Cursor_Size'Pos (CI.Size) + 1 + Rand (Gen) mod 2) mod 3);
         end if;

         -- always ensure the cursor fits
         if Cursor_Width (CI.Size) > Pipes (P).Framebuffer.Width or
            Cursor_Width (CI.Size) > Pipes (P).Framebuffer.Height
         then
            CI.Size := Cursor_64x64;
         end if;

         C := Cursors (CI.Color) (CI.Size);
         C.Center_X := Old_C.Center_X;
         C.Center_Y := Old_C.Center_Y;
         GMA.Update_Cursor (P, C);
      end Select_New_Cursor;

      Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
      HP_Deadline : Time.T := Time.MS_From_Now (HP_Delay_MS);
      Timed_Out : Boolean := False;
      Cnt : Word32 := 0;
   begin
      Hotplug_List := (others => Disabled);
      for Pipe in Pipe_Index loop
         exit when Pipes (Pipe).Port = GMA.Disabled;
         Select_New_Cursor (Pipe, Pipes (Pipe).Cursor, Cursor_Infos (Pipe));
      end loop;
      loop
         for Pipe in Pipe_Index loop
            exit when Pipes (Pipe).Port = GMA.Disabled;
            declare
               C : Cursor_Type renames Pipes (Pipe).Cursor;
               CI : Cursor_Info renames Cursor_Infos (Pipe);
               FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
               Width : constant Width_Type := FB.Width;
               Height : constant Height_Type := FB.Height;

               Update : Boolean := False;
            begin
               if Cnt mod 16 = 0 then
                  CI.X_Acc := Cursor_Rand (Gen);
                  CI.Y_Acc := Cursor_Rand (Gen);
               end if;
               CI.X_Velo := CI.X_Velo + CI.X_Acc;
               CI.Y_Velo := CI.Y_Velo + CI.Y_Acc;
               C.Center_X := C.Center_X + CI.X_Velo / 100;
               C.Center_Y := C.Center_Y + CI.Y_Velo / 100;
               if C.Center_X not in 0 .. Width - 1 then
                  C.Center_X := Int32'Max (0, Int32'Min (Width, C.Center_X));
                  CI.X_Velo := -CI.X_Velo;
                  Update := True;
               end if;
               if C.Center_Y not in 0 .. Height - 1 then
                  C.Center_Y := Int32'Max (0, Int32'Min (Height, C.Center_Y));
                  CI.Y_Velo := -CI.Y_Velo;
                  Update := True;
               end if;
               if Update then
                  Select_New_Cursor (Pipe, C, CI);
               else
                  GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
               end if;
            end;
         end loop;

         Timed_Out := Time.Timed_Out (HP_Deadline);
         if Timed_Out then
            HP_Deadline := Time.MS_From_Now (HP_Delay_MS);
            GMA.Display_Probing.Hotplug_Events (Hotplug_List);
            if Hotplug_List (Hotplug_List'First) /= Disabled then
               return;
            end if;
         end if;

         Timed_Out := Time.Timed_Out (Total_Deadline);
         exit when Timed_Out;
         Timed_Out := Time.Timed_Out (Deadline);
         exit when Timed_Out;
         Time.M_Delay (16);   -- ~60 fps
         Cnt := Cnt + 1;
      end loop;
   end Move_Cursors;

   procedure Run_The_Show
     (Deadline : Time.T;
      Gen      : Rand_P.Generator;
      Rotation : Rotation_Type)
   is
      Timed_Out : Boolean;
      Hotplug_List : GMA.Display_Probing.Port_List;

      New_Pipes : GMA.Pipe_Configs := Pipes;

      function Rand_Div (Num : Position_Type) return Position_Type is
        (case Rand (Gen) mod 4 is
            when 3 => Rand (Gen) mod Num / 3,
            when 2 => Rand (Gen) mod Num / 2,
            when 1 => Rand (Gen) mod Num,
            when others => 0);
   begin
      for Pipe in GMA.Pipe_Index loop
         if Pipes (Pipe).Port /= GMA.Disabled then
            Test_Screen
              (Framebuffer => Pipes (Pipe).Framebuffer,
               Pipe        => Pipe);
         end if;
         for Size in Cursor_Size loop
            Draw_Cursor (Pipe, Rotation, Cursors (Pipe) (Size));
         end loop;
      end loop;

      Cursor_Infos :=
        (others =>
           (Color    => Pipe_Index'Val (Rand (Gen) mod 3),
            Size     => Cursor_Size'Val (Rand (Gen) mod 3),
            others   => Cursor_Rand (Gen)));

      Script_Cursors (Pipes, Hotplug_List, Deadline, Primary_Delay_MS);
      if Hotplug_List (Hotplug_List'First) /= Disabled then
         return;
      end if;
      Timed_Out := Time.Timed_Out (Deadline);
      if Timed_Out then
         return;
      end if;

      Rand_P.Reset (Gen, Seed);
      loop
         GMA.Display_Probing.Hotplug_Events (Hotplug_List);
         if Hotplug_List (Hotplug_List'First) /= Disabled then
            return;
         end if;
         New_Pipes := Pipes;
         for Pipe in GMA.Pipe_Index loop
            exit when Pipes (Pipe).Port = Disabled;
            declare
               New_FB : Framebuffer_Type renames
                  New_Pipes (Pipe).Framebuffer;
               Cursor : Cursor_Type renames New_Pipes (Pipe).Cursor;
               CI : Cursor_Info renames Cursor_Infos (Pipe);
               Width : constant Width_Type :=
                  Pipes (Pipe).Framebuffer.Width;
               Height : constant Height_Type :=
                  Pipes (Pipe).Framebuffer.Height;
            begin
               New_FB.Start_X := Position_Type'Min
                 (Width - 64, Rand_Div (Width));
               New_FB.Start_Y := Position_Type'Min
                 (Height - 64, Rand_Div (Height));
               New_FB.Width := Width_Type'Max
                 (64, Width - New_FB.Start_X - Rand_Div (Width));
               New_FB.Height := Height_Type'Max
                 (64, Height - New_FB.Start_Y - Rand_Div (Height));

               Cursor.Mode := No_Cursor;
               Cursor.Center_X := New_FB.Width / 2;
               Cursor.Center_Y := New_FB.Height / 2;
               CI.X_Velo := 6 * Cursor_Rand (Gen) / (Width / New_FB.Width);
               CI.Y_Velo := 6 * Cursor_Rand (Gen) / (Height / New_FB.Height);
            end;
         end loop;
         GMA.Dump_Configs (New_Pipes);
         GMA.Update_Outputs (New_Pipes);
         Move_Cursors
           (New_Pipes, Hotplug_List, Deadline, Secondary_Delay_MS, Gen);
         exit when Hotplug_List (Hotplug_List'First) /= Disabled;

         Timed_Out := Time.Timed_Out (Deadline);
         exit when Timed_Out;
      end loop;
   end Run_The_Show;

   procedure Print_Usage
   is
   begin
      Debug.Put ("Usage: ");
      Debug.Put (Ada.Command_Line.Command_Name);
      Debug.Put_Line (" <delay seconds> [(0|90|180|270)]");
      Debug.New_Line;
   end Print_Usage;

   procedure Main
   is
      use type HW.GFX.GMA.Port_Type;
      use type HW.Word64;
      use type Interfaces.C.int;

      Res_Addr : Word64;

      Delay_MS : Natural;
      Rotation : Rotation_Type := No_Rotation;

      Dev_Init,
      Initialized : Boolean;

      Gen : Rand_P.Generator;

      Deadline : Time.T;
      Timed_Out : Boolean;
      Hotplug_List : GMA.Display_Probing.Port_List;

      function iopl (level : Interfaces.C.int) return Interfaces.C.int;
      pragma Import (C, iopl, "iopl");
   begin
      if Ada.Command_Line.Argument_Count < 1 then
         Print_Usage;
         return;
      end if;

      Delay_MS := Natural'Value (Ada.Command_Line.Argument (1)) * 1_000;

      if Ada.Command_Line.Argument_Count >= 2 then
         declare
            Rotation_Degree : constant String := Ada.Command_Line.Argument (2);
         begin
            if    Rotation_Degree =   "0" then Rotation := No_Rotation;
            elsif Rotation_Degree =  "90" then Rotation := Rotated_90;
            elsif Rotation_Degree = "180" then Rotation := Rotated_180;
            elsif Rotation_Degree = "270" then Rotation := Rotated_270;
            else  Print_Usage; return; end if;
         end;
      end if;

      if iopl (3) /= 0 then
         Debug.Put_Line ("Failed to change i/o privilege level.");
         return;
      end if;

      Dev.Initialize (Dev_Init);
      if not Dev_Init then
         Debug.Put_Line ("Failed to map PCI config.");
         return;
      end if;

      Dev.Map (Res_Addr, PCI.Res2, WC => True);
      if Res_Addr = 0 then
         Debug.Put_Line ("Failed to map PCI resource2.");
         return;
      end if;
      Screen.Set_Base_Address (Res_Addr);

      GMA.Initialize
        (Clean_State => True,
         Success     => Initialized);

      if Initialized then
         Backup_GTT;

         Deadline := Time.MS_From_Now (Delay_MS);
         loop
            Prepare_Configs (Rotation, Gen);

            GMA.Update_Outputs (Pipes);

            if not (for all P in Pipe_Index => Pipes (P).Port = Disabled) then
               for Pipe in GMA.Pipe_Index loop
                  if Pipes (Pipe).Port /= GMA.Disabled then
                     Backup_Screen (Pipes (Pipe).Framebuffer);
                  end if;
               end loop;

               Run_The_Show (Deadline, Gen, Rotation);

               for Pipe in GMA.Pipe_Index loop
                  if Pipes (Pipe).Port /= GMA.Disabled then
                     Restore_Screen (Pipes (Pipe).Framebuffer);
                  end if;
               end loop;
            else
               loop
                  Time.M_Delay (HP_Delay_MS);
                  GMA.Display_Probing.Hotplug_Events (Hotplug_List);
                  exit when Hotplug_List (Hotplug_List'First) /= Disabled;

                  Timed_Out := Time.Timed_Out (Deadline);
                  exit when Timed_Out;
               end loop;
            end if;

            Timed_Out := Time.Timed_Out (Deadline);
            exit when Timed_Out;
         end loop;

         Restore_GTT;
      end if;
   end Main;

end HW.GFX.GMA.GFX_Test;