Check wall collisions when expanding

src/Dodge/Creature/Action.hs

@@ -8,7 +8,7 @@ module Dodge.Creature.Action
     , dropUnselected
     , startReloadingWeapon
     , blinkAction
-    , sizeSelf
+    , maybeSizeSelf
     , crAutoReload
     , copyItemToFloor
     , youDropItem
@@ -17,6 +17,7 @@ module Dodge.Creature.Action
     where
 import Dodge.Path
 import Dodge.Default
+import Dodge.WallCreatureCollisions
 import Dodge.Creature.Stance.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
@@ -199,7 +200,7 @@ blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan
 setMinInvSize :: Int -> Creature -> World -> World
 setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 
   where
-    f inv = IM.unionWith (\x _ -> x) inv $ IM.fromList $ [0..n-1] <&> (, NoItem)
+    f inv = IM.unionWith const inv $ IM.fromList $ [0..n-1] <&> (, NoItem)
 
 stripNoItems :: Creature -> World -> World
 stripNoItems cr = creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f
@@ -269,21 +270,24 @@ pickUpItem cid flit w = case maybeInvSlot of
         Nothing -> w'
         Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
 
-sizeSelf :: Float -> Creature -> World -> World
+maybeSizeSelf :: Float -> Creature -> World -> Maybe World
-sizeSelf x cr w = w
+maybeSizeSelf x cr w 
-    & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
+    | _crPos cr1 == _crPos cr2 = Just $ w
-    & over distortions (distortionBulge :)
+        & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
---    & inverseShockwaveAt cpos 40 0 2
+        & over distortions (distortionBulge :)
-    & creatures . ix cid %~ 
+        & creatures . ix cid %~ 
-        ( (crRad .~ 10 * x) 
+            ( (crRad .~ 10 * x) 
-        . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
+            . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
-        . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
+            . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
-        )
+            )
+    | otherwise = Nothing
   where
+    cr1 = colCrWall w (cr {_crRad = 10* x})
+    cr2 = colCrWall w cr1
     distR = 120
     distortionBulge 
-        | _crRad cr < 10 * x 
+        | _crRad cr < 10*x  = raddist 1.9
-            = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+        | otherwise         = raddist 0.1
-        | otherwise = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 0.1
+    raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR)
     cid  = _crID cr
     cpos = _crPos cr

src/Dodge/Distortion/Data.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Distortion.Data where
 import Geometry

src/Dodge/Item/Weapon/Utility.hs

@@ -38,13 +38,11 @@ shrinkGun = defaultGun
     }
 
 useShrinkGun :: Item -> Creature -> World -> World
-useShrinkGun it cr = case _itBool $ _itAttachment it of
+useShrinkGun it cr w = if _itBool $ _itAttachment it
-    True -> sizeSelf 0.5 cr . f False UndroppableIdentified
+    then tryResize 0.5 $ f False UndroppableIdentified . stripNoItems cr . dropUnselected cr
-                . stripNoItems cr
+    else tryResize 1   $ f True Uncursed . setMinInvSize defaultInvSize cr
-                . dropUnselected cr
-    False -> sizeSelf 1 cr . f True Uncursed
-                . setMinInvSize defaultInvSize cr
   where
+    tryResize x g = maybe w g $ maybeSizeSelf x cr w
     f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~
         ( (itAttachment . itBool .~ isInUse) . (itCurseStatus .~ cstatus) )
 

src/Dodge/Render/HUD.hs

@@ -108,9 +108,7 @@ renderItemMapAt :: Float -> Float -> World -> IM.IntMap Item -> Picture
 renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
 
 displayInv :: Int -> World -> Picture
-displayInv n w = renderItemMapAt 0 0 w items
+displayInv n w = renderItemMapAt 0 0 w . _crInv $ _creatures w IM.! n
-  where 
-    items = _crInv $ _creatures w IM.! n
 
 drawLocations :: World -> Picture
 drawLocations w = pictures $ 
@@ -204,7 +202,9 @@ itemText :: Item -> Picture
 itemText NoItem = text "----"
 itemText it = case _itCurseStatus it of
     UndroppableIdentified -> color black (text (_itInvDisplay it it)) 
-        <> color (withAlpha 0.5 thecolor) (polygon (rectNSEW 120 (-70) 900 (-100)))
+        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 110 (-65) 885 (-90)))
+--        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 115 (-70) 895 (-95)))
+--        <> color (withAlpha 0.9 thecolor) (polygon (rectNSEW 120 (-70) 900 (-100)))
     _ -> color thecolor $ text (_itInvDisplay it it)
   where
     thecolor = _itInvColor it

src/Dodge/Room/Corridor.hs

@@ -29,6 +29,13 @@ corridor = defaultRoom
         ,((20,70), negate $ pi/6)
         ,((20,10)    ,pi)
         ]
+keyholeCorridor :: Room
+keyholeCorridor = corridor
+    { _rmPath  = []
+    , _rmPmnts = [ lowWall $ rectNSEW 50 30 0 15
+        , lowWall $ rectNSEW 50 30 25 40]
+    }
+    
 corridorN :: Room
 corridorN = defaultRoom
     { _rmPolys = [rectNSWE 80 0 0 40

src/Dodge/Room/Start.hs

@@ -7,6 +7,7 @@ import Dodge.Default
 import Dodge.Layout.Tree.Either
 import Dodge.RandomHelp
 import Dodge.Room.Door
+import Dodge.Room.Corridor
 import Dodge.Room.Room
 import Dodge.Room.Link
 import Dodge.Room.Procedural
@@ -27,13 +28,22 @@ import Control.Lens
 import System.Random
 --import qualified Data.IntMap.Strict as IM
 
+minigunfakeout :: RandomGen g => State g (Tree (Either Room Room))
+minigunfakeout = do
+    rcol <- rezColor
+    ncor <- state $ randomR (1,5)
+    return $ ([Left $ rezBox rcol,Left door] ++ replicate ncor (Left corridor)
+            ++ [Left keyholeCorridor,Left corridor])
+        `treeFromPost` Right door
+
 startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = join $ takeOne 
-    [ rezBoxesWp
+    [ minigunfakeout
-    , rezBoxesThenWeaponRoom
+    --, rezBoxesWp
-    , rezBoxThenWeaponRoom
+    --, rezBoxesThenWeaponRoom
-    , rezBoxesWpCrit
+    --, rezBoxThenWeaponRoom
-    , runPastStart
+    --, rezBoxesWpCrit
+    --, runPastStart
     ]
 
 runPastStart :: RandomGen g => State g (Tree (Either Room Room))

src/Dodge/WallCreatureCollisions.hs

@@ -1,6 +1,7 @@
 {- | Deals with moving creature wall collisions.  -}
 module Dodge.WallCreatureCollisions 
     ( colCrsWalls
+    , colCrWall
     ) where
 import Dodge.Data
 --import Dodge.Data.DamageType
@@ -16,13 +17,15 @@ import Control.Lens
 import qualified Data.IntMap.Strict as IM
 
 colCrsWalls :: World -> World
-colCrsWalls w = over creatures (fmap (colCrWall w)) w
+colCrsWalls w = w & creatures %~ fmap (colCrWall w)
 
 colCrWall :: World -> Creature -> Creature
 colCrWall w c 
     | noclipIsOn && _crID c == 0 = c -- for noclip
     | p1 == p2  = pushOrCrush ls c
-    | otherwise = c & crPos %~ pushOutFromWalls rad ls 
+    | otherwise = c & crPos %~ 
+        pushOutFromWalls rad (reverse ls)
+        . pushOutFromWalls rad ls 
         . flip (collidePointWalls p1) wls  -- check push throughs
   where 
     rad = _crRad c + wallBuffer
@@ -60,12 +63,12 @@ pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
 -- assumes wall points are different
 pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
 pushOutFromWall rad cp2 (wp1,wp2) 
-    | isOnWall  = Just newP -- +.+ (1 *.* norm))
+    | isOnWall  = Just newP
     | otherwise = Nothing
   where 
     norm = errorNormalizeV 61 $ vNormal (wp1 -.- wp2)
-    wp1' = (rad *.* norm) +.+ wp1
+    wp1' = wp1 +.+ rad *.* norm
-    wp2' = (rad *.* norm) +.+ wp2
+    wp2' = wp2 +.+ rad *.* norm
     newP = errorClosestPointOnLine 5 wp1' wp2' cp2
     isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad