File : simulation_state.adb
-- A version of the game Asteroids in Ada using OpenGL.
-- COL Gene Ressler.
--
-- This package is an abstraction of the state of the world, which
5 -- includes a clock, the space ship, rocks, bullets, and explosions.
-- Changes in the world are simulated whenever the Advance_Clock is
-- called with a new clock value. These changes are based on
-- Newtonian physics that describe how masses move in an inertial
-- reference frame. Advance_Clock is called by the GUI to cause the
10 -- simulation to proceed in real time. Other changes are simulated by
-- calls corresponding to spaceship controls: firing the main engine,
-- thrusters that spin the ship left or right, and the trigger that
-- fires bullets.
15 with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;
with Bag;
package body Simulation_State is
20
-- Instantiate floating point math functions for GlFloats.
package GlFloat_Math is
new Ada.Numerics.Generic_Elementary_Functions(GlFloat);
use GlFloat_Math;
25
-- Wrap a single coordinate back into the universe if it is too big
-- or too small.
procedure Wrap(Value : in out GlFloat;
Circumference : in GlFloat) is
30 begin
while Value < 0.0 loop
Value := Value + Circumference;
end loop;
while Value >= Circumference loop
35 Value := Value - Circumference;
end loop;
end Wrap;
-- A generator to produce random values in [0.0 .. 1.0].
40 Value : Generator;
-- Return a random float in [0.0 .. 1.0].
function Random_Zero_To_One return GlFloat is
begin
45 return GlFloat(Random(Value));
end Random_Zero_To_One;
-------------------------------------------------------------------
-- Space Ship
50 -------------------------------------------------------------------
-- State of the space ship.
type Space_Ship_State_Type is
record
55 X : GlFloat := Universe_X_Circumference/2.0; -- Position (screen units)
Y : GlFloat := Universe_Y_Circumference/2.0;
V_X, V_Y : GlFloat := 0.0; -- Velocity (screen units/sec)
Theta : GlFloat := 90.0; -- Direction nose is pointing (degrees)
D_Theta_D_T : GlFloat := 0.0; -- Rate at which theta is changing (degrees/sec)
60 Acceleration : GlFloat := 0.0; -- Current acceleration in direction theta.
Alive : Boolean := True; -- Set false after ship blows up.
end record;
-- Reset a space ship state to default values.
65 procedure Reset(Space_Ship_State : in out Space_Ship_State_Type) is
Default : Space_Ship_State_Type;
begin
Space_Ship_State := Default;
end Reset;
70
-- Implement Newton's motion equations over a time step where
-- velocity and acceleration are assumed constant (Euler's method).
procedure Advance_Space_Ship(Space_Ship_State : in out Space_Ship_State_Type;
Delta_T : in GlFloat) is
75 Drag_Coefficient : constant GlFloat := 0.3;
Drag_Acceleration_X, Drag_Acceleration_Y : GlFloat;
begin
-- Adjust direction that the ship is pointing using spin rate.
Space_Ship_State.Theta := Space_Ship_State.Theta + Space_Ship_State.D_Theta_D_T * Delta_T;
80
-- Calculate acceleration due to drag of random gas particles:
-- magnitude is proportional to space ship speed and direction
-- opposite to velocity of movement.
Drag_Acceleration_X := -Space_Ship_State.V_X * Drag_Coefficient;
85 Drag_Acceleration_Y := -Space_Ship_State.V_Y * Drag_Coefficient;
-- Adjust velocity based on acceleration.
Space_Ship_State.V_X := Space_Ship_State.V_X
+ (Space_Ship_State.Acceleration * Cos(Space_Ship_State.Theta, 360.0) + Drag_Acceleration_X) * Delta_T;
90
Space_Ship_State.V_Y := Space_Ship_State.V_Y
+ (Space_Ship_State.Acceleration * Sin(Space_Ship_State.Theta, 360.0) + Drag_Acceleration_Y) * Delta_T;
-- Adjust position based on velocity.
95 Space_Ship_State.X := Space_Ship_State.X + Space_Ship_State.V_X * Delta_T;
Space_Ship_State.Y := Space_Ship_State.Y + Space_Ship_State.V_Y * Delta_T;
-- Wrap back into universe if we've gone off the edge.
Wrap(Space_Ship_State.X, Universe_X_Circumference);
100 Wrap(Space_Ship_State.Y, Universe_Y_Circumference);
end Advance_Space_Ship;
-------------------------------------------------------------------
-- Bullets
105 -------------------------------------------------------------------
-- A bullet is a position, velociy, and time to expire.
type Bullet_Type is
record
110 X, Y : GlFloat := 0.0;
V_X, V_Y : GlFloat := 0.0;
Expiration : GlFloat := 0.0;
end record;
115 package Bullet_Bag is new Bag(Bullet_Type);
use Bullet_Bag;
-- Bullet state is just a bag of bullets.
type Bullet_State_Type is
120 record
Bullets : Bullet_Bag.Bag_Type;
end record;
-- Reset bullet state to default, which is no bullets at all.
125 procedure Reset(Bullet_State : in out Bullet_State_Type) is
begin
Clear(Bullet_State.Bullets);
end Reset;
130 -- Implement Newton's motion equations over a time step where
-- velocity and acceleration are assumed constant (Euler's method).
-- Also delete bullets that have reached their expiration time.
procedure Advance_Bullets(Bullet_State : in out Bullet_State_Type;
New_Clock : in GlFloat;
135 Delta_T : in GlFloat) is
Bullet : Bullet_Type;
Index : Natural := 0;
begin
loop -- Loop through all bullets.
140 Get_Next(Bullet_State.Bullets, Index, Bullet); -- Get next one.
exit when Index = 0; -- Exit when all bullets have been seen.
if New_Clock > Bullet.Expiration then
Delete(Bullet_State.Bullets, Index); -- Delete expired bullet.
else
145 Bullet.X := Bullet.X + Bullet.V_X * Delta_T; -- Compute new position using velocity.
Bullet.Y := Bullet.Y + Bullet.V_Y * Delta_T;
Wrap(Bullet.X, Universe_X_Circumference); -- Ensure bullet remains within universe.
Wrap(Bullet.Y, Universe_Y_Circumference);
Set(Bullet_State.Bullets, Index, Bullet); -- Update state
150 end if;
end loop;
end Advance_Bullets;
-------------------------------------------------------------------
155 -- Rocks
-------------------------------------------------------------------
-- A rock is a radius (rocks are approximately circular), a
-- position, and a velocity.
160 type Rock_Type is
record
Radius : GlFloat := 0.0;
X, Y : GlFloat := 0.0;
V_X, V_Y : GlFloat := 0.0;
165 end record;
package Rock_Bag is new Bag(Rock_Type);
use Rock_Bag;
170 -- Initially there are this many seconds between appearances of new
-- rocks in the simulation.
Initial_Interval_Between_Rocks : constant GlFloat := 20.0;
-- A rock state is a bag of rocks, the interval between appearance
175 -- of the last rock and the next one (this steadily decreases as
-- the simulation proceeds), and the clock time at which the next
-- rock is scheduled to appear.
type Rock_State_Type is
record
180 Rocks : Rock_Bag.Bag_Type;
Interval_Between_Rocks : GlFloat := Initial_Interval_Between_Rocks;
Next_Rock_Clock : GlFloat := 0.0;
end record;
185 -- Reset rocks to their initial state. The bag of rocks is empty, the
-- interval between rocks is reset to its initial, largest value, and
-- the next rock is scheduled for time zero.
procedure Reset(Rock_State : in out Rock_State_Type) is
begin
190 Clear(Rock_State.Rocks);
Rock_State.Interval_Between_Rocks := Initial_Interval_Between_Rocks;
Rock_State.Next_Rock_Clock := 0.0;
end Reset;
195 -- Return a rock at the given position with given size, but with
-- randomly selected velocity.
function Random_Rock(Radius, X, Y : GlFloat) return Rock_Type is
Speed : GlFloat := 100.0 / (Radius / 100.0);
begin
200 return(Radius => Radius,
X => X, Y => Y,
V_X => (Random_Zero_To_One - 0.5) * Speed,
V_Y => (Random_Zero_To_One - 0.5) * Speed);
end Random_Rock;
205
-- Return a rock with the given size whose position is selected
-- randomly from the bottom or left edge of the universe.
function Random_Rock(Radius : in GlFloat) return Rock_Type is
Edge_Distance : GlFloat;
210 begin
-- Compute a random part of the sum of bottom and left edges.
Edge_Distance := Random_Zero_To_One * (Universe_X_Circumference + Universe_Y_Circumference);
if Edge_Distance < Universe_X_Circumference then
215 -- If the distance is less than the length of the bottom edge, position the rock there.
return Random_Rock(Radius, Edge_Distance, 0.0);
else
-- Otherwise use the excess to position the rock on the left edge.
return Random_Rock(Radius, 0.0, Edge_Distance - Universe_X_Circumference);
220 end if;
end Random_Rock;
-- Implement Newton's motion equations over a time step where
-- velocity and acceleration are assumed constant (Euler's method).
225 -- Also new rocks at the appropriate time.
procedure Advance_Rocks(Rock_State : in out Rock_State_Type;
New_Clock : in GlFloat;
Delta_T : in GlFloat) is
Rock : Rock_Type;
230 Index : Natural := 0;
begin
loop
Get_Next(Rock_State.Rocks, Index, Rock);
exit when Index = 0;
235 Rock.X := Rock.X + Rock.V_X * Delta_T; -- Update rock position using velocity.
Rock.Y := Rock.Y + Rock.V_Y * Delta_T;
Wrap(Rock.X, Universe_X_Circumference); -- Ensure rock remains within universe.
Wrap(Rock.Y, Universe_Y_Circumference);
Set(Rock_State.Rocks, Index, Rock);
240 end loop;
-- If it's time for a new rock.
if New_Clock >= Rock_State.Next_Rock_Clock then
245 -- Add the new rock to the bag in the state.
Add(Rock_State.Rocks, Random_Rock(80.0));
-- Schedule the next one.
Rock_State.Next_Rock_Clock := New_Clock + Rock_State.Interval_Between_Rocks;
250
-- Decrease interval so rocks appear ever more frequently.
Rock_State.Interval_Between_Rocks := Rock_State.Interval_Between_Rocks * 0.98;
end if;
end Advance_Rocks;
255
-- Convert a rock radius into the score that it's worth when hit with a bullet.
function Radius_To_Score(Radius : in GlFloat) return Natural is
begin
if Radius < 30.0 then
260 return 45;
elsif Radius < 50.0 then
return 30;
else
return 10;
265 end if;
end Radius_To_Score;
-------------------------------------------------------------------
-- Explosion
270 -------------------------------------------------------------------
-- An explosion particle has position and velocity.
type Particle_Type is
record
275 X, Y : GlFloat;
V_X, V_Y : GlFloat;
end record;
type Particle_List_Type is array(Particle_Geometry_List_Type'Range) of Particle_Type;
280
-- An explosion is its particles, it's expiration time, and the
-- type of object involved.
type Explosion_Type is
record
285 Particles : Particle_List_Type;
Expiration : GlFloat;
Object : Object_Type;
end record;
290 package Explosion_Bag is new Bag(Explosion_Type);
use Explosion_Bag;
-- Return a random explosion for the given time and place, and of
-- the given object type.
295 function Random_Explosion(Clock, X, Y : in GlFloat;
Object : in Object_Type) return Explosion_Type is
begin
return (Particles => (others => (X => X, Y => Y,
V_X => 100.0 * Random_Zero_To_One,
300 V_Y => 100.0 * Random_Zero_To_One)),
Expiration => Clock + 3.0,
Object => Object);
end Random_Explosion;
305 -- Explosion state is just a bag of explosions.
type Explosion_State_Type is
record
Explosions : Explosion_Bag.Bag_Type;
end record;
310
-- Reset explostions to initial state, i.e. no explosions at all.
procedure Reset(Explosion_State : in out Explosion_State_Type) is
begin
Clear(Explosion_State.Explosions);
315 end Reset;
-- Implement Newton's motion equations over a time step where
-- velocity and acceleration are assumed constant (Euler's method).
-- Also delete explosions that have expired.
320 procedure Advance_Explosions(Explosion_State : in out Explosion_State_Type;
New_Clock : in GlFloat;
Delta_T : in GlFloat) is
Explosion : Explosion_Type;
Index : Natural := 0;
325 begin
loop -- Loop through all explosions.
Get_Next(Explosion_State.Explosions, Index, Explosion);
exit when Index = 0; -- We're done when all explosions have been processed.
if New_Clock > Explosion.Expiration then
330 Delete(Explosion_State.Explosions, Index); -- Delete expired explosions.
else
for I in Explosion.Particles'Range loop -- Loop through particles in the explosion.
declare
P : Particle_Type renames Explosion.Particles(I); -- Rename the current particle for readability.
335 begin
P.X := P.X + P.V_X * Delta_T; -- Update particle location using velocity.
P.Y := P.Y + P.V_Y * Delta_T;
Wrap(P.X, Universe_X_Circumference); -- Ensure particles remain in the universe.
Wrap(P.Y, Universe_Y_Circumference);
340 end;
end loop;
Set(Explosion_State.Explosions, Index, Explosion); -- Update the explosion state.
end if;
end loop;
345 end Advance_Explosions;
-------------------------------------------------------------------
-- Collisions
-------------------------------------------------------------------
350
-- Return true iff two circular objects with given positions and
-- radii have collided. We'll assume that ship, rocks, and bullets
-- are all circular. Note we avoid a Sqrt, which is relatively slow,
-- by squaring the whole distance check relation.
355 function Collision(X1, Y1, R1,
X2, Y2, R2 : in GlFloat) return Boolean is
begin
-- Below is same as:
-- Sqrt((X2 - X1) ** 2 + (Y2 - Y1) ** 2) < R1 + R2;
360 -- but faster.
return (X2 - X1) ** 2 + (Y2 - Y1) ** 2 < (R1 + R2) ** 2;
end Collision;
-- Check for collisions between bullets and rocks and between rocks
365 -- and the space ship. Where a collision is detected, simulate
-- what should happen in each case.
procedure Cause_Collisions (Clock : in GlFloat;
Space_Ship_State : in out Space_Ship_State_Type;
Bullet_State : in out Bullet_State_Type;
370 Rock_State : in out Rock_State_Type;
Explosion_State : in out Explosion_State_Type;
Score : in out Natural) is
Rock_Index, Bullet_Index : Natural := 0;
Rock : Rock_Type;
375 Bullet : Bullet_Type;
begin
loop -- through rocks
Get_Next(Rock_State.Rocks, Rock_Index, Rock);
380 exit when Rock_Index = 0;
-- Check for and handle rock/space ship collisions.
if Space_Ship_State.Alive and then
Collision(Rock.X, Rock.Y, Rock.Radius,
385 Space_Ship_State.X, Space_Ship_State.Y, Space_Ship_Gun_X / 3.0) then
-- Kill the ship.
Space_Ship_State.Alive := False;
390 -- Create the resulting explosion.
Add(Explosion_State.Explosions,
Random_Explosion(Clock, Space_Ship_State.X, Space_Ship_State.Y, Space_Ship_Object));
end if;
395 Bullet_Index := 0;
loop -- through bullets
Get_Next(Bullet_State.Bullets, Bullet_Index, Bullet);
exit when Bullet_Index = 0;
400
-- Check for and handle rock/bullet collisions.
if Collision(Rock.X, Rock.Y, Rock.Radius,
Bullet.X, Bullet.Y, 0.0) then
405 -- Chalk up the kill.
Score := Score + Radius_To_Score(Rock.Radius);
-- Kill both the bullet and the rock by deleting them from state.
Delete(Bullet_State.Bullets, Bullet_Index);
410 Delete(Rock_State.Rocks, Rock_Index);
-- Check the size of the deleted rock.
if Rock.Radius > 30.0 then
-- For big rocks, create several smaller ones.
415 for Count in 1..3 loop
Add(Rock_State.Rocks, Random_Rock(Rock.Radius / 2.0, Rock.X, Rock.Y));
end loop;
else
-- For small rocks, just create an explosion.
420 Add(Explosion_State.Explosions, Random_Explosion(Clock, Rock.X, Rock.Y, Rock_Object));
end if;
end if;
end loop;
end loop;
425 end Cause_Collisions;
-------------------------------------------------------------------
-- The Simulation State
-------------------------------------------------------------------
430
-- The overall state is a union of space ship, bullet, rock and
-- explosion states, plus the simulation clock.
type Simulation_State_Type is
record
435 Space_Ship_State : Space_Ship_State_Type;
Bullet_State : Bullet_State_Type;
Rock_State : Rock_State_Type;
Explosion_State : Explosion_State_Type;
Score : Natural := 0;
440 High_Score : Natural := 0;
Clock : GlFloat := 0.0;
end record;
-- This package contains its own, single, simulation state that all
445 -- the procedures in the specification implicitly refer to.
State : Simulation_State_Type;
-- These are the procedures in the specification. See
-- simulation_state.ads for descriptions of what they do.
450 procedure Fire_Main_Engine(Is_Firing : in Boolean) is
begin
if not State.Space_Ship_State.Alive then
return;
end if;
455 if Is_Firing then
State.Space_Ship_State.Acceleration := Universe_X_Circumference/4.0; -- 1/4 universe / sec^2
else
State.Space_Ship_State.Acceleration := 0.0;
end if;
460 end Fire_Main_Engine;
procedure Fire_Thrusters(Firing_State : Firing_State_Type) is
Spin_Rate : constant GlFloat := 360.0; -- 1 spin per second.
begin
465 if not State.Space_Ship_State.Alive then
return;
end if;
case Firing_State is
when Spin_Left | Cancel_Spin_Right =>
470 State.Space_Ship_State.D_Theta_D_T := State.Space_Ship_State.D_Theta_D_T + Spin_Rate;
when Spin_Right | Cancel_Spin_Left =>
State.Space_Ship_State.D_Theta_D_T := State.Space_Ship_State.D_Theta_D_T - Spin_Rate;
end case;
end Fire_Thrusters;
475
procedure Fire_Bullet is
V_Bullet : constant GlFloat := 300.0; -- units/second
C : constant GlFloat := Cos(State.Space_Ship_State.Theta, 360.0);
S : constant GlFloat := Sin(State.Space_Ship_State.Theta, 360.0);
480 begin
if not State.Space_Ship_State.Alive then
return;
end if;
Add(State.Bullet_State.Bullets,
485 (X => State.Space_Ship_State.X + Space_Ship_Gun_X * C,
Y => State.Space_Ship_State.Y + Space_Ship_Gun_X * S,
V_X => State.Space_Ship_State.V_X + V_Bullet * C,
V_Y => State.Space_Ship_State.V_Y + V_Bullet * S,
Expiration => State.Clock + 1.5)); -- bullets live this long!
490 end Fire_Bullet;
procedure Get_Space_Ship_Geometry(Alive : out Boolean;
X, Y, Theta : out GlFloat;
Main_Engine_Firing : out Boolean) is
495 begin
Alive := State.Space_Ship_State.Alive;
if Alive then
X := State.Space_Ship_State.X;
Y := State.Space_Ship_State.Y;
500 Theta := State.Space_Ship_State.Theta;
Main_Engine_Firing := State.Space_Ship_State.Acceleration /= 0.0;
end if;
end Get_Space_Ship_Geometry;
505 procedure Get_Bullet_Geometry(X, Y : out GlFloat;
Index : in out Natural) is
Bullet : Bullet_Type;
begin
Get_Next(State.Bullet_State.Bullets, Index, Bullet);
510 X := Bullet.X;
Y := Bullet.Y;
end Get_Bullet_Geometry;
procedure Get_Rock_Geometry(X, Y, Radius : out GlFloat;
515 Index : in out Natural) is
Rock : Rock_Type;
begin
Get_Next(State.Rock_State.Rocks, Index, Rock);
X := Rock.X;
520 Y := Rock.Y;
Radius := Rock.Radius;
end Get_Rock_Geometry;
procedure Get_Explosion_Geometry(Explosion_Geometry : out Explosion_Geometry_Type;
525 Index : in out natural) is
Explosion : Explosion_Type;
begin
Get_Next(State.Explosion_State.Explosions, Index, Explosion);
for I in Explosion.Particles'Range loop
530 Explosion_Geometry.Particles(I).X := Explosion.Particles(I).X;
Explosion_Geometry.Particles(I).Y := Explosion.Particles(I).Y;
end loop;
Explosion_Geometry.Object := Explosion.Object;
end Get_Explosion_Geometry;
535
procedure Get_Score(Score, High_Score : out Natural) is
begin
Score := State.Score;
High_Score := State.High_Score;
540 end Get_Score;
procedure Advance_Clock(New_Clock : in GlFloat) is
Delta_T : GlFloat := New_Clock - State.Clock;
begin
545 Advance_Space_Ship(State.Space_Ship_State, Delta_T);
Advance_Bullets(State.Bullet_State, New_Clock, Delta_T);
Advance_Rocks(State.Rock_State, New_Clock, Delta_T);
Advance_Explosions(State.Explosion_State, New_Clock, Delta_T);
Cause_Collisions(New_Clock,
550 State.Space_Ship_State,
State.Bullet_State,
State.Rock_State,
State.Explosion_State,
State.Score);
555 State.High_Score := Natural'Max(State.Score, State.High_Score);
State.Clock := New_Clock;
end Advance_Clock;
procedure Reset is
560 begin
Reset(State.Space_Ship_State);
Reset(State.Bullet_State);
Reset(State.Rock_State);
Reset(State.Explosion_State);
565 State.Score := 0;
-- Do not reset high score.
end Reset;
end Simulation_State;