Refactor bullet particles

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.ReaderUpdate
-import Dodge.Creature.AlertLevel
+--import Dodge.Creature.AlertLevel
-import Dodge.Creature.SetTarget
+--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
+    , _crUpdate = stateUpdate $ impulsiveAIR $
-        [ performActions
+        sentinelFireType (const shootTillEmpty)
-        , shootTargetWithStrat targetYouCognizant suppress
+    , _crActionPlan = ActionPlan
-        , basicPerceptionUpdate [0]
+        { _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
+    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelFireType $ const shootTillEmpty
-        [ performActions
-        , watchUpdateStrat
-            [ (crHasTargetLOS, aimThenShootStrat 0)
-            , (crAwayFromPost, goToPostStrat)
-            ]
-        , basicPerceptionUpdate [0]
-        , doStrategyActions
-        , reloadOverrideNoHolster
-        , targetYouWhenCognizant
-        , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
-        ]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []
@@ -142,20 +112,19 @@ multGunCrit = defaultCreature
     , _crInvSel = 0
     , _crRad = 10
     , _crHP = 300
-    , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
+    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelExtraWatchUpdate
-        [ performActions
+            [ ( not . crHasAmmo
-        , watchUpdateStrat
+              , \_ _ -> StrategyActions Reload reloadActions
-            [ (not . crSafeDistFromTarg 150 , fleeTime 5)
+              )
-            , (crHasTargetLOS, shootFirstMiss 0)
+            , (not . crSafeDistFromTarg 150 
-            , (crAwayFromPost, goToPostStrat)
+              , \_ 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 

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
+

src/Dodge/Creature/ActionRat.hs

@@ -1,162 +1,19 @@
 module Dodge.Creature.ActionRat
-    ( shootTargetWithStrat
+    ( goToPostStrat
-    , aimThenShootStrat 
-    , suppressShootTarget
-    , suppress
-    , shootAdvance
-    , shootFirstMiss
-    , doStrategyActions
-    , doStrategyActionsR
-    , reloadOverride
-    , reloadOverrideR
-    , reloadOverrideNoHolster
-    , shootAdvanceStrat
-    , shootMoveStrat
-    , watchUpdateStrat
-    , watchUpdateStratR
-    , goToPostStrat
-    , overrideInternal
-    , overrideInternalR
-    , fleeTime
     )
     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.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]]
 
 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

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.SentinelAI
-import Dodge.Creature.ActionRat
 --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 $
+    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelAI
-        performActionsR
-        >=>  watchUpdateStratR
-          [ (crHasTargetLOS, shootAdvanceStrat 0)
-          , (crAwayFromPost, goToPostStrat)
-          ] 
-        >=> basicPerceptionUpdateR [0]
-        >=> doStrategyActionsR
-        >=> reloadOverrideR
-        >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-          $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

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
+    }

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

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
+    , _crUpdate = stateUpdate $ impulsiveAIR $
-        [ performActions
+        performActionsR
-        , watchUpdateStrat
+        >=> watchUpdateStratR
---            [ (crHasTargetLOS, shootMoveStrat (0,3) 0)
             [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) [retreatFire])
             , (crAwayFromPost, goToPostStrat)
             ]
-        , basicPerceptionUpdate [0]
+        >=> basicPerceptionUpdateR [0]
-        , doStrategyActions
+        >=> doStrategyActionsR
-        , reloadOverride
+        >=> reloadOverrideR
-        , targetYouWhenCognizant
+        >=> targetYouWhenCognizantR
-        , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
+            $ \ _ -> 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`

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
+    , _crUpdate = stateUpdate $ impulsiveAIR $
-        [ performActions
+        performActionsR
-        , watchUpdateStrat
+        >=> 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]
+        >=> basicPerceptionUpdateR [0]
-        , doStrategyActions
+        >=> doStrategyActionsR
-        , reloadOverride
+        >=> reloadOverrideR
-        , targetYouWhenCognizant
+        >=> targetYouWhenCognizantR
-        , overrideInternal (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait
+            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
-        ]
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

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]

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

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

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]]

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

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])

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
+stepItemUseCooldown :: Creature -> Creature
-updateReloadCounter cr = over (crInv . ix iSel . itUseTime) decreaseToZero
+stepItemUseCooldown  cr = over (crInv . ix iSel . itUseTime) decreaseToZero cr
-    . over (crInv . ix iSel . wpReloadState) decreaseToZero
+  where 
-    $ cr
+    iSel = _crInvSel cr 
+
+stepReloading :: Creature -> Creature
+stepReloading cr 
+--    | crIsAiming' cr = cr
+--    | otherwise     
+        = over (crInv . ix iSel . wpReloadState) decreaseToZero cr
   where 
     iSel = _crInvSel cr 
 

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
+    { _crUpdate = stateUpdate $ impulsiveAIR $
-        [ flockPointTarget encircle targetYouLOS
+        flockPointTargetR encircle targetYouLOS
-        , \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
+        >=> return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1))
-        , basicPerceptionUpdate [0]
+        >=> basicPerceptionUpdateR [0]
+        >=> doStrategyActionsR
+        >=> targetYouWhenCognizantR
 --        , doStrategyActions
 --        , targetYouWhenCognizant
-        ]
+        
     , _crHP = 1
     , _crRad = 2
     , _crMass = 2

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

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

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
         }

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

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]

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

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

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

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 :: Particle -> Point2 -> Creature -> World -> World
-bulHitCr' bt p cr w 
+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

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

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

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

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