diff --git a/src/Dodge/Placement/Instance/Door.hs b/src/Dodge/Placement/Instance/Door.hs index 63804492b..156163f5c 100644 --- a/src/Dodge/Placement/Instance/Door.hs +++ b/src/Dodge/Placement/Instance/Door.hs @@ -15,25 +15,25 @@ import Dodge.LevelGen.Switch import Control.Lens import qualified Data.IntMap.Strict as IM -putDoubleDoor :: Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement -putDoubleDoor wl cond a b speed - = putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing) +putDoubleDoor :: EdgeObstacle -> Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement +putDoubleDoor eo wl cond a b speed + = putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing) -putDoubleDoorThen :: Wall -> (World -> Bool) +putDoubleDoorThen ::EdgeObstacle -> Wall -> (World -> Bool) -> 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 +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 :: Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float -> +doorBetween :: EdgeObstacle -> Wall -> (World -> Bool) -> 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 DoorObstacle soff x y) g +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 @@ -55,7 +55,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of putAutoDoor :: Point2 -> Point2 -> Placement putAutoDoor a b = PlacementUsingPos (addZ 0 a) $ \az -> PlacementUsingPos (addZ 0 b) - $ \bz -> putDoubleDoor defaultAutoWall + $ \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 diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index 8f46e5a8f..49980bd8f 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -27,8 +27,8 @@ airlock0 = defaultRoom , _rmPath = foldMap doublePairSet [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ] , _rmPmnts = [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id) - $ \btid -> Just $ putDoubleDoorThen thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2 - $ \_ _ -> Just $ putDoubleDoor thewall (cond' btid) (V2 0 80) (V2 40 80) 2 + $ \btid -> Just $ putDoubleDoorThen DoorObstacle thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2 + $ \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (cond' btid) (V2 0 80) (V2 40 80) 2 , invisibleWall $ rectNSWE 60 40 (-40) (-30) ,spanLightI (V2 (-2) 30) (V2 (-2) 70) ,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50) diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index a75a5426b..54ebd92e6 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -40,6 +40,6 @@ triggerDoorRoom inplid = defaultRoom -- note no bounds } where - f (pmnt:_) = putDoubleDoor (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2 + f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2 f _ = error "tried to put a door using an empty placement list" cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 7f95f2335..8b0a530d8 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -118,7 +118,7 @@ addButtonSlowDoor x h rm = do thewall = switchWallCol red butDoor = putLitButOnPos col (rprBool (isUnusedLnkType InLink)) - $ \btplmnt -> Just $ putDoubleDoorThen thewall (cond' $ fromJust $ _plMID btplmnt) + $ \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (cond' $ fromJust $ _plMID btplmnt) 30 (V2 0 h) (V2 x h) 2 $ \dr1 dr2 -> amountedlight dr1 50