1 { GRX color allocation test.
2 
3   Copyright (C) 2001 Frank Heckenbach <frank@pascal.gnu.de>
4 
5   This file is free software; as a special exception the author
6   gives unlimited permission to copy and/or distribute it, with or
7   without modifications, as long as this notice is preserved.
8 
9   This program is distributed in the hope that it will be useful,
10   but WITHOUT ANY WARRANTY, to the extent permitted by law; without
11   even the implied warranty of MERCHANTABILITY or FITNESS FOR A
12   PARTICULAR PURPOSE. }
13 
14 {$X+}
15 
16 program ColorTest;
17 
18 uses GRX;
19 
20 var
21   Dummy, i, x, y, j: Integer = 0;
22   Color: array [0 .. 1023] of Integer;
23   s : string[255];
24 
25 begin
26   Dummy := GrSetMode (Gr_Width_Height_BPP_Graphics, 800, 300, 16, 0, 0);
27   for x := 0 to 1023 do
28     begin
29       { GrAllocCell; GrSetColor (x, x, x, x); }
30       if x < 256 then
31         Color[x] := GrAllocColor (x, x, x)
32       else if x < 512 then
33         Color[x] := GrAllocColor (x - 256, 0, 0)
34       else if x < 768 then
35         Color[x] := GrAllocColor (0, x - 512, 0)
36       else
37         Color[x] := GrAllocColor (0, 0, x - 768);
38       Inc (j);
39       if Color[x] <= $100000 then Inc (i)
40     end;
41   WriteStr (s, i, ' of ', j, ' colors allocated.');
42   for y := 0 to 299 do
43     for x := 0 to 799 do
44       GrPlot (x, y, Color[(x + y) mod 1024]);
45   GrTextXY(300, 10, s, GrWhite, GrNoColor);
46   i := GrKeyRead
47 end.
48