47 lines
2.1 KiB
Haskell
47 lines
2.1 KiB
Haskell
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
|