diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 86af02a18..8ab6a9865 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 -sizeSelf x cr w = w - & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing - & over distortions (distortionBulge :) --- & inverseShockwaveAt cpos 40 0 2 - & creatures . ix cid %~ - ( (crRad .~ 10 * x) - . (crMvType . mvSpeed .~ yourDefaultSpeed * x) - . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x)) - ) +maybeSizeSelf :: Float -> Creature -> World -> Maybe World +maybeSizeSelf x cr w + | _crPos cr1 == _crPos cr2 = Just $ w + & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing + & over distortions (distortionBulge :) + & creatures . ix cid %~ + ( (crRad .~ 10 * x) + . (crMvType . mvSpeed .~ yourDefaultSpeed * 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 - = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9 - | otherwise = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 0.1 + | _crRad cr < 10*x = raddist 1.9 + | otherwise = raddist 0.1 + raddist = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) cid = _crID cr cpos = _crPos cr diff --git a/src/Dodge/Distortion/Data.hs b/src/Dodge/Distortion/Data.hs index 262915205..89531f963 100644 --- a/src/Dodge/Distortion/Data.hs +++ b/src/Dodge/Distortion/Data.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +--{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StrictData #-} module Dodge.Distortion.Data where import Geometry diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index da5ae6efd..53f6b0f4a 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/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 - True -> sizeSelf 0.5 cr . f False UndroppableIdentified - . stripNoItems cr - . dropUnselected cr - False -> sizeSelf 1 cr . f True Uncursed - . setMinInvSize defaultInvSize cr +useShrinkGun it cr w = if _itBool $ _itAttachment it + then tryResize 0.5 $ f False UndroppableIdentified . stripNoItems cr . dropUnselected cr + else tryResize 1 $ 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) ) diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 8f33b84ef..940e2e1a5 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 - where - items = _crInv $ _creatures w IM.! n +displayInv n w = renderItemMapAt 0 0 w . _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 diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index ace0112e0..56ea6a685 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/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 diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index 477eb3eb1..99f3e7ba5 100644 --- a/src/Dodge/Room/Start.hs +++ b/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 - , rezBoxesThenWeaponRoom - , rezBoxThenWeaponRoom - , rezBoxesWpCrit - , runPastStart + [ minigunfakeout + --, rezBoxesWp + --, rezBoxesThenWeaponRoom + --, rezBoxThenWeaponRoom + --, rezBoxesWpCrit + --, runPastStart ] runPastStart :: RandomGen g => State g (Tree (Either Room Room)) diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index 3d059c194..01fc499ce 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/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 - wp2' = (rad *.* norm) +.+ wp2 + wp1' = wp1 +.+ rad *.* norm + wp2' = wp2 +.+ rad *.* norm newP = errorClosestPointOnLine 5 wp1' wp2' cp2 isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad