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 | -----------------------------------------------------------------------
-- Ada Labs --
-- --
-- Copyright (C) 2008-2023, AdaCore --
-- --
-- This program is free software: you can redistribute it and/or --
-- modify it under the terms of the GNU General Public License as --
-- published by the Free Software Foundation, either version 3 of --
-- the License, or (at your option) any later version. --
-- --
-- This program is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --
-- GNU General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this program. If not, see --
-- <https://www.gnu.org/licenses/>. --
-----------------------------------------------------------------------
--$ line answer
with Ada.Real_Time; use Ada.Real_Time;
with Float_Maths; use Float_Maths;
package body Solar_System is
procedure Init_Body
(B : Bodies_Enum_T;
--$ line question
Bodies : in out Bodies_Array_T;
Radius : Float;
Color : RGBA_T;
Distance : Float;
Angle : Float;
Speed : Float;
Turns_Around : Bodies_Enum_T;
--$ line answer
Tail : Boolean := False;
Visible : Boolean := True)
is
begin
--$ line question
Bodies (B) :=
--$ line answer
Bodies (B).Set_Data (
(Distance => Distance,
Speed => Speed,
Angle => Angle,
Turns_Around => Turns_Around,
Visible => Visible,
Color => Color,
Radius => Radius,
--$ line answer
With_Tail => Tail,
--$ line question
others => <>);
--$ line answer
others => <>));
end Init_Body;
-- compute the X coordinate:
-- x of the reference + distance * cos(angle)
function Compute_X
(Body_To_Move : Body_T;
Turns_Around : Body_T) return Float;
-- compute the Y coordinate:
-- y of the reference + distance * sin(angle)
function Compute_Y
(Body_To_Move : Body_T;
Turns_Around : Body_T) return Float;
function Compute_X
(Body_To_Move : Body_T;
Turns_Around : Body_T) return Float is
begin
--$ line question
return Turns_Around.X
--$ line answer
return Turns_Around.Pos.X
+ Body_To_Move.Distance * Cos (Body_To_Move.Angle);
end Compute_X;
function Compute_Y
(Body_To_Move : Body_T;
Turns_Around : Body_T) return Float is
begin
--$ line question
return Turns_Around.Y
--$ line answer
return Turns_Around.Pos.Y
+ Body_To_Move.Distance * Sin (Body_To_Move.Angle);
end Compute_Y;
procedure Move (Body_To_Move : in out Body_T; Turns_Around : Body_T) is
begin
--$ line question
Body_To_Move.X :=
--$ line answer
Body_To_Move.Pos.X :=
Compute_X (Body_To_Move, Turns_Around);
--$ line question
Body_To_Move.Y :=
--$ line answer
Body_To_Move.Pos.Y :=
Compute_Y (Body_To_Move, Turns_Around);
Body_To_Move.Angle := Body_To_Move.Angle + Body_To_Move.Speed;
--$ begin answer
if Body_To_Move.With_Tail then
for I in Body_To_Move.Tail'First .. Body_To_Move.Tail'Last - 1 loop
Body_To_Move.Tail (I) := Body_To_Move.Tail (I + 1);
end loop;
Body_To_Move.Tail (Tail_T'Last) := Body_To_Move.Pos;
end if;
--$ end answer
end Move;
--$ begin question
procedure Move_All (Bodies : in out Bodies_Array_T) is
begin
for B of Bodies loop
Move (B, Bodies (B.Turns_Around));
end loop;
end Move_All;
--$ end question
--$ begin answer
-------------------------
-- Protected and Tasks --
-------------------------
protected body Body_P is
function Get_Data return Body_T is
begin
return Data;
end Get_Data;
procedure Set_Data (B : Body_T) is
begin
Data := B;
end Set_Data;
end Body_P;
protected body Dispatch_Tasks is
procedure Get_Next_Body (B : out Bodies_Enum_T) is
begin
B := Current;
if Current /= Bodies_Enum_T'Last then
Current := Bodies_Enum_T'Succ (Current);
end if;
end Get_Next_Body;
end Dispatch_Tasks;
-- single writer, multiple reader, using an atomic
Run : Boolean := True
with Atomic;
task body T_Move_Body is
-- declare a variable Now of type Time to record current time
Now : Time;
-- declare a constant Period of 40 milliseconds of type Time_Span
-- defining the loop period
Period : constant Time_Span := Milliseconds (20);
Current : Body_T;
Turns_Around : Body_T;
B : Bodies_Enum_T;
begin
Dispatch_Tasks.Get_Next_Body (B);
while Run loop
Now := Clock;
Current := Bodies (B).Get_Data;
Turns_Around := Bodies (Current.Turns_Around).Get_Data;
Move (Current, Turns_Around);
Bodies (B).Set_Data (Current);
delay until Now + Period;
end loop;
end T_Move_Body;
procedure Terminate_Tasks is
begin
Run := False;
-- Wait for tasks to terminate
for T of Tasks loop
while not T'Terminated loop
delay 0.1;
end loop;
end loop;
end Terminate_Tasks;
--$ end answer
end Solar_System;
|