diff --git a/package.yaml b/package.yaml
index 70cebdf9b..4fcc6adff 100644
--- a/package.yaml
+++ b/package.yaml
@@ -46,6 +46,7 @@ dependencies:
 - aeson
 - directory
 - QuickCheck
+- extra
 
 library:
   source-dirs: src
diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs
index 326a14826..7b9fa631b 100644
--- a/src/Dodge/AIs.hs
+++ b/src/Dodge/AIs.hs
@@ -4,6 +4,7 @@ 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
@@ -14,7 +15,7 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Function
-import Data.Graph.Inductive.Graph
+import Data.Graph.Inductive.Graph hiding ((&))
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
 import qualified Data.ByteString as B
@@ -29,6 +30,158 @@ import Control.Concurrent
 import System.Random
 import Foreign.ForeignPtr
 
+expandToAI 
+    :: ( World -> StdGen -> Creature -> (World -> World, StdGen, Creature) )
+    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
+expandToAI ai w (f,g) cr =
+    let (sideE, g', cr') = ai w g cr
+    in ((sideE . f, g'), Just cr')
+
+chaseAI :: 
+    World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
+chaseAI w (f,g') cr =  
+    let cid = _crID cr
+        cpos = _crPos cr
+        damageYou = over (creatures . ix 0 . crState . crDamage) addDam 
+                    . soundOnce (fromIntegral hitSound)
+        addDam dams = (( Blunt 100 cpos ypos ypos ) : dams )
+        ypos = _crPos $ you w
+        combinedRad = _crRad cr + _crRad (you w)
+        (a,g) = randomR (-0.2,0.2) g'
+        (wtime,g1) = randomR (15,25) g'
+        randomTurn = over crDir (+a)
+        randomTurn2 = over crDir (+(signum a))
+        isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
+        isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr) 
+                               && dist cpos (_crPos cr') < 25
+        replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
+        addGoal newGoals     = Just . over (crState . goals) (\gs -> newGoals ++ gs)
+        replaceAction newActions 
+            = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
+        addAction newActions 
+            = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
+    in  --if _crHP cr <= 0 then killCr w f cr else
+    case head $ _goals $ _crState cr of
+        [] -> ((f, g') , replaceGoal [] cr)
+        (Wait:_) | dist cpos ypos < 900 && hasLOS cpos ypos w
+                      -> ((f ,g')
+                         ,addGoal [[WaitFor wtime,MoveTo ypos]] cr)
+                 | dist cpos ypos < 900 && hasLOSIndirect cpos ypos w
+                      -> ((f , g')
+                         ,addGoal [[WaitFor wtime,PathTo ypos]] cr)
+                 | otherwise -> ( (f , g')
+                                ,Just cr)
+        (WaitFor x:gls)| x == 0    -> ( (f , g')
+                                      ,replaceAction [] cr
+--                                $ drawCircleAtForCol cpos 10 (withAlpha 0.5 cyan)
+                                      )
+                       | hasLOS cpos ypos w
+                                   -> ( (f, g')
+                                      ,replaceAction [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr
+                                      )
+                       | otherwise -> ( (f, g')
+                                      , replaceAction [WaitFor (x-1)] cr )
+        (MoveTo p:gls) 
+                       | dist ypos cpos < combinedRad + 5
+                            && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
+                                    -> ( (damageYou . f , g')
+                                       , replaceAction [MeleeAttack 5] $
+                                        over crPos
+                                            (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr
+                                        )
+                       | hasLOS cpos ypos w -> ( (f  , g)
+                                               , replaceAction [MoveTo ypos] 
+                                                  $ crMvForward 2.5 $ randomTurn 
+                                                          $ crTurnTowardSpeed 0.05 p cr
+                                               )
+                       | dist p cpos < 10 -> ( (f, g') 
+                                             , replaceAction [] cr)
+                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
+                                   -> ( (f ,g' )
+                                      , Just $ crTurnTowardSpeed 0.05 p cr)
+                       | otherwise -> ( (f, g' )
+                                      , Just $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
+        (MoveToFor p x:gls) 
+                       | hasLOS cpos ypos w -> 
+                                ( (f , g )
+                                , replaceAction [MoveTo ypos]
+                                      $ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr
+                                )
+                       | dist p cpos < 10 -> ( (f , g)
+                                             , replaceAction [] cr)
+                       | x == 0 -> ( (f , g)
+                                   , replaceAction [] cr)
+                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
+                                   -> ( (f , g)
+                                      , replaceAction [MoveToFor p (max 0 (x-1))] 
+                                        $ crTurnTowardSpeed 0.05 p cr)
+                       | otherwise -> ( (f , g)
+                                      , replaceAction [MoveToFor p (max 0 (x-1))]
+                                         $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
+        (PathTo p:_)   
+            | dist p cpos < 10 -> ( (f , g)
+                                  , replaceAction [] cr
+--                                $ drawCircleAtForCol p 10 (withAlpha 0.5 blue)
+                                        )
+            | hasLOS cpos p w -> ( (f , g)
+                                  , addAction [MoveToFor p 10] cr
+--                                $ drawCircleAtForCol p 10 (withAlpha 0.5 green)
+                                        )
+            | otherwise -> 
+                            --((f, g) , replaceAction [] cr)
+--                   case makePathBetweenPs cpos p w of
+--                         Just (q:_) -> ( (f , g)
+--                                  
+--                                   , addAction [MoveToFor q 10] cr
+--                                   )
+--                         _ ->      ((f , g)
+--                                  
+--                                   , replaceAction [] cr
+--                                   )
+                   case pointTowardsGoal cpos p w of
+                         Just q -> ( (f , g)
+                                  
+                                   , addAction [MoveToFor q 10] cr
+                                   )
+                         _ ->      ((f , g)
+                                  
+                                   , replaceAction [] cr
+                                   )
+
+--                case pointTowardsGoal' cpos p w of
+ --                   Right q -> addAction [MoveToFor q 10] 
+-----                let ns = map fst $ concatMap doublePair $ _pathGraph' w
+-----                    a' = listToMaybe $ sortBy (compare `on` dist cpos) $ ns
+-----                    b' = listToMaybe $ sortBy (compare `on` dist p) $ ns
+-----                    g :: World -> World
+-----                    g = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 yellow) a'
+-----                    h = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 blue) b'
+-----                    incf = incidenceToFunction $ pairsToIncidence 
+-----                                  $ concatMap doublePair $ _pathGraph' w
+-----                    as :: [Point]
+-----                    as = concat $ maybeToList $ fmap incf a'
+-----                    g' w = foldr (\p -> drawCircleAtForCol p 5 orange) w as
+-----                    h' qs w = foldr (\p -> drawCircleAtForCol p 5 orange) w qs
+-----                in case makePath' <$> return incf <*> b' <*> a' of
+-----                    Just (q:qs) -> ( f . h' qs
+-----                                . drawCircleAtForCol q 10 magenta
+-----                              , addAction [MoveToFor q 10] cr
+-----                             --   $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs 
+-----                             --                       cpos p w)) ++ [p]) 50 red
+-----                                )
+-------                    Left s  -> error s
+-------                    - -> (f,cr)
+-----                    _ -> ( f 
+-----                           . g . h . g'
+-----                         , replaceAction [] cr
+-----                         )
+        (MeleeAttack x:_)
+                       | x == 0    -> ( (f , g)
+                                  , replaceAction [WaitFor wtime] cr     )
+                       | otherwise -> ( (f , g)
+                                  , replaceAction [MeleeAttack (x-1)] cr )
+
+
 factionIs :: Faction -> Creature -> Bool
 factionIs f c = (_faction $ _crState $ c) == f
 
@@ -220,149 +373,6 @@ placeCrFaction cr fact p op rot w = over creatures addCr w
                                 crs
 
 
-chaseAI :: 
-    World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature)
-chaseAI w (f,g') cr =  
-    let cid = _crID cr
-        cpos = _crPos cr
-        damageYou = over (creatures . ix 0 . crState . crDamage) addDam 
-                    . soundOnce (fromIntegral hitSound)
-        addDam dams = (( Blunt 100 cpos ypos ypos ) : dams )
-        ypos = _crPos $ you w
-        combinedRad = _crRad cr + _crRad (you w)
-        (a,g) = randomR (-0.2,0.2) g'
-        (wtime,g1) = randomR (15,25) g'
-        randomTurn = over crDir (+a)
-        randomTurn2 = over crDir (+(signum a))
-        isCrowded = (length $ IM.elems $ IM.filter isCloseFaction (_creatures w)) > 2
-        isCloseFaction cr' = _faction (_crState cr') == _faction (_crState cr) 
-                               && dist cpos (_crPos cr') < 25
-        replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
-        addGoal newGoals     = Just . over (crState . goals) (\gs -> newGoals ++ gs)
-        replaceAction newActions 
-            = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
-        addAction newActions 
-            = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
-    in  --if _crHP cr <= 0 then killCr w f cr else
-    case head $ _goals $ _crState cr of
-        [] -> ((f, g') , replaceGoal [] cr)
-        (Wait:_) | dist cpos ypos < 900 && hasLOS cpos ypos w
-                      -> ((f ,g')
-                         ,addGoal [[WaitFor wtime,MoveTo ypos]] cr)
-                 | dist cpos ypos < 900 && hasLOSIndirect cpos ypos w
-                      -> ((f , g')
-                         ,addGoal [[WaitFor wtime,PathTo ypos]] cr)
-                 | otherwise -> ( (f , g')
-                                ,Just cr)
-        (WaitFor x:gls)| x == 0    -> ( (f , g')
-                                      ,replaceAction [] cr
---                                $ drawCircleAtForCol cpos 10 (withAlpha 0.5 cyan)
-                                      )
-                       | hasLOS cpos ypos w
-                                   -> ( (f, g')
-                                      ,replaceAction [WaitFor (x-1)] $ crTurnTowardSpeed 0.05 ypos cr
-                                      )
-                       | otherwise -> ( (f, g')
-                                      , replaceAction [WaitFor (x-1)] cr )
-        (MoveTo p:gls) 
-                       | dist ypos cpos < combinedRad + 5
-                            && abs ((_crDir cr) - argV (ypos -.- cpos)) < pi/4 -- same error as above
-                                    -> ( (damageYou . f , g')
-                                       , replaceAction [MeleeAttack 5] $
-                                        over crPos
-                                            (+.+ (12 *.* errorNormalizeVAI (ypos -.- cpos))) cr
-                                        )
-                       | hasLOS cpos ypos w -> ( (f  , g)
-                                               , replaceAction [MoveTo ypos] 
-                                                  $ crMvForward 2.5 $ randomTurn 
-                                                          $ crTurnTowardSpeed 0.05 p cr
-                                               )
-                       | dist p cpos < 10 -> ( (f, g') 
-                                             , replaceAction [] cr)
-                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-                                   -> ( (f ,g' )
-                                      , Just $ crTurnTowardSpeed 0.05 p cr)
-                       | otherwise -> ( (f, g' )
-                                      , Just $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
-        (MoveToFor p x:gls) 
-                       | hasLOS cpos ypos w -> 
-                                ( (f , g )
-                                , replaceAction [MoveTo ypos]
-                                      $ crMvForward 2.5 $ randomTurn $ crTurnTowardSpeed 0.05 p cr
-                                )
-                       | dist p cpos < 10 -> ( (f , g)
-                                             , replaceAction [] cr)
-                       | x == 0 -> ( (f , g)
-                                   , replaceAction [] cr)
-                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-                                   -> ( (f , g)
-                                      , replaceAction [MoveToFor p (max 0 (x-1))] 
-                                        $ crTurnTowardSpeed 0.05 p cr)
-                       | otherwise -> ( (f , g)
-                                      , replaceAction [MoveToFor p (max 0 (x-1))]
-                                         $ crMvForward 2.5 $ crTurnTowardSpeed 0.05 p cr)
-        (PathTo p:_)   
-            | dist p cpos < 10 -> ( (f , g)
-                                  , replaceAction [] cr
---                                $ drawCircleAtForCol p 10 (withAlpha 0.5 blue)
-                                        )
-            | hasLOS cpos p w -> ( (f , g)
-                                  , addAction [MoveToFor p 10] cr
---                                $ drawCircleAtForCol p 10 (withAlpha 0.5 green)
-                                        )
-            | otherwise -> 
-                            --((f, g) , replaceAction [] cr)
---                   case makePathBetweenPs cpos p w of
---                         Just (q:_) -> ( (f , g)
---                                  
---                                   , addAction [MoveToFor q 10] cr
---                                   )
---                         _ ->      ((f , g)
---                                  
---                                   , replaceAction [] cr
---                                   )
-                   case pointTowardsGoal cpos p w of
-                         Just q -> ( (f , g)
-                                  
-                                   , addAction [MoveToFor q 10] cr
-                                   )
-                         _ ->      ((f , g)
-                                  
-                                   , replaceAction [] cr
-                                   )
-
---                case pointTowardsGoal' cpos p w of
- --                   Right q -> addAction [MoveToFor q 10] 
------                let ns = map fst $ concatMap doublePair $ _pathGraph' w
------                    a' = listToMaybe $ sortBy (compare `on` dist cpos) $ ns
------                    b' = listToMaybe $ sortBy (compare `on` dist p) $ ns
------                    g :: World -> World
------                    g = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 yellow) a'
------                    h = fromMaybe id $ fmap (\p -> drawCircleAtForCol p 10 blue) b'
------                    incf = incidenceToFunction $ pairsToIncidence 
------                                  $ concatMap doublePair $ _pathGraph' w
------                    as :: [Point]
------                    as = concat $ maybeToList $ fmap incf a'
------                    g' w = foldr (\p -> drawCircleAtForCol p 5 orange) w as
------                    h' qs w = foldr (\p -> drawCircleAtForCol p 5 orange) w qs
------                in case makePath' <$> return incf <*> b' <*> a' of
------                    Just (q:qs) -> ( f . h' qs
------                                . drawCircleAtForCol q 10 magenta
------                              , addAction [MoveToFor q 10] cr
------                             --   $ drawLineForCol ((cpos : (concat $ maybeToList $ makePathBetweenPs 
------                             --                       cpos p w)) ++ [p]) 50 red
------                                )
--------                    Left s  -> error s
--------                    - -> (f,cr)
------                    _ -> ( f 
------                           . g . h . g'
------                         , replaceAction [] cr
------                         )
-        (MeleeAttack x:_)
-                       | x == 0    -> ( (f , g)
-                                  , replaceAction [WaitFor wtime] cr     )
-                       | otherwise -> ( (f , g)
-                                  , replaceAction [MeleeAttack (x-1)] cr )
 
 ---- meleeAI' :: Int -> World -> World
 ---- meleeAI' cid w = let cr = _creatures w IM.! cid
@@ -1610,6 +1620,7 @@ basicShooterAI w (f,g) cr =
                             -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p cr)
                        | otherwise
                             -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
+
 sniperAI :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
 sniperAI w (f,g) cr = 
     let cpos = _crPos cr
@@ -1618,75 +1629,51 @@ sniperAI w (f,g) cr =
         wp   = _crInv cr IM.! _crInvSel cr
         (aimtime,g1) = randomR (80,120) g
         noAmmo = 0 == _wpLoadedAmmo wp
-        turnCloseSlow p | errorAngleVV 22 (p -.- cpos) 
-                                          (unitVectorAtAngle (_crDir cr)) < 0.4
+        turnCloseSlow p 
+            | errorAngleVV 22 (p -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
                                     =  crTurnTowardSpeed 0.01 p
-                        | otherwise =  crTurnTowardSpeed 0.05 p
+            | otherwise =  crTurnTowardSpeed 0.05 p
         replaceGoal newGoals = Just . over (crState . goals) (\gs -> newGoals ++ tail gs)
         addGoal newGoals     = Just . over (crState . goals) (\gs -> newGoals ++ gs)
         replaceAction newActions 
             = Just . over (crState . goals) (\((_:as):ass) -> (newActions ++ as):ass)
         addAction newActions 
             = Just . over (crState . goals) (\(as:ass) -> (newActions++as):ass)
---        autoFireTweak p | _wpIsAuto wp = Just
---                        | otherwise    = replaceGoal [[AimAt p (_itUseRate wp * 2)]]
-    in  --if _crHP cr <= 0 then killCr w f cr else
-    case head $ _goals $ _crState cr of
-        []             | canSeeFire cpos ypos w -> ( ( f , g1 ) 
-                                                   , replaceGoal [[AimAt ypos aimtime]] cr
-                                                   )
-                       | otherwise              -> ( ( f , g )
-                                                   , replaceGoal [] cr
-                                                   )
-        (WaitFor x:gls)| canSeeFire cpos ypos w -> ( ( f , g1 ) 
-                                                   , replaceGoal [[AimAt ypos aimtime]] cr
-                                                   )
-                       | x == 0    -> ( (f ,g ),  replaceAction [] cr )
-                       | otherwise -> ( (f ,g ),  replaceAction [WaitFor (x-1)] cr )
+    in case head $ _goals $ _crState cr of
+        []  | canSeeFire cpos ypos w -> ( ( f , g1 ) , replaceGoal [[AimAt ypos aimtime]] cr)
+            | otherwise              -> ( ( f , g ) , replaceGoal [] cr)
+        (WaitFor x:gls)
+            | canSeeFire cpos ypos w -> ( ( f , g1 ) , replaceGoal [[AimAt ypos aimtime]] cr)
+            | x == 0    -> ( (f ,g ),  replaceAction [] cr )
+            | otherwise -> ( (f ,g ),  replaceAction [WaitFor (x-1)] cr )
         (MoveToFor p x:gls) 
-                       | canSeeFire cpos ypos w -> ( (f , g1) 
-                                                   , replaceGoal [[AimAt ypos aimtime]] cr
-                                                   )
-                       | x == 0    -> ( (f , g)
-                                      , replaceAction [] cr
-                                      )
-                       | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr)
-                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
-                                   -> ( (f , g)
-                                      , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr  )
-                       | otherwise -> ( (f , g)
-                                      , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 
-                                                                          $ crTurnTowardSpeed 0.05 p cr )
-        (PathTo p:_)   | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr )
-                       | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
-                       | otherwise -> case pointTowardsGoal cpos p w of
-                                        Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
-                                        _      -> ( (f , g) , replaceAction [] cr            )
-        (FireAt p:gls) | noAmmo -> ( (tryUseItem cid . f , g )
-                                   , replaceGoal [[Reload
-                                                 ,WaitFor 50
-                                                 --,Search 1 ,WaitFor 100
-                                                 ]] 
-                                                 cr
-                                    )
-                       | canSeeFireVisionAll cid (_yourID w) w 
-                            -> ( (tryUseItem cid . f , g)
-                               , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr
-                               )
-                       | pathToPointFireable cid p w 
-                            -> ( (tryUseItem cid . f , g)
-                               , Just $ turnCloseSlow p cr
-                               )
-                       | otherwise -> ( (f , g)
-                                      , replaceGoal [[WaitFor 50 ]] cr
-                                      )
-        (Reload:gls)   | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
-                       | canSeeFireVisionAny cid (_yourID w) w 
-                            -> ( (f , g)
-                               , Just $ turnCloseSlow ypos cr
-                               )  -- no longer chase if see you when reloading
-                                                    --  $ replaceAction [] w
-                       | otherwise -> ( (f , g) , Just cr)
+            | canSeeFire cpos ypos w -> ( (f , g1) , replaceGoal [[AimAt ypos aimtime]] cr)
+            | x == 0    -> ( (f , g) , replaceAction [] cr)
+            | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr)
+            | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4 -> 
+                ( (f , g) , replaceAction [MoveToFor p (x-1)] $ crTurnTowardSpeed 0.05 p cr  )
+            | otherwise -> 
+                ( (f , g) 
+                , replaceAction [MoveToFor p (x-1)] $ crMvForward 2 $ crTurnTowardSpeed 0.05 p cr )
+        (PathTo p:_)   
+            | dist p cpos < 1 -> ( (f , g) , replaceAction [] cr )
+            | hasLOS cpos p w -> ( (f , g) , addAction [MoveToFor p 100] cr )
+            | otherwise -> case pointTowardsGoal cpos p w of
+                Just q -> ( (f , g) , addAction [MoveToFor q 100] cr )
+                _      -> ( (f , g) , replaceAction [] cr            )
+        (FireAt p:gls) 
+            | noAmmo -> ( (tryUseItem cid . f , g ) , replaceGoal [[Reload ,WaitFor 50 ]] cr)
+            | canSeeFireVisionAll cid (_yourID w) w -> 
+                ( (tryUseItem cid . f , g) , replaceGoal [[FireAt ypos]] $ turnCloseSlow p cr)
+            | pathToPointFireable cid p w -> 
+                ( (tryUseItem cid . f , g) , Just $ turnCloseSlow p cr)
+            | otherwise -> 
+                ( (f , g) , replaceGoal [[WaitFor 50 ]] cr)
+        (Reload:gls)   
+            | _wpReloadState wp == 0 -> ( (f , g) , replaceAction [] cr )
+            | canSeeFireVisionAny cid (_yourID w) w -> 
+                ( (f , g) , Just $ turnCloseSlow ypos cr) 
+            | otherwise -> ( (f , g) , Just cr)
         (Search i:gls) | i == 0 -> ( (f , g) , replaceAction [] cr)
                        | otherwise 
                             -> ( ( f , g1)
@@ -1712,155 +1699,10 @@ sniperAI w (f,g) cr =
                             -> ( (f,g) , replaceAction [AimAt ypos (i-1)] $ crTurnTowardSpeed 0.2 p cr)
                        | otherwise
                             -> ( (f,g) , replaceAction [AimAt p (i-1)] $ turnCloseSlow p cr)
---closeShooterAI :: Int -> World -> World
---closeShooterAI cid w = let cr = _creatures w IM.! cid
---                           cpos = _crPos cr
---                           ypos = _crPos $ you w
---                           wp   = _crInv cr IM.! _crInvSel cr
---                           noAmmo = 0 == _wpLoadedAmmo wp
---                           turnCloseSlow p | errorAngleVV 22 (p -.- cpos) 
---                                                             (unitVectorAtAngle (_crDir cr)) < 0.4
---                                                       =  turnTowardSpeed 0.01 p cid
---                                           | otherwise =  turnTowardSpeed 0.05 p cid
---                           replaceGoal newGoals = over (creatures . ix cid . crState . goals)
---                                                      (\gs -> newGoals ++ tail gs)
---                           addGoal newGoals = over (creatures . ix cid . crState . goals)
---                                                      (\gs -> newGoals ++ gs)
---                           replaceAction newActions = over (creatures . ix cid . crState . goals)
---                                                      (\((_:as):ass) -> (newActions ++ as):ass)
---                           addAction newActions = over (creatures . ix cid . crState . goals)
---                                                      (\(as:ass) -> (newActions++as):ass)
---                           autoFireTweak p | _wpIsAuto wp = id
---                                           | otherwise    = replaceGoal [[AimAt p (_itUseRate wp * 2)]]
---                       in  if _crHP cr <= 0 then killCr cid w else
---    case head $ _goals $ _crState cr of
---        []             | canSeeAny cid (_yourID w) w
---                            -> replaceGoal [[AimAt ypos 50]] w
---                       | otherwise ->  replaceGoal [] w
---        (WaitFor x:gls)| canSeeAny cid (_yourID w) w
---                            -> replaceGoal [[AimAt ypos 50]] w 
---                       | x == 0    -> replaceAction [] w
---                       | otherwise -> replaceAction [WaitFor (x-1)] w
---        (MoveToFor p x:gls) 
---                       | canSeeAny cid (_yourID w) w -> replaceGoal [[AimAt ypos 50]] w
---                       | x == 0 || not (canSeePoint cid p w) -> replaceAction [] w
---                       | dist p cpos < 10 -> replaceAction [] w
---                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
---                                   -> replaceAction [MoveToFor p (x-1)] $ turnTowardSpeed 0.05 p cid w
---                       | otherwise -> replaceAction [MoveToFor p (x-1)]
---                                      $ mvForward speed cid $ turnTowardSpeed 0.05 p cid w
---        (PathTo p:_)   | dist p cpos < 10 -> replaceAction [] w
---                       | canSeePoint cid p w -> addAction [MoveToFor p 100] w
---                       | otherwise -> case pointTowardsGoal cpos p w of
---                                        Just q -> addAction [MoveToFor q 100] w
---                                        _  -> replaceAction [] w
---        (MoveFire mp tp:gls) 
---                       | noAmmo -> replaceGoal [[Reload
---                                               ,MoveFire mp tp
---                                               ]]
---                                    $ tryUseItem cid w
---                       | not $ canSeeAll cid (_yourID w) w -> replaceAction [PathTo tp,Search 1] w
---                       | dist cpos mp  < 10 -> replaceAction [MoveFire ypos ypos] $ turnCloseSlow tp 
---                                        $ tryUseItem cid w
---                       | otherwise -> replaceAction [MoveFire mp ypos]
---                                        $ turnCloseSlow tp $ strafeTo speed mp cid
---                                        $ tryUseItem cid w
---        (Reload:gls)   | _wpReloadState wp == 0 -> replaceAction [] w
---                       | canSeeAny cid (_yourID w) w -> turnCloseSlow ypos
---                                                    $ replaceAction [Reload,MoveFire ypos ypos,Search 1] 
---                                                    $ replaceAction [] w
---                       | otherwise -> w
---        (Guard p p':_)| canSeeAny cid (_yourID w) w
---                            -> addGoal [[AimAt ypos 50]] w
---                       | dist cpos p > 10
---                            -> addGoal [[PathTo p]] w
---                       | errorAngleVV 21 (unitVectorAtAngle (_crDir cr)) (p' -.- p) > pi/8
---                            -> turnTowardSpeed 0.05 p' cid w
---                       | otherwise -> w
---        (InitGuard :_) -> replaceGoal [[Guard cpos (cpos +.+ 50 *.* unitVectorAtAngle (_crDir cr))]] w
---        (AimAt p i:_)  | i == 0 -> replaceAction [MoveFire p p] w
---                       | angleVV (unitVectorAtAngle (_crDir cr)) (p -.- cpos) > pi/4
---                                   -> replaceAction [AimAt p (i-1)] $ turnTowardSpeed 0.05 p cid w
---                       | canSeeAll cid (_yourID w) w
---                            -> replaceAction [AimAt ypos (i-1)] $ turnCloseSlow p 
---                                    $ strafeTo speed p cid w
---                       | otherwise
---                            -> replaceGoal [[AimAt p (i-1),Search 1]] $ turnCloseSlow p 
---                                    $ strafeTo speed p cid w
---        (Search i:gls) | i == 0 -> replaceAction [] w
---                       | otherwise -> replaceAction [PathTo (randomPointXStepsFrom 3 cpos w)
---                                                    ] $ over randGen (snd . next) w
---    where speed = 2
         
-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)
-          equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
-          cr = _creatures w IM.! cid
-          wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr)
-
-randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int)
-randomGraphStep n g = 
-    do let ns = neighbors g n
-       i  <- state $ randomR (0,length ns - 1)
-       case ns of [] -> return Nothing
-                  _  -> return $ Just $ ns !! i
-randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int)
-randomGraphStepRestricted n notns g = 
-    do let ns = neighbors g n \\ notns
-       i  <- state $ randomR (0,length ns - 1)
-       case ns of [] -> return Nothing
-                  _  -> return $ Just $ ns !! i
-
----- continues a walk from a list of points, without repetitions
----- supposes that the list is non-empty
-randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int]
-randomGraphWalk (n:ns) g = 
-    do next <- randomGraphStepRestricted n ns g
-       case next of Nothing -> return (n:ns)
-                    Just n' -> randomGraphWalk (n':n:ns) g
-
-randomPointXStepsFrom :: Int -> Point2 -> World -> Point2
-randomPointXStepsFrom i p w = 
-    let g  = _pathGraph w
-        ns = labNodes g
-        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
-    in  case mp of Nothing -> p
-                   Just (n,_) -> fromJust $ lab g 
-                                                (last $ take i 
-                                                      $ evalState (randomGraphWalk [n] g)
-                                                                  $ _randGen w)
-
-randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2]
-randomPointsXStepsFrom i p w = 
-    let g  = _pathGraph w
-        ns = labNodes g
-        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
-    in  case mp of Nothing -> [p]
-                   Just (n,_) -> mapMaybe (lab g )
-                                                (take i 
-                                                      $ evalState (randomGraphWalk [n] g)
-                                                                  $ _randGen w)
-
-
 errorNormalizeVAI :: Point2 -> Point2
-errorNormalizeVAI (0,0) = error $ "problem with function: errorNormalizeVAI in DodgeAIs"
+errorNormalizeVAI (0,0) = error "problem with function: errorNormalizeVAI in DodgeAIs"
 errorNormalizeVAI p = normalizeV p
 
-splitCritPict' :: Int -> Picture
-splitCritPict' i = pictures $ (++) [color (greyN 0.1) $ circleSolid r,color green $ circLine r] $ concatMap (\p -> map (uncurry translate p) pic) $ take (2^(i-1)) rps
-    where pic = [color green $ circLine 6]
-          rps = fst $ runState ((sequence . repeat . randInCirc) (r-6)) $ mkStdGen 0
-          r   = sqrt ((fromIntegral i) * spCrRadFac)
-
-splitCritPict :: Float -> Picture
-splitCritPict x = pictures [color (greyN 0.8) $ circleSolid x, color green $ circLine x]
-splitCritCorpse :: Float -> Picture
-splitCritCorpse x = color (greyN 0.2) $ circleSolid x
-spCrRadFac = 8^2
-
-
 ----------------
-
 sigmoid x = x/sqrt(1+x^2)
diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs
index 35ca80636..cbe15c202 100644
--- a/src/Dodge/Creature.hs
+++ b/src/Dodge/Creature.hs
@@ -225,10 +225,12 @@ Items you start with.
 startInventory = IM.fromList (zip [0..20] 
     (
     [bezierGun
-    ,autoGun
+    ,hvAutoGun
     ,remoteLauncher
     ,grenade
     ,spawnGun lamp
+    ,lasGun
+    ,autoGun
     --,poisonSprayer
     --,launcher
     --,lasGun
diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs
index 127e43a92..238b3f09a 100644
--- a/src/Dodge/Creature/Action.hs
+++ b/src/Dodge/Creature/Action.hs
@@ -3,11 +3,12 @@
 {-# LANGUAGE BangPatterns #-}
 module Dodge.Creature.Action 
     ( module Dodge.Creature.Action
-    , useItem
-    , tryUseItem
+    , module Dodge.Creature.Action.UseItem
+    , module Dodge.Creature.Action.Movement
     )
     where
 import Dodge.Creature.Action.UseItem
+import Dodge.Creature.Action.Movement
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
 import Dodge.Base
@@ -87,12 +88,6 @@ stepForward speed cr = over (crState . stance . carriage) f cr
     f (w@Walking {}) = w {_stepToAdd = ceiling speed}
     f s = s
 
-{- Determine the speed modifier of an item. -}
-equipSpeed :: Item -> Float
-equipSpeed NoItem = 1
-equipSpeed it | _itIdentity it == FrontArmour = 0.75
-              | _itIdentity it == FlameShield = 0.75
-              | otherwise                     = 1
 
 turnTo 
     :: Point2   -- ^ Target point
diff --git a/src/Dodge/Creature/Action/Movement.hs b/src/Dodge/Creature/Action/Movement.hs
new file mode 100644
index 000000000..67ca6bd10
--- /dev/null
+++ b/src/Dodge/Creature/Action/Movement.hs
@@ -0,0 +1,22 @@
+module Dodge.Creature.Action.Movement
+    where
+import Dodge.Data
+import Geometry
+
+import qualified Data.IntMap.Strict as IM
+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)
+          equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! cid
+          cr = _creatures w IM.! cid
+          wpFactor = _itAimingSpeed (_crInv cr IM.! _crInvSel cr)
+
+{- Determine the speed modifier of an item. -}
+equipSpeed :: Item -> Float
+equipSpeed NoItem = 1
+equipSpeed it | _itIdentity it == FrontArmour = 0.75
+              | _itIdentity it == FlameShield = 0.75
+              | otherwise                     = 1
diff --git a/src/Dodge/Creature/Action/UseItem.hs b/src/Dodge/Creature/Action/UseItem.hs
index 48e69e81a..e0db9126d 100644
--- a/src/Dodge/Creature/Action/UseItem.hs
+++ b/src/Dodge/Creature/Action/UseItem.hs
@@ -12,7 +12,10 @@ import Data.Maybe (fromMaybe)
 useItem :: Int -> World -> World
 useItem n w = equippedItemEffect n w
 
-tryUseItem :: Int -> World -> World
+tryUseItem 
+    :: Int      -- ^ Creature id
+    -> World 
+    -> World
 tryUseItem cid w = case w ^? creatures . ix cid of
     Just cr -> itemEffect cid (_crInv cr IM.! _crInvSel cr) w
     Nothing -> w
@@ -20,11 +23,15 @@ tryUseItem cid w = case w ^? creatures . ix cid of
 equippedItemEffect :: Int -> World -> World
 equippedItemEffect n w = itemEffect n it w
   where 
-    c = (_creatures w IM.! n)
+    c = _creatures w IM.! n
     it = _crInv c IM.! _crInvSel c
 
-itemEffect :: Int -> Item -> World -> World
-itemEffect n (Consumable {_cnEffect=eff }) w = fromMaybe w $ fmap (rmSelectedInvItem n) $ eff n w
+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 (Weapon {_wpFire=eff}) w = eff n w
 itemEffect n (Throwable {_twFire = eff}) w = eff n w
 itemEffect _ _ w = w
diff --git a/src/Dodge/Creature/Property.hs b/src/Dodge/Creature/Property.hs
index a85e70050..c5bf9fc58 100644
--- a/src/Dodge/Creature/Property.hs
+++ b/src/Dodge/Creature/Property.hs
@@ -1,7 +1,6 @@
 module Dodge.Creature.Property
     where
 import Dodge.Data
-
 import Geometry
 
 import Control.Lens
diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs
index ea1491cc1..04dcf3f0b 100644
--- a/src/Dodge/Creature/State/Data.hs
+++ b/src/Dodge/Creature/State/Data.hs
@@ -86,6 +86,7 @@ data Carriage
     = Walking { _stepCycle :: Int, _stepToAdd :: Int }
     | Standing
     | Floating
+    | Flying
     | Boosting Point2
   deriving (Eq,Show)
 data Posture = Aiming | AtEase
diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs
index 0993ef015..c5c8901c2 100644
--- a/src/Dodge/Creature/YourControl.hs
+++ b/src/Dodge/Creature/YourControl.hs
@@ -21,7 +21,7 @@ yourControl w (f,g) cr = ( (updateUsingInput . f, g)
                          , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
                          )
   where 
-    strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
+    strafeSpeed = _varMovementSpeedModifier w * equipFactor * fromMaybe 1 (yourItem w ^? itAimingSpeed)
     speed = _varMovementSpeedModifier w * equipFactor
     equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
 
@@ -37,16 +37,16 @@ wasdWithAiming w speed aimSpeed i cr
           . set crDir mouseDir 
           $ set (crState . stance . carriage) (Boosting mov)
           cr
-    | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
+    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving && isAiming
         = set crDir mouseDir 
           $ set (crState . stance . carriage) Floating
           cr
-    | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving
+    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isMoving
         = over crPos (+.+ (speed *.* mov)) 
           . over crDir (flip fromMaybe dir) 
           $ set (crState . stance . carriage) (Boosting mov)
           cr
-    | (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming
+    | any (\it -> it ^? itIdentity == Just JetPack) (_crInv cr) && isAiming
         = set (crState . stance . carriage) Floating
           $ set crDir mouseDir 
           cr
@@ -61,25 +61,25 @@ wasdWithAiming w speed aimSpeed i cr
           cr
     | isMoving
         = stepForward speed
-          $ over ( crPos) (+.+ (speed *.* mov)) 
-          $ over ( crDir) (flip fromMaybe dir) 
+          $ over crPos (+.+ (speed *.* mov)) 
+          $ over crDir (`fromMaybe` dir) 
           $ set (crState . stance . carriage) (Walking 0 0)
           cr
     | otherwise
-        = over ( crDir) (flip fromMaybe dir) 
+        = over crDir (`fromMaybe` dir) 
           $ set (crState . stance . carriage) Standing
                         cr
   where 
     (mov',dir') = wasdComp (view keys w) w
     (mov,dir)   = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
     isMoving    = mov' /= (0,0)
-    isAiming    = (_posture $ _stance $ _crState cr) == Aiming
+    isAiming    = _posture (_stance $ _crState cr) == Aiming
     mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                               . itAttachment of
-          Just (Just (ItScope {_scopePos = p})) -> normalizeAngle $ argV
-                                  $ p +.+ 2 / _cameraZoom w 
-                                      *.* rotateV (_cameraRot w) (_mousePos w)
-          _                 -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
+        Just (Just ItScope{_scopePos = p}) -> normalizeAngle $ argV
+                                $ p +.+ 2 / _cameraZoom w 
+                                    *.* rotateV (_cameraRot w) (_mousePos w)
+        _ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
 
 
 wasdM :: World -> SDL.Scancode -> Point2
diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs
index c9bbf8681..df59ab36f 100644
--- a/src/Dodge/Event/Keyboard.hs
+++ b/src/Dodge/Event/Keyboard.hs
@@ -59,7 +59,7 @@ handlePressedKeyInGame _ w = Just w
 handlePressedKey :: Bool -> Scancode -> World -> Maybe World
 handlePressedKey True _       w = Just w
 handlePressedKey _    scode w
-    | _menuLayers w == [] 
+    | null (_menuLayers w)
                 = handlePressedKeyInGame scode w
     | otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
 handlePressedKey _ _ w = Just w
diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs
index 92e7a3d9d..da81e15a7 100644
--- a/src/Dodge/Floor.hs
+++ b/src/Dodge/Floor.hs
@@ -48,6 +48,10 @@ roomTreex = do
         t = treeFromTrunk 
             [[StartRoom]
             ,[Corridor]
+            ,[Corridor]
+            ,[SpecificRoom . pure . pure . Right $ roomGlassOctogon 200]
+            ,[Corridor]
+            ,[Corridor]
             ,[SpecificRoom . fmap (pure . Right) $ twinSlowDoorChasers 30]
             ,[Corridor]
             ,[DoorAno]
diff --git a/src/Dodge/Item/Consumable.hs b/src/Dodge/Item/Consumable.hs
index 4a8b2a09a..bc73d29c1 100644
--- a/src/Dodge/Item/Consumable.hs
+++ b/src/Dodge/Item/Consumable.hs
@@ -30,5 +30,5 @@ heal25 = heal 25
 heal :: Int -> Int -> World -> Maybe World
 heal hp n w | _crHP (_creatures w IM.! n) >= 10000 = Nothing
             | otherwise = Just $ soundOnce healSound 
-                               $ over (creatures . ix n . crHP) ((\x-> min x 10000). (+ hp) ) w
+                               $ over (creatures . ix n . crHP) ((min 10000) . (+ hp) ) w
 
diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs
index 4a1a67e56..ba2cb77a2 100644
--- a/src/Dodge/Item/Weapon.hs
+++ b/src/Dodge/Item/Weapon.hs
@@ -136,8 +136,7 @@ autoGun = defaultGun
 autoFireMode = shootWithSound (fromIntegral autoGunSound) 
     . torqueBefore 0.05
     $ autoGunNonTwistEff
-singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) 
-    $ autoGunNonTwistEff
+singleFireMode = hammerCheck $ shootWithSound (fromIntegral autoGunSound) autoGunNonTwistEff
 autoGunNonTwistEff = withRecoil 40
     . withRandomDir (autogunSpread/2)
     . withMuzFlare
@@ -612,12 +611,12 @@ aTeslaArc cid w = aTeslaArc' cid
                 $ soundFrom (CrWeaponSound cid) 25 1 0 w
 
 aTeslaArc' :: Int -> World -> World
-aTeslaArc' cid w = 
-                teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
-                $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
-                $ set randGen g w
+aTeslaArc' cid w 
+    = teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir)
+    $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) 
+    $ set randGen g w
   where 
-    cr  = (_creatures w IM.! cid)
+    cr  = _creatures w IM.! cid
     i = newProjectileKey w
     pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) 
                     +.+ sideOffset *.* vNormal (unitVectorAtAngle dir)
@@ -1019,13 +1018,18 @@ moveRemoteShell time i cid itid dir w
                           . _Just . scopePos .~ (newPos -.- _crPos (_creatures w' IM.! cid))
               _   -> w'
 
-explodeRemoteRocket :: Int -> Int -> Int -> World -> World
+explodeRemoteRocket 
+    :: Int  -- ^ Item id
+    -> Int  -- ^ Projectile id
+    -> Int 
+    -> World 
+    -> World
 explodeRemoteRocket itid pjid n w
     = set (projectiles . ix pjid . pjUpdate) (retireRemoteRocket itid 30 pjid)
-        $ set (projectiles . ix pjid . pjPict) blank
-        $ set (itPoint . wpFire) (flip const)
-        $ resetName
-        $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
+    $ set (projectiles . ix pjid . pjPict) blank
+    $ set (itPoint . wpFire) (const id)
+    $ resetName
+    $ makeExplosionAt (_pjPos (_projectiles w IM.! pjid)) w
   where 
     resetName = set (itPoint . itName) "REMOTELAUNCHER"
     itPoint = pointToItem $ _itemPositions w IM.! itid
@@ -1073,7 +1077,7 @@ explodeRemoteBomb :: Int -> Int -> Int -> World -> World
 explodeRemoteBomb itid pjid n w
     = set (projectiles . ix pjid . pjUpdate) (retireRemoteBomb itid 30 pjid)
         $ set (projectiles . ix pjid . pjPict) blank
-        $ set (creatures . ix n . crInv . ix j . twFire) (flip const)
+        $ set (creatures . ix n . crInv . ix j . twFire) (const id)
         $ resetName
         $ resetPict
 --        $ resetScope
diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs
index a795e7c05..c391189ea 100644
--- a/src/Dodge/Item/Weapon/Bullet.hs
+++ b/src/Dodge/Item/Weapon/Bullet.hs
@@ -17,7 +17,6 @@ import System.Random
 import Control.Lens
 import Control.Monad.State
 import qualified Data.IntMap.Strict as IM
-
 -- | Basic bullet hit creature effect.
 bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
 bulHitCr' bt p cr w 
@@ -38,10 +37,7 @@ bulHitCr' bt p cr w
     (d1,g)  = randomR (-0.7,0.7) $ _randGen w
     (colID,_) = randomR (0,11) $ _randGen w
     p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
-
-{- |
-Bounce off armoured creatures, otherwise do damage.
- -}
+{- | Bounce off armoured creatures, otherwise do damage.  -}
 bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr' bt p cr w 
     | crIsArmouredFrom p cr
@@ -65,10 +61,7 @@ bulBounceArmCr' bt p cr w
     bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
                                       (_btHitEffect' bt) (_btWidth' bt)
               ) {_btTimer' = _btTimer' bt - 1}
-
-{- |
-Bullet pass through creatures.
- -}
+{- | Bullet pass through creatures.  -}
 bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
 bulPenCr' bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
@@ -91,8 +84,7 @@ bulPenCr' bt p cr w
     piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) 
                                       (_btHitEffect' bt) (_btWidth' bt)
               ) {_btTimer' = _btTimer' bt - 1}
-{- | 
-Heavy bullet effects when hitting creature:
+{- | Heavy bullet effects when hitting creature:
 piercing, blunt, twisting and pushback damage all applied.  -}
 hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
 hvBulHitCr' bt p cr w 
@@ -111,8 +103,7 @@ hvBulHitCr' bt p cr w
     cid = _crID cr
     sp = head $ _btTrail' bt
     ep = sp +.+ _btVel' bt
-{- |
-Create a flamelet when hitting a creature.  -}
+{- | Create a flamelet when hitting a creature.  -}
 bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
 bulIncCr' bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
@@ -126,8 +117,7 @@ bulIncCr' bt p cr w
     ep = sp +.+ _btVel' bt
     v = evalState (randInCirc 1) $ _randGen w
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
-{- |
-Creates a shockwave when hitting a creature.  -}
+{- | Creates a shockwave when hitting a creature.  -}
 bulConCr' :: Particle -> Point2 -> Creature -> World -> World
 bulConCr' bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
@@ -140,8 +130,7 @@ bulConCr' bt p cr w
     sp = head $ _btTrail' bt
     ep = sp +.+ _btVel' bt
     mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
-{- |
-Hitting wall effects: create a spark, damage blocks.  -}
+{- | Hitting wall effects: create a spark, damage blocks.  -}
 bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
 bulHitWall' bt p x w = damageBlocks x
     $ createSpark 8 colID pOut (reflectDir x) Nothing
@@ -153,14 +142,11 @@ bulHitWall' bt p x w = damageBlocks x
     (colID,g) = randomR (0,11) $ _randGen w
     (a, _) = randomR (-0.1,0.1) $ _randGen w
     spid = newKey $ _projectiles w
-    reflectDir wall = a + 
-        argV (reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) (p -.- sp) )
+    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
     damageBlocks wall w = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
           _ -> w
-{- |
-Bounce off walls, do damage to blocks.
- -}
+{- | Bounce off walls, do damage to blocks.  -}
 bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
 bulBounceWall' bt p wl w = damageBlocks wl $ over worldEvents addBouncer w
   where 
@@ -168,20 +154,19 @@ 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 -> over (walls . ix j . blHP) (\y -> y - 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)
               ) {_btTimer' = _btTimer' bt - 1}
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
-    reflectVel = (reflectIn wallV (_btVel' bt))
-    addBouncer = (.) ( over particles (bouncer : ) )
+    wallV = uncurry (-.-) (_wlLine wl)
+    reflectVel = reflectIn wallV (_btVel' bt)
+    addBouncer = ( over particles (bouncer : ) . )
 -- the hack is to get around the fact that the particles list gets reset after
 -- all projectiles in it are checked, so we cannot add to it as we accumulate over
 -- this list
 
-{- | Create flamelet on wall.
- -}
+{- | Create flamelet on wall.  -}
 bulIncWall'
     :: Particle 
     -> Point2   -- Impact point
@@ -194,16 +179,15 @@ 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 -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
           _ -> w
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
+    wallV = uncurry (-.-) (_wlLine wl)
     reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
-
 {- | Create a shockwave on wall-}
 bulConWall'
     :: Particle 
-    -> Point2   -- Impact point
+    -> Point2   -- ^ Impact point
     -> Wall 
     -> World 
     -> World
@@ -213,14 +197,13 @@ 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 -> over (walls . ix j . blHP) (\y -> y - 5)) w (_blIDs wall)
+          Just hp -> foldr (\j -> (walls . ix j . blHP -~ 5)) w (_blIDs wall)
           _ -> w
-    wallV = (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
-    mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
+    mkwave = over worldEvents ((makeShockwaveAt [] p 15 4 1 white) . ) 
 
 hvBulHitWall' 
     :: Particle 
-    -> Point2   -- Impact point
+    -> Point2   -- ^ Impact point
     -> Wall 
     -> World 
     -> World
@@ -231,10 +214,10 @@ hvBulHitWall' bt p x w =  damageBlocks x $ set randGen g $ foldr ($) w (sparks p
     (a, g) = randomR (-0.1,0.1) $ _randGen w
     spid = newKey $ _projectiles w
     reflectDir wall = a + 
-        argV (reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) (p -.- sp) )
+        argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
     sv = unitVectorAtAngle $ reflectDir x
     damageBlocks wall w = case wall ^? blHP of 
-        Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 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
@@ -243,10 +226,7 @@ hvBulHitWall' bt p x w =  damageBlocks x $ set randGen g $ foldr ($) w (sparks p
 
 bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
 bulHitFF' _ _ _ = id
-
-{-
-Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.
- -}
+{- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.  -}
 basicBulletEffect :: HitEffect
 basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
 
diff --git a/src/Dodge/Item/Weapon/Laser.hs b/src/Dodge/Item/Weapon/Laser.hs
index e9057570d..7daea7d53 100644
--- a/src/Dodge/Item/Weapon/Laser.hs
+++ b/src/Dodge/Item/Weapon/Laser.hs
@@ -1,3 +1,4 @@
+{- | Laser effects -}
 module Dodge.Item.Weapon.Laser
     where
 import Dodge.Data
@@ -15,6 +16,7 @@ import Picture
 
 import Control.Lens
 import System.Random
+import Data.Tuple
 import Data.List (find)
 import Data.Maybe (fromMaybe)
 import qualified Data.Sequence as Seq
@@ -38,7 +40,6 @@ charToPhaseV 'V'    = 0.2
 charToPhaseV '/'   = 1
 charToPhaseV 'Z'    = 5
 
-
 makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle
 makeLaserAt phaseV pos dir mcid = Particle
     { _ptDraw = const blank
@@ -55,13 +56,12 @@ moveLaser
     -> (World, Maybe Particle)
 moveLaser phaseV pos dir mcid w pt
     = ( set randGen g $ hitEffect w
-      , Just pt {_ptDraw = const $ onLayer PtLayer $ pic ,_ptUpdate' = ptTimer' 0 }
+      , Just pt {_ptDraw = const $ onLayer PtLayer pic ,_ptUpdate' = ptTimer' 0 }
       )
   where 
     xp = pos +.+ 800 *.* unitVectorAtAngle dir
     (a,g)  = randomR (-0.7,0.7) $ _randGen w
-    reflectDir wall = a + 
-        (argV $ reflectIn ((fst $ _wlLine wall) -.- (snd $ _wlLine wall)) (xp -.- pos) )
+    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (xp -.- pos))
     (colID,_) = randomR (0,11) $ _randGen w
     f :: [Wall] -> Point2 -> Point2 -> (Maybe (Point2,Either3 Creature Wall ForceField),[Point2])
     f seenWs x y = case find (h' seenWs) $ thingsHitExceptCrLongLine Nothing x y w of
@@ -76,20 +76,23 @@ moveLaser phaseV pos dir mcid w pt
     h x y wl p | isEntering = p +.+ rotateV angleRef normalDist
                | otherwise = p +.+ rotateV angleRef' normalDist'
       where 
-        wlNormal = vNormal $ (snd $ _wlLine wl) -.- (fst $ _wlLine wl)
+        wlNormal = vNormal $ uncurry (-.-) $ swap (_wlLine wl)
         normalDist = magV (p -.- y) *.* normalizeV wlNormal
         angleInc = piRange $ argV wlNormal - argV (x -.- y)
-        angleRef | reflectExternal = angleInc
-                 | otherwise = asin $ sin angleInc / phaseV
-        piRange a | a > pi = a - 2 * pi
-                  | a > negate pi = a
-                  | otherwise  = a + 2 * pi
-        isEntering = isLeftOf (x -.- y) ((snd $ _wlLine wl) -.- (fst $ _wlLine wl))
+        angleRef 
+            | reflectExternal = angleInc
+            | otherwise = asin $ sin angleInc / phaseV
+        piRange a 
+            | a > pi = a - 2 * pi
+            | a > negate pi = a
+            | otherwise  = a + 2 * pi
+        isEntering = not $ isLeftOf (x -.- y) (uncurry (-.-) (_wlLine wl))
         wlNormal' = vNormal $ uncurry (-.-) (_wlLine wl)
         normalDist' = magV (p -.- y) *.* normalizeV wlNormal'
         angleInc' = piRange $ argV wlNormal' - argV (x -.- y)
-        angleRef' | reflectInternal = angleInc'
-                  | otherwise = asin $ phaseV * sin angleInc'
+        angleRef' 
+            | reflectInternal = angleInc'
+            | otherwise = asin $ phaseV * sin angleInc'
         reflectInternal = 1 < abs (phaseV * sin angleInc')
         reflectExternal = 1 < abs (sin angleInc / phaseV)
             
@@ -104,10 +107,11 @@ moveLaser phaseV pos dir mcid w pt
           Just (p,E3x2 wl) -> createSpark 8 colID (p +.+ safeNormalizeV (pos -.- p))
                                                       (reflectDir wl) Nothing
           _   -> id
-    pic = pictures [ fadeLine pos (head ps) 0.2 40 yellow
-                   , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
-                   , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
-                   ]
+    pic = pictures 
+        [ fadeLine pos (head ps) 0.2 40 yellow
+        , setLayer 1 $ color (withAlpha 0.9 white) $ vThickLine (pos:ps)
+        , setLayer 1 $ color (withAlpha 0.5 yellow) $ vvThickLine (pos:ps)
+        ]
 
 fadeLine :: Point2 -> Point2 -> Float -> Float -> Color -> Picture
 fadeLine sp ep alph width col = setLayer 1 $ polygonCol 
diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs
index b78d7b18b..6a48c43b5 100644
--- a/src/Dodge/Item/Weapon/TriggerType.hs
+++ b/src/Dodge/Item/Weapon/TriggerType.hs
@@ -351,10 +351,8 @@ torqueAfter torque feff cid w
     (rot, g) = randomR (-torque,torque) $ _randGen w
     rotateScope w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
                           . itAttachment . _Just . scopePos %~ rotateV rot 
-{- |
-Create multiple bullets with a given spread, a given amount, given velocity,
-given width and given 'HitEffect'.
- -}
+{- | Create multiple bullets with a given spread, a given amount, given velocity,
+given width and given 'HitEffect'.  -}
 spreadNumVelWthHiteff 
     :: Float    -- ^ Spread
     -> Int      -- ^ Number of bullets
@@ -371,15 +369,13 @@ spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++)
         (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth) 
         poss dirs colids
     poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
-              $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
-    dirs = map ((+) (_crDir cr)) 
-              $ zipWith (+) [-spread,-spread+(2*spread/fromIntegral num)..]
-                            $ randomRs (0,spread/5) (_randGen w)
+        $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
+    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)
-{- | 
-Create a number of bullets side by side with a given velocity,
-given width and given 'HitEffect'.
- -}
+{- | Create a number of bullets side by side with a given velocity,
+given width and given 'HitEffect'.  -}
 numVelWthHitEff 
     :: Int      -- ^ Amount of bullets
     -> Point2   -- ^ Velocity, x axis is direction of creature
diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs
index 42843c4c7..9509e8ba9 100644
--- a/src/Dodge/Item/Weapon/UseEffect.hs
+++ b/src/Dodge/Item/Weapon/UseEffect.hs
@@ -90,18 +90,17 @@ mvRadar
     -> Point2   -- ^ Center of expanding circle
     -> World -> Particle -> (World, Maybe Particle)
 mvRadar 0 _ w _  = (w, Nothing)
-mvRadar x p w pt = (putBlips w, Just $ pt {_ptDraw = const pic
-                              ,_ptUpdate' = mvRadar (x-1) p
-                              }
-                   )
+mvRadar x p w pt = 
+    ( putBlips w
+    , Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p }
+    )
   where 
-    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures $ sweepPics
-    putBlips = over worldEvents ((.) $ over particles ((++) blips))
-    blips = map (\p -> blipAt p (withAlpha (0.5*globalAlpha) red) 50) 
-                $ circPoints
-    circPoints = mapMaybe (\wl -> collidePointCircCorrect (fst $ _wlLine wl) (snd $ _wlLine wl) r p)
-                  $ (map (over wlLine swp) $ IM.elems $ wallsAlongCirc p r w)
-                      ++ (IM.elems $ wallsAlongCirc p r w)
+    pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics
+    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)
+                      ++ IM.elems (wallsAlongCirc p r w)
     swp (a,b) = (b,a)
     r = fromIntegral (800 - x*16)
     sweepPics = [--colHelper 0.1 $ uncurry translate p $ thickCircle r 15
@@ -117,14 +116,14 @@ aTractorBeam
     -> Int      -- ^ Creature id
     -> World 
     -> World
-aTractorBeam col cid w
-        = set (creatures . ix cid . crInv . ix itRef . wpFire)
-                        (shoot $ aTractorBeam ((col + 1) `mod` 10))
-                      $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
+aTractorBeam col cid w 
+    = set (creatures . ix cid . crInv . ix itRef . wpFire)
+        (shoot $ aTractorBeam ((col + 1) `mod` 10))
+    $ over projectiles (IM.insert i (tractorBeamAt col i pos dir)) w
   where 
     i = newProjectileKey w
-    cr  = (_creatures w IM.! cid)
-    pos = _crPos cr +.+ ((_crRad cr +10) *.* unitVectorAtAngle dir)
+    cr  = _creatures w IM.! cid
+    pos = _crPos cr +.+ ((_crRad cr + 10) *.* unitVectorAtAngle dir)
     dir = _crDir cr
     itRef = _crInvSel cr
 
diff --git a/src/Dodge/Layout/Tree/Annotate.hs b/src/Dodge/Layout/Tree/Annotate.hs
index ee81c1ae4..efe929456 100644
--- a/src/Dodge/Layout/Tree/Annotate.hs
+++ b/src/Dodge/Layout/Tree/Annotate.hs
@@ -76,7 +76,7 @@ annoToRoomTree [DoorNumAno i,AirlockAno] = airlock i >>=  roomThenCorridor
 annoToRoomTree [FirstWeapon] = do
     branchWP <- branchRectWith weaponRoom
     blockedC <- longBlockedCorridor
-    join $ takeOne $ (return $ appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
+    join $ takeOne $ return (appendEitherTree branchWP [blockedC]) : replicate 5 weaponRoom
 annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
 annoToRoomTree [StartRoom] = do
     w <- state $ randomR (100,400)
@@ -85,7 +85,7 @@ annoToRoomTree [StartRoom] = do
 annoToRoomTree (SpecificRoom rt:_) = rt
 annoToRoomTree (BossAno cr : _) = do
     br <- bossRoom cr
-    branchRectWith . pure . fmap (Left) $ treeFromPost [corridor,corridor] br
+    branchRectWith . pure . fmap Left $ treeFromPost [corridor,corridor] br
 annoToRoomTree (TreasureAno crs loot : _) =
     branchRectWith . fmap (pure . Left) $ lootRoom crs loot
 annoToRoomTree _ = do
diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs
index 89c1f2779..5cfbc89a6 100644
--- a/src/Dodge/Layout/Tree/Shift.hs
+++ b/src/Dodge/Layout/Tree/Shift.hs
@@ -26,13 +26,11 @@ shiftRoomTreeSearch
 shiftRoomTreeSearch _  Empty = Just []
 shiftRoomTreeSearch bs (Node r ts :<| ts')
     | roomIsClipping = Nothing
-    | otherwise = fmap (r :) $ shiftRoomTreeSearch newBounds $ ts' >< children
+    | otherwise = fmap (r :) . shiftRoomTreeSearch newBounds $ ts' >< children
   where
     roomIsClipping = or (polysIntersect <$> _rmBound r <*> bs)
     newBounds = _rmBound r ++ bs
-    children = fromList $ zipWith (\l -> applyToRoot (shiftRoomToLink l))
-                       (_rmLinks r)
-                       ts
+    children = fromList $ zipWith (applyToRoot . shiftRoomToLink) (_rmLinks r) ts
 {- |
 All: Depth first search of trees of rooms, produces a list of lists of rooms that are not clipping.
  -}
@@ -44,7 +42,7 @@ shiftRoomTreeSearchAll _ Empty = [[]]
 shiftRoomTreeSearchAll bs (Node r ts :<| ts')
     | roomIsClipping = [] -- this is called too often, but whatever
     | otherwise = case ts of
-        [] -> (r :) <$> (shiftRoomTreeSearchAll newBounds ts')
+        [] -> (r :) <$> shiftRoomTreeSearchAll newBounds ts'
         (s:ss) -> concatMap (\l -> shiftRoomTreeSearchAll bs (Node (rm l) ss <| (ts' |> f l s))) ls
   where
     ls = init $ _rmLinks r
diff --git a/src/Dodge/LevelGen/AutoDoor.hs b/src/Dodge/LevelGen/AutoDoor.hs
index 6a769442c..cfcfdd64b 100644
--- a/src/Dodge/LevelGen/AutoDoor.hs
+++ b/src/Dodge/LevelGen/AutoDoor.hs
@@ -1,4 +1,4 @@
-{-
+{- |
 Creation of doors that open when creatures approach them.
  -}
 {-# LANGUAGE BangPatterns #-}
@@ -68,11 +68,12 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane (pl,pr))
 
     addSound (x:xs) = f x : xs
     f wl = over doorMech g wl
-    g dm w | dist wp pld > 2 && dist wp hwd > 2 
-              = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
-           | otherwise = dm w
+    g dm w 
+        | dist wp pld > 2 && dist wp hwd > 2 
+            = soundFrom (WallSound (head xs)) (fromIntegral doorSound) 1 0 $ dm w
+        | otherwise = dm w
       where 
-        wp = snd (_wlLine $ _walls w IM.! (head xs))
+        wp = snd (_wlLine $ _walls w IM.! head xs)
 
 autoDoorPane 
     :: (Point2,Point2)  -- ^ Trigger line
diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs
index 5f79f2ac8..7969c22ce 100644
--- a/src/Dodge/LevelGen/Block.hs
+++ b/src/Dodge/LevelGen/Block.hs
@@ -1,5 +1,5 @@
-{-
-Creation, update and descruction of destructible walls.
+{- |
+Creation, update and destruction of destructible walls.
  -}
 module Dodge.LevelGen.Block where
 import Dodge.Data
@@ -26,17 +26,18 @@ updateBlocks w = (\w' -> seq (_wallsZone w') w') $ flip (foldr removeFromZone) d
     removeFromZone :: Wall -> World -> World
     removeFromZone bl = over (wallsZone . ix x . ix y) (IM.delete (_wlID bl))
       where 
-        (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine bl) (snd $ _wlLine bl)
+        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine bl)
     deadPanes = filter blockIsDead (IM.elems $ _walls w)
     deadBlocks = nubBy ((==) `on` _blIDs) deadPanes
     blockIsDead wl = case wl ^? blHP of 
         Just x  -> x <= 0
         Nothing -> False
-
+{- | Destroy a block.
+Plays destruction sound and sets to be displayed other walls that were shadowed by this wall. -}
 killBlock :: Wall -> World -> World
-killBlock bl w =  f bl .  flip (foldr unshadow) (_blShadows bl) $ w
+killBlock bl w =  f bl . flip (foldr unshadow) (_blShadows bl) $ w
   where
-    f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
+    f bl@Block{_blDegrades = (x:xs)} = degradeBlock bl . hitSound bl
     f bl          = hitSound' bl
     pos = fst $ _wlLine bl
     hitSound bl 
@@ -50,7 +51,7 @@ killBlock bl w =  f bl .  flip (foldr unshadow) (_blShadows bl) $ w
     unshadow :: Int -> World -> World
     unshadow bid w = case w ^? walls . ix bid of 
         Just b -> 
-            let (x,y) = zoneOfPoint $ pHalf (fst $ _wlLine b) (snd $ _wlLine b)
+            let (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine b)
             in w & wallsZone . ix x . ix y . ix bid . blVisible %~ const True
                  & walls . ix bid . blVisible %~ const True
         Nothing -> w
@@ -97,33 +98,34 @@ addBlock (p:ps) hp col isSeeThrough degradability w
     | hp <= 0 && null degradability = w
     | hp <= 0 = addBlock (p:ps) (head degradability + hp) col isSeeThrough (tail degradability) w
     | otherwise = w  
-            & wallsZone %~ flip (IM.foldr wallInZone) panes
-            & walls     %~ IM.union panes
+        & wallsZone %~ flip (IM.foldr wallInZone) panes
+        & walls     %~ IM.union panes
   where 
     lines = zip (p:ps) (ps ++ [p])
     i = newKey $ _walls w
     is = [i.. i + length lines-1]
-    panes = IM.fromList $ zip is 
-              $ zipWith (\j (a,b) -> Block { _wlLine = (a,b)
-                                           , _wlID = j
-                                           , _wlColor = col
-                                           , _wlSeen = False
-                                           , _blIDs = is
-                                           , _blHP = hp
-                                           , _wlIsSeeThrough = isSeeThrough
-                                           , _blVisible = True
-                                           , _blShadows = []
-                                           , _blDegrades = degradability
-                                           }
-                         ) is lines
+    panes = IM.fromList $ zip is $ zipWith 
+        (\j (a,b) -> Block 
+            { _wlLine = (a,b)
+            , _wlID = j
+            , _wlColor = col
+            , _wlSeen = False
+            , _blIDs = is
+            , _blHP = hp
+            , _wlIsSeeThrough = isSeeThrough
+            , _blVisible = True
+            , _blShadows = []
+            , _blDegrades = degradability
+            }
+        ) is lines
     wallInZone wl 
-        | dist (fst $ _wlLine wl) (snd $ _wlLine wl) <= 2*zoneSize 
-                      = 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 $ pHalf (fst $ _wlLine wl) (snd $ _wlLine wl)
+        (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
-        ips = map zoneOfPoint $ divideLine (2*zoneSize) (fst $ _wlLine wl) (snd $ _wlLine wl)
+        ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
         
 putBlock :: [Point2] -> Int -> Color -> Bool -> [Int] -> World -> World
 putBlock (p:ps) i c b is w = foldr (uncurry removePathsCrossing) wWithBlock pairs
diff --git a/src/Dodge/LevelGen/LineBlock.hs b/src/Dodge/LevelGen/LineBlock.hs
index 6a7f39133..d3fafa1b5 100644
--- a/src/Dodge/LevelGen/LineBlock.hs
+++ b/src/Dodge/LevelGen/LineBlock.hs
@@ -1,28 +1,26 @@
+{- | Splits a line into many four cornered blocks. -}
 module Dodge.LevelGen.LineBlock
-    (putLineBlock
+    ( putLineBlock
     )
     where
 import Dodge.Data
 import Dodge.Base
 import Dodge.LevelGen.Pathing
-
 import Picture
 import Geometry
 
 import Control.Lens
-
 import qualified Data.IntMap as IM
-
--- taken from online, splits a list into its even and odd elements
+-- | Taken from online, splits a list into its even and odd elements
 evenOddSplit = foldr f ([],[])
     where f a (ls,rs) = (rs, a : ls)
 
 putLineBlock 
-    :: Wall     -- Base pane
-    -> Float    -- Block width
-    -> Float    -- Block depth
-    -> Point2   -- Start point (symmetric)
-    -> Point2   -- End point (symmetric)
+    :: Wall     -- ^ Base pane
+    -> Float    -- ^ Block width
+    -> Float    -- ^ Block depth
+    -> Point2   -- ^ Start point (symmetric)
+    -> Point2   -- ^ End point (symmetric)
     -> World 
     -> World
 putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
@@ -30,7 +28,7 @@ putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr i
     d = dist a b
     rot = argV (b -.- a)
     psOnLine = divideLineOddNumPoints blockWidth a b
-    halfBlockWidth = d / (fromIntegral $ length psOnLine - 1)
+    halfBlockWidth = d / fromIntegral (length psOnLine - 1)
     blockCenPs = snd $ evenOddSplit psOnLine
     numBlocks = length blockCenPs
     is = [0.. numBlocks - 1]
diff --git a/src/Dodge/LevelGen/StaticWalls.hs b/src/Dodge/LevelGen/StaticWalls.hs
index 11c3b82c9..6abd72604 100644
--- a/src/Dodge/LevelGen/StaticWalls.hs
+++ b/src/Dodge/LevelGen/StaticWalls.hs
@@ -132,7 +132,7 @@ cutWalls' qs walls =
 expandPolyBy :: Float -> [Point2] -> [Point2]
 expandPolyBy x ps = map f ps
   where
-    cp = 1/(fromIntegral (length ps)) *.* foldr (+.+) (0,0) ps
+    cp = 1/fromIntegral (length ps) *.* foldr (+.+) (0,0) ps
     f p = p +.+ x *.* (p -.- cp)
 -- | Given a polygon expressed as a list of points and a collection of walls,
 -- returns: 
@@ -171,7 +171,7 @@ addPolyWall (p1,p2) walls =
         Just ws -> if all (\(x,y) -> isLHS x y p3) ws
             then walls
             else (p1,p2) : walls
-        Nothing -> ((p1,p2) : walls)
+        Nothing -> (p1,p2) : walls
   where 
     p3 = 0.5 *.* (p1 +.+ p2)
     p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs
index 5d8317653..a8b718f92 100644
--- a/src/Dodge/Path.hs
+++ b/src/Dodge/Path.hs
@@ -2,23 +2,20 @@ module Dodge.Path where
 import Dodge.Data
 import Dodge.Base
 import Dodge.Graph
-
 import Geometry
 
-import Control.Monad
-
 import Data.List
 import Data.Maybe
 import Data.Function
-import Data.Graph.Inductive.Graph
-import qualified Data.HashSet as HS
-import qualified Data.Heap as HP
-
-import qualified Data.Map as M
-
-import Data.Graph.Inductive.Graph
 import Data.Graph.Inductive.PatriciaTree
 import Data.Graph.Inductive.Query.SP
+import Data.Graph.Inductive.Graph hiding ((&))
+import qualified Data.HashSet as HS
+import qualified Data.Heap as HP
+import qualified Data.Map as M
+import Control.Monad
+import Control.Monad.State
+import System.Random
 
 worldGraph :: World -> Point2 -> HS.HashSet Point2
 worldGraph w p = HS.unions $ fmap (\q -> HS.fromList $ pointsAlong w p (p +.+ q)) 
@@ -164,3 +161,44 @@ maybeToEither :: a -> Maybe b -> Either a b
 maybeToEither _ (Just x) = Right x
 maybeToEither y Nothing  = Left y
 
+randomGraphStep :: RandomGen g => Int -> Gr a b -> State g (Maybe Int)
+randomGraphStep n g = 
+    do let ns = neighbors g n
+       i  <- state $ randomR (0,length ns - 1)
+       case ns of [] -> return Nothing
+                  _  -> return $ Just $ ns !! i
+randomGraphStepRestricted :: RandomGen g => Int -> [Int] -> Gr a b -> State g (Maybe Int)
+randomGraphStepRestricted n notns g = do 
+    let ns = neighbors g n \\ notns
+    i  <- state $ randomR (0,length ns - 1)
+    case ns of 
+        [] -> return Nothing
+        _  -> return $ Just $ ns !! i
+
+---- continues a walk from a list of points, without repetitions
+---- supposes that the list is non-empty
+randomGraphWalk :: RandomGen g => [Int] -> Gr a b -> State g [Int]
+randomGraphWalk (n:ns) g = do 
+    next <- randomGraphStepRestricted n ns g
+    case next of 
+        Nothing -> return (n:ns)
+        Just n' -> randomGraphWalk (n':n:ns) g
+
+randomPointXStepsFrom :: Int -> Point2 -> World -> Point2
+randomPointXStepsFrom i p w = 
+    let g  = _pathGraph w
+        ns = labNodes g
+        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
+    in case mp of 
+        Nothing -> p
+        Just (n,_) -> fromJust 
+            $ lab g (last $ take i $ randomGraphWalk [n] g Data.Function.& evalState  $ _randGen w)
+
+randomPointsXStepsFrom :: Int -> Point2 -> World -> [Point2]
+randomPointsXStepsFrom i p w = 
+    let g  = _pathGraph w
+        ns = labNodes g
+        mp = listToMaybe $ sortBy (compare `on` dist p . snd) $ filter (flip (isWalkable p) w . snd) ns
+    in case mp of 
+        Nothing -> [p]
+        Just (n,_) -> mapMaybe (lab g) (take i $ randomGraphWalk [n] g Data.Function.& evalState $ _randGen w)
diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs
index 0d3928ea5..a5f4340c1 100644
--- a/src/Dodge/Room/Boss.hs
+++ b/src/Dodge/Room/Boss.hs
@@ -19,10 +19,10 @@ import Data.Tree
 import Control.Monad.State
 import Control.Lens
 import System.Random
-roomOctogon
+roomGlassOctogon
     :: Float    -- ^ Size
     -> Room
-roomOctogon x = Room
+roomGlassOctogon x = Room
     { _rmPolys = [rectNSWE x (-x) (-x) x
                  ,rectNSWE 0 (-(x + 40)) (-20) 20
                  ]
@@ -63,7 +63,7 @@ armouredChasers = do
 
 randomMediumRoom :: RandomGen g => State g Room
 randomMediumRoom = takeOne 
-    [ roomOctogon 300
+    [ roomGlassOctogon 300
     , roomCross 180 300
     , roomShuriken 200 300
     , roomTwistCross 230 300 0
diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs
index f86944d41..0c8c2d7d6 100644
--- a/src/Dodge/Room/Procedural.hs
+++ b/src/Dodge/Room/Procedural.hs
@@ -1,6 +1,5 @@
-{-
-Procedural creation of rooms and subroom parts.
--}
+{- | 
+ Procedural creation of rooms and subroom parts.  -}
 module Dodge.Room.Procedural
     ( roomRect
     , roomRectAutoLinks
@@ -24,6 +23,7 @@ import Picture
 
 import Data.List (nub,nubBy,sortBy,minimumBy)
 import Data.Function (on)
+import qualified Data.Tuple.Extra as Tup
 import qualified Data.Map as M
 import Control.Lens
 import Control.Monad
@@ -49,10 +49,10 @@ roomRect x y xn yn = Room
   where 
     yd = (y - 40) / fromIntegral yn
     xd = (x - 40) / fromIntegral xn
-    elnks = flip zip (repeat ( pi/2)) $ translateS (0,20) $ gridPoints  0  1      yd (yn+1)
-    wlnks = flip zip (repeat (-pi/2)) $ translateS (x,20) $ gridPoints  0  1      yd (yn+1)
-    nlnks = flip zip (repeat (    0)) $ translateS (20,y) $ gridPoints xd (xn+1)  0  1
-    slnks = flip zip (repeat (   pi)) $ translateS (20,0) $ gridPoints xd (xn+1)  0  1
+    elnks = zip (translateS (0,20) $ gridPoints  0  1      yd (yn+1))  (repeat ( pi/2)) 
+    wlnks = zip (translateS (x,20) $ gridPoints  0  1      yd (yn+1))  (repeat (-pi/2)) 
+    nlnks = zip (translateS (20,y) $ gridPoints xd (xn+1)  0  1     )  (repeat      0 ) 
+    slnks = zip (translateS (20,0) $ gridPoints xd (xn+1)  0  1     )  (repeat     pi ) 
     lnks = nlnks ++ elnks ++ wlnks ++ slnks
     pth  = linksAndPath lnks $ translateS (20,20) (makeGrid xd xn yd yn)
 {-
@@ -65,7 +65,7 @@ makeGrid :: Float -> Int -> Float -> Int -> [(Point2,Point2)]
 makeGrid x nx y ny 
     = nub 
     . concatMap doublePair 
-    . concatMap (\p -> map (\(a,b) -> (p +.+ a,p +.+ b)) $ makeRect x y)
+    . concatMap (\p -> map (Tup.both (p +.+)) $ makeRect x y)
     $ gridPoints x nx y ny
 
 gridPoints :: Float -> Int -> Float -> Int -> [Point2]
diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs
index 86b6cf497..ac83b58e7 100644
--- a/src/Dodge/WorldEvent/SpawnParticle.hs
+++ b/src/Dodge/WorldEvent/SpawnParticle.hs
@@ -1,4 +1,4 @@
-{-
+{- |
 Creation of particles in the world.
  -}
 module Dodge.WorldEvent.SpawnParticle
@@ -26,6 +26,7 @@ import Control.Monad.State
 import Data.Function (on)
 import Data.List
 import Data.Maybe
+import Data.Tuple
 
 aFlameParticle 
     :: Int      -- ^ Timer
@@ -126,9 +127,8 @@ moveFlame rotd w pt
         , _btVel' = reflV wl
         }
     pOut p = p +.+ safeNormalizeV (sp -.- p)
-    reflV wall = (0.3 *.* reflectIn ((snd $ _wlLine wall) -.- (fst $ _wlLine wall)) vel )
-                    +.+
-                 (0.2 *.* vel)
+    reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
+        +.+ (0.2 *.* vel)
     smokeGen = makeFlamerSmokeAt ep
 
 makeFlameletTimed 
diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs
index c8bf1c884..54651412c 100644
--- a/src/Dodge/WorldEvent/ThingsHit.hs
+++ b/src/Dodge/WorldEvent/ThingsHit.hs
@@ -1,4 +1,4 @@
-{-
+{- |
 Find which objects lie upon a line.
  -}
 module Dodge.WorldEvent.ThingsHit
@@ -11,9 +11,7 @@ import qualified Data.IntMap.Strict as IM
 import Data.List
 import Data.Maybe
 import Data.Function (on)
-{-
-List those objects that appear on a line.
--}
+{- List those objects that appear on a line.  -}
 thingsHit 
     :: Point2    -- ^ Line start point
     -> Point2    -- ^ Line end point
@@ -23,26 +21,24 @@ thingsHit sp ep w
     | sp == ep  = []
     | otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
   where 
-    hitCrs   = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
-                                      $ _creatures w
---                                      $ creaturesAlongLine sp ep w
+    hitCrs = IM.elems 
+        $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
+        $ _creatures w
+    --    $ creaturesAlongLine sp ep w
     crPs     = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
     crs   = zip crPs (map E3x1 hitCrs)
-
     hitWls   = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
                                                                       , b<-[y-1,y,y+1]])
     (x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
-    f i m = case IM.lookup i m of Just val -> val
-                                  _        -> IM.empty
+    f i m = case IM.lookup i m of 
+        Just val -> val
+        _        -> IM.empty
     walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-    hitPoint w = intersectSegSeg' sp ep (fst $ _wlLine w) (snd $ _wlLine w)
+    hitPoint w = uncurry (intersectSegSeg' sp ep) (_wlLine w)
     hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
-
-{-
-List objects that appear on a line.
-Can filter out a creature.
--}
+{- List objects that appear on a line.
+Can filter out a creature.  -}
 thingsHitExceptCr 
     :: Maybe Int -- ^ A possible creature ID
     -> Point2    -- ^ Line start point
@@ -55,28 +51,32 @@ thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
     crNotCid (_,E3x1 cr) = _crID cr /= cid
     crNotCid _ = True
 
-thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World 
-                        -> [(Point2, Either3 Creature Wall ForceField)]
+thingsHitExceptCrLongLine 
+    :: Maybe Int 
+    -> Point2 
+    -> Point2 
+    -> World 
+    -> [(Point2, Either3 Creature Wall ForceField)]
 thingsHitExceptCrLongLine Nothing    sp ep = thingsHitLongLine sp ep
 thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
-    where crNotCid (_,E3x1 cr) = _crID cr /= cid
-          crNotCid _ = True
+  where 
+    crNotCid (_,E3x1 cr) = _crID cr /= cid
+    crNotCid _ = True
 
 thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
 thingsHitLongLine sp ep w 
     | sp == ep  = []
-    | otherwise = sortBy (compare `on` dist sp . fst) (crs ++  walls ++ ffs)
+    | otherwise = sortOn (dist sp . fst) (crs ++  walls ++ ffs)
   where 
     crs  = zip crPs (map E3x1 hitCrs)
-    hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
-                                  $ _creatures w
-                                --   $ creaturesAlongLine sp ep w
+    hitCrs = IM.elems 
+        . IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
+        $ _creatures w
+    --   $ creaturesAlongLine sp ep w
     crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
-
     walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
     hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
-    hitPoint wl = intersectSegSeg' sp ep (fst $ _wlLine wl) (snd $ _wlLine wl)
-
+    hitPoint wl = uncurry (intersectSegSeg' sp ep) (_wlLine wl)
     hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs