From 5f17841811a95880f43aa1f3dd029432420fad43 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 1 Oct 2021 09:51:47 +0100 Subject: [PATCH] Fix placement movement bug --- src/Dodge/Floor.hs | 2 +- src/Dodge/Placement.hs | 7 +++++-- src/Dodge/Room/Link.hs | 1 + src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Room/NoNeedWeapon.hs | 7 +++---- src/Dodge/Room/Procedural.hs | 30 ++++++++++++------------------ 6 files changed, 23 insertions(+), 26 deletions(-) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 12af22b46..3b2bda78f 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -74,7 +74,7 @@ initialRoomTree = do ,[SpecificRoom $ pure $ (pure . Right) (twinSlowDoorRoom 80 200 40)] ,[Corridor] ,[DoorAno] - ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50] + ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit] ,[SpecificRoom blockedCorridor] ,[OrAno [[DoorAno] ,[Corridor] diff --git a/src/Dodge/Placement.hs b/src/Dodge/Placement.hs index cc3c04ad2..7530eaf71 100644 --- a/src/Dodge/Placement.hs +++ b/src/Dodge/Placement.hs @@ -9,8 +9,11 @@ jsps0 pst = Just $ sPS (V2 0 0) 0 pst sps0 :: PSType -> Placement sps0 pst = sPS (V2 0 0) 0 pst -jspsJ :: PSType -> Placement -> Maybe Placement -jspsJ pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm +jspsJ :: Point2 -> Float -> PSType -> Placement -> Maybe Placement +jspsJ p a pst plm = Just $ Placement (PS p a pst) $ \_ -> Just plm + +jsps0J :: PSType -> Placement -> Maybe Placement +jsps0J pst plm = Just $ Placement (PS (V2 0 0) 0 pst) $ \_ -> Just plm place0 :: PSType -> (Int -> Maybe Placement) -> Placement place0 pst = Placement (PS (V2 0 0) 0 pst) diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index c21bea3ef..32156e305 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -91,6 +91,7 @@ shiftPSBy shiftPSBy (pos,rot) ps = ps & placementSpot . psPos %~ shiftPointBy (pos,rot) & placementSpot . psRot %~ (+ rot) + & idPlacement %~ fmap (fmap $ shiftPSBy (pos,rot)) shiftPathPointBy :: (Point2,Float) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 7f7af4cfe..c469019e0 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -41,7 +41,7 @@ twinSlowDoorRoom w h x = defaultRoom , _rmPath = [] , _rmPS = [ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeSwitch col red id id) - $ \btid -> jspsJ (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed) + $ \btid -> jsps0J (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed) $ place0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed) $ \did -> Just $ place0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0)) $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight diff --git a/src/Dodge/Room/NoNeedWeapon.hs b/src/Dodge/Room/NoNeedWeapon.hs index c3cf47843..b946abcf3 100644 --- a/src/Dodge/Room/NoNeedWeapon.hs +++ b/src/Dodge/Room/NoNeedWeapon.hs @@ -25,9 +25,8 @@ To solve this, here we delete unwanted links. -} centerVaultExplosiveExit :: RandomGen g - => Int -- ^ Door id - -> State g Room -centerVaultExplosiveExit drid = do + => State g Room +centerVaultExplosiveExit = do cr <- takeOne [miniGunCrit, autoCrit] let extraPS = [sPS (V2 0 175) 0 $ PutCrit explosiveBarrel @@ -36,5 +35,5 @@ centerVaultExplosiveExit drid = do ,sPS (V2 (-4) 195) 0 $ PutCrit explosiveBarrel ,sPS (V2 0 0) 0 $ PutCrit (cr & crState . crDropsOnDeath .~ DropAll) ] - r <- centerVaultRoom drid 200 200 50 <&> rmPS %~ (extraPS ++) + r <- centerVaultRoom 200 200 50 <&> rmPS %~ (extraPS ++) randomiseLinksBy shuffleTail r <&> rmLinks %~ take 2 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index 07f7b7403..61158f6bf 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -34,7 +34,8 @@ import Data.Tile --import Data.List --import Data.Function (on) --import qualified Data.Tuple.Extra as Tup -import qualified Data.Map as M +--import qualified Data.Map.Strict as M +import qualified Data.IntMap.Strict as IM import Control.Lens import Control.Monad import Control.Monad.State @@ -215,19 +216,12 @@ randomFourCornerRoom = do {- | Creates room with a central vault with doors around it. -} centerVaultRoom - :: Int -- ^ Door id - -> Float -- ^ Width + :: Float -- ^ Width -> Float -- ^ Height -> Float -- ^ Vault dimensions -> State g Room -centerVaultRoom n w h d = do - let northPoly = rectNSWE h d (-w) w - nsDoors = rectNSWE (d + 20) (negate (d +20)) (-20) 20 - weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) - centerPoly = rectWdthHght (d - 20) (d - 20) - --polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly) +centerVaultRoom w h d = do return $ defaultRoom - --{ _rmPolys = polys { _rmPolys = [rectNSWE h (-h) (-w) w] , _rmLinks = [(V2 0 h , 0 ) @@ -247,17 +241,17 @@ centerVaultRoom n w h d = do ,mountedLight (V2 w (h/2-20)) (V3 (w-20) (h/2-20) 70) ,mountedLightV (V2 0 (d-20)) (V3 0 0 70) ] - ++ concat (zipWith (\i r -> map (shiftPSBy (V2 0 0,r)) $ theDoor i) - [n, n+1, n+2, n+3] [0,pi/2,pi,3*pi/2]) + ++ concat (map (\r -> map (shiftPSBy (V2 0 0,r)) $ theDoor) + [0,pi/2,pi,3*pi/2]) , _rmBound = [rectNSWE h (-h) (-w) w] } where col = dim $ dim $ bright red - theDoor i = - [ sPS (V2 0 (d-10)) 0 $ PutDoubleDoor col (cond i) (V2 (-21) 0) (V2 21 0) 2 - , sPS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red - (over worldState (M.insert (DoorNumOpen i) True)) - (over worldState (M.insert (DoorNumOpen i) False)) + theDoor = + [ Placement (PS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red id id) + $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 (-21) 0) (V2 0 0) 2) + $ sPS (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 21 0) (V2 0 0) 2) ] - cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w') + --cond i w' = or $ M.lookup (DoorNumOpen i) (_worldState w') + cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn