77 lines
2.9 KiB
Haskell
77 lines
2.9 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 Color
|
|
import Geometry
|
|
import Dodge.LevelGen.Data
|
|
import Dodge.LevelGen.Switch
|
|
|
|
import Control.Lens
|
|
|
|
putDoubleDoor :: EdgeObstacle -> Wall -> WdBl -> Point2 -> Point2 -> Float -> Placement
|
|
putDoubleDoor eo wl cond a b speed
|
|
= putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
|
|
|
|
putDoubleDoorThen ::EdgeObstacle -> Wall -> WdBl
|
|
-> Float -> Point2 -> Point2 -> Float
|
|
-> (Placement -> Placement -> Maybe Placement)
|
|
-> Placement
|
|
putDoubleDoorThen eo wl cond soff a b speed cont
|
|
= doorBetween eo wl cond soff a half speed
|
|
$ \pl1 -> Just $ doorBetween eo wl cond soff b half speed
|
|
$ \pl2 -> cont pl1 pl2
|
|
where
|
|
half = 0.5 *.* (a +.+ b)
|
|
|
|
doorBetween :: EdgeObstacle -> Wall -> WdBl -> Float -> Point2 -> Point2 -> Float ->
|
|
(Placement -> Maybe Placement) -> Placement
|
|
doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
|
|
[x,y] -> ptCont (PutSlideDr adoor wl eo soff x y) g
|
|
(x:y:zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
|
|
_ -> undefined
|
|
where
|
|
adoor = defaultDoor
|
|
& drTrigger .~ cond
|
|
& drSpeed .~ speed
|
|
|
|
divideDoorPane :: Maybe Int -> Wall -> WdBl -> Float -> Float
|
|
-> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement
|
|
divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
|
|
[p] -> ptCont (adoor p) g
|
|
(p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
|
|
_ -> undefined
|
|
where
|
|
adoor (x,y) = PutSlideDr thedoor wl DoorObstacle soff x y
|
|
thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
|
|
& drPushedBy .~ maybe PushesItself PushedBy mid
|
|
|
|
putAutoDoor :: Point2 -> Point2 -> Placement
|
|
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
|
|
$ \az -> PlacementUsingPos (addZ 0 b)
|
|
$ \bz -> putDoubleDoor AutoDoorObstacle defaultAutoWall
|
|
(cond az bz) a b 3
|
|
where
|
|
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
|
|
cond az bz = WdBlCrFilterNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)) CrIsAnimate
|
|
-- 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 NoWorldEffect NoWorldEffect)
|
|
$ \btid -> jsps0J (doorbetween btid dra drc)
|
|
$ sps0 (doorbetween btid drb drc)
|
|
where
|
|
doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) DoorObstacle 1 a b
|
|
where
|
|
thedoor = defaultDoor
|
|
& drTrigger .~ WdBlBtOn btid
|
|
& drSpeed .~ 2
|
|
drc = 0.5 *.* (dra +.+ drb)
|
|
--cond btid w' = _btState (_buttons w' IM.! btid) == BtOn
|