48 lines
1.3 KiB
Haskell
48 lines
1.3 KiB
Haskell
--{-# LANGUAGE BangPatterns #-}
|
|
{- |
|
|
Creation of doors that open when creatures approach them.
|
|
-}
|
|
module Dodge.LevelGen.AutoDoor
|
|
( addAutoDoor
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Creature.Property
|
|
--import Dodge.LevelGen.MoveDoor
|
|
import Dodge.LevelGen.DoorPane
|
|
--import Geometry
|
|
import Picture
|
|
import Geometry.Data
|
|
--import qualified DoubleStack as DS
|
|
import qualified IntMapHelp as IM
|
|
|
|
--import Data.List
|
|
--import Data.Maybe
|
|
import Control.Lens
|
|
--import Control.DeepSeq (deepseq)
|
|
|
|
addAutoDoor
|
|
:: Point2 -- ^ Left point
|
|
-> Point2 -- ^ Right point (though the two points should be symmetric)
|
|
-> World
|
|
-> World
|
|
addAutoDoor a b = over walls (autoDoorAt a b)
|
|
|
|
autoDoorAt
|
|
:: Point2 -- ^ Left point
|
|
-> Point2 -- ^ Right point (though the two points should be symmetric)
|
|
-> IM.IntMap Wall
|
|
-> IM.IntMap Wall
|
|
autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
|
|
where
|
|
is = [IM.newKey wls..]
|
|
|
|
mkAutoDoor
|
|
:: Point2 -- ^ Left point
|
|
-> Point2 -- ^ Right point (though the two points should be symmetric)
|
|
-> [Int] -- ^ Wall ids
|
|
-> [Wall]
|
|
mkAutoDoor pl pr = mkDoubleDoor (dim yellow) True cond pl pr 3
|
|
where
|
|
cond = any (crNearSeg 40 pl pr) . IM.filter isAnimate . _creatures
|