Refactor creature ai

2021-05-20 21:25:42 +02:00
parent 4463dc7716
commit 114335fdbe
32 changed files with 449 additions and 270 deletions
@@ -14,11 +14,11 @@ import Dodge.Data
 import Dodge.Base.Zone
 import Dodge.Base.Window
 import Dodge.Base.Collide
--import Dodge.Config.Data
 import Geometry
 import Picture

 import Control.Lens
+
 --import Control.Monad.State
 import Data.List
 --import Data.Function
@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
+--{-# LANGUAGE OverloadedStrings #-}
 module Dodge.Config.KeyConfig
  where
 --import Data.Aeson
@@ -7,12 +7,12 @@ module Dodge.Creature
    , spreadGunCrit
    , autoCrit
    , chaseCrit
+    , armourChaseCrit
    , smallChaseCrit
    )
  where
 --import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
-import Dodge.Creature.ImpulseRat
 --import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.AlertLevel
 --import Dodge.Creature.SetTarget
@@ -25,6 +25,7 @@ import Dodge.Creature.LtAutoCrit
 import Dodge.Creature.SpreadGunCrit
 import Dodge.Creature.AutoCrit
 import Dodge.Creature.ChaseCrit
+import Dodge.Creature.ArmourChase
 import Dodge.Data
 import Dodge.Default
 import Dodge.Base
@@ -37,7 +38,7 @@ import Dodge.Creature.Inanimate
 import Dodge.Creature.State
 import Dodge.Creature.Picture
 import Dodge.Creature.Rationality
-import Dodge.Creature.ChooseTarget
+--import Dodge.Creature.ChooseTarget
 --import Dodge.Item
 import Dodge.Picture.Layer
 import Picture
@@ -61,16 +62,6 @@ spawnerCrit = defaultCreature
    , _crPict = basicCrPict blue
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    }
-armourChaseCrit :: Creature
-armourChaseCrit = defaultCreature
-    { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
-    , _crHP = 300
-    , _crPict = basicCrPict green
-    , _crInv = IM.fromList 
-        [(0,frontArmour)
-        ,(1,medkit 200)
-        ]
-    }
 miniGunCrit :: Creature
 miniGunCrit = defaultCreature
    { _crPict = basicCrPict red
@@ -174,7 +165,7 @@ startInventory = IM.fromList (zip [0..20]
    ,lasGun
    ,autoGun
    ,flamer
-    --,poisonSprayer
+    ,poisonSprayer
    ,launcher
    --,lasGun
    --,grenade
@@ -0,0 +1,35 @@
+module Dodge.Creature.ArmourChase
+    where
+import Dodge.Data
+import Dodge.Default
+import Dodge.Creature.State
+import Dodge.Creature.Rationality
+import Dodge.Creature.ReaderUpdate
+import Dodge.Creature.AlertLevel
+import Dodge.Creature.ChooseTarget
+import Dodge.Creature.Picture
+import Dodge.Item.Equipment
+import Dodge.Item.Consumable
+import Picture
+
+import qualified Data.IntMap.Strict as IM
+import Control.Lens
+import Control.Monad.Reader
+
+armourChaseCrit :: Creature
+armourChaseCrit = 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,frontArmour)
+        ,(1,medkit 200)
+        ]
+    }
@@ -21,7 +21,7 @@ import qualified Data.IntMap.Strict as IM
 autoCrit :: Creature
 autoCrit = defaultCreature
    { _crPict = basicCrPict red
-    , _crUpdate = stateUpdate $ impulsiveAIR $ sentinelAI
+    , _crUpdate = stateUpdate $ impulsiveAIR sentinelAI
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -0,0 +1,255 @@
+module Dodge.Creature.Boid
+    where
+import Dodge.Data
+import Dodge.Base
+import Dodge.Creature.State.Data
+import Dodge.Creature.ImpulseRat
+import Geometry
+
+import Control.Monad.Reader
+import Control.Lens
+import qualified Data.IntMap as IM
+
+interpWith :: Float -> Point2 -> Point2 -> Point2
+interpWith x a b = x *.* a +.+ (1 - x) *.* b
+
+invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
+invertEncircleDistP d tcr cenp cr = ypos +.+ 
+    d *.* (reflectIn (cenp -.- ypos) $ safeNormalizeV (cpos -.- cenp))
+  where 
+    cpos = _crPos cr
+    ypos = _crPos tcr
+
+encircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
+encircleDistP d tcr cenp cr = ypos +.+ d *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    ypos = _crPos tcr
+
+encircleP :: Creature -> Point2 -> Creature -> Point2
+encircleP tcr cenp cr = ypos +.+ 50 *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    ypos = _crPos tcr
+    --f x = 150 * sigmoid (x-10)
+
+encircleCloseP :: Creature -> Point2 -> Creature -> Point2
+encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    ypos = _crPos tcr
+    f x = 150 * sigmoid (x-10)
+
+forbidFlee
+    :: (Creature -> Point2 -> Creature -> Point2)
+    -> Creature 
+    -> Point2 
+    -> Creature 
+    -> Point2
+forbidFlee f tcr cenp cr
+    | ptargTest = tpos
+    | otherwise = ptarg
+  where
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    ptarg = f tcr cenp cr
+    ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi/2)) (cpos -.- tpos)) ptarg
+    --      && isRHS cpos (cpos +.+ rotateV (pi/3) (cpos -.- tpos)) ptarg
+    --targBehindCrit = isLHS cpos (vNormal $ cpos +.+ unitVectorAtAngle (_crDir cr)) ptarg
+
+pincerP :: Creature -> Point2 -> Creature -> Point2
+pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    splitp 
+        | isLHS cenp cpos tpos
+            = 150 *.* orthCenpTpos
+        | otherwise
+            = negate 150 *.* orthCenpTpos
+    --d = min 150 (dist cpos tpos)
+    --orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos)
+    orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp)
+
+pincerP''' :: Creature -> Point2 -> Creature -> Point2
+pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
+  where 
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    dtcen = dist tpos cenp
+    f x = 150 * sigmoid (x-10)
+    cenawayp 
+        | dist cenp tpos < dist cpos tpos = tpos +.+ splitp
+        | otherwise = cenp +.+ splitp
+    splitp 
+        | isLHS cenp cpos tpos
+            = f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos
+        | otherwise
+            = negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
+    orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cenp)
+    cenclosep 
+            = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+
+pincerP' :: Creature -> Point2 -> Creature -> Point2
+pincerP' tcr cenp cr 
+    | dist cenp tpos > dist cpos tpos 
+                = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+    | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    f x = 150 * sigmoid (x-10)
+
+pincerP'' :: Creature -> Point2 -> Creature -> Point2
+pincerP'' tcr cenp cr 
+    | dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos
+        = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ tpos -.- cenp)
+    | dist cenp tpos > dist cpos tpos 
+        = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (vNormal $ cenp -.- tpos)
+    | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    f x = 150 * sigmoid (x-10)
+
+encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
+encircle tcr crs cr 
+    | length crs <= 1 = ypos
+    | otherwise       = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
+  where 
+    cpos = _crPos cr
+    ypos = _crPos tcr
+    f x = 150 * sigmoid (x-10)
+    cenp = centroid (map _crPos $ IM.elems crs)
+
+lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
+lineOrth tcr crs cr = p
+  where 
+    ypos = _crPos tcr
+    cpos = _crPos cr
+    ps = map _crPos $ IM.elems crs 
+    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+    p   | dist cen ypos < 20 = ypos
+        | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
+
+holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
+holdForm ycr crs cr = p
+  where
+    ypos = _crPos ycr
+    cpos = _crPos cr
+    ps = map _crPos $ IM.elems crs 
+    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+    p   | dist cen ypos < 20 = ypos
+        | otherwise = ypos +.+ cpos -.- cen
+
+lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
+lineUp ycr crs cr = p
+  where
+    ypos = _crPos ycr
+    cpos = _crPos cr
+    ps = map _crPos $ IM.elems crs 
+    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+    p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
+
+-- not nice, a kind of encircle
+spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2
+spreadOut ycr crs cr = p
+  where
+    ypos = _crPos ycr
+    cpos = _crPos cr
+    ps = map _crPos $ IM.elems crs 
+    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
+    p   | dist cen ypos < 30 = ypos
+        | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
+    spreadFactor 
+        | dist ypos cpos > 90 = 1
+        | otherwise = 1.5
+
+swarmUsingCenter
+    :: (Creature -> Point2 -> Creature -> Creature) 
+    -> (Point2 -> Creature -> Creature)
+    -> World
+    -> Creature
+    -> Creature
+swarmUsingCenter updT upd w cr = case _crTarget cr of
+    Nothing -> upd cenp cr
+    Just tcr -> updT tcr cenp cr
+  where
+    cid = _crID cr
+    cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup $ _creatures w IM.! cid)
+
+flockChaseTarget
+    :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
+    -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
+    -> World
+    -> Creature
+    -> Creature
+flockChaseTarget updT upd w cr = case _crTarget cr of
+    Nothing -> upd crs cr
+    Just tcr -> updT tcr crs cr
+  where
+    is = _swarm $ _crGroup cr
+    crs = IM.restrictKeys (_creatures w) is
+
+flockPointTarget
+    :: (Creature -> IM.IntMap Creature -> Creature -> Point2)
+    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> World 
+    -> Creature 
+    -> Creature 
+flockPointTarget f targFunc w cr = case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg
+      where
+        is = _swarm $ _crGroup cr
+        crs = IM.restrictKeys (_creatures w) is
+        p = f crTarg crs cr
+
+flockToPointUsing
+    :: (Creature -> Point2 -> Creature -> Point2)
+    -> (Point2 -> Creature -> Creature -> [Impulse])
+    -> Creature
+    -> Reader World Creature
+flockToPointUsing pf mvf cr = reader $ \w -> case _crTarget cr of
+    Nothing -> cr
+    Just tcr -> cr & crActionPlan . crImpulse .~ mvf ptarg cr tcr
+      where
+        cenp = _crGroupCenter $ _creatureGroups w IM.! _crGroupID (_crGroup cr)
+        ptarg = pf tcr cenp cr
+
+flockFunc
+    :: (Creature -> Point2 -> Creature -> Point2)
+    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> Creature 
+    -> Reader World Creature 
+flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg
+      where
+        cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr))
+        p = f crTarg cenp cr
+
+flockCenterFunc
+    :: (Creature -> Point2 -> Creature -> Point2)
+    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -> Creature 
+    -> Reader World Creature 
+flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
+    Nothing -> cr
+    Just crTarg -> cr & crActionPlan . crImpulse .~ mvPointMeleeTarg p cr crTarg
+      where
+        cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID (_crGroup cr))
+        p = f crTarg cenp 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 .~ mvPointMeleeTarg p cr crTarg
+      where
+        is = _swarm $ _crGroup cr
+        crs = IM.restrictKeys (_creatures w) is
+        p = f crTarg crs cr
@@ -1,130 +1,14 @@
 module Dodge.Creature.ImpulseRat
    where
 import Dodge.Data
-import Dodge.Base
+--import Dodge.Base
 --import Dodge.Creature.ChooseTarget
-import Dodge.Creature.State.Data
+--import Dodge.Creature.State.Data
 import Geometry

-import qualified Data.IntMap as IM
+--import qualified Data.IntMap as IM
 import Control.Lens
-import Control.Monad.Reader
-
-encircle :: Creature -> IM.IntMap Creature -> Creature -> Point2
-encircle tcr crs cr 
-    | length crs <= 1 = ypos
-    | otherwise       = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.* safeNormalizeV (cpos -.- cenp)
-  where 
-    cpos = _crPos cr
-    ypos = _crPos tcr
-    f x = 150 * sigmoid (x-10)
-    cenp = (1 / fromIntegral (length crs)) *.* foldr1 (+.+) (map _crPos $ IM.elems crs)
-
-lineOrth :: Creature -> IM.IntMap Creature -> Creature -> Point2
-lineOrth tcr crs cr = p
-  where 
-    ypos = _crPos tcr
-    cpos = _crPos cr
-    ps = map _crPos $ IM.elems crs 
-    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 20 = ypos
-        | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
-
-holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
-holdForm ycr crs cr = p
-  where
-    ypos = _crPos ycr
-    cpos = _crPos cr
-    ps = map _crPos $ IM.elems crs 
-    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 20 = ypos
-        | otherwise = ypos +.+ cpos -.- cen
-
-lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
-lineUp ycr crs cr = p
-  where
-    ypos = _crPos ycr
-    cpos = _crPos cr
-    ps = map _crPos $ IM.elems crs 
-    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p = (0.05 *.* ypos) +.+ (0.95 *.* errorClosestPointOnLine 500 cen ypos cpos)
-
-- not nice, a kind of encircle
-spreadOut :: Creature -> IM.IntMap Creature -> Creature -> Point2
-spreadOut ycr crs cr = p
-  where
-    ypos = _crPos ycr
-    cpos = _crPos cr
-    ps = map _crPos $ IM.elems crs 
-    cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 30 = ypos
-        | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
-    spreadFactor 
-        | dist ypos cpos > 90 = 1
-        | otherwise = 1.5
-
-swarmUsingCenter
-    :: (Creature -> Point2 -> Creature -> Creature) 
-    -> (Point2 -> Creature -> Creature)
-    -> World
-    -> Creature
-    -> Creature
-swarmUsingCenter updT upd w cr = case _crTarget cr of
-    Nothing -> upd cenp cr
-    Just tcr -> updT tcr cenp cr
-  where
-    cid = _crID cr
-    cenp = _crGroupCenter $ _creatureGroups w IM.! (_crGroupID $ _crGroup $ _creatures w IM.! cid)
-
-flockChaseTarget
-    :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
-    -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
-    -> World
-    -> Creature
-    -> Creature
-flockChaseTarget updT upd w cr = case _crTarget cr of
-    Nothing -> upd crs cr
-    Just tcr -> updT tcr crs cr
-  where
-    is = _swarm $ _crGroup cr
-    crs = IM.restrictKeys (_creatures w) is
-
-flockPointTarget
-    :: (Creature -> IM.IntMap Creature -> Creature -> Point2)
-    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
-    -> World 
-    -> Creature 
-    -> Creature 
-flockPointTarget f targFunc w cr = 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
-
-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
+--import Control.Monad.Reader


 chaseTarget
@@ -149,9 +33,34 @@ overrideMeleeCloseTarget _ cr = case _crTarget cr of
  where
    cpos = _crPos cr

+meleeHeadingMove
+    :: Float -- ^ max turn speed
+    -> Float -- ^ min turn speed
+    -> Float -- ^ turn speed cutoff angle
+    -> Float -- ^ move speed
+    -> Point2 -- ^ target point
+    -> Creature -- ^ start creature
+    -> Creature -- ^ target creature
+    -> [Impulse]
+meleeHeadingMove maxta minta tacutoff speed tp cr tcr
+    | dist tpos cpos < combinedRad + 5 
+            && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
+            && _crMeleeCooldown cr == Just 0
+        = [Melee (_crID tcr), Turn pi]
+    | dist tpos cpos < combinedRad + 5 
+            && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
+        = [ TurnToward tpos minta ]
+    | abs (_crDir cr - argV (tp -.- cpos)) < tacutoff
+                = [MoveForward speed , TurnToward tp maxta , RandomTurn maxta ]
+    | otherwise = [MoveForward speed , TurnToward tp minta, RandomTurn maxta ]
+  where
+    cpos = _crPos cr
+    tpos = _crPos tcr
+    combinedRad = _crRad cr + _crRad tcr
+    

-chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse]
-chaseTarg' p cr crT
+mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse]
+mvPointMeleeTarg p cr crT
    | dist tpos cpos < combinedRad + 5 
            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
            && _crMeleeCooldown cr == Just 0
@@ -160,8 +69,8 @@ chaseTarg' p cr crT
            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
        = [ TurnToward tpos 0.05 ]
    | abs (_crDir cr - argV (p -.- cpos)) < pi/4
-                = [MoveForward 2.5 , TurnToward p 0.2 , RandomTurn 0.2 ]
-    | otherwise = [MoveForward 2.5 , TurnToward p 0.05, RandomTurn 0.2 ]
+                = [MoveForward 3 , TurnToward p 0.2 , RandomTurn 0.2 ]
+    | otherwise = [MoveForward 3 , TurnToward p 0.05, RandomTurn 0.2 ]
  where
    cpos = _crPos cr
    tpos = _crPos crT
@@ -36,8 +36,9 @@ launcherCrit = defaultCreature
        >=> doStrategyActionsR
        >=> reloadOverrideR
        >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+        >=> overrideInternalR    
+            (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -44,8 +44,9 @@ ltAutoCrit = defaultCreature
        >=> doStrategyActionsR
        >=> reloadOverrideR
        >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+        >=> overrideInternalR 
+            (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -6,7 +6,7 @@ module Dodge.Creature.Picture
    , circLine
    ) where
 import Dodge.Data
-import Dodge.Creature.Stance.Data
+--import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 --import Dodge.Creature.AlertLevel.Data
 import Dodge.Picture.Layer
@@ -67,7 +67,7 @@ drawEquipment
 drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
  where 
    f (i,it) = case it ^? itEquipPict of
-        Just g | (cr ^? crStance . posture) == Just Aiming -> g cr i
+        Just g -> g cr i
        _      -> blank

 circLine :: Float -> Picture
@@ -28,7 +28,9 @@ impulsiveAIR
    -> (World -> World, StdGen)
    -> Creature
    -> ((World -> World, StdGen) , Maybe Creature)
-impulsiveAIR impf w (f,g) cr = followImpulses w (f,g) . ($ w) . runReader . impf $ cr
+impulsiveAIR impf w (f,g) = followImpulses w (f,g') . ($ w) . runReader . impf
+  where
+    (g',_) = split g

 impulsiveAI 
    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
@@ -67,7 +67,7 @@ reloadOverrideR cr
    | cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo == Just 0 
            && cr ^. crStance . posture == Aiming
        = return $ cr & crActionPlan . crStrategy .~ StrategyActions Reload reloadActions
-    | otherwise = return $ cr
+    | otherwise = return cr
  where
    reloadActions = 
        [ holsterWeapon
@@ -48,7 +48,6 @@ sentinelAI = sentinelExtraWatchUpdate
        )
      ] 
    >=> reloadOverrideR
-  where

 sentinelFireType
    :: (Int -> Action)
@@ -66,8 +65,9 @@ sentinelFireType f = performActionsR
    >=> doStrategyActionsR
    >=> reloadOverrideR
    >=> targetYouWhenCognizantR
-    >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-      $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+    >=> overrideInternalR 
+        (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+        (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
  where
    drawwp = DoActionIfElse NoAction crIsAiming (DoActionThen drawWeapon (WaitThen 50 NoAction))
    aiming = AimAtCloseSlow 
@@ -89,8 +89,8 @@ sentinelExtraWatchUpdate xs = performActionsR
    >=> doStrategyActionsR
 --    >=> reloadOverrideR
    >=> targetYouWhenCognizantR
-    >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-      $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+    >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+      (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)


 shootAtAdvance :: Int -> [Action]
@@ -44,8 +44,8 @@ spreadGunCrit = defaultCreature
        >=> doStrategyActionsR
        >=> reloadOverrideR
        >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-          $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+        >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+          (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
    , _crActionPlan = ActionPlan
        { _crImpulse    = []
        , _crAction     = []
@@ -5,10 +5,11 @@ module Dodge.Creature.SwarmCrit
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.Picture
+import Dodge.Creature.Boid
 --import Dodge.Creature.Test
 --import Dodge.Creature.ActionRat
 import Dodge.Creature.ImpulseRat
-import Dodge.Creature.ChooseTarget
+--import Dodge.Creature.ChooseTarget
 --import Dodge.Creature.SetTarget
 import Dodge.Creature.Rationality
 import Dodge.Creature.ReaderUpdate
@@ -30,7 +31,7 @@ import Control.Monad.Reader
 swarmCrit :: Creature
 swarmCrit = defaultCreature
    { _crUpdate = stateUpdate $ impulsiveAIR $
-        flockPointTargetR encircle targetYouLOS
+        flockToPointUsing (encircleDistP (100)) (meleeHeadingMove 0.1 0.1 (pi/4) 3.9)
        >=> return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1))
        >=> basicPerceptionUpdateR [0]
        >=> doStrategyActionsR
@@ -46,3 +47,12 @@ swarmCrit = defaultCreature
    , _crFaction = ColorFaction yellow
    , _crMeleeCooldown = Just 0
    }
+
+--swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2
+--swarmCritMoveFunc tcr cenp cr 
+--    | targBehindCrit 
+--  where
+--    cpos = _crPos cr
+--    ypos = _crPos tcr
+
+
@@ -24,7 +24,7 @@ yourControl w (f,g) cr =
    , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
    )
  where 
-    speed = _varMovementSpeedModifier w * equipFactor
+    speed = 3 * equipFactor
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
 {- | Turn key presses into creature movement.  -}
 wasdWithAiming 
@@ -50,7 +50,6 @@ wasdWithAiming w speed i cr
                                    *.* rotateV (_cameraRot w) (_mousePos w)
        _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w

-
 wasdM :: World -> SDL.Scancode -> Point2
 wasdM w scancode 
 | scancode == moveUpKey    (_keyConfig w) = ( 0, 1)
@@ -91,8 +91,6 @@ data World = World
    , _seenLocations        :: IM.IntMap (World -> Point2,String)
    , _selLocation          :: Int
    , _keyConfig            :: KeyConfigSDL
-    , _varMovementSpeedModifier :: Float
-    , _varMovementStrafeSpeedModifier :: Float
    , _debugMode            :: Bool
    , _config               :: Configuration
    , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
@@ -272,8 +272,6 @@ defaultWorld = World
        ]
    , _selLocation = 0
    , _keyConfig = defaultKeyConfigSDL
-    , _varMovementSpeedModifier = 3
-    , _varMovementStrafeSpeedModifier = 3
    , _debugMode = True
    , _config       = defaultConfig
    , _sideEffects          = []
@@ -125,7 +125,7 @@ wheelDownEvent w = case _carteDisplay w of

 upInvPos :: World -> World
 upInvPos w = stopSoundFrom (CrReloadSound 0) $ w
-    & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . (subtract 1)
+    & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract 1
  where 
    n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
 downInvPos :: World -> World
@@ -60,8 +60,6 @@ handlePressedKey _    scode w

 debugKey :: Scancode -> World -> Maybe World 
 debugKey scancode w
-    | scancode == ScancodeF7 = Just $ w & varMovementSpeedModifier -~ 1
-    | scancode == ScancodeF8 = Just $ w & varMovementSpeedModifier +~ 1
    | scancode == ScancodeF5 = Just $ dropLight w 
    | scancode == ScancodeF6 = Just $ dropLight' w 
 debugKey _ w = Just w
@@ -50,14 +50,14 @@ roomTreex = do
        t = treeFromTrunk 
            [[StartRoom]
            ,[Corridor]
+            ,[Corridor]
            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++)
+                & rmPS %~ ([sPS (0,50) 0 $ PutCrit armourChaseCrit ]++)
             ]
            ,[Corridor]
            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
-                & rmPS %~ ([sPS (0,50) 0 $ PutCrit autoCrit ]++)
+                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200,202] ]++)
             ]
-            ,[Corridor]
            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
                & rmPS %~ ([sPS (0,50) 0 $ PutCrit pistolCrit ]++)
             ]
@@ -21,7 +21,7 @@ medkit i = defaultConsumable
    , _itAmount = 1
    , _cnEffect = heal i
    , _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
-    , _itEquipPict = drawWeapon $ color blue $ circleSolid 3
+    , _itEquipPict = pictureItem $ color blue $ circleSolid 3
    , _itID = Nothing
    }

@@ -2,17 +2,32 @@ module Dodge.Item.Draw
    where
 import Dodge.Data
 import Dodge.Picture.Layer
+import Dodge.Creature.Stance.Data
 import Picture
 {- |
 Places an item picture onto a creature when the item is selected. -}
-drawWeapon 
+pictureWeaponOnAim
    :: Picture 
    -> Creature 
    -> Int  -- ^ Position of item in inventory
    -> Picture
-drawWeapon p cr posInInv 
+pictureWeaponOnAim p cr posInInv 
+    | _crInvSel cr == posInInv && _posture (_crStance cr) == Aiming
+                = onLayer PtLayer drawnWep
+    | _crInvSel cr == posInInv 
+                = onLayer PtLayer holsteredWep
+    | otherwise = blank
+  where 
+    drawnWep = uncurry translate (_crRad cr,0) p
+    holsteredWep = uncurry translate (_crRad cr,0) (scale 0.1 1 p)
+
+pictureItem
+    :: Picture 
+    -> Creature 
+    -> Int  -- ^ Position of item in inventory
+    -> Picture
+pictureItem p cr posInInv 
    | _crInvSel cr == posInInv = onLayer PtLayer drawnWep
    | otherwise                = blank
  where 
    drawnWep = uncurry translate (_crRad cr,0) p
-
@@ -59,7 +59,6 @@ pistol
    ,teslaLauncher
    ,remoteLauncher
    ,bezierGun
-    ,poisonSprayer
    ,defaultThrowable
 --    ,shatterGun
    ,longGun,flamer,blinkGun,forceFieldGun :: Item
@@ -88,7 +87,7 @@ pistol = Weapon
    , _itAimingSpeed = 1
    , _itAimingRange = 0
    , _itZoom = defaultItZoom
-    , _itEquipPict = drawWeapon $ color green $ polygon $ rectNESW 3 3 (-3) (-3)
+    , _itEquipPict = pictureWeaponOnAim $ color green $ polygon $ rectNESW 3 3 (-3) (-3)
    , _itScrollUp = const id
    , _itScrollDown = const id
    , _itAttachment = Nothing
@@ -137,7 +136,7 @@ autoGun = defaultGun
    , _itAimingSpeed = 0.4
    , _itAimingRange = 1
    , _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
-    , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
+    , _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 4 4 (-4) (-4)
    , _itEffect = wpRecock
    , _itAttachment = Just $ ItCharMode $ Seq.fromList "MS"
    , _itScrollUp   = incCharMode
@@ -174,7 +173,7 @@ rezGun = defaultGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.4
    , _itAimingRange = 0
-    , _itEquipPict = drawWeapon $ color chartreuse $ pictures 
+    , _itEquipPict = pictureWeaponOnAim $ color chartreuse $ pictures 
        [polygon $ rectNESW 7    3 1    (-3)
        ,polygon $ rectNESW (-1) 3 (-7) (-3)
        ]
@@ -200,7 +199,7 @@ teslaGun = defaultAutoGun
    , _itAimingSpeed = 0.4
    , _itZoom = defaultItZoom
    , _itAimingRange = 0
-    , _itEquipPict = drawWeapon $ color blue $ pictures 
+    , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures 
        [polygon $ rectNESW 7    3 1    (-3)
        ,polygon $ rectNESW (-1) 3 (-7) (-3)
        ]
@@ -222,7 +221,7 @@ lasGun = defaultAutoGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.4
    , _itAimingRange = 1
-    , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
+    , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 3 3 (-3) (-3)
    , _itAttachment = Just $ ItCharMode $ Seq.fromList "/VZ"
    , _itScrollUp   = incCharMode
    , _itScrollDown = decCharMode
@@ -282,7 +281,7 @@ tractorGun = defaultAutoGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.4
    , _itAimingRange = 0.5
-    , _itEquipPict = drawWeapon $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
+    , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ]
    }
 launcher = defaultGun 
    { _itName = "ROCKO"
@@ -301,7 +300,7 @@ launcher = defaultGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.2
    , _itAimingRange = 0.5
-    , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
    , _itHammer = NoHammer
    , _itEffect = NoItEffect
    }
@@ -390,7 +389,7 @@ remoteLauncher = defaultGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.2
    , _itAimingRange = 0.5
-    , _itEquipPict = drawWeapon $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color cyan $ polygon $ rectNESW 5 5 (-5) (-5)
    , _itAttachment = Just $ ItScope (0,0) 0 1 True
    }
 hvAutoGun = defaultAutoGun 
@@ -409,7 +408,7 @@ hvAutoGun = defaultAutoGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.2
    , _itAimingRange = 1
-    , _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
    }
  where 
    mkHvBul = withSound (fromIntegral longGunSound)
@@ -439,7 +438,7 @@ ltAutoGun = defaultAutoGun
    , _itAimingSpeed = 1
    , _itAimingRange = 0
    , _itZoom = defaultItZoom
-    , _itEquipPict = drawWeapon $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
+    , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
                                                        ,circleSolid 4
                                                         ]    
    }
@@ -464,7 +463,7 @@ miniGun = defaultAutoGun
    , _itMaxStack = 1
    , _itAimingSpeed = 0.4
    , _itAimingRange = 1
-    , _itEquipPict = drawWeapon $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color red $ polygon $ rectNESW 9 5 (-9) (-5)
    }
 spreadGun = defaultGun 
    { _itName = "SPREAD"
@@ -486,7 +485,7 @@ spreadGun = defaultGun
    , _itMaxStack = 1
    , _itAimingSpeed = 1
    , _itAimingRange = 0
-    , _itEquipPict = drawWeapon $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
+    , _itEquipPict = pictureWeaponOnAim $ color green $ pictures [ polygon [(-3,0),(3,6),(3,-6)] ]
    }
 multGun = defaultGun 
    { _itName = "MULTGUN"
@@ -509,7 +508,7 @@ multGun = defaultGun
    , _itAimingSpeed = 0.4
    , _itAimingRange = 1
    , _itZoom = defaultItZoom {_itAimZoomFac = 1.5}
-    , _itEquipPict = drawWeapon multGunPic
+    , _itEquipPict = pictureWeaponOnAim multGunPic
    }
  where 
    multGunPic = color red $ pictures 
@@ -542,7 +541,7 @@ longGun = defaultGun
    , _itAimingSpeed = 0.2
    , _itAimingRange = 1
    , _itZoom = defaultItZoom {_itAimZoomMax = 0.5, _itAimZoomMin = 0.5}
-    , _itEquipPict = drawWeapon $ pictures  [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
+    , _itEquipPict = pictureWeaponOnAim $ pictures  [color orange $ polygon $ rectNESW 3 6 (-3) (-6) ]
    , _itScrollUp = startZoomInLongGun
    , _itScrollDown = startZoomOutLongGun
    , _itAttachment = Just $ ItScope (0,0) 0 1 False
@@ -556,6 +555,7 @@ startZoomOutLongGun :: Int -> World -> World
 startZoomOutLongGun  _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                                . itAttachment . _Just . scopeZoomChange %~ \x -> min (-5) (x-5)

+poisonSprayer :: Item
 poisonSprayer = defaultAutoGun 
    { _itName = "POISON"
    , _itIdentity = PoisonSprayer
@@ -574,7 +574,7 @@ poisonSprayer = defaultAutoGun
    , _itAimingSpeed = 0.2
    , _itAimingRange = 0
    , _itZoom = defaultItZoom
-    , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
+    , _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
    }

 flamer = defaultAutoGun 
@@ -595,7 +595,7 @@ flamer = defaultAutoGun
    , _itAimingSpeed = 0.5
    , _itAimingRange = 0
    , _itZoom = defaultItZoom {_itAimZoomMax = 5, _itAimZoomMin = 1.5}
-    , _itEquipPict = drawWeapon $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
+    , _itEquipPict = pictureWeaponOnAim $ color yellow $ polygon $ rectNESW 4 4 (-4) (-4)
    , _itAttachment = Nothing
    }
 blinkGun = defaultGun 
@@ -873,7 +873,7 @@ grenade = Throwable
    , _itAimingSpeed = 1
    , _itAimingRange = 0
    , _itZoom = defaultItZoom {_itAimZoomMax = f fuseTime, _itAimZoomMin = f fuseTime}
-    , _itEquipPict = drawWeapon $ grenadePic fuseTime
+    , _itEquipPict = pictureWeaponOnAim $ grenadePic fuseTime
    , _itID = Nothing
    , _itUseRate = 50 
    , _itUseTime = 0
@@ -918,7 +918,7 @@ remoteBomb = defaultThrowable
    , _twAccuracy = 30
    , _twFire = hammerCheck throwRemoteBomb
    , _itAttachment = Just $ ItScope (0,0) 0 1 True
-    , _itEquipPict = drawWeapon remoteBombUnarmedPic
+    , _itEquipPict = pictureWeaponOnAim remoteBombUnarmedPic
    }


@@ -1099,7 +1099,7 @@ explodeRemoteBomb itid pjid n w
  where 
    resetName = set (creatures . ix n . crInv . ix j . itName) "REMOTEBOMB"
    resetPict = set (creatures . ix n . crInv . ix j . itEquipPict ) 
-                    (drawWeapon remoteBombUnarmedPic)
+                    (pictureWeaponOnAim remoteBombUnarmedPic)
 --    resetScope = creatures . ix n . crInv . ix j . itScope . _Just . scopePos .~ (0,0)
    j = _crInvSel $ _creatures w IM.! n
 remoteBombPic 
@@ -1148,7 +1148,7 @@ radar = defaultGun
    , _itMaxStack = 1
    , _itAimingRange = 1
    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
-    , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
    }
 {- |
 Sends out pulses that display creatures.  -}
@@ -1170,7 +1170,7 @@ sonar = defaultGun
    , _itMaxStack = 1
    , _itAimingRange = 1
    , _itZoom = defaultItZoom {_itAimZoomMax = 1, _itZoomMax = 1}
-    , _itEquipPict = drawWeapon $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
+    , _itEquipPict = pictureWeaponOnAim $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
    }
 {- |
 Automatically sends out pulses that display creatures.  -}
@@ -1229,3 +1229,4 @@ spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
        & crID  .~ k
        & crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
        & crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
+
@@ -60,7 +60,7 @@ throwGrenade
    -> Int      -- ^ Creature id
    -> World 
    -> World
-throwGrenade explosion n w = setWp $ removePict $ over projectiles addG $ w
+throwGrenade explosion n w = setWp $ removePict $ over projectiles addG w
  where 
    addG = IM.insert i $ Shell 
        { _pjPos = p
@@ -95,7 +95,7 @@ throwArmReset x = ItInvEffect {_itInvEffect = f ,_itEffectCounter = x }
    counterDown it 
        | _itEffectCounter (_itEffect it) == 0 = it 
            & itHammer .~ HammerUp 
-            & itEquipPict .~ drawWeapon (grenadePic 50)
+            & itEquipPict .~ pictureWeaponOnAim (grenadePic 50)
        | otherwise = it & itEffect . itEffectCounter -~ 1
                                           
 --(grenadeAccL, grenadeAccA) = (0.1, 0.1)
@@ -21,6 +21,7 @@ import Control.Lens
 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 
@@ -39,7 +40,6 @@ bulHitCr bt p cr w
    cid = _crID cr
    (d1,_)  = randomR (-0.7,0.7) $ _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
@@ -87,7 +87,7 @@ f = incidenceToFunction $ pairsToIncidence
 --    ]

 pathBetween :: Point2 -> Point2 -> World -> Maybe [Point2]
-pathBetween a b w = (makePath' $ \p -> _pathInc w M.! p) <$> a' <*> b'
+pathBetween a b w = makePath' (\p -> _pathInc w M.! p) <$> a' <*> b'
  where
    nsa :: [Point2]
    nsa = map snd $ concat $ lookLookups (zoneAroundPoint a) (_pathPoints w)
@@ -56,7 +56,7 @@ menuScreen cfig hw hh mLays = case mLays of
    mavol = f $ _volume_master cfig
    snvol = f $ _volume_sound  cfig
    muvol = f $ _volume_music  cfig
-    f x = show $ (round $ 10 * x :: Int)
+    f x = show (round $ 10 * x :: Int)
    showShadRes i = "1/"++ show i

 optionsList
@@ -218,7 +218,7 @@ moveFlamelet w pt
    damifclose cr 
        | isClose cr = cr & crState . crDamage %~ ( Flaming 3 sp ep ep : )
        | otherwise  = cr
-
+-- | At writing the radius is half the size of the effect area
 makeGasCloud 
    :: Point2   -- ^ Position
    -> Point2   -- ^ Velocity
@@ -234,7 +234,7 @@ makeGasCloud pos vel w = w
                     , _clVel = vel
                     , _clPict = \_ -> onLayer CrLayer $ color (withAlpha 0.1 col) 
                                                       $ circleSolid 20
-                     , _clRad = 20
+                     , _clRad = 10
                     , _clTimer = 400
                     , _clEffect = cloudPoisonDamage
                     }
@@ -247,7 +247,7 @@ cloudPoisonDamage :: Cloud -> World -> World
 cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
  where 
    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
-    f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c
+    f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
    doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)

 {-
@@ -194,7 +194,7 @@ difference x y
    | x > y     = x - y
    | otherwise = y - x
 -- | Given vector line direction and a vector movement,
-- reflects the movement accoring to the line.
+-- reflects the movement according to the line.
 reflectIn :: Point2 -> Point2 -> Point2
 reflectIn line vec = rotateV angle vec
  where
@@ -134,7 +134,7 @@ but is symmetric around 0:

 -}
 roundPoint2 :: Point2 -> Point2
-roundPoint2 (x,y) = (fromIntegral $ (round x :: Int),fromIntegral $ (round y :: Int))
+roundPoint2 (x,y) = (fromIntegral (round x :: Int),fromIntegral (round y :: Int))
 -- | Given two points, finds the linear gradient if it is non-infinite.
 linGrad :: (Eq a,Fractional a) => (a,a) -> (a,a) -> Maybe a
 linGrad (x,y) (a,b) 
@@ -2,8 +2,7 @@
 module Geometry.Vector
    where
 import Geometry.Data
-{- | Moves from to three dimensions, adding zero in z direction.
- -}
+{- | Moves from to three dimensions, adding zero in z direction.  -}
 zeroZ :: Point2 -> Point3
 {-# INLINE zeroZ #-}
 zeroZ (x,y) = (x,y,0)
@@ -11,8 +10,7 @@ zeroZ (x,y) = (x,y,0)
 infixl 6 +.+, -.-
 infixl 7 *.*

-{- | 2D coordinate-wise addition.
- -}
+{- | 2D coordinate-wise addition.  -}
 (+.+) :: Point2 -> Point2 -> Point2
 {-# INLINE (+.+) #-}
 (x1, y1) +.+ (x2, y2) =
@@ -20,8 +18,7 @@ infixl 7 *.*
    !x = x1 + x2
    !y = y1 + y2
  in (x, y)
-{- | 2D coordinate-wise subtraction.
- -}
+{- | 2D coordinate-wise subtraction.  -}
 (-.-) :: Point2 -> Point2 -> Point2
 {-# INLINE (-.-) #-}
 (x1, y1) -.- (x2, y2) =
@@ -29,8 +26,7 @@ infixl 7 *.*
    !x = x1 - x2
    !y = y1 - y2
  in (x, y)
-{- | 2D scalar multiplication.
- -}
+{- | 2D scalar multiplication.  -}
 (*.*) :: Float -> Point2 -> Point2
 {-# INLINE (*.*) #-}
 a *.* (x2, y2) =
@@ -42,9 +38,7 @@ a *.* (x2, y2) =
 infixl 6 +.+.+, -.-.-
 infixl 7 *.*.*

-
-{- | 3D coordinate-wise addition.
- -}
+{- | 3D coordinate-wise addition.  -}
 (+.+.+) :: Point3 -> Point3 -> Point3
 {-# INLINE (+.+.+) #-}
 (x1, y1, z1) +.+.+ (x2, y2, z2) =
@@ -53,9 +47,7 @@ infixl 7 *.*.*
    !y = y1 + y2
    !z = z1 + z2
  in (x, y, z)
-
-{- | 3D coordinate-wise subtraction.
- -}
+{- | 3D coordinate-wise subtraction.  -}
 (-.-.-) :: Point3 -> Point3 -> Point3
 {-# INLINE (-.-.-) #-}
 (x1, y1, z1) -.-.- (x2, y2, z2) =
@@ -64,9 +56,7 @@ infixl 7 *.*.*
    !y = y1 - y2
    !z = z1 - z2
  in (x, y, z)
-
-{- | 3D scalar multiplication.
- -}
+{- | 3D scalar multiplication.  -}
 (*.*.*) :: Point3 -> Point3 -> Point3
 {-# INLINE (*.*.*) #-}
 (x1, y1, z1) *.*.* (x2, y2, z2) =
@@ -75,16 +65,11 @@ infixl 7 *.*.*
    !y = y1 * y2
    !z = z1 * z2
  in (x, y, z)
-
-{- | Normalize a vector to length 1.
- -}
+{- | Normalize a vector to length 1.  -}
 normalizeV :: Point2 -> Point2
 {-# INLINE normalizeV #-}
 normalizeV p = (1 / magV p) *.* p
-
-{- | Angle between two vectors.
-Always positive.
- -}
+{- | Angle between two vectors.  Always positive.  -}
 angleVV :: Point2 -> Point2 -> Float
 {-# INLINE angleVV #-}
 angleVV a b = 
@@ -92,58 +77,44 @@ angleVV a b =
        mb = magV b
        d  = a `dotV` b
    in  acos $ d / (ma * mb)
-
 {- | Safe version of 'angleVV' that returns 0 if either vector is null. -}
 safeAngleVV :: Point2 -> Point2 -> Float
 {-# INLINE safeAngleVV #-}
 safeAngleVV a b
    | a == (0,0) || b == (0,0) = 0
    | otherwise                = angleVV a b
-
-{- | Dot product.
- -}
+{- | Dot product.  -}
 dotV :: Point2 -> Point2 -> Float
 {-# INLINE dotV #-}
 dotV (x,y) (z,w) = x*z + y*w
-
-{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.
- -}
+{- | Given vector, returns the angle, anticlockwise from +ve x-axis, in radians.  -}
 argV :: Point2 -> Float
 {-# INLINE argV #-}
 argV (x,y) = normalizeAngle $ atan2 y x
-
-{- | Determinant of the matrix formed by two vectors.
- -}
+{- | Determinant of the matrix formed by two vectors.  -}
 detV :: Point2 -> Point2 -> Float
 {-# INLINE detV #-}
-detV (x1, y1) (x2, y2)
-       = x1 * y2 - y1 * x2
-
-{- | Given an angle in radians, anticlockwise from +ve x-axis, returns the
-corresponding unit vector.
-}
+detV (x1, y1) (x2, y2) = x1 * y2 - y1 * x2
+{- | Given an angle in radians, anticlockwise from +ve x-axis, 
+ - returns the corresponding unit vector.  -}
 unitVectorAtAngle :: Float -> Point2
 {-# INLINE unitVectorAtAngle #-}
-unitVectorAtAngle r
-        = (cos r, sin r)
-
+unitVectorAtAngle r = (cos r, sin r)
 -- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.
 rotateV :: Float -> Point2 -> Point2
-rotateV r (x, y)
- =      (  x * cos r - y * sin r
-        ,  x * sin r + y * cos r)
+rotateV r (x, y) =
+    (  x * cos r - y * sin r
+    ,  x * sin r + y * cos r
+    )
 {-# INLINE rotateV #-}
-
 -- | Convert degrees to radians
 degToRad :: Float -> Float
 degToRad d      = d * pi / 180
 {-# INLINE degToRad #-}
-
 -- | Convert radians to degrees
 radToDeg :: Float -> Float
 radToDeg r      = r * 180 / pi
 {-# INLINE radToDeg #-}
-
 -- | Normalize an angle to be between 0 and 2*pi radians
 normalizeAngle :: Float -> Float
 {-# INLINE normalizeAngle #-}
@@ -151,34 +122,29 @@ normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))
  where  
    floor' :: Float -> Float
    floor' x = fromIntegral (floor x :: Int)
-
-{- | Rotate vector by pi/2 clockwise.
- -}
+{- | Rotate vector by pi/2 clockwise.  -}
 vNormal :: Point2 -> Point2
 {-# INLINE vNormal #-}
 vNormal (x,y) = (y,-x)
-
-{- | Negate a vector.
- -}
+{- | Negate a vector.  -}
 vInverse :: Point2 -> Point2
 vInverse (x,y) = (-x,-y)
-
-{- | Normalize a vector safely: on (0,0) return (0,0).
- -}
+{- | Normalize a vector safely: on (0,0) return (0,0).  -}
 safeNormalizeV :: Point2 -> Point2
 {-# INLINE safeNormalizeV #-}
 safeNormalizeV (0,0) = (0,0)
 safeNormalizeV p = (1/magV p ) *.* p
-
-{- | Magnitude of a vector.
- -}
+{- | Magnitude of a vector.  -}
 magV :: Point2 -> Float
 {-# INLINE magV #-}
 magV (x,y) = sqrt $ x^(2::Int) + y^(2::Int)
-
 {- | Magnitude of the cross product of two vectors.
-Identical to detV.
-}
+Identical to detV.  -}
 crossV :: Point2 -> Point2 -> Float
 crossV (ax,ay) (bx,by) = ax*by - ay*bx
-
+{- | TO CHECK Orthographic projection of one vector onto another. -}
+projV 
+    :: Point2
+    -> Point2
+    -> Point2
+projV fromv onv = (fromv `dotV` onv) / (onv `dotV` onv) *.* onv