diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index d42b4583a..ddf149ca3 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -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 diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index ad31fbae6..d1505c9da 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -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 diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 556f693bb..4dc70d622 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/src/Dodge/Creature/Perception.hs @@ -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 diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs index 30c7d6a9a..48b580ed9 100644 --- a/src/Dodge/Creature/Property.hs +++ b/src/Dodge/Creature/Property.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8f0c0653c..dc19be2b9 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index d38713f9b..0d9e121fb 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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 diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index c4a6d1e7c..52cc21fe1 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -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 } diff --git a/src/Dodge/Item/Weapon/SonicGuns.hs b/src/Dodge/Item/Weapon/SonicGuns.hs index 218e44723..d8f155207 100644 --- a/src/Dodge/Item/Weapon/SonicGuns.hs +++ b/src/Dodge/Item/Weapon/SonicGuns.hs @@ -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))