747 lines
25 KiB
Ada
747 lines
25 KiB
Ada
|
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;
|
||
|
|
with HW.GFX.GMA.Config;
|
||
|
|
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;
|
||
|
|
|
||
|
|
procedure Backup_GTT
|
||
|
|
is
|
||
|
|
begin
|
||
|
|
for Idx in GTT_Range loop
|
||
|
|
Read_GTT (GTT_Backup (Idx).Addr, GTT_Backup (Idx).Valid, Idx);
|
||
|
|
end loop;
|
||
|
|
end Backup_GTT;
|
||
|
|
|
||
|
|
procedure Restore_GTT
|
||
|
|
is
|
||
|
|
begin
|
||
|
|
for Idx in GTT_Range 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; Cursor : Cursor_Type)
|
||
|
|
is
|
||
|
|
use type HW.Byte;
|
||
|
|
Width : constant Width_Type := Cursor_Width (Cursor.Size);
|
||
|
|
Screen_Offset : Natural :=
|
||
|
|
Natural (Shift_Left (Word32 (Cursor.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;
|
||
|
|
Offset : in out Word32)
|
||
|
|
is
|
||
|
|
GMA_Phys_Base : constant PCI.Index := 16#5c#;
|
||
|
|
GMA_Phys_Base_Mask : constant := 16#fff0_0000#;
|
||
|
|
|
||
|
|
Phys_Base : Word32;
|
||
|
|
Success : Boolean;
|
||
|
|
begin
|
||
|
|
Dev.Read32 (Phys_Base, GMA_Phys_Base);
|
||
|
|
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);
|
||
|
|
GTT_End : constant Word32 := Offset + Word32 (Width * Width) * 4;
|
||
|
|
begin
|
||
|
|
Cursors (Size) :=
|
||
|
|
(Mode => ARGB_Cursor,
|
||
|
|
Size => Size,
|
||
|
|
Center_X => Width,
|
||
|
|
Center_Y => Width,
|
||
|
|
GTT_Offset => GTT_Range (Shift_Right (Offset, 12)));
|
||
|
|
while Offset < GTT_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;
|
||
|
|
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), 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 := Rotated_Width (FB);
|
||
|
|
Height : constant Height_Type := Rotated_Height (FB);
|
||
|
|
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;
|
||
|
|
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 := Rotated_Width (FB);
|
||
|
|
Height : constant Height_Type := Rotated_Height (FB);
|
||
|
|
|
||
|
|
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)
|
||
|
|
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, 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),
|
||
|
|
X_Velo => 3 * Cursor_Rand (Gen),
|
||
|
|
Y_Velo => 3 * Cursor_Rand (Gen),
|
||
|
|
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;
|
||
|
|
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 - 320, Rand_Div (Width));
|
||
|
|
New_FB.Start_Y := Position_Type'Min
|
||
|
|
(Height - 320, Rand_Div (Height));
|
||
|
|
New_FB.Width := Width_Type'Max
|
||
|
|
(320, Width - New_FB.Start_X - Rand_Div (Width));
|
||
|
|
New_FB.Height := Height_Type'Max
|
||
|
|
(320, Height - New_FB.Start_Y - Rand_Div (Height));
|
||
|
|
|
||
|
|
Cursor.Center_X := Rotated_Width (New_FB) / 2;
|
||
|
|
Cursor.Center_Y := Rotated_Height (New_FB) / 2;
|
||
|
|
GMA.Update_Cursor (Pipe, Cursor);
|
||
|
|
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_Line
|
||
|
|
("Usage: " & Ada.Command_Line.Command_Name &
|
||
|
|
" <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);
|
||
|
|
|
||
|
|
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;
|