From 51d89982ed2c368c50ab1f4eaecce1423529e4be Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 19 Nov 2021 22:43:46 +0000 Subject: [PATCH] Readd wall corner collisions --- src/Dodge/Creature/Action.hs | 14 ++++++++++++-- src/Dodge/Event.hs | 1 + src/Dodge/Item/Attachment.hs | 3 +-- src/Dodge/Item/Weapon/BatteryGuns.hs | 5 +---- src/Dodge/Item/Weapon/Utility.hs | 11 ++++++++--- src/Dodge/LevelGen/StaticWalls.hs | 1 + src/Dodge/WallCreatureCollisions.hs | 29 ++++++++++++++++++---------- src/Padding.hs | 6 ++++++ 8 files changed, 49 insertions(+), 21 deletions(-) diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index 1dfba881e..cdc8af41f 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -36,7 +36,7 @@ import Control.Lens --import Control.Monad --import Control.Applicative import Data.Maybe ---import Data.List +import Data.List (findIndex) import System.Random import Control.Monad.Reader --import qualified Data.Map as M @@ -203,11 +203,21 @@ setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 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 +stripNoItems cr = organiseInvKeys (_crID cr) . + ( creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f ) where f NoItem = Nothing f x = Just x +organiseInvKeys :: Int -> World -> World +organiseInvKeys cid w = w & creatures . ix cid %~ + ( ( crInvSel .~ newSelKey ) . (crInv .~ newInv ) ) + where + cr = _creatures w IM.! cid + pairs = IM.toList (_crInv cr) + newSelKey = fromJust $ findIndex ( (== _crInvSel cr) . fst) pairs + newInv = IM.fromAscList $ zip [0..] $ map snd pairs + dropUnselected :: Creature -> World -> World dropUnselected cr w = foldr (dropItem cr) w . IM.keys $ _crInvSel cr `IM.delete` _crInv cr diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 9b6aa3d7b..0cb5beb33 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -131,6 +131,7 @@ moveYourAmmoParam i w = case yourItem w ^? wpAmmo . amPjParams . ix paramid . pj _ -> w where paramid = _amParamSel $ _wpAmmo $ yourItem w + swapInvDir :: Int -> World -> World swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n) where diff --git a/src/Dodge/Item/Attachment.hs b/src/Dodge/Item/Attachment.hs index a235c792d..bd0226386 100644 --- a/src/Dodge/Item/Attachment.hs +++ b/src/Dodge/Item/Attachment.hs @@ -2,8 +2,7 @@ module Dodge.Item.Attachment ( charFiringStratI , scrollCharMode , changeFuse - ) - where + ) where import Dodge.Data import Dodge.Default diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index cf1dd1bf2..d7738c440 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -60,12 +60,9 @@ teslaGun = defaultGun , _itAimingRange = 0 } teslaGunPic :: Item -> SPic -teslaGunPic _ = - ( colorSH blue $ +teslaGunPic _ = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb y xa (-y)) ++ upperPrismPoly 5 (rectNESW (-xa) y (-xb) (-y)) - , mempty - ) where xa = 1 xb = 9 diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 53f6b0f4a..07cca75a8 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/src/Dodge/Item/Weapon/Utility.hs @@ -9,7 +9,7 @@ import Geometry import Picture --import qualified IntMapHelp as IM import Shape ---import ShapePicture +import ShapePicture import Control.Lens shrinkGun :: Item @@ -31,15 +31,20 @@ shrinkGun = defaultGun , _itLeftClickUse = Nothing , _wpSpread = 0.05 , _wpRange = 20 - , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)] + , _itFloorPict = shrinkGunPic , _itAimingSpeed = 1 , _itAimingRange = 0 , _itAttachment = ItBool True } +shrinkGunPic :: Item -> SPic +shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5 + +-- be careful changing this around; potential problems include updating the +-- creature but using the old crInvSel value useShrinkGun :: Item -> Creature -> World -> World useShrinkGun it cr w = if _itBool $ _itAttachment it - then tryResize 0.5 $ f False UndroppableIdentified . stripNoItems cr . dropUnselected cr + then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropUnselected cr else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr where tryResize x g = maybe w g $ maybeSizeSelf x cr w diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs index f435e3b2a..d68b22de9 100644 --- a/src/Dodge/LevelGen/StaticWalls.hs +++ b/src/Dodge/LevelGen/StaticWalls.hs @@ -19,6 +19,7 @@ import Data.Maybe -- | Describe a wall as two points. -- Order is important: the wall face is to the left of the line going from -- 'fst' to 'snd'. +-- TODO remove duplication type WallP = (Point2,Point2) -- | Remove inverse walls. removeInverseWalls :: [WallP] -> [WallP] diff --git a/src/Dodge/WallCreatureCollisions.hs b/src/Dodge/WallCreatureCollisions.hs index adbb79022..7f7ef32e4 100644 --- a/src/Dodge/WallCreatureCollisions.hs +++ b/src/Dodge/WallCreatureCollisions.hs @@ -2,6 +2,7 @@ module Dodge.WallCreatureCollisions ( colCrsWalls , colCrWall + , pushCreatureOutFromWalls ) where import Dodge.Data --import Dodge.Data.DamageType @@ -23,11 +24,13 @@ colCrWall :: World -> Creature -> Creature colCrWall w c | noclipIsOn && _crID c == 0 = c -- for noclip | p1 == p2 = pushOrCrush ls c - | _crPos c' == _crPos c'' = c' - | otherwise = c & crPos .~ _crOldPos c +-- | _crPos c' == _crPos c'' = c' +-- | otherwise = c & crPos .~ _crOldPos c + | otherwise = c' where - c'' = c' & crPos %~ pushOutFromWalls rad ls - c' = c & crPos %~ pushOutFromWalls' rad (reverse ls) +-- c'' = c' & crPos %~ pushOutFromWalls rad ls + --c' = c & crPos %~ pushOutFromWalls' rad (reverse ls) + c' = c & crPos %~ pushOutFromCorners rad (reverse ls) . pushOutFromWalls rad ls . flip (collidePointWalls p1) wls -- check push throughs rad = _crRad c + wallBuffer @@ -42,6 +45,9 @@ colCrWall w c wallBuffer :: Float wallBuffer = 0 +pushCreatureOutFromWalls :: [(Point2,Point2)] -> Creature -> Creature +pushCreatureOutFromWalls ls cr = cr & crPos %~ pushOutFromWalls (_crRad cr) ls + -- the following tests whether or not a point is on a wall, and if so pushes it -- out from the wall -- this is then repeated if the point ends up on a new wall @@ -91,8 +97,11 @@ pushOutFromWall' rad cp2 (wp1,wp2) --isOnWall = circOnSegNoEndpoints wp1 wp2 cp2 rad isOnWall = circOnSeg wp1 wp2 cp2 rad ---pushOutFromCorners :: World -> Creature -> Creature ---pushOutFromCorners w cr = cr & crPos .~ newPos +pushOutFromCorners :: Float -> [(Point2,Point2)] -> Point2 -> Point2 +pushOutFromCorners r ls p = foldr (intersectCirclePoint r) p (map fst ls) + +--pushOutFromCorners' :: World -> Creature -> Creature +--pushOutFromCorners' w cr = cr & crPos .~ newPos -- where -- newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls -- ls = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ _wlLine <$> wallsNearPoint (_crPos cr) w @@ -101,7 +110,7 @@ pushOutFromWall' rad cp2 (wp1,wp2) --collideCorners rad ps p2 = foldr (intersectCirclePoint rad) p2 ps ---- collide circles with points (outer corners) ---intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 ---intersectCirclePoint rad p cCen --- | dist cCen p > rad = cCen --- | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) +intersectCirclePoint :: Float -> Point2 -> Point2 -> Point2 +intersectCirclePoint rad p cCen + | dist cCen p > rad = cCen + | otherwise = p +.+ (rad *.* errorNormalizeV 65 (cCen -.- p)) diff --git a/src/Padding.hs b/src/Padding.hs index 1aed772d5..81b6110d3 100644 --- a/src/Padding.hs +++ b/src/Padding.hs @@ -50,3 +50,9 @@ rotListAt x' xs = f x' xs [] insertAt :: Int -> a -> [a] -> [a] insertAt i x xs = let (ys,zs) = splitAt i xs in ys ++ [x] ++ zs + +--listElementOthersPairs :: [a] -> [(a,[a])] +--listElementOthersPairs (x:xs) = go [] x xs +-- where +-- go ys y [] = [(y,ys)] +-- go ys y (z:zs) = (y,ys++zs): go (y:ys) z zs