Refactor creature ai

src/Dodge/Base.hs

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

src/Dodge/Config/KeyConfig.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
+--{-# LANGUAGE OverloadedStrings #-}
 module Dodge.Config.KeyConfig
   where
 --import Data.Aeson

src/Dodge/Creature.hs

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

src/Dodge/Creature/ArmourChase.hs

@@ -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)
+        ]
+    }

src/Dodge/Creature/AutoCrit.hs

@@ -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     = []

src/Dodge/Creature/Boid.hs

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

src/Dodge/Creature/ImpulseRat.hs

@@ -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
+--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
 
 
 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 ]
+                = [MoveForward 3 , TurnToward p 0.2 , RandomTurn 0.2 ]
-    | otherwise = [MoveForward 2.5 , TurnToward p 0.05, RandomTurn 0.2 ]
+    | otherwise = [MoveForward 3 , TurnToward p 0.05, RandomTurn 0.2 ]
   where
     cpos = _crPos cr
     tpos = _crPos crT

src/Dodge/Creature/LauncherCrit.hs

@@ -36,8 +36,9 @@ launcherCrit = defaultCreature
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+        >=> overrideInternalR    
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+            (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/LtAutoCrit.hs

@@ -44,8 +44,9 @@ ltAutoCrit = defaultCreature
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+        >=> overrideInternalR 
-            $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+            (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
+            (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
     , _crActionPlan = ActionPlan
         { _crImpulse    = []
         , _crAction     = []

src/Dodge/Creature/Picture.hs

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

src/Dodge/Creature/Rationality.hs

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

src/Dodge/Creature/ReaderUpdate.hs

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

src/Dodge/Creature/SentinelAI.hs

@@ -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))))
+    >=> overrideInternalR 
-      $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+        (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))))
+    >=> overrideInternalR (onBoth (&&) crHasTarget (crStratConMatches (GetTo (0,0))))
-      $ \ _ -> crActionPlan . crStrategy .~ WatchAndWait)
+      (\ _ -> crActionPlan . crStrategy .~ WatchAndWait)
 
 
 shootAtAdvance :: Int -> [Action]

src/Dodge/Creature/SpreadGunCrit.hs

@@ -44,8 +44,8 @@ spreadGunCrit = defaultCreature
         >=> doStrategyActionsR
         >=> reloadOverrideR
         >=> targetYouWhenCognizantR
-        >=> (overrideInternalR (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/SwarmCrit.hs

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

src/Dodge/Creature/YourControl.hs

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

src/Dodge/Data.hs

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

src/Dodge/Default.hs

@@ -272,8 +272,6 @@ defaultWorld = World
         ]
     , _selLocation = 0
     , _keyConfig = defaultKeyConfigSDL
-    , _varMovementSpeedModifier = 3
-    , _varMovementStrafeSpeedModifier = 3
     , _debugMode = True
     , _config       = defaultConfig
     , _sideEffects          = []

src/Dodge/Event.hs

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

src/Dodge/Event/Keyboard.hs

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

src/Dodge/Floor.hs

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

src/Dodge/Item/Consumable.hs

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

src/Dodge/Item/Draw.hs

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

src/Dodge/Item/Weapon.hs

@@ -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)
+

src/Dodge/Item/Weapon/Grenade.hs

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

src/Dodge/Particle/Bullet/HitEffect.hs

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

src/Dodge/Path.hs

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

src/Dodge/Render/MenuScreen.hs

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

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -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)
 
 {-

src/Geometry.hs

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

src/Geometry/Intersect.hs

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

src/Geometry/Vector.hs

@@ -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)
+detV (x1, y1) (x2, y2) = x1 * y2 - y1 * x2
-       = x1 * y2 - y1 * x2
+{- | Given an angle in radians, anticlockwise from +ve x-axis, 
-
+ - returns the corresponding unit vector.  -}
-{- | Given an angle in radians, anticlockwise from +ve x-axis, returns the
-corresponding unit vector.
--}
 unitVectorAtAngle :: Float -> Point2
 {-# INLINE unitVectorAtAngle #-}
-unitVectorAtAngle r
+unitVectorAtAngle r = (cos r, sin 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)
+rotateV r (x, y) =
- =      (  x * cos r - y * sin r
+    (  x * cos r - y * sin r
-        ,  x * sin r + y * cos 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