path: root/src/sokoban.adb

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;