blob: fc1868f59c65803e4b5adc82fd9fef86a38281c2 [file] [log] [blame]
Nico Hubera455f0e2018-01-07 11:40:40 +01001with Ada.Numerics.Discrete_Random;
Nico Huberfda2d6e2017-07-09 16:47:52 +02002with Ada.Unchecked_Conversion;
Nico Huber1d0abe42017-03-05 14:14:09 +01003with Ada.Command_Line;
4with Interfaces.C;
5
Nico Huber3b654a02017-07-15 22:27:14 +02006with HW.Time;
Nico Huber1d0abe42017-03-05 14:14:09 +01007with HW.Debug;
Nico Huberfda2d6e2017-07-09 16:47:52 +02008with HW.PCI.Dev;
9with HW.MMIO_Range;
Nico Huber1d0abe42017-03-05 14:14:09 +010010with HW.GFX.GMA;
Nico Huber3b654a02017-07-15 22:27:14 +020011with HW.GFX.GMA.Config;
Nico Huber1d0abe42017-03-05 14:14:09 +010012with HW.GFX.GMA.Display_Probing;
13
Nico Huberfda2d6e2017-07-09 16:47:52 +020014package body HW.GFX.GMA.GFX_Test
15is
16 pragma Disable_Atomic_Synchronization;
Nico Huber1d0abe42017-03-05 14:14:09 +010017
Nico Hubera455f0e2018-01-07 11:40:40 +010018 Primary_Delay_MS : constant := 8_000;
19 Secondary_Delay_MS : constant := 4_000;
20 Seed : constant := 12345;
21
Nico Hubera63e8332018-02-01 16:41:30 +010022 package Rand_P is new Ada.Numerics.Discrete_Random (Natural);
Nico Huberd8282b62018-06-18 00:44:55 +020023 function Rand (Gen : Rand_P.Generator)
24 return Int32 is (Int32 (Rand_P.Random (Gen)));
Nico Hubera455f0e2018-01-07 11:40:40 +010025
Nico Huber5ef4d602017-12-13 13:56:47 +010026 Start_X : constant := 0;
27 Start_Y : constant := 0;
28
Nico Huberfda2d6e2017-07-09 16:47:52 +020029 package Dev is new PCI.Dev (PCI.Address'(0, 2, 0));
Nico Huber1d0abe42017-03-05 14:14:09 +010030
Nico Huberc76749d2018-06-09 22:04:55 +020031 type GTT_Entry is record
32 Addr : GTT_Address_Type;
33 Valid : Boolean;
34 end record;
35 GTT_Backup : array (GTT_Range) of GTT_Entry;
Nico Huber3b654a02017-07-15 22:27:14 +020036
37 procedure Backup_GTT
38 is
39 begin
40 for Idx in GTT_Range loop
Nico Huberc76749d2018-06-09 22:04:55 +020041 Read_GTT (GTT_Backup (Idx).Addr, GTT_Backup (Idx).Valid, Idx);
Nico Huber3b654a02017-07-15 22:27:14 +020042 end loop;
43 end Backup_GTT;
44
45 procedure Restore_GTT
46 is
47 begin
48 for Idx in GTT_Range loop
Nico Huberc76749d2018-06-09 22:04:55 +020049 Write_GTT (Idx, GTT_Backup (Idx).Addr, GTT_Backup (Idx).Valid);
Nico Huber3b654a02017-07-15 22:27:14 +020050 end loop;
51 end Restore_GTT;
52
Nico Huber1d0abe42017-03-05 14:14:09 +010053 type Pixel_Type is record
54 Red : Byte;
55 Green : Byte;
56 Blue : Byte;
57 Alpha : Byte;
58 end record;
59
60 for Pixel_Type use record
61 Blue at 0 range 0 .. 7;
62 Green at 1 range 0 .. 7;
63 Red at 2 range 0 .. 7;
64 Alpha at 3 range 0 .. 7;
65 end record;
66
Nico Huber244ea7e2017-08-28 11:38:23 +020067 White : constant Pixel_Type := (255, 255, 255, 255);
68 Black : constant Pixel_Type := ( 0, 0, 0, 255);
69 Red : constant Pixel_Type := (255, 0, 0, 255);
70 Green : constant Pixel_Type := ( 0, 255, 0, 255);
71 Blue : constant Pixel_Type := ( 0, 0, 255, 255);
72
Nico Huberfda2d6e2017-07-09 16:47:52 +020073 function Pixel_To_Word (P : Pixel_Type) return Word32
74 with
75 SPARK_Mode => Off
76 is
77 function To_Word is new Ada.Unchecked_Conversion (Pixel_Type, Word32);
78 begin
79 return To_Word (P);
80 end Pixel_To_Word;
81
Nico Huber7bb10c62018-01-12 14:07:44 +010082 Max_W : constant := 4096;
83 Max_H : constant := 2160;
84 FB_Align : constant := 16#0004_0000#;
85 Cursor_Align : constant := 16#0001_0000#;
86 Max_Cursor_Wid : constant := 256;
87 subtype Screen_Index is Natural range 0 .. 3 *
88 (Max_W * Max_H + FB_Align / 4 +
89 3 * Max_Cursor_Wid * Max_Cursor_Wid + Cursor_Align / 4)
90 - 1;
Nico Huberfda2d6e2017-07-09 16:47:52 +020091 type Screen_Type is array (Screen_Index) of Word32;
Nico Huber1d0abe42017-03-05 14:14:09 +010092
Nico Huber34be6542017-12-13 09:26:24 +010093 function Screen_Offset (FB : Framebuffer_Type) return Natural is
94 (Natural (Phys_Offset (FB) / 4));
95
Nico Huberfda2d6e2017-07-09 16:47:52 +020096 package Screen is new MMIO_Range (0, Word32, Screen_Index, Screen_Type);
Nico Huber1d0abe42017-03-05 14:14:09 +010097
Nico Huber3b654a02017-07-15 22:27:14 +020098 Screen_Backup : Screen_Type;
99
100 procedure Backup_Screen (FB : Framebuffer_Type)
101 is
Nico Huber34be6542017-12-13 09:26:24 +0100102 First : constant Screen_Index := Screen_Offset (FB);
Nico Huber3b654a02017-07-15 22:27:14 +0200103 Last : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
104 begin
105 for Idx in Screen_Index range First .. Last loop
106 Screen.Read (Screen_Backup (Idx), Idx);
107 end loop;
108 end Backup_Screen;
109
110 procedure Restore_Screen (FB : Framebuffer_Type)
111 is
Nico Huber34be6542017-12-13 09:26:24 +0100112 First : constant Screen_Index := Screen_Offset (FB);
Nico Huber3b654a02017-07-15 22:27:14 +0200113 Last : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
114 begin
115 for Idx in Screen_Index range First .. Last loop
116 Screen.Write (Idx, Screen_Backup (Idx));
117 end loop;
118 end Restore_Screen;
Nico Huber1d0abe42017-03-05 14:14:09 +0100119
Nico Huber5ef4d602017-12-13 13:56:47 +0100120 function Drawing_Width (FB : Framebuffer_Type) return Natural is
121 (Natural (FB.Width + 2 * Start_X));
122
123 function Drawing_Height (FB : Framebuffer_Type) return Natural is
124 (Natural (FB.Height + 2 * Start_Y));
125
Nico Huber244ea7e2017-08-28 11:38:23 +0200126 function Corner_Fill
127 (X, Y : Natural;
128 FB : Framebuffer_Type;
129 Pipe : Pipe_Index)
130 return Pixel_Type
131 is
132 Xrel : constant Integer :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100133 (if X < 32 then X else X - (Drawing_Width (FB) - 32));
Nico Huber244ea7e2017-08-28 11:38:23 +0200134 Yrel : constant Integer :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100135 (if Y < 32 then Y else Y - (Drawing_Height (FB) - 32));
Nico Huber244ea7e2017-08-28 11:38:23 +0200136
137 function Color (Idx : Natural) return Pixel_Type is
138 (case (Idx + Pipe_Index'Pos (Pipe)) mod 4 is
139 when 0 => Blue, when 1 => Black,
140 when 3 => Green, when others => Red);
141 begin
142 return
143 (if Xrel mod 16 = 0 or Xrel = 31 or Yrel mod 16 = 0 or Yrel = 31 then
144 White
145 elsif Yrel < 16 then
146 (if Xrel < 16 then Color (0) else Color (1))
147 else
148 (if Xrel < 16 then Color (3) else Color (2)));
149 end Corner_Fill;
150
Nico Huber1d0abe42017-03-05 14:14:09 +0100151 function Fill
152 (X, Y : Natural;
153 Framebuffer : Framebuffer_Type;
Nico Huber244ea7e2017-08-28 11:38:23 +0200154 Pipe : Pipe_Index)
Nico Huber1d0abe42017-03-05 14:14:09 +0100155 return Pixel_Type
156 is
157 use type HW.Byte;
158
Nico Huber5ef4d602017-12-13 13:56:47 +0100159 Xp : constant Natural := X * 256 / Drawing_Width (Framebuffer);
160 Yp : constant Natural := Y * 256 / Drawing_Height (Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100161 Xn : constant Natural := 255 - Xp;
162 Yn : constant Natural := 255 - Yp;
163
164 function Map (X, Y : Natural) return Byte is
165 begin
166 return Byte (X * Y / 255);
167 end Map;
168 begin
169 return
170 (case Pipe is
171 when GMA.Primary => (Map (Xn, Yn), Map (Xp, Yn), Map (Xp, Yp), 255),
172 when GMA.Secondary => (Map (Xn, Yp), Map (Xn, Yn), Map (Xp, Yn), 255),
173 when GMA.Tertiary => (Map (Xp, Yp), Map (Xn, Yp), Map (Xn, Yn), 255));
174 end Fill;
175
176 procedure Test_Screen
177 (Framebuffer : Framebuffer_Type;
178 Pipe : GMA.Pipe_Index)
179 is
Nico Huber1d0abe42017-03-05 14:14:09 +0100180 P : Pixel_Type;
181 -- We have pixel offset wheras the framebuffer has a byte offset
Nico Huber34be6542017-12-13 09:26:24 +0100182 Offset_Y : Natural := Screen_Offset (Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100183 Offset : Natural;
Nico Huber9ca69f12017-08-28 14:31:46 +0200184
185 function Top_Test (X, Y : Natural) return Boolean
186 is
Nico Huber5ef4d602017-12-13 13:56:47 +0100187 C : constant Natural := Drawing_Width (Framebuffer) / 2;
188 S_Y : constant Natural := 3 * (Y - Start_Y) / 2;
Nico Huber9ca69f12017-08-28 14:31:46 +0200189 Left : constant Integer := X - C + S_Y;
190 Right : constant Integer := X - C - S_Y;
191 begin
192 return
Nico Huber5ef4d602017-12-13 13:56:47 +0100193 (Y - Start_Y) < 12 and
Nico Huber9ca69f12017-08-28 14:31:46 +0200194 ((-1 <= Left and Left <= 0) or
195 (0 <= Right and Right <= 1));
196 end Top_Test;
Nico Huber1d0abe42017-03-05 14:14:09 +0100197 begin
Nico Huber5ef4d602017-12-13 13:56:47 +0100198 for Y in 0 .. Drawing_Height (Framebuffer) - 1 loop
Nico Huber1d0abe42017-03-05 14:14:09 +0100199 Offset := Offset_Y;
Nico Huber5ef4d602017-12-13 13:56:47 +0100200 for X in 0 .. Drawing_Width (Framebuffer) - 1 loop
201 if (X < 32 or X >= Drawing_Width (Framebuffer) - 32) and
202 (Y < 32 or Y >= Drawing_Height (Framebuffer) - 32)
Nico Huber244ea7e2017-08-28 11:38:23 +0200203 then
204 P := Corner_Fill (X, Y, Framebuffer, Pipe);
Nico Huber9ca69f12017-08-28 14:31:46 +0200205 elsif Framebuffer.Rotation /= No_Rotation and then
206 Top_Test (X, Y)
207 then
208 P := White;
Nico Huber244ea7e2017-08-28 11:38:23 +0200209 elsif Y mod 16 = 0 or X mod 16 = 0 then
210 P := Black;
Nico Huber1d0abe42017-03-05 14:14:09 +0100211 else
212 P := Fill (X, Y, Framebuffer, Pipe);
213 end if;
Nico Huberfda2d6e2017-07-09 16:47:52 +0200214 Screen.Write (Offset, Pixel_To_Word (P));
Nico Huber1d0abe42017-03-05 14:14:09 +0100215 Offset := Offset + 1;
216 end loop;
217 Offset_Y := Offset_Y + Natural (Framebuffer.Stride);
218 end loop;
219 end Test_Screen;
220
Nico Huber7bb10c62018-01-12 14:07:44 +0100221 function Donut (X, Y, Max : Cursor_Pos) return Byte
222 is
223 ZZ : constant Int32 := Max * Max * 2;
224 Dist_Center : constant Int32 := ((X * X + Y * Y) * 255) / ZZ;
225 Dist_Circle : constant Int32 := Dist_Center - 20;
226 begin
227 return Byte (255 - Int32'Min (255, 6 * abs Dist_Circle + 64));
228 end Donut;
229
230 procedure Draw_Cursor (Pipe : Pipe_Index; Cursor : Cursor_Type)
231 is
232 use type HW.Byte;
233 Width : constant Width_Type := Cursor_Width (Cursor.Size);
234 Screen_Offset : Natural :=
235 Natural (Shift_Left (Word32 (Cursor.GTT_Offset), 12) / 4);
236 begin
237 if Cursor.Mode /= ARGB_Cursor then
238 return;
239 end if;
240 for Y in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
241 for X in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
242 declare
243 D : constant Byte := Donut (X, Y, Width / 2);
244 begin
245 -- Hardware seems to expect pre-multiplied alpha (i.e.
246 -- color components already contain the alpha).
247 Screen.Write
248 (Index => Screen_Offset,
249 Value => Pixel_To_Word (
250 (Red => (if Pipe = Secondary then D / 2 else 0),
251 Green => (if Pipe = Tertiary then D / 2 else 0),
252 Blue => (if Pipe = Primary then D / 2 else 0),
253 Alpha => D)));
254 Screen_Offset := Screen_Offset + 1;
255 end;
256 end loop;
257 end loop;
258 end Draw_Cursor;
259
Nico Huber1d0abe42017-03-05 14:14:09 +0100260 procedure Calc_Framebuffer
261 (FB : out Framebuffer_Type;
262 Mode : in Mode_Type;
Nico Huber88f3c982017-08-28 13:31:38 +0200263 Rotation : in Rotation_Type;
Nico Huber1d0abe42017-03-05 14:14:09 +0100264 Offset : in out Word32)
265 is
Nico Huberc5c767a2018-06-03 01:09:04 +0200266 Width : constant Width_Type := Mode.H_Visible;
267 Height : constant Height_Type := Mode.V_Visible;
Nico Huber1d0abe42017-03-05 14:14:09 +0100268 begin
269 Offset := (Offset + FB_Align - 1) and not (FB_Align - 1);
Nico Huber88f3c982017-08-28 13:31:38 +0200270 if Rotation = Rotated_90 or Rotation = Rotated_270 then
271 FB :=
Nico Huberc5c767a2018-06-03 01:09:04 +0200272 (Width => Height,
273 Height => Width,
Nico Huber5ef4d602017-12-13 13:56:47 +0100274 Start_X => Start_X,
275 Start_Y => Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200276 BPC => 8,
Nico Huberc5c767a2018-06-03 01:09:04 +0200277 Stride => Div_Round_Up (Height + 2 * Start_X, 32) * 32,
278 V_Stride => Div_Round_Up (Width + 2 * Start_Y, 32) * 32,
Nico Huber88f3c982017-08-28 13:31:38 +0200279 Tiling => Y_Tiled,
280 Rotation => Rotation,
Nico Huber34be6542017-12-13 09:26:24 +0100281 Offset => Offset + Word32 (GTT_Rotation_Offset) * GTT_Page_Size);
Nico Huber88f3c982017-08-28 13:31:38 +0200282 else
283 FB :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100284 (Width => Width,
285 Height => Height,
286 Start_X => Start_X,
287 Start_Y => Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200288 BPC => 8,
Nico Huber5ef4d602017-12-13 13:56:47 +0100289 Stride => Div_Round_Up (Width + 2 * Start_X, 16) * 16,
290 V_Stride => Height + 2 * Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200291 Tiling => Linear,
292 Rotation => Rotation,
293 Offset => Offset);
294 end if;
Nico Huberb7470492017-11-30 14:48:35 +0100295 Offset := Offset + Word32 (FB_Size (FB));
Nico Huber1d0abe42017-03-05 14:14:09 +0100296 end Calc_Framebuffer;
297
Nico Huber7bb10c62018-01-12 14:07:44 +0100298 type Cursor_Array is array (Cursor_Size) of Cursor_Type;
299 Cursors : array (Pipe_Index) of Cursor_Array;
300
301 procedure Prepare_Cursors
302 (Cursors : out Cursor_Array;
303 Offset : in out Word32)
304 is
305 GMA_Phys_Base : constant PCI.Index := 16#5c#;
306 GMA_Phys_Base_Mask : constant := 16#fff0_0000#;
307
308 Phys_Base : Word32;
309 Success : Boolean;
310 begin
311 Dev.Read32 (Phys_Base, GMA_Phys_Base);
312 Phys_Base := Phys_Base and GMA_Phys_Base_Mask;
313 Success := Phys_Base /= GMA_Phys_Base_Mask and Phys_Base /= 0;
314 if not Success then
315 Debug.Put_Line ("Failed to read stolen memory base.");
316 return;
317 end if;
318
319 for Size in Cursor_Size loop
320 Offset := (Offset + Cursor_Align - 1) and not (Cursor_Align - 1);
321 declare
322 Width : constant Width_Type := Cursor_Width (Size);
323 GTT_End : constant Word32 := Offset + Word32 (Width * Width) * 4;
324 begin
325 Cursors (Size) :=
326 (Mode => ARGB_Cursor,
327 Size => Size,
328 Center_X => Width,
329 Center_Y => Width,
330 GTT_Offset => GTT_Range (Shift_Right (Offset, 12)));
331 while Offset < GTT_End loop
332 GMA.Write_GTT
333 (GTT_Page => GTT_Range (Offset / GTT_Page_Size),
334 Device_Address => GTT_Address_Type (Phys_Base + Offset),
335 Valid => True);
336 Offset := Offset + GTT_Page_Size;
337 end loop;
338 end;
339 end loop;
340 end Prepare_Cursors;
341
Nico Huber3b654a02017-07-15 22:27:14 +0200342 Pipes : GMA.Pipe_Configs;
343
Nico Huberd8282b62018-06-18 00:44:55 +0200344 procedure Prepare_Configs (Rotation : Rotation_Type; Gen : Rand_P.Generator)
Nico Huber1d0abe42017-03-05 14:14:09 +0100345 is
346 use type HW.GFX.GMA.Port_Type;
347
Nico Huberfda2d6e2017-07-09 16:47:52 +0200348 Offset : Word32 := 0;
Nico Huber3b654a02017-07-15 22:27:14 +0200349 Success : Boolean;
Nico Huber1d0abe42017-03-05 14:14:09 +0100350 begin
351 GMA.Display_Probing.Scan_Ports (Pipes);
352
353 for Pipe in GMA.Pipe_Index loop
354 if Pipes (Pipe).Port /= GMA.Disabled then
355 Calc_Framebuffer
356 (FB => Pipes (Pipe).Framebuffer,
357 Mode => Pipes (Pipe).Mode,
Nico Huber88f3c982017-08-28 13:31:38 +0200358 Rotation => Rotation,
Nico Huber1d0abe42017-03-05 14:14:09 +0100359 Offset => Offset);
Nico Huber3b654a02017-07-15 22:27:14 +0200360 GMA.Setup_Default_FB
361 (FB => Pipes (Pipe).Framebuffer,
362 Clear => False,
363 Success => Success);
364 if not Success then
365 Pipes (Pipe).Port := GMA.Disabled;
366 end if;
Nico Huber1d0abe42017-03-05 14:14:09 +0100367 end if;
Nico Huber7bb10c62018-01-12 14:07:44 +0100368 Prepare_Cursors (Cursors (Pipe), Offset);
Nico Huberd8282b62018-06-18 00:44:55 +0200369 Pipes (Pipe).Cursor := Cursors (Pipe) (Cursor_Size'Val (Rand (Gen) mod 3));
Nico Huber1d0abe42017-03-05 14:14:09 +0100370 end loop;
371
372 GMA.Dump_Configs (Pipes);
373 end Prepare_Configs;
374
Nico Hubera63e8332018-02-01 16:41:30 +0100375 procedure Script_Cursors
376 (Pipes : in out GMA.Pipe_Configs;
377 Time_MS : in Natural)
378 is
379 type Corner is (UL, UR, LR, LL);
380 type Cursor_Script_Entry is record
381 Rel : Corner;
382 X, Y : Int32;
383 end record;
384 Cursor_Script : constant array (Natural range 0 .. 19) of Cursor_Script_Entry :=
385 ((UL, 16, 16), (UL, 16, 16), (UL, 16, 16), (UL, -32, 0), (UL, 16, 16),
386 (UR, -16, 16), (UR, -16, 16), (UR, -16, 16), (UR, 0, -32), (UR, -16, 16),
387 (LR, -16, -16), (LR, -16, -16), (LR, -16, -16), (LR, 32, 0), (LR, -16, -16),
388 (LL, 16, -16), (LL, 16, -16), (LL, 16, -16), (LL, 0, 32), (LL, 16, -16));
389
390 Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
391 Timed_Out : Boolean := False;
392 Cnt : Word32 := 0;
393 begin
394 loop
395 for Pipe in Pipe_Index loop
396 exit when Pipes (Pipe).Port = GMA.Disabled;
397 declare
398 C : Cursor_Type renames Pipes (Pipe).Cursor;
399 FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
Nico Huberc5c767a2018-06-03 01:09:04 +0200400 Width : constant Width_Type := Rotated_Width (FB);
401 Height : constant Height_Type := Rotated_Height (FB);
Nico Hubera63e8332018-02-01 16:41:30 +0100402 CS : Cursor_Script_Entry renames Cursor_Script
403 (Natural (Cnt) mod (Cursor_Script'Last + 1));
404 begin
405 C.Center_X := CS.X;
406 C.Center_Y := CS.Y;
407 case CS.Rel is
408 when UL => null;
409 when UR => C.Center_X := CS.X + Width;
410 when LR => C.Center_X := CS.X + Width;
411 C.Center_Y := CS.Y + Height;
412 when LL => C.Center_Y := CS.Y + Height;
413 end case;
414 GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
415 end;
416 end loop;
417 Timed_Out := Time.Timed_Out (Deadline);
418 exit when Timed_Out;
419 Time.M_Delay (160);
420 Cnt := Cnt + 1;
421 end loop;
422 end Script_Cursors;
423
424 type Cursor_Info is record
425 X_Velo, Y_Velo : Int32;
426 X_Acc, Y_Acc : Int32;
427 Color : Pipe_Index;
428 Size : Cursor_Size;
429 end record;
Nico Huberd8282b62018-06-18 00:44:55 +0200430 function Cursor_Rand (Gen : Rand_P.Generator)
431 return Int32 is (Rand (Gen) mod 51 - 25);
432 Cursor_Infos : array (Pipe_Index) of Cursor_Info;
Nico Hubera63e8332018-02-01 16:41:30 +0100433
434 procedure Move_Cursors
435 (Pipes : in out GMA.Pipe_Configs;
Nico Huberd8282b62018-06-18 00:44:55 +0200436 Time_MS : in Natural;
437 Gen : in Rand_P.Generator)
Nico Hubera63e8332018-02-01 16:41:30 +0100438 is
439 procedure Select_New_Cursor
440 (P : in Pipe_Index;
441 C : in out Cursor_Type;
442 CI : in out Cursor_Info)
443 is
444 Old_C : constant Cursor_Type := C;
445 begin
446 -- change either size or color
Nico Huberd8282b62018-06-18 00:44:55 +0200447 if Rand (Gen) mod 2 = 0 then
Nico Hubera63e8332018-02-01 16:41:30 +0100448 CI.Color := Pipe_Index'Val
Nico Huberd8282b62018-06-18 00:44:55 +0200449 ((Pipe_Index'Pos (CI.Color) + 1 + Rand (Gen) mod 2) mod 3);
Nico Hubera63e8332018-02-01 16:41:30 +0100450 else
451 CI.Size := Cursor_Size'Val
Nico Huberd8282b62018-06-18 00:44:55 +0200452 ((Cursor_Size'Pos (CI.Size) + 1 + Rand (Gen) mod 2) mod 3);
Nico Hubera63e8332018-02-01 16:41:30 +0100453 end if;
454 C := Cursors (CI.Color) (CI.Size);
455 C.Center_X := Old_C.Center_X;
456 C.Center_Y := Old_C.Center_Y;
457 GMA.Update_Cursor (P, C);
458 end Select_New_Cursor;
459
460 Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
461 Timed_Out : Boolean := False;
462 Cnt : Word32 := 0;
463 begin
464 for Pipe in Pipe_Index loop
465 exit when Pipes (Pipe).Port = GMA.Disabled;
466 Select_New_Cursor (Pipe, Pipes (Pipe).Cursor, Cursor_Infos (Pipe));
467 end loop;
468 loop
469 for Pipe in Pipe_Index loop
470 exit when Pipes (Pipe).Port = GMA.Disabled;
471 declare
472 C : Cursor_Type renames Pipes (Pipe).Cursor;
473 CI : Cursor_Info renames Cursor_Infos (Pipe);
474 FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
Nico Huberc5c767a2018-06-03 01:09:04 +0200475 Width : constant Width_Type := Rotated_Width (FB);
476 Height : constant Height_Type := Rotated_Height (FB);
Nico Hubera63e8332018-02-01 16:41:30 +0100477
478 Update : Boolean := False;
479 begin
480 if Cnt mod 16 = 0 then
Nico Huberd8282b62018-06-18 00:44:55 +0200481 CI.X_Acc := Cursor_Rand (Gen);
482 CI.Y_Acc := Cursor_Rand (Gen);
Nico Hubera63e8332018-02-01 16:41:30 +0100483 end if;
484 CI.X_Velo := CI.X_Velo + CI.X_Acc;
485 CI.Y_Velo := CI.Y_Velo + CI.Y_Acc;
486 C.Center_X := C.Center_X + CI.X_Velo / 100;
487 C.Center_Y := C.Center_Y + CI.Y_Velo / 100;
488 if C.Center_X not in 0 .. Width - 1 then
489 C.Center_X := Int32'Max (0, Int32'Min (Width, C.Center_X));
490 CI.X_Velo := -CI.X_Velo;
491 Update := True;
492 end if;
493 if C.Center_Y not in 0 .. Height - 1 then
494 C.Center_Y := Int32'Max (0, Int32'Min (Height, C.Center_Y));
495 CI.Y_Velo := -CI.Y_Velo;
496 Update := True;
497 end if;
498 if Update then
499 Select_New_Cursor (Pipe, C, CI);
500 else
501 GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
502 end if;
503 end;
504 end loop;
505 Timed_Out := Time.Timed_Out (Deadline);
506 exit when Timed_Out;
507 Time.M_Delay (16); -- ~60 fps
508 Cnt := Cnt + 1;
509 end loop;
510 end Move_Cursors;
511
Nico Huber3b654a02017-07-15 22:27:14 +0200512 procedure Print_Usage
513 is
514 begin
515 Debug.Put_Line
Nico Huber88f3c982017-08-28 13:31:38 +0200516 ("Usage: " & Ada.Command_Line.Command_Name &
517 " <delay seconds>" &
518 " [(0|90|180|270)]");
Nico Huber3b654a02017-07-15 22:27:14 +0200519 Debug.New_Line;
520 end Print_Usage;
521
Nico Huber1d0abe42017-03-05 14:14:09 +0100522 procedure Main
523 is
Nico Huber1d0abe42017-03-05 14:14:09 +0100524 use type HW.GFX.GMA.Port_Type;
Nico Huberfda2d6e2017-07-09 16:47:52 +0200525 use type HW.Word64;
Nico Huber1d0abe42017-03-05 14:14:09 +0100526 use type Interfaces.C.int;
527
Nico Huberfda2d6e2017-07-09 16:47:52 +0200528 Res_Addr : Word64;
529
Nico Hubera455f0e2018-01-07 11:40:40 +0100530 Delay_MS : Natural;
Nico Huber88f3c982017-08-28 13:31:38 +0200531 Rotation : Rotation_Type := No_Rotation;
Nico Huber3b654a02017-07-15 22:27:14 +0200532
Nico Huberfda2d6e2017-07-09 16:47:52 +0200533 Dev_Init,
Nico Huber1d0abe42017-03-05 14:14:09 +0100534 Initialized : Boolean;
535
Nico Huberd8282b62018-06-18 00:44:55 +0200536 Gen : Rand_P.Generator;
537
Nico Huber1d0abe42017-03-05 14:14:09 +0100538 function iopl (level : Interfaces.C.int) return Interfaces.C.int;
539 pragma Import (C, iopl, "iopl");
540 begin
Nico Huber88f3c982017-08-28 13:31:38 +0200541 if Ada.Command_Line.Argument_Count < 1 then
Nico Huber3b654a02017-07-15 22:27:14 +0200542 Print_Usage;
543 return;
544 end if;
545
Nico Hubera455f0e2018-01-07 11:40:40 +0100546 Delay_MS := Natural'Value (Ada.Command_Line.Argument (1)) * 1_000;
Nico Huber3b654a02017-07-15 22:27:14 +0200547
Nico Huber88f3c982017-08-28 13:31:38 +0200548 if Ada.Command_Line.Argument_Count >= 2 then
549 declare
550 Rotation_Degree : constant String := Ada.Command_Line.Argument (2);
551 begin
552 if Rotation_Degree = "0" then Rotation := No_Rotation;
553 elsif Rotation_Degree = "90" then Rotation := Rotated_90;
554 elsif Rotation_Degree = "180" then Rotation := Rotated_180;
555 elsif Rotation_Degree = "270" then Rotation := Rotated_270;
556 else Print_Usage; return; end if;
557 end;
558 end if;
559
Nico Huber1d0abe42017-03-05 14:14:09 +0100560 if iopl (3) /= 0 then
561 Debug.Put_Line ("Failed to change i/o privilege level.");
562 return;
563 end if;
564
Nico Huberfda2d6e2017-07-09 16:47:52 +0200565 Dev.Initialize (Dev_Init);
566 if not Dev_Init then
567 Debug.Put_Line ("Failed to map PCI config.");
Nico Huber1d0abe42017-03-05 14:14:09 +0100568 return;
569 end if;
570
Nico Huberfda2d6e2017-07-09 16:47:52 +0200571 Dev.Map (Res_Addr, PCI.Res2, WC => True);
572 if Res_Addr = 0 then
573 Debug.Put_Line ("Failed to map PCI resource2.");
574 return;
575 end if;
576 Screen.Set_Base_Address (Res_Addr);
577
Nico Huber1d0abe42017-03-05 14:14:09 +0100578 GMA.Initialize
Nico Huber2b6f6992017-07-09 18:11:34 +0200579 (Clean_State => True,
Nico Huber1d0abe42017-03-05 14:14:09 +0100580 Success => Initialized);
581
582 if Initialized then
Nico Huber3b654a02017-07-15 22:27:14 +0200583 Backup_GTT;
584
Nico Huberd8282b62018-06-18 00:44:55 +0200585 Prepare_Configs (Rotation, Gen);
Nico Huber1d0abe42017-03-05 14:14:09 +0100586
587 GMA.Update_Outputs (Pipes);
588
589 for Pipe in GMA.Pipe_Index loop
590 if Pipes (Pipe).Port /= GMA.Disabled then
Nico Huber3b654a02017-07-15 22:27:14 +0200591 Backup_Screen (Pipes (Pipe).Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100592 Test_Screen
593 (Framebuffer => Pipes (Pipe).Framebuffer,
594 Pipe => Pipe);
595 end if;
Nico Huber7bb10c62018-01-12 14:07:44 +0100596 for Size in Cursor_Size loop
597 Draw_Cursor (Pipe, Cursors (Pipe) (Size));
598 end loop;
Nico Huber1d0abe42017-03-05 14:14:09 +0100599 end loop;
Nico Huber3b654a02017-07-15 22:27:14 +0200600
Nico Huberd8282b62018-06-18 00:44:55 +0200601 Cursor_Infos :=
602 (others =>
603 (Color => Pipe_Index'Val (Rand (Gen) mod 3),
604 Size => Cursor_Size'Val (Rand (Gen) mod 3),
605 X_Velo => 3 * Cursor_Rand (Gen),
606 Y_Velo => 3 * Cursor_Rand (Gen),
607 others => Cursor_Rand (Gen)));
608
Nico Hubera63e8332018-02-01 16:41:30 +0100609 if Delay_MS < Primary_Delay_MS + Secondary_Delay_MS then
610 Script_Cursors (Pipes, Delay_MS);
611 else -- getting bored?
612 Script_Cursors (Pipes, Primary_Delay_MS);
Nico Hubera455f0e2018-01-07 11:40:40 +0100613 Delay_MS := Delay_MS - Primary_Delay_MS;
614 declare
615 New_Pipes : GMA.Pipe_Configs := Pipes;
616
Nico Huber7a740432018-05-30 13:58:27 +0200617 function Rand_Div (Num : Position_Type) return Position_Type is
Nico Huberd8282b62018-06-18 00:44:55 +0200618 (case Rand (Gen) mod 4 is
619 when 3 => Rand (Gen) mod Num / 3,
620 when 2 => Rand (Gen) mod Num / 2,
621 when 1 => Rand (Gen) mod Num,
Nico Hubera455f0e2018-01-07 11:40:40 +0100622 when others => 0);
623 begin
624 Rand_P.Reset (Gen, Seed);
625 while Delay_MS >= Secondary_Delay_MS loop
626 New_Pipes := Pipes;
627 for Pipe in GMA.Pipe_Index loop
628 exit when Pipes (Pipe).Port = Disabled;
629 declare
630 New_FB : Framebuffer_Type renames
631 New_Pipes (Pipe).Framebuffer;
Nico Hubera63e8332018-02-01 16:41:30 +0100632 Cursor : Cursor_Type renames New_Pipes (Pipe).Cursor;
Nico Hubera455f0e2018-01-07 11:40:40 +0100633 Width : constant Width_Type :=
634 Pipes (Pipe).Framebuffer.Width;
635 Height : constant Height_Type :=
636 Pipes (Pipe).Framebuffer.Height;
637 begin
Nico Huber7a740432018-05-30 13:58:27 +0200638 New_FB.Start_X := Position_Type'Min
Nico Hubera455f0e2018-01-07 11:40:40 +0100639 (Width - 320, Rand_Div (Width));
Nico Huber7a740432018-05-30 13:58:27 +0200640 New_FB.Start_Y := Position_Type'Min
Nico Hubera455f0e2018-01-07 11:40:40 +0100641 (Height - 320, Rand_Div (Height));
642 New_FB.Width := Width_Type'Max
643 (320, Width - New_FB.Start_X - Rand_Div (Width));
644 New_FB.Height := Height_Type'Max
645 (320, Height - New_FB.Start_Y - Rand_Div (Height));
Nico Hubera63e8332018-02-01 16:41:30 +0100646
Nico Huberc5c767a2018-06-03 01:09:04 +0200647 Cursor.Center_X := Rotated_Width (New_FB) / 2;
648 Cursor.Center_Y := Rotated_Height (New_FB) / 2;
Nico Hubera63e8332018-02-01 16:41:30 +0100649 GMA.Update_Cursor (Pipe, Cursor);
Nico Hubera455f0e2018-01-07 11:40:40 +0100650 end;
651 end loop;
652 GMA.Dump_Configs (New_Pipes);
653 GMA.Update_Outputs (New_Pipes);
Nico Huberd8282b62018-06-18 00:44:55 +0200654 Move_Cursors (New_Pipes, Secondary_Delay_MS, Gen);
Nico Hubera455f0e2018-01-07 11:40:40 +0100655 Delay_MS := Delay_MS - Secondary_Delay_MS;
656 end loop;
Nico Huberd8282b62018-06-18 00:44:55 +0200657 Move_Cursors (New_Pipes, Delay_MS, Gen);
Nico Hubera455f0e2018-01-07 11:40:40 +0100658 end;
659 end if;
Nico Huber3b654a02017-07-15 22:27:14 +0200660
661 for Pipe in GMA.Pipe_Index loop
662 if Pipes (Pipe).Port /= GMA.Disabled then
663 Restore_Screen (Pipes (Pipe).Framebuffer);
664 end if;
665 end loop;
666 Restore_GTT;
Nico Huber1d0abe42017-03-05 14:14:09 +0100667 end if;
668 end Main;
669
Nico Huberfda2d6e2017-07-09 16:47:52 +0200670end HW.GFX.GMA.GFX_Test;