File : graphic_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 graphical user
5 -- interface of the simulation. It communicates with the
-- Simulation_State module, both providing information to it about
-- user interaction and receiving information about the simulation
-- state in order to draw the game screen.
--
10 -- It performs the following functions:
--
-- 1. Uses the GLUT Idle callback to continuously poll the GLUT real
-- time clock and send "advance clock" messages to the simulation
-- state module so that the simulator knows what time it is. After
15 -- each clock advance, it also posts a message to GLUT to redraw the
-- display.
--
-- 2. Responds to user keystrokes, usually be sending information to
-- the simulation state.
20 --
-- 3. Continuously updates the display by responding to GLUT Display
-- callbacks. It queries the simulation state for current information
-- to do this. Of course, display callbacks occur because the Idle
-- callback procedure requests display updates whenever the clock is
25 -- advanced.
--
-- This package could be split into separate packages for Clock,
-- Display, Keyboard, and Initialization but I've left it all one for
-- easier viewing. the natural divisions are marked with big comments.
30
with Ada.Characters.Latin_1, Ada.Integer_Text_Io, Ada.Strings, Ada.Strings.Fixed, Win32.Gl, Win32.Glut;
use Ada.Characters.Latin_1, Ada.Integer_Text_Io, Ada.Strings, Ada.Strings.Fixed, Win32.Gl, Win32.Glut;
with Interfaces.C; -- For type "Unsigned"
with Simulation_State;
35
package body Graphic_State is
-------------------------------------------------------------------
-- Clock
40 -------------------------------------------------------------------
-- Return the current GLUT clock in seconds since the program
-- started. GLUT clock is in milliseconds, so multiply by 1/1000.
function Current_Clock return GlFloat is
45 begin
return GlFloat(GlutGet(GLUT_ELAPSED_TIME)) * 0.001;
end Current_Clock;
-- Last GLUT clock time to which the simulation time was advanced.
50 Last_Advance_Clock : GlFloat := -1.0;
-- Send a message to the simulation state to update its clock to
-- the current GLUT clock value. Actually updates only if GLUT
-- time has is a given delta larger than the last time the
55 -- simulation clock was advanced. Returns a flag saying whether an
-- update was actually performed.
procedure Advance_Clock_To_Current(Min_Delta_T : in GlFloat;
Did_Update : out Boolean) is
Clock : GlFloat := Current_Clock;
60 begin
if Clock - Last_Advance_Clock > Min_Delta_T then
Simulation_State.Advance_Clock(Clock);
Last_Advance_Clock := Clock;
Did_Update := True;
65 else
Did_Update := False;
end if;
end Advance_Clock_To_Current;
70 -- Same as above, but always update right now.
procedure Advance_Clock_To_Current is
Clock : GlFloat := Current_Clock;
begin
Simulation_State.Advance_Clock(Clock);
75 Last_Advance_Clock := Clock;
end Advance_Clock_To_Current;
-------------------------------------------------------------------
-- Display
80 -------------------------------------------------------------------
-- Return width in world coordinates of a given string of given height.
function Stroke_Font_String_Width(Height : in GlFloat;
Str : in String) return GlFloat is
85 Scale : constant GlFloat := Height / 152.38; -- Max char height.
begin
return Scale * GlFloat(GlutStrokeLength(GLUT_STROKE_MONO_ROMAN, Str));
end Stroke_Font_String_Width;
90 type Horizontal_Justification_Type is (Left, Center, Right);
-- Draw a string at the given position with given character height.
procedure Draw_Stroke_Font_String(X, Y, Height : in GlFloat;
Justification : in Horizontal_Justification_Type;
95 Str : in String) is
Scale : constant GlFloat := Height / 152.38; -- Max char height.
X0 : GlFloat;
begin
case Justification is
100 when Left =>
X0 := X;
when Center =>
X0 := X - Stroke_Font_String_Width(Height, Str) / 2.0;
when Right =>
105 X0 := X - Stroke_Font_String_Width(Height, Str);
end case;
GlPushMatrix;
GlTranslateF(X0, Y, 0.0);
GlScaleF(Scale, Scale, 1.0);
110 for I in Str'Range loop
GlutStrokeCharacter(GLUT_STROKE_MONO_ROMAN, Character'Pos(Str(I)));
end loop;
GlPopMatrix;
end Draw_Stroke_Font_String;
115
-- Declare types for unconstrained arrays of 2d vertices.
type Vertex_Type is
record
X, Y : GlFloat;
120 end record;
type Vertex_Array_Type is array(Integer range <>) of Vertex_Type;
-- Send contents of a 2d array of vertices to OpenGL for drawing
-- as a series of line segments.
125 procedure Draw_Shape(Vertices : in Vertex_Array_Type) is
begin
GlBegin(GL_LINE_LOOP);
for Vertex_Index in Vertices'Range loop
GlVertex2F(Vertices(Vertex_Index).X, Vertices(Vertex_Index).Y);
130 end loop;
GlEnd;
end Draw_Shape;
-- Vertices for the spaceship.
135 Space_Ship_Vertices : constant Vertex_Array_Type :=
(( 20.0, 0.0),
(-10.0, -10.0),
(-5.0, 0.0),
(-10.0, 10.0),
140 ( 20.0, 0.0));
-- Vertices for the flame visible when the ship's engine is firing.
Engine_Flame_Vertices : constant Vertex_Array_Type :=
((-7.5, -5.0),
145 (-14.0, -3.0),
(-8.0, -0.5),
(-18.0, 0.0),
(-8.0 , 0.5),
(-14.0, 3.0),
150 (-7.5, 5.0));
-- Vertices for the rocks.
R_Rock : constant GlFloat := 4.0;
Rock_Vertices : constant Vertex_Array_Type :=
155 ((-2.0/R_Rock, -4.0/R_Rock),
( 1.0/R_Rock, -3.0/R_Rock),
( 3.0/R_Rock, -1.0/R_Rock),
( 2.0/R_Rock, 0.0/R_Rock),
( 4.0/R_Rock, 1.0/R_Rock),
160 ( 2.0/R_Rock, 4.0/R_Rock),
( 0.0/R_Rock, 3.0/R_Rock),
(-2.0/R_Rock, 4.0/R_Rock),
(-3.0/R_Rock, 1.0/R_Rock),
(-4.0/R_Rock, -1.0/R_Rock),
165 (-2.0/R_Rock, -2.0/R_Rock));
-- GLUT Display callback is called whenever the screen needs to be
-- drawn.
procedure Display is
170 Index, Score, High_Score : Natural;
X, Y, Theta, Radius : GlFloat;
Alive, Main_Engine_Firing : Boolean;
Explosion_Geometry : Simulation_State.Explosion_Geometry_Type;
use type Simulation_State.Object_Type;
175 begin
-- Clear the screen buffer. Due to double buffering, this clear
-- occurs in a RAM buffer that is invisible to the user, as does
-- all the drawing that follows.
180 GlClear(GL_COLOR_BUFFER_BIT);
-- Draw the spaceship.
Simulation_State.Get_Space_Ship_Geometry(Alive, X, Y, Theta, Main_Engine_Firing);
if Alive then
185 GlPushMatrix; -- Save the current transformation.
GlTranslateF(X, Y, 0.0); -- Translate to the current location.
GlRotateF(Theta, 0.0, 0.0, 1.0); -- Rotate to the current spin angle.
GlColor3f (1.0, 1.0, 0.0); -- Change colors to yellow (red+green).
Draw_Shape(Space_Ship_Vertices); -- Send the vertices to OpenGL.
190
-- Optionally add the flame if the engine is firing.
if Main_Engine_Firing then
GlColor3F(1.0, 0.0, 0.0); -- Change color to red.
Draw_Shape(Engine_Flame_Vertices); -- Send vertices to OpenGL.
195 end if;
GlPopMatrix; -- Restore the current transformation.
end if;
-- Draw the rocks.
200 Index := 0;
GlColor3F(0.8, 0.8, 0.8); -- Change color to gray.
loop
Simulation_State.Get_Rock_Geometry(X, Y, Radius, Index);
exit when Index = 0;
205 GlPushMatrix; -- Save the current transformation.
GlTranslateF(X, Y, 0.0); -- Translate to the rock's location.
GlScaleF(Radius, Radius, 1.0); -- Scale to the correct size.
Draw_Shape(Rock_Vertices); -- Send vertices to OpenGL.
GlPopMatrix;
210 end loop;
-- Draw the bullets.
Index := 0;
GlColor3F(1.0, 0.0, 1.0); -- Change color to magenta (red+blue)
215 GlPointSize(3.0); -- Set the size of points.
GlBegin(GL_POINTS); -- Tell OpenGL to draw points.
loop
Simulation_State.Get_Bullet_Geometry(X, Y, Index);
exit when Index = 0;
220 GlVertex2F(X, Y); -- Send point to OpenGL.
end loop;
GlEnd; -- Done sending points.
-- Draw the particles of explosions.
225 Index := 0;
GlPointSize(3.0);
GlBegin(GL_POINTS);
loop
Simulation_State.Get_Explosion_Geometry(Explosion_Geometry, Index);
230 exit when Index = 0;
if Explosion_Geometry.Object = Simulation_State.Space_Ship_Object then
GlColor3F(1.0, 1.0, 0.0); -- Set space ship explosion color
else -- it's a rock
GlColor3F(1.0, 1.0, 1.0); -- Set rock explosion color
235 end if;
-- Send the particle vertices to OpenGL.
for I in Explosion_Geometry.Particles'Range loop
GlVertex2F(Explosion_Geometry.Particles(I).X, Explosion_Geometry.Particles(I).Y);
end loop;
240 end loop;
GlEnd;
-- Draw the score.
Simulation_State.Get_Score(Score, High_Score);
245 GlColor3F(1.0, 0.0, 1.0);
declare
subtype Score_String_Type is String(1..5);
Score_String, High_Score_String : Score_String_Type;
Height : constant GlFloat := 50.0;
250 Y : constant GlFloat := Simulation_State.Universe_Y_Circumference - 80.0;
X1 : constant GlFloat := 40.0;
X2 : constant GlFloat := Simulation_State.Universe_X_Circumference - X1;
begin
Put(Score_String, Score);
255 Draw_Stroke_Font_String(X1, Y, Height, Left, Trim(Score_String, Left));
Put(High_Score_String, High_Score);
Draw_Stroke_Font_String(X2, Y, Height, Right, High_Score_String);
end;
260 -- Tell OpenGL to instantly start using the RAM buffer where we
-- have been drawing to display on the screen. The previously
-- used RAM buffer is now invisible and ready for the next call
-- to Display.
GlutSwapBuffers;
265 end Display;
-------------------------------------------------------------------
-- Keyboard
-------------------------------------------------------------------
270
-- These are pretty self-explanatory. They are called by GLUT when
-- the respective types of events occur. Most of them send
-- information to the simulation that affect the space ship and
-- other elements of the simulated world.
275
-- Space bar: Fire a bullet.
-- R key: Reset the simulation to initial condition.
-- Esc or Q key: Quit.
procedure Normal_Key_Press(C_Key : in Interfaces.C.Unsigned_Char;
280 X, Y : in Integer) is
Key : Character := Character'Val(C_Key);
Quit : exception;
begin
Advance_Clock_To_Current;
285 case Key is
when ' ' =>
Simulation_State.Fire_Bullet;
when 'r' | 'R' =>
Simulation_State.Reset;
290 when ESC | 'q' | 'Q' =>
raise Quit;
when others =>
null;
end case;
295 end Normal_Key_Press;
-- Left/Right arrows spin the space ship.
-- Up key fires the main engine.
procedure Special_Key_Press(Key, X, Y : in Integer) is
300 begin
Advance_Clock_To_Current;
case Key is
when GLUT_KEY_UP =>
Simulation_State.Fire_Main_Engine(True);
305 when GLUT_KEY_LEFT =>
Simulation_State.Fire_Thrusters(Simulation_State.Spin_Left);
when GLUT_KEY_RIGHT =>
Simulation_State.Fire_Thrusters(Simulation_State.Spin_Right);
when others =>
310 null;
end case;
end Special_Key_Press;
-- Releasing the arrow keys require the changes caused by pressing
315 -- the keys to be stopped:
--
-- Left/Right arrows cancel spinning the space ship.
-- Up key stops firing the main engine.
procedure Special_Key_Release(Key, X, Y : in Integer) is
320 begin
Advance_Clock_To_Current;
case Key is
when GLUT_KEY_UP =>
Simulation_State.Fire_Main_Engine(False);
325 when GLUT_KEY_LEFT =>
Simulation_State.Fire_Thrusters(Simulation_State.Cancel_Spin_Left);
when GLUT_KEY_RIGHT =>
Simulation_State.Fire_Thrusters(Simulation_State.Cancel_Spin_Right);
when others =>
330 null;
end case;
end Special_Key_Release;
-- Idle is called by GLUT when there is no other work that needs to
335 -- be done. We use this to repeatedly update the clock in the
-- simulation state using the GLUT real time clock. Therefore the
-- simulation proceeds in (roughly) real time.
procedure Idle is
Update_Interval : constant := 1.0 / 30.0;
340 Did_Update : Boolean;
begin
Advance_Clock_To_Current(Update_Interval, Did_Update);
if Did_Update then
GlutPostWindowRedisplay(GlutGetWindow); -- Tell GLUT that Display needs to be redrawn!
345 else
delay Update_Interval / 2.0; -- Yield the processor so we don't hog all cycles!
end if;
end Idle;
350 -------------------------------------------------------------------
-- Initialization
-------------------------------------------------------------------
procedure Initialize is
355 Window_Handle : Integer;
begin
-- Set up the display window.
Window_Handle := GlutCreateWindow("CS473 Asteroids");
GlutReshapeWindow(Integer(Simulation_State.Universe_X_Circumference),
360 Integer(Simulation_State.Universe_Y_Circumference));
GlutIgnoreKeyRepeat(1);
-- Install callbacks.
GlutDisplayFunc(Display'Access);
365 GlutKeyboardFunc(Normal_Key_Press'Access);
GlutSpecialFunc(Special_Key_Press'Access);
GlutSpecialUpFunc(Special_Key_Release'Access);
GlutIdleFunc(Idle'Access);
370 -- Set up display projection for 2d universe.
GlMatrixMode(GL_PROJECTION);
GlLoadIdentity;
GlOrtho(0.0, GlDouble(Simulation_State.Universe_X_Circumference),
0.0, GlDouble(Simulation_State.Universe_Y_Circumference),
375 0.0, 1.0);
-- Set up model transformation for 2d universe.
GlMatrixMode(GL_MODELVIEW);
GlLoadIdentity;
380 end Initialize;
end Graphic_State;