1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232 | --------------------------------------------------------------------------------------------------------------------
-- This source code is subject to the Zlib license, see the LICENCE file in the root of this directory.
--------------------------------------------------------------------------------------------------------------------
with Ada.Real_Time; use Ada.Real_Time;
with Interfaces.C.Pointers;
with SDL.Events.Events;
with SDL.Events.Keyboards;
with SDL.Events.Mice;
with SDL.Log;
with SDL.Video.Palettes;
with SDL.Video.Pixel_Formats;
with SDL.Video.Surfaces.Makers;
with SDL.Video.Rectangles;
with SDL.Video.Windows.Makers;
with Ada.Numerics.Long_Complex_Types;
use Ada.Numerics.Long_Complex_Types;
procedure Surface_Direct_Access is
W : SDL.Video.Windows.Window;
package Sprite is
subtype Pixel is Interfaces.Unsigned_16;
type Image_Type is array (Integer range <>, Integer range <>) of aliased Pixel;
T : constant := 16#0000#;
R : constant := 16#F00F#;
W : constant := 16#FFFF#;
Image : aliased Image_Type := (
(T, T, T, T, T, T, T, T, T, T, T, T, T, T, T, T),
(T, T, T, R, R, R, T, T, T, R, R, R, T, T, T, T),
(T, T, R, W, W, R, R, T, R, W, W, R, R, T, T, T),
(T, R, W, R, R, R, R, R, W, R, R, R, R, R, T, T),
(R, W, R, R, R, R, R, R, R, R, R, R, R, R, R, T),
(R, W, R, R, R, R, R, R, R, R, R, R, R, R, R, T),
(R, R, R, R, R, R, R, R, R, R, R, R, R, R, R, T),
(T, R, R, R, R, R, R, R, R, R, R, R, R, R, T, T),
(T, R, R, R, R, R, R, R, R, R, R, R, R, R, T, T),
(T, T, R, R, R, R, R, R, R, R, R, R, R, T, T, T),
(T, T, T, R, R, R, R, R, R, R, R, R, T, T, T, T),
(T, T, T, T, R, R, R, R, R, R, R, T, T, T, T, T),
(T, T, T, T, T, R, R, R, R, R, T, T, T, T, T, T),
(T, T, T, T, T, T, R, R, R, T, T, T, T, T, T, T),
(T, T, T, T, T, T, T, R, T, T, T, T, T, T, T, T),
(T, T, T, T, T, T, T, R, T, T, T, T, T, T, T, T)
);
S : SDL.Video.Surfaces.Surface;
procedure Create_From is new SDL.Video.Surfaces.Makers.Create_From_Array (
Element => Pixel,
Index => Integer,
Element_Array => Image_Type);
end Sprite;
begin
SDL.Log.Set (Category => SDL.Log.Application, Priority => SDL.Log.Debug);
if SDL.Initialise (Flags => SDL.Enable_Screen) = True then
SDL.Video.Windows.Makers.Create (Win => W,
Title => "Surface direct access: Julia set interactive view (Esc to exit)",
Position => SDL.Natural_Coordinates'(X => 100, Y => 100),
Size => SDL.Positive_Sizes'(640, 640),
Flags => SDL.Video.Windows.Resizable);
Sprite.Create_From (Self => Sprite.S,
Pixels => Sprite.Image'Access,
Red_Mask => 16#000F#,
Green_Mask => 16#00F0#,
Blue_Mask => 16#0F00#,
Alpha_Mask => 16#F000#);
-- Main loop.
declare
Pixel_Depth : constant := 16;
-- Not all Pixel_Depth values are displayed correctly.
-- Actual data layout may differ than implied here.
type Pixel is mod 2**Pixel_Depth;
type Pixel_Array is array (Integer range <>) of aliased Pixel;
package Pixel_Pointers is new Interfaces.C.Pointers (Index => Integer,
Element => Pixel,
Element_Array => Pixel_Array,
Default_Terminator => 0);
use type Pixel_Pointers.Pointer;
S : SDL.Video.Surfaces.Surface;
package Pixel_Data is new SDL.Video.Surfaces.Pixel_Data (Element => Pixel,
Element_Pointer => Pixel_Pointers.Pointer);
-- This procedure writes individual pixel in the surface (no blending or masking)
procedure Write_Pixel (X, Y : Integer; Colour : Pixel) is
Row_Ptr : constant Pixel_Pointers.Pointer := Pixel_Data.Get_Row (S, SDL.Coordinate (Y));
Ptr : constant Pixel_Pointers.Pointer := Row_Ptr + Interfaces.C.ptrdiff_t (X);
begin
Ptr.all := Colour;
end Write_Pixel;
Cursor : SDL.Natural_Coordinates;
N_Max : constant := 63; -- Maximum number of iterations for Julia set
-- Precalculated map of colours
False_Colour : Pixel_Array (0 .. N_Max);
procedure Make_False_Colour is
Z : Complex;
A : constant Complex := Compose_From_Polar (1.0, 1.0, 3.0);
R, G, B : Integer;
begin
for I in 0 .. N_Max loop
case I is
when 0 .. N_Max - 1 =>
Z := Compose_From_Polar
(127.0, Long_Float (I), Long_Float (N_Max));
B := 127 + Integer (Re (Z));
R := 127 + Integer (Re (Z * A));
G := 127 + Integer (Re (Z * A * A));
when others => -- last iteration means we did'nt reach condition
R := 0;
G := 0;
B := 0;
end case;
False_Colour (I) := Pixel (SDL.Video.Pixel_Formats.To_Pixel
(Format => S.Pixel_Format,
Red => SDL.Video.Palettes.Colour_Component (R),
Green => SDL.Video.Palettes.Colour_Component (G),
Blue => SDL.Video.Palettes.Colour_Component (B)));
end loop;
end Make_False_Colour;
procedure Render is
-- A constant for Julia set iteration
C : constant Complex := (
(Long_Float (Cursor.X) / 640.0) * 4.0 - 2.0,
(Long_Float (Cursor.Y) / 640.0) * 4.0 - 2.0);
-- Julia set iteration variable
Z : Complex;
-- Julia set iteration counter
N : Integer;
begin
S.Lock;
for X in 0 .. 639 loop
for Y in 0 .. 639 loop
-- Julia set iteration
Z := ((Long_Float (X) / 640.0) * 4.0 - 2.0,
(Long_Float (Y) / 640.0) * 4.0 - 2.0);
N := 0;
-- Julia set iteration
while Re (Z)**2 + Im (Z)**2 < 4.0 and N < N_Max loop
N := N + 1;
Z := Z**2 + C;
end loop;
Write_Pixel (X, Y, False_Colour (N));
end loop;
end loop;
S.Unlock;
declare
TR, SR : SDL.Video.Rectangles.Rectangle := (X => 0,
Y => 0,
Width => Sprite.Image'Length (2),
Height => Sprite.Image'Length (1));
begin
TR.X := 20;
TR.Y := 20;
S.Blit (TR,
Sprite.S,
SR);
end;
end Render;
Window_Surface : SDL.Video.Surfaces.Surface;
Event : SDL.Events.Events.Events;
Finished : Boolean := False;
Loop_Start_Time_Goal : Ada.Real_Time.Time;
Frame_Duration : constant Ada.Real_Time.Time_Span :=
Ada.Real_Time.Microseconds (16_667);
-- 60 Hz refresh rate (set to anything you like)
use type SDL.Events.Keyboards.Key_Codes;
begin
SDL.Video.Surfaces.Makers.Create (Self => S,
Size => (640, 640),
BPP => Pixel_Depth,
Red_Mask => 0,
Blue_Mask => 0,
Green_Mask => 0,
Alpha_Mask => 0); -- a surface with known pixel depth
Make_False_Colour;
Render;
Window_Surface := W.Get_Surface;
Window_Surface.Blit (S);
W.Update_Surface;
-- Set next frame delay target using monotonic clock time
Loop_Start_Time_Goal := Ada.Real_Time.Clock;
loop
-- Limit event loop to 60 Hz using realtime "delay until"
Loop_Start_Time_Goal := Loop_Start_Time_Goal + Frame_Duration;
delay until Loop_Start_Time_Goal;
while SDL.Events.Events.Poll (Event) loop
case Event.Common.Event_Type is
when SDL.Events.Quit =>
Finished := True;
when SDL.Events.Keyboards.Key_Down =>
if Event.Keyboard.Key_Sym.Key_Code = SDL.Events.Keyboards.Code_Escape then
Finished := True;
end if;
when SDL.Events.Mice.Motion =>
Cursor := (X => Event.Mouse_Motion.X, Y => Event.Mouse_Motion.Y);
Render;
Window_Surface := W.Get_Surface;
Window_Surface.Blit (S);
W.Update_Surface;
when others =>
null;
end case;
end loop;
exit when Finished;
end loop;
end;
W.Finalize;
SDL.Finalise;
end if;
end Surface_Direct_Access;
|