Delete cruft, add Reader monad to some internal ai

2021-05-16 21:42:11 +02:00
parent 0798cc0b0e
commit d7fcdbf550
69 changed files with 721 additions and 2894 deletions
@@ -24,7 +24,7 @@ import Music
 import Control.Concurrent
 import Control.Lens
 import Foreign (Word32)
-import Control.Monad (when,void)
+import Control.Monad
 import System.Random
 import qualified Data.Map                  as M
 import qualified Data.IntMap               as IM
@@ -82,7 +82,7 @@ doPreload = do
 checkForGlErrors :: IO ()
 checkForGlErrors = do
    errs <- errors
-    when (length errs > 0) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
+    unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs)
 setWindowSize :: Int -> Int -> KeyConfigSDL-> World -> World
 setWindowSize x y z w = w 
@@ -1,104 +0,0 @@
 module Dodge.AIs 
    ( 
    ) where
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Impulse.Data
 import Dodge.Data hiding (Action (..), Impulse (..), Strategy (..))
 import Dodge.Base
 import Dodge.Path
 import Dodge.SoundLogic
 import Dodge.Creature.Action
 import Dodge.Creature.Action.Movement
 import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.Creature.Picture
 import Geometry
 import Picture
 import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
 import Data.Graph.Inductive.Graph hiding ((&))
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
 import qualified Data.ByteString as B
 import qualified Data.Set as S
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import Control.Lens
 import Control.Applicative
 import Control.Monad
 import Control.Monad.State
 import Control.Concurrent
 import System.Random
 import Foreign.ForeignPtr
 ----  
 ----  encircleAI' :: Int -> World -> World
 ----  encircleAI' cid w =
 ----          let cr = _creatures w IM.! cid
 ----              cpos = _crPos cr
 ----              damageYou = over (creatures . ix 0 . crHP) (\hp -> hp - 10) . soundOnce hitSound
 ----              ypos = _crPos $ you w
 ----              flockers = IM.filter (flip (canSeePoint cid) w . _crPos) 
 ----                              $ IM.filter (factionIs $ EncircleFlock)
 ----                              $ _creatures w
 ----              tp | length flockers <= 1 = ypos
 ----                 | otherwise            = ypos +.+ 
 ----                                              f (max 0 (magV (ypos -.- cenp) - 30) )
 ----                                                    *.* safeNormalizeV (cpos -.- cenp)
 ----                  where f x = 150 * sigmoid (x-10)
 ----                        cenp = (1 / fromIntegral (length flockers)) *.* 
 ----                                foldr1 (+.+) 
 ----                                       (map _crPos $ IM.elems flockers)
 ----              combinedRad = _crRad cr + _crRad (you w)
 ----              replaceGoal newImpulses = over (creatures . ix cid . crState . goals)
 ----                                         (\gs -> newImpulses ++ tail gs)
 ----              addGoal newImpulses = over (creatures . ix cid . crState . goals)
 ----                                         (\gs -> newImpulses ++ gs)
 ----              replaceImpulse newActions = over (creatures . ix cid . crState . goals)
 ----                                         (\((_:as):ass) -> (newActions ++ as):ass)
 ----              addImpulse newActions = over (creatures . ix cid . crState . goals)
 ----                                         (\(as:ass) -> (newActions++as):ass)
 ----          in  if _crHP cr <= 0 then killCr cid w else
 ----      case head $ _goals $ _crState cr of
 ----          []             | canSee cid (_yourID w) w
 ----                              -> replaceGoal [[MoveToFor tp 10]] w
 ----                         | otherwise -> w
 ----          (MoveToFor p x:_) 
 ----                          | dist ypos cpos < combinedRad + 5
 ----                              && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
 ----                              && x == 0
 ----                                      -> over (creatures . ix cid . crPos) 
 ----                                              (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos)))
 ----                                          $ replaceImpulse [MeleeAttack 5]
 ----                                          $ damageYou
 ----                                              w
 ----                          | canSee cid (_yourID w) w && dist cpos ypos < 50
 ----                              -> mvForward 2 cid $ turnTowardSpeed 0.5 ypos cid 
 ----                                          $ replaceImpulse [MoveToFor ypos (max 0 (x-1))] w
 ----                          | x == 0 && canSee cid (_yourID w) w 
 ----                              -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid 
 ----                                          $ replaceImpulse [MoveToFor tp 0] w
 ----                          | x == 0 -> replaceImpulse [MoveToFor p 10] w
 ----                          | canSee cid (_yourID w) w
 ----                              -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid 
 ----                                          $ replaceImpulse [MoveToFor p (x-1)] w
 ----                          | dist cpos p < 20 -> w
 ----                          | otherwise -> mvForward 2 cid $ turnTowardSpeed 0.5 p cid w
 ----          (MeleeAttack x:_)
 ----                         | x == 0    -> replaceImpulse [WaitFor 5] w
 ----                         | otherwise -> replaceImpulse [MeleeAttack (x-1)] w
 ----          (WaitFor x:gls)| x == 0    -> replaceImpulse [] w
 ----                         | canSee cid (_yourID w) w
 ----                                     -> turnTowardSpeed 0.02 ypos cid
 ----                                          $ replaceImpulse [WaitFor (x-1)] w
 ----                         | otherwise -> replaceImpulse [WaitFor (x-1)] w
 errorNormalizeVAI :: Point2 -> Point2
 errorNormalizeVAI (0,0) = error "problem with function: errorNormalizeVAI in DodgeAIs"
 errorNormalizeVAI p = normalizeV p
 ----------------
@@ -45,9 +45,9 @@ midPadL i x xs ys = take j (xs ++ repeat x) ++ ys
    j = i - length ys
 takeUntil :: (a -> Bool) -> [a] -> [a]
-takeUntil f ps = case span (not . f) ps of
+takeUntil f ps = case break f ps of
    (xs,[])    -> xs
-    (xs,(y:_)) -> xs ++ [y]
+    (xs, y:_ ) -> xs ++ [y]
 you :: World -> Creature
 you w = _creatures w IM.! _yourID w
@@ -63,7 +63,7 @@ crItem w cid = _crInv cr IM.! _crInvSel cr
  where
    cr = _creatures w IM.! cid
-yourItemRef w = (creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w)))
+yourItemRef w = creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))
 wallNormal :: Wall -> Point2
 wallNormal wl = normalizeV . vNormal $ a -.- b
@@ -73,22 +73,21 @@ wallNormal wl = normalizeV . vNormal $ a -.- b
 wallsOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> [Wall]
 wallsOnLine p1 p2 ws = hitWalls
  where 
-    hitPoint w = intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w)
+    hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
    hitWalls = filter (isJust . hitPoint) (IM.elems ws)
 wallOnLine :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Wall
 wallOnLine p1 p2 ws 
    = listToMaybe $ sortBy f hitWalls
  where 
-    hitPoint w = intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w)
+    hitPoint w = uncurry (intersectSegSeg' p1 p2) (_wlLine w)
    hitWalls = filter (isJust . hitPoint) (IM.elems ws)
    f w1 w2 = compare (magV (p1 -.- fromJust (hitPoint w1))) (magV (p1 -.- fromJust (hitPoint w2)))
-wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> [Wall]
+wallsOnCirc :: Point2 -> Float -> IM.IntMap Wall -> IM.IntMap Wall
-wallsOnCirc p r wls = IM.elems $ IM.filter f wls
+wallsOnCirc p r = IM.filter f
  where 
-    f wl = circOnSeg (fst $ _wlLine wl) (snd $ _wlLine wl) p r
+    f wl = uncurry circOnSeg (_wlLine wl) p r
 allWalls :: World -> IM.IntMap Wall
 allWalls w = IM.unions $ concatMap IM.elems $ IM.elems $ _wallsZone w
@@ -301,7 +300,7 @@ collidePointWallsCol p1 p2 ws
    . sortOn f 
    . IM.elems 
    $ IM.mapMaybe ( (\(m, c) -> m <&> (, c))
-        . (\w -> (intersectSegSeg' p1 p2 (fst $ _wlLine w) (snd $ _wlLine w), _wlColor w))) ws
+        . (\w -> (uncurry (intersectSegSeg' p1 p2) (_wlLine w), _wlColor w))) ws
  where 
    f (a,_) = magV (p1 -.- a)
 {- | Looks for first collision of a point with walls.
@@ -507,3 +506,11 @@ isAnimate cr = case _crActionPlan cr of
    _   -> True
 sigmoid x = x/sqrt(1+x^2)
 {- | In order to force a list, apply with seq. -}
 forceSpine :: [a] -> ()
 forceSpine = foldr (const id) ()
 forceList :: [a] -> [a]
 forceList l = seq (forceSpine l) l
@@ -13,9 +13,7 @@ import Control.Lens
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
-hasLOS p1 p2 w = (not $ pointHitsWalls p1 p2 nearbyWalls) 
+hasLOS p1 p2 w = not $ pointHitsWalls p1 p2 $ wallsAlongLine p1 p2 w
  where 
    nearbyWalls = wallsAlongLine p1 p2 w
 -- | looks for first collision of a point with walls
 -- if found, gives point and reflection velocity
 reflectPointWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe (Point2,Point2)
@@ -56,11 +54,11 @@ reflectPointWallsDamped dfact p1 p2 ws
 -- | Test if a point collides with walls
 pointHitsWalls :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 pointHitsWalls p1 p2 
-    = any $ isJust . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine
+    = any $ isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine
 -- | Test if there something blocking a walk
 collidePointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointWalkable p1 p2 ws 
-    = any (isJust . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine) 
+    = any (isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
    $ IM.filter (fromMaybe True . (^? doorPathable)) ws
 furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
@@ -69,7 +67,7 @@ furthestPointWalkable p1 p2 ws
    . listToMaybe
    . sortOn (dist p1) 
    . IM.elems 
-    $ IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine) ws
+    $ IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) ws
 collidePointIndirect :: Point2 -> Point2 -> IM.IntMap Wall -> Maybe Point2
 {-# INLINE collidePointIndirect #-}
@@ -77,7 +75,7 @@ collidePointIndirect p1 p2 ws
    = listToMaybe 
    . sortOn (dist p1) 
    . IM.elems 
-    . IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine) 
    $ IM.filter (not . _wlIsSeeThrough) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
 - Not sure if this needs vision as well, need to make this uniform. -}
@@ -86,13 +84,13 @@ collidePointFire p1 p2 ws
    = listToMaybe 
    . sortOn (dist p1) 
    . IM.elems 
-    . IM.mapMaybe ( ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine ) 
+    . IM.mapMaybe ( uncurry (intersectSegSeg' p1 p2) . _wlLine ) 
    $ IM.filter (\wl -> not (_wlIsSeeThrough wl && isJust (wl ^? blHP))) ws
 {- | Checks to see whether someone can fire bullets effectively between two points. 
 - Not sure if this needs vision as well, need to make this uniform. -}
 collidePointFireVision :: Point2 -> Point2 -> IM.IntMap Wall -> Bool
 collidePointFireVision p1 p2 ws 
-    = any ( isJust . ( \(x,y) -> intersectSegSeg' p1 p2 x y) . _wlLine) 
+    = any ( isJust . uncurry (intersectSegSeg' p1 p2) . _wlLine) 
    $ IM.filter notBlockWindow ws
  where 
    notBlockWindow wl = case wl ^? blHP of
@@ -125,15 +123,14 @@ canSeePoint i p w = hasLOS p1 p w
 pathToPointFireable :: Int -> Point2 -> World -> Bool
 pathToPointFireable i p w 
    = not 
-    . pointHitsWalls (_crPos (_creatures w IM.! i)) p
+    . pointHitsWalls (_crPos $ _creatures w IM.! i) p
-    $ IM.filter (not . isJust . \wl -> wl ^? blHP) $ wallsAlongLine p1 p w
+    $ IM.filter (isNothing . (^? blHP) ) $ wallsAlongLine p1 p w
  where 
    p1 = _crPos (_creatures w IM.! i)
 canSeePointAll :: Int -> Point2 -> World -> Bool
 canSeePointAll i targPos w 
-    = and 
+    = all (flip (canSeePoint i) w . (\p -> targPos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
    $ map (flip (canSeePoint i) w . (\p -> (targPos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! i
    cpos = _crPos cr
@@ -141,8 +138,7 @@ canSeePointAll i targPos w
 canSeeAny :: Int -> Int -> World -> Bool
 canSeeAny fromID toID w 
-    = or 
+    = any (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
    $ map (flip (canSeePoint fromID) w . (\p -> (cpos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! toID
    cpos = _crPos cr
@@ -150,8 +146,7 @@ canSeeAny fromID toID w
 canSeeAll :: Int -> Int -> World -> Bool
 canSeeAll fromID toID w 
-    = and 
+    = all (flip (canSeePoint fromID) w . (\p -> cpos +.+ radius *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
    $ map (flip (canSeePoint fromID) w . (\p -> (cpos +.+ radius *.* p))) [(1,0),(0,1),(-1,0),(0,-1)]
  where 
    cr = _creatures w IM.! toID
    cpos = _crPos cr
@@ -164,7 +159,7 @@ canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos
    jpos = _crPos (_creatures w IM.! j)
 canSeeIndirect :: Int -> Int -> World -> Bool
-canSeeIndirect i j w = not . isJust . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
+canSeeIndirect i j w = isNothing . collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
  where 
    ipos = _crPos (_creatures w IM.! i)
    jpos = _crPos (_creatures w IM.! j)
@@ -7,7 +7,7 @@ import Foreign.C.Types
 import GHC.Generics
 import qualified GHC.Int
 import qualified SDL
-import SDL.Internal.Numbered as SDL.Internal.Numbered
+import qualified SDL.Internal.Numbered
 import System.Directory
@@ -9,10 +9,8 @@ module Dodge.Creature
  where
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Impulse.Data
 import Dodge.Creature.ImpulseRat
 import Dodge.Creature.ActionRat
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.AlertLevel
 import Dodge.Creature.SetTarget
 import Dodge.Creature.Test
@@ -21,7 +19,6 @@ import Dodge.Creature.PistolCrit
 import Dodge.Creature.LtAutoCrit
 import Dodge.Creature.SpreadGunCrit
 import Dodge.Data
 import Dodge.AIs
 import Dodge.Default
 import Dodge.Base
 import Dodge.Item.Weapon
@@ -35,7 +32,6 @@ import Dodge.Creature.Rationality
 import Dodge.Creature.ChooseTarget
 import Dodge.Item
 import Dodge.Picture.Layer
 import Dodge.Creature.Picture
 import Picture
 import Geometry
@@ -63,7 +59,6 @@ spawnerCrit = defaultCreature
    { --_crUpdate = stateUpdate $ spawnerAI chaseCrit
     _crHP = 300
    , _crPict = basicCrPict blue
    , _crState = defaultState {_goals = [[WaitFor 0]] }
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    }
 smallChaseCrit :: Creature
@@ -78,10 +73,11 @@ smallChaseCrit = defaultCreature
    }
 chaseCrit :: Creature
 chaseCrit = defaultCreature
-    { _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
+    { _crUpdate = stateUpdate $ impulsiveAIR $ 
-        [ chaseTarget targetYouLOS
+        chaseTargetR targetYouLOS <=<
-        , \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
+        overrideMeleeCloseTargetR <=<
-        ]
+        basicPerceptionUpdateR [0] <=<
        return . (crMeleeCooldown . _Just %~ (max 0 . subtract 1))
    , _crHP = 300
    , _crPict = basicCrPict green
    , _crInv = IM.empty 
@@ -93,7 +89,6 @@ armourChaseCrit = defaultCreature
    { _crUpdate = stateUpdate $ meleeCooldown $ impulsiveAI $ chaseTarget targetYouLOS
    , _crHP = 300
    , _crPict = basicCrPict green
    , _crState = defaultState {_goals = [[Wait]]}
    , _crInv = IM.fromList 
        [(0,frontArmour)
        ,(1,medkit 200)
@@ -139,7 +134,6 @@ longCrit = defaultCreature
    , _crInv = IM.fromList [(0,longGun),(1,medkit 100)]
    , _crInvSel = 0
    , _crRad = 10
    , _crState = defaultState {_goals = [[InitGuard]]}
    , _crHP = 300
    }
 multGunCrit :: Creature
@@ -149,7 +143,6 @@ multGunCrit = defaultCreature
    , _crInv = IM.fromList [(0,multGun),(1,medkit 100)]
    , _crInvSel = 0
    , _crRad = 10
    , _crState = defaultState {_goals = [[InitGuard]]}
    , _crHP = 300
    , _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
        [ performActions
@@ -197,68 +190,21 @@ autoCrit = defaultCreature
    , _crInv = IM.fromList [(0,autoGun),(1,medkit 100)]
    , _crInvSel = 0
    , _crRad = 10
    , _crState = defaultState {_goals = [[InitGuard]]}
    , _crHP = 300
    }
 addArmour :: Creature -> Creature
 addArmour = over crInv insarmour
  where 
    insarmour xs = IM.insert (newKey xs) frontArmour xs
-
+{- | The creature you control.
--packCrits :: (Int -> World -> World) -> [Int] -> [Creature]
+ID 0.  -}
 --packCrits ai is = [(defaultCreature i)
 --    { _crPos = (150,10+20*fromIntegral i)
 --    , _crPict = swarmPict
 --    , _crUpdate = ai i
 --    --, _crUpdate = swarmAI is i
 --    , _crRad = 3
 --    , _crHP = 1
 --    , _crMass = 2
 --    }
 --    | i <- is]
 --queenBeeCrit :: Int -> Creature
 --queenBeeCrit cID = (defaultCreature cID)
 --    { _crRad = 20
 --    , _crCorpse = color (greyN 0.5) $ circleSolid 20
 --    , _crPict = const $ pictures [color black $ circSolid 20
 --                         ,color yellow $ circLine 20
 --                         ]
 --    , _crUpdate = checkDead cID . makeStateAI queenBeeAI cID
 --    , _crState = QueenBee 0 20
 --    , _crMass = 20
 --    }
 --antCrit :: Int -> Creature
 --antCrit cID = (defaultCreature cID)
 --    { _crPos = (0,100 + 3 * fromIntegral cID)
 --    , _crUpdate = checkDead cID . makeStateAI (antAI 2) cID
 --    , _crState = AntMove 50
 --    , _crPict = antPic
 --    , _crRad = 3
 --    , _crHP = 1
 --    , _crMass = 2
 --    , _crCorpse = color (greyN 0.5) $ circSolid 3
 --    }
 --    where i = evalState (state (randomR (1::Int,100))) (mkStdGen cID)
 --antPic = const $ pictures [ translate (-1) 0 $ circleSolid 2
 --                  , translate (2) 0 $ circleSolid 1
 --                  , translate (1) 0 $ circleSolid 1
 --                  , line [(3,3),(-3,-3)]
 --                  , line [(-3,3),(3,-3)]
 --                  , line [(0,-3),(0,3)]
 --                  ]
 {- |
 The creature you control.
 ID 0.
 -}
 startCr :: Creature
 startCr = defaultCreature
    { _crPos = (0,0)
    , _crOldPos = (0,0)
    , _crDir = 0
    , _crID = 0
-    , _crPict = basicCrPict $ black
+    , _crPict = basicCrPict black
    , _crUpdate = stateUpdate yourControl
    , _crRad = 10
    , _crMass = 10
@@ -268,9 +214,7 @@ startCr = defaultCreature
    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
    , _crFaction = PlayerFaction
    }
-{- |
+{- | Items you start with.  -}
 Items you start with.
 -}
 startInventory = IM.fromList (zip [0..20] 
    (
    [bezierGun
@@ -298,5 +242,5 @@ startInventory = IM.fromList (zip [0..20]
      ++ 
    repeat NoItem))
-smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor
+smokeGenGun = effectGun "smoke" $ const spawnSmokeAtCursor
@@ -1,11 +0,0 @@
 module Dodge.Creature.AI
    where
 import Dodge.Data
 import Control.Lens
 import System.Random
 insectAI 
    :: ( World -> StdGen -> Creature -> (World -> World, StdGen, Creature) )
    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 insectAI = undefined
@@ -1,12 +0,0 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.AI.Data
    where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Impulse.Data
 import Control.Lens
 data Intelligence
    = Zombie { _crImpulse :: Impulse }
    | Inanimate
@@ -1,6 +1,5 @@
 {- | Actions performed by creatures within the world
 -}
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Action 
    ( module Dodge.Creature.Action
    , module Dodge.Creature.Action.UseItem
@@ -36,9 +35,9 @@ crStrafeLeft
    -> Creature
 crStrafeLeft speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
  where 
-    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr + pi/2)
+    p = s2 *.* unitVectorAtAngle (_crDir cr + pi/2)
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    s2 = (speed * equipFactor)
+    s2 = speed * equipFactor
 crStrafeRight 
    :: Float    -- ^ Speed
@@ -46,9 +45,9 @@ crStrafeRight
    -> Creature
 crStrafeRight speed cr = advanceStepCounter s2 $ over crPos (+.+ p) cr
  where 
-    p =  (*.*) s2 $ unitVectorAtAngle $ (_crDir cr - pi/2)
+    p =  s2 *.* unitVectorAtAngle (_crDir cr - pi/2)
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    s2 = (speed * equipFactor)
+    s2 = speed * equipFactor
 turnTo 
    :: Point2   -- ^ Target point
@@ -239,7 +238,7 @@ blinkAction n w
    cp = _crPos $ _creatures w IM.! n
    p2 = reflectPointWalls cp p1 $ wallsAlongLine cp p1 w
    r  = 1.5 * _crRad (_creatures w IM.! n)
-    p3 = fromMaybe p1 (fmap ((\p -> moveAmountToward p r cp) . fst) p2)
+    p3 = maybe p1 ((\p -> moveAmountToward p r cp) . fst) p2
 blinkShockwave 
    :: Int      -- ^ Blinking creature ID.
@@ -317,7 +316,6 @@ pickUpItem cid flit w = case maybeInvSlot of
    updateItLocation invid w' = case _itID it of 
        Nothing -> w'
        Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
 {- | Creature attempts to moves under its own steam.
 The idea is that this may or may not work, depending on the status of the creature. 
 For now, though, this cannot fail. -}
@@ -329,8 +327,8 @@ crMvBy p' cr = advanceStepCounter (magV p) $ over crPos (+.+ p) cr
  where 
    p =  (*.*) (equipFactor * aimingFactor) $ rotateV (_crDir cr) p'
    equipFactor = product $ map equipSpeed $ IM.elems $ _crInv cr
-    aimingFactor | (_posture $ _crStance cr) == Aiming
+    aimingFactor 
-                      = fromMaybe 1 $ it ^? itAimingSpeed
+        | _posture (_crStance cr) == Aiming = fromMaybe 1 $ it ^? itAimingSpeed
        | otherwise = 1
    it = _crInv cr IM.! _crInvSel cr
@@ -338,16 +336,15 @@ crMvForward
    :: Float    -- ^ Speed
    -> Creature 
    -> Creature
-crMvForward speed cr = crMvBy (speed,0) cr
+crMvForward speed = crMvBy (speed,0)
 advanceStepCounter
    :: Float    -- ^ Speed
    -> Creature 
    -> Creature
-advanceStepCounter speed cr = over (crStance . carriage) f cr
+advanceStepCounter speed = crStance . carriage %~ f
  where 
-    f (w@Walking {}) = w {_stepToAdd = ceiling speed}
+    f w@Walking{} = w{_stepToAdd = ceiling speed}
    f s = s
 creatureTurn :: Float -> Creature -> Creature
@@ -9,7 +9,7 @@ import Control.Lens
 strafeTo :: Float -> Point2 -> Int -> World -> World
 strafeTo speed targPos cid w = over (creatures . ix cid . crPos) (+.+ q) w
    where q =  (*.*) (speed * equipFactor * wpFactor) 
-                      $ safeNormalizeV $ (targPos -.- _crPos cr)
+                      $ safeNormalizeV $ targPos -.- _crPos cr
          equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
          cr = _creatures w IM.! cid
          wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr)
@@ -7,10 +7,13 @@ import Dodge.Inventory
 import qualified Data.IntMap as IM
 import Control.Lens
-import Data.Maybe (fromMaybe)
+import Data.Maybe (maybe)
 useItem :: Int -> World -> World
-useItem n w = equippedItemEffect n w
+useItem n w = itemEffect n it w
  where 
    c = _creatures w IM.! n
    it = _crInv c IM.! _crInvSel c
 crUseItem :: Creature -> World -> World
 --crUseItem cr = itemEffect (_crID cr) (_crInv cr IM.! _crInvSel cr)
@@ -24,18 +27,12 @@ tryUseItem cid w = case w ^? creatures . ix cid of
    Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w
    Nothing -> w
 equippedItemEffect :: Int -> World -> World
 equippedItemEffect n w = itemEffect n it w
  where 
    c = _creatures w IM.! n
    it = _crInv c IM.! _crInvSel c
 itemEffect 
    :: Int      -- ^ Creature id (I am almost certain)
    -> Item 
    -> World 
    -> World
-itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ rmSelectedInvItem n <$> eff n w
+itemEffect n Consumable{_cnEffect=eff } w = maybe w (rmSelectedInvItem n) (eff n w)
-itemEffect n (Weapon {_wpFire=eff}) w = eff n w
+itemEffect n Weapon{_wpFire=eff} w = eff n w
-itemEffect n (Throwable {_twFire = eff}) w = eff n w
+itemEffect n Throwable{_twFire = eff} w = eff n w
 itemEffect _ _ w = w
@@ -20,7 +20,6 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Collide
 import Dodge.Creature.ChooseTarget
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Test
 import Geometry
@@ -216,7 +215,7 @@ applyNewStrategies
 applyNewStrategies w cr = case cr ^? crActionPlan . crStrategy of
    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
        & crActionPlan . crStrategy .~ strat
-    otherwise -> cr
+    _ -> cr
 doStrategyActions
    :: World
@@ -225,7 +224,7 @@ doStrategyActions
 doStrategyActions w cr = case cr ^? crActionPlan . crStrategy of
    Just (StrategyActions strat acs) -> cr & crActionPlan . crAction .~ acs
        & crActionPlan . crStrategy .~ strat
-    otherwise -> cr
+    _ -> cr
 updateShoot
    :: World
@@ -270,7 +269,7 @@ watchUpdateStrat
    -> Creature
 watchUpdateStrat fs w cr = case cr ^? crActionPlan . crStrategy of
    Just WatchAndWait -> cr 
-        & crActionPlan . crStrategy .~ listGuard (fs, (\_ _ -> WatchAndWait)) (w, cr) w cr
+        & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
    _ -> cr
 listGuard :: ([(a -> Bool, b)] , b) -> a -> b
@@ -3,11 +3,12 @@ module Dodge.Creature.AlertLevel
    where
 import Dodge.Data
 import Dodge.Creature.AlertLevel.Data
-import Dodge.Base.Collide
+import Dodge.Base
 --import Dodge.Base.Collide
 import Control.Lens
 import Control.Monad.Reader
 import qualified Data.IntMap.Strict as IM
 {- | Ties together (currently) an awareness and attention update -}
 basicPerceptionUpdate
    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
@@ -15,13 +16,20 @@ basicPerceptionUpdate
    -> Creature
    -> Creature
 basicPerceptionUpdate is w cr 
-    = basicAwarenessUpdate w $ 
+    = basicAwarenessUpdate w $ basicAttentionUpdate is w cr
-        basicAttentionUpdate is w cr
+
 basicPerceptionUpdateR
    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
    -> Creature
    -> Reader World Creature
 basicPerceptionUpdateR is cr = reader $ \w ->
    basicAwarenessUpdate w $ basicAttentionUpdate is w cr
 {- | Update a creatures awareness based upon the creatures current direction
 of attention -}
 basicAwarenessUpdate 
    :: World -> Creature -> Creature
-basicAwarenessUpdate w cr = case _crAttentionDir cr of
+basicAwarenessUpdate _ cr = case _crAttentionDir cr of
    AttentiveTo is -> cr & crAwarenessLevel %~ updateAwareness is
    Fixated i -> cr & crAwarenessLevel 
        %~ ( IM.insert i (Cognizant 100) . IM.mapMaybe decreaseAwareness)
@@ -54,4 +62,4 @@ basicAttentionUpdate
    -> Creature
    -> Creature
 basicAttentionUpdate cids w cr = cr & crAttentionDir .~
-    AttentiveTo (filter (\cid -> canSee (_crID cr) cid w) cids)
+    AttentiveTo (forceList $ filter (\cid -> canSee (_crID cr) cid w) cids)
@@ -1,5 +1,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.AlertLevel.Data
    where
 import Control.Lens
 data AwakeLevel
    = Comatose
@@ -9,9 +12,11 @@ data AwakeLevel
    | Overstrung
 data AttentionDir
-    = AttentiveTo [Int]
+    = AttentiveTo {_unAttentiveTo :: [Int]}
-    | Fixated  Int
+    | Fixated {_unFixated :: Int }
 data AwarenessLevel
    = AwarenessInt Int
    | Cognizant Int
 makeLenses ''AttentionDir
@@ -1,5 +0,0 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.Data
  where
 import Control.Lens
@@ -1,58 +0,0 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.Impulse.Data
    where
 import Dodge.Creature.Stance.Data
 import Geometry.Data
 import Control.Lens
 data Impulse 
    = MoveTo Point2
    | MoveToFor Point2 Int
    | MoveFire Point2 Point2
    | PathTo Point2
    | PathAlong [Point2]
    | SubPathTo Point2 Int Point2
    | Wait
    | WaitFor Int
    | WaitForID Int Int
    | FireAt Point2
    | FireAtID Int Point2
    | Fire
    | Reload
    | IncreaseAlert Int
    | Guard Point2 Point2
    | Search Int
    | SearchNear Point2
    | AimAt Point2 Int
    | InitGuard
    | Init
    | MeleeAttack Int
    | InitTrackYou
    | TrackYou
    | Track Int
    | TrackFor Int Int
    | TurnByFor Float Int
    | TurnTo Point2
    | TurnToward Point2
    | TurnTowardAngle Float
    | StrafeLeftAround Int Point2
    | StrafeRightAround Int Point2
    | StrafeLeftFor Int
    | StrafeRightFor Int
    | StrafeLeftForSpeed Int Float
    | StrafeRightForSpeed Int Float
    | StrafeLeftFire
    | StrafeRightFire
    | MoveForwardFor Int
    | MoveForwardFire
    | MoveBackwardFor Int
    | MoveByFor Point2 Int
    | MoveBackwardFire
    | ImpulseID Int Impulse
    | AtRange Float
    | AtRanges Float Float
    | RepeatAction Int Impulse
    | MakeJudgement
    | SetPosture Posture
  deriving (Eq,Show)
@@ -4,23 +4,22 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Creature.ChooseTarget
 import Dodge.Creature.State.Data
 import Dodge.Creature.Rationality.Data
 import Geometry
 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) - 30) ) *.* safeNormalizeV (cpos -.- cenp)
+    | 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 
@@ -64,6 +63,19 @@ spreadOut ycr crs cr = p
        | 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
@@ -100,16 +112,51 @@ chaseTarget targFunc w cr = case targFunc cr w of
    Nothing -> cr
    Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
 chaseTargetR
    :: (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
    -> Creature 
    -> Reader World Creature 
 chaseTargetR targFunc cr = reader $ \w ->  case targFunc cr w of
    Nothing -> cr
    Just crTarg -> cr & crActionPlan . crImpulse .~ chaseTarg cr crTarg
 overrideMeleeCloseTarget :: World -> Creature -> Creature
 overrideMeleeCloseTarget w cr = case _crTarget cr of
    Nothing -> cr
    Just tcr
        | _crMeleeCooldown cr == Just 0
            && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 
            && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
            -> cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike [DoImpulses [Melee (_crID tcr)]]
        | otherwise -> cr
  where
    cpos = _crPos cr
 overrideMeleeCloseTargetR 
    :: Creature 
    -> Reader World Creature
 overrideMeleeCloseTargetR cr = reader $ \w  -> case _crTarget cr of
    Nothing -> cr
    Just tcr
        | _crMeleeCooldown cr == Just 0
            && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5 
            && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
            -> cr & crActionPlan . crStrategy .~ StrategyActions MeleeStrike [DoImpulses [Melee (_crID tcr)]]
        | otherwise -> cr
  where
    cpos = _crPos cr
 chaseTarg' :: Point2 -> Creature -> Creature -> [Impulse]
 chaseTarg' p cr crT
    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
            && _crMeleeCooldown cr == Just 0
        = [Melee (_crID crT)]
    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
        = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (p -.- cpos)) < pi/4
+    | 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 ]
  where
@@ -120,13 +167,9 @@ chaseTarg' p cr crT
 chaseTarg :: Creature -> Creature -> [Impulse]
 chaseTarg cr crT
    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
            && _crMeleeCooldown cr == Just 0
        = [Melee (_crID crT)]
    | dist tpos cpos < combinedRad + 5 
            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
        = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+    | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
                = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
    | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
  where
@@ -146,13 +189,13 @@ impulseShootAtTarget targFunc w cr = case targFunc cr w of
 impulseShootAtTarg :: Creature -> Creature -> [Impulse]
 impulseShootAtTarg cr crT
    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
            && _crMeleeCooldown cr == Just 0
        = [Melee (_crID crT)]
    | dist tpos cpos < combinedRad + 5 
-            && abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+            && abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
        = [ TurnToward tpos 0.05 ]
-    | abs ((_crDir cr) - argV (tpos -.- cpos)) < pi/4
+    | abs (_crDir cr - argV (tpos -.- cpos)) < pi/4
                = [MoveForward 2.5 , TurnToward tpos 0.2, RandomTurn 0.2 ]
    | otherwise = [MoveForward 2.5 , TurnToward tpos 0.05, RandomTurn 0.2 ]
  where
@@ -6,7 +6,6 @@ module Dodge.Creature.Inanimate
 import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Impulse.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.Default
@@ -59,8 +58,7 @@ barrel = defaultInanimate
        , color (greyN 0.5) $ circleSolid 8
        ]
    , _crState = defaultState 
-        {_goals = [[Wait]]
+        {_crSpState = Barrel []
        ,_crSpState = Barrel []
        }
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    }
@@ -74,8 +72,7 @@ explosiveBarrel = defaultInanimate
        , color orange $ circleSolid 10
        ]
    , _crState = defaultState 
-        {_goals = [[Wait]]
+        {_crSpState = Barrel []
        ,_crSpState = Barrel []
        }
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    ,_crApplyDamage = \_ c -> (id, c)
@@ -52,7 +52,7 @@ launcherCrit = defaultCreature
    }
 retreatFire :: Action
-retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ])
+retreatFire = ImpulsesList ( [ UseItem ] : replicate 20 [ Turn 0.16 ])
    `DoActionThen`
    HolsterWeapon
    `DoActionThen`
@@ -60,7 +60,7 @@ retreatFire = ImpulsesList ( [ [ UseItem ] ] ++ replicate 20 [ Turn 0.16 ])
    `DoActionThen`
    DrawWeapon
    `DoActionThen`
-    ImpulsesList ( [[UseItem]] ++ replicate 20 [ Turn $ negate 0.16 ] )
+    ImpulsesList ( [UseItem] : replicate 20 [ Turn $ negate 0.16 ] )
    `DoActionThen`
    HolsterWeapon
    `DoActionThen`
@@ -72,4 +72,4 @@ chooseMovement cr w
    tcr = _creatures w IM.! 0
    p = _crPos tcr
    v = vNormal $ p -.- cpos
-    p' = p +.+ 0.5 *.* (v -.- 20 *.* (normalizeV v))
+    p' = p +.+ 0.5 *.* (v -.- 20 *.* normalizeV v)
@@ -33,17 +33,17 @@ basicCrPict col cr = pictures
        | pdam > 99     = color white $ circleSolid $ _crRad cr
        | otherwise     = pictures [color col' $ circleSolid $ _crRad cr, circLine $ _crRad cr]
    pastDams = _crPastDamage $ _crState cr
-    pdam = sum $ concatMap (map _dmAmount) $ pastDams
+    pdam = sum $ concatMap (map _dmAmount) pastDams
    col' = light . light . light $ light col
    bluntDam :: Maybe Point2
    bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
    bluntScale = case fmap argV bluntDam of
        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
        _   -> id
-    isBluntDam (Blunt {}) = True
+    isBluntDam Blunt{} = True
    isBluntDam _ = False
    piercingDam = find isPiercingDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
-    isPiercingDam (Piercing {}) = True
+    isPiercingDam Piercing{} = True
    isPiercingDam _ = False
    piercingMod = case fmap argV piercingDam of
        Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
@@ -93,8 +93,8 @@ chooseMovement' cr w = takeOneWeighted [chargeProb,retreatProb,strafeProb,strafe
        3
        `DoReplicate`
        ImpulsesList (replicate 9 [Move (0,-3)] ++ [[Move (0,-3),UseItem]])
-    yposl = ypos -.- 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
+    yposl = ypos -.- 100 *.* vNormal (normalizeV $ ypos -.- cpos)
-    yposr = ypos +.+ 100 *.* (vNormal $ normalizeV $ ypos -.- cpos)
+    yposr = ypos +.+ 100 *.* vNormal (normalizeV $ ypos -.- cpos)
 retreatActions :: Creature -> Creature -> Action
 retreatActions tcr cr = 
@@ -2,7 +2,6 @@ module Dodge.Creature.Rationality
    where
 import Dodge.Data
 import Dodge.Base.Collide
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.Action
 import Dodge.Creature.Action.UseItem
 import Dodge.Creature.State.Data
@@ -14,6 +13,7 @@ import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
 import Control.Monad.Reader
 -- Alternatives would probably be a very good fit for actions...
@@ -24,6 +24,14 @@ composeInternalAIs
    -> Creature
 composeInternalAIs fs w c = foldr ($ w) c fs
 impulsiveAIR
    :: (Creature -> Reader World Creature)
    -> World
    -> (World -> World, StdGen)
    -> Creature
    -> ((World -> World, StdGen) , Maybe Creature)
 impulsiveAIR impf w (f,g) cr = followImpulses w (f,g) . ($ w) . runReader . impf $ cr
 impulsiveAI 
    :: (World -> Creature -> Creature) -- ^ Internal AI update, should determine impulses
    -> World 
@@ -84,7 +92,7 @@ followImpulse cr w imp = case imp of
    rr a = fst $ randomR (-a,a) $ _randGen w
    hitCr i = over (creatures . ix i . crState . crDamage) (addDam i)
        . soundOnce (fromIntegral hitSound)
-    addDam i dams = (( Blunt 100 cpos (posFromID i) (posFromID i) ) : dams )
+    addDam i dams = Blunt 100 cpos (posFromID i) (posFromID i) : dams 
 actionUpdateAI
    :: (World -> Creature -> Creature) -- ^ the function updating the actions
@@ -93,6 +101,24 @@ actionUpdateAI
    -> Creature
 actionUpdateAI actF w c = performActions w $ actF w c
 performActionR :: Creature -> Reader World Creature
 performActionR cr = reader $ \w -> performActions w cr
 watchUpdateStratR
    :: [ ((World, Creature) -> Bool, World -> Creature -> Strategy) ]
    -> Creature
    -> Reader World Creature
 watchUpdateStratR fs cr = case cr ^? crActionPlan . crStrategy of
    Just WatchAndWait -> reader $ \w -> cr 
        & crActionPlan . crStrategy .~ listGuard (fs, \_ _ -> WatchAndWait) (w, cr) w cr
    _ -> reader $ \_ -> cr
 listGuard :: ([(a -> Bool, b)] , b) -> a -> b
 listGuard ( (test,y):ps, z ) x
    | test x = y
    | otherwise = listGuard (ps, z) x
 listGuard (_,z) _ = z
 performActions :: World -> Creature -> Creature
 performActions w cr = cr
    & crActionPlan . crImpulse .~ concat iss
@@ -1,8 +0,0 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Creature.Rationality.Data
    where
 import Dodge.Creature.Stance.Data
 import Geometry.Data
 import Control.Lens
@@ -8,10 +8,11 @@ import Dodge.Creature.AlertLevel.Data
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 {- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -}
 targetYouWhenCognizant
    :: World
    -> Creature
    -> Creature
 targetYouWhenCognizant w cr = case cr ^? crAwarenessLevel . ix 0 of
-    Just (Cognizant _)  -> cr & crTarget .~ Just (_creatures w IM.! 0)
+    Just (Cognizant _)  -> cr & crTarget ?~ _creatures w IM.! 0
    _                   -> cr & crTarget .~ Nothing
@@ -2,7 +2,6 @@ module Dodge.Creature.State where
 import Dodge.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.RandomHelp
@@ -16,16 +15,11 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
 --import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
 import Codec.BMP
 import qualified Data.ByteString as B
 import Control.Lens
 import Control.Applicative
 import Control.Monad.State
 import Control.Monad
-import qualified SDL as SDL
+import qualified SDL
 import qualified SDL.Mixer as Mix
 import System.Random
 import qualified Data.Set as S
@@ -38,7 +32,6 @@ type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World
 meleeCooldown :: CRUpdate -> CRUpdate
 meleeCooldown u w (f,g) cr = u w (f,g) $ cr & crMeleeCooldown . _Just %~ (max 0 . (\x -> x - 1))
 -- | The movement is updated before the ai in order to correctly set the oldpos.
 -- the whole of this update cycle could do with a rethink, it is becoming
 -- convoluted
@@ -46,10 +39,10 @@ stateUpdate :: CRUpdate -> CRUpdate
 stateUpdate u w (f,g) cr = 
    let (cr', g'') = updateMovement g cr 
    in case u w (f,g'') cr' of
-        ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . deathEff . f'
+        ((f',g') , maybeCr) -> 
            (   (invSideEff cr . movementSideEff cr . deathEff . f'
                , g')
-                               , fmap (updateReloadCounter . doDamage . crAutoReload) 
+            , fmap (updateReloadCounter . doDamage . crAutoReload) $ crOrCorpse =<< maybeCr
                                      $ crOrCorpse =<< maybeCr
            )
  where   
    crOrCorpse cr 
@@ -60,11 +53,11 @@ stateUpdate u w (f,g) cr =
        | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) 
            . over decorations addCorpse 
            . dropByState cr
-    crBeforeDeath = colCrWall w $ cr
+    crBeforeDeath = colCrWall w cr
-    addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) 
+    addCorpse = insertNewKey 
        $ uncurry translate (_crOldPos cr) 
        $ rotate (_crDir cr)
        (_crCorpse cr)
 -- | Drop items according to the creature state.
 dropByState :: Creature -> World -> World
 dropByState cr w = foldr (copyItemToFloor cr) w is
@@ -75,10 +68,8 @@ dropByState cr w = foldr (copyItemToFloor cr) w is
        DropSpecific xs -> xs
        DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
 setOldPos :: Creature -> Creature
 setOldPos cr = set crOldPos (_crPos cr) cr
 {- |
 Given a creature and a velocity, applies friction to that creature and evaluates a 
 velocity to carry across frames.
@@ -86,17 +77,12 @@ velocity to carry across frames.
 crFriction :: Creature -> Point2 -> Point2
 crFriction cr vel = (0,0)
 {- | In order to force a list, apply with seq. -}
 forceSpine :: [a] -> ()
 forceSpine = foldr (const id) ()
 doDamage :: Creature -> Creature
 doDamage cr = set (crState . crDamage) [] 
-    $ over (crState . crPastDamage) (f . take 20 . (dams :) ) damagedCr
+    $ over (crState . crPastDamage) (forceList . take 20 . (dams :) ) damagedCr
  where 
    f l = seq (forceSpine l) l
    dams = _crDamage $ _crState cr
-    damagedCr = snd $ (_crApplyDamage cr) dams cr
+    damagedCr = snd $ _crApplyDamage cr dams cr
 sumDamage :: Creature -> DamageType -> Int -> Int
 sumDamage cr dm x = x + _dmAmount dm
@@ -107,7 +93,7 @@ movementSideEff cr w
        = case cr ^? crStance . carriage of
            Just (Boosting v) 
                -> makeFlameletTimed 
-                            (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi))
+                            (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
                            (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
                            Nothing
                            1
@@ -128,9 +114,6 @@ movementSideEff cr w
    (randDir,g) = randomR (-0.5,0.5) $ _randGen w
    (randAng,_) = randomR (0,2*pi) $ _randGen w
    (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w
    (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[])
    crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
    takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0
                 | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0  
@@ -139,15 +122,16 @@ movementSideEff cr w
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
-    where f i it w' = case it ^? itEffect . itInvEffect of
+    where 
    f i it w' = case it ^? itEffect . itInvEffect of
        Nothing -> w'
        Just g  -> g cr i w'
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of
-    Just (Weapon {_wpReloadState = 0}) -> w
+    Just Weapon{_wpReloadState = 0} -> w
-    Just (Weapon {_wpReloadState = 1}) -> stopSoundFrom (CrReloadSound cid) w
+    Just Weapon{_wpReloadState = 1} -> stopSoundFrom (CrReloadSound cid) w
-    Just (Weapon {}) -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w
+    Just Weapon{} -> soundFrom (CrReloadSound cid) reloadSound 1 0 w
    _ -> w
  where 
    cid = _crID cr
@@ -171,7 +155,7 @@ updateMovement g cr
 isFrictionless :: Creature -> Bool
 isFrictionless cr = case cr ^? crStance . carriage of
    Just (Boosting _) -> True
-    Just (Floating)   -> True
+    Just Floating     -> True
    _                 -> False
 updateReloadCounter :: Creature -> Creature
@@ -212,12 +196,11 @@ updateExpBarrel w (f,g) cr
    damages = _crDamage $ _crState cr
    pierceSparks :: [World -> World]
    pierceSparks 
-      = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) 
+      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
-                                          (Just $ _crID cr))
+                            poss as times colids
-                            poss as colids times
+    as =  randomRs (-0.7,0.7) g
-    as =  randomRs (-0.7,0.7) $ g
+    colids = randomRs (0,11) g
-    colids = randomRs (0,11) $ g
+    times = randomRs (2,5) g
    times = randomRs (2,5) $ g
    (g',_) = split g
    poss = _piercedPoints $ _crSpState $ _crState cr
    --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
@@ -229,7 +212,7 @@ updateExpBarrel w (f,g) cr
    applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints 
                                                       $ _crSpState $ _crState cr)) 
                                   cr
-    hiss | poss == [] = id
+    hiss | null poss = id
         | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1
    stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
@@ -237,14 +220,14 @@ damToExpBarrel :: [DamageType] -> Creature -> Creature
 damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
  where 
    (pierceDam,otherDam) = partition isPierce ds
-    isPierce (Piercing {}) = True
+    isPierce Piercing{} = True
    isPierce _             = False
 damToExpBarrel' :: DamageType -> Creature -> Creature
 damToExpBarrel' (Piercing amount sp int ep) cr 
    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
        $ over crHP (\hp -> hp - div amount 200) cr
-damToExpBarrel' (PoisonDam {}) cr = cr
+damToExpBarrel' PoisonDam {} cr = cr
-damToExpBarrel' (SparkDam {})  cr = cr
+damToExpBarrel' SparkDam {}  cr = cr
-damToExpBarrel' (PushDam {_dmPushBack = v})   cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
+damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
 damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt
@@ -4,31 +4,25 @@ module Dodge.Creature.State.Data
  where
 import Geometry
 import Dodge.Data.DamageType
 import Dodge.Creature.Impulse.Data
 import Dodge.Creature.Stance.Data
 import Picture.Data
 import Control.Lens
 import qualified Data.IntSet as IS
 data CreatureState = CrSt 
-    { _goals    :: [[Impulse]]
+    { _crDamage  :: [DamageType]
    , _crDamage  :: [DamageType]
    , _crPastDamage :: [[DamageType]]
    , _crSpState :: CrSpState
    , _crDropsOnDeath :: CreatureDropType
    }
 data CreatureDropType
    = DropAll
    | DropAmount Int
    | DropSpecific [Int]
 data CrSpState 
    = Barrel { _piercedPoints :: [Point2]}
    | GenCr
  deriving (Eq,Show,Ord)
 data Faction 
    = GenericFaction Int
    | ZombieFaction
@@ -39,11 +33,12 @@ data Faction
    | ColorFaction Color
    | PlayerFaction
  deriving (Eq,Show)
 data CrGroup
    = LoneWolf
-    | Swarm { _swarm :: IS.IntSet }
+    | Swarm 
-
+        { _swarm :: IS.IntSet 
        , _crGroupID :: Int
        }
    | CrGroupID { _crGroupID :: Int }
 makeLenses ''CreatureState
 makeLenses ''CrSpState
 makeLenses ''Impulse
@@ -32,14 +32,15 @@ swarmCrit = defaultCreature
    { _crUpdate = stateUpdate $ impulsiveAI $ composeInternalAIs
        [ flockPointTarget encircle targetYouLOS
        , \ _ -> crMeleeCooldown . _Just %~ (max 0 . subtract 1)
        , basicPerceptionUpdate [0]
 --        , doStrategyActions
 --        , targetYouWhenCognizant
        ]
    , _crHP = 1
    , _crRad = 2
    , _crMass = 2
    , _crPict = basicCrPict yellow
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 2
    , _crFaction = ColorFaction yellow
    , _crMeleeCooldown = Just 0
    }
@@ -16,6 +16,7 @@ import Data.List (find)
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Control.Monad.Reader
 andTest :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 andTest f g a = f a && g a
@@ -28,31 +29,61 @@ crIsReloading (w,cr) = case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
    Just t -> t > 0
    _ -> False
 crIsReloadingR :: Creature -> Reader World Bool
 crIsReloadingR cr = return $ case cr ^? crInv . ix (_crInvSel cr) . wpReloadState of
    Just t -> t > 0
    _ -> False
 crCanSeeCr :: Creature -> (World, Creature) -> Bool
 crCanSeeCr tcr (w,cr) = hasLOS (_crPos cr) (_crPos tcr) w
 crCanSeeR :: Creature -> Creature -> Reader World Bool
 crCanSeeR tcr cr = reader $ \w -> hasLOS (_crPos cr) (_crPos tcr) w
 crCanSeeCID :: Int -> (World, Creature) -> Bool
 crCanSeeCID cid (w,cr) = hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
 crCanSeeCIDR :: Int -> Creature -> Reader World Bool
 crCanSeeCIDR cid cr = reader $ \w -> hasLOS (_crPos cr) (_crPos $ _creatures w IM.! cid) w
 crIsAiming :: (World,Creature) -> Bool
 crIsAiming (_,cr) = _posture (_crStance cr) == Aiming
 crIsAimingR :: Creature -> Reader World Bool
 crIsAimingR cr = return $ _posture (_crStance cr) == Aiming
 crHasTarget :: (World,Creature) -> Bool
 crHasTarget (_,cr) = isJust $ cr ^? crTarget . _Just
 crHasTargetR :: Creature -> Reader World Bool
 crHasTargetR cr = return $ isJust $ cr ^? crTarget . _Just
 crHasTargetLOS :: (World,Creature) -> Bool
 crHasTargetLOS (w,cr) = case cr ^? crTarget . _Just of
    Just i -> crCanSeeCr i (w,cr) 
    Nothing -> False
 crHasTargetLOSR :: Creature -> Reader World Bool
 crHasTargetLOSR cr = reader $ \w -> case cr ^? crTarget . _Just of
    Just i -> crCanSeeCr i (w,cr) 
    Nothing -> False
 crSafeDistFromTarg :: Float -> (World,Creature) -> Bool
 crSafeDistFromTarg d (w,cr) = case cr ^? crTarget . _Just of
    Just tcr -> dist (_crPos cr) (_crPos tcr) > d
    Nothing -> True
 crSafeDistFromTargR :: Float -> Creature -> Reader World Bool
 crSafeDistFromTargR d cr = reader $ \w -> case cr ^? crTarget . _Just of
    Just tcr -> dist (_crPos cr) (_crPos tcr) > d
    Nothing -> True
 crStratConMatches :: Strategy -> (World,Creature) -> Bool
 crStratConMatches strat (_,cr) = eqConstr strat (_crStrategy $ _crActionPlan cr)
 crStratConMatchesR :: Strategy -> Creature -> Reader World Bool
 crStratConMatchesR strat cr = return $ eqConstr strat (_crStrategy $ _crActionPlan cr)
 crAwayFromPost :: (World,Creature) -> Bool
 crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
    Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
@@ -60,3 +91,11 @@ crAwayFromPost (_,cr) = case find sentinelGoal $ _crGoal $ _crActionPlan cr of
  where
    sentinelGoal (SentinelAt p dir) = True
    sentinelGoal _ = False
 crAwayFromPostR :: Creature -> Reader World Bool
 crAwayFromPostR cr = return $ case find sentinelGoal $ _crGoal $ _crActionPlan cr of
    Just (SentinelAt p dir) -> dist p (_crPos cr) > 15
    _ -> False
  where
    sentinelGoal (SentinelAt p dir) = True
    sentinelGoal _ = False
@@ -1,4 +1,3 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Update
  where
 import Dodge.Data
@@ -16,10 +16,8 @@ module Dodge.Data
    , soundTime
    ) where
 import Dodge.Picture.Layer.Data
 import Dodge.Creature.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.AlertLevel.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
@@ -42,6 +40,7 @@ import Data.Data
 import Data.Graph.Inductive
 import Data.Int (Int16)
 import qualified Data.Set as S
 import qualified Data.IntSet as IS
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import qualified Data.DList as DL
@@ -58,6 +57,7 @@ data World = World
    , _cameraViewFrom       :: !Point2
    , _creatures            :: IM.IntMap Creature
    , _creaturesZone        :: IM.IntMap (IM.IntMap (IM.IntMap Creature))
    , _creatureGroups       :: IM.IntMap CrGroupParams
    , _itemPositions        :: IM.IntMap ItemPos
    , _clouds               :: IM.IntMap Cloud
    , _cloudsZone           :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
@@ -65,7 +65,7 @@ data World = World
    , _particles            :: ![Particle]
    , _staticWalls          :: [Wall]
    , _walls                :: !(IM.IntMap Wall)
-    , _wallsZone            :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
+    , _wallsZone            :: IM.IntMap (IM.IntMap (IM.IntMap Wall))
    , _forceFields          :: IM.IntMap ForceField
    , _floorItems           :: IM.IntMap FloorItem
    , _randGen              :: StdGen
@@ -105,6 +105,12 @@ data World = World
    , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
    , _doneSideEffects      :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
    }
 data CrGroupParams = CrGroupParams
    { _crGroupParamID   :: Int
    , _crGroupIDs       :: IS.IntSet
    , _crGroupCenter    :: Point2
    , _crGroupUpdate    :: World -> CrGroupParams -> Maybe CrGroupParams
    }
 data Corpse = Corpse
    { _cpPos :: Point2
    , _cpPict :: Picture
@@ -380,8 +386,7 @@ data Particle
        , _btMaxTime'   :: Int
        , _btTimer'     :: Int
        }
-type HitEffect = Particle -> [(Point2, (Either3 Creature Wall ForceField))] -> World 
+type HitEffect = Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World,Maybe Particle)
                    -> (World,Maybe Particle)
 data Projectile 
    = Projectile    
        { _pjPos :: Point2
@@ -540,26 +545,26 @@ data Action
        ,_waitThenAction :: Action
        }
    | DoActionWhile 
-        {_doActionWhileCondition :: ( (World, Creature) -> Bool)
+        {_doActionWhileCondition :: (World, Creature) -> Bool
        ,_doActionWhileAction :: Action 
        }
    | DoActionWhilePartial
        {_doActionWhilePartial :: Action
-        ,_doActionWhileCondition :: ( (World, Creature) -> Bool)
+        ,_doActionWhileCondition :: (World, Creature) -> Bool
        ,_doActionWhileAction :: Action 
        }
    | DoActionIf
-        {_doActionIfCondition :: ( (World, Creature) -> Bool) 
+        {_doActionIfCondition :: (World, Creature) -> Bool
        ,_doActionIfAction :: Action
        }
    | DoActionIfElse 
        {_doActionIfElseIfAction :: Action 
-        ,_doActionIfElseCondition :: ( (World, Creature) -> Bool) 
+        ,_doActionIfElseCondition ::  (World, Creature) -> Bool
        ,_doActionIfElseElseAction :: Action
        }
    | DoActionWhileThen 
        {_doActionWhileThenDo :: Action 
-        ,_doActionWhileThenCondition :: ( (World, Creature) -> Bool) 
+        ,_doActionWhileThenCondition :: (World, Creature) -> Bool
        ,_doActionWhileThenThen :: Action
        }
    | DoActions 
@@ -619,6 +624,7 @@ data Strategy
    | GetTo Point2
    | Reload
    | Flee
    | MeleeStrike
  deriving (Generic)
 --  deriving (Eq,Ord,Show)
 data Goal
@@ -646,6 +652,7 @@ makeLenses ''Button
 makeLenses ''ActionPlan
 makeLenses ''Impulse
 makeLenses ''Action
 makeLenses ''CrGroupParams
 numColor :: Int -> Color
 numColor 0  = (1,0,0,1) 
@@ -1,4 +1,3 @@
 {-# LANGUAGE BangPatterns #-}
 {- |
 Module      : Dodge.Default
 Description : Instances of data structures  
@@ -10,7 +9,6 @@ import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.State.Data
 import Dodge.Creature.Rationality.Data
 import Dodge.Creature.AlertLevel.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
@@ -45,15 +43,13 @@ defaultCrystalWall = Wall
    , _wlSeen = False
    , _wlIsSeeThrough = True
    }
-
+{- Door that opens on approach.
 {-
 Door that opens on approach.
 Pathable.  -}
 defaultAutoDoor = Door 
    { _wlLine = ((0,0),(50,0))
    , _wlID = 0
    , _doorMech = id
-    , _wlColor = light $ dim $ dim $ dim $ yellow
+    , _wlColor = light $ dim $ dim $ dim yellow
    , _wlSeen = False
    , _wlIsSeeThrough = False
    , _doorPathable = True
@@ -66,7 +62,7 @@ defaultDoor = Door
    { _wlLine = ((0,0),(50,0))
    , _wlID = 0
    , _doorMech = id
-    , _wlColor = light $ dim $ dim $ dim $ yellow
+    , _wlColor = light $ dim $ dim $ dim yellow
    , _wlSeen = False
    , _wlIsSeeThrough = False
    , _doorPathable = False
@@ -101,8 +97,7 @@ defaultCreature = Creature
    , _crGroup   = LoneWolf
    }
 defaultState = CrSt 
-    { _goals = []
+    { _crDamage = []
    , _crDamage = []
    , _crPastDamage = []
    , _crSpState = GenCr
    , _crDropsOnDeath = DropAmount 1
@@ -143,7 +138,7 @@ defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
 defaultApplyDamage ds cr = (id, doPoisonDam $ foldr (\d c -> snd $ applyIndividualDamage d c) cr ds')
  where 
    (ps,ds') = partition isPoison ds
-    isPoison (PoisonDam {}) = True
+    isPoison PoisonDam{} = True
    isPoison _ = False
    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
    doPoisonDam = over crHP (\hp -> hp - poisonDam)
@@ -174,7 +169,7 @@ defaultIt = Consumable
    , _itName = "defaultIt"
    , _itMaxStack = 3
    , _itAmount = 2
-    , _cnEffect = \ _ -> return
+    , _cnEffect = const return
    , _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
    , _itEquipPict = \cr _ -> blank
    , _itID = Nothing
@@ -187,8 +182,8 @@ defaultButton = Button
    { _btPict = onLayer WlLayer $ color red $ polygon $ rectNSEW 5 (-5) 10 (-10)
    , _btPos = (0,0)
    , _btRot = 0
-    , _btEvent = \b w -> set (buttons . ix (_btID b) . btPict) 
+    , _btEvent = \b w -> 
-                             (onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10))
+        set (buttons . ix (_btID b) . btPict) (onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10))
        . set (buttons . ix (_btID b) . btState) BtNoLabel
        . soundOnce 1 $ w
    , _btID = 0
@@ -204,15 +199,13 @@ defaultPT = Projectile
    , _pjUpdate = id
    }
 defaultPP = PressPlate
-    { _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5
+    { _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright blue) $ circleSolid 5
    , _ppPos = (0,0)
    , _ppRot = 0
-    , _ppEvent = \pp -> id
+    , _ppEvent = const id
    , _ppID = -1
    , _ppText = "Pressure plate"
    }
 -- }}}
 defaultWorld = World
    { _keys = S.empty
    , _mouseButtons = S.empty
@@ -222,6 +215,7 @@ defaultWorld = World
    , _cameraViewFrom = (0,0)
    , _creatures = IM.empty
    , _creaturesZone = IM.empty
    , _creatureGroups = IM.empty
    , _clouds = IM.empty
    , _cloudsZone = IM.empty
    , _itemPositions = IM.empty
@@ -108,12 +108,12 @@ wheelUpEvent w = case _carteDisplay w of
 wheelDownEvent :: World -> World
 wheelDownEvent w = case _carteDisplay w of
-    True    | rbDown    -> w & carteZoom .~ max 0.05 (z-(0.1*z))
+    True    
-            | otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i + 1)
+        | rbDown    -> w & carteZoom .~ max 0.05 (z-(0.1*z))
-    False   | rbDown    -> fromMaybe (closeObjScrollDown w)
+        | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ 1)
-                                  $ (yourItem w ^? itScrollDown) 
+    False   
-                                      <*> pure (_crInvSel (you w))
+        | rbDown    -> fromMaybe (closeObjScrollDown w)
-                                      <*> pure w
+            $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) <*> pure w
        | lbDown     -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
        | otherwise   -> downInvPos w
  where 
@@ -25,7 +25,6 @@ import qualified Data.Set as S
 import Control.Lens
 import Picture
 {- | Handles keyboard press and release.
 On release, remove scancode from the 'Set' of pressed keys.
 On press, adds the scancode, and perhaps applies a direct effect:
@@ -58,7 +57,6 @@ handlePressedKey True _     w   = Just w
 handlePressedKey _    scode w
    | null (_menuLayers w)      = handlePressedKeyInGame scode w
    | otherwise                 = handlePressedKeyInMenu (head $ _menuLayers w) scode w
 handlePressedKey _ _ w          = Just w
 debugKey :: Scancode -> World -> Maybe World 
 debugKey scancode w
@@ -40,8 +40,7 @@ import Control.Lens
 import Control.Monad.State
 import Control.Monad.Loops
 import System.Random
-{- |
+{- | A test level tree. -}
 A test level tree. -}
 roomTreex :: RandomGen g => State g (Maybe [Room])
 roomTreex = do
    struct' <- aTreeStrut
@@ -51,16 +50,19 @@ roomTreex = do
        t = treeFromTrunk 
            [[StartRoom]
            ,[Corridor]
            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
                & rmPS %~ ([sPS (0,50) 0 $ PutCrit chaseCrit ]++)
             ]
            ,[Corridor]
            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 400 
                & rmPS %~ ([swarmPS 0 (x,y) 0 swarmCrit | x <- [-20,-19.5.. 20] , y <- [200] ]++)
             ]
            ,[Corridor]
            ,[Corridor]
-            ,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30]
+            ,[SpecificRoom $ pure . Right <$> twinSlowDoorChasers 30]
            ,[Corridor]
            ,[DoorAno]
-            ,[SpecificRoom $ fmap (pure . Right) 
+            ,[SpecificRoom $ pure . Right <$> centerVaultExplosiveExit 50]
                $ centerVaultExplosiveExit 50]
            ,[SpecificRoom blockedCorridor]
            ,[OrAno [[DoorAno]
                    ,[Corridor]
@@ -82,8 +84,7 @@ roomTreex = do
            ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
            ] 
            t'
-    fmap (shiftExpandTree . expandTreeBy id) $ mapM annoToRoomTree t
+    shiftExpandTree . expandTreeBy id <$> mapM annoToRoomTree t
 levx :: RandomGen g => State g [Room]
 levx = untilJust roomTreex
@@ -1,18 +1,20 @@
 module Dodge.Graph
  where
 import Data.Function (on)
-import Data.List
+import Data.List.Extra
 import Data.Bifunctor (first)
 import Data.Graph
 import Data.Maybe
 pairsToIncidence :: (Eq a,Ord a) => [(a,a)] -> [(a,[a])]
-pairsToIncidence = map ((\(xs,ys) -> (head xs,ys)) . unzip)
+pairsToIncidence 
-                     . groupBy ( (==) `on` fst)
+    = map (first head . unzip)
    . groupOn fst
    . sort
 incidenceToFunction :: Eq a => [(a,[a])] -> a -> [a]
-incidenceToFunction xs a = case lookup a xs of Just ys -> ys
+incidenceToFunction xs a = fromMaybe [] $ lookup a xs
                                               Nothing -> []
 mkNode :: (a,[a]) -> (a,a,[a])
 mkNode (x,xs) = (x,x,xs)
@@ -2,22 +2,19 @@ module Dodge.Inventory
    where
 import Dodge.Data
 import Dodge.Base
 --import Dodge.SoundLogic
 import Geometry
 import Data.Maybe
 import Data.List
 import Data.Function (on)
 import qualified Data.IntMap.Strict as IM
 import System.Random
 import Control.Lens
 checkInvSlotsYou' :: Maybe Item -> World -> Maybe Int
-checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
+checkInvSlotsYou' it w = fst <$> find cond invListSelFirst
-    where cond (_,NoItem) = True
+  where 
    cond (_,NoItem) = True
    cond (_,it'   ) = itNotFull it' && fmap _itName it == Just (_itName it')
    youCr = you w
    youSel = _crInvSel youCr
@@ -25,7 +22,7 @@ checkInvSlotsYou' it w = fmap fst $ find cond invListSelFirst
    invListSelFirst = (youSel , invList IM.! youSel) : IM.toList invList
 checkInvSlotsYou :: Item -> World -> Maybe Int
-checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
+checkInvSlotsYou it w = fst <$> find cond invListSelFirst
  where 
    cond (_,NoItem) = True
    cond (_,it'   ) = itNotFull it' && _itName it == _itName it'
@@ -36,7 +33,8 @@ checkInvSlotsYou it w = fmap fst $ find cond invListSelFirst
 checkInvSlots :: Item -> IM.IntMap Item -> Maybe Int
 checkInvSlots it its = fmap fst $ find cond $ IM.toList its
-    where cond (_,NoItem) = True
+  where 
    cond (_,NoItem) = True
    cond (_,it'   ) = itNotFull it' && _itName it == _itName it'
 addItem :: Item -> Item -> Item
@@ -67,20 +65,17 @@ rmInvItem n i w =
            Equipment {_itAmount = x} -> over (itRef . itAmount)  (\y-> y-1) w    
            Throwable {_itAmount = x} -> over (itRef . itAmount)  (\y-> y-1) w    
            _ -> set itRef NoItem w
-
+{- Delete a creature's selected item, the item will no longer exist.  -}
 {-
 Delete a creature's selected item, the item will no longer exist.
 -}
 rmSelectedInvItem 
    :: Int  -- ^ Creature id
    -> World 
    -> World
 rmSelectedInvItem cid w = rmInvItem cid (_crInvSel (_creatures w IM.! cid)) w
 -- for now, left are floor items, right are buttons
 closestActiveObject :: World -> Maybe (Either FloorItem Button)
-closestActiveObject w = listToMaybe $ sortBy (compare `on` dist ypos . pos) $ actObjs
+closestActiveObject w = listToMaybe $ sortOn (dist ypos . pos) actObjs
-    where ypos = _crPos $ you w
+  where 
    ypos = _crPos $ you w
    actObjs = filter (\obj -> dist ypos (pos obj) < 40 && hasLOS ypos (pos obj) w) 
                  $ map Left (IM.elems $ _floorItems w) ++ activeButtons -- map Right (IM.elems $ _buttons w)
    pos (Right x) = _btPos x
@@ -13,7 +13,7 @@ keyToken n = defaultEquipment
    , _itName = "KEYTOKEN "++show n
    , _itMaxStack = 5
    , _itAmount = 1
-    , _itFloorPict = setDepth 0.5 $ keyPic
+    , _itFloorPict = setDepth 0.5 keyPic
    , _itEquipPict = \cr _ -> setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
    , _itEffect = NoItEffect
    , _itHammer = HammerUp
@@ -36,7 +36,7 @@ latchkey n = defaultEquipment
    , _itName = "KEY "++show n
    , _itMaxStack = 1
    , _itAmount = 1
-    , _itFloorPict = setDepth 0.5 $ latchkeyPic
+    , _itFloorPict = setDepth 0.5 latchkeyPic
    , _itEquipPict = \cr _ -> setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
    , _itEffect = NoItEffect
    , _itHammer = HammerUp
@@ -29,6 +29,5 @@ heal25 :: Int -> World -> Maybe World
 heal25 = heal 25
 heal :: Int -> Int -> World -> Maybe World
 heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
-            | otherwise = Just $ soundOnce healSound 
+            | otherwise = Just $ soundOnce healSound w & creatures . ix n . crHP %~ min 10000 . (+ hp)
                               $ over (creatures . ix n . crHP) ((min 10000) . (+ hp) ) w
@@ -1,8 +1,5 @@
-{- |
+{- | Definitions of weapons.
-Definitions of weapons.
+In progress: move out effects into other modules.  -}
 In progress: move out effects into other modules.
 -}
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Item.Weapon 
    ( module Dodge.Item.Weapon
    )
@@ -145,7 +145,7 @@ bulHitWall' bt p x w = damageBlocks x
    spid = newKey $ _projectiles w
    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
    damageBlocks wall w = case wall ^? blHP of 
-          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
          _ -> w
 {- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
@@ -155,7 +155,7 @@ bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
          _ -> w
    bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
                                      (_btHitEffect' bt) (_btWidth' bt)
@@ -180,7 +180,7 @@ bulIncWall' bt p wl w =  damageBlocks wl $ incFlamelets w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
          _ -> w
    wallV = uncurry (-.-) (_wlLine wl)
    reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
@@ -198,9 +198,9 @@ bulConWall' bt p wl w =  damageBlocks wl $ mkwave w
    pOut = p +.+ safeNormalizeV (sp -.- p)
    damageBlocks wall w
      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> walls . ix j . blHP -~ 5) w (_blIDs wall)
          _ -> w
-    mkwave = over worldEvents ((makeShockwaveAt [] p 15 4 1 white) . ) 
+    mkwave = over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
 hvBulHitWall' 
    :: Particle 
@@ -218,7 +218,7 @@ hvBulHitWall' bt p x w =  damageBlocks x $ set randGen g $ foldr ($) w (sparks p
        argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
    sv = unitVectorAtAngle $ reflectDir x
    damageBlocks wall w = case wall ^? blHP of 
-        Just hp -> foldr (\j -> (walls . ix j . blHP -~ 20)) w (_blIDs wall)
+        Just hp -> foldr (\j -> walls . ix j . blHP -~ 20) w (_blIDs wall)
        _ -> w
    cs      = take 10 $ randomRs (0,11) $ _randGen w
    ds      = randomRs (-0.7,0.7) $ _randGen w
@@ -370,7 +370,7 @@ spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++)
        poss dirs colids
    poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
        $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
-    dirs = map ((_crDir cr) +) $ zipWith (+) 
+    dirs = map (_crDir cr +) $ zipWith (+) 
        [-spread,-spread+(2*spread/fromIntegral num)..]
        (randomRs (0,spread/5) (_randGen w))
    colids = take num $ randomRs (0,11) (_randGen w)
@@ -96,7 +96,7 @@ mvRadar x p w pt =
    )
  where 
    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
-    putBlips = over worldEvents ( ( over particles (blips ++) ) . )
+    putBlips = over worldEvents ( over particles (blips ++) . )
    blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) circPoints
    circPoints = mapMaybe (\wl -> uncurry collidePointCircCorrect (_wlLine wl) r p)
        $ map (over wlLine swp) (IM.elems $ wallsAlongCirc p r w)
@@ -25,7 +25,7 @@ import Data.Maybe
 import Data.Tree
 import Data.Either
 import Data.Function
-import Data.Graph.Inductive.Graph
+import Data.Graph.Inductive.Graph hiding ((&))
 import Data.Graph.Inductive.Basic
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.NodeMap
@@ -61,16 +61,17 @@ generateFromTree t w = updateWallZoning $ placeSpots plmnts
 updateWallZoning :: World -> World
 updateWallZoning w = set wallsZone (IM.foldr wallInZone IM.empty (_walls w)) w
  where
-    wallInZone wl | uncurry dist (_wlLine wl) <= 2*zoneSize 
+    wallInZone wl 
-                      = insertIMInZone x y wlid wl
+        | uncurry dist (_wlLine wl) <= 2*zoneSize = insertIMInZone x y wlid wl
        | otherwise = flip (foldr (\(a,b) -> insertIMInZone a b wlid wl)) ips
-      where (x,y) = zoneOfPoint $ (uncurry pHalf (_wlLine wl))
+      where 
        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
        wlid  = _wlID wl
        ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
 makePath :: Tree Room -> [(Point2,Point2)]
-makePath = concat . map _rmPath . flatten
+makePath = concatMap _rmPath . flatten
 -- consider nubbing walls after dividing them
 wallsFromTree :: Tree Room -> IM.IntMap Wall
@@ -81,7 +82,7 @@ wallsFromTree t =
    . removeInverseWalls
    . foldr cutWalls [] -- map (map (g . roundPoint2)) 
 --    . map (map roundPoint2)
-    $ (concatMap _rmPolys $ flatten t)
+    $ concatMap _rmPolys (flatten t)
  where
    assignKeys = IM.fromList . zip [0..] . zipWith f [0..]
    f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i}
@@ -98,9 +99,8 @@ wallsFromRooms =
 divideWall :: Wall -> [Wall]
 divideWall wl
    = let (a,b) = _wlLine wl
          --ps = divideLine (zoneSize * 2) a b
          ps = divideLine (zoneSize * 2) a b
-      in  map (\(x,y) -> wl {_wlLine = (x,y)}) $ zip (init ps) (tail ps)
+      in  zipWith (\ x y -> wl & wlLine .~ (x,y) ) (init ps) (tail ps)
 divideWallIn :: Wall -> IM.IntMap Wall -> IM.IntMap Wall
 divideWallIn wl wls = 
@@ -130,7 +130,7 @@ shiftRoomTreeConstruction (Node t ts) = (Node t [] :) $ concat $
    (_rmLinks t) 
    ts
  where 
-    f r = shiftRoomBy ((0,0) -.- (rotateV (pi-a) p),0) $ shiftRoomBy ((0,0),pi-a)  r
+    f r = shiftRoomBy ( (0,0) -.- rotateV (pi-a) p , 0) $ shiftRoomBy ((0,0),pi-a)  r
      where 
        (p,a) = last $ _rmLinks r
@@ -1,4 +1,3 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE FlexibleInstances #-}
 -- | deals with placement of objects within the world
 -- after they have had their coordinates set by the layout
@@ -8,9 +7,7 @@ module Dodge.LevelGen
    , pairsToGraph
    , makeButton
    , makeSwitch
-    )
+    ) where
    where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Room.Data
@@ -29,22 +26,24 @@ import System.Random
 import Control.Monad.State
 import Control.Applicative
 import Control.Lens
-import Data.List
+import Data.List.Extra
 import Data.Function
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified Data.Map as M
 placeSpots :: [Placement] -> World -> World
-placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements
+placeSpots pss w = foldr (placeSpot . _placementSpot) w' singlePlacements
  where
    (singlePlacements, groupedPlacements) = partition isSPS pss
-    isSPS (SinglePlacement {}) = True
+    isSPS SinglePlacement{} = True
    isSPS _ = False
-    gplmnts = groupBy ((==) `on` _groupPlacementID) $ sortOn _groupPlacementID groupedPlacements
+    gplmnts :: [[Placement]]
-    w' = foldr updateGroup w gplmnts
+    gplmnts = groupOn _groupPlacementID $ sortOn _groupPlacementID groupedPlacements
    w' = foldr putGroup w gplmnts
    putGroup :: [Placement] -> World -> World
    putGroup gps w = (_groupUpdate $ head gps) w gps
 {- | OK, this is perhaps slightly impenetrable.
 - The idea is that for a list of collected group placements, we first update
@@ -53,20 +52,20 @@ placeSpots pss w = foldr placeSpot w' $ map _placementSpot singlePlacements
 - After this, for each placement we apply the group placement function to
 - the psType using a zipWith, and taking all the pstypes as a paramenter,
 - then successively update the world using a foldr. -}
-updateGroup :: [Placement] -> World -> World
+--updateGroup :: [Placement] -> World -> World
-updateGroup ps w =
+--updateGroup ps w =
-    let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
+--    let (w', psTypes) = mapAccumR updateSpot w $ map _placementSpot ps
-        fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
+--        fs = zipWith (\gp pst -> _groupPlacementFunc gp psTypes pst) ps psTypes
-    in foldr ($) w' fs
+--    in foldr ($) w' fs
-    
+--{- | -}
-updateSpot :: World -> PlacementSpot -> (World, PSType)
+--updateSpot :: World -> PlacementSpot -> (World, PSType)
-updateSpot w ps = case _psType ps of
+--updateSpot w ps = case _psType ps of
-    PutButton bt -> undefined
+--    PutButton bt -> undefined
-    PutCrit cr -> placeUpdateCr cr p rot w
+--    PutCrit cr -> placeUpdateCr cr p rot w
-  where
+--  where
-    p = _psPos ps
+--    p = _psPos ps
-    rot = _psRot ps
+--    rot = _psRot ps
-
+{- | -}    
 placeSpot :: PlacementSpot -> World -> World
 placeSpot ps w = case _psType ps of
    PutButton bt -> placeBt bt p rot w
@@ -134,7 +133,7 @@ addPane wl (p0,p1) wls = IM.insert (newKey wls) (wl
    })
    wls
-placeBt bt p rot w = over buttons addBT w
+placeBt bt p rot = over buttons addBT
  where 
    addBT bts = IM.insert (newKey bts) (bt {_btPos = p, _btRot = rot, _btID = newKey bts}) bts
 {- Creates a floor item at a given point.
@@ -155,7 +154,7 @@ placeFlIt itm p rot = floorItems %~
            }
        ) fis
-placePressPlate pp p rot w = over pressPlates addPP w
+placePressPlate pp p rot = over pressPlates addPP
  where 
    addPP pps = IM.insert (newKey pps) (pp {_ppPos = p,_ppRot = rot}) pps
@@ -166,20 +165,21 @@ placeUpdateCr scr p rot w = (w & creatures %~ IM.insert cid cr, PutCrit cr)
    cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid} 
 placeCr :: Creature -> Point2 -> Float -> World -> World
-placeCr crF p rot w = over creatures addCr w
+placeCr crF p rot = over creatures addCr
  where 
-    addCr crs = IM.insert (newKey crs) 
+    addCr crs = IM.insert 
        (newKey crs) 
        (crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs}) 
        crs
 placeLS :: LightSource -> Picture -> Point2 -> Float -> World -> World
-placeLS ls dec p rot w = over lightSources addLS 
+placeLS ls dec p rot w = over lightSources addLS $ over decorations addDec w
-                            $ over decorations addDec w
+  where 
-    where addLS lss = IM.insert (newKey lss) 
+    addLS lss = IM.insert 
        (newKey lss) 
        (ls {_lsPos = p,_lsDir = rot,_lsID = newKey lss}) 
        lss
-          addDec decs = IM.insert (newKey decs) 
+    addDec decs = IM.insert 
-                                  (uncurry translate p $ rotate (0 - rot) dec)
+        (newKey decs) 
        (uncurry translate p $ rotate (negate rot) dec)
        decs
@@ -8,7 +8,6 @@ import Picture
 import Control.Lens
 import Control.Monad.State
 import System.Random
 data PSType = PutCrit {_unPutCrit :: Creature}
    | PutLS LightSource Picture
    | PutButton Button
@@ -34,12 +33,13 @@ data Placement
    = SinglePlacement {_placementSpot :: PlacementSpot }
    | GroupedPlacement
        {_groupPlacementID :: Int
-        ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
+--        ,_groupPlacementUpdate :: World -> Placement -> (World, Placement)
        ,_groupUpdate :: World -> [Placement] -> World
 --        ,_groupPlacementFunc :: [PSType] -> PSType -> World -> World
        ,_placementSpot :: PlacementSpot
        }
-        
+sPS :: Point2 -> Float -> PSType -> Placement
 sPS p a = SinglePlacement . PS p a
 makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement
@@ -3,23 +3,54 @@ module Dodge.LevelGen.SwarmPlacement
    )
    where
 import Dodge.Data
 import Dodge.Base
 import Dodge.LevelGen.Data
 import Dodge.Creature.State.Data
 import Geometry
 import Data.List
 import qualified Data.IntSet as IS
 import qualified Data.IntMap as IM
 import Control.Lens
 swarmPS :: Int -> Point2 -> Float -> Creature -> Placement
 swarmPS i p a cr = GroupedPlacement
    { _groupPlacementID = i
-    , _groupPlacementFunc = setSwarm
+    , _groupUpdate = setSwarm
 --    , _groupPlacementFunc = setSwarm i
    , _placementSpot = PS p a $ PutCrit cr
    }
-
+setSwarm :: World -> [Placement] -> World
-setSwarm :: [PSType] -> PSType -> World -> World
+setSwarm w ps = updateCrs w' & creatureGroups %~ IM.insert gid theGroupParams
 setSwarm psts (PutCrit cr) w
    = w & creatures . ix cid . crGroup .~ theSwarm
  where
-    cid = _crID cr
+    (w', crs) = mapAccumR updateCrit w ps
-    theSwarm = Swarm swarmSet
+    is = IS.fromList $ map _crID crs
-    swarmSet = IS.fromList $ map (_crID . _unPutCrit) psts
+    cpos = centroid $ map _crPos crs
    gid = newKey (_creatureGroups w')
    theGroupParams = CrGroupParams
        { _crGroupParamID = gid
        , _crGroupIDs = is
        , _crGroupCenter = cpos
        , _crGroupUpdate = crGroupUpdateCenter
        }
    updateCrs w'' = IS.foldl' (\w''' cid -> w''' & creatures . ix cid %~ setSwarmStatus) w'' is
    setSwarmStatus = crGroup .~ Swarm {_swarm = is, _crGroupID = gid}
 crGroupUpdateCenter :: World -> CrGroupParams -> Maybe CrGroupParams
 crGroupUpdateCenter w cgp 
    | IM.null crs = Nothing
    | otherwise = Just $ cgp & crGroupCenter .~
        centroid (IM.map _crPos crs)
  where
    crs = IM.restrictKeys (_creatures w) (_crGroupIDs cgp)
 updateCrit :: World -> Placement -> (World, Creature)
 updateCrit w pl = (w & creatures %~ IM.insert cid cr
    , cr
    )
  where 
    p = _psPos $ _placementSpot pl
    rot = _psRot $ _placementSpot pl
    scr = _unPutCrit $ _psType $ _placementSpot pl
    cid = newKey (_creatures w)
    cr = scr {_crPos = p,_crOldPos = p,_crDir = rot,_crID = cid} 
@@ -50,4 +50,4 @@ tLightRad i rmax rmin p = TLS
    , _tlsUpdate = \w _ -> (w, Just $ tLightRad (i-1) rmax rmin p)
    }
-tLightAt i p = tLightRad i 100 0 p
+tLightAt i = tLightRad i 100 0
@@ -1,17 +1,13 @@
 module Dodge.LoadSound where
 -- imports {{{
 import Dodge.Data
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 import qualified Data.Map as M
 import Control.Monad
 import Control.Lens
 import qualified SDL.Mixer as Mix
 -- }}}
 loadSounds :: IO (IM.IntMap Mix.Chunk)
 loadSounds = do
    Mix.openAudio Mix.defaultAudio 128
@@ -57,7 +53,7 @@ loadSounds = do
    glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav" 
    glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav" 
    foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav" 
-    return $ IM.fromList $ zip [0..] $ 
+    return $ IM.fromList $ zip [0..]
        [ pFireSound
        , click
        , reloadSound'
@@ -105,6 +101,6 @@ loadSounds = do
 loadMusic :: IO (IM.IntMap Mix.Music)
 loadMusic = do
    undercity <- Mix.load "./data/music/firstCompo.mid"
-    return $ IM.fromList $ zip [0..] $
+    return $ IM.fromList $ zip [0..]
        [ undercity
        ]
@@ -41,31 +41,24 @@ type SearchedNodes = (HP.MinHeap (Float,(Float,[Point2])), [Point2])
 stripRight :: Either a b -> b
 stripRight (Right x) = x
-stepPath :: (Point2 -> [Point2]) -> Point2 
+stepPath :: (Point2 -> [Point2]) -> Point2 -> SearchedNodes -> Either [Point2] SearchedNodes
-            -> SearchedNodes -> Either [Point2] SearchedNodes
+stepPath f p (nextNodes, seenNodes) = case HP.view nextNodes of
 stepPath f p (nextNodes, seenNodes)
    = case HP.view nextNodes of
    Nothing -> Left []
-            Just ((_,(cost,(q:qs))), nextNodes') 
+    Just ((_,(cost,q:qs)), nextNodes') 
        | q == p -> Left (q:qs)
-                | otherwise -> let rs' = f q
+        | otherwise -> 
            let rs' = f q
                rs = rs' \\ seenNodes
-                                   newNodes = map (\r -> (cost + dist q r + dist r p
+                newNodes = map (\r -> (cost + dist q r + dist r p , (cost + dist q r , r:q:qs))) rs
-                                                         ,  (cost + dist q r
+            in  Right (foldr HP.insert nextNodes' newNodes , rs ++ seenNodes)
-                                                            , (r:q:qs)
+
-                                                            )
+stepPath' :: (Point2 -> [Point2]) -> Point2 -> SearchedNodes -> [Point2]
-                                                         )
+stepPath' f p s = case stepPath f p s of 
-                                                  ) rs
+    Left ps -> ps
                               in  Right $ (foldr HP.insert nextNodes' newNodes
                                           , rs ++ seenNodes
                                           )
 stepPath' :: (Point2 -> [Point2]) -> Point2 
            -> SearchedNodes -> [Point2]
 stepPath' f p s = case stepPath f p s of Left ps -> ps
    Right s' -> stepPath' f p s'
 makePath' :: (Point2 -> [Point2]) -> Point2 -> Point2 -> [Point2]
-makePath' f s e = stepPath' f e $ (HP.singleton (0,(0,[s])) , [])
+makePath' f s e = stepPath' f e (HP.singleton (0,(0,[s])) , [])
 makeNode :: Point2 -> SearchedNodes
 makeNode e = (HP.singleton (0,(0,[e])) , [])
@@ -76,39 +69,36 @@ tp1 = (0,1)
 tp2 = (0,20)
 tp3 = (30,40)
-f = incidenceToFunction $ pairsToIncidence [(tp1,tp2),(tp2,tp3)
+f = incidenceToFunction $ pairsToIncidence 
    [(tp1,tp2)
    ,(tp2,tp3)
    ,(tp2,tp1)
-                                           ,(tp1,tp3)]
+    ,(tp1,tp3)
-g = pairsToIncidence [(tp1,tp2),(tp2,tp3)
+    ]
 g = pairsToIncidence 
    [(tp1,tp2)
    ,(tp2,tp3)
    ,(tp2,tp1)
-                                           ,(tp1,tp3)]
+    ,(tp1,tp3)
    ]
 pathBetween :: Point2 -> Point2 -> World -> Maybe [Point2]
-pathBetween a b w = makePath' <$> return (\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)
    nsb = map snd $ concat $ lookLookups (zoneAroundPoint b) (_pathPoints w)
-          --a' = listToMaybe $ sortBy (compare `on` dist a) $ ns
+    a' = find (flip (isWalkable a) w)  nsa
-          --b' = listToMaybe $ sortBy (compare `on` dist b) $ ns
+    b' = find (flip (isWalkable b) w)  nsb
          a' = listToMaybe $ filter (flip (isWalkable a) w)  nsa
          b' = listToMaybe $ filter (flip (isWalkable b) w)  nsb
 ----
 makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int]
 makePathBetween a b w =  join $ sp <$> fmap fst a' <*> fmap fst b' <*> return g
-    where g  = _pathGraph w
+  where
    g  = _pathGraph w
    nsa = concat $ lookLookups (zoneAroundPoint a) (_pathPoints w)
    nsb = concat $ lookLookups (zoneAroundPoint b) (_pathPoints w)
--          a' = listToMaybe $ sortBy (compare `on` dist a . snd) $ filter (flip (isWalkable a) w . snd) ns
+    a' = find (flip (isWalkable a) w . snd) nsa
--          b' = listToMaybe $ sortBy (compare `on` dist b . snd) $ filter (flip (isWalkable b) w . snd) ns
+    b' = find (flip (isWalkable b) w . snd) nsb
          a' = listToMaybe $ filter (flip (isWalkable a) w . snd) nsa
          b' = listToMaybe $ filter (flip (isWalkable b) w . snd) nsb
 ezipWith :: Monoid a => (b -> c -> d) -> Either a b -> Either a c -> Either a d
 ezipWith f (Right x) (Right y) = Right (f x y)
@@ -116,46 +106,38 @@ ezipWith f (Left  x) (Right _) = Left x
 ezipWith f (Right _) (Left  y) = Left y
 ezipWith f (Left  x) (Left  y) = Left (mappend x y)
 makePathBetween' :: Point2 -> Point2 -> World -> Either String [Int]
-makePathBetween' a b w = let g  = _pathGraph w
+makePathBetween' a b w = 
    let g  = _pathGraph w
        ns = labNodes g
-                             nsa = (_pathPoints w) `ixNZ` a
+        nsa = _pathPoints w `ixNZ` a
-                             nsb = (_pathPoints w) `ixNZ` b
+        nsb = _pathPoints w `ixNZ` b
-                             a' = case listToMaybe $ sortBy (compare `on` dist a . snd) 
+        a' = case listToMaybe $ sortBy (compare `on` dist a . snd) $ filter (flip (isWalkable a) w . snd) ns of
                --             a' = case listToMaybe 
                                                   $ filter (flip (isWalkable a) w . snd) ns of
            Just p -> Right $ fst p
            _      -> Left "FIRST POINT UNSEEN"
-                             b' = case listToMaybe $ sortBy (compare `on` dist b . snd) 
+        b' = case listToMaybe $ sortBy (compare `on` dist b . snd) $ filter (flip (isWalkable b) w . snd) ns of
                --             b' = case listToMaybe 
                                                   $ filter (flip (isWalkable b) w . snd) ns of
            Just p -> Right $ fst p
            _      -> Left $ "SECOND POINT UNSEEN" ++ show b
    in case ezipWith (\x y -> sp x y g) a' b' of
            Right (Just xs) -> Right xs
-                                        Right (Nothing) -> Left $ "NO PATH" ++ show a ++ show b ++ show a' ++ show b'
+            Right Nothing   -> Left $ "NO PATH" ++ show a ++ show b ++ show a' ++ show b'
            Left m          -> Left m
 makePathBetweenPs :: Point2 -> Point2 -> World -> Maybe [Point2]
--makePathBetweenPs a b = pathBetween a b
+makePathBetweenPs a b w = mapMaybe (lab g) <$> makePathBetween b a w
-makePathBetweenPs a b w =  fmap (mapMaybe (lab g)) $ makePathBetween b a w
+  where 
-    where g  = _pathGraph w
+    g  = _pathGraph w
 makePathBetweenPs' :: Point2 -> Point2 -> World -> Either String [Point2]
-makePathBetweenPs' a b w =  fmap (mapMaybe (lab g)) $ makePathBetween' a b w
+makePathBetweenPs' a b w = mapMaybe (lab g) <$> makePathBetween' a b w
-    where g  = _pathGraph w
+  where 
-
+    g  = _pathGraph w
 pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
-pointTowardsImpulse a b w = join $ fmap (listToMaybe . filter (flip (isWalkable a) w))
+pointTowardsImpulse a b w = find (flip (isWalkable a) w) =<< makePathBetweenPs a b w
 --                              $ pathBetween a b w
                                $ makePathBetweenPs a b w
 --
 pointTowardsImpulse' :: Point2 -> Point2 -> World -> Either String Point2
-pointTowardsImpulse' a b w = join $ fmap (maybeToEither "NOSEEPATH" . listToMaybe . filter (flip (isWalkable a) w))
+pointTowardsImpulse' a b w = (maybeToEither "NOSEEPATH" . find (flip (isWalkable a) w)) =<< makePathBetweenPs' b a w
                               $ makePathBetweenPs' b a w
 maybeToEither :: a -> Maybe b -> Either a b
 maybeToEither _ (Just x) = Right x
@@ -12,7 +12,7 @@ import Data.List
 randomRanges :: (Random a,RandomGen g) => [a] -> State g a
 randomRanges xs = join $ takeOne $ f xs
  where 
-    f (x:y:ys) = (state (randomR (x,y))) : (f ys)
+    f (x:y:ys) = state (randomR (x,y)) : f ys
    f  _ = []
 takeOne :: RandomGen g => [a] -> State g a
@@ -20,7 +20,7 @@ takeOne xs = state (randomR (0,length xs - 1)) >>= (\i -> return (xs !! i))
 takeOneWeighted :: (RandomGen g, Random b, Ord b, Num b) => [b] -> [a] -> State g a
 takeOneWeighted ws xs = state (randomR (0, sum ws))
-                            >>= (\w -> return (xs !! (i w ws)))
+                            >>= (\w -> return (xs !! i w ws))
  where 
    i y (z:zs) 
        | y <= z = 0
@@ -35,11 +35,11 @@ takeOneMore (xs,ys) = do
    return (w:xs, zs ++ ws)
 takeNMore :: RandomGen g => Int -> ([a],[a]) -> State g ([a],[a])
-takeNMore n p = foldr (const ((=<<) takeOneMore)) (return p) [1..n]
+takeNMore n p = foldr (const (>>= takeOneMore)) (return p) [1..n]
 takeN :: RandomGen g => Int -> [a] -> State g [a]
 takeN 0 xs = return []
-takeN i xs = fmap fst $ takeNMore i ([],xs)
+takeN i xs = fst <$> takeNMore i ([],xs)
 -- | Randomly shuffle a list.
 shuffle :: RandomGen g => [a] -> State g [a]
@@ -38,7 +38,7 @@ import qualified SDL
 Central drawing function.
 Returns a 'Word32' that should give the number of ticks it took to evaluate.
 -}
-doDrawing :: RenderData -> World -> IO (Word32)
+doDrawing :: RenderData -> World -> IO Word32
 doDrawing pdata w = do
    sTicks <- SDL.ticks
    clear [ColorBuffer,DepthBuffer]
@@ -169,8 +169,10 @@ ffToDraw w = filter (lineOnScreen w . _ffLine) $
                _forceFields w
 drawFF :: ForceField -> Picture
-drawFF (FF {_ffLine = l, _ffColor = col}) = pictures [color white $ line l, color col 
+drawFF FF{_ffLine = l, _ffColor = col} = pictures 
-                                                        $ lineOfThickness 6 l ]
+    [color white $ line l
    , color col $ lineOfThickness 6 l 
    ]
 drawFFShadow :: World -> ForceField -> [Picture]
 drawFFShadow w ff
@@ -84,10 +84,8 @@ roomPillars = over rmLinks init $ set rmPS plmnts $ roomRect 240 240 2 2
    f a x b y = putBlockRect a x b y
    g a b c d = f a b a b ++ f a b c d ++ f c d a b ++ f c d c d
 branchWith :: Room -> [Tree Room] -> Tree (Either Room Room)
-branchWith r ts = Node (Left r) $ [return $ Right door] ++ fmap (fmap Left) ts
+branchWith r ts = Node (Left r) $ return (Right door) : fmap (fmap Left) ts
 glassSwitchBack :: RandomGen g => State g Room
 glassSwitchBack = do
@@ -95,7 +93,8 @@ glassSwitchBack = do
    hgt <- state $ randomR (400,600)
    wllen <- state $ randomR (60,wth/2-40)
    let hf = hgt/5
-    let plmnts = [windowLine (wth-60,     hf) (wllen,hf)
+    let plmnts = 
            [windowLine (wth-60,     hf) (wllen,hf)
            ,windowLine (wth-wllen,2*hf) (60,   2*hf)
            ,windowLine (wth-60,   3*hf) (wllen,3*hf)
            ,windowLine (wth-wllen,4*hf) (60,   4*hf)
@@ -103,7 +102,7 @@ glassSwitchBack = do
            ,blockLine (wth-wllen, 2*hf) (  wth,2*hf)
            ,blockLine (        0, 3*hf) (wllen,3*hf)
            ,blockLine (wth-wllen, 4*hf) (  wth,4*hf)
-                 , sPS (wth/2,hgt/2) 0 $ putLamp
+            , sPS (wth/2,hgt/2) 0 putLamp
            ]
    return $ set rmPS plmnts $ roomRect wth hgt 2 6
@@ -112,19 +111,19 @@ manyDoors i = treeFromPost (replicate i (Left door)) $ Right door
 glassLesson :: RandomGen g => State g (Tree (Either Room Room))
 glassLesson = do
-    corridors <- sequence $ replicate 3 $ fmap Left $ randomiseOutLinks corridor
+    corridors <- replicateM 3 $ Left <$> randomiseOutLinks corridor
-    return $ Node (Left $ botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
+    return $ Node (Left botRoom) [deadRoom door,uppers, treeFromPost (Left door : corridors) $ Right door]
-        where uppers = Node (Left door) [deadRoom topRoom]
+  where 
-              botRoom = set rmPS botplmnts 
+    uppers = Node (Left door) [deadRoom topRoom]
-                                 $ roomRect 200 200 1 1
+    botRoom = set rmPS botplmnts $ roomRect 200 200 1 1
-              topRoom = set rmPS topplmnts 
+    topRoom = set rmPS topplmnts $ roomRect 200 200 1 1
-                                 $ roomRect 200 200 1 1
+    botplmnts = 
-              botplmnts = [sPS (0,0) 0 $ PutWall (rectNSWE (200) 0 (90) (110)) 
+        [sPS    (0,0) 0 $ PutWall (rectNSWE 200 0 90 110) defaultCrystalWall
                                      $ defaultCrystalWall
        ,sPS (50,100) 0 $ PutCrit miniGunCrit
        ,sPS  (50,50) 0 putLamp
        ]
-              topplmnts = [windowLine (100,200) (100,0) 
+    topplmnts = 
        [windowLine (100,200) (100,0) 
        ,sPS (50,100) 0 $ PutCrit miniGunCrit
        ,sPS (50,50) 0 putLamp
        ]
@@ -145,7 +144,7 @@ miniRoom1 = do
                     ,windowLine (wth-60,   40+3*hf) (wllen,40+3*hf)
                     ,windowLine (wth-wllen,40+4*hf) (60,40+4*hf)
                     ,sPS (crx,cry) 0 $ PutCrit miniGunCrit
-                     ,sPS (wth-20,hgt/2+40) 0 $ randC
+                     ,sPS (wth-20,hgt/2+40) 0 randC
                     ,sPS (wth/2,hgt/2) 0 putLamp
                     ,blockLine (        0, 40+1*hf) (wllen,40+1*hf)
                     ,blockLine (wth-wllen, 40+2*hf) (  wth,40+2*hf)
@@ -155,9 +154,10 @@ miniRoom1 = do
        return $ set rmPS plmnts $ shiftRoomBy ((0,40),0) $ roomRect wth hgt 2 4
 miniTree2 :: RandomGen g => State g (Tree (Either Room Room))
-miniTree2 = miniRoom1 >>= randomiseOutLinks >>= changeLinkTo (\p -> (snd . fst) p < 70) 
+miniTree2 = miniRoom1 
-                         >>= return . flip branchWith (replicate 3 $ treeFromPost [door,corridor] 
+    >>= randomiseOutLinks 
-                                                                              critInDeadEnd   )
+    >>= changeLinkTo (\p -> (snd . fst) p < 70) 
    <&> flip branchWith (replicate 3 $ treeFromPost [door,corridor] critInDeadEnd)
 miniRoom3 :: RandomGen g => State g (Tree (Either Room Room))
 miniRoom3 = do
@@ -200,7 +200,7 @@ roomMiniIntro = fmap (g . expandTreeBy f) $ sequence $ treeFromPost
    [return $ connectRoom door
    ,join $ takeOne [miniTree2,glassLesson]
    ]
-    $ fmap connectRoom $ randomiseOutLinks corridor
+    $ connectRoom <$> randomiseOutLinks corridor
  where 
    f (Node (Right x) xs) = Node (Right (Right x)) $ map f xs
    f (Node (Left x) xs) = Node (Left (Left x)) $ map f xs
@@ -245,7 +245,7 @@ allPairs xs = [(x,y) | x <- xs, y <- xs, x /= y]
 randomCorridorFrom :: RandomGen g => [a] -> State g (Tree (Either a a))
 randomCorridorFrom xs = do
-    rooms <- sequence $ replicate 5 $ takeOne xs
+    rooms <- replicateM 5 $ takeOne xs
    return $ treeFromTrunk (map Left $ init rooms) (Node (Right (last rooms)) [])
 {- Probabilites of the type of the first floor weapon.  -}
 randFirstWeapon :: State StdGen PSType
@@ -264,23 +264,25 @@ weaponEmptyRoom :: RandomGen g => State g (Tree (Either Room Room))
 weaponEmptyRoom = do
    w <- state $ randomR (220,300)
    h <- state $ randomR (220,300)
-    let plmnts = [sPS (w/2,h-40) 0 $ RandPS randFirstWeapon
+    let plmnts = 
-                 ,sPS (20,20) (pi/2) $ randC1
+            [sPS (w/2,h-40)     0 $ RandPS randFirstWeapon
-                 ,sPS (w-20,20) (pi/2) $ randC1
+            ,sPS   (20,20) (pi/2) randC1
-                 ,sPS (w/2,h/2) 0 $ putLamp
+            ,sPS (w-20,20) (pi/2) randC1
            ,sPS (w/2,h/2)      0 putLamp
            ]
-    (fmap connectRoom . randomiseOutLinks) =<< (changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) 
+    (fmap connectRoom . randomiseOutLinks) =<< 
-                        $ set rmPS plmnts $ roomRect w h 2 2)
+        changeLinkTo ((\p -> dist p (w/2,0) < 10) . fst) (set rmPS plmnts $ roomRect w h 2 2)
 weaponUnderCrits :: RandomGen g => State g (Tree (Either Room Room))
 weaponUnderCrits = do
    let plmnts = 
            [sPS (20,0)   0 $ RandPS randFirstWeapon
-            ,sPS (20,0) (0-pi/2) $ randC1
+            ,sPS (20,0)  (negate $ pi/2) randC1
-            ,sPS (20,20) (0-pi/2) $ randC1
+            ,sPS (20,20) (negate $ pi/2) randC1
            ]
-    let continuationRoom = treeFromTrunk [Left corridorN,Left corridorN] 
+    let continuationRoom = treeFromTrunk 
-                                     (connectRoom (set rmPS plmnts $ corridorN))
+            [Left corridorN,Left corridorN] 
            (connectRoom (set rmPS plmnts corridorN))
    rcp' <- roomCenterPillar
    let rcp = over rmPS ( sPS (120,80) 0 putLamp : ) rcp'
    deadEndRoom <- takeOne [roomPillars,rcp]
@@ -295,14 +297,16 @@ weaponBehindPillar :: RandomGen g => State g (Tree (Either Room Room))
 weaponBehindPillar  = do
      crPos <- takeOne $ [(x,y) | x <- [20,220], y <- [20,220]] ++ [(120,160),(120,200)]
      let d p = argV $ (120,80) -.- p
-      let plmnts1 = [sPS (120,160)  0 $ RandPS randFirstWeapon
+      let plmnts1 = 
-                    ,sPS crPos (d crPos) $ randC1
+            [sPS (120,160)  0 $ RandPS randFirstWeapon
            ,sPS crPos (d crPos) randC1
            ]
      rcp <- roomCenterPillar
-      return $ treeFromTrunk [Left door
+      return $ treeFromTrunk 
-                         ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp]
+        [Left door
-                         (connectRoom $ set rmPS [sPS (20,60) (0-pi/2) $ randC1]
+        ,Left $ over rmLinks tail $ over rmPS (++ plmnts1) rcp
-                                                  $ corridorN)
+        ]
        (connectRoom $ set rmPS [sPS (20,60) (negate $ pi/2) randC1] corridorN)
 weaponBetweenPillars :: RandomGen g => State g (Tree (Either Room Room))
 weaponBetweenPillars = do
@@ -313,34 +317,31 @@ weaponBetweenPillars = do
        d p = argV $ (120,120) -.- p
        plmnts = 
            [sPS wpPos 0 $ RandPS randFirstWeapon
-            ,sPS crPos1 (d crPos1) $ randC1
+            ,sPS crPos1 (d crPos1) randC1
-            ,sPS crPos2 (d crPos2) $ randC1
+            ,sPS crPos2 (d crPos2) randC1
            ]
-    (fmap connectRoom . randomiseOutLinks) =<< (filterLinks f $ over rmPS (++plmnts) $ roomPillars)
+    (fmap connectRoom . randomiseOutLinks) =<< filterLinks f (over rmPS (++plmnts) roomPillars)
  where 
    f (_,a) = a == 0
 weaponLongCorridor :: RandomGen g => State g (Tree (Either Room Room))
 weaponLongCorridor = do
-    root <- takeOne $ [tEast, tWest]
+    root <- takeOne [tEast, tWest]
    connectingRoom <- takeOne 
-        [tEast & rmPS .~ [sPS (-40,60) 0 $ putLamp]
+        [tEast & rmPS .~ [sPS (-40,60) 0 putLamp]
-        ,tWest & rmPS .~ [sPS ( 40,60) 0 $ putLamp]
+        ,tWest & rmPS .~ [sPS ( 40,60) 0 putLamp]
        ]
    i1 <- state $ randomR (2,5)
    i2 <- state $ randomR (2,5)
    let branch1 = treeFromTrunk (replicate i1 $ Left corridorN) (connectRoom $ putCrs connectingRoom)
    let branch2 = treeFromTrunk (replicate i2 $ Left corridorN) (deadRoom $ putWp corridor)
    return $ Node (Left root) [branch1,branch2]
-        where putCrs = over rmPS (++ [sPS (10,40) (-pi/2) $ randC
+      where 
-                                 ,sPS (-10,40) (-pi/2) $ randC
+        putCrs = over rmPS (++ [sPS (10,40) (-pi/2) randC ,sPS (-10,40) (-pi/2) randC ])
-                                 ])
+        putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon ,sPS (20,60) 0 putLamp ]
              putWp = set rmPS [sPS (20,40) 0 $ RandPS randFirstWeapon
                               ,sPS (20,60) 0 $ putLamp
                               ]
 critInDeadEnd :: Room
-critInDeadEnd = set rmPS [sPS (0,0) 0 $ randC] deadEndRoom
+critInDeadEnd = set rmPS [sPS (0,0) 0 randC] deadEndRoom
 deadEndRoom :: Room
 deadEndRoom = Room
@@ -365,8 +366,8 @@ weaponRoom = join $ takeOne
 roomCCrits :: RandomGen g => State g (Tree (Either Room Room))
 roomCCrits = do
-    ps <- sequence $ replicate 20 $ randInCirc 9
+    ps <- replicateM 20 $ randInCirc 9
-    let plmnts = map (\p -> sPS p 0 $ randC) 
+    let plmnts = map (\p -> sPS p 0 randC) 
                       $ zipWith (+.+) [(x,y) | x<-[110,130,150,170,190], y<- [70,90,110,130,150]] ps
        lamps = [sPS (50,100) 0 putLamp , sPS (175,100) 0 putLamp]
    return $ connectRoom $ over rmPS ((lamps ++) . (plmnts ++)) $ roomC 200 200
@@ -384,28 +385,26 @@ longRoom = do
                    ,rectNSWE (h-35) (h-135) 65 85
                    ]
    let wsDefense = map (\ps -> sPS (0,0) 0 $ PutWall ps defaultCrystalWall)
-                    [rectNSWE (95) (70)  0 25
+                    [rectNSWE 95 70  0 25
-                    ,rectNSWE (95) (70) 50 75
+                    ,rectNSWE 95 70 50 75
                    ]
    brls <- fmap (map (\p -> sPS (p +.+ (10,200)) 0 $ PutCrit explosiveBarrel) )
-                            $ sequence $ replicate 5 $ randInRect (w-20) 900
+                            $ replicateM 5 $ randInRect (w-20) 900
    let rm = roomRect w (h+70) 1 1 & rmPolys %~ ([rectNSWE h (h-165) (-45) (w+45)] ++)
-    changeLinkTo cond $ set rmPS (ws ++ brls ++ wsDefense ++
+    changeLinkTo cond $ rm & rmPS .~ ws ++ brls ++ wsDefense ++
        [sPS ( 12.5,h-25) 0 $ PutCrit longCrit
        ,sPS ( 37.5,h-25) 0 $ PutCrit longCrit
        ,sPS ( 62.5,h-25) 0 $ PutCrit longCrit
-                                 ,sPS ( 25, 20) 0 $ putLamp
+        ,sPS (   25,  20) 0 putLamp
-                                 ,sPS ( 25, h-10) 0 $ putLamp
+        ,sPS (   25,h-10) 0 putLamp
        ]
                                 )
                      $ rm
 shooterRoom :: RandomGen g => State g Room
 shooterRoom = do
    h <- state $ randomR (200,300)
    let cond x = (snd . fst) x < h - 40
-    changeLinkTo cond $ set rmPS ( [blockLine (50,50) (50,h)
+    changeLinkTo cond $ roomRect 100 h 1 1 & rmPS .~
        [blockLine (50,50) (50,h)
        ,sPS ( 25,h-25) 0 $ PutCrit $ addArmour autoCrit
        ,sPS ( 75,h-30) 0 $ PutCrit explosiveBarrel
        ,sPS ( 75,h-60) 0 $ PutCrit explosiveBarrel
@@ -413,9 +412,6 @@ shooterRoom = do
        ,sPS ( 85,h-45) 0 $ PutCrit explosiveBarrel
        ,sPS ( 75,h-80) 0 putLamp
        ]
                                 ) 
                      $ roomRect 100 h 1 1
 shootersRoom1 :: RandomGen g => State g Room
 shootersRoom1 = do
@@ -70,13 +70,13 @@ resumeSound w = w
 Consider replacing instances with 'soundOncePos'.
 -}
 soundOnce :: Int -> World -> World
-soundOnce i = over soundQueue ((:) (i,0))
+soundOnce i = soundQueue %~  ((i,0) : )
 {-| Play a sound with a given position in the world.
 Uses the angle between the given position and '_cameraViewFrom', taking into account '_cameraRot'.
 -}
 soundOncePos :: Int -> Point2 -> World -> World
-soundOncePos i pos w = over soundQueue ((:) (i,a)) w
+soundOncePos i pos w = w & soundQueue %~ ((i,a) :)
  where
    a = soundAngle pos w
@@ -88,7 +88,7 @@ soundOnceOrigin
    -> SoundOrigin  -- ^ The \"creator\" of the sound
    -> Point2       -- ^ The position of the sound in the world
    -> World -> World
-soundOnceOrigin sType so p w = over sounds (M.insertWith (flip const) so theSound) w
+soundOnceOrigin sType so p w = w & sounds %~ M.insertWith (\ _ x -> x) so theSound
  where 
    theSound = Sound 
        { _soundChunkID     = sType
@@ -141,7 +141,7 @@ soundFrom
    -> Int -- ^ Frames to play
    -> Int -- ^ Fade out time (ms)
    -> World -> World
-soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
+soundFrom so sType time fadeTime = sounds %~ M.insertWith f so sound
  where 
    sound = Sound 
        { _soundChunkID     = sType
@@ -9,7 +9,6 @@ import Dodge.Data
 import Dodge.Data.Menu
 import Dodge.World.Trigger.Data
 import Dodge.Config.Data
 import Dodge.Data.Menu
 import Dodge.Base
 import Dodge.WallCreatureCollisions
 import Dodge.LevelGen.Block
@@ -67,6 +66,7 @@ update' w = case _menuLayers w of
        . zoneClouds
        . updateClouds
        . updateCreatures 
        . updateCreatureGroups
        . updateBlocks
        . updateSeenWalls 
        . updateSoundQueue
@@ -84,6 +84,10 @@ update' w = case _menuLayers w of
        cid = _clID cr
    doubleArgumentFor f x = f x x
 updateCreatureGroups :: World -> World
 updateCreatureGroups w = w & creatureGroups %~ 
    IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)
 updateTriggers :: World -> World
 updateTriggers w 
    | ResetLevel 1 `S.member` _worldTriggers w = generateFromList levx $ initialWorld 
@@ -119,7 +123,7 @@ updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
 {- |
 Apply door mechanisms.  -}
 updateWalls :: World -> World
-updateWalls w = IM.foldr (maybe id id . (^? doorMech)) w (_walls w)
+updateWalls w = IM.foldr (fromMaybe id . (^? doorMech)) w (_walls w)
 ppEvents :: World -> World
 ppEvents w = IM.foldr (\pp w -> _ppEvent pp pp w) w $ _pressPlates w
@@ -158,8 +162,8 @@ moveCloud c w = _clEffect c c . theUpdate $ w
    oldPos = _clPos c
    newPos = oldPos +.+ newVel
    hitWl = collideCircWalls' oldPos newPos 5 $ wallsNearPoint newPos w
-    finalPos = fromMaybe newPos (fmap fst hitWl)
+    finalPos = maybe newPos fst hitWl
-    finalVel = fromMaybe newVel (fmap snd hitWl)
+    finalVel = maybe newVel snd hitWl
    theUpdate w' = w' 
        & clouds . ix (_clID c) . clTimer %~ (\t -> t - 1)
        & clouds . ix (_clID c) . clVel .~ finalVel
@@ -168,7 +172,7 @@ moveCloud c w = _clEffect c c . theUpdate $ w
 clClSpringVel :: Cloud -> World -> Cloud -> Point2 -> Point2
 clClSpringVel a w b v 
    | ida == idb = v
-    | dist pa pb < radDist = v +.+ 0.1 *.* (safeNormalizeV (pa -.- pb))
+    | dist pa pb < radDist = v +.+ 0.1 *.* safeNormalizeV (pa -.- pb)
    | otherwise = v
  where 
    ida = _clID a
@@ -181,7 +185,7 @@ simpleCrSprings :: World -> World
 simpleCrSprings w = IM.foldr' crSpring w $ _creatures w
 crSpring :: Creature -> World -> World
-crSpring c w = IM.foldr' (crCrSpring c) w $ cs
+crSpring c w = IM.foldr' (crCrSpring c) w cs
  where 
    cs = creaturesNearPoint (_crPos c) w
@@ -196,7 +200,7 @@ crCrSpring c1 c2 w
    id1  = _crID c1
    id2  = _crID c2
    vec  = _crPos c1 -.- _crPos c2
-    diff = magV $ vec
+    diff = magV vec
    comRad  = _crRad c1 + _crRad c2
    overlap1 = ((comRad - diff) * _crMass c2 * 0.5 / massT) *.* errorNormalizeV 55 vec
    overlap2 = ((comRad - diff) * _crMass c1 * 0.5 / massT) *.* errorNormalizeV 56 vec
@@ -27,7 +27,7 @@ colCrWall w c
    rad = _crRad c + wallBuffer
    p1  = _crOldPos c
    p2  = _crPos c
-    ls  = IM.elems $ fmap _wlLine $ wallsNearPoint p2 w
+    ls  = IM.elems $ _wlLine <$> wallsNearPoint p2 w
    wallPoints = nub $ concatMap (\(x,y) -> [x,y]) ls
 -- colCrPushThrough :: World -> Creature -> Creature
@@ -65,13 +65,13 @@ pushOrCrush :: [(Point2,Point2)] -> Creature -> Creature
 pushOrCrush wls cr = case mapMaybe (pushOutFromWall (_crRad cr) cpos) wls of
    []  -> cr
    [p] -> cr & crPos .~ p
-    _   -> cr & crState . crDamage %~ ( (Blunt 50 cpos cpos cpos) :)
+    _   -> cr & crState . crDamage %~ ( Blunt 50 cpos cpos cpos : )
  where
    cpos = _crPos cr
 -- assumes that the wall is orientated
 -- assumes wall points are different
-pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe (Point2)
+pushOutFromWall :: Float -> Point2 -> (Point2,Point2) -> Maybe Point2
 pushOutFromWall rad cp2 (wp1,wp2) 
    | isOnWall  = Just newP -- +.+ (1 *.* norm))
    | otherwise = Nothing
@@ -88,7 +88,7 @@ pushOutFromCorners :: World -> Creature -> Creature
 pushOutFromCorners w cr = cr & crPos .~ newPos
  where
    newPos = foldr (intersectCirclePoint (_crRad cr)) (_crPos cr) ls
-    ls  = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ fmap _wlLine $ wallsNearPoint (_crPos cr) w
+    ls  = nub . concatMap (\(x,y) -> [x,y]) . IM.elems $ _wlLine <$> wallsNearPoint (_crPos cr) w
 collideCorners :: Float -> Point2 -> [Point2] -> Point2 -> Point2
 collideCorners rad p1 ps p2 = foldr (intersectCirclePoint rad) p2 ps
@@ -103,7 +103,7 @@ checkPushThroughs :: Float -> Point2 -> [(Point2,Point2)] -> Point2 -> Point2
 checkPushThroughs rad cp1 walls cp2
    = fromMaybe cp2 $ (listToMaybe.mapMaybe (checkPushThrough rad cp1 cp2)) walls
-checkPushThrough :: Float -> Point2 -> Point2 -> (Point2,Point2) -> Maybe (Point2)
+checkPushThrough :: Float -> Point2 -> Point2 -> (Point2,Point2) -> Maybe Point2
 checkPushThrough  rad cp1 cp2 (wp1,wp2) 
    | isPushedThrough = intersectSegSeg' cp1 cp2 wp1 wp2
    | otherwise = Nothing
@@ -39,12 +39,12 @@ import Data.Function
 import Data.List
 import qualified Data.IntMap.Strict as IM
-createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
+createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World
-createBarrelSpark time colid pos dir maycid w = over worldEvents 
+createBarrelSpark pos dir maycid time colid w 
-                                        ((.) $ ( over particles ((:) spark) 
+    = over worldEvents (( over particles (spark :) . sparkFlashAt pos') . ) w
-                                               . sparkFlashAt pos')
+  where 
-                                        ) w
+    spark = Bul'  
-    where spark = Bul'  { _ptDraw = drawBul
+        { _ptDraw = drawBul
        , _ptUpdate' = mvGenBullet'
        , _btVel' = rotateV dir (5,0)
        , _btColor' = numColor colid
@@ -72,7 +72,7 @@ mvShockwave is w pt
    t    = _btTimer' pt
    tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
    rad = r - (3/4) * r * tFraction
-    dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
+    dams = over creatures (IM.map damCr) . flip (IM.foldr damageBlocks) hitBlocks
    hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
    damageBlocks wall w
      = case wall ^? blHP of 
@@ -17,17 +17,17 @@ left (DS (_,l,_)) = l
 right (DS (_,_,r)) = r
 pushL :: DS a -> DS a
-pushL (DS (x,xs,(y:ys))) = DS (y,(x:xs),ys)
+pushL (DS (x,xs, y:ys )) = DS (y, x:xs ,ys)
 pushL ds = ds
 pushR :: DS a -> DS a
-pushR (DS (y,(x:xs),ys)) = DS (x,xs,(y:ys))
+pushR (DS (y, x:xs ,ys)) = DS (x,xs, y:ys )
 pushR ds = ds
 cycleL :: DS a -> Maybe (DS a)
-cycleL (DS (x,xs,(y:ys))) = Just $ DS (y,(x:xs),ys)
+cycleL (DS (x,xs, y:ys )) = Just $ DS (y, x:xs ,ys)
 cycleL _ = Nothing
 cycleR :: DS a -> Maybe (DS a)
-cycleR (DS (y,(x:xs),ys)) = Just $ DS (x,xs,(y:ys))
+cycleR (DS (y, x:xs ,ys)) = Just $ DS (x,xs, y:ys )
 cycleR _ = Nothing
@@ -24,16 +24,13 @@ import Geometry.Vector
 import Data.Function
 import Data.List
 import Data.Maybe
 import Control.Applicative
 -- | Return a point a distance away from a first point towards a second point.
 -- Does not go past the second point.
 alongSegBy :: Float -> Point2 -> Point2 -> Point2
 alongSegBy !x !a !b = a +.+ y *.* normalizeV (b -.- a)
  where
    y = min x $ dist a b
 -- | Given a line and a point return the point on the line closest to the
 -- point.
 closestPointOnLine 
@@ -44,7 +41,6 @@ closestPointOnLine
 {-# INLINE closestPointOnLine #-}
 closestPointOnLine !a  !b  !p  = a +.+ u *.* (b -.- a)
  where u = closestPointOnLineParam a b p
 -- | Given a line and a point return a value corresponding to how far along the
 -- line the point is.
 closestPointOnLineParam 
@@ -55,36 +51,28 @@ closestPointOnLineParam
 {-# INLINE closestPointOnLineParam #-}
 closestPointOnLineParam !a !b !p
    = (p -.- a) `dotV` (b -.- a) / (b -.- a) `dotV` (b -.- a)
 -- | Draw a rectangle based on maximal N E S W values.
 rectNESW :: Float -> Float -> Float -> Float -> [Point2]
 rectNESW !a !b !c !d = [(b,a),(b,c),(d,c),(d,a) ]
 -- | Draw a rectangle based on maximal N S E W values.
 rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
 rectNSEW !n !s !e !w = rectNESW n e s w
 -- | Draw a rectangle based on maximal N S W E values.
 rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
 rectNSWE !n !s !w !e = [ (w,n), (w,s), (e,s), (e,n)]
-
+-- | Draw a rectangle around the origin with given height and width
 rectWdthHght :: Float -> Float -> [Point2]
 rectWdthHght w h = rectNSWE h (-h) (-w) w
 -- | Draw a rectangle around the origin with given height and width
 -- | Test whether a point is in a polygon or on the polygon border.
 -- Supposes the points in the
 -- polygon are listed in anticlockwise order.
 pointInOrOnPolygon :: Point2 -> [Point2] -> Bool
 pointInOrOnPolygon !p (x:xs) = all (\l -> not (uncurry isRHS l p)) $ zip (x:xs) (xs ++ [x])
 -- | Test whether a point is strictly inside a polygon.
 -- Supposes the points in the polygon are listed in anticlockwise order.
 pointInPolygon :: Point2 -> [Point2] -> Bool
 pointInPolygon !p [] = False
 pointInPolygon !p (x:xs) = all (\l -> uncurry (errorIsLHS 1) l p) $ zip (x:xs) (xs ++ [x])
 -- | Debug version of 'pointInPolygon'.
 errorPointInPolygon :: Int -> Point2 -> [Point2] -> Bool
 errorPointInPolygon !i !p xs 
@@ -92,36 +80,30 @@ errorPointInPolygon !i !p xs
    | length xs == 2 = error "two point polygon"
    | nub xs == xs = pointInPolygon p xs
    | otherwise = error $ "errorPointInPolygon "++ show i
 -- | Debug version of 'normalizeV'.
 errorNormalizeV :: Int -> Point2 -> Point2
 errorNormalizeV !i (0,0) = error $ "problem with function: errorNormalizeV "++show i
 errorNormalizeV !i !p = normalizeV p
 -- | Debug version of 'angleVV'.
 errorAngleVV :: Int -> Point2 -> Point2 -> Float
 errorAngleVV !i (0,0) _ = error $ "problem with function: errorAngleVV "++show i
 errorAngleVV !i _ (0,0) = error $ "problem with function: errorAngleVV "++show i
 errorAngleVV !i !p !p' = angleVV p p'
 -- | Debug version of 'isLHS'.
 errorIsLHS :: Int -> Point2 -> Point2 -> Point2 -> Bool
 errorIsLHS !i !x !y 
    | x == y = error $ "problem with function: errorIsLHS " ++show i
    | otherwise = isLHS x y
 -- | Debug version of 'closestPointOnLine'
 errorClosestPointOnLine :: Int -> Point2 -> Point2 -> Point2 -> Point2
 errorClosestPointOnLine !i !x !y 
    | x == y = error $ "problem with function: errorClosestPointOnLine " ++show i
    | otherwise = closestPointOnLine x y
 -- | Debug version of 'closestPointOnLineParam'
 errorClosestPointOnLineParam :: Int -> Point2 -> Point2 -> Point2 -> Float
 errorClosestPointOnLineParam  !i !x! y! z 
    | x == y    = dist x z
    | otherwise = closestPointOnLineParam  x y z
 -- | Test whether a point is on the LHS of a line.
 -- Returns False if the line is of zero length.
 isLHS 
@@ -141,7 +123,6 @@ isLHS
    a2 = y' - y
    b1 = x'' - x
    b2 = y'' - y
 -- | Test whether a point is on the LHS of a line.
 -- Returns False if the line is of zero length.
 isRHS 
@@ -161,14 +142,12 @@ isRHS
    a2 = y' - y
    b1 = x'' - x
    b2 = y'' - y
 -- | Reorder points to be anticlockwise around their center.
 orderPolygon :: [Point2] -> [Point2]
 orderPolygon [] = []
 orderPolygon ps = sortBy (compare `on` \p -> argV (p -.- cen)) ps
  where 
    cen = 1/ fromIntegral (length ps) *.* foldr1 (+.+) ps
 -- | Adds a point to a convex polygon.
 -- If the point is inside, returns the original.
 -- Points ordered anticlockwise, input not checked.
@@ -176,21 +155,17 @@ addPointPolygon :: Point2 -> [Point2] -> [Point2]
 addPointPolygon p ps
    | pointInOrOnPolygon p ps = ps
    | otherwise = orderPolygon $ p : ps
 -- | Creates the convex hull of a set of points.
 convexHull :: [Point2] -> [Point2]
-convexHull (x:y:z:xs) = foldr addPointPolygon (orderPolygon (x:y:z:[])) xs
+convexHull (x:y:z:xs) = foldr addPointPolygon (orderPolygon [x,y,z]) xs
 convexHull _ = error "Tried to create the convex hull of two or less points"
 -- | Return distance between two points.
 dist :: Point2 -> Point2 -> Float
 {-# INLINE dist #-}
 dist !p1 !p2 = magV (p2 -.- p1)
 -- | Return midpoint between two points.
 pHalf :: Point2 -> Point2 -> Point2
 pHalf !a !b = 0.5 *.* (a +.+ b)
 -- | Test whether a circle is on a segment by intersecting a new normal segment through the 
 -- center of the circle with the segment itself.
 -- Returns False if the circle center is beyond the enpoints of the
@@ -202,7 +177,6 @@ circOnSegNoEndpoints !p1 !p2 !c !rad = isJustTrue (fmap (\p -> magV (p -.- c) <
    y = intersectSegLine' p1 p2 c (c +.+ vNormal (p1 -.- p2))
    isJustTrue (Just True) = True
    isJustTrue _           = False
 -- | Test whether a circle is on a segment by intersecting a normal and testing
 -- the distance to the endpoints of the segment.
 circOnSeg :: Point2 -> Point2 -> Point2 -> Float -> Bool
@@ -213,29 +187,24 @@ circOnSeg !p1 !p2 !c !rad = magV (p1 -.- c) <= rad || magV (p2 -.- c) <= rad
    y = intersectSegLine' p1 p2 c (c +.+ vNormal (p1 -.- p2))
    isJustTrue (Just True) = True
    isJustTrue _           = False
 -- | Find the difference between two Nums.
 difference :: (Ord a, Num a) => a -> a -> a
 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.
 reflectIn :: Point2 -> Point2 -> Point2
-reflectIn line vec = 
+reflectIn line vec = rotateV angle vec
-    let angle = 2 * angleBetween line vec
+  where
-    in  rotateV angle vec
+    angle = 2 * angleBetween line vec
 -- | Find angle between two points.
 -- Not normalised, ranges from -2*pi to 2*pi.
 angleBetween :: Point2 -> Point2 -> Float
 angleBetween v1 v2 = argV v1 - argV v2
 -- | Return a list containing two copies of a pair.
 doublePair :: (a,a) -> [(a,a)]
 doublePair (x,y) = [(x,y),(y,x)]
 -- | Test whether two polygons intersect by testing the intersection of each
 -- consecutive pair of points.
 polysIntersect :: [Point2] -> [Point2] -> Bool
@@ -245,40 +214,32 @@ polysIntersect (p:ps) (q:qs)
    pairs1 = zip (p:ps) (ps++[p])
    pairs2 = zip (q:qs) (qs++[q])
 polysIntersect _ _ = False
 -- | Test whether two polygons intersect or if one is contained in the other.
 polysOverlap :: [Point2] -> [Point2] -> Bool
 polysOverlap (p:ps) (q:qs) = polysIntersect (p:ps) (q:qs) 
    || pointInPolygon p (q:qs)
    || pointInPolygon q (p:ps)
 polysOverlap _ _ = False
 -- | Test whether any polygons from a first list intersect with any polygons from
 -- a second list.
 anyPolyssIntersect :: [[Point2]] -> [[Point2]] -> Bool
 anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y
 -- | Return n equidistant points on a circle with a radius of 600.
 nRays :: Int -> [Point2]
 nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (600,0)
 -- | Return n equidistant points on a circle with a radius of x.
 nRaysRad :: Int -> Float -> [Point2]
 nRaysRad n x = take n $ iterate (rotateV (2*pi/fromIntegral n)) (x,0)
 -- | Test whether an angle is to the left of another angle, according to the
 -- smallest change in rotation between them.
 -- This appears to sometimes fail if the angles are not normalized.
 isLeftOfA :: Float -> Float -> Bool
-isLeftOfA angle1 angle2 = 
+isLeftOfA angle1 angle2 = (angle1 - angle2 < pi && angle1 > angle2)
    (angle1 - angle2 < pi && angle1 > angle2)
    || (angle2 - angle1 > pi && angle2 > angle1)
 -- | Test whether a vector is to the left of another, according to the smallest
 -- change of rotation between them.
 isLeftOf :: Point2 -> Point2 -> Bool
 isLeftOf x y = isLeftOfA (argV x) (argV y)
 -- | Find the difference between two angles.
 -- Possibly not correct...
 diffAngles :: Float -> Float -> Float
@@ -292,7 +253,6 @@ diffAngles x y
 differenceAngles = diffAngles
 angleDifference = diffAngles
 -- | Given a triangle where we know the length of a first side,
 -- the length of a second side, and the angle between the first side and the
 -- third side, finds the length of the third side.
@@ -305,7 +265,6 @@ ssaTri ab bc a
        let c = asin ( (ab * sin a)/bc)
            b = pi - (a + c)
        in  sin b * bc / sin a
 -- | Given two points of a triangle and a third point, return
 -- the point which lies between pa and pc' on a line from pb of length bc.
 -- Note that there are likely two such points, this should return the point
@@ -316,7 +275,6 @@ ssaTriPoint pa pb pc' bc
          a  = errorAngleVV 6 (pb -.- pa) (pc' -.- pa)
          ac = ssaTri ab bc a
      in  pa +.+ (ac *.* errorNormalizeV 47 (pc' -.- pa))
 -- | Safe version of 'ssaTriPoint'.
 ssaTriPoint' :: Point2 -> Point2 -> Point2 -> Float -> Maybe Point2
 ssaTriPoint' pa pb pc' bc
@@ -333,41 +291,34 @@ ssaTriPointCorrect pa pb pc' bc
  where 
    p = ssaTriPoint pa pb pc' bc
    param = closestPointOnLineParam pa pc' p
 -- | Given a segment and external point, find the closest point on the segment.
 closestPointOnSeg :: Point2 -> Point2 -> Point2 -> Point2
 closestPointOnSeg segP1 segP2 p
    | errorClosestPointOnLineParam 3 segP1 segP2 p <= 0 = segP1
    | errorClosestPointOnLineParam 4 segP1 segP2 p >= 1 = segP2
    | otherwise                                  = errorClosestPointOnLine 2 segP1 segP2 p
 -- | Return Just a point if it is inside a circle, Nothing otherwise.
 pointInCircle :: Point2 -> Float -> Point2 -> Maybe Point2
 pointInCircle p r c 
    | p == c = Just p
    | magV (p -.- c) < r = Just p
    | otherwise = Nothing
 -- | Determines if a moving point intersects with a circle,
 -- if so, returns a point on circle that intersects with the line passing
 -- throught the circle : HOPEFULLY THE CORRECT OF THE TWO!
 collidePointCirc :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
 collidePointCirc p1 p2 rad c = ssaTriPoint' p2 c p1 rad
 -- | As 'collidePointCirc', but changes the point to a measure of the distance.
 collidePointCirc' :: Point2 -> Point2 -> Float -> Point2 -> Maybe Float
 collidePointCirc' p1 p2 rad c = fmap (\x -> magV (x -.- p1))
    (collidePointCirc p1 p2 rad c)
 -- | As 'collidePointCirc', but returns both the point and the measure of the distance.
 collidePointCirc'' :: Point2 -> Point2 -> Float -> Point2 -> Maybe (Point2,Float)
 collidePointCirc'' p1 p2 rad c = (,) <$> collidePointCirc p1 p2 rad c
    <*>  collidePointCirc' p1 p2 rad c
 -- | As 'collidePointCirc', but uses the supposedly correct version of ssaTriPoint.
 collidePointCircCorrect :: Point2 -> Point2 -> Float -> Point2 -> Maybe Point2
 collidePointCircCorrect p1 p2 rad c = ssaTriPointCorrect p2 c p1 rad
 -- | Finds the height of a triangle using herons formula.
 -- The base is the line between the first two points.
 heron :: Point2 -> Point2 -> Point2 -> Float
@@ -380,7 +331,6 @@ heron x y z
            s = (a+b+c)/2
            area = sqrt(s*(s-a)*(s-b)*(s-c))
        in  2*area/a
 -- | Multiplies reflection in normal by factor.
 reflectInParam :: Float -> Point2 -> Point2 -> Point2
 reflectInParam x line vec = 
@@ -388,7 +338,6 @@ reflectInParam x line vec =
        rAng = rotateV angle vec
        p = x *.* errorClosestPointOnLine 3 (0,0) (vNormal line) rAng
    in  rAng -.- p
 --reflectIn' :: Point2 -> Point2 -> Point2 -> Point2 -> Point2
 --reflectIn' l1 l2 v1 v2 = v1 +.+ reflectIn (l1 -.- l2) (v2 -.- v1)
@@ -397,22 +346,19 @@ isOnSeg l1 l2 p =
    errorClosestPointOnLineParam 10 l1 (l1 +.+ vNormal (l2 -.- l1)) p == 0
    && errorClosestPointOnLineParam 11 l1 l2 p <= 1
    && errorClosestPointOnLineParam 12 l1 l2 p >= 0
 -- | Divide a segment into a list of points with a maximal distance between
 -- them.
 -- the take 5000 here is a hack, otherwise divideLine seems to sometimes
 -- generate an infinite list, and I don't know why
 divideLine :: Float -> Point2 -> Point2 -> [Point2]
 --divideLine x a b = map (\i -> a +.+ (i / (fromIntegral numPoints)) *.* (b -.- a)) 
-divideLine x a b = 
+divideLine x a b = take 5000 
    take 5000 
    $ map (\i -> a +.+ (fromIntegral i / fromIntegral numPoints *.* (b -.- a)) )
    ns
  where 
    d = dist a b
    numPoints = max 1 $ ceiling $ d / x
    ns = [0 .. numPoints]
 -- | As 'divideLine', but must return an odd number of points.
 divideLineOddNumPoints :: Float -> Point2 -> Point2 -> [Point2]
 --divideLine x a b = map (\i -> a +.+ (i / (fromIntegral numPoints)) *.* (b -.- a)) 
@@ -422,22 +368,25 @@ divideLineOddNumPoints x a b = take 5000
  where 
    d = dist a b
    numPoints' = max 1 $ ceiling $ d / x
-    numPoints | even numPoints' = numPoints'
+    numPoints
        | even numPoints' = numPoints'
        | otherwise       = numPoints' + 1
    ns = [0 .. numPoints]
 -- | Given two pairs of Ints, returns a list of pairs of Ints that form 
 -- a digital line between them.
 digitalLine :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
 {-# INLINE digitalLine #-}
 digitalLine (x1,y1) (x2,y2) 
-    | abs (x1-x2) > abs (y1-y2) = [ (x,( (y1-y2) * x + x1*y2 - x2*y1) `rdiv` (x1-x2) ) 
+    | abs (x1-x2) > abs (y1-y2) = 
-                                    | x <- intervalList x1 x2 ]
+        [ (x,( (y1-y2) * x + x1*y2 - x2*y1) `rdiv` (x1-x2) ) 
-    | otherwise                 = [ ( ((x1-x2) * y + y1*x2 - y2*x1) `rdiv` (y1-y2)  , y)
+        | x <- intervalList x1 x2 
-                                    | y <- intervalList y1 y2 ]
+        ]
    | otherwise = 
        [ ( ((x1-x2) * y + y1*x2 - y2*x1) `rdiv` (y1-y2)  , y)
        | y <- intervalList y1 y2 
        ]
  where 
    rdiv a b = round $ fromIntegral a / fromIntegral b
 -- | Given two pairs of 'Int's, create a list of pairs of 'Int's that form a
 -- rectangle between them.
 digitalRect :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
@@ -448,13 +397,11 @@ digitalRect (a,b) (c,d) = [(s,t) | s <- [minx .. maxx] , t <- [miny .. maxy]]
    minx = min a c
    maxy = max b d
    miny = min b d
 -- | Given two Ints, creates the list of Ints between these.
 intervalList :: Int -> Int -> [Int]
 intervalList x y 
    | y >= x = [x .. y]
    | otherwise = reverse [y..x]
 -- | Create points on the circumference of a circle with maximal distance
 -- between them.
 divideCircle :: Float -> Point2 -> Float -> [Point2]
@@ -478,7 +425,7 @@ arcStepwisePositive
    -> Point2   -- ^ Center
    -> Point2   -- ^ Start vector from center
    -> [Point2]
-arcStepwisePositive ssize a cen v = ((cen +.+) . (\rot -> rotateV rot v) ) <$> rots
+arcStepwisePositive ssize a cen v = (cen +.+) . (`rotateV` v) <$> rots
  where
    rots :: [Float]
    rots = map ((a*) . (/ fromIntegral n ) . fromIntegral) [0 .. n]
@@ -502,7 +449,6 @@ makeLoopPairs :: [Point2] -> [(Point2,Point2)]
 makeLoopPairs [] = error "tried to make loop with empty list of points"
 makeLoopPairs [x] = error "tried to make loop with singleton list of points"
 makeLoopPairs (x:xs) = zip (x:xs) (xs ++ [x])
 -- | Test whether a point is in a cone.
 -- Note the pair is ordered.
 -- Doesn't work for obtuse angles.
@@ -512,4 +458,6 @@ pointIsInCone
    -> Point2           -- ^ Point to test.
    -> Bool
 pointIsInCone c (rightp,leftp) p = isLHS c rightp p && isLHS leftp c p
-
+-- | TODO: implement using Control.Foldl
 centroid :: Foldable t => t Point2 -> Point2
 centroid xs = 1 / fromIntegral (length xs) *.* foldl' (+.+) (0,0) xs
@@ -1,6 +1,6 @@
 {- |
 Module      : Loop
-Description : Minimal game loop
+Description : Simple game loop
 This module sets up an SDL window which may be updated using a simple game loop.
 -}
@@ -41,7 +41,7 @@ setupLoop
        startWorld <- ioStartWorld
        initializeAll
        bracket 
-            (createWindow (T.pack "A Minimal Game Loop") (winConfig xSize ySize)) 
+            (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize)) 
            destroyWindow 
            $ \window -> bracket 
                (glCreateContext window) 
@@ -1,4 +1,3 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Music
  where
 import qualified SDL.Mixer as Mix
@@ -120,7 +120,7 @@ extrapolate (ox,oy) (ax,ay) (bx,by) (x,y) =
 color :: RGBA -> Picture -> Picture
 {-# INLINE color #-}
-color c pic = OverPic id id 0 (const c) pic
+color c = OverPic id id 0 (const c)
 translate3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE translate3 #-}
@@ -128,15 +128,15 @@ translate3 a b (x,y,z) = (x+a,y+b,z)
 translate :: Float -> Float -> Picture -> Picture
 {-# INLINE translate #-}
-translate x y pic = OverPic (translate3 x y) id 0 id pic
+translate x y = OverPic (translate3 x y) id 0 id
 setDepth :: Float -> Picture -> Picture
 {-# INLINE setDepth #-}
-setDepth d pic = OverPic (\(x,y,_) -> (x,y,d)) id 0 id pic
+setDepth d = OverPic (\(x,y,_) -> (x,y,d)) id 0 id
 setLayer :: Int -> Picture -> Picture
 {-# INLINE setLayer #-}
-setLayer i pic = OnLayer i pic
+setLayer = OnLayer
 scale3 :: Float -> Float -> Point3 -> Point3
 {-# INLINE scale3 #-}
@@ -144,7 +144,7 @@ scale3 a b (x,y,z) = (x*a,y*b,z)
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
-scale x y pic = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id pic
+scale x y = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
@@ -154,7 +154,7 @@ rotate3 a (x,y,z) = (x',y',z)
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
-rotate a pic = OverPic (rotate3 a) id a id pic
+rotate a = OverPic (rotate3 a) id a id
 pictures :: [Picture] -> Picture
 {-# INLINE pictures #-}
@@ -162,9 +162,9 @@ pictures = Pictures
 makeArc :: Float -> (Float,Float) -> [Point2]
 {-# INLINE makeArc #-}
-makeArc rad (a,b) = zipWith rotateV as (repeat (0,rad))
+makeArc rad (a,b) = map (`rotateV` (0,rad)) angles
  where 
-    as = [a,a+step.. b]
+    angles = [a,a+step.. b]
    step = pi * 0.2
 circleSolid :: Float -> Picture
@@ -203,7 +203,7 @@ thickLine ps t = pictures $ f ps
 thickCircle :: Float -> Float -> Picture
 {-# INLINE thickCircle #-}
-thickCircle rad wdth = thickArc 0 (2*pi) rad wdth
+thickCircle = thickArc 0 (2*pi)
 arcSolid :: Float -> Float -> Float -> Picture
 {-# INLINE arcSolid #-}
@@ -1,4 +1,4 @@
-{-# LANGUAGE DefaultSignatures, TypeOperators, FlexibleContexts #-}
+{-# LANGUAGE TypeOperators, FlexibleContexts #-}
 {- | Pulled from
 https://stackoverflow.com/questions/10112733/haskell-simple-constructor-comparison-function
 -}
@@ -1,4 +1,3 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Shader
    ( makeShader
    , addTexture
@@ -47,7 +46,7 @@ extractProgAndUnis :: FullShader a -> (Program,[UniformLocation])
 extractProgAndUnis s = (_shaderProgram s, _shaderUniforms s)
 pokeShaders :: [FullShader a] -> F.FoldM IO a [Int]
-pokeShaders fss = traverse pokeShader fss
+pokeShaders = traverse pokeShader
 pokeShader :: FullShader a -> F.FoldM IO a Int
 pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
@@ -61,18 +60,17 @@ pokeRender :: (a -> [[[Float]]])
 pokeRender toFs ptrs n rt = pokeList ptrs n (toFs rt)
 pokeList :: [(Ptr Float,Int)] -> Int -> [[[Float]]] -> IO Int
-pokeList ptrs n fsss = foldM (pokePtrs ptrs) n fsss
+pokeList ptrs = foldM (pokePtrs ptrs)
 pokePtrs :: [(Ptr Float,Int)] -> Int -> [[Float]] -> IO Int
 pokePtrs ptrIs n fss = do
    zipWithM_ f ptrIs fss
    return $ n + 1
-  where f (ptr,i) fs = pokeArrayOff ptr (i*n) fs
+  where 
    f (ptr,i) fs = pokeArrayOff ptr (i*n) fs
 pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO ()
-pokeArrayOff ptr i xs =
+pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..]
    zipWithM_ (pokeElemOff ptr) [i..] xs
 bindArrayBuffers :: Int -> [(BufferObject,Ptr Float,Int)] -> IO ()
 {-# INLINE bindArrayBuffers #-}
@@ -82,22 +80,20 @@ bindArrayBuffers numVs ps = do
        bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, StreamDraw)
 bindShaderBuffers :: [FullShader a] -> [Int] -> IO ()
-bindShaderBuffers fss is =
+bindShaderBuffers = zipWithM_ f
    zipWithM_ f fss is
  where 
    f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
 drawShaders :: [FullShader a] -> [Int] -> IO ()
-drawShaders fss is =
+drawShaders = zipWithM_ drawShader
    zipWithM_ drawShader fss is
 drawShader :: FullShader a -> Int -> IO ()
 {-# INLINE drawShader #-}
 drawShader fs i = do 
    currentProgram $= Just (_shaderProgram fs)
-    bindVertexArrayObject $= (Just (_vao $ _shaderVAO fs))
+    bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
    case _shaderTexture fs of 
-        Just (ShaderTexture {_textureObject = to})
+        Just ShaderTexture{_textureObject = to}
            -> textureBinding Texture2D $= Just to
        _   -> return ()
    drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)
@@ -50,10 +50,7 @@ In the update:
 -}
 playAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
 playAndUpdate sData newSounds 
-    = updateSounds (_loadedChunks sData) (mergeSounds newSounds (_playingSounds sData))
+    = updateSounds (_loadedChunks sData) (M.unionWith mergeSound newSounds (_playingSounds sData))
 mergeSounds :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound
 mergeSounds as bs = M.unionWith mergeSound as bs
 mergeSound :: Sound -> Sound -> Sound
 mergeSound newS oldS 
@@ -85,7 +82,7 @@ tryPlay sd s = do
        Mix.halt i
        Mix.playOn i Mix.Once (sd IM.! _soundChunkID s)
    return $ s 
-        & soundChannel  .~ Just i
+        & soundChannel  ?~ i
        & soundStatus   .~ Playing
 repetitions :: Sound -> Mix.Times
@@ -100,14 +97,13 @@ tryGetChannel s = case _soundChannel s of
 decrementTimer :: Sound -> IO Sound
 decrementTimer s = case _soundTime s of
-    Just t | t > 0     -> return $ s & soundTime .~ Just (t - 1)
+    Just t 
        | t > 0     -> return $ s & soundTime ?~ t - 1
        | otherwise -> fadeOutMaybe (_soundChannel s) (_soundFadeTime s)
                            >> return (s & soundTime .~ Nothing
                                         & soundStatus .~ FadingOut)
    Nothing -> return s
 --applyPosition = return
 applyPosition :: Sound -> IO Sound
 applyPosition s = case _soundPos s of
    Nothing     -> return s
@@ -30,11 +30,11 @@ polygonStrictlyConvex ps = True
 --prop_looping :: [Point2] -> [WallP] -> Bool
 prop_looping = forAllShrink genTris shrinkTris $ \tris ->
-    (all (not . (\[a,b,c] -> isOnSeg a b c
+    not (any ( \[a,b,c] -> isOnSeg a b c
                            || isOnSeg a c b
                            || isOnSeg b c a
-                ) ) tris)
+                ) tris)
-    ==> (isLooping' $ foldr cutWalls' [] tris)
+    ==> isLooping' (foldr cutWalls' [] tris)
 shrinkTris [] = []
 shrinkTris (x:xs) = xs : map (x :) (shrinkTris xs)