module Dodge.LevelGen.InnerWalls
  where
import Dodge.Data
import Dodge.Base

import Geometry

import Control.Lens
import qualified Data.IntMap as IM

------------------------------------------------------------------------------------
-- idea: create inner walls to draw and to cast shadows
createInnerWalls :: IM.IntMap Wall -> IM.IntMap Wall
createInnerWalls wls = IM.map (createInnerWall wls) wls

createInnerWall :: IM.IntMap Wall -> Wall -> Wall
createInnerWall walls wl = wl & wlLine %~ \l -> l ++ [wlL,wlR]
  where wl0 = _wlLine wl !! 0
        wl1 = _wlLine wl !! 1
        wlLeft = findWallLeft wl walls
        wlRight = findWallRight wl walls
        wlN = normalizeV $ vNormal $ wl1 -.- wl0
        rN = normalizeV $ vNormal $ (_wlLine wlRight !! 1) -.- (_wlLine wlRight !! 0)
        lN = normalizeV $ vNormal $ (_wlLine wlLeft  !! 1) -.- (_wlLine wlLeft  !! 0)
        wlR = wl0 +.+ 20 *.* normalizeV (wlN +.+ rN)
        wlL = wl1 +.+ 20 *.* normalizeV (wlN +.+ lN)

findWallLeft :: Wall -> IM.IntMap Wall -> Wall
findWallLeft wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsLeft (_wlLine wl !! 1) wls of
    [w] -> w
    wls   -> error $ "findWallLeft: " ++ show (map _wlID wls)
                                                                 ++ " wlLines: "++ show (map _wlLine wls)

findWallRight :: Wall -> IM.IntMap Wall -> Wall
findWallRight wl wls = case filter (\w -> _wlID w /= _wlID wl) $ IM.elems $ findWallsRight (_wlLine wl !! 0) wls of
    [w] -> w
    wls   -> error $ "findWallRight: wall with ID " ++ show (_wlID wl) ++ " and points " ++
                    show (_wlLine wl) ++ "\nhas a right corner with and only with the walls "
                    ++ show (map _wlID wls) ++ "\nwlLines "++ show (map _wlLine wls)
                    ++ "\nUnless a wall has a corner with exactly one other wall, there is a problem"

findWallsLeft :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
findWallsLeft x wls = IM.filter (\wl -> dist x (_wlLine wl !! 0) < 1) wls

findWallsRight :: Point2 -> IM.IntMap Wall -> IM.IntMap Wall
findWallsRight x wls = IM.filter (\wl -> dist x (_wlLine wl !! 1) < 1) wls