%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% file: maze.m
% author: conway, June 1997
%
% This source file is hereby placed in the public domain. -conway (the author).
%
% maze is a 2D maze generator. It uses a 'perfect' algorithm that was posted
% to rec.games.programmer by Kent Quirk. The algorithm is 'perfect' in the
% sense that there is a single path between any two cells in the maze; every
% cell is connected to every other cell.
%
% The options are:
%     -x --width <N>  : the width of the maze
%     -y --height <N> : the height of the maze
%     -s --seed <N>   : the random number seed to use
%
% The random number seed has the form "a,b,c" where each of a, b and c
% is an unsigned 64-bit integer.
%
% GLUT version by juliensf
% - I've also added a keyboard handler so you can press escape order to quit.
%
%-----------------------------------------------------------------------------%

:- module maze.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module glut.
:- import_module glut.callback.
:- import_module glut.window.
:- import_module mglu.
:- import_module mogl.

:- import_module bool.
:- import_module char.
:- import_module float.
:- import_module getopt.
:- import_module int.
:- import_module integer.
:- import_module list.
:- import_module map.
:- import_module math.
:- import_module maybe.
:- import_module pair.
:- import_module random.
:- import_module random.sfc64.
:- import_module random.system_rng.
:- import_module require.
:- import_module set.
:- import_module solutions.
:- import_module string.

%-----------------------------------------------------------------------------%

:- type option ---> height ; width ; seed.

:- type wall ---> north ; south ; east ; west.

:- type pos ---> pos(int, int).

:- type adj ---> adj(pos, pos).

:- type maze == map(pos, set(pos)).

:- type walls == map(pos, list(wall)).

:- type wander ---> w(set(pos), list(pos)).

%------------------------------------------------------------------------------%

main(!IO) :-
    % Process the command line options ...
    io.command_line_arguments(Args0, !IO),
    getopt.process_options(option_ops_multi(short, long, defaults),
        Args0, _Args, MOpts),
    (
        MOpts = ok(Opts),
        % Create the maze.
        io.write_string("generating maze....", !IO),
        io.flush_output(!IO),
        getopt.lookup_int_option(Opts, width, XMax),
        getopt.lookup_int_option(Opts, height, YMax),
        getopt.lookup_string_option(Opts, seed, SeedStr),
        get_random_seed(SeedStr, SeedResult, !IO),
        (
            SeedResult = ok({SeedA, SeedB, SeedC}),
            sfc64.seed(SeedA, SeedB, SeedC, RNG0, RndState0),
            make_io_urandom(RNG0, RndState0, RNG, !IO),
            set_size(float(XMax), !IO),
            XIndexes = 0 .. XMax - 1,
            YIndexes = 0 .. YMax - 1,
            dig(RNG, pos(XMax, YMax), XIndexes, YIndexes, map.init, Maze, !IO),
            io.write_string(" done.\n", !IO),
            io.flush_output(!IO),
            main_2(Maze, !IO)
        ;
            SeedResult = error(Msg),
            io.stderr_stream(StdErr, !IO),
            io.format(StdErr, "error: %s\n", [s(Msg)], !IO),
            io.set_exit_status(1, !IO)
        )
    ;
        MOpts = error(Str),
        io.stderr_stream(StdErr, !IO),
        io.format(StdErr, "usage: maze [-xN] [-yN] [-sN]\nerror: %s\n",
            [s(option_error_to_string(Str))], !IO),
        io.set_exit_status(1, !IO)
    ).

%-----------------------------------------------------------------------------%

    % Set the display mode and initial window attributes.
    % Register callbacks and then start the thing running.
:- pred main_2(maze::in, io::di, io::uo) is det.

main_2(Maze, !IO) :-
    glut.init_display_mode([double, rgba], !IO),
    glut.init_window_size(300, 300, !IO),
    glut.window.create("Maze", !IO),

    create(Maze, !IO),
    glut.callback.display_func(maze.display, !IO),
    glut.callback.reshape_func(maze.reshape, !IO),
    glut.callback.keyboard_func(maze.keyboard, !IO),
    glut.callback.idle_func(maze.idle, !IO),

    set_maze(Maze, !IO),
    set_pos(pos(0, 0), !IO),
    set_dir(east, !IO),
    set_phi(0.0, !IO),
    set_theta(0.0, !IO),
    set_w(w(set.init, []), !IO),

    glut.main_loop(!IO).

%------------------------------------------------------------------------------%
%
% Solve the maze.
%

    % Work out the next position in the traversal of the maze and then
    % tell OpenGL to redisplay it.
:- pred idle(io::di, io::uo) is det.

idle(!IO) :-
    next_pos(!IO),
    glut.window.post_redisplay(!IO).

:- pred next_pos(io::di, io::uo) is det.

next_pos(!IO) :-
    get_maze(Maze, !IO),
    get_pos(Pos0, !IO),
    get_w(w(Visited0, Others0), !IO),
    Visited = set.insert(Visited0, Pos0),
    AdjSet = Maze ^ det_elem(Pos0),
    Choices0 = set.difference(AdjSet, Visited),
    ChoiceList = set.to_sorted_list(Choices0),
    Others1 = ChoiceList ++ Others0,
    (
        Others1 = [],
        set_w(w(set.init, []), !IO)
    ;
        Others1 = [Pos | Others],
        set_pos(Pos, !IO),
        set_w(w(Visited, Others), !IO)
    ).

%-----------------------------------------------------------------------------%

:- pred create(maze::in, io::di, io::uo) is det.

create(Maze, !IO) :-
    MazeList = map.to_assoc_list(Maze),
    Walls = maze.cons_walls(MazeList),
    WallList = map.to_assoc_list(Walls),
    mogl.new_list(maze_list, compile, !IO),
    mogl.begin(quads, !IO),
        maze.make_mlist(WallList, !IO),
    mogl.end(!IO),
    mogl.end_list(!IO),

    mogl.point_size(1.5, !IO),

    mogl.light_model(light_model_two_side(yes), !IO),
    mogl.light_model(light_model_local_viewer(yes), !IO),

    mogl.enable(normalize,!IO),
    mogl.enable(lighting, !IO),
    mogl.enable(light(0), !IO),
    mogl.enable(light(1), !IO),

    mogl.shade_model(smooth, !IO),
    mogl.enable(depth_test, !IO).

:- pred make_mlist(list(pair(pos, list(wall)))::in, io::di, io::uo) is det.

make_mlist([], !IO).
make_mlist([Pos - Walls | Rest], !IO) :-
    mogl.color3(0.7, 0.7, 0.7, !IO),
    list.foldl(maze.wall(Pos), Walls, !IO),
    maze.make_mlist(Rest, !IO).

:- pred wall(pos::in, wall::in, io::di, io::uo) is det.

wall(pos(X0, Z0), north, !IO) :-
    X = float(X0),
    Z = float(Z0),
    mogl.vertex3(X,       0.0, Z + 1.0, !IO),
    mogl.vertex3(X + 1.0, 0.0, Z + 1.0, !IO),
    mogl.vertex3(X + 1.0, 1.0, Z + 1.0, !IO),
    mogl.vertex3(X,       1.0, Z + 1.0, !IO).
wall(pos(X0, Z0), south, !IO) :-
    X = float(X0),
    Z = float(Z0),
    mogl.vertex3(X,       0.0, Z, !IO),
    mogl.vertex3(X + 1.0, 0.0, Z, !IO),
    mogl.vertex3(X + 1.0, 1.0, Z, !IO),
    mogl.vertex3(X,       1.0, Z, !IO).
wall(pos(X0, Z0), east, !IO) :-
    X = float(X0),
    Z = float(Z0),
    mogl.vertex3(X + 1.0, 0.0, Z,       !IO),
    mogl.vertex3(X + 1.0, 0.0, Z + 1.0, !IO),
    mogl.vertex3(X + 1.0, 1.0, Z + 1.0, !IO),
    mogl.vertex3(X + 1.0, 1.0, Z,       !IO).
wall(pos(X0, Z0), west, !IO) :-
    X = float(X0),
    Z = float(Z0),
    mogl.vertex3(X, 0.0, Z,       !IO),
    mogl.vertex3(X, 0.0, Z + 1.0, !IO),
    mogl.vertex3(X, 1.0, Z + 1.0, !IO),
    mogl.vertex3(X, 1.0, Z,       !IO).

    % The stuff that happens for each frame.
:- pred display(io::di, io::uo) is det.

display(!IO) :-
    get_size(Size, !IO),
    mogl.clear_color(0.0, 0.0, 0.0, 0.0, !IO),
    mogl.clear([color, depth], !IO),
    mogl.matrix_mode(modelview, !IO),
    mogl.push_matrix(!IO),
        mogl.load_identity(!IO),
        mogl.light(0, position(0.0, 0.0, 0.0, 1.0),   !IO),
        mogl.light(0, ambient(0.5, 0.5, 0.0, 1.0),    !IO),
        mogl.light(0, diffuse(0.7, 0.7, 0.0, 1.0),    !IO),
        mogl.light(0, specular(0.7, 0.7, 0.0, 1.0),   !IO),
        mogl.light(1, position(Size, 0.0, Size, 1.0), !IO),
        mogl.light(1, ambient(0.0, 0.0, 0.7, 1.0),    !IO),
        mogl.light(1, diffuse(0.8, 0.0, 0.7, 1.0),    !IO),
        mogl.light(1, specular(0.0, 0.0, 0.7, 1.0),   !IO),
    mogl.pop_matrix(!IO),
    maze.draw_maze(!IO),
    glut.window.swap_buffers(!IO).

:- pred reshape(int::in, int::in, io::di, io::uo) is det.

reshape(Width, Height, !IO) :-
    mogl.viewport(0, 0, Width, Height, !IO),
    mogl.matrix_mode(projection, !IO),
    mogl.load_identity(!IO),
    mglu.perspective(55.0, float(Width) / float(Height), 0.1, 10000.0, !IO),
    mogl.matrix_mode(modelview, !IO).

%------------------------------------------------------------------------------%
%
% Maze drawing.
%

:- pred draw_maze(io::di, io::uo) is det.

draw_maze(!IO) :-
    mogl.load_identity(!IO),
    get_w(w(Visited, Other), !IO),
    get_size(Size, !IO),
    get_phi(Phi, !IO),
    get_theta(Theta, !IO),
    R = 1.5 * Size,
    Y = R * sin(Theta),
    Q = R * cos(Theta),
    X = Q * cos(Phi) + 0.5 * Size,
    Z = Q * sin(Phi) + 0.5 * Size,
    mglu.look_at(X, Y, Z, 0.5 * Size, 0.0, 0.5 * Size, 0.0, 0.0, 1.0, !IO),
    mogl.disable(lighting, !IO),
    mogl.begin(points, !IO),
        mogl.color3(0.0, 1.0, 0.0, !IO),
        VisList = set.to_sorted_list(Visited),
        list.foldl(draw_vis, VisList, !IO),
        mogl.color3(1.0, 0.0, 0.0, !IO),
        list.foldl(draw_vis, Other, !IO),
    mogl.end(!IO),
    mogl.enable(lighting, !IO),
    mogl.call_list(maze_list, !IO),
    set_phi(Phi + 0.005, !IO),
    set_theta(Theta + 0.005, !IO).

:- pred draw_vis(pos::in, io::di, io::uo) is det.

draw_vis(pos(Xi, Zi), !IO) :-
    mogl.vertex3(float(Xi) + 0.5, 0.5, float(Zi) + 0.5, !IO).

%------------------------------------------------------------------------------%

    % Convert the adjacency representation of the maze to a walls
    % representation.
:- func cons_walls(list(pair(pos, set(pos)))) = walls.

cons_walls(Maze) = Walls :-
    ConsWalls = (func(F - T, Wall0) = Wall :-
        ( if Wall0 ^ elem(F) = Sides0 then
            Sides1 = Sides0
        else
            Sides1 = [north, south, east, west]
        ),
        Nexts  = set.to_sorted_list(T),
        Sides2 = list.foldl(remove_side(F), Nexts, Sides1),
        Wall   = Wall0 ^ elem(F) := Sides2
    ),
    Walls = list.foldl(ConsWalls, Maze, map.init).

:- func remove_side(pos, pos, list(wall)) = list(wall).

remove_side(pos(X0, Y0), pos(X1, Y1), Sides0) = Sides :-
    ( if X1 = X0 + 1 then
        Side = east
    else if X1 = X0 - 1
        then Side = west
    else if Y1 = Y0 + 1 then
        Side = north
    else
        Side = south
    ),
    Sides = list.delete_all(Sides0, Side).

%------------------------------------------------------------------------------%
%
% Maze creation.
%

:- pred dig(RNG::in, pos::in, list(int)::in, list(int)::in, maze::in, maze::out,
    RngState::di, RngState::uo) is det <= urandom(RNG, RngState).

dig(_, _, [], _, !Maze, !Rnd).
dig(RNG, FarPos, [X | Xs], Ys, !Maze, !Rnd) :-
    dig1(RNG, FarPos, X, Ys, !Maze, !Rnd),
    dig(RNG, FarPos, Xs, Ys, !Maze, !Rnd).

:- pred dig1(RNG::in, pos::in, int::in, list(int)::in, maze::in, maze::out,
    RngState::di, RngState::uo) is det <= urandom(RNG, RngState).

dig1(_, _, _, [], !Maze, !Rnd).
dig1(RNG, FarPos, X, [Y | Ys], !Maze, !Rnd) :-
    Pos = pos(X, Y),
    adj(RNG, FarPos, Pos, AdjPoss, !Rnd),
    dig2(RNG, FarPos, AdjPoss, !Maze, !Rnd),
    dig1(RNG, FarPos, X, Ys, !Maze, !Rnd).

:- pred dig2(RNG::in, pos::in, list(adj)::in, maze::in, maze::out,
    RndState::di, RndState::uo) is det <= urandom(RNG, RndState).

dig2(_, _, [], !Maze, !Rnd).
dig2(RNG, FarPos, [adj(NewPos, OldPos) | Rest], !Maze, !Rnd) :-
    ( if
        not map.contains(!.Maze, NewPos)
    then
        knock_out_wall(OldPos, NewPos, !Maze),
        adj(RNG, FarPos, NewPos, AdjPoss, !Rnd),
        dig2(RNG, FarPos, AdjPoss, !Maze, !Rnd)
    else
        dig2(RNG, FarPos, Rest, !Maze, !Rnd)
    ).

:- pred adj(RNG::in, pos::in, pos::in, list(adj)::out,
    RndState::di, RndState::uo) is det <= urandom(RNG, RndState).

adj(RNG, pos(FarX, FarY), pos(X, Y), Adjs, !Rnd) :-
    Pred = (pred(Adj::out) is nondet :-
        (
            X1 = X - 1,
            Y1 = Y
        ;
            X1 = X + 1,
            Y1 = Y
        ;
            X1 = X,
            Y1 = Y + 1
        ;
            X1 = X,
            Y1 = Y - 1
        ),
        Adj = adj(pos(X1, Y1), pos(X, Y)),
        X1 >= 0, X1 < FarX,
        Y1 >= 0, Y1 < FarY
    ),
    solutions(Pred, Adjs0),
    shuffle_list(RNG, Adjs0, Adjs, !Rnd).

:- pred knock_out_wall(pos::in, pos::in, maze::in, maze::out) is det.

knock_out_wall(NewPos, OldPos, !Maze) :-
    ( if !.Maze ^ elem(NewPos) = NewSet0 then
        NewSet = set.insert(NewSet0, OldPos)
    else
        NewSet = set.make_singleton_set(OldPos)
    ),
    !Maze ^ elem(NewPos) := NewSet,
    ( if !.Maze ^ elem(OldPos) = OldSet0 then
        OldSet = set.insert(OldSet0, NewPos)
    else
        OldSet = set.make_singleton_set(NewPos)
    ),
    !Maze ^ elem(OldPos) := OldSet.

%------------------------------------------------------------------------------%
%
% Global state.
%

:- mutable(maze, maze, map.init, ground, [attach_to_io_state, untrailed]).
:- mutable(size, float, 0.0, ground, [attach_to_io_state, untrailed]).
:- mutable(pos, pos, pos(0, 0), ground, [attach_to_io_state, untrailed]).
:- mutable(dir, wall, east, ground, [attach_to_io_state, untrailed]).
:- mutable(phi, float, 0.0, ground, [attach_to_io_state, untrailed]).
:- mutable(theta, float, 0.0, ground, [attach_to_io_state, untrailed]).
:- mutable(w, wander, w(set.init, []), ground,
    [attach_to_io_state, untrailed]).

%------------------------------------------------------------------------------%
%
% Keyboard handling.
%

:- pred keyboard(char::in, int::in, int::in, io::di, io::uo) is det.

keyboard(Key, _, _, !IO) :-
    ( if char.to_int(Key, 27) then
        glut.quit(!IO)
    else
        true
    ).

%-----------------------------------------------------------------------------%
%
% Random number generator seed.
%

:- pred get_random_seed(string::in, maybe_error({uint64, uint64, uint64})::out,
    io::di, io::uo) is det.

get_random_seed(SeedStr, Result, !IO) :-
    ( if SeedStr = "" then
        open_system_rng(OpenResult, !IO),
        (
            OpenResult = ok(SysRNG),
            system_rng.generate_uint64(SysRNG, A, !IO),
            system_rng.generate_uint64(SysRNG, B, !IO),
            system_rng.generate_uint64(SysRNG, C, !IO),
            Result = ok({A, B, C}),
            close_system_rng(SysRNG, !IO)
        ;
            OpenResult = error(Msg),
            Result = error(Msg)
        )
    else if string_to_seed(SeedStr, A, B, C) then
        Result = ok({A, B, C})
    else
        Result = error("invalid value for option '-s'")
    ).

:- pred string_to_seed(string::in, uint64::out, uint64::out, uint64::out)
    is semidet.

string_to_seed(SeedStr, A, B, C) :-
    SeedStrs = string.split_at_char((','), SeedStr),
    SeedStrs = [AStr, BStr, CStr],
    string_to_uint64(AStr, A),
    string_to_uint64(BStr, B),
    string_to_uint64(CStr, C).

:- pred string_to_uint64(string::in, uint64::out) is semidet.

string_to_uint64(Str, U64) :-
    integer.from_string(Str, Integer),
    integer.to_uint64(Integer, U64).

%-----------------------------------------------------------------------------%
%
% Options processing.
%

:- pred short(char::in, option::out) is semidet.

short('x', width).
short('y', height).
short('s', seed).

:- pred long(string::in, option::out) is semidet.

long("width",  width).
long("height", height).
long("seed",   seed).

:- pred defaults(option::out, option_data::out) is multi.

defaults(width,  int(12)).
defaults(height, int(12)).
defaults(seed,   string("")).

%-----------------------------------------------------------------------------%
%
% Display list ids.
%

:- func maze_list = int.

maze_list = 7.

%-----------------------------------------------------------------------------%
:- end_module maze.
%-----------------------------------------------------------------------------%
