113 lines
3.2 KiB
Haskell
113 lines
3.2 KiB
Haskell
module Dodge.Placement.Instance.Door (
|
|
putDoubleDoor,
|
|
putAutoDoor,
|
|
putDoubleDoorThen,
|
|
switchDoor, -- not used 9/3/22
|
|
) where
|
|
|
|
import Color
|
|
import Control.Lens
|
|
import Dodge.Data.CreatureEffect
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Door
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Dodge.LevelGen.Switch
|
|
import Geometry
|
|
|
|
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
|