diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index b43aade0e..5dc9429ff 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -6,20 +6,25 @@ module Dodge.Creature , ltAutoCrit , spreadGunCrit , autoCrit + , chaseCrit + , smallChaseCrit ) where --import Dodge.Creature.Stance.Data import Dodge.Creature.State.Data import Dodge.Creature.ImpulseRat -import Dodge.Creature.ActionRat -import Dodge.Creature.AlertLevel -import Dodge.Creature.SetTarget +--import Dodge.Creature.ReaderUpdate +--import Dodge.Creature.AlertLevel +--import Dodge.Creature.SetTarget +import Dodge.Creature.Volition import Dodge.Creature.Test +import Dodge.Creature.SentinelAI import Dodge.Creature.LauncherCrit import Dodge.Creature.PistolCrit import Dodge.Creature.LtAutoCrit import Dodge.Creature.SpreadGunCrit import Dodge.Creature.AutoCrit +import Dodge.Creature.ChaseCrit import Dodge.Data import Dodge.Default import Dodge.Base @@ -43,7 +48,7 @@ import Picture --import Data.Maybe --import Data.Function import Control.Lens -import Control.Monad.State +--import Control.Monad.Reader --import System.Random --import qualified Data.Set as S import qualified Data.IntMap.Strict as IM @@ -56,32 +61,6 @@ spawnerCrit = defaultCreature , _crPict = basicCrPict blue , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] } -smallChaseCrit :: Creature -smallChaseCrit = defaultCreature - { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS - , _crHP = 1 - , _crRad = 4 - , _crPict = basicCrPict yellow - , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] - , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4 - , _crFaction = ColorFaction green - } -chaseCrit :: Creature -chaseCrit = defaultCreature - { _crUpdate = stateUpdate $ impulsiveAIR $ - doStrategyActionsR >=> - performActionsR >=> - overrideMeleeCloseTargetR >=> - chaseTargetR targetYouLOS >=> - basicPerceptionUpdateR [0] >=> - targetYouWhenCognizantR >=> - return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1)) - , _crHP = 300 - , _crPict = basicCrPict green - , _crInv = IM.empty - , _crMeleeCooldown = Just 0 - , _crFaction = ColorFaction green - } armourChaseCrit :: Creature armourChaseCrit = defaultCreature { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS @@ -95,11 +74,14 @@ armourChaseCrit = defaultCreature miniGunCrit :: Creature miniGunCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ performActions - , shootTargetWithStrat targetYouCognizant suppress - , basicPerceptionUpdate [0] - ] + , _crUpdate = stateUpdate $ impulsiveAIR $ + sentinelFireType (const shootTillEmpty) + , _crActionPlan = ActionPlan + { _crImpulse = [] + , _crAction = [] + , _crStrategy = StrategyActions WatchAndWait [StartSentinelPost] + , _crGoal = [] + } , _crInv = IM.fromList [(0,miniGun)] , _crInvSel = 0 , _crRad = 10 @@ -110,19 +92,7 @@ longCrit :: Creature longCrit = defaultCreature { _crPict = basicCrPict red -- , _crUpdate = stateUpdate sniperAI - , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ performActions - , watchUpdateStrat - [ (crHasTargetLOS, aimThenShootStrat 0) - , (crAwayFromPost, goToPostStrat) - ] - , basicPerceptionUpdate [0] - , doStrategyActions - , reloadOverrideNoHolster - , targetYouWhenCognizant - , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait - ] + , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelFireType $ const shootTillEmpty , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -142,20 +112,19 @@ multGunCrit = defaultCreature , _crInvSel = 0 , _crRad = 10 , _crHP = 300 - , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ performActions - , watchUpdateStrat - [ (not . crSafeDistFromTarg 150 , fleeTime 5) - , (crHasTargetLOS, shootFirstMiss 0) - , (crAwayFromPost, goToPostStrat) + , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate + [ ( not . crHasAmmo + , \_ _ -> StrategyActions Reload reloadActions + ) + , (not . crSafeDistFromTarg 150 + , \_ cr -> StrategyActions Flee + [(not . crSafeDistFromTarg 150) `DoActionWhile` UseTarget (fleeFrom cr) + `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] + ) + , (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) + [ drawwp `DoActionThen` shootFirstMiss' `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] ] + ) ] - , basicPerceptionUpdate [0] - , doStrategyActions - , reloadOverride - , targetYouWhenCognizant - , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait - ] , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -163,6 +132,13 @@ multGunCrit = defaultCreature , _crGoal = [] } } + where + drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + reloadActions = + [ holsterWeapon + , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + ] + addArmour :: Creature -> Creature addArmour = over crInv insarmour where diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index f97e212a9..ae280c3be 100644 --- a/src/Dodge/Creature/Action.hs +++ b/src/Dodge/Creature/Action.hs @@ -199,11 +199,11 @@ moveBy -> World moveBy n v = over (creatures . ix n . crPos) (+.+ v) -reloadWeapon +startReloadingWeapon :: Int -- ^ Creature id -> World -> Maybe World -reloadWeapon cid w = +startReloadingWeapon cid w = let cr = _creatures w IM.! cid it = _crInv cr IM.! _crInvSel cr itRef = creatures . ix cid . crInv . ix (_crInvSel cr) @@ -216,7 +216,8 @@ reloadWeapon cid w = {- | Start reloading if clip is empty. -} crAutoReload :: Creature -> Creature crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of - Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT) + Just 0 | _posture (_crStance cr) /= Aiming + -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT) & crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA) _ -> cr where @@ -368,3 +369,4 @@ creatureTurnToward p turnSpeed cr where vToTarg = p -.- _crPos cr dirToTarget = argV vToTarg + diff --git a/src/Dodge/Creature/ActionRat.hs b/src/Dodge/Creature/ActionRat.hs index 6e06f7cf8..a3b326bd9 100644 --- a/src/Dodge/Creature/ActionRat.hs +++ b/src/Dodge/Creature/ActionRat.hs @@ -1,162 +1,19 @@ module Dodge.Creature.ActionRat - ( shootTargetWithStrat - , aimThenShootStrat - , suppressShootTarget - , suppress - , shootAdvance - , shootFirstMiss - , doStrategyActions - , doStrategyActionsR - , reloadOverride - , reloadOverrideR - , reloadOverrideNoHolster - , shootAdvanceStrat - , shootMoveStrat - , watchUpdateStrat - , watchUpdateStratR - , goToPostStrat - , overrideInternal - , overrideInternalR - , fleeTime + ( goToPostStrat ) where import Dodge.Data -import Dodge.Base +--import Dodge.Base --import Dodge.Base.Collide --import Dodge.Creature.ChooseTarget -import Dodge.Creature.Stance.Data +--import Dodge.Creature.Stance.Data import Dodge.Creature.Test +import Dodge.Creature.Volition --import Geometry import Data.List --import qualified Data.IntMap.Strict as IM -import Control.Lens -import Control.Monad.Reader - -shootTargetWithStrat - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> (World -> Creature -> Creature -> [Action] -> [Action]) - -- ^ Function for determining shooting strategy given target - -> World - -> Creature - -> Creature -shootTargetWithStrat targFunc strat w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg - -{- | Action update for a simple shooting creature -} -suppressShootTarget - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> World - -> Creature - -> Creature -suppressShootTarget targFunc w cr = case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crAction %~ suppress w cr crTarg - -suppress :: World -> Creature -> Creature -> [Action] -> [Action] -suppress w cr tcr as - | canSee (_crID cr) (_crID tcr) w && cr ^. crStance . posture /= Aiming - && cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 = - [ DrawWeapon - , WaitThen 50 ShootTillEmpty - , AimAtCloseSlow - { _targetID = _crID tcr - , _targetSeenAt = _crPos cr - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/4 - } - ] - | otherwise = as - --- This should be decomposed properly -shootFirstMiss :: Int -> World -> Creature -> Strategy -shootFirstMiss tcid _ _ = StrategyActions (ShootAt tcid) acs - where - acs = - [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - LeadTarget (30,50) - `DoActionThen` - advanceShoot - `DoActionThen` - LeadTarget (0,0) - `DoActionThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - - ] - lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] - -fleeTime :: Int -> World -> Creature -> Strategy -fleeTime t _ _ = StrategyActions Flee - [ t `DoReplicate` - UseTargetCID FleeFrom - `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - ] - -aimThenShootStrat :: Int -> World -> Creature -> Strategy -aimThenShootStrat tcid _ _ = StrategyActions (ShootAt tcid) - [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - 50 - `WaitThen` - DoImpulses [UseItem, ChangeStrategy WatchAndWait] - , AimAtCloseSlow - { _targetID = tcid - , _targetSeenAt = (0,0) -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 - } - ] - -shootMoveStrat :: Point2 -> Int -> World -> Creature -> Strategy -shootMoveStrat moveV tcid _ _ = StrategyActions (ShootAt tcid) - [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - lostest `DoActionWhile` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow - { _targetID = tcid - , _targetSeenAt = (0,0) -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 - } - ] - where - lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, Move moveV]] - -shootAdvanceStrat :: Int -> World -> Creature -> Strategy -shootAdvanceStrat tcid _ _ = StrategyActions (ShootAt tcid) - [ DoActionIfElse NoAction crIsAiming (DoActionThen DrawWeapon (WaitThen 50 NoAction)) - `DoActionThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 75 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow - { _targetID = tcid - , _targetSeenAt = (0,0) -- hack - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 - } - ] - where - lostest (w,cr') = canSee (_crID cr') tcid w - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] +--import Control.Lens goToPostStrat :: World -> Creature -> Strategy goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of @@ -171,137 +28,6 @@ goToPostStrat w cr = case find sentinelGoal $ _crGoal $ _crActionPlan cr of sentinelGoal (SentinelAt _ _) = True sentinelGoal _ = False holsterIfAiming - | crIsAiming (w,cr) = HolsterWeapon + | crIsAiming (w,cr) = holsterWeapon | otherwise = NoAction -overrideInternal - :: ((World , Creature) -> Bool) - -> (World -> Creature -> Creature) - -> World - -> Creature - -> Creature -overrideInternal test update w cr - | test (w,cr) = update w cr - | otherwise = cr - -overrideInternalR - :: ((World , Creature) -> Bool) - -> (World -> Creature -> Creature) - -> Creature - -> Reader World Creature -overrideInternalR test update cr = reader $ \w -> - if test (w,cr) - then update w cr - else cr - -shootAdvance :: World -> Creature -> Creature -> [Action] -> [Action] -shootAdvance w cr tcr as - | lostest (w,cr) && cr ^. crStance . posture /= Aiming - && cr ^? crInv . ix (_crInvSel cr) . wpReloadState == Just 0 = - [ DrawWeapon - , DoImpulses [ChangeStrategy $ ShootAt $ _crID tcr] - , 50 `WaitThen` - lostest `DoActionWhile` - advanceShoot `DoActionThen` - 50 `DoReplicate` - advanceShoot `DoActionThen` - DoImpulses [ChangeStrategy WatchAndWait] - , AimAtCloseSlow - { _targetID = _crID tcr - , _targetSeenAt = _crPos cr - , _aimSpeed = 0.2 - , _slowAimSpeed = 0.01 - , _slowAimAngle = pi/8 - } - ] - | cr ^. crStance . posture == Aiming && cr ^? crInv . ix (_crInvSel cr) . wpReloadState /= Just 0 - = [ HolsterWeapon ] - | otherwise = as - where - lostest (w',cr') = canSee (_crID cr') (_crID tcr) w' - advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] - -doStrategyActions - :: World - -> Creature - -> Creature -doStrategyActions _ cr = case cr ^? crActionPlan . crStrategy of - Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs - & crActionPlan . crStrategy .~ strat - _ -> cr - -doStrategyActionsR - :: Creature - -> Reader World Creature -doStrategyActionsR cr = return $ case cr ^? crActionPlan . crStrategy of - Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs - & crActionPlan . crStrategy .~ strat - _ -> cr - -reloadOverride - :: World - -> Creature - -> Creature -reloadOverride _ cr - | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 - && cr ^. crStance . posture == Aiming - = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions - | otherwise = cr - where - reloadActions = - [ HolsterWeapon - , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) - ] - -reloadOverrideR - :: Creature - -> Reader World Creature -reloadOverrideR cr - | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 - && cr ^. crStance . posture == Aiming - = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions - | otherwise = return $ cr - where - reloadActions = - [ HolsterWeapon - , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) - ] - -reloadOverrideNoHolster - :: World - -> Creature - -> Creature -reloadOverrideNoHolster _ cr - | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 - && cr ^. crStance . posture == Aiming - = cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions - | otherwise = cr - where - reloadActions = - [ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) - ] - -watchUpdateStrat - :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] - -> World - -> Creature - -> Creature -watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of - Just WatchAndWait -> cr - & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr - _ -> cr - -watchUpdateStratR - :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] - -> Creature - -> Reader World Creature -watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of - Just WatchAndWait -> cr - & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr - _ -> cr - -listGuard :: ([(a -> Bool, b)] , b) -> a -> b -listGuard ( (test,y):ps, z ) x - | test x = y - | otherwise = listGuard (ps, z) x -listGuard (_,z) _ = z diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index 17be01d5d..f24a40854 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -4,12 +4,9 @@ module Dodge.Creature.AutoCrit import Dodge.Data import Dodge.Default import Dodge.Creature.Picture -import Dodge.Creature.Test -import Dodge.Creature.ActionRat +import Dodge.Creature.SentinelAI --import Dodge.Creature.ChooseTarget -import Dodge.Creature.SetTarget import Dodge.Creature.Rationality -import Dodge.Creature.AlertLevel import Dodge.Creature.State --import Dodge.Creature.State.Data import Dodge.Item.Weapon @@ -17,28 +14,14 @@ import Dodge.Item.Consumable --import Geometry import Picture --import Dodge.RandomHelp - +-- --import Data.Maybe import qualified Data.IntMap.Strict as IM -import Control.Lens -import Control.Monad ---import System.Random autoCrit :: Creature autoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAIR $ - performActionsR - >=> watchUpdateStratR - [ (crHasTargetLOS, shootAdvanceStrat 0) - , (crAwayFromPost, goToPostStrat) - ] - >=> basicPerceptionUpdateR [0] - >=> doStrategyActionsR - >=> reloadOverrideR - >=> targetYouWhenCognizantR - >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelAI , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs new file mode 100644 index 000000000..0fbaa61a6 --- /dev/null +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -0,0 +1,50 @@ +module Dodge.Creature.ChaseCrit + (smallChaseCrit + ,chaseCrit + ) where +import Dodge.Data +import Dodge.Default +import Dodge.Creature.Picture +--import Dodge.Creature.Test +import Dodge.Creature.ReaderUpdate +import Dodge.Creature.ChooseTarget +import Dodge.Creature.Rationality +import Dodge.Creature.AlertLevel +import Dodge.Creature.State +import Dodge.Creature.State.Data +import Dodge.Item.Consumable +import Dodge.Picture.Layer +--import Geometry +import Picture +--import Dodge.RandomHelp + +--import Data.Maybe +import qualified Data.IntMap.Strict as IM +import Control.Lens +import Control.Monad +--import System.Random + +smallChaseCrit :: Creature +smallChaseCrit = chaseCrit + { _crHP = 1 + , _crRad = 4 + , _crPict = basicCrPict green + , _crInv = IM.fromList [(0,medkit 200)] + , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 4 + } +chaseCrit :: Creature +chaseCrit = defaultCreature + { _crUpdate = stateUpdate $ impulsiveAIR $ + doStrategyActionsR >=> + performActionsR >=> + overrideMeleeCloseTargetR >=> + chaseTargetR targetYouLOS >=> + basicPerceptionUpdateR [0] >=> + targetYouWhenCognizantR >=> + return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1)) + , _crHP = 300 + , _crPict = basicCrPict green + , _crInv = IM.fromList [(0,medkit 200)] + , _crMeleeCooldown = Just 0 + , _crFaction = ColorFaction green + } diff --git a/src/Dodge/Creature/ImpulseRat.hs b/src/Dodge/Creature/ImpulseRat.hs index 32c307c3b..e6e384ee8 100644 --- a/src/Dodge/Creature/ImpulseRat.hs +++ b/src/Dodge/Creature/ImpulseRat.hs @@ -103,6 +103,30 @@ flockPointTarget f targFunc w cr = case targFunc cr w of crs = IM.restrictKeys (_creatures w) is p = f crTarg crs cr +flockPointTargetR + :: (Creature -> IM.IntMap Creature -> Creature -> Point2) + -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> Reader World Creature +flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg' p cr crTarg + where + is = _swarm $ _crGroup cr + crs = IM.restrictKeys (_creatures w) is + p = f crTarg crs cr + + +--swarmUseCenter +-- :: (Creature -> Point2 -> Creature -> Point2) +-- :: (Creature -> IM.IntMap Creature -> Creature -> Point2) +-- -> (Creature -> World -> Maybe Creature) -- ^ Function for determining target +-- -> World +-- -> Creature +-- -> Creature +--swarmUseCenter + + chaseTarget :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target -> World @@ -112,13 +136,6 @@ chaseTarget targFunc w cr = case targFunc cr w of Nothing -> cr Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg -chaseTargetR - :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target - -> Creature - -> Reader World Creature -chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of - Nothing -> cr - Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg overrideMeleeCloseTarget :: World -> Creature -> Creature overrideMeleeCloseTarget _ cr = case _crTarget cr of @@ -132,24 +149,6 @@ overrideMeleeCloseTarget _ cr = case _crTarget cr of where cpos = _crPos cr -overrideMeleeCloseTargetR - :: Creature - -> Reader World Creature -overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget cr) - -tryMeleeAttack :: Creature -> Creature -> Creature -tryMeleeAttack cr tcr - | _crMeleeCooldown cr == Just 0 - && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 - && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4 - = cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike meleeActions - | otherwise = cr - where - cpos = _crPos cr - meleeActions = - [DoImpulses [Melee (_crID tcr)] - `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] - ] chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse] chaseTarg' p cr crT diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 402f4ab58..d86765c81 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -6,9 +6,10 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Volition import Dodge.Creature.ActionRat --import Dodge.Creature.ChooseTarget -import Dodge.Creature.SetTarget +import Dodge.Creature.ReaderUpdate import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State @@ -20,24 +21,23 @@ import Picture import qualified Data.IntMap.Strict as IM import Control.Lens +import Control.Monad.Reader launcherCrit :: Creature launcherCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ performActions - , watchUpdateStrat --- [ (crHasTargetLOS, shootMoveStrat (0,3) 0) + , _crUpdate = stateUpdate $ impulsiveAIR $ + performActionsR + >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire]) , (crAwayFromPost, goToPostStrat) ] - , basicPerceptionUpdate [0] - , doStrategyActions - , reloadOverride - , targetYouWhenCognizant - , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait - ] + >=> basicPerceptionUpdateR [0] + >=> doStrategyActionsR + >=> reloadOverrideR + >=> targetYouWhenCognizantR + >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] @@ -54,26 +54,26 @@ launcherCrit = defaultCreature retreatFire :: Action retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ]) `DoActionThen` - HolsterWeapon + holsterWeapon `DoActionThen` ImpulsesList ( replicate 30 [ MoveForward 3 ]) `DoActionThen` - DrawWeapon + drawWeapon `DoActionThen` ImpulsesList ( [UseItem] : replicate 20 [ Turn $ negate 0.16 ] ) `DoActionThen` - HolsterWeapon + holsterWeapon `DoActionThen` ImpulsesList ( replicate 15 [ MoveForward 3 ] ) `DoActionThen` - DrawWeapon + drawWeapon `DoActionThen` ImpulsesList ( replicate 100 [UseItem, ImpulseUseTarget $ \tcr -> TurnToward (_crPos tcr) (pi/16) ] ) `DoActionThen` 20 `WaitThen` - HolsterWeapon + holsterWeapon `DoActionThen` ImpulsesList ( replicate 15 [ MoveForward 3 ] ) `DoActionThen` diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 5528048f0..11e7e4c9c 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -5,9 +5,10 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Volition import Dodge.Creature.ActionRat --import Dodge.Creature.ChooseTarget -import Dodge.Creature.SetTarget +import Dodge.Creature.ReaderUpdate import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State @@ -21,17 +22,17 @@ import Picture --import Data.Maybe import qualified Data.IntMap.Strict as IM import Control.Lens ---import Control.Monad.State +import Control.Monad.Reader --import System.Random ltAutoCrit :: Creature ltAutoCrit = defaultCreature { _crPict = basicCrPict red - , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ performActions - , watchUpdateStrat + , _crUpdate = stateUpdate $ impulsiveAIR $ + performActionsR + >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) DrawWeapon + [DoActionIf (not . crIsAiming) drawWeapon ,DoActionThen (DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement) (DoImpulses [ChangeStrategy WatchAndWait]) @@ -39,13 +40,12 @@ ltAutoCrit = defaultCreature ) , (crAwayFromPost, goToPostStrat) ] - , basicPerceptionUpdate [0] - , doStrategyActions - , reloadOverride - , targetYouWhenCognizant - , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) - $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait - ] + >=> basicPerceptionUpdateR [0] + >=> doStrategyActionsR + >=> reloadOverrideR + >=> targetYouWhenCognizantR + >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) , _crActionPlan = ActionPlan { _crImpulse = [] , _crAction = [] diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 5c5e32775..38f8ddade 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -5,9 +5,10 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Volition import Dodge.Creature.ActionRat +import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.SetTarget import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State @@ -31,7 +32,7 @@ pistolCrit = defaultCreature performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \w cr -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) DrawWeapon,chooseMovement cr w]) + [DoActionIf (not . crIsAiming) drawWeapon,chooseMovement cr w]) , (crAwayFromPost, goToPostStrat) ] >=> basicPerceptionUpdateR [0] diff --git a/src/Dodge/Creature/Rationality.hs b/src/Dodge/Creature/Rationality.hs index 6219e7baa..9ebba8811 100644 --- a/src/Dodge/Creature/Rationality.hs +++ b/src/Dodge/Creature/Rationality.hs @@ -125,9 +125,6 @@ performAction -> Action -> ( [Impulse] , Maybe Action ) performAction cr w ac = case ac of - ShootTillEmpty -> case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of - Just x | x == 0 -> ( [UseItem] , Just ShootTillEmpty ) - _ -> ( [] , Just (WaitThen 20 HolsterWeapon) ) AimAtCloseSlow tcid p speed slowSpeed a | canSee (_crID cr) tcid w && safeAngleVV (unitVectorAtAngle cdir) (tpos -.- cpos) < a -> ([TurnToward tpos slowSpeed] , Just $ AimAtCloseSlow tcid tpos speed slowSpeed a) @@ -143,8 +140,6 @@ performAction cr w ac = case ac of ImpulsesList (xs:xss) -> (xs, Just $ ImpulsesList xss) ImpulsesList _ -> ([], Nothing) DoImpulses imps -> (imps, Nothing) - DrawWeapon -> ([ChangePosture Aiming, MakeSound pickUpSound] , Nothing) - HolsterWeapon -> ([ChangePosture AtEase, MakeSound putDownSound] , Nothing) DoActionThen fsta afta -> case performAction cr w fsta of (imps , Just nxta) -> (imps, Just (DoActionThen nxta afta)) (imps , Nothing ) -> (imps, Just afta) @@ -175,12 +170,10 @@ performAction cr w ac = case ac of LeadTarget p -> case cr ^? crTarget . _Just of Just tcr -> ([TurnTo (_crPos tcr +.+ rotateV (_crDir tcr) p)], Nothing) _ -> ([], Nothing) - FleeFrom cid -> case w ^? creatures . ix cid of - Just tcr -> ([MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)], Nothing) - _ -> ([], Nothing) UseTargetCID f -> case cr ^? crTarget . _Just of Just tcr -> performAction cr w (f $ _crID tcr) _ -> ([],Nothing) + UseTarget f -> performAction cr w $ f $ cr ^? crTarget . _Just UseAheadPos f -> performAction cr w (f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr))) ArbitraryAction f -> performAction cr w (f cr w) DoImpulsesAlongside sideImp mainAc -> case performAction cr w mainAc of diff --git a/src/Dodge/Creature/ReaderUpdate.hs b/src/Dodge/Creature/ReaderUpdate.hs new file mode 100644 index 000000000..574bb9ac7 --- /dev/null +++ b/src/Dodge/Creature/ReaderUpdate.hs @@ -0,0 +1,138 @@ +{- | Function updating a creature in a Reader World environment -} +module Dodge.Creature.ReaderUpdate + where +import Dodge.Data +import Dodge.Creature.Stance.Data +import Dodge.Creature.Test +import Dodge.Creature.Volition +import Dodge.Creature.AlertLevel.Data +import Geometry + +import qualified Data.IntMap.Strict as IM +import Control.Monad.Reader +import Control.Lens + +overrideMeleeCloseTargetR + :: Creature + -> Reader World Creature +overrideMeleeCloseTargetR cr = return $ maybe cr (tryMeleeAttack cr) (_crTarget cr) + +tryMeleeAttack :: Creature -> Creature -> Creature +tryMeleeAttack cr tcr + | _crMeleeCooldown cr == Just 0 + && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 + && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4 + = cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike meleeActions + | otherwise = cr + where + cpos = _crPos cr + meleeActions = + [DoImpulses [Melee (_crID tcr)] + `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] + ] + +chaseTargetR + :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> Creature + -> Reader World Creature +chaseTargetR targFunc cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg + +chaseTarg :: Creature -> Creature -> [Impulse] +chaseTarg cr crT + | dist tpos cpos < combinedRad + 5 + && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 + = [ TurnToward tpos 0.05 ] + | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4 + = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ] + | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ] + where + cpos = _crPos cr + tpos = _crPos crT + combinedRad = _crRad cr + _crRad crT + +doStrategyActionsR + :: Creature + -> Reader World Creature +doStrategyActionsR cr = return $ case cr ^? crActionPlan . crStrategy of + Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs + & crActionPlan . crStrategy .~ strat + _ -> cr + +reloadOverrideR + :: Creature + -> Reader World Creature +reloadOverrideR cr + | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 + && cr ^. crStance . posture == Aiming + = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions + | otherwise = return $ cr + where + reloadActions = + [ holsterWeapon + , WaitThen 1 $ DoActionWhileInterrupt NoAction crIsReloading (DoImpulses [ChangeStrategy WatchAndWait]) + ] + +overrideInternalR + :: ((World , Creature) -> Bool) + -> (World -> Creature -> Creature) + -> Creature + -> Reader World Creature +overrideInternalR test update cr = reader $ \w -> + if test (w,cr) + then update w cr + else cr +overrideInternalRR + :: ((World , Creature) -> Bool) + -> (Creature -> Reader World Creature) + -> Creature + -> Reader World Creature +overrideInternalRR test update cr = reader $ \w -> + if test (w,cr) + then runReader (update cr) w + else cr + +watchUpdateStratR + :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ] + -> Creature + -> Reader World Creature +watchUpdateStratR fs cr = reader $ \w -> case cr ^? crActionPlan . crStrategy of + Just WatchAndWait -> cr + & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr + _ -> cr + +watchUpdateStratRRR + :: [ (Creature -> Reader World Bool, Creature -> Reader World Strategy) ] + -> Creature + -> Reader World Creature +watchUpdateStratRRR fs cr = do + return undefined fs cr +-- reader $ \w -> case cr ^? crActionPlan . crStrategy of +-- Just WatchAndWait -> cr +-- & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr +-- _ -> cr + + + +listGuard :: ([(a -> Bool, b)] , b) -> a -> b +listGuard ( (test,y):ps, z ) x + | test x = y + | otherwise = listGuard (ps, z) x +listGuard (_,z) _ = z + +targetYouWhenCognizantR :: Creature -> Reader World Creature +targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of +-- Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0 + Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0} + _ -> cr & crTarget .~ Nothing + +shootTargetWithStratR + :: (Creature -> World -> Maybe Creature) -- ^ Function for determining target + -> (World -> Creature -> Creature -> [Action] -> [Action]) + -- ^ Function for determining shooting strategy given target + -> Creature + -> Reader World Creature +shootTargetWithStratR targFunc strat cr = reader $ \w -> case targFunc cr w of + Nothing -> cr + Just crTarg -> cr & crActionPlan . crAction %~ strat w cr crTarg diff --git a/src/Dodge/Creature/SentinelAI.hs b/src/Dodge/Creature/SentinelAI.hs new file mode 100644 index 000000000..915361296 --- /dev/null +++ b/src/Dodge/Creature/SentinelAI.hs @@ -0,0 +1,136 @@ +module Dodge.Creature.SentinelAI + where +import Dodge.Data +import Dodge.Base.Collide +import Dodge.Creature.Test +import Dodge.Creature.Volition +import Dodge.Creature.ReaderUpdate +import Dodge.Creature.ActionRat +--import Dodge.Creature.ChooseTarget +import Dodge.Creature.Rationality +import Dodge.Creature.AlertLevel +--import Dodge.Creature.State +--import Dodge.Creature.State.Data +--import Geometry +--import Picture +--import Dodge.RandomHelp + +import Data.Maybe +--import qualified Data.IntMap.Strict as IM +import Control.Lens +import Control.Monad +import Control.Monad.Reader +--import System.Random + +sentinelAI :: Creature -> Reader World Creature +sentinelAI = sentinelExtraWatchUpdate + [ (crHasTargetLOS + , \ _ cr -> + let lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + tcid = _crID $ fromJust $ _crTarget cr + in StrategyActions (ShootAt tcid) + [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + lostest `DoActionWhile` + advanceShoot `DoActionThen` + 75 `DoReplicate` + advanceShoot `DoActionThen` + DoImpulses [ChangeStrategy WatchAndWait] + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + ) + ] + >=> reloadOverrideR + where + +sentinelFireType + :: (Int -> Action) + -> Creature + -> Reader World Creature +sentinelFireType f = performActionsR + >=> watchUpdateStratR + [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) + [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait] + , aiming] + ) + , (crAwayFromPost, goToPostStrat) + ] + >=> basicPerceptionUpdateR [0] + >=> doStrategyActionsR + >=> reloadOverrideR + >=> targetYouWhenCognizantR + >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + where + drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + aiming = AimAtCloseSlow + { _targetID = 0 + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + +sentinelExtraWatchUpdate + :: [((World, Creature) -> Bool , World -> Creature -> Strategy)] + -> Creature + -> Reader World Creature +sentinelExtraWatchUpdate xs = performActionsR + >=> watchUpdateStratR + ( xs ++ [(crAwayFromPost, goToPostStrat)] ) + >=> basicPerceptionUpdateR [0] + >=> doStrategyActionsR +-- >=> reloadOverrideR + >=> targetYouWhenCognizantR + >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0)))) + $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait) + + +shootAtAdvance :: Int -> [Action] +shootAtAdvance tcid = + [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + lostest `DoActionWhile` + advanceShoot `DoActionThen` + 75 `DoReplicate` + advanceShoot `DoActionThen` + DoImpulses [ChangeStrategy WatchAndWait] + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + where + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + +shootAtWhileContinueTime :: Int -> World -> Creature -> Strategy +shootAtWhileContinueTime tcid _ _ = StrategyActions (ShootAt tcid) + [ DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction)) + `DoActionThen` + lostest `DoActionWhile` + advanceShoot `DoActionThen` + 75 `DoReplicate` + advanceShoot `DoActionThen` + DoImpulses [ChangeStrategy WatchAndWait] + , AimAtCloseSlow + { _targetID = tcid + , _targetSeenAt = (0,0) -- hack + , _aimSpeed = 0.2 + , _slowAimSpeed = 0.01 + , _slowAimAngle = pi/8 + } + ] + where + lostest (w,cr') = canSee (_crID cr') tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index 6f96b4c66..a8d138d43 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/src/Dodge/Creature/SetTarget.hs @@ -7,7 +7,6 @@ import Dodge.Data import Dodge.Creature.AlertLevel.Data import Control.Lens -import Control.Monad.Reader import qualified Data.IntMap.Strict as IM {- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -} targetYouWhenCognizant @@ -18,8 +17,3 @@ targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0 _ -> cr & crTarget .~ Nothing -targetYouWhenCognizantR :: Creature -> Reader World Creature -targetYouWhenCognizantR cr = reader $ \w -> case cr ^? crAwarenessLevel . ix 0 of --- Just (Cognizant _) -> cr & crTarget ?~ _creatures w IM.! 0 - Just (Cognizant _) -> cr {_crTarget = Just $! _creatures w IM.! 0} - _ -> cr & crTarget .~ Nothing diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 51a6cc720..3dfb4e4f8 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -5,9 +5,10 @@ import Dodge.Data import Dodge.Default import Dodge.Creature.Picture import Dodge.Creature.Test +import Dodge.Creature.Volition import Dodge.Creature.ActionRat +import Dodge.Creature.ReaderUpdate --import Dodge.Creature.ChooseTarget -import Dodge.Creature.SetTarget import Dodge.Creature.Rationality import Dodge.Creature.AlertLevel import Dodge.Creature.State @@ -31,7 +32,7 @@ spreadGunCrit = defaultCreature performActionsR >=> watchUpdateStratR [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) - [DoActionIf (not . crIsAiming) DrawWeapon + [DoActionIf (not . crIsAiming) drawWeapon ,DoActionThen (DoActionWhile crHasTargetLOS $ ArbitraryAction chooseMovement) (DoImpulses [ChangeStrategy WatchAndWait]) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 7f6d6bde2..53c8ac242 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -2,6 +2,7 @@ module Dodge.Creature.State where import Dodge.Data import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data +--import Dodge.Creature.Test import Dodge.Base import Dodge.SoundLogic import Dodge.RandomHelp @@ -40,7 +41,7 @@ stateUpdate u w (f,g) cr = ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f' , g') - , fmap (updateReloadCounter . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr + , fmap (stepReloading . stepItemUseCooldown . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr ) where crOrCorpse cr' @@ -153,10 +154,16 @@ isFrictionless cr = case cr ^? crStance . carriage of Just Floating -> True _ -> False -updateReloadCounter :: Creature -> Creature -updateReloadCounter cr = over (crInv . ix iSel . itUseTime) decreaseToZero - . over (crInv . ix iSel . wpReloadState) decreaseToZero - $ cr +stepItemUseCooldown :: Creature -> Creature +stepItemUseCooldown cr = over (crInv . ix iSel . itUseTime) decreaseToZero cr + where + iSel = _crInvSel cr + +stepReloading :: Creature -> Creature +stepReloading cr +-- | crIsAiming' cr = cr +-- | otherwise + = over (crInv . ix iSel . wpReloadState) decreaseToZero cr where iSel = _crInvSel cr diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index b5a0350c9..c075372a6 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -11,6 +11,7 @@ import Dodge.Creature.ImpulseRat import Dodge.Creature.ChooseTarget --import Dodge.Creature.SetTarget import Dodge.Creature.Rationality +import Dodge.Creature.ReaderUpdate import Dodge.Creature.AlertLevel import Dodge.Creature.State import Dodge.Creature.State.Data @@ -22,18 +23,21 @@ import Picture --import Data.Maybe --import qualified Data.IntMap.Strict as IM import Control.Lens +import Control.Monad.Reader --import Control.Monad.State --import System.Random swarmCrit :: Creature swarmCrit = defaultCreature - { _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs - [ flockPointTarget encircle targetYouLOS - , \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1) - , basicPerceptionUpdate [0] + { _crUpdate = stateUpdate $ impulsiveAIR $ + flockPointTargetR encircle targetYouLOS + >=> return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1)) + >=> basicPerceptionUpdateR [0] + >=> doStrategyActionsR + >=> targetYouWhenCognizantR -- , doStrategyActions -- , targetYouWhenCognizant - ] + , _crHP = 1 , _crRad = 2 , _crMass = 2 diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index ff0694f99..aaa57e0ec 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -49,6 +49,9 @@ crCanSeeCIDR cid cr = reader $ \w -> hasLOS (_crPos cr) (_crPos $ _creatures w I crIsAiming :: (World,Creature) -> Bool crIsAiming (_,cr) = _posture (_crStance cr) == Aiming +crIsAiming' :: Creature -> Bool +crIsAiming' cr = _posture (_crStance cr) == Aiming + crIsAimingR :: Creature -> Reader World Bool crIsAimingR cr = return $ _posture (_crStance cr) == Aiming @@ -99,3 +102,9 @@ crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan c where sentinelGoal (SentinelAt _ _) = True sentinelGoal _ = False + +crHasAmmo :: (World,Creature) -> Bool +crHasAmmo (_,cr) = maybe False (> 0) $ cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo + +crCanShoot :: (World,Creature) -> Bool +crCanShoot p = crIsAiming p && crHasAmmo p diff --git a/src/Dodge/Creature/Volition.hs b/src/Dodge/Creature/Volition.hs new file mode 100644 index 000000000..a9ef6f52d --- /dev/null +++ b/src/Dodge/Creature/Volition.hs @@ -0,0 +1,39 @@ +{- | Not a good name, perhaps: internal creature actions. -} +module Dodge.Creature.Volition + where +import Dodge.Data +import Dodge.Base.Collide +import Dodge.Creature.Test +import Dodge.Creature.Stance.Data +import Dodge.SoundLogic.Synonyms +import Geometry + +holsterWeapon, drawWeapon :: Action +holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound putDownSound] +drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound pickUpSound] + +fleeFrom :: Creature -> Maybe Creature -> Action +fleeFrom cr mtcr = case mtcr of + Just tcr -> DoImpulses [MoveForward 3, TurnToward ((2 *.* _crPos cr) -.- _crPos tcr) (pi/4)] + Nothing -> NoAction + +shootTillEmpty :: Action +--shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) +shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem]) + `DoActionThen` 20 `WaitThen` holsterWeapon + +advanceShoot' :: Int -> Action +advanceShoot' tcid = lostest `DoActionWhile` + advanceShoot `DoActionThen` + 75 `DoReplicate` + advanceShoot + where + lostest (w,cr) = canSee (_crID cr) tcid w + advanceShoot = ImpulsesList [[UseItem, MoveForward 3]] + +shootFirstMiss' :: Action +shootFirstMiss' = + LeadTarget (30,50) `DoActionThen` + DoImpulses [UseItem] `DoActionThen` + (crCanShoot `DoActionWhile` DoActions [LeadTarget (0,0),DoImpulses [UseItem]]) + `DoActionThen` 20 `WaitThen` holsterWeapon diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f8d3fb328..964fb2603 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -509,9 +509,6 @@ data Action | PathTo {_pathToPoint :: Point2 } - | FleeFrom - {_fleeFromCID :: Int - } | HealSelf | DefendSelf | Protect @@ -524,15 +521,12 @@ data Action | PickupItem {_pickupItemID :: Int } - | ShootTillEmpty | ImpulsesList {_impulsesListList :: [[Impulse]] } | DoImpulses {_doImpulsesList :: [Impulse] } - | DrawWeapon - | HolsterWeapon | WaitThen {_waitThenTimer :: Int ,_waitThenAction :: Action @@ -587,9 +581,15 @@ data Action } | NoAction | StartSentinelPost + | UseTarget + {_useTarget :: Maybe Creature -> Action + } | UseTargetCID {_useTargetCID :: Int -> Action } + | UseSelf + {_useSelf :: Creature -> Action + } | UseAheadPos {_useAheadPos :: Point2 -> Action } diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 8628a801a..f50a6833f 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -43,7 +43,7 @@ handlePressedKeyInGame scode w | scode == pauseKey (_keyConfig w) = Just $ pauseGame $ escapeMap w | scode == dropItemKey (_keyConfig w) = Just $ youDropItem w | scode == toggleMapKey (_keyConfig w) = Just $ toggleMap w - | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ reloadWeapon (_yourID w) w + | scode == reloadKey (_keyConfig w) = Just $ fromMaybe w $ startReloadingWeapon (_yourID w) w | scode == testEventKey (_keyConfig w) = Just $ testEvent w | scode == spaceActionKey (_keyConfig w) = Just $ spaceAction w | scode == rotateCameraPlusKey (_keyConfig w) = Just $ w & cameraRot +~ 0.01 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index d3d55d06a..73fc028f0 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -8,7 +8,7 @@ module Dodge.Floor import Dodge.Data --import Dodge.Room import Dodge.Creature.State.Data ---import Dodge.Creature.SwarmCrit +import Dodge.Creature.SwarmCrit import Dodge.Room.Procedural import Dodge.Room.RoadBlock import Dodge.Room.Data @@ -31,7 +31,7 @@ import Dodge.Creature --import Dodge.RandomHelp --import Dodge.LightSources import Dodge.LevelGen.Data ---import Dodge.LevelGen.SwarmPlacement +import Dodge.LevelGen.SwarmPlacement import Dodge.Item.Weapon --import Data.Tree @@ -50,13 +50,17 @@ roomTreex = do t = treeFromTrunk [[StartRoom] ,[Corridor] + ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 + & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++) + ] + ,[Corridor] + ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 + & rmPS %~ ([sPS (0,50) 0 $ PutCrit autoCrit ]++) + ] + ,[Corridor] ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 & rmPS %~ ([sPS (0,50) 0 $ PutCrit pistolCrit ]++) ] --- ,[Corridor] --- ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 --- & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++) --- ] ,[Corridor] ,[Corridor] ,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 6a4bb929e..74d95271e 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -11,7 +11,8 @@ import Dodge.RandomHelp import Dodge.WorldEvent import Dodge.Default import Dodge.Item.Draw -import Dodge.Item.Weapon.Bullet +import Dodge.Particle.Bullet.HitEffect +import Dodge.Particle.Bullet.Spawn --import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType @@ -44,7 +45,6 @@ pistol ,lasGun ,tractorGun ,launcher - ,autoGun ,ltAutoGun ,hvAutoGun ,miniGun @@ -78,7 +78,7 @@ pistol = Weapon . withRandomDir 0.1 . withMuzFlare . withVelWthHiteff (30,0) 2 - $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' + $ destroyOnImpact bulHitCr bulHitWall' bulHitFF' , _wpSpread = 0.02 , _wpRange = 20 , _itHammer = HammerUp @@ -114,7 +114,7 @@ autoEffectGun name eff = defaultAutoGun { _itName = name ++ "Gun" , _wpFire = eff } - +autoGun :: Item autoGun = defaultGun { _itName = "AUTOGUN" , _itIdentity = AutoGun @@ -153,7 +153,7 @@ autoGunNonTwistEff = withRecoil 40 . withRandomDir (autogunSpread/2) . withMuzFlare . withVelWthHiteff (50,0) 3 - $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF' + $ destroyOnImpact bulHitCr bulHitWall' bulHitFF' rezGun = defaultGun { _itName = "REANIMATOR" @@ -356,7 +356,7 @@ shootBezier targetp cid w = over particles (theBullet :) w startp (controlp +.+ randPos) (targetp +.+ randPos') - (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') + (destroyOnImpact bulHitCr bulHitWall' bulHitFF') 5 controlp = mouseWorldPos w cr = _creatures w IM.! cid diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index a64e6c86f..5c019eda2 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -4,11 +4,11 @@ module Dodge.Item.Weapon.TriggerType where import Dodge.Data import Dodge.SoundLogic -import Dodge.Creature.Action (reloadWeapon) +import Dodge.Creature.Action (startReloadingWeapon) import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt) import Dodge.WorldEvent.Cloud import Dodge.RandomHelp -import Dodge.Item.Weapon.Bullet +import Dodge.Particle.Bullet.Spawn import Dodge.Item.Attachment.Data import Geometry @@ -64,7 +64,7 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w $ set (pointItem . itUseTime) startRate $ shooteff1 cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w + | reloadCondition = fromMaybe w $ startReloadingWeapon cid w | otherwise = w where cr = _creatures w IM.! cid @@ -90,7 +90,7 @@ withWarmUp -> World -> World withWarmUp t f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w + | reloadCondition = fromMaybe w $ startReloadingWeapon cid w | _wpReloadState item /= 0 = w | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) $ set (pointerToItem . itUseTime) 2 @@ -175,7 +175,7 @@ shootWithSound soundid f cid w $ soundOncePos soundid (_crPos cr) $ set (pointerToItem . itUseTime) (_itUseRate item) $ f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w + | reloadCondition = fromMaybe w $ startReloadingWeapon cid w | otherwise = w where cr = _creatures w IM.! cid @@ -226,7 +226,7 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . itUseTime) (_itUseRate item) $ f cid w - | reloadCondition = fromMaybe w $ reloadWeapon cid w + | reloadCondition = fromMaybe w $ startReloadingWeapon cid w | otherwise = w where cr = _creatures w IM.! cid @@ -276,7 +276,7 @@ withVelWthHiteff vel width hiteff cid w = over particles (newbul : ) $ set randGen g w where cr = _creatures w IM.! cid - newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width + newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width (colid, g) = randomR (0,11) $ _randGen w dir = _crDir cr pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr) @@ -363,7 +363,7 @@ spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++) where cr = _creatures w IM.! cid newbuls = zipWith3 - (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth) + (\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth) poss dirs colids poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)) $ (replicateM num . randInCirc) 5 & evalState $ _randGen w @@ -385,7 +385,7 @@ numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w where cr = _creatures w IM.! cid newbuls = zipWith - (\p colid -> aGenBulAt' (Just cid) (numColor colid) p (rotateV d vel) eff wth) + (\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth) poss colids d = _crDir cr diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Particle/Bullet/Draw.hs new file mode 100644 index 000000000..589cf69ba --- /dev/null +++ b/src/Dodge/Particle/Bullet/Draw.hs @@ -0,0 +1,10 @@ +module Dodge.Particle.Bullet.Draw + ( drawBul + ) where +import Dodge.Data +import Picture + +drawBul :: Particle -> Picture +drawBul pt = setLayer 1 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) + where + thecolor = _btColor' pt diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Particle/Bullet/HitEffect.hs similarity index 80% rename from src/Dodge/Item/Weapon/Bullet.hs rename to src/Dodge/Particle/Bullet/HitEffect.hs index 8d03856b8..340b2760c 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -1,11 +1,12 @@ {- | Effects of bullets upon impact with walls or creatures, and possibly force fields. -} -module Dodge.Item.Weapon.Bullet +module Dodge.Particle.Bullet.HitEffect where import Dodge.Data --import Dodge.Base import Dodge.WorldEvent +import Dodge.Particle.Bullet.Spawn import Dodge.WorldEvent.DamageBlock import Dodge.SoundLogic import Dodge.RandomHelp @@ -21,10 +22,10 @@ import Control.Monad.State --import Data.Maybe --import qualified Data.IntMap.Strict as IM -- | Basic bullet hit creature effect. -bulHitCr' :: Particle -> Point2 -> Creature -> World -> World -bulHitCr' bt p cr w +bulHitCr :: Particle -> Point2 -> Creature -> World -> World +bulHitCr bt p cr w | crIsArmouredFrom p cr - = createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w + = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w | otherwise = addDamage . makeHitSound . flashEff $ w where sp = head $ _btTrail' bt @@ -37,7 +38,8 @@ bulHitCr' bt p cr w flashEff = over worldEvents (bloodFlashAt p . ) cid = _crID cr (d1,_) = randomR (-0.7,0.7) $ _randGen w - (colID,_) = randomR (0,11) $ _randGen w + colID = _btColor' bt + --(colID,_) = randomR (0,11) $ _randGen w p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr) {- | Bounce off armoured creatures, otherwise do damage. -} bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World @@ -58,7 +60,7 @@ bulBounceArmCr' bt p cr w pOut = p +.+ 2 *.* newDir reflectVel = magV bulVel *.* newDir addBouncer = worldEvents %~ ( over particles (bouncer :) . ) - bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel + bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} {- | Bullet pass through creatures. -} @@ -81,7 +83,7 @@ bulPenCr' bt p cr w sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt addPiercer = over particles (piercer :) - piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) + piercer = (aGenBulAt (Just cid) (_btColor' bt) p (_btVel' bt) (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} {- | Heavy bullet effects when hitting creature: @@ -130,7 +132,6 @@ bulConCr' bt p cr w sp = head $ _btTrail' bt ep = sp +.+ _btVel' bt mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white) - {- | Hitting wall effects: create a spark, damage blocks. -} bulHitWall' :: Particle -> Point2 -> Wall -> World -> World bulHitWall' bt p x w = damageBlocksBy 5 x @@ -148,7 +149,7 @@ bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w where sp = head $ _btTrail' bt pOut = p +.+ safeNormalizeV (sp -.- p) - bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel + bouncer = (aGenBulAt Nothing (_btColor' bt) pOut reflectVel (_btHitEffect' bt) (_btWidth' bt) ) {_btTimer' = _btTimer' bt - 1} wallV = uncurry (-.-) (_wlLine wl) @@ -205,48 +206,6 @@ bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World bulHitFF' _ _ _ = id {- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls. -} basicBulletEffect :: HitEffect -basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF' +basicBulletEffect = destroyOnImpact bulHitCr bulHitWall' bulHitFF' -aGenBulAt' - :: Maybe Int -- ^ Pass-through creature id - -> Color - -> Point2 -- ^ Start position - -> Point2 -- ^ Velocity - -> HitEffect - -> Float -- ^ Bullet width - -> Particle -aGenBulAt' maycid col pos vel hiteff width = Bul' - { _ptDraw = drawBul - , _ptUpdate' = mvGenBullet' - , _btVel' = vel - , _btColor' = col - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 100 - , _btHitEffect' = hiteff - } -aCurveBulAt - :: Maybe Int -- ^ Pass-through creature id - -> Color - -> Point2 -- ^ Start position - -> Point2 -- ^ Control position - -> Point2 -- ^ Target position - -> HitEffect - -> Float -- ^ Bullet width - -> Particle -aCurveBulAt maycid col pos control targ hiteff width = Bul' - { _ptDraw = drawBul - , _ptUpdate' = \w -> mvGenBullet' w . setVel - , _btVel' = (0,0) - , _btColor' = col - , _btTrail' = [pos] - , _btPassThrough' = maycid - , _btWidth' = width - , _btTimer' = 100 - , _btHitEffect' = hiteff - } - where - setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt) - bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05 diff --git a/src/Dodge/Particle/Bullet/Spawn.hs b/src/Dodge/Particle/Bullet/Spawn.hs new file mode 100644 index 000000000..fea0c2fbb --- /dev/null +++ b/src/Dodge/Particle/Bullet/Spawn.hs @@ -0,0 +1,53 @@ +module Dodge.Particle.Bullet.Spawn + where +import Dodge.Data +import Dodge.Particle.Bullet.Draw +import Dodge.Particle.Bullet.Update +import Geometry +import Picture + +import Control.Lens + +aGenBulAt + :: Maybe Int -- ^ Pass-through creature id + -> Color + -> Point2 -- ^ Start position + -> Point2 -- ^ Velocity + -> HitEffect + -> Float -- ^ Bullet width + -> Particle +aGenBulAt maycid _ pos vel hiteff width = Bul' + { _ptDraw = drawBul + , _ptUpdate' = mvGenBullet' + , _btVel' = vel + , _btColor' = white + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = width + , _btTimer' = 100 + , _btHitEffect' = hiteff + } + +aCurveBulAt + :: Maybe Int -- ^ Pass-through creature id + -> Color + -> Point2 -- ^ Start position + -> Point2 -- ^ Control position + -> Point2 -- ^ Target position + -> HitEffect + -> Float -- ^ Bullet width + -> Particle +aCurveBulAt maycid col pos control targ hiteff width = Bul' + { _ptDraw = drawBul + , _ptUpdate' = \w -> mvGenBullet' w . setVel + , _btVel' = (0,0) + , _btColor' = col + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = width + , _btTimer' = 100 + , _btHitEffect' = hiteff + } + where + setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt) + bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05 diff --git a/src/Dodge/WorldEvent/Bullet.hs b/src/Dodge/Particle/Bullet/Update.hs similarity index 95% rename from src/Dodge/WorldEvent/Bullet.hs rename to src/Dodge/Particle/Bullet/Update.hs index cee31a711..0fe391f20 100644 --- a/src/Dodge/WorldEvent/Bullet.hs +++ b/src/Dodge/Particle/Bullet/Update.hs @@ -1,7 +1,7 @@ {- Bullet update. -} -module Dodge.WorldEvent.Bullet +module Dodge.Particle.Bullet.Update where import Dodge.Data --import Dodge.Base diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 184815132..2d31ffa8c 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -1,6 +1,5 @@ module Dodge.WorldEvent ( module Dodge.WorldEvent - , module Dodge.WorldEvent.Bullet , module Dodge.WorldEvent.Flash , module Dodge.WorldEvent.ThingsHit , module Dodge.WorldEvent.Cloud @@ -9,7 +8,8 @@ module Dodge.WorldEvent , module Dodge.WorldEvent.SpawnParticle ) where -import Dodge.WorldEvent.Bullet +import Dodge.Particle.Bullet.Draw +import Dodge.Particle.Bullet.Update import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit --import Dodge.WorldEvent.HelperParticle diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 8e00c537c..59b5d45e9 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -12,7 +12,8 @@ import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.Flash -import Dodge.WorldEvent.Bullet +import Dodge.Particle.Bullet.Draw +import Dodge.Particle.Bullet.Update import Dodge.SoundLogic import Dodge.RandomHelp import Dodge.Debug @@ -418,8 +419,25 @@ createSpark time colid pos dir maycid w where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt +createSparkCol :: Int -> Color -> Point2 -> Float -> Maybe Int -> World -> World +createSparkCol time col pos dir maycid w + = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . ) + where + spark = Bul' + { _ptDraw = drawBul + , _ptUpdate' = mvGenBullet' + , _btVel' = rotateV dir (5,0) + , _btColor' = col + , _btTrail' = [pos] + , _btPassThrough' = maycid + , _btWidth' = 1 + , _btTimer' = time + , _btHitEffect' = destroyOnImpact sparkEff noEff noEff + } + pos' = pos +.+ rotateV dir (5,0) + sparkEff bt p cr + = creatures . ix (_crID cr) . crState . crDamage %~ ( SparkDam 1 sp p ep : ) + where + sp = head (_btTrail' bt) + ep = sp +.+ _btVel' bt -drawBul :: Particle -> Picture -drawBul pt = setLayer 1 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt) - where - thecolor = _btColor' pt