77 lines
3.0 KiB
Haskell
77 lines
3.0 KiB
Haskell
module Dodge.Placement.Instance.Door
|
|
( putDoubleDoor
|
|
, putAutoDoor
|
|
, putDoubleDoorThen
|
|
, switchDoor -- not used 9/3/22
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Default.Door
|
|
--import Dodge.Base
|
|
import Color
|
|
import Geometry
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.Creature.Test
|
|
import Dodge.LevelGen.Switch
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
putDoubleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
|
|
putDoubleDoor pathing col cond a b speed
|
|
= putDoubleDoorThen pathing col cond 1 a b speed (const $ const Nothing)
|
|
|
|
putDoubleDoorThen :: Bool -> Color -> (World -> Bool)
|
|
-> Float -> Point2 -> Point2 -> Float
|
|
-> (Placement -> Placement -> Maybe Placement)
|
|
-> Placement
|
|
putDoubleDoorThen pathing col cond soff a b speed cont
|
|
= doorBetween pathing col cond soff a half speed
|
|
$ \pl1 -> Just $ doorBetween pathing col cond soff b half speed
|
|
$ \pl2 -> cont pl1 pl2
|
|
where
|
|
half = 0.5 *.* (a +.+ b)
|
|
|
|
doorBetween :: Bool -> Color -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
|
|
(Placement -> Maybe Placement) -> Placement
|
|
doorBetween pathing col cond soff pa pb speed g = case divideLine 40 pa pb of
|
|
[x,y] -> ptCont (PutSlideDr pathing col adoor soff x y) g
|
|
(x:y:zs) -> divideDoorPane Nothing pathing col cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
|
|
_ -> undefined
|
|
where
|
|
adoor = defaultDoor
|
|
& drTrigger .~ cond
|
|
& drSpeed .~ speed
|
|
|
|
divideDoorPane :: Maybe Int -> Bool -> Color -> (World -> Bool) -> Float -> Float
|
|
-> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement
|
|
divideDoorPane mid pathing col cond soff speed ppairs g = case ppairs of
|
|
[p] -> ptCont (adoor p) $ g
|
|
(p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) pathing col cond soff speed ps g
|
|
_ -> undefined
|
|
where
|
|
adoor (x,y) = PutSlideDr pathing col thedoor soff x y
|
|
thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
|
|
& drSupport .~ maybe SupportsItself SupportedBy mid
|
|
|
|
putAutoDoor :: Point2 -> Point2 -> Placement
|
|
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
|
|
$ \az -> PlacementUsingPos (addZ 0 b)
|
|
$ \bz -> putDoubleDoor True (dim yellow) (cond az bz) a b 3
|
|
where
|
|
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
|
|
cond az bz = any (crNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)))
|
|
. IM.filter isAnimate . _creatures
|
|
|
|
switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
|
|
switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeSwitch col red id id)
|
|
$ \btid -> jsps0J (doorbetween btid dra drc)
|
|
$ sps0 (doorbetween btid drb drc)
|
|
where
|
|
doorbetween btid a b = PutSlideDr False col thedoor 1 a b
|
|
where
|
|
thedoor = defaultDoor
|
|
& drTrigger .~ cond btid
|
|
& drSpeed .~ 2
|
|
drc = 0.5 *.* (dra +.+ drb)
|
|
cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|