Skip to content

Commit

Permalink
Update
Browse files Browse the repository at this point in the history
  • Loading branch information
@CuiRuikai
CuiRuikai committed Nov 16, 2019
1 parent 1c454f9 commit a566b5f
Show file tree
Hide file tree
Showing 6 changed files with 94 additions and 74 deletions.
15 changes: 14 additions & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
@@ -1,2 +1,15 @@
# Snake-Ada
Snake implemented by Ada with GtkAda
This is a simple Snake implementation using Ada with GtkAda as the graphic library.

### Compile

Please install the latest version of GNAT: https://www.adacore.com/download/more

And install GtkAda

Tested on Windows 10 with community GNAT version-2019-20190517 and community GtkAda version-2019-20190523

### Reference

About Graphic: https://github.com/davidhildenbrand/SnakeAda

103 changes: 54 additions & 49 deletions src/control.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,73 +2,78 @@ with Ada.Numerics.Discrete_Random;

package body Control is

task body Game is
begin
Snake (1) := (X => 20, Y => 10);
Apple := Generate_Position;
declare
Head : Position;
Next_Dir : Direction := Right;
begin
loop
select
accept Move_To (Dir : in Direction) do
Next_Dir := Dir;
end Move_To;
or
delay 0.5;
end select;

-- Move
Head := Snake (1);
case Next_Dir is
when Up => Head.Y := Head.Y - 1;
when Down => Head.Y := Head.Y + 1;
when Left => Head.X := Head.X - 1;
when Right => Head.X := Head.X + 1;
when others => null;
end case;
for Ix in reverse 2..Snake_Length loop
Snake (Ix) := Snake (Ix - 1);
end loop;
Snake (1) := Head;

-- Eat
if Head.X = Apple.X and then Head.Y = Apple.Y then
Snake_Length := Snake_Length + 1;
Snake (Snake_Length) := Apple;
Apple := Generate_Position;
end if;

-- Crash
Terminate_Indicator := Head.X = 1 or else Head.X =40 or else Head.Y = 1 or else Head.Y = 24;
for Ix in 2..Snake_Length - 1 loop
exit when Terminate_Indicator;
Terminate_Indicator := Head.X = Snake (Ix).X and then Head.Y = Snake (Ix).Y;
end loop;

exit when Terminate_Indicator;

end loop;
end;
end Game;

function Generate_Position return Position is

package Random_Integer is new Ada.Numerics.Discrete_Random (Integer);

Gen : Random_Integer.Generator;
P : Position;
Is_Conflict : Boolean;

begin
Random_Integer.Reset(Gen);
loop
Is_Conflict := False;

P.X := abs(Random_Integer.Random (Gen)) mod 40 + 1;
P.Y := abs(Random_Integer.Random (Gen)) mod 20 + 1;
for Ix in Integer range 1..Snake_Length loop
Is_Conflict := P.X = Snake (1).X and then P.Y = Snake (1).Y;
exit when Is_Conflict;
end loop;

exit when not Is_Conflict;
end loop;
return P;
end Generate_Position;

task body Game is
Head : Position;
Next_Dir : Direction := Right;
begin
Snake (1) := (X => 20, Y => 10);
Apple := Generate_Position;
loop
select
accept Move_To (Dir : in Direction) do
Next_Dir := Dir;
end Move_To;
or
delay 0.5;
end select;

-- Move
Head := Snake (1);
case Next_Dir is
when Up => Head.Y := Head.Y - 1;
when Down => Head.Y := Head.Y + 1;
when Left => Head.X := Head.X - 1;
when Right => Head.X := Head.X + 1;
when others => null;
end case;
for Ix in reverse 2..Snake_Length loop
Snake (Ix) := Snake (Ix - 1);
end loop;
Snake (1) := Head;

-- Eat
if Head.X = Apple.X and then Head.Y = Apple.Y then
Snake_Length := Snake_Length + 1;
Snake (Snake_Length) := Apple;
Apple := Generate_Position;
end if;

-- Crash
Terminate_Indicator := Head.X = 1 or else Head.X =40 or else Head.Y = 1 or else Head.Y = 24;
for Ix in 2..Snake_Length - 1 loop
exit when Terminate_Indicator;
Terminate_Indicator := Head.X = Snake (Ix).X and then Head.Y = Snake (Ix).Y;
end loop;
exit when Terminate_Indicator;
end loop;
end Game;


end Control;
14 changes: 8 additions & 6 deletions src/control.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,16 +7,18 @@ package Control is

type Direction is (Up,Down,Left,Right);

Snake_Length : Integer := 1;
Apple : Position;
Snake : array (1..100) of Position;
Snake_Length : Integer := 1;

Apple : Position;
Snake : array (1..100) of Position;
Terminate_Indicator : Boolean := False;

function Generate_Position return Position;
Terminate_Indicator : Boolean := False;

task type Game is
entry Move_To (Dir : Direction);
end Game;

private

function Generate_Position return Position;

end Control;
18 changes: 9 additions & 9 deletions src/gui.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,9 @@ package body GUI is
Width => Gdouble (10),
Height => Gdouble (10));
Cairo.Fill_Preserve (Cr);
end;
end Draw_Rectangle;

function On_Key_Press (Ent : access GObject_Record'Class; Event : Gdk_Event_Key) return Boolean is
function On_Key_Press (Ent : access GObject_Record'Class; Event : Gdk_Event_Key) return Boolean is
begin
case Event.Keyval is
when GDK_Up => Game_Ins.Move_To (Up);
Expand All @@ -25,35 +25,35 @@ package body GUI is
return False;
end On_Key_Press;

function On_Draw (Self : access Gtk_Widget_Record'Class; Cr : Cairo.Cairo_Context) return Boolean is
function On_Draw (Self : access Gtk_Widget_Record'Class; Cr : Cairo.Cairo_Context) return Boolean is
begin
-- Draw the border
for x in Integer range 0 .. 41 loop
for x in 0 .. 41 loop
Draw_Rectangle (Cr, (X=> x , Y => 0));
Draw_Rectangle (Cr, (X=> x , Y => 25));
end loop;
for y in Integer range 0 .. 25 loop
for y in 0 .. 25 loop
Draw_Rectangle (Cr, (X=> 0 , Y => y));
Draw_Rectangle (Cr, (X=> 41 , Y => y));
Draw_Rectangle (Cr, (X=> 41, Y => y));
end loop;

-- Draw Apple And Snake
if (Terminate_Indicator) then
if Terminate_Indicator then
Cairo.Set_Font_Size (Cr, Gdouble (30));
Cairo.Move_To (Cr, Gdouble (80), Gdouble (8 * 11));
Cairo.Show_Text (Cr, "GAME OVER");
abort Game_Ins;
else
-- Draw Apple
Draw_Rectangle (Cr, Apple);

-- Draw Snake
for Ix in Integer range 1..Snake_Length loop
for Ix in 1..Snake_Length loop
Draw_Rectangle (Cr, Snake (Ix));
end loop;
end if;

return False;

end On_Draw;

function TriggerRedraw return Boolean is
Expand Down
2 changes: 1 addition & 1 deletion src/gui.ads
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ package GUI is

procedure Draw_Rectangle (Cr : Cairo_Context; Pos : Position);

function On_Key_Press (Ent : access GObject_Record'Class; Event : Gdk_Event_Key) return Boolean;
function On_Key_Press (Ent : access GObject_Record'Class ; Event : Gdk_Event_Key) return Boolean;
function On_Draw (Self : access Gtk_Widget_Record'Class; Cr : Cairo.Cairo_Context) return Boolean;
function TriggerRedraw return Boolean;

Expand Down
16 changes: 8 additions & 8 deletions src/main.adb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,19 +16,19 @@ begin
Gtk.Main.Init;

-- Create Window
Gtk_New (Win);
Win.Set_Title("Snake Game");
Win.Set_Border_Width(4);
Win.Set_Resizable (False);
Gtk_New (Win);
Win.Set_Title ("Snake Game");
Win.Set_Border_Width (4);
Win.Set_Resizable (False);

Gtk.Drawing_Area.Gtk_New (GUI.Draw);
Gtk.Drawing_Area.Gtk_New (GUI.Draw);
GUI.Draw.Set_Size_Request (462, 286);
GUI.Draw.On_Draw (On_Draw'Access);
Win.Add (GUI.Draw);
GUI.Draw.On_Draw (On_Draw'Access);
Win.Add (GUI.Draw);

-- Show the window
Win.Show_All;
Win.On_Key_Press_Event (On_Key_Press'Access, Win);
Win.On_Key_Press_Event (On_Key_Press'Access, Win);

-- Update
Timeout := Glib.Main.Timeout_Add (10, TriggerRedraw'Access);
Expand Down

0 comments on commit a566b5f

Please sign in to comment.