106 lines
2.8 KiB
Haskell
106 lines
2.8 KiB
Haskell
module Dodge.Placement.Instance.Door (
|
|
putDoubleDoor,
|
|
putAutoDoor,
|
|
putDoubleDoorThen,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Dodge.Data.CreatureEffect
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.Default.Door
|
|
import Dodge.Default.Wall
|
|
import Dodge.Door.PutSlideDoor
|
|
import Dodge.LevelGen.PlacementHelper
|
|
import Geometry
|
|
import Linear
|
|
|
|
putDoubleDoor ::
|
|
Wall ->
|
|
WdBl ->
|
|
Point2 ->
|
|
Point2 ->
|
|
Float ->
|
|
Placement
|
|
putDoubleDoor wl cond a b speed =
|
|
putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
|
|
|
|
putDoubleDoorThen ::
|
|
Wall ->
|
|
WdBl ->
|
|
Float ->
|
|
Point2 ->
|
|
Point2 ->
|
|
Float ->
|
|
(Placement -> Placement -> Maybe Placement) ->
|
|
Placement
|
|
putDoubleDoorThen wl cond soff a b speed cont =
|
|
doorBetween wl cond soff a half speed $
|
|
\pl1 -> Just $
|
|
doorBetween wl cond soff b half speed $
|
|
\pl2 -> cont pl1 pl2
|
|
where
|
|
half = 0.5 *^ (a + b)
|
|
|
|
doorBetween ::
|
|
Wall ->
|
|
WdBl ->
|
|
Float ->
|
|
Point2 ->
|
|
Point2 ->
|
|
Float ->
|
|
(Placement -> Maybe Placement) ->
|
|
Placement
|
|
doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
|
|
-- [x, y] -> ptCont (putSlideDr adoor wl soff x y) g
|
|
(x : y : zs) ->
|
|
divideDoorPane
|
|
Nothing
|
|
wl
|
|
cond
|
|
(soff - dist y pb)
|
|
speed
|
|
(zip (x : y : zs) (y : zs))
|
|
g
|
|
_ -> error "tried to create doorBetween with too few points"
|
|
-- where
|
|
-- adoor =
|
|
-- defaultDoor
|
|
-- & drTrigger .~ cond
|
|
-- & drUpdate .~ DoorLerp 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 soff x y
|
|
thedoor =
|
|
defaultDoor
|
|
& drUpdate . drLerpSpeed .~ speed
|
|
& drTrigger .~ cond
|
|
& drPushedBy .~ maybe PushesItself PushedBy mid
|
|
|
|
putAutoDoor :: Point2 -> Point2 -> Placement
|
|
putAutoDoor a b = Placement (PS 0 0) (PutCoord a) Nothing Nothing $ \_ apl ->
|
|
Just $
|
|
Placement (PS 0 0) (PutCoord b) Nothing Nothing $ \w bpl ->
|
|
let x = w ^?! gwWorld . coordinates . ix (apl ^?! plMID . _Just)
|
|
y = w ^?! gwWorld . coordinates . ix (bpl ^?! plMID . _Just)
|
|
in Just $
|
|
putDoubleDoor
|
|
defaultAutoWall
|
|
(WdBlCrFilterNearPoint 40 (0.5 *^ (x + y)) CrIsAnimate)
|
|
a
|
|
b
|
|
3
|