blob: 6839dc3abf6d6e8f61e32a1dfc2aaea26d775d0e [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 Hubera455f0e2018-01-07 11:40:40 +010023 Gen : Rand_P.Generator;
Nico Hubera63e8332018-02-01 16:41:30 +010024 function Rand 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 Huber3b654a02017-07-15 22:27:14 +020031 type GTT_PTE_Type is mod 2 ** (Config.GTT_PTE_Size * 8);
32 type GTT_Registers_Type is array (GTT_Range) of GTT_PTE_Type;
33 package GTT is new MMIO_Range
34 (Base_Addr => 0,
35 Element_T => GTT_PTE_Type,
36 Index_T => GTT_Range,
37 Array_T => GTT_Registers_Type);
38
39 GTT_Backup : GTT_Registers_Type;
40
41 procedure Backup_GTT
42 is
43 begin
44 for Idx in GTT_Range loop
45 GTT.Read (GTT_Backup (Idx), Idx);
46 end loop;
47 end Backup_GTT;
48
49 procedure Restore_GTT
50 is
51 begin
52 for Idx in GTT_Range loop
53 GTT.Write (Idx, GTT_Backup (Idx));
54 end loop;
55 end Restore_GTT;
56
Nico Huber1d0abe42017-03-05 14:14:09 +010057 type Pixel_Type is record
58 Red : Byte;
59 Green : Byte;
60 Blue : Byte;
61 Alpha : Byte;
62 end record;
63
64 for Pixel_Type use record
65 Blue at 0 range 0 .. 7;
66 Green at 1 range 0 .. 7;
67 Red at 2 range 0 .. 7;
68 Alpha at 3 range 0 .. 7;
69 end record;
70
Nico Huber244ea7e2017-08-28 11:38:23 +020071 White : constant Pixel_Type := (255, 255, 255, 255);
72 Black : constant Pixel_Type := ( 0, 0, 0, 255);
73 Red : constant Pixel_Type := (255, 0, 0, 255);
74 Green : constant Pixel_Type := ( 0, 255, 0, 255);
75 Blue : constant Pixel_Type := ( 0, 0, 255, 255);
76
Nico Huberfda2d6e2017-07-09 16:47:52 +020077 function Pixel_To_Word (P : Pixel_Type) return Word32
78 with
79 SPARK_Mode => Off
80 is
81 function To_Word is new Ada.Unchecked_Conversion (Pixel_Type, Word32);
82 begin
83 return To_Word (P);
84 end Pixel_To_Word;
85
Nico Huber7bb10c62018-01-12 14:07:44 +010086 Max_W : constant := 4096;
87 Max_H : constant := 2160;
88 FB_Align : constant := 16#0004_0000#;
89 Cursor_Align : constant := 16#0001_0000#;
90 Max_Cursor_Wid : constant := 256;
91 subtype Screen_Index is Natural range 0 .. 3 *
92 (Max_W * Max_H + FB_Align / 4 +
93 3 * Max_Cursor_Wid * Max_Cursor_Wid + Cursor_Align / 4)
94 - 1;
Nico Huberfda2d6e2017-07-09 16:47:52 +020095 type Screen_Type is array (Screen_Index) of Word32;
Nico Huber1d0abe42017-03-05 14:14:09 +010096
Nico Huber34be6542017-12-13 09:26:24 +010097 function Screen_Offset (FB : Framebuffer_Type) return Natural is
98 (Natural (Phys_Offset (FB) / 4));
99
Nico Huberfda2d6e2017-07-09 16:47:52 +0200100 package Screen is new MMIO_Range (0, Word32, Screen_Index, Screen_Type);
Nico Huber1d0abe42017-03-05 14:14:09 +0100101
Nico Huber3b654a02017-07-15 22:27:14 +0200102 Screen_Backup : Screen_Type;
103
104 procedure Backup_Screen (FB : Framebuffer_Type)
105 is
Nico Huber34be6542017-12-13 09:26:24 +0100106 First : constant Screen_Index := Screen_Offset (FB);
Nico Huber3b654a02017-07-15 22:27:14 +0200107 Last : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
108 begin
109 for Idx in Screen_Index range First .. Last loop
110 Screen.Read (Screen_Backup (Idx), Idx);
111 end loop;
112 end Backup_Screen;
113
114 procedure Restore_Screen (FB : Framebuffer_Type)
115 is
Nico Huber34be6542017-12-13 09:26:24 +0100116 First : constant Screen_Index := Screen_Offset (FB);
Nico Huber3b654a02017-07-15 22:27:14 +0200117 Last : constant Screen_Index := First + Natural (FB_Size (FB)) / 4 - 1;
118 begin
119 for Idx in Screen_Index range First .. Last loop
120 Screen.Write (Idx, Screen_Backup (Idx));
121 end loop;
122 end Restore_Screen;
Nico Huber1d0abe42017-03-05 14:14:09 +0100123
Nico Huber5ef4d602017-12-13 13:56:47 +0100124 function Drawing_Width (FB : Framebuffer_Type) return Natural is
125 (Natural (FB.Width + 2 * Start_X));
126
127 function Drawing_Height (FB : Framebuffer_Type) return Natural is
128 (Natural (FB.Height + 2 * Start_Y));
129
Nico Huber244ea7e2017-08-28 11:38:23 +0200130 function Corner_Fill
131 (X, Y : Natural;
132 FB : Framebuffer_Type;
133 Pipe : Pipe_Index)
134 return Pixel_Type
135 is
136 Xrel : constant Integer :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100137 (if X < 32 then X else X - (Drawing_Width (FB) - 32));
Nico Huber244ea7e2017-08-28 11:38:23 +0200138 Yrel : constant Integer :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100139 (if Y < 32 then Y else Y - (Drawing_Height (FB) - 32));
Nico Huber244ea7e2017-08-28 11:38:23 +0200140
141 function Color (Idx : Natural) return Pixel_Type is
142 (case (Idx + Pipe_Index'Pos (Pipe)) mod 4 is
143 when 0 => Blue, when 1 => Black,
144 when 3 => Green, when others => Red);
145 begin
146 return
147 (if Xrel mod 16 = 0 or Xrel = 31 or Yrel mod 16 = 0 or Yrel = 31 then
148 White
149 elsif Yrel < 16 then
150 (if Xrel < 16 then Color (0) else Color (1))
151 else
152 (if Xrel < 16 then Color (3) else Color (2)));
153 end Corner_Fill;
154
Nico Huber1d0abe42017-03-05 14:14:09 +0100155 function Fill
156 (X, Y : Natural;
157 Framebuffer : Framebuffer_Type;
Nico Huber244ea7e2017-08-28 11:38:23 +0200158 Pipe : Pipe_Index)
Nico Huber1d0abe42017-03-05 14:14:09 +0100159 return Pixel_Type
160 is
161 use type HW.Byte;
162
Nico Huber5ef4d602017-12-13 13:56:47 +0100163 Xp : constant Natural := X * 256 / Drawing_Width (Framebuffer);
164 Yp : constant Natural := Y * 256 / Drawing_Height (Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100165 Xn : constant Natural := 255 - Xp;
166 Yn : constant Natural := 255 - Yp;
167
168 function Map (X, Y : Natural) return Byte is
169 begin
170 return Byte (X * Y / 255);
171 end Map;
172 begin
173 return
174 (case Pipe is
175 when GMA.Primary => (Map (Xn, Yn), Map (Xp, Yn), Map (Xp, Yp), 255),
176 when GMA.Secondary => (Map (Xn, Yp), Map (Xn, Yn), Map (Xp, Yn), 255),
177 when GMA.Tertiary => (Map (Xp, Yp), Map (Xn, Yp), Map (Xn, Yn), 255));
178 end Fill;
179
180 procedure Test_Screen
181 (Framebuffer : Framebuffer_Type;
182 Pipe : GMA.Pipe_Index)
183 is
Nico Huber1d0abe42017-03-05 14:14:09 +0100184 P : Pixel_Type;
185 -- We have pixel offset wheras the framebuffer has a byte offset
Nico Huber34be6542017-12-13 09:26:24 +0100186 Offset_Y : Natural := Screen_Offset (Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100187 Offset : Natural;
Nico Huber9ca69f12017-08-28 14:31:46 +0200188
189 function Top_Test (X, Y : Natural) return Boolean
190 is
Nico Huber5ef4d602017-12-13 13:56:47 +0100191 C : constant Natural := Drawing_Width (Framebuffer) / 2;
192 S_Y : constant Natural := 3 * (Y - Start_Y) / 2;
Nico Huber9ca69f12017-08-28 14:31:46 +0200193 Left : constant Integer := X - C + S_Y;
194 Right : constant Integer := X - C - S_Y;
195 begin
196 return
Nico Huber5ef4d602017-12-13 13:56:47 +0100197 (Y - Start_Y) < 12 and
Nico Huber9ca69f12017-08-28 14:31:46 +0200198 ((-1 <= Left and Left <= 0) or
199 (0 <= Right and Right <= 1));
200 end Top_Test;
Nico Huber1d0abe42017-03-05 14:14:09 +0100201 begin
Nico Huber5ef4d602017-12-13 13:56:47 +0100202 for Y in 0 .. Drawing_Height (Framebuffer) - 1 loop
Nico Huber1d0abe42017-03-05 14:14:09 +0100203 Offset := Offset_Y;
Nico Huber5ef4d602017-12-13 13:56:47 +0100204 for X in 0 .. Drawing_Width (Framebuffer) - 1 loop
205 if (X < 32 or X >= Drawing_Width (Framebuffer) - 32) and
206 (Y < 32 or Y >= Drawing_Height (Framebuffer) - 32)
Nico Huber244ea7e2017-08-28 11:38:23 +0200207 then
208 P := Corner_Fill (X, Y, Framebuffer, Pipe);
Nico Huber9ca69f12017-08-28 14:31:46 +0200209 elsif Framebuffer.Rotation /= No_Rotation and then
210 Top_Test (X, Y)
211 then
212 P := White;
Nico Huber244ea7e2017-08-28 11:38:23 +0200213 elsif Y mod 16 = 0 or X mod 16 = 0 then
214 P := Black;
Nico Huber1d0abe42017-03-05 14:14:09 +0100215 else
216 P := Fill (X, Y, Framebuffer, Pipe);
217 end if;
Nico Huberfda2d6e2017-07-09 16:47:52 +0200218 Screen.Write (Offset, Pixel_To_Word (P));
Nico Huber1d0abe42017-03-05 14:14:09 +0100219 Offset := Offset + 1;
220 end loop;
221 Offset_Y := Offset_Y + Natural (Framebuffer.Stride);
222 end loop;
223 end Test_Screen;
224
Nico Huber7bb10c62018-01-12 14:07:44 +0100225 function Donut (X, Y, Max : Cursor_Pos) return Byte
226 is
227 ZZ : constant Int32 := Max * Max * 2;
228 Dist_Center : constant Int32 := ((X * X + Y * Y) * 255) / ZZ;
229 Dist_Circle : constant Int32 := Dist_Center - 20;
230 begin
231 return Byte (255 - Int32'Min (255, 6 * abs Dist_Circle + 64));
232 end Donut;
233
234 procedure Draw_Cursor (Pipe : Pipe_Index; Cursor : Cursor_Type)
235 is
236 use type HW.Byte;
237 Width : constant Width_Type := Cursor_Width (Cursor.Size);
238 Screen_Offset : Natural :=
239 Natural (Shift_Left (Word32 (Cursor.GTT_Offset), 12) / 4);
240 begin
241 if Cursor.Mode /= ARGB_Cursor then
242 return;
243 end if;
244 for Y in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
245 for X in Cursor_Pos range -Width / 2 .. Width / 2 - 1 loop
246 declare
247 D : constant Byte := Donut (X, Y, Width / 2);
248 begin
249 -- Hardware seems to expect pre-multiplied alpha (i.e.
250 -- color components already contain the alpha).
251 Screen.Write
252 (Index => Screen_Offset,
253 Value => Pixel_To_Word (
254 (Red => (if Pipe = Secondary then D / 2 else 0),
255 Green => (if Pipe = Tertiary then D / 2 else 0),
256 Blue => (if Pipe = Primary then D / 2 else 0),
257 Alpha => D)));
258 Screen_Offset := Screen_Offset + 1;
259 end;
260 end loop;
261 end loop;
262 end Draw_Cursor;
263
Nico Huber1d0abe42017-03-05 14:14:09 +0100264 procedure Calc_Framebuffer
265 (FB : out Framebuffer_Type;
266 Mode : in Mode_Type;
Nico Huber88f3c982017-08-28 13:31:38 +0200267 Rotation : in Rotation_Type;
Nico Huber1d0abe42017-03-05 14:14:09 +0100268 Offset : in out Word32)
269 is
Nico Huberc5c767a2018-06-03 01:09:04 +0200270 Width : constant Width_Type := Mode.H_Visible;
271 Height : constant Height_Type := Mode.V_Visible;
Nico Huber1d0abe42017-03-05 14:14:09 +0100272 begin
273 Offset := (Offset + FB_Align - 1) and not (FB_Align - 1);
Nico Huber88f3c982017-08-28 13:31:38 +0200274 if Rotation = Rotated_90 or Rotation = Rotated_270 then
275 FB :=
Nico Huberc5c767a2018-06-03 01:09:04 +0200276 (Width => Height,
277 Height => Width,
Nico Huber5ef4d602017-12-13 13:56:47 +0100278 Start_X => Start_X,
279 Start_Y => Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200280 BPC => 8,
Nico Huberc5c767a2018-06-03 01:09:04 +0200281 Stride => Div_Round_Up (Height + 2 * Start_X, 32) * 32,
282 V_Stride => Div_Round_Up (Width + 2 * Start_Y, 32) * 32,
Nico Huber88f3c982017-08-28 13:31:38 +0200283 Tiling => Y_Tiled,
284 Rotation => Rotation,
Nico Huber34be6542017-12-13 09:26:24 +0100285 Offset => Offset + Word32 (GTT_Rotation_Offset) * GTT_Page_Size);
Nico Huber88f3c982017-08-28 13:31:38 +0200286 else
287 FB :=
Nico Huber5ef4d602017-12-13 13:56:47 +0100288 (Width => Width,
289 Height => Height,
290 Start_X => Start_X,
291 Start_Y => Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200292 BPC => 8,
Nico Huber5ef4d602017-12-13 13:56:47 +0100293 Stride => Div_Round_Up (Width + 2 * Start_X, 16) * 16,
294 V_Stride => Height + 2 * Start_Y,
Nico Huber88f3c982017-08-28 13:31:38 +0200295 Tiling => Linear,
296 Rotation => Rotation,
297 Offset => Offset);
298 end if;
Nico Huberb7470492017-11-30 14:48:35 +0100299 Offset := Offset + Word32 (FB_Size (FB));
Nico Huber1d0abe42017-03-05 14:14:09 +0100300 end Calc_Framebuffer;
301
Nico Huber7bb10c62018-01-12 14:07:44 +0100302 type Cursor_Array is array (Cursor_Size) of Cursor_Type;
303 Cursors : array (Pipe_Index) of Cursor_Array;
304
305 procedure Prepare_Cursors
306 (Cursors : out Cursor_Array;
307 Offset : in out Word32)
308 is
309 GMA_Phys_Base : constant PCI.Index := 16#5c#;
310 GMA_Phys_Base_Mask : constant := 16#fff0_0000#;
311
312 Phys_Base : Word32;
313 Success : Boolean;
314 begin
315 Dev.Read32 (Phys_Base, GMA_Phys_Base);
316 Phys_Base := Phys_Base and GMA_Phys_Base_Mask;
317 Success := Phys_Base /= GMA_Phys_Base_Mask and Phys_Base /= 0;
318 if not Success then
319 Debug.Put_Line ("Failed to read stolen memory base.");
320 return;
321 end if;
322
323 for Size in Cursor_Size loop
324 Offset := (Offset + Cursor_Align - 1) and not (Cursor_Align - 1);
325 declare
326 Width : constant Width_Type := Cursor_Width (Size);
327 GTT_End : constant Word32 := Offset + Word32 (Width * Width) * 4;
328 begin
329 Cursors (Size) :=
330 (Mode => ARGB_Cursor,
331 Size => Size,
332 Center_X => Width,
333 Center_Y => Width,
334 GTT_Offset => GTT_Range (Shift_Right (Offset, 12)));
335 while Offset < GTT_End loop
336 GMA.Write_GTT
337 (GTT_Page => GTT_Range (Offset / GTT_Page_Size),
338 Device_Address => GTT_Address_Type (Phys_Base + Offset),
339 Valid => True);
340 Offset := Offset + GTT_Page_Size;
341 end loop;
342 end;
343 end loop;
344 end Prepare_Cursors;
345
Nico Huber3b654a02017-07-15 22:27:14 +0200346 Pipes : GMA.Pipe_Configs;
347
Nico Huber88f3c982017-08-28 13:31:38 +0200348 procedure Prepare_Configs (Rotation : Rotation_Type)
Nico Huber1d0abe42017-03-05 14:14:09 +0100349 is
350 use type HW.GFX.GMA.Port_Type;
351
Nico Huberfda2d6e2017-07-09 16:47:52 +0200352 Offset : Word32 := 0;
Nico Huber3b654a02017-07-15 22:27:14 +0200353 Success : Boolean;
Nico Huber1d0abe42017-03-05 14:14:09 +0100354 begin
355 GMA.Display_Probing.Scan_Ports (Pipes);
356
357 for Pipe in GMA.Pipe_Index loop
358 if Pipes (Pipe).Port /= GMA.Disabled then
359 Calc_Framebuffer
360 (FB => Pipes (Pipe).Framebuffer,
361 Mode => Pipes (Pipe).Mode,
Nico Huber88f3c982017-08-28 13:31:38 +0200362 Rotation => Rotation,
Nico Huber1d0abe42017-03-05 14:14:09 +0100363 Offset => Offset);
Nico Huber3b654a02017-07-15 22:27:14 +0200364 GMA.Setup_Default_FB
365 (FB => Pipes (Pipe).Framebuffer,
366 Clear => False,
367 Success => Success);
368 if not Success then
369 Pipes (Pipe).Port := GMA.Disabled;
370 end if;
Nico Huber1d0abe42017-03-05 14:14:09 +0100371 end if;
Nico Huber7bb10c62018-01-12 14:07:44 +0100372 Prepare_Cursors (Cursors (Pipe), Offset);
373 Pipes (Pipe).Cursor := Cursors (Pipe) (Cursor_Size'Val (Rand mod 3));
Nico Huber1d0abe42017-03-05 14:14:09 +0100374 end loop;
375
376 GMA.Dump_Configs (Pipes);
377 end Prepare_Configs;
378
Nico Hubera63e8332018-02-01 16:41:30 +0100379 procedure Script_Cursors
380 (Pipes : in out GMA.Pipe_Configs;
381 Time_MS : in Natural)
382 is
383 type Corner is (UL, UR, LR, LL);
384 type Cursor_Script_Entry is record
385 Rel : Corner;
386 X, Y : Int32;
387 end record;
388 Cursor_Script : constant array (Natural range 0 .. 19) of Cursor_Script_Entry :=
389 ((UL, 16, 16), (UL, 16, 16), (UL, 16, 16), (UL, -32, 0), (UL, 16, 16),
390 (UR, -16, 16), (UR, -16, 16), (UR, -16, 16), (UR, 0, -32), (UR, -16, 16),
391 (LR, -16, -16), (LR, -16, -16), (LR, -16, -16), (LR, 32, 0), (LR, -16, -16),
392 (LL, 16, -16), (LL, 16, -16), (LL, 16, -16), (LL, 0, 32), (LL, 16, -16));
393
394 Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
395 Timed_Out : Boolean := False;
396 Cnt : Word32 := 0;
397 begin
398 loop
399 for Pipe in Pipe_Index loop
400 exit when Pipes (Pipe).Port = GMA.Disabled;
401 declare
402 C : Cursor_Type renames Pipes (Pipe).Cursor;
403 FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
Nico Huberc5c767a2018-06-03 01:09:04 +0200404 Width : constant Width_Type := Rotated_Width (FB);
405 Height : constant Height_Type := Rotated_Height (FB);
Nico Hubera63e8332018-02-01 16:41:30 +0100406 CS : Cursor_Script_Entry renames Cursor_Script
407 (Natural (Cnt) mod (Cursor_Script'Last + 1));
408 begin
409 C.Center_X := CS.X;
410 C.Center_Y := CS.Y;
411 case CS.Rel is
412 when UL => null;
413 when UR => C.Center_X := CS.X + Width;
414 when LR => C.Center_X := CS.X + Width;
415 C.Center_Y := CS.Y + Height;
416 when LL => C.Center_Y := CS.Y + Height;
417 end case;
418 GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
419 end;
420 end loop;
421 Timed_Out := Time.Timed_Out (Deadline);
422 exit when Timed_Out;
423 Time.M_Delay (160);
424 Cnt := Cnt + 1;
425 end loop;
426 end Script_Cursors;
427
428 type Cursor_Info is record
429 X_Velo, Y_Velo : Int32;
430 X_Acc, Y_Acc : Int32;
431 Color : Pipe_Index;
432 Size : Cursor_Size;
433 end record;
434 function Cursor_Rand return Int32 is (Rand mod 51 - 25);
435 Cursor_Infos : array (Pipe_Index) of Cursor_Info :=
436 (others =>
437 (Color => Pipe_Index'Val (Rand mod 3),
438 Size => Cursor_Size'Val (Rand mod 3),
439 X_Velo => 3 * Cursor_Rand,
440 Y_Velo => 3 * Cursor_Rand,
441 others => Cursor_Rand));
442
443 procedure Move_Cursors
444 (Pipes : in out GMA.Pipe_Configs;
445 Time_MS : in Natural)
446 is
447 procedure Select_New_Cursor
448 (P : in Pipe_Index;
449 C : in out Cursor_Type;
450 CI : in out Cursor_Info)
451 is
452 Old_C : constant Cursor_Type := C;
453 begin
454 -- change either size or color
455 if Rand mod 2 = 0 then
456 CI.Color := Pipe_Index'Val
457 ((Pipe_Index'Pos (CI.Color) + 1 + Rand mod 2) mod 3);
458 else
459 CI.Size := Cursor_Size'Val
460 ((Cursor_Size'Pos (CI.Size) + 1 + Rand mod 2) mod 3);
461 end if;
462 C := Cursors (CI.Color) (CI.Size);
463 C.Center_X := Old_C.Center_X;
464 C.Center_Y := Old_C.Center_Y;
465 GMA.Update_Cursor (P, C);
466 end Select_New_Cursor;
467
468 Deadline : constant Time.T := Time.MS_From_Now (Time_MS);
469 Timed_Out : Boolean := False;
470 Cnt : Word32 := 0;
471 begin
472 for Pipe in Pipe_Index loop
473 exit when Pipes (Pipe).Port = GMA.Disabled;
474 Select_New_Cursor (Pipe, Pipes (Pipe).Cursor, Cursor_Infos (Pipe));
475 end loop;
476 loop
477 for Pipe in Pipe_Index loop
478 exit when Pipes (Pipe).Port = GMA.Disabled;
479 declare
480 C : Cursor_Type renames Pipes (Pipe).Cursor;
481 CI : Cursor_Info renames Cursor_Infos (Pipe);
482 FB : Framebuffer_Type renames Pipes (Pipe).Framebuffer;
Nico Huberc5c767a2018-06-03 01:09:04 +0200483 Width : constant Width_Type := Rotated_Width (FB);
484 Height : constant Height_Type := Rotated_Height (FB);
Nico Hubera63e8332018-02-01 16:41:30 +0100485
486 Update : Boolean := False;
487 begin
488 if Cnt mod 16 = 0 then
489 CI.X_Acc := Cursor_Rand;
490 CI.Y_Acc := Cursor_Rand;
491 end if;
492 CI.X_Velo := CI.X_Velo + CI.X_Acc;
493 CI.Y_Velo := CI.Y_Velo + CI.Y_Acc;
494 C.Center_X := C.Center_X + CI.X_Velo / 100;
495 C.Center_Y := C.Center_Y + CI.Y_Velo / 100;
496 if C.Center_X not in 0 .. Width - 1 then
497 C.Center_X := Int32'Max (0, Int32'Min (Width, C.Center_X));
498 CI.X_Velo := -CI.X_Velo;
499 Update := True;
500 end if;
501 if C.Center_Y not in 0 .. Height - 1 then
502 C.Center_Y := Int32'Max (0, Int32'Min (Height, C.Center_Y));
503 CI.Y_Velo := -CI.Y_Velo;
504 Update := True;
505 end if;
506 if Update then
507 Select_New_Cursor (Pipe, C, CI);
508 else
509 GMA.Place_Cursor (Pipe, C.Center_X, C.Center_Y);
510 end if;
511 end;
512 end loop;
513 Timed_Out := Time.Timed_Out (Deadline);
514 exit when Timed_Out;
515 Time.M_Delay (16); -- ~60 fps
516 Cnt := Cnt + 1;
517 end loop;
518 end Move_Cursors;
519
Nico Huber3b654a02017-07-15 22:27:14 +0200520 procedure Print_Usage
521 is
522 begin
523 Debug.Put_Line
Nico Huber88f3c982017-08-28 13:31:38 +0200524 ("Usage: " & Ada.Command_Line.Command_Name &
525 " <delay seconds>" &
526 " [(0|90|180|270)]");
Nico Huber3b654a02017-07-15 22:27:14 +0200527 Debug.New_Line;
528 end Print_Usage;
529
Nico Huber1d0abe42017-03-05 14:14:09 +0100530 procedure Main
531 is
Nico Huber1d0abe42017-03-05 14:14:09 +0100532 use type HW.GFX.GMA.Port_Type;
Nico Huberfda2d6e2017-07-09 16:47:52 +0200533 use type HW.Word64;
Nico Huber1d0abe42017-03-05 14:14:09 +0100534 use type Interfaces.C.int;
535
Nico Huberfda2d6e2017-07-09 16:47:52 +0200536 Res_Addr : Word64;
537
Nico Hubera455f0e2018-01-07 11:40:40 +0100538 Delay_MS : Natural;
Nico Huber88f3c982017-08-28 13:31:38 +0200539 Rotation : Rotation_Type := No_Rotation;
Nico Huber3b654a02017-07-15 22:27:14 +0200540
Nico Huberfda2d6e2017-07-09 16:47:52 +0200541 Dev_Init,
Nico Huber1d0abe42017-03-05 14:14:09 +0100542 Initialized : Boolean;
543
544 function iopl (level : Interfaces.C.int) return Interfaces.C.int;
545 pragma Import (C, iopl, "iopl");
546 begin
Nico Huber88f3c982017-08-28 13:31:38 +0200547 if Ada.Command_Line.Argument_Count < 1 then
Nico Huber3b654a02017-07-15 22:27:14 +0200548 Print_Usage;
549 return;
550 end if;
551
Nico Hubera455f0e2018-01-07 11:40:40 +0100552 Delay_MS := Natural'Value (Ada.Command_Line.Argument (1)) * 1_000;
Nico Huber3b654a02017-07-15 22:27:14 +0200553
Nico Huber88f3c982017-08-28 13:31:38 +0200554 if Ada.Command_Line.Argument_Count >= 2 then
555 declare
556 Rotation_Degree : constant String := Ada.Command_Line.Argument (2);
557 begin
558 if Rotation_Degree = "0" then Rotation := No_Rotation;
559 elsif Rotation_Degree = "90" then Rotation := Rotated_90;
560 elsif Rotation_Degree = "180" then Rotation := Rotated_180;
561 elsif Rotation_Degree = "270" then Rotation := Rotated_270;
562 else Print_Usage; return; end if;
563 end;
564 end if;
565
Nico Huber1d0abe42017-03-05 14:14:09 +0100566 if iopl (3) /= 0 then
567 Debug.Put_Line ("Failed to change i/o privilege level.");
568 return;
569 end if;
570
Nico Huberfda2d6e2017-07-09 16:47:52 +0200571 Dev.Initialize (Dev_Init);
572 if not Dev_Init then
573 Debug.Put_Line ("Failed to map PCI config.");
Nico Huber1d0abe42017-03-05 14:14:09 +0100574 return;
575 end if;
576
Nico Huber3b654a02017-07-15 22:27:14 +0200577 Dev.Map (Res_Addr, PCI.Res0, Offset => Config.GTT_Offset);
578 if Res_Addr = 0 then
579 Debug.Put_Line ("Failed to map PCI resource0.");
580 return;
581 end if;
582 GTT.Set_Base_Address (Res_Addr);
583
Nico Huberfda2d6e2017-07-09 16:47:52 +0200584 Dev.Map (Res_Addr, PCI.Res2, WC => True);
585 if Res_Addr = 0 then
586 Debug.Put_Line ("Failed to map PCI resource2.");
587 return;
588 end if;
589 Screen.Set_Base_Address (Res_Addr);
590
Nico Huber1d0abe42017-03-05 14:14:09 +0100591 GMA.Initialize
Nico Huber2b6f6992017-07-09 18:11:34 +0200592 (Clean_State => True,
Nico Huber1d0abe42017-03-05 14:14:09 +0100593 Success => Initialized);
594
595 if Initialized then
Nico Huber3b654a02017-07-15 22:27:14 +0200596 Backup_GTT;
597
Nico Huber88f3c982017-08-28 13:31:38 +0200598 Prepare_Configs (Rotation);
Nico Huber1d0abe42017-03-05 14:14:09 +0100599
600 GMA.Update_Outputs (Pipes);
601
602 for Pipe in GMA.Pipe_Index loop
603 if Pipes (Pipe).Port /= GMA.Disabled then
Nico Huber3b654a02017-07-15 22:27:14 +0200604 Backup_Screen (Pipes (Pipe).Framebuffer);
Nico Huber1d0abe42017-03-05 14:14:09 +0100605 Test_Screen
606 (Framebuffer => Pipes (Pipe).Framebuffer,
607 Pipe => Pipe);
608 end if;
Nico Huber7bb10c62018-01-12 14:07:44 +0100609 for Size in Cursor_Size loop
610 Draw_Cursor (Pipe, Cursors (Pipe) (Size));
611 end loop;
Nico Huber1d0abe42017-03-05 14:14:09 +0100612 end loop;
Nico Huber3b654a02017-07-15 22:27:14 +0200613
Nico Hubera63e8332018-02-01 16:41:30 +0100614 if Delay_MS < Primary_Delay_MS + Secondary_Delay_MS then
615 Script_Cursors (Pipes, Delay_MS);
616 else -- getting bored?
617 Script_Cursors (Pipes, Primary_Delay_MS);
Nico Hubera455f0e2018-01-07 11:40:40 +0100618 Delay_MS := Delay_MS - Primary_Delay_MS;
619 declare
620 New_Pipes : GMA.Pipe_Configs := Pipes;
621
Nico Huber7a740432018-05-30 13:58:27 +0200622 function Rand_Div (Num : Position_Type) return Position_Type is
Nico Hubera455f0e2018-01-07 11:40:40 +0100623 (case Rand mod 4 is
624 when 3 => Rand mod Num / 3,
625 when 2 => Rand mod Num / 2,
626 when 1 => Rand mod Num,
627 when others => 0);
628 begin
629 Rand_P.Reset (Gen, Seed);
630 while Delay_MS >= Secondary_Delay_MS loop
631 New_Pipes := Pipes;
632 for Pipe in GMA.Pipe_Index loop
633 exit when Pipes (Pipe).Port = Disabled;
634 declare
635 New_FB : Framebuffer_Type renames
636 New_Pipes (Pipe).Framebuffer;
Nico Hubera63e8332018-02-01 16:41:30 +0100637 Cursor : Cursor_Type renames New_Pipes (Pipe).Cursor;
Nico Hubera455f0e2018-01-07 11:40:40 +0100638 Width : constant Width_Type :=
639 Pipes (Pipe).Framebuffer.Width;
640 Height : constant Height_Type :=
641 Pipes (Pipe).Framebuffer.Height;
642 begin
Nico Huber7a740432018-05-30 13:58:27 +0200643 New_FB.Start_X := Position_Type'Min
Nico Hubera455f0e2018-01-07 11:40:40 +0100644 (Width - 320, Rand_Div (Width));
Nico Huber7a740432018-05-30 13:58:27 +0200645 New_FB.Start_Y := Position_Type'Min
Nico Hubera455f0e2018-01-07 11:40:40 +0100646 (Height - 320, Rand_Div (Height));
647 New_FB.Width := Width_Type'Max
648 (320, Width - New_FB.Start_X - Rand_Div (Width));
649 New_FB.Height := Height_Type'Max
650 (320, Height - New_FB.Start_Y - Rand_Div (Height));
Nico Hubera63e8332018-02-01 16:41:30 +0100651
Nico Huberc5c767a2018-06-03 01:09:04 +0200652 Cursor.Center_X := Rotated_Width (New_FB) / 2;
653 Cursor.Center_Y := Rotated_Height (New_FB) / 2;
Nico Hubera63e8332018-02-01 16:41:30 +0100654 GMA.Update_Cursor (Pipe, Cursor);
Nico Hubera455f0e2018-01-07 11:40:40 +0100655 end;
656 end loop;
657 GMA.Dump_Configs (New_Pipes);
658 GMA.Update_Outputs (New_Pipes);
Nico Hubera63e8332018-02-01 16:41:30 +0100659 Move_Cursors (New_Pipes, Secondary_Delay_MS);
Nico Hubera455f0e2018-01-07 11:40:40 +0100660 Delay_MS := Delay_MS - Secondary_Delay_MS;
661 end loop;
Nico Hubera63e8332018-02-01 16:41:30 +0100662 Move_Cursors (New_Pipes, Delay_MS);
Nico Hubera455f0e2018-01-07 11:40:40 +0100663 end;
664 end if;
Nico Huber3b654a02017-07-15 22:27:14 +0200665
666 for Pipe in GMA.Pipe_Index loop
667 if Pipes (Pipe).Port /= GMA.Disabled then
668 Restore_Screen (Pipes (Pipe).Framebuffer);
669 end if;
670 end loop;
671 Restore_GTT;
Nico Huber1d0abe42017-03-05 14:14:09 +0100672 end if;
673 end Main;
674
Nico Huberfda2d6e2017-07-09 16:47:52 +0200675end HW.GFX.GMA.GFX_Test;