module LevelGen (
  gen_cave
) where

import Control.Monad.State
import Data.Set hiding (filter, map, partition, split)
import Data.Array ((//), array, bounds, range)
import Data.List (partition, sortBy)
import Data.Ratio
import System.Random

import Util.Grid
import RandT
import Materials
import Landscape
import Monsters
import MonsterGen

-- add_rift :: Position -> Position -> RandT State Landscape ()
-- add_rift (minx, miny) (maxx, maxy) = do
--  zags <- rnd (3, 6)
--  xs <- sequence $ replicate zags $ rnd (minx, maxx)
--  ys <- sequence $ replicate zags $ rnd (miny, maxy)
--  points <- choice [
--    return $ zip (sort xs) ys,   -- left-to-right rift
--    return $ zip xs (sort ys)    -- top-to-bottom rift
--    ]

-- Partition a list of positions into the smallest possible number of
-- lists of connected positions. For each list in the result, any
-- position in the list is reachable from any other position in the list.
areas :: [Position] -> [[Position]]
areas ps = areasSet (fromList ps)

areasSet :: Set Position -> [[Position]]
areasSet s = case elems s of
  [] -> []
  (p : _) -> areas_inner [] ((flip delete) s p) [p]

areas_inner :: [Position] -> Set Position -> [Position] -> [[Position]]
areas_inner part s [] = part : areasSet s
areas_inner part s (n : ns) =
  let np = filter (`member` s) (neighbours n)
      s' = s `difference` (fromList np)
  in areas_inner (n : part) s' (np ++ ns)

areas_merge :: [Position] -> [[Position]] -> ([Position], [[Position]])
areas_merge _ [] = ([], [])
areas_merge newpoints (ps : pss) =
  if any (\n -> any (is_neighbour n) ps) newpoints
    then (ps ++ merged, as)
    else (merged, ps : as)
 where (merged, as) = areas_merge newpoints pss

make_doorlike :: Position -> RandT (State Landscape) ()
make_doorlike pos = do
  feature <- choice $ (map return) [
    Feature Floor Stone,
    Feature Doorway Stone,
    Feature ClosedDoor Wood,
    Feature ClosedDoor Stone,
    Feature LockedDoor Wood,
    Feature LockedDoor Stone,
    Feature LockedDoor Iron,
    Feature OpenDoor Wood,
    Feature OpenDoor Stone
    ]
  lift $ modify (// [(pos, feature)])

-- Create a path from p1 to p2, constructing doors or digging corridors
-- as necessary.  Return the squares that have been turned from walls to
-- walkable areas.
make_path :: Position -> Position -> RandT (State Landscape) ([Position], [Position])
make_path p1 p2 = do
  land <- lift $ get
  -- Our cost function: try to find a path that avoids going through walls.
  let costf pos = if is_wall land pos then 10 else 1
  let path = shortest_path costf p1 p2
  -- We only need to fiddle with the walls in the path.
  let walls = filter (is_wall land) path
  let (solidwalls, edgewalls) = partition (solid_wall land) walls
  lift $ modify $ make_floors solidwalls
  sequence_ $ map make_doorlike edgewalls
  return (edgewalls, solidwalls)
 where solid_wall :: Landscape -> Position -> Bool
       solid_wall land pos = all (is_wall land) (neighbours pos)
       make_floors :: [Position] -> Landscape -> Landscape
       make_floors ps land = land // zip ps (repeat (Feature Floor Stone))

-- Make sure all floor areas are connected.  Do this by adding doors
-- and corridors.
connect_areas :: RandT (State Landscape) ()
connect_areas = do
  land <- lift get
  let points = [ pos | pos <- range (bounds land), not (is_wall land pos) ]
  connect_areas' (areas points)
 where
  -- If there aren't at least two partitions, then we have nothing to do.
  connect_areas' [] = return ()
  connect_areas' [_] = return ()
  connect_areas' pss = do
    -- Connect smallest areas first.  This tends to reduce make_path
    -- cost, because small areas tend to either be close together
    -- (cheap make_path) or have at least one other area between
    -- them (fewer make_path calls).
    let areasize a1 a2 = compare (length a1) (length a2)
    let (ps1 : ps2 : _) = sortBy areasize pss
    p1 <- rnd (0, length ps1 - 1)
    p2 <- rnd (0, length ps2 - 1)
    (edgepoints, tunnelpoints) <- make_path (ps1 !! p1) (ps2 !! p2)
    -- make_path might have connected more than ps1 and ps2.
    let (merged, pss') = areas_merge edgepoints pss
    let newp1 = ps1 ++ ps2 ++ edgepoints ++ tunnelpoints ++ merged
    connect_areas' (newp1 : pss')

-- Make a heightfield smoother by making each position the average of
-- all its neighbours.
smooth :: (Integral a) => (Position -> a) -> (Position -> a)
smooth f = \pos -> (sum $ map f $ neighbours_and_self pos) `div` 9

cavescape :: (Position, Position) -> Int -> (Position -> Int) -> Landscape
cavescape (from, to) threshold f =
  array (from, to) (zip ixs (map (tocave . f) ixs))
  where
    ixs = range (from, to)
    tocave :: Int -> Feature
    tocave x | x < threshold = Feature Wall Stone
    tocave _ = Feature Floor Stone

make_cave :: RandT (State Landscape) ()
make_cave = do
  maxx <- rnd (60, 100)
  maxy <- rnd (60, 100)
  threshold <- rnd (90, 110)
  let area = ((0, 0), (maxx, maxy))
  start_cave <- random_field (0, 200) area
  lift $ put $ cavescape area threshold (smooth start_cave)
  connect_areas

make_cave_monsters :: Landscape -> RandT (State Monsters) ()
make_cave_monsters land =
  let spaces = [ pos | pos <- range (bounds land), is_floor land pos ]
  in sequence_ $ map maybe_monster spaces
  where
    maybe_monster loc = perhaps (1 % 20) $ do
      mon <- generate cave_monster
      lift $ modify $ add_monster mon loc

gen_cave :: (RandomGen g) => g -> (Landscape, Monsters)
gen_cave g = (land, mons)
  where land = execState (evalRandT make_cave lg) undefined
        mons = execState (evalRandT (make_cave_monsters land) mg) new_monsters
        (lg, mg) = split g