diff options
Diffstat (limited to 'src/sokoban.adb')
| -rw-r--r-- | src/sokoban.adb | 168 |
1 files changed, 159 insertions, 9 deletions
diff --git a/src/sokoban.adb b/src/sokoban.adb index 9c3e490..b58874b 100644 --- a/src/sokoban.adb +++ b/src/sokoban.adb @@ -2,10 +2,12 @@ with + FLTK.Widgets, Displays, Grids, Squares, Things, + Moves, Ada.Command_Line, Ada.Directories, Ada.Text_IO, @@ -26,24 +28,53 @@ package body Sokoban is (X, Y : in Natural; Char : in Character); + procedure Move_Man + (Delta_X, Delta_Y : in Integer); + procedure Undo_Movement; - -- Global state of the game. - - My_Display : Displays.Display := Displays.Create; - My_Grid : Grids.Grid := Grids.Create (0, 0); - Current_Level : LevelID; + -- Miscellaneous game data. - - -- Miscellaneous. + type Game_State is (Loading, Play, Complete); Origin : String := Ada.Directories.Containing_Directory (Ada.Directories.Full_Name (Ada.Command_Line.Command_Name)); Level_Dir : String := Origin & "/../share/sokoban/level"; + Loading_Message : String := "Loading..."; + + Play_Message : String := "Move with the arrow keys. Press u for undo." & ASCII.LF & + "To move to a square where there is a clear path, click with the mouse." & ASCII.LF & + "Press n to skip this level, q to quit, and r to restart this level."; + + Complete_Message : String := "Level complete!" & ASCII.LF & + "Press enter to progress to the next level, or q to quit."; + + Fully_Complete_Message : String := "Congratulations! All levels complete!" & ASCII.LF & + "Press enter to start again at the first level, or q to quit."; + + U_Key : FLTK.Shortcut_Key := FLTK.Shortcut ('u'); + N_Key : FLTK.Shortcut_Key := FLTK.Shortcut ('n'); + R_Key : FLTK.Shortcut_Key := FLTK.Shortcut ('r'); + Q_Key : FLTK.Shortcut_Key := FLTK.Shortcut ('q'); + + + + + -- Global state of the game. + + My_Display : Displays.Display := Displays.Create; + My_Grid : Grids.Grid := Grids.Create (0, 0); + Current_Level : LevelID; + Level_State : Game_State := Loading; + Current_Man_X : Integer; + Current_Man_Y : Integer; + Move_Record : Moves.Path; + Goals_Remaining : Integer; + @@ -60,6 +91,9 @@ package body Sokoban is Rows, Cols : Natural; begin + Level_State := Loading; + My_Display.Set_Message (Loading_Message); + Goals_Remaining := 0; Open (Data_File, In_File, Filename); declare @@ -85,9 +119,12 @@ package body Sokoban is end loop; Close (Data_File); - Current_Level := Number; My_Display.Centre_On_Screen; + Move_Record := Moves.Empty_Path; + My_Display.Set_Message (Play_Message); + My_Grid.Redraw; + Level_State := Play; end Load_Level; @@ -109,7 +146,54 @@ package body Sokoban is - -- Callbacks for keyboard controls. + -- Keyboard and mouse control handling. + + function Keypress + (Key : in FLTK.Shortcut_Key) + return FLTK.Event_Outcome + is + use type FLTK.Shortcut_Key; + begin + if Key = Q_Key then + Hide; + return FLTK.Handled; + end if; + + if Level_State = Play then + if Key = FLTK.Up_Key then + Move_Man (0, -1); + elsif Key = FLTK.Down_Key then + Move_Man (0, 1); + elsif Key = FLTK.Left_Key then + Move_Man (-1, 0); + elsif Key = FLTK.Right_Key then + Move_Man (1, 0); + elsif Key = U_Key then + Undo_Movement; + elsif Key = N_Key then + if Current_Level = LevelID'Last then + My_Display.Set_Message (Fully_Complete_Message); + Level_State := Complete; + else + Load_Level (Current_Level + 1); + end if; + elsif Key = R_Key then + Load_Level (Current_Level); + else + return FLTK.Not_Handled; + end if; + return FLTK.Handled; + elsif Level_State = Complete and Key = FLTK.Enter_Key then + if Current_Level = LevelID'Last then + Load_Level (LevelID'First); + else + Load_Level (Current_Level + 1); + end if; + return FLTK.Handled; + else + return FLTK.Not_Handled; + end if; + end Keypress; @@ -144,11 +228,14 @@ package body Sokoban is when '.' => My_Grid.Set_Square (X, Y, Squares.Goal); + Goals_Remaining := Goals_Remaining + 1; when '@' => Temp := Squares.Empty; Temp.Set_Contents (Things.Man); My_Grid.Set_Square (X, Y, Temp); + Current_Man_X := X; + Current_Man_Y := Y; when others => raise Program_Error; @@ -157,10 +244,73 @@ package body Sokoban is end Add_New_Grid_Item; + + + procedure Move_Man + (Delta_X, Delta_Y : in Integer) + is + use type Squares.Square, Things.Thing; + + Current : Squares.Square := + My_Grid.Get_Square (Current_Man_X, Current_Man_Y); + Next : Squares.Square := + My_Grid.Get_Square (Current_Man_X + Delta_X, Current_Man_Y + Delta_Y); + Next_Next : Squares.Square := + My_Grid.Get_Square (Current_Man_X + Delta_X * 2, Current_Man_Y + Delta_Y * 2); + begin + if Next.Is_Walkable then + if Next.Get_Contents = Things.Nothing then + Current.Set_Contents (Things.Nothing); + My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Current); + Current_Man_X := Current_Man_X + Delta_X; + Current_Man_Y := Current_Man_Y + Delta_Y; + Next.Set_Contents (Things.Man); + My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Next); + Move_Record.Add ((Delta_X => Delta_X, Delta_Y => Delta_Y, Push => False)); + My_Grid.Redraw; + elsif + Next.Get_Contents = Things.Treasure and Next_Next.Is_Walkable and + Next_Next.Get_Contents = Things.Nothing + then + Current.Set_Contents (Things.Nothing); + My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Current); + Current_Man_X := Current_Man_X + Delta_X; + Current_Man_Y := Current_Man_Y + Delta_Y; + Next.Set_Contents (Things.Man); + My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Next); + Next_Next.Set_Contents (Things.Treasure); + My_Grid.Set_Square (Current_Man_X + Delta_X, Current_Man_Y + Delta_Y, Next_Next); + Move_Record.Add ((Delta_X => Delta_X, Delta_Y => Delta_Y, Push => True)); + My_Grid.Redraw; + + if Next = Squares.Goal and Next_Next /= Squares.Goal then + Goals_Remaining := Goals_Remaining + 1; + elsif Next /= Squares.Goal and Next_Next = Squares.Goal then + Goals_Remaining := Goals_Remaining - 1; + end if; + + if Goals_Remaining = 0 then + My_Display.Set_Message (Complete_Message); + Level_State := Complete; + end if; + end if; + end if; + end Move_Man; + + + + + procedure Undo_Movement is + begin + null; + end Undo_Movement; + + begin My_Display.Set_Grid (My_Grid); + My_Display.Set_Keyboard_Callback (Keypress'Access); end Sokoban; |