with FLTK.Widgets, Displays, Grids, Squares, Things, Moves, Pathfinding, Misc, Ada.Text_IO, Ada.Strings.Fixed, Ada.Strings.Maps; use Ada.Text_IO; package body Sokoban is -- Forward declarations of helper functions. procedure Add_New_Grid_Item (X, Y : in Natural; Char : in Character); procedure Move_Man (Delta_X, Delta_Y : in Integer); procedure Undo_Movement; -- Miscellaneous game data. type Game_State is (Loading, Play, Complete); Level_Dir : String := Misc.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.Key_Combo := FLTK.Press ('u'); N_Key : FLTK.Key_Combo := FLTK.Press ('n'); R_Key : FLTK.Key_Combo := FLTK.Press ('r'); Q_Key : FLTK.Key_Combo := FLTK.Press ('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; -- Main program interface. procedure Load_Level (Number : in LevelID) is use Ada.Strings, Ada.Strings.Fixed, Ada.Strings.Maps; Data_File : File_Type; Filename : String := Level_Dir & "/level" & Trim (LevelID'Image (Number), Both) & ".data"; Rows, Cols : Natural; begin Level_State := Loading; My_Display.Set_Message (Loading_Message); Goals_Remaining := 0; Open (Data_File, In_File, Filename); declare Row_Line : String := Get_Line (Data_File); Col_Line : String := Get_Line (Data_File); Start, Finish : Natural; begin Find_Token (Row_Line, To_Set ("0123456789"), 1, Inside, Start, Finish); Rows := Natural'Value (Row_Line (Start .. Finish)); Find_Token (Col_Line, To_Set ("0123456789"), 1, Inside, Start, Finish); Cols := Natural'Value (Col_Line (Start .. Finish)); end; My_Display.Adjust_Grid (Cols, Rows); for Y in Integer range 1 .. Rows loop declare Working_Line : String := Get_Line (Data_File); begin for X in Integer range 1 .. Cols loop Add_New_Grid_Item (X, Y, Working_Line (X)); end loop; end; 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_Display.Set_Level_Number (Natural (Current_Level)); My_Display.Set_Move_Number (Move_Record.Length); My_Grid.Redraw; Level_State := Play; end Load_Level; procedure Show is begin My_Display.Show; end Show; procedure Hide is begin My_Display.Hide; end Hide; -- Keyboard and mouse control handling. function Keypress (Key : in FLTK.Key_Combo) return FLTK.Event_Outcome is use type FLTK.Key_Combo; begin if Key = Q_Key then Hide; return FLTK.Handled; end if; if Level_State = Play then if Key = FLTK.Press (FLTK.Up_Key) then Move_Man (0, -1); elsif Key = FLTK.Press (FLTK.Down_Key) then Move_Man (0, 1); elsif Key = FLTK.Press (FLTK.Left_Key) then Move_Man (-1, 0); elsif Key = FLTK.Press (FLTK.Right_Key) then Move_Man (1, 0); elsif Key = U_Key then if Move_Record.Length > 0 then Undo_Movement; end if; 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.Press (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; function Mouseclick (X, Y : in Integer) return FLTK.Event_Outcome is Col, Row, DX, DY : Integer; Movement : Moves.Path; Temp : Squares.Square; begin My_Grid.Pixel_To_Colrow (X, Y, Col, Row); if My_Grid.In_Bounds (Col, Row) then Movement := Pathfinding.A_Star (My_Grid, Current_Man_X, Current_Man_Y, Col, Row); Movement.Total_Delta (DX, DY); Temp := My_Grid.Get_Square (Current_Man_X, Current_Man_Y); Temp.Set_Contents (Things.Nothing); My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Temp); Current_Man_X := Current_Man_X + DX; Current_Man_Y := Current_Man_Y + DY; Temp := My_Grid.Get_Square (Current_Man_X, Current_Man_Y); Temp.Set_Contents (Things.Man); My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Temp); Move_Record.Add (Movement); My_Display.Set_Move_Number (Move_Record.Length); My_Grid.Redraw; return FLTK.Handled; end if; return FLTK.Not_Handled; end Mouseclick; -- Helper functions. procedure Add_New_Grid_Item (X, Y : in Natural; Char : in Character) is Temp : Squares.Square; begin case Char is when '#' => My_Grid.Set_Square (X, Y, Squares.Wall); when ' ' => My_Grid.Set_Square (X, Y, Squares.Empty); when '$' => Temp := Squares.Empty; Temp.Set_Contents (Things.Treasure); My_Grid.Set_Square (X, Y, Temp); when '*' => Temp := Squares.Goal; Temp.Set_Contents (Things.Treasure); My_Grid.Set_Square (X, Y, Temp); when '!' => My_Grid.Set_Square (X, Y, Squares.Space); 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; end case; 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_Display.Set_Move_Number (Move_Record.Length); 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_Display.Set_Move_Number (Move_Record.Length); 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 Last : Moves.Move := Move_Record.Latest; Prev : Squares.Square := My_Grid.Get_Square (Current_Man_X - Last.Delta_X, Current_Man_Y - Last.Delta_Y); Current : Squares.Square := My_Grid.Get_Square (Current_Man_X, Current_Man_Y); Next : Squares.Square := My_Grid.Get_Square (Current_Man_X + Last.Delta_X, Current_Man_Y + Last.Delta_Y); begin if Last.Push then Current.Set_Contents (Things.Treasure); Next.Set_Contents (Things.Nothing); else Current.Set_Contents (Things.Nothing); end if; Prev.Set_Contents (Things.Man); My_Grid.Set_Square (Current_Man_X, Current_Man_Y, Current); My_Grid.Set_Square (Current_Man_X + Last.Delta_X, Current_Man_Y + Last.Delta_Y, Next); My_Grid.Set_Square (Current_Man_X - Last.Delta_X, Current_Man_Y - Last.Delta_Y, Prev); Current_Man_X := Current_Man_X - Last.Delta_X; Current_Man_Y := Current_Man_Y - Last.Delta_Y; Move_Record.Drop_Latest; My_Display.Set_Move_Number (Move_Record.Length); My_Grid.Redraw; end Undo_Movement; begin My_Display.Set_Grid (My_Grid); My_Display.Set_Keyboard_Callback (Keypress'Access); My_Display.Set_Mouse_Callback (Mouseclick'Access); end Sokoban;