% crochet

% crochet

open crochet.debug;

singleton maze;
type maze-gen(Width is integer, Height is integer);
type point(X is integer, Y is integer);

type cell(Position is point);

relation y: Y* x: X* cell: Cell;
relation state: Cell-State* cell: Cell*;
relation Cell* state: Cell-State;
relation Cell* adjacent: Cell*;
relation Maze-Gen* cell: Cell*;
relation Maze-Gen* phase: Phase;

enum phase = start, cut, trace;
enum direction = north, east, south, west;
enum cell-state = cs-cut, cs-wall, cs-exposed, cs-unvisited,
                  cs-path, cs-begin, cs-end;

command point move: north = new point(self.X, self.Y - 1);
command point move: east  = new point(self.X + 1, self.Y);
command point move: south = new point(self.X, self.Y + 1);
command point move: west  = new point(self.X - 1, self.Y);

command point distance-to: (P is point) do
  let X = (P.X - self.X) as float;
  let Y = (P.Y - self.Y) as float;
  ((X ** 2) + (Y ** 2)) sqrt;
end

command cell adjacent-cells do
  let Adjacency = [
    self.Position move: north,
    self.Position move: east,
    self.Position move: south,
    self.Position move: west,
  ];
  Adjacency flat-map: (cells-at: _);
end

command cells-at: (P is point) do
  (search let X = P.X, let Y = P.Y, y: Y x: X cell: Cell).Cell;
end

command cell-at: (P is point) do
  let Cells = cells-at: P;
  condition
    when Cells is-empty => false;
    otherwise => Cells first;
  end
end

command cell set-state: (State is cell-state) do
  match
    when self state: S do
      forget state: S cell: self;
    end

    otherwise do end
  end;

  fact state: State cell: self;
  fact self state: State;
end

command cell cut do
  self set-state: cs-cut;

  match
    when self adjacent: Cell, Cell state: cs-unvisited do
      Cell set-state: cs-exposed;
    end

    otherwise do end
  end
end

command maze generate-width: Width height: Height do
  let Maze = new maze-gen(Width, Height);

  for IY in 1 to: Height, IX in 1 to: Width do
    let Point = new point(IX, IY);
    let Cell = new cell(Point);
    fact Maze cell: Cell;
    fact y: IY x: IX cell: Cell;
    Cell set-state: cs-unvisited;
  end

  for Cell in (search Maze cell: C).C do
    for Adjacent in Cell adjacent-cells do
      fact Cell adjacent: Adjacent;
    end
  end

  fact Maze phase: start;
  simulate for [Maze] until action quiescence;
  Maze;
end

action (Maze is maze-gen) initialise
when
  Maze phase: start,
  sample 1 of state: cs-unvisited cell: Cell
do
  Cell cut;
  fact Maze phase: cut;
end

action (Maze is maze-gen) cut
when
  Maze phase: cut,
  sample 1 of state: cs-exposed cell: Cell
do
  match
    when let Cells = (search Cell adjacent: C, C state: cs-cut),
         if Cells count === 1
    do
      Cell cut;
    end

    otherwise do
      Cell set-state: cs-wall;
    end
  end
end

action (Maze is maze-gen) begin-tracing
when
  Maze phase: cut,
  not state: cs-exposed cell: _,
  sample 5 of state: cs-cut cell: Start,
  sample 5 of state: cs-cut cell: Goal,
  if not (Start =:= Goal),
  not Start adjacent: Goal
rank
  Start.Position distance-to: Goal.Position
do
  fact Maze phase: trace;
  Start set-state: cs-begin;
  Goal set-state: cs-end;
end


command maze-gen draw do
  let Lines =
    for IY in 1 to: self.Height do
      let Line =
        for IX in 1 to: self.Width do
          (cell-at: new point(IX, IY)) draw;
        end;
      Line as interpolation
        |> _ flatten-into-plain-text
    end;
  
  #text from-lines: Lines;
end

command cell draw do
  let Char =
    match
      when self state: cs-cut => "_";
      when self state: cs-path => ".";
      when self state: cs-begin => "B";
      when self state: cs-end => "E";
      when self state: cs-wall => "#";
      when self state: cs-exposed => "!";
      when self state: cs-unvisited => "?";
    end;
  Char first;
end

command main: _ do
  let Maze = maze generate-width: 20 height: 20;
  Maze draw;
end

command verify: Result do
  let Expected =
"#_#?#_#___#__#_#____
___#__#_#_#_#____##_
##___#___#___##_#__#
_###__#_#__##_#___#_
___##___##B#____##__
##__#_#______##____#
___#___#_##_#__#_#__
_#___#_#__#_#_#_#__#
#_##_##__#__#____#__
___##_##__#__#_#___#
_#_______#__#?#__#__
#_#_###_#?#__#?##__#
___##____#__#_#__#__
_#____#_#_#_#__#_#_#
_#_#_#__#____#______
#_#___##__#_#__#_#_#
#___#__#_#_#__#__#__
_#_#__#_#____#_#E#_#
____#____#_#___##__#
_#_#__#_#__#_#___#__";

  assert Result === Expected;
end