path: root/src/sokoban.adb

--  Programmed by Jedidiah Barber
--  Licensed under the Sunset License v1.0

--  See license.txt for further details


with

    Ada.Directories,
    Ada.Strings.Fixed,
    Ada.Strings.Maps,
    Ada.Text_IO,
    Data,
    Displays,
    FLTK.Widgets,
    Grids,
    Moves,
    Pathfinding,
    Squares,
    Things;

use

    Ada.Text_IO;


package body Sokoban is


    package ADir renames Ada.Directories;




    --  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);

    Loading_Message : constant String :=
        "Loading...";

    Play_Message : constant 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 : constant String :=
        "Level complete!" & ASCII.LF &
        "Press enter to progress to the next level, or q to quit.";

    Fully_Complete_Message : constant String :=
        "Congratulations! All levels complete!" & ASCII.LF &
        "Press enter to start again at the first level, or q to quit.";

    U_Key : constant FLTK.Key_Combo := FLTK.Press ('u');
    N_Key : constant FLTK.Key_Combo := FLTK.Press ('n');
    R_Key : constant FLTK.Key_Combo := FLTK.Press ('r');
    Q_Key : constant 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 : constant String := ADir.Compose
            (Data.Level_Path, "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 : constant String := Get_Line (Data_File);
            Col_Line : constant 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 : constant 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 then
                Next_Next.Is_Walkable and then 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 : constant 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;