justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start to implement equipment sites on body

Browse Source
This commit is contained in:
justin
2022-05-21 12:13:50 +01:00
parent bc0f7ada3c
commit 398ed6d982
8 changed files with 94 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature.hs
+2
View File
@@ -174,6 +174,8 @@ inventoryA = IM.fromList $ zip [0..]
testInventory :: IM.IntMap Item
testInventory = IM.fromList $ zip [0..]
[ makeTypeCraftNum 9 PIPE
, frontArmour
, flameShield
, makeModule INCENDIARYMODULE
, makeModule STATICMODULE
, makeModule CONCUSSMODULE
src/Dodge/Creature/Impulse/UseItem.hs
+34 -4
View File
@@ -6,6 +6,7 @@ import Dodge.Data
import Dodge.Inventory
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
import Control.Lens
import Data.Maybe
@@ -22,7 +23,7 @@ itemEffect cr it w = case it ^? itUse of
Just RightUse {_rUse = eff,_useMods = usemods}
-> hammerTest $ foldr ($) eff usemods it cr
Just LeftUse {} -> setuhamdown $ lhammer setEquipLeftItem
Just EquipUse{} -> setuhamdown $ lhammer setEquipment
Just EquipUse{} -> setuhamdown $ lhammer $ toggleEquipmentAt (_crInvSel cr) it
-- ConsumeUse will cause problems if the item is not selected
Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
Just NoUse -> setuhamdown w
@@ -37,15 +38,44 @@ itemEffect cr it w = case it ^? itUse of
setEquipLeftItem cr' = case _crLeftInvSel cr' of
Just i | i == _crInvSel cr' -> cr' & crLeftInvSel .~ Nothing
_ -> cr' & crLeftInvSel ?~ _crInvSel cr'
setEquipment = toggleEquipmentAt (_crInvSel cr)
setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
toggleEquipmentAt :: Int -> Creature -> Creature
toggleEquipmentAt invid cr = cr & crInvEquipped . at invid %~ f
toggleEquipmentAt :: Int -> Item -> Creature -> Creature
toggleEquipmentAt invid itm cr
| invid `IS.member` _crInvEquipped cr = cr & crInvEquipped . at invid .~ Nothing
& removeEquipmentUsingSite esite
& setEquipmentSite esite Nothing'
| otherwise = cr & crInvEquipped . at invid .~ Just ()
& removeEquipmentUsingSite esite
& setEquipmentSite esite (Just' invid)
where
esite = _eqSite (_itUse itm)
f Nothing = Just ()
f (Just ()) = Nothing
removeEquipmentUsingSite :: EquipSite -> Creature -> Creature
removeEquipmentUsingSite esite cr = case esite of
GoesOnSpecial -> cr
_ -> case cr ^? crEquipment . esiteToPoint . _Just' of
Just invid -> cr & crInvEquipped . at invid .~ Nothing
_ -> cr
where
esiteToPoint = case esite of
GoesOnHead -> onHead
GoesOnChest -> onChest
GoesOnBack -> onBack
GoesOnWrist -> onWristL
GoesOnLegs -> onLegs
setEquipmentSite :: EquipSite -> Maybe' Int -> Creature -> Creature
setEquipmentSite esite = case esite of
GoesOnHead -> set (crEquipment . onHead)
GoesOnChest -> set (crEquipment . onChest)
GoesOnBack -> set (crEquipment . onBack)
GoesOnWrist -> set (crEquipment . onWristL)
GoesOnLegs -> set (crEquipment . onLegs)
GoesOnSpecial -> const id
useLeftItem :: Int -> World -> World
useLeftItem cid w
| _crInvLock cr = w
src/Dodge/Creature/Perception.hs
+3 -4
View File
@@ -169,9 +169,8 @@ rememberSounds w cr = cr
-- TODO work out correct form for sounds passing through walls
soundIsClose :: World -> Creature -> (Point2,Float) -> Bool
soundIsClose w cr (pos,vol)
| dist cpos pos > 2000 = False
| hasLOS cpos pos w = vol > (_auDist . _crAudition $ _crPerception cr) (dist pos cpos)
| otherwise = False
soundIsClose w cr (pos,vol) = dist cpos pos < 2000
&& vol > (_auDist . _crAudition $ _crPerception cr) (dist pos cpos)
&& hasLOS cpos pos w
where
cpos = _crPos cr
src/Dodge/Creature/Property.hs
+5 -2
View File
@@ -8,11 +8,14 @@ import Geometry
import Control.Lens
-- the use of crOldPos is because the damage position is calculated on the
-- previous frame
-- Not sure if it is a good idea
crIsArmouredFrom :: Point2 -> Creature -> Bool
crIsArmouredFrom p cr
= p /= _crPos cr
= p /= _crOldPos cr
&& any (\it -> it ^? itType == Just FRONTARMOUR) (_crInv cr)
&& angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crPos cr) < pi/2
&& angleVV (unitVectorAtAngle $ _crDir cr) (p -.- _crOldPos cr) < pi/2
-- even though angleVV can generate NaN, the comparison seems to deal with it
--crOnSeg :: Point2 -> Point2 -> Creature -> Bool
src/Dodge/Data.hs
+19
View File
@@ -278,6 +278,7 @@ data Creature = Creature
, _crInvCapacity :: Int
, _crInvLock :: Bool
, _crInvEquipped :: IS.IntSet
, _crEquipment :: CreatureEquipment
, _crLeftInvSel :: Maybe Int
, _crState :: CreatureState
, _crCorpse :: Picture
@@ -296,6 +297,14 @@ data Creature = Creature
, _crHammerPosition :: HammerPosition
, _crName :: String
}
data CreatureEquipment = CreatureEquipment
{_onHead :: Maybe' Int
,_onChest :: Maybe' Int
,_onBack :: Maybe' Int
,_onWristL :: Maybe' Int
,_onWristR :: Maybe' Int
,_onLegs :: Maybe' Int
}
data Vocalization
= Mute
| Vocalization
@@ -376,8 +385,17 @@ data ItemUse
}
| EquipUse
{ _eqUse :: Creature -> Int -> World -> World
, _eqSite :: EquipSite
}
| NoUse
data EquipSite
= GoesOnHead
| GoesOnChest
| GoesOnBack
| GoesOnWrist
| GoesOnLegs
| GoesOnSpecial
deriving (Eq,Ord,Show)
_itUseAimStance :: Item -> AimStance
_itUseAimStance = _aimStance . _useAim . _itUse
data ItemConsumption
@@ -1288,3 +1306,4 @@ makeLenses ''Beam
makeLenses ''BeamType
makeLenses ''WorldBeams
makeLenses ''ArcStep
makeLenses ''CreatureEquipment
src/Dodge/Default.hs
+12 -1
View File
@@ -46,6 +46,14 @@ defaultCreature = Creature
, _crCorpse = setLayer BottomLayer $ setDepth 5 $ color (greyN 0.5) $ circleSolid 10
, _crApplyDamage = defaultApplyDamage
, _crPastDamage = 0
, _crEquipment = CreatureEquipment
{_onHead = Nothing'
,_onChest = Nothing'
,_onBack = Nothing'
,_onWristL = Nothing'
,_onWristR = Nothing'
,_onLegs = Nothing'
}
, _crStance = Stance
{_carriage=Walking 0 WasLeftForward
,_posture=AtEase
@@ -156,7 +164,10 @@ defaultEquipment = Item
, _itInvPos = Nothing
, _itDimension = defItDimCol yellow
, _itConsumption = NoConsumption
, _itUse = EquipUse {_eqUse = \_ _ -> id}
, _itUse = EquipUse
{_eqUse = \_ _ -> id
,_eqSite = GoesOnSpecial
}
, _itScroll = \ _ _ -> id
, _itAttachment = NoItAttachment
, _itParams = NoParams
src/Dodge/Item/Equipment.hs
+14 -7
View File
@@ -19,7 +19,7 @@ magShield :: Item
magShield = defaultEquipment
{ _itType = MAGSHIELD
, _itName = "MAGSHIELD"
, _itUse = EquipUse useMagShield
, _itUse = EquipUse useMagShield GoesOnWrist
, _itEquipPict = \_ _ -> (,) emptySH blank
, _itID = Nothing
, _itAttachment = ItMInt Nothing
@@ -38,11 +38,14 @@ useMagShield cr invid w = w & magnets . at mgid ?~ themagnet
Nothing -> IM.newKey $ _magnets w
it = _crInv cr IM.! invid
flameShield :: Item
flameShield = defaultEquipment
{ _itType = FLAMESHIELD
, _itName = "FLAMESHIELD"
, _itUse = EquipUse
{_eqUse = \_ _ -> id
,_eqSite = GoesOnChest
}
, _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
, _itID = Nothing
}
@@ -51,6 +54,10 @@ frontArmour :: Item
frontArmour = defaultEquipment
{ _itType = FRONTARMOUR
, _itName = "FARMOUR"
, _itUse = EquipUse
{_eqUse = \_ _ -> id
,_eqSite = GoesOnChest
}
-- , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ translate 0 (-5) $ pictures
-- [color (greyN 0.1) $ thickArc 0 (pi/2) 10 5
-- ,color (greyN 0.1) $ thickArc (3*pi/2) (2*pi) 10 5
@@ -65,7 +72,7 @@ frontArmour = defaultEquipment
flatShield :: Item
flatShield = defaultEquipment
{ _itEquipPict = pictureWeaponAim flatShieldEquipSPic
, _itEffect = effectOnOffEquip createShieldWall removeShieldWall
, _itEffect = effectOnOffHeld createShieldWall removeShieldWall
-- the above seems to work, but I am not sure why: it may break on edge
-- cases
, _itName = "FLATSHIELD"
@@ -150,11 +157,11 @@ removeShieldWall cr invid w = case _itEffectID $ _itEffect it of
crid = _crID cr
it = _crInv (_creatures w IM.! crid) IM.! invid
effectOnOffEquip
:: (Creature -> Int -> World -> World) -- ^ effect when equiped
-> (Creature -> Int -> World -> World) -- ^ effect when not equiped
effectOnOffHeld
:: (Creature -> Int -> World -> World) -- ^ effect when held
-> (Creature -> Int -> World -> World) -- ^ effect when not held
-> ItEffect
effectOnOffEquip f f' = ItInvEffectID
effectOnOffHeld f f' = ItInvEffectID
{ _itInvEffect = g
, _itEffectID = Nothing
}
src/Dodge/Item/Weapon/SonicGuns.hs
+5 -5
View File
@@ -112,15 +112,15 @@ mvSonicWave w pt
dosplit :: [Maybe ((Point2,Float),(Bool,Bool))] -> [[(Point2,Float)]]
dosplit (x:xs) = case x of
Nothing -> [] : dosplit xs
Just (pair,(True,True)) -> onHead (pair:) $ dosplit xs
Just (pair,(False,True)) -> [] : onHead (pair:) (dosplit xs)
Just (pair,(True,True)) -> overHead (pair:) $ dosplit xs
Just (pair,(False,True)) -> [] : overHead (pair:) (dosplit xs)
Just (pair,(True,False)) -> [pair] : dosplit xs
Just (_,(False,False)) -> [] : dosplit xs
dosplit [] = [[]]
onHead :: (a -> a) -> [a] -> [a]
onHead f (x:xs) = f x: xs
onHead _ [] = []
overHead :: (a -> a) -> [a] -> [a]
overHead f (x:xs) = f x: xs
overHead _ [] = []
reflectShockLine :: Wall -> Point2 -> Point2 -> Point2 -> Maybe ((Point2,Float),(Bool,Bool))