diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index c56091dde..ded0eb678 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -107,7 +107,7 @@ multGunCrit = defaultCreature , _crRad = 10 , _crHP = 300 , _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate - [ ( const $ not . crHasAmmo + [ ( const $ not . crWeaponReady , \_ _ -> StrategyActions Reload reloadActions ) , (const $ not . crSafeDistFromTarg 150 diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index cf47cb2e9..ddf72c9c7 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -28,10 +28,10 @@ import qualified IntMapHelp as IM --import FoldableHelp ---import qualified Data.IntSet as IS ---import Data.Maybe import Data.Function import Control.Lens +--import qualified Data.IntSet as IS +--import Data.Maybe --import Control.Applicative --import qualified SDL --import qualified SDL.Mixer as Mix diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 3a8d1db57..ab3cc4da7 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -6,6 +6,23 @@ the creature NEED NOT be the same as the creature with that id in the world, in fact a creature with that id need not exist. -} module Dodge.Creature.Test + ( crIsAiming + , crIsReloading + , crIsArmouredFrom + , oneH + , twists + , twoFlat + , crWeaponReady + , crInAimStance + , crNearPoint + , isAnimate + , crCanShoot + , crHasTargetLOS + , crAwayFromPost + , crHasTarget + , crStratConMatches + , crSafeDistFromTarg + ) where import Dodge.Data import Dodge.Base.Collide @@ -14,29 +31,22 @@ import SameConstr import Data.List (find) import Data.Maybe -import qualified Data.IntMap.Strict as IM +--import qualified Data.IntMap.Strict as IM import Control.Lens -andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool -andTest f g a = f a && g a - -onBoth :: (a -> b -> c) -> (d -> a) -> (d -> b) -> d -> c -onBoth f g h x = f (g x) (h x) - crIsReloading :: Creature -> Bool crIsReloading cr = case cr ^? crInvSel . iselAction of Just ReloadAction {} -> True _ -> False crWeaponReady :: Creature -> Bool -crWeaponReady cr = isNothing $ cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just +crWeaponReady cr = fromMaybe False $ do + ic <- cr ^? crInv . ix (crSel cr) . itConsumption + return (_laLoaded ic > 0 && _laPrimed ic) crCanSeeCr :: Creature -> (World, Creature) -> Bool crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w -crCanSeeCID :: Int -> (World, Creature) -> Bool -crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w - crIsAiming :: Creature -> Bool crIsAiming cr = _posture (_crStance cr) == Aiming @@ -64,14 +74,11 @@ crAwayFromPost cr = case find sentinelGoal . _crGoal $ _crActionPlan cr of sentinelGoal (SentinelAt _ _) = True sentinelGoal _ = False -crHasAmmo :: Creature -> Bool -crHasAmmo cr = maybe False (> 0) $ cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded - crCanShoot :: Creature -> Bool -crCanShoot p = crIsAiming p && crHasAmmo p +crCanShoot cr = crIsAiming cr && crWeaponReady cr crInAimStance :: AimStance -> Creature -> Bool -crInAimStance as cr = crIsAiming cr -- || (_posture (_crStance cr) == Reloading && hasAmmo cr) +crInAimStance as cr = crIsAiming cr && cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance == Just as oneH :: Creature -> Bool @@ -106,8 +113,8 @@ hasFrontArmour p cr = fromMaybe False $ do --crOnSeg :: Point2 -> Point2 -> Creature -> Bool --crOnSeg p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr) -crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool -crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d) +--crNearSeg :: Float -> Point2 -> Point2 -> Creature -> Bool +--crNearSeg d p1 p2 cr = circOnSeg p1 p2 (_crPos cr) (_crRad cr + d) crNearPoint :: Float -> Point2 -> Creature -> Bool crNearPoint d p cr = dist (_crPos cr) p < d + _crRad cr diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 7394b65fb..9542448c1 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -55,6 +55,7 @@ rmInvItem :: Int -- ^ Creature id rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1 _ -> w & creatures . ix cid . crInv %~ f + & creatures . ix cid . crInvSel %~ stopCrInvSelAction & creatures . ix cid . crInvSel . iselPos %~ g & creatures . ix cid . crLeftInvSel %~ g' & removeAnySlotEquipment @@ -64,6 +65,9 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons & creatures . ix cid . crInvEquipped %~ IM.mapKeys g -- TODO check whether this can be mapKeysMonotonic where + stopCrInvSelAction (InvSel i a) + | i == invid = InvSel i NoInvSelAction + | otherwise = InvSel i a cr = _creatures w IM.! cid itm = _crInv cr IM.! invid dounequipfunction = fromMaybe id $ do diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index 49a7c2f67..fd25412b5 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -1,4 +1,8 @@ module Dodge.Item.Display + ( itemDisplay + , selectedItemDisplay + , itemString + ) where import Dodge.Module import Dodge.Data @@ -12,40 +16,27 @@ import Data.Sequence itemString :: Item -> String itemString = head . itemDisplay -selectedItemDisplay :: Creature -> Item -> [String] -selectedItemDisplay cr it = Prelude.take (itSlotsTaken it) $ - (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam) - : catMaybes [maybeWarmupStatus it] +itemDisplayWithNumber :: String -> Item -> [String] +itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $ + (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) + : catMaybes [maybeWarmupStatus it,maybeRateStatus it] ++ moduleStrings it ++ repeat "*" where thename = show . _iyBase $ _itType it - thenumber = showSelectedConsumption cr (_itConsumption it) theparam = fromMaybe [] . listToMaybe $ mapMaybe ($ it) [ maybeModeStatus --- , maybeWarmupStatus --- , maybeRateStatus ] +selectedItemDisplay :: Creature -> Item -> [String] +selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itConsumption it)) it {- | Displays the item name, ammo if loaded, and any selected '_itCharMode'. -} -- TODO make work on remote launchers itemDisplay :: Item -> [String] -itemDisplay it = Prelude.take (itSlotsTaken it) $ - (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam) - : catMaybes [maybeWarmupStatus it] - ++ moduleStrings it ++ repeat "*" - where - thename = show . _iyBase $ _itType it - thenumber = showConsumption (_itConsumption it) - theparam = fromMaybe [] - . listToMaybe - $ mapMaybe ($ it) - [ maybeModeStatus --- , maybeWarmupStatus --- , maybeRateStatus - ] +itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it + showSelectedConsumption :: Creature -> ItemConsumption -> String showSelectedConsumption cr ic = case ic of LoadableAmmo{} -> showReloadProgress cr ic @@ -68,9 +59,10 @@ showLoadProgress x mlas = case mlas ^? _Just . ix 0 of showConsumption :: ItemConsumption -> String showConsumption ic = case ic of LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic) - am@ChargeableAmmo{} -> show $ _wpCharge am - x@ItemItselfConsumable{} -> show (_icAmount x) + ChargeableAmmo{} -> show $ _wpCharge ic + ItemItselfConsumable{} -> show (_icAmount ic) NoConsumption -> "" + showLoadActionType :: LoadAction -> Int -> String showLoadActionType la x = case la of LoadEject {} -> "E" @@ -78,10 +70,6 @@ showLoadActionType la x = case la of LoadAdd {} -> "A" ++ show x LoadPrime {} -> "P" --- & itInvDisplay .~ \it -> head (basicItemDisplay it) : --- ["*FIRERATE:" ++ fromMaybe "" (maybeRateStatus it) --- ] - maybeWarmupStatus :: Item -> Maybe String maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of Nothing -> Nothing diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index ea740a88e..6b1898574 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -53,7 +53,7 @@ updateUniverse u = case _menuLayers u of functionalUpdate :: Configuration -> World -> World functionalUpdate cfig w = checkEndGame -- . updateRandGen - . (mouseButtons . each .~ True) + . (mouseButtons . each .~ True) -- to determine if the mouse button is held . (worldClock +~ 1) . doRewind . (doubleMouseHammer %~ moveHammerUp)