diff --git a/src/Dodge/Barreloid.hs b/src/Dodge/Barreloid.hs index 5a5fb7c94..50bcbd0b4 100644 --- a/src/Dodge/Barreloid.hs +++ b/src/Dodge/Barreloid.hs @@ -31,7 +31,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of HP _ -> w & makeExplosionAt ((cr ^. crPos) & _z +~ 20) 0 - & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs + & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed _ -> w where f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos . _xy) (argV p) w' @@ -44,7 +44,7 @@ updateExpBarrel ps cr w = case cr ^. crHP of updateBarrel :: Creature -> World -> World updateBarrel cr = case cr ^. crHP of HP x | x > 0 -> doDamage (cr ^. crID) - HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs + HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrDestroyed Gibbed _ -> id damsToExpBarrel :: [Damage] -> Creature -> Creature diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 50c6410d6..85db1a5e9 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -32,6 +32,7 @@ module Dodge.Base.Collide ( anythingHitCirc, collide3WallsFloor, collide3, + crHeight, ) where import Data.Foldable @@ -174,10 +175,13 @@ collide3Creature sp cr (ep, m) = fromMaybe (ep, m) $ do crHeight :: Creature -> Maybe Float crHeight cr = case cr ^. crHP of - HP{} -> Just 25 + HP{} -> Just $ case cr ^. crType of + HoverCrit {} -> 10 + ChaseCrit {} -> 25 + Avatar {} -> 25 + _ -> error "Need to define crHeight for this crType" CrIsCorpse{} -> Just 5 - CrIsGibs -> Nothing - CrIsPitted -> Nothing + CrDestroyed{} -> Nothing wallToSurface :: Wall -> (Point3, Point3, [(Point3, Point3)]) wallToSurface wl = (g x, g $ vNormal (x - y), [(g x, g (y - x)), (g y, g (x - y))]) diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 12785a905..f186a90fc 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -139,6 +139,5 @@ hasAutoDoorBody :: Creature -> Bool hasAutoDoorBody cr = case cr ^. crHP of HP {} -> True CrIsCorpse {} -> True - CrIsGibs -> False - CrIsPitted -> False + CrDestroyed {} -> False diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index 4c90655f1..e212e2235 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -39,7 +39,7 @@ import ShapePicture.Data -- allow for knockbacks etc to be determined as well as intended movements updateCreature :: Creature -> World -> World updateCreature cr - | cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr + | cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr | CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr) . chasmTestCorpse cr | null (cr ^? crHP . _HP) = id | otherwise = updateLivingCreature cr @@ -143,7 +143,7 @@ corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of Just PhysicalDamage | _crPain cr > 200 -> makeCrGibs cr - . sethp CrIsGibs + . sethp (CrDestroyed Gibbed) . dodeathsound GibsDeath _ -> sethp (CrIsCorpse thecorpse) diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index b4e1e9fdf..5812889e8 100644 --- a/src/Dodge/Data/Creature.hs +++ b/src/Dodge/Data/Creature.hs @@ -59,11 +59,13 @@ data Creature = Creature , _crWallTouch :: IM.IntMap Point2 } +-- Prisms, not lenses data CrHP = HP Int | CrIsCorpse SPic - | CrIsGibs - | CrIsPitted + | CrDestroyed CrDestructionType + +data CrDestructionType = Gibbed | Pitted data DeathType = CookDeath | PoisonDeath | PlainDeath | GibsDeath @@ -93,4 +95,5 @@ concat [ ''Creature , ''Intention , ''CrHP + , ''CrDestructionType ] diff --git a/src/Dodge/Data/Creature/Misc.hs b/src/Dodge/Data/Creature/Misc.hs index e5464f519..20d8f0dc0 100644 --- a/src/Dodge/Data/Creature/Misc.hs +++ b/src/Dodge/Data/Creature/Misc.hs @@ -23,7 +23,8 @@ data Vocalization data CrMvType = NoMvType - | MvWalking {_mvSpeed :: Float} + | MvWalking {_mvSpeed :: Float} -- note this may interact with a friction element + -- so currently 26.04.03 the actual max speed when walking is twice this | CrMvType { _mvSpeed :: Float , _mvTurnRad :: FloatFloat diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 622d164c6..98529980f 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -1,50 +1,58 @@ {-# OPTIONS_GHC -Wno-unused-imports #-} + module Dodge.TestString where -import Dodge.Creature.Picture -import Dodge.WallCreatureCollisions -import Data.List ((\\)) -import ShortShow -import Geometry -import qualified SDL -import Linear -import Dodge.ListDisplayParams -import Dodge.SelectionSections -import qualified Control.Foldl as L -import Dodge.DoubleTree -import Dodge.Data.DoubleTree -import Dodge.Item.Grammar -import Dodge.Item.Display import AesonHelp -import Dodge.SmoothScroll -import HelpNum -import Dodge.Base.Coordinate -import Geometry.Vector -import Data.Maybe -import Dodge.Render.Lights -import Data.Aeson (ToJSON) -import Data.ByteString.Lazy.Char8 (unpack) -import qualified Data.Aeson.Encode.Pretty as AEP +import qualified Control.Foldl as L import Control.Lens -import Dodge.Data.Universe -import qualified IntMapHelp as IM -import qualified Data.Map.Strict as M -import NewInt +import Data.Aeson (ToJSON) +import qualified Data.Aeson.Encode.Pretty as AEP +import Data.ByteString.Lazy.Char8 (unpack) import Data.Foldable +import Data.List ((\\)) +import qualified Data.Map.Strict as M +import Data.Maybe import Data.Monoid +import Dodge.Base.Coordinate +import Dodge.Creature.Picture +import Dodge.Data.DoubleTree +import Dodge.Data.Universe +import Dodge.DoubleTree +import Dodge.Item.Display +import Dodge.Item.Grammar +import Dodge.ListDisplayParams +import Dodge.Render.Lights +import Dodge.SelectionSections +import Dodge.SmoothScroll +import Dodge.WallCreatureCollisions +import Geometry +import Geometry.Vector +import HelpNum +import qualified IntMapHelp as IM +import Linear +import NewInt import RandomHelp +import qualified SDL +import ShortShow + +tocrs :: + ( IM.IntMap Creature -> + Const (Endo [String]) (IM.IntMap Creature) + ) -> + Universe -> + Const (Endo [String]) Universe +tocrs = uvWorld . cWorld . lWorld . creatures testStringInit :: Universe -> [String] -testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $ op' - oop, show d] - <> u ^.. tocr . crStance . carriage . to show - <> u ^.. tocr . crMvDir . to show - where - tocr = uvWorld . cWorld . lWorld . creatures . ix 0 - f = fromMaybe 0 - p = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos - op' = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos - oop = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos - d = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crDir +testStringInit u = u ^.. tocrs . each . crStance . carriage . to show + +-- where +-- tocr = uvWorld . cWorld . lWorld . creatures . ix 0 +-- f = fromMaybe 0 +-- p = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos +-- op' = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos +-- oop = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos +-- d = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crDir -- u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apStrategy . to show -- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apAction . to show -- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crPerception . cpAttention . to show @@ -58,7 +66,7 @@ testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $ -- a <> fromMaybe [] (do -- a w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18 -- a w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61 --- a let +-- a let -- a f = uncurry (-) . (^. wlLine) -- a g = argV . f -- a h = normalizeV . uncurry (-) . (^. wlLine) @@ -72,29 +80,37 @@ testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $ -- a ] -- a ) -- <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial) ---testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir) ---testStringInit u = map show +-- testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir) +-- testStringInit u = map show -- (u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer) -- <> -- map f (u ^.. uvWorld . cWorld . lWorld . machines . traverse) -- where -- f mc = show (mc ^. mcID) <> shortShow (mc ^. mcType) --- [show $ foldMap (foldMap (Sum . length . (^. seObstacles))) +-- [show $ foldMap (foldMap (Sum . length . (^. seObstacles))) -- $ u ^. uvWorld . cWorld . incGraph] - -- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor ---testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines +-- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor +-- testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines -- showh _ = "" -- shortShow topTestPart :: Universe -> [String] -topTestPart u = [maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject +topTestPart u = + [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject ] showManObj :: ManipulatedObject -> String showManObj SortInventory = "SortInventory" -showManObj (SelectedItem x y as z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z - ++ " AimStance: " ++ show as +showManObj (SelectedItem x y as z) = + "SelItem: " + ++ show x + ++ " Root: " + ++ show y + ++ " Attached: " + ++ show z + ++ " AimStance: " + ++ show as showManObj SelNothing = "SelNothing" showManObj SortCloseItem = "SortCloseItem" showManObj (SelCloseItem x) = "CloseItem " ++ show x @@ -103,10 +119,10 @@ showManObj (SelCloseButton x) = "CloseButton " ++ show x showTimeFlow :: TimeFlowStatus -> String showTimeFlow tfs = case tfs of - RespawnDelay i -> "Respawndelay"++show i + RespawnDelay i -> "Respawndelay" ++ show i NormalTimeFlow -> "NormalTimeFlow" - ItemScrollTimeFlow {_reverseAmount = ra } -> "ItemScrollTimeFlow" ++ show ra - CameraScrollTimeFlow {_reverseAmount = ra } -> "CameraScrollTimeFlow" ++ show ra - RewindLeftClick {_reverseAmount = ra } -> "RewindLeftClick" ++ show ra - PausedTimeFlow {_timeFlowCharge = ra } -> "PausedTimeFlow" ++ show ra - PauseTimeMessage {} -> "PausedTimeMessage" + ItemScrollTimeFlow{_reverseAmount = ra} -> "ItemScrollTimeFlow" ++ show ra + CameraScrollTimeFlow{_reverseAmount = ra} -> "CameraScrollTimeFlow" ++ show ra + RewindLeftClick{_reverseAmount = ra} -> "RewindLeftClick" ++ show ra + PausedTimeFlow{_timeFlowCharge = ra} -> "PausedTimeFlow" ++ show ra + PauseTimeMessage{} -> "PausedTimeMessage" diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1a3f3f7de..85a603a19 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -975,16 +975,23 @@ canSpring cr = cr ^. crPos . _z >= 0 && case cr ^. crHP of HP{} -> True CrIsCorpse{} -> True - CrIsGibs -> False - CrIsPitted -> False + CrDestroyed{} -> False +-- should possibly limit how big this can get crCrSpring :: Creature -> Creature -> World -> World crCrSpring c1 c2 | id1 == id2 = id | vec == V2 0 0 = id | diff >= comRad = id + | diffheight = id | otherwise = cWorld . lWorld . creatures %~ ( olap c1 c2 . olap' c2 c1) where + z c = c ^. crPos . _z + h c = fmap (+ z c) (crHeight c) + diffheight = fromMaybe True $ do + h1 <- h c1 + h2 <- h c2 + return $ (z c1 > h2 || z c2 > h1) olap a b = ix (a ^. crID) . crPos . _xy +~ overlap b olap' a b = ix (a ^. crID) . crPos . _xy -~ overlap b id1 = _crID c1