From 4b367c25b0365be8fe38381136353a659d5ce545 Mon Sep 17 00:00:00 2001 From: Charles Date: Sun, 8 Dec 2019 11:06:26 +0100 Subject: Added direction change with arrow key, food spawn --- game.adb | 41 ++++++++++++++++++++++++++++------------- game.ads | 14 ++++++++++++++ graphics.adb | 38 +++++++++++++++++++++++++++++++------- graphics.ads | 3 +++ 4 files changed, 76 insertions(+), 20 deletions(-) diff --git a/game.adb b/game.adb index 2c1934d..cd403e2 100644 --- a/game.adb +++ b/game.adb @@ -13,6 +13,9 @@ package body Game is Enqueue(game.snake, (2, 2)); Enqueue(game.snake, (2, 3)); game.food := (1, 1); + Reset(game.width_generator); + Reset(game.height_generator); + Spawn_Food(game); end Init; function Next(game: in out T_Game) return Boolean is @@ -24,22 +27,35 @@ package body Game is Enqueue(game.snake, new_head); if new_head /= game.food then Dequeue(game.snake); + else + Spawn_Food(game); end if; - return true; end Next; + procedure Change_Direction(game: in out T_Game; + direction: T_Direction) is + begin + case direction is + when DIRECTION_UP => + if game.direction /= DIRECTION_DOWN then + game.direction := direction; + end if; + when DIRECTION_DOWN => + if game.direction /= DIRECTION_UP then + game.direction := direction; + end if; + when DIRECTION_LEFT => + if game.direction /= DIRECTION_RIGHT then + game.direction := direction; + end if; + when DIRECTION_RIGHT => + if game.direction /= DIRECTION_LEFT then + game.direction := direction; + end if; + end case; + end Change_Direction; procedure Spawn_Food(game: in out T_Game) is - subtype T_Width_Random_Range is Positive range 1..game.width; - subtype T_Height_Random_Range is Positive range 1..game.height; - package P_Width_Random is new Ada.Numerics.Discrete_Random(T_Width_Random_Range); - package P_Height_Random is new Ada.Numerics.Discrete_Random(T_Height_Random_Range); - use P_Width_Random; - use P_Height_Random; - - width_random_generator: P_Width_Random.Generator; - height_random_generator: P_Height_Random.Generator; - function Valid_Food(game: T_Game; food: T_Position) return Boolean is cursor: T_List := game.snake.front; begin @@ -54,9 +70,8 @@ package body Game is food: T_Position; begin - -- reset in main loop - food := (random(height_random_generator), random(width_random_generator)); + food := (random(game.height_generator), random(game.width_generator)); exit when Valid_Food(game, food); end loop; game.food := food; diff --git a/game.ads b/game.ads index 67247c8..558f272 100644 --- a/game.ads +++ b/game.ads @@ -1,3 +1,5 @@ +with Ada.Numerics.Discrete_Random; + with Queue; package Game is @@ -17,18 +19,30 @@ package Game is DIRECTION_RIGHT ); + subtype T_Width_Random_Range is Positive range 1..10; + subtype T_Height_Random_Range is Positive range 1..10; + package P_Width_Random is new Ada.Numerics.Discrete_Random(T_Width_Random_Range); + package P_Height_Random is new Ada.Numerics.Discrete_Random(T_Height_Random_Range); + use P_Width_Random; + use P_Height_Random; + type T_Game is record height: Positive; width: Positive; snake: T_Queue; direction: T_Direction; food: T_Position; + width_generator: P_Width_Random.Generator; + height_generator: P_Height_Random.Generator; + end record; procedure Init(game: out T_Game; width: Positive; height: Positive); function Next(game: in out T_Game) return Boolean; + procedure Change_Direction(game: in out T_Game; + direction: T_Direction); private diff --git a/graphics.adb b/graphics.adb index e9e4b71..dba73b9 100644 --- a/graphics.adb +++ b/graphics.adb @@ -6,17 +6,16 @@ with SDL.Timers; with SDL.Video.Rectangles; with SDL.Events; with SDL.Events.Events; +with SDL.Events.Keyboards; +use SDL.Events.Keyboards; with SDL.Video.Windows; with SDL.Video.Windows.Makers; with SDL.Video.Renderers; with SDL.Video.Renderers.Makers; use SDL.Video; -with Graphics, Game; -use Graphics, Game; - with Interfaces.C; -use Interfaces.C; +use Interfaces.C; package body Graphics is @@ -40,10 +39,20 @@ package body Graphics is end Quit; procedure Run(state: in out T_State) is + use SDL.Timers; + + last_time: SDL.Timers.Milliseconds := SDL.Timers.Ticks; + current_time: SDL.Timers.Milliseconds; begin + Update(state); while state.running loop + current_time := SDL.Timers.Ticks; Event_Handler(state); - Update(state); + if current_time >= last_time then + last_time := current_time + TIME_STEP; + state.running := Next(state.game); + Update(state); + end if; SDL.Timers.Wait_Delay(3); end loop; end Run; @@ -54,6 +63,19 @@ package body Graphics is while SDL.Events.Events.Poll(event) loop case event.common.event_type is when SDL.Events.Quit => state.running := false; + when SDL.Events.Keyboards.Key_Down => + case event.keyboard.key_sym.scan_code is + when Scan_Code_Escape => state.running := false; + when Scan_Code_Up => + Change_Direction(state.game, DIRECTION_UP); + when Scan_Code_Down => + Change_Direction(state.game, DIRECTION_DOWN); + when Scan_Code_Left => + Change_Direction(state.game, DIRECTION_LEFT); + when Scan_Code_Right => + Change_Direction(state.game, DIRECTION_RIGHT); + when others => null; + end case; when others => null; end case; end loop; @@ -66,11 +88,13 @@ package body Graphics is Renderers.Set_Draw_Colour(state.renderer, COLOR_BLACK); Renderers.Clear(state.renderer); - Renderers.Set_Draw_Colour(state.renderer, COLOR_WHITE); + Renderers.Set_Draw_Colour(state.renderer, COLOR_GREEN); while cursor /= null loop Draw_Square(state, cursor.all.data); cursor := cursor.all.next; end loop; + Renderers.Set_Draw_Colour(state.renderer, COLOR_RED); + Draw_Square(state, state.game.food); Renderers.Present(state.renderer); end Update; @@ -78,7 +102,7 @@ package body Graphics is pos: T_Position) is rect: Rectangles.Rectangle; begin - rect := ((C.int(pos.y) - 1) * 20, (C.int(pos.x) - 1) * 20, 20, 20); + rect := ((C.int(pos.x) - 1) * 20, (C.int(pos.y) - 1) * 20, 20, 20); Renderers.Fill(state.renderer, rect); end Draw_Square; diff --git a/graphics.ads b/graphics.ads index 1f58de3..601c3e9 100644 --- a/graphics.ads +++ b/graphics.ads @@ -1,4 +1,5 @@ with SDL; +with SDL.Timers; with SDL.Video.Windows; with SDL.Video.Renderers; with SDL.Video.Palettes; @@ -14,6 +15,8 @@ package Graphics is WINDOW_WIDTH: constant SDL.Positive_Dimension := 400; WINDOW_HEIGHT: constant SDL.Positive_Dimension := 400; + TIME_STEP: constant SDL.Timers.Milliseconds := 400; + COLOR_WHITE: constant SDL.Video.Palettes.Colour := (255, 255, 255, 255); COLOR_BLACK: constant SDL.Video.Palettes.Colour := (0, 0, 0, 255); COLOR_RED: constant SDL.Video.Palettes.Colour := (255, 0, 0, 255); -- cgit