Refactor, try to limit dependencies

appDodge/Main.hs

@@ -10,7 +10,6 @@ import Dodge.Initialisation
 import Dodge.Update
 import Dodge.Event
 import Dodge.Render
-import Dodge.Config.KeyConfig
 import Dodge.Config.Load
 import Dodge.Config.Update
 import Dodge.SoundLogic.LoadSound
@@ -20,7 +19,6 @@ import Preload.Render
 import Sound
 import Preload
 import Music
-import Data.Preload
 import Data.Preload.Render
 
 import Control.Lens
@@ -73,7 +71,6 @@ theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
 firstWorldLoad :: Configuration -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
-    theKeyConfig <- loadKeyConfig
     pdata <- doPreload >>= applyWorldConfig theConfig
     return $ startNewGame $ Universe 
         {_uvWorld = initialWorld
@@ -81,7 +78,6 @@ firstWorldLoad theConfig = do
         ,_preloadData = pdata
         ,_menuLayers = []
         ,_savedWorlds = M.empty
-        ,_keyConfig = theKeyConfig
         , _uvIOEffects  = return
         , _uvTestString = testStringInit
         }

src/Dodge/Annotation.hs

@@ -7,7 +7,7 @@ module Dodge.Annotation
 import Dodge.Cleat
 import RandomHelp
 import Dodge.Tree
-import Dodge.Data
+import Dodge.Data.GenWorld
 import Dodge.Annotation.Data
 import LensHelp
 

src/Dodge/Annotation/Data.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Annotation.Data where
-import Dodge.Data
+import Dodge.Data.GenWorld
---import Dodge.Room
---import TreeHelp
 import Dodge.Tree.Compose.Data
 
 import Control.Monad.State

src/Dodge/ArcStep.hs

@@ -1,8 +1,9 @@
 module Dodge.ArcStep where
-import Dodge.Data
-import Dodge.Tesla.Arc.Default
 
 import Control.Monad.State
+import Dodge.Data.ArcStep
+import Dodge.Data.World
+import Dodge.Tesla.Arc.Default
 import System.Random
 
 doStep :: NextArcStep -> ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)

src/Dodge/Barreloid.hs

@@ -1,14 +1,14 @@
 module Dodge.Barreloid where
-import Dodge.Data
-import Dodge.WorldEvent.Explosion
-import Dodge.Spark
-import Dodge.Creature.State
-import Geometry
-import Dodge.SoundLogic
-import LensHelp
 
-import System.Random
 import Data.List
+import Dodge.Creature.State
+import Dodge.Data.World
+import Dodge.SoundLogic
+import Dodge.Spark
+import Dodge.WorldEvent.Explosion
+import Geometry
+import LensHelp
+import System.Random
 
 updateBarreloid :: Creature -> World -> World
 updateBarreloid cr = case cr ^?! crType . barrelType of
@@ -24,16 +24,21 @@ updateExpBarrel cr w
     g = _randGen w
     damages = _csDamage $ _crState cr
     pierceSparks :: [World -> World]
-    pierceSparks 
+    pierceSparks =
-      = zipWith3 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
+        zipWith3
-                            poss as colids
+            (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
+            poss
+            as
+            colids
     as = randomRs (-0.7, 0.7) g
     colids = randomRs (0, 11) g
     poss = _piercedPoints $ _csSpState $ _crState cr
     newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damToExpBarrel damages cr
-    applyFuseDamage cr' = cr' & crHP %~ 
+    applyFuseDamage cr' =
-        subtract (length . _piercedPoints . _csSpState $ _crState cr')
+        cr' & crHP
-    hiss | null poss = id
+            %~ subtract (length . _piercedPoints . _csSpState $ _crState cr')
+    hiss
+        | null poss = id
         | otherwise = soundMultiFrom [BarrelHiss 0, BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
     stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)
 
@@ -51,8 +56,9 @@ damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam
 
 damToExpBarrel' :: Damage -> Creature -> Creature
 damToExpBarrel' dm cr = case _dmType dm of
-    PIERCING    -> over (crState . csSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
+    PIERCING ->
-        $ cr & crHP -~ div amount 200
+        over (crState . csSpState . piercedPoints) ((:) $ int -.- _crPos cr) $
+            cr & crHP -~ div amount 200
     POISONDAM -> cr
     SPARKING -> cr
     --    PUSHDAM     -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))

src/Dodge/Base/CardinalPoint.hs

@@ -1,4 +1,5 @@
 module Dodge.Base.CardinalPoint where
+
 import Dodge.Data.Room
 import Geometry
 
@@ -11,5 +12,3 @@ cardVec cp = case cp of
     South -> V2 0 (-1)
     East -> V2 1 0
     West -> V2 (-1) 0
-
-

src/Dodge/Base/Collide.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TupleSections #-}
+
 {- | Basic collision detection for a moving point.
  - Conventions: input is typically a stream of walls.
  - Collide returns an endpoint and maybe a collided with
@@ -8,49 +9,48 @@
  - Overlap returns a stream of walls.
  - A point will typically be moving.
  - A ball refers to a moving circle, i.e. a point with a radius.
- - -}
+ -
-module Dodge.Base.Collide
+-}
-    ( collidePoint
+module Dodge.Base.Collide (
-    , collideSegCrs
+    collidePoint,
-    , collidePointWallsFilterStream
+    collideSegCrs,
-    , collidePointTestFilter
+    collidePointWallsFilterStream,
-    , overlapSegWalls
+    collidePointTestFilter,
-    , overlapSegCrs
+    overlapSegWalls,
-    , overlap1SegCrs
+    overlapSegCrs,
-    , bounceBall
+    overlap1SegCrs,
-    , bouncePoint
+    bounceBall,
-    , sortStreamOn
+    bouncePoint,
-    , minStreamOn
+    sortStreamOn,
-    , collideCircWallsStream
+    minStreamOn,
-    , circOnSomeWall
+    collideCircWallsStream,
-    , circOnAnyCr
+    circOnSomeWall,
-    , overlapCircWalls
+    circOnAnyCr,
-    , overlapCircWallsClosest
+    overlapCircWalls,
-    , crsNearPoint
+    overlapCircWallsClosest,
-    , allVisibleWalls
+    crsNearPoint,
-
+    allVisibleWalls,
-    , hasLOS
+    hasLOS,
-    , hasLOSIndirect
+    hasLOSIndirect,
-    , hasButtonLOS
+    hasButtonLOS,
-    , canSee
+    canSee,
-    , canSeeIndirect
+    canSeeIndirect,
-    , isWalkable
+    isWalkable,
-
+    anythingHitCirc,
-    , anythingHitCirc
 ) where
-import Dodge.Data
-import Dodge.Zoning
-import Dodge.Base.Wall
-import Geometry
-import FoldableHelp
 
+import Control.Lens
+import qualified Data.IntSet as IS
 import Data.List (sortOn)
 import Data.Maybe
+import Dodge.Base.Wall
+import Dodge.Data.World
+import Dodge.Zoning
+import FoldableHelp
+import Geometry
 import qualified IntMapHelp as IM
-import Control.Lens
-import StreamingHelp
 import qualified Streaming.Prelude as S
-import qualified Data.IntSet as IS
+import StreamingHelp
 
 --collidePoint :: Point2 -> Point2
 --    -> StreamOf Wall
@@ -60,50 +60,65 @@ import qualified Data.IntSet as IS
 --  where
 --    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
-collidePoint :: Point2 -> Point2 
+collidePoint ::
-    -> [Wall]
+    Point2 ->
-    -> (Point2, Maybe Wall)
+    Point2 ->
+    [Wall] ->
+    (Point2, Maybe Wall)
 {-# INLINE collidePoint #-}
 collidePoint sp ep = foldl' findPoint (ep, Nothing)
   where
     findPoint (p, mwl) wl = maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
-overlap1SegCrs :: Point2 -> Point2 
+overlap1SegCrs ::
-    -> [Creature]
+    Point2 ->
-    -> [(Point2, Creature)]
+    Point2 ->
+    [Creature] ->
+    [(Point2, Creature)]
 {-# INLINE overlap1SegCrs #-}
-overlap1SegCrs sp ep = mapMaybe 
+overlap1SegCrs sp ep =
+    mapMaybe
         (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep))
 
-overlapSegCrs :: Point2 -> Point2 
+overlapSegCrs ::
-    -> StreamOf Creature
+    Point2 ->
-    -> StreamOf ([Point2], Creature)
+    Point2 ->
+    StreamOf Creature ->
+    StreamOf ([Point2], Creature)
 {-# INLINE overlapSegCrs #-}
-overlapSegCrs sp ep = S.mapMaybe 
+overlapSegCrs sp ep =
+    S.mapMaybe
         (\cr -> f cr $ intersectCircSeg (_crPos cr) (_crRad cr) sp ep)
   where
     f _ [] = Nothing
     f cr ps = Just (ps, cr)
 
-collideSegCrs :: Point2 -> Point2 
+collideSegCrs ::
-    -> StreamOf Creature
+    Point2 ->
-    -> (Point2, Maybe Creature)
+    Point2 ->
+    StreamOf Creature ->
+    (Point2, Maybe Creature)
 {-# INLINE collideSegCrs #-}
 collideSegCrs sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id
   where
-    findPoint (p,mcr) cr 
+    findPoint (p, mcr) cr =
-        = maybe (p,mcr) (,Just cr) $ listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp p)
+        maybe (p, mcr) (,Just cr) $ listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp p)
 
 doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
 {-# INLINE doBounce #-}
-doBounce x sp ep (p, mwl) = mwl <&> \wl ->
+doBounce x sp ep (p, mwl) =
+    mwl <&> \wl ->
         ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
         , reflVelWallDamp x wl (ep -.- sp)
         )
 
-bounceBall :: Float -> Point2 -> Point2 -> Float 
+bounceBall ::
-    -> [Wall]
+    Float ->
-    -> Maybe (Point2,Point2)
+    Point2 ->
+    Point2 ->
+    Float ->
+    [Wall] ->
+    Maybe (Point2, Point2)
 {-# INLINE bounceBall #-}
 bounceBall x sp ep r = doBounce x sp ep . collideCircWalls sp ep r
 
@@ -115,8 +130,8 @@ bouncePoint t x sp ep = doBounce x sp ep . collidePointWallsFilterStream t sp ep
 -- whether this is actually faster
 collidePointTestFilter :: (Wall -> Bool) -> Point2 -> Point2 -> [Wall] -> Bool
 {-# INLINE collidePointTestFilter #-}
-collidePointTestFilter t sp ep 
+collidePointTestFilter t sp ep =
-    = any (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
+    any (isJust . uncurry (intersectSegSeg sp ep) . _wlLine)
         . filter t
 
 ---- this COULD be written in terms of collidePointWallsFilterStream, TODO test
@@ -129,7 +144,8 @@ collidePointTestFilter t sp ep
 
 collidePointWallsFilterStream :: (Wall -> Bool) -> Point2 -> Point2 -> World -> (Point2, Maybe Wall)
 {-# INLINE collidePointWallsFilterStream #-}
-collidePointWallsFilterStream t sp ep = collidePoint sp ep
+collidePointWallsFilterStream t sp ep =
+    collidePoint sp ep
         . filter t
         . wlsNearSeg sp ep
 
@@ -144,7 +160,8 @@ overlapSegWalls sp ep = mapMaybe $ \wl -> uncurry (intersectSegSeg sp ep) (_wlLi
 
 visibleWalls :: Point2 -> Point2 -> World -> [(Point2, Wall)]
 {-# INLINE visibleWalls #-}
-visibleWalls sp ep = takeUntil (not . wlIsOpaque . snd)
+visibleWalls sp ep =
+    takeUntil (not . wlIsOpaque . snd)
         . sortOn (dist sp . fst)
         . overlapSegWalls sp ep
         . wlsNearSeg sp ep
@@ -177,8 +194,11 @@ allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays
 --    dointersect wl = f (_wlLine wl) <&> (,wl)
 --    f (a,b) = intersectSegSeg p (p +.+ r *.* normalizeV ((0.5 *.* (a +.+ b)) -.- p)) a b
 
-overlapCircWalls :: Point2 -> Float -> [Wall]
+overlapCircWalls ::
-    -> [(Point2,Wall)]
+    Point2 ->
+    Float ->
+    [Wall] ->
+    [(Point2, Wall)]
 {-# INLINE overlapCircWalls #-}
 overlapCircWalls p r = mapMaybe dointersect
   where
@@ -190,10 +210,15 @@ collideCircWalls :: Point2 -> Point2 -> Float -> [Wall] -> (Point2, Maybe Wall)
 {-# INLINE collideCircWalls #-}
 collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
   where
-    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) 
+    findPoint (p, mwl) wl =
+        maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p)
             . shiftbyrad
-        . _wlLine $ wl
+            . _wlLine
-    shiftbyrad (a,b) = bimap f f
+            $ wl
+    shiftbyrad (a, b) =
+        bimap
+            f
+            f
             ( a +.+ rad *.* normalizeV (a -.- b)
             , b +.+ rad *.* normalizeV (b -.- a)
             )
@@ -201,15 +226,24 @@ collideCircWalls sp ep rad = foldl' findPoint (ep, Nothing)
         f = (+.+) (rad *.* normalizeV (vNormal $ a -.- b))
 
 -- | note that this does not push the circle away from the wall at all
-collideCircWallsStream :: Point2 -> Point2 -> Float -> StreamOf Wall
+collideCircWallsStream ::
-    -> (Point2, Maybe Wall)
+    Point2 ->
+    Point2 ->
+    Float ->
+    StreamOf Wall ->
+    (Point2, Maybe Wall)
 {-# INLINE collideCircWallsStream #-}
 collideCircWallsStream sp ep rad = runIdentity . S.fold_ findPoint (ep, Nothing) id
   where
-    findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) 
+    findPoint (p, mwl) wl =
+        maybe (p, mwl) (,Just wl) . uncurry (intersectSegSeg sp p)
             . shiftbyrad
-        . _wlLine $ wl
+            . _wlLine
-    shiftbyrad (a,b) = bimap f f
+            $ wl
+    shiftbyrad (a, b) =
+        bimap
+            f
+            f
             ( a +.+ rad *.* normalizeV (a -.- b)
             , b +.+ rad *.* normalizeV (b -.- a)
             )
@@ -218,7 +252,8 @@ collideCircWallsStream sp ep rad = runIdentity . S.fold_ findPoint (ep, Nothing)
 
 overlapCircWallsClosest :: Point2 -> Float -> [Wall] -> Maybe (Point2, Wall)
 {-# INLINE overlapCircWallsClosest #-}
-overlapCircWallsClosest p r = safeMinimumOn (dist p . fst)
+overlapCircWallsClosest p r =
+    safeMinimumOn (dist p . fst)
         . overlapCircWalls p r
 
 --overlapCircWallsClosest :: Point2 -> Float -> StreamOf Wall -> Maybe (Point2,Wall)
@@ -227,10 +262,12 @@ overlapCircWallsClosest p r = safeMinimumOn (dist p . fst)
 --    . overlapCircWalls p r
 
 {- | Test if a circle collides with any wall.
- - Note no check on whether the wall is walkable. -}
+ - Note no check on whether the wall is walkable.
+-}
 circOnSomeWall :: Point2 -> Float -> World -> Bool
 {-# INLINE circOnSomeWall #-}
-circOnSomeWall p rad = any (uncurry (circOnSeg p rad) . _wlLine)
+circOnSomeWall p rad =
+    any (uncurry (circOnSeg p rad) . _wlLine)
         . wlsNearPoint p
 
 --circOnSomeWall :: Point2 -> Float -> World -> Bool
@@ -244,29 +281,32 @@ circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
   where
     f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? cWorld . creatures . ix cid) || bl
 
-{- | More general collision tests follow -}
+-- | More general collision tests follow
-
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
-hasLOS p1 p2 = not 
+hasLOS p1 p2 =
+    not
         . collidePointTestFilter (const True) p1 p2
         . wlsNearSeg p1 p2
 
 hasButtonLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasButtonLOS #-}
-hasButtonLOS p1 p2 = not
+hasButtonLOS p1 p2 =
+    not
         . collidePointTestFilter (not . _wlTouchThrough) p1 p2
         . wlsNearSeg p1 p2
 
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOSIndirect #-}
-hasLOSIndirect p1 p2 = not
+hasLOSIndirect p1 p2 =
+    not
         . collidePointTestFilter wlIsOpaque p1 p2
         . wlsNearSeg p1 p2
 
 isWalkable :: Point2 -> Point2 -> World -> Bool
 {-# INLINE isWalkable #-}
-isWalkable p1 p2 = not 
+isWalkable p1 p2 =
+    not
         . collidePointTestFilter (not . (^?! wlPathable)) p1 p2
         . wlsNearSeg p1 p2
 
@@ -288,9 +328,13 @@ anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
 anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
   where
     hitCr = IS.foldr f False $ crsNearSeg sp ep w
-    f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
+    f cid bl =
+        maybe
+            False
+            (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
             (w ^? cWorld . creatures . ix cid)
             || bl
 
     hitWl = collideCircWalls sp ep rad $ wlsNearPoint ep w
+
 -- this should probably be wallsOnLine or something

src/Dodge/Base/Coordinate.hs

@@ -1,38 +1,48 @@
 module Dodge.Base.Coordinate where
-import Dodge.Data
-import Dodge.Base.WinScale
 
+import Dodge.Base.WinScale
+import Dodge.Data.Universe
 import Geometry
-{- | Transform coordinates from world position to screen coordinates.  -}
+
+-- | Transform coordinates from world position to screen coordinates.
 worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
 worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
   where
     doTranslate p = p -.- _cameraCenter (_cWorld w)
     doZoom p = _cameraZoom (_cWorld w) *.* p
     doRotate p = rotateV (negate $ _cameraRot (_cWorld w)) p
+
 {- | Transform world coordinates to scaled screen coordinates.
  - These have to be scaled according to the size of the window to get actual screen positions.
- - This allows for line thicknesses etc to correspond to pixel sizes.-}
+ - This allows for line thicknesses etc to correspond to pixel sizes.
+-}
 worldPosToScreen :: World -> Point2 -> Point2
-worldPosToScreen w 
+worldPosToScreen w =
-    = rotateV (negate $ _cameraRot (_cWorld w)) 
+    rotateV (negate $ _cameraRot (_cWorld w))
         . (_cameraZoom (_cWorld w) *.*)
         . (-.- _cameraCenter (_cWorld w))
+
 {- | Transform coordinates from the map position to screen
-coordinates.  -}
+coordinates.
+-}
 cartePosToScreen :: Configuration -> World -> Point2 -> Point2
 cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
   where
     doTranslate p = p -.- _carteCenter (_hud (_cWorld w))
     doZoom p = _carteZoom (_hud (_cWorld w)) *.* p
     doRotate p = rotateV (negate $ _carteRot (_hud (_cWorld w))) p
+
 crToMousePosOffset :: Creature -> World -> (Point2, Float)
 crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-{- | The mouse position in world coordinates.  -}
+
+-- | The mouse position in world coordinates.
 mouseWorldPos :: World -> Point2
-mouseWorldPos w = _cameraCenter (_cWorld w) +.+ 
+mouseWorldPos w =
-    (1/_cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w)
+    _cameraCenter (_cWorld w)
-{- | The mouse position in map coordinates -}
+        +.+ (1 / _cameraZoom (_cWorld w)) *.* rotateV (_cameraRot (_cWorld w)) (_mousePos w)
+
+-- | The mouse position in map coordinates
 mouseCartePos :: World -> Point2
-mouseCartePos w = _carteCenter (_hud (_cWorld w)) +.+ 
+mouseCartePos w =
-    (1/_carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w)
+    _carteCenter (_hud (_cWorld w))
+        +.+ (1 / _carteZoom (_hud (_cWorld w))) *.* rotateV (_carteRot (_hud (_cWorld w))) (_mousePos w)

src/Dodge/Base/Item.hs

@@ -1,27 +0,0 @@
-module Dodge.Base.Item 
-    (
-    ) where
---import Dodge.Data
---import Dodge.Base.You
---import LensHelp
---
---import qualified IntMapHelp as IM
-
---selectedObject :: World -> Maybe (Either FloorItem Button)
---selectedObject w = lookup (_crInvSel ycr) $ zip [n..] $ _closeObjects w
---  where
---    ycr = you w
---    n = length $ _crInv ycr
---
---crItem :: World -> Int -> Item
---crItem w cid = _crInv cr IM.! _crInvSel cr
---  where
---    cr = _creatures w IM.! cid
---
---yourItemRef
---    :: Applicative f
---    => World
---    -> (Item -> f Item)
---    -> World
---    -> f World
---yourItemRef w = creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))

src/Dodge/Base/Wall.hs

@@ -1,5 +1,6 @@
 module Dodge.Base.Wall where
-import Dodge.Data
+
+import Dodge.Data.Wall
 import Geometry
 
 wlIsOpaque :: Wall -> Bool

src/Dodge/Base/Window.hs

@@ -1,41 +1,47 @@
-{- | Getting the window size geometry. -}
+-- | Getting the window size geometry.
-module Dodge.Base.Window
+module Dodge.Base.Window (
-    ( halfWidth
+    halfWidth,
-    , halfHeight
+    halfHeight,
-    , screenPolygon
+    screenPolygon,
-    , screenPolygonBord
+    screenPolygonBord,
-    , screenBox
+    screenBox,
-    )
+) where
-    where
+
-import Dodge.Data
+import Dodge.Data.Universe
 import Geometry
 
 -- | A box covering the screen in world coordinates
 screenPolygon :: Configuration -> World -> [Point2]
 screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
---    [tr,tl,bl,br]
   where
+    --    [tr,tl,bl,br]
+
     scRot = rotateV (_cameraRot (_cWorld w))
-    scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
+    scZoom p
+        | _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
         | otherwise = p
     scTran p = p +.+ _cameraCenter (_cWorld w)
+
 --    tr = scTran $ scRot $ scZoom (V2 ( halfWidth w) ( halfHeight w))
 --    tl = scTran $ scRot $ scZoom (V2 (-halfWidth w) ( halfHeight w))
 --    br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w))
 --    bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w))
 
 -- | A box covering the screen in world coordinates, with a x and y border
-screenPolygonBord 
+screenPolygonBord ::
-    :: Float    -- ^ X border
+    -- | X border
-    -> Float    -- ^ Y border
+    Float ->
-    -> Configuration
+    -- | Y border
-    -> World
+    Float ->
-    -> [Point2]
+    Configuration ->
+    World ->
+    [Point2]
 screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
   where
     hw = halfWidth cfig - xbord
     hh = halfHeight cfig - ybord
-    scZoom p | _cameraZoom (_cWorld w) /= 0   = (1/_cameraZoom (_cWorld w)) *.* p
+    scZoom p
+        | _cameraZoom (_cWorld w) /= 0 = (1 / _cameraZoom (_cWorld w)) *.* p
         | otherwise = p
     theTransform = (+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w)) . scZoom
     tr = theTransform (V2 hw hh)
@@ -46,6 +52,7 @@ screenPolygonBord xbord ybord cfig w = [tr,tl,bl,br]
 halfWidth, halfHeight :: Configuration -> Float
 halfWidth w = _windowX w / 2
 halfHeight w = _windowY w / 2
+
 -- | A box of the size of the screen in screen centered coordinates
 screenBox :: Configuration -> [Point2]
 screenBox w = rectNSWE hh (- hh) (- hw) hw

src/Dodge/Base/You.hs

@@ -1,8 +1,7 @@
 module Dodge.Base.You where
-import Dodge.Data
+
---import Picture
+import Dodge.Data.World
 import qualified IntMapHelp as IM
---import Control.Lens
 
 you :: World -> Creature
 you w = _creatures (_cWorld w) IM.! _yourID (_cWorld w)

src/Dodge/Beam.hs

@@ -1,46 +1,57 @@
 module Dodge.Beam where
-import Dodge.Data
+
+import Data.Maybe
+import Dodge.Data.World
 import Dodge.Flame
-import Dodge.Tesla.Arc
 import Dodge.Item.Location
+import Dodge.Tesla.Arc
 import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
 import Picture
 
-import Data.Maybe
+doBeamCombine ::
-import qualified IntMapHelp as IM
+    BeamCombineType ->
-
+    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-doBeamCombine :: BeamCombineType 
+    World ->
-    -> (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    World
-    -> World 
-    -> World
 doBeamCombine bct = case bct of
     FlameBeamCombine -> flameBeamCombine
     LasBeamCombine -> lasBeamCombine
     TeslaBeamCombine -> teslaBeamCombine
     SplitBeamCombine -> splitBeamCombine
     NoBeamCombine -> const id
-flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-flameBeamCombine (p,(a,b,_),(x,y,_))
-    = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
-lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-lasBeamCombine (p,(a,b,_),(x,y,_)) 
-    = cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
 
-splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+flameBeamCombine ::
-    -> World -> World
+    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-splitBeamCombine (p,(a,b,_),(x,y,_)) 
+    World ->
-    = (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
+    World
+flameBeamCombine (p, (a, b, _), (x, y, _)) =
+    makeFlame p (2 *.* normalizeV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
+
+lasBeamCombine ::
+    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+    World ->
+    World
+lasBeamCombine (p, (a, b, _), (x, y, _)) =
+    cWorld . lasers .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x)))
+
+splitBeamCombine ::
+    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
+    World ->
+    World
+splitBeamCombine (p, (a, b, _), (x, y, _)) =
+    (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir + 0.5 * pi))
         . (cWorld . lasers .:~ lasRayAt yellow 11 1 p (dir -0.5 * pi))
   where
     dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
 
-teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+teslaBeamCombine ::
-    -> World -> World
+    (Point2, (Point2, Point2, Beam), (Point2, Point2, Beam)) ->
-teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
+    World ->
-    = w' & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
+    World
+teslaBeamCombine (p, (a, b, bm), (x, y, _)) w =
+    w' & pointerToItemLocation (_itemLocations (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
   where
     itid = fromJust $ _bmOrigin bm
     dir = argV (normalizeV (b -.- a) +.+ normalizeV (y -.- x))
@@ -50,7 +61,8 @@ teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
         Just itm -> itm
 
 lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> LaserStart
-lasRayAt col dam phasev pos dir = LaserStart
+lasRayAt col dam phasev pos dir =
+    LaserStart
         { _lpType = DamageLaser dam
         , _lpPhaseV = phasev
         , _lpPos = pos

src/Dodge/Beam/Draw.hs

@@ -1,4 +1,5 @@
 module Dodge.Beam.Draw where
+
 import Dodge.Data.Beam
 import Picture
 
@@ -8,7 +9,9 @@ drawBeam bd = case bd of
     BeamDrawColor _ -> basicDrawBeam
 
 basicDrawBeam :: Beam -> Picture
-basicDrawBeam bm = setLayer BloomNoZWrite $ pictures
+basicDrawBeam bm =
+    setLayer BloomNoZWrite $
+        pictures
             [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps
             , setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
             ]

src/Dodge/Block.hs

@@ -1,31 +1,33 @@
 module Dodge.Block where
-import Dodge.DrWdWd
+
-import Dodge.Zoning.Wall
+import Dodge.Data.MountedObject
-import Dodge.Data
+import Control.Lens
+import Data.Foldable
+import qualified Data.Graph.Inductive as FGL
+import qualified Data.IntSet as IS
+import Data.Maybe
 import Dodge.Base.Collide
-import Dodge.Material.Sound
 import Dodge.Block.Debris
+import Dodge.Data.World
+import Dodge.DrWdWd
 import Dodge.LightSource
-import Dodge.Wall.Zone
+import Dodge.Material.Sound
-import Dodge.WorldEvent.Sound
 import Dodge.Wall.Delete
 import Dodge.Wall.Dust
-import RandomHelp
+import Dodge.Wall.Zone
+import Dodge.WorldEvent.Sound
+import Dodge.Zoning.Wall
 import Geometry
---import Geometry.ConvexPoly
-
-import Data.Foldable
-import Data.Function
-import Data.Maybe
-import qualified Data.IntSet as IS
 import qualified IntMapHelp as IM
-import Control.Lens
+import RandomHelp
-import qualified Data.Graph.Inductive as FGL
 
 splinterBlock :: Block -> World -> World
-splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
+splinterBlock bl w =
-    & originsIDsAt [MaterialSound bm 0,MaterialSound bm 1,MaterialSound bm 2]
+    foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
-        (weakenMatS bm) (_blPos bl)
+        & originsIDsAt
+            [MaterialSound bm 0, MaterialSound bm 1, MaterialSound bm 2]
+            (weakenMatS bm)
+            (_blPos bl)
   where
     bm = fromMaybe Stone $ do
         wlids <- w ^? cWorld . blocks . ix (_blID bl) . blWallIDs
@@ -34,7 +36,8 @@ splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardC
 
 unshadowBlock :: Int -> World -> World
 unshadowBlock wlid w = case w ^? cWorld . walls . ix wlid of
-    Just wl -> w
+    Just wl ->
+        w
             & cWorld . walls . ix wlid . wlUnshadowed .~ True
             & insertWallInZones (wl & wlUnshadowed .~ True)
     Nothing -> w
@@ -45,7 +48,8 @@ checkBlockHP bl
     | otherwise = id
 
 destroyBlock :: Block -> World -> World
-destroyBlock bl w = w
+destroyBlock bl w =
+    w
         & flip (foldr unshadowBlock) (_blShadows bl)
         & makeBlockDebris bl
         & deleteWallIDs wlids
@@ -65,12 +69,13 @@ maybeClearPaths ps w = foldl' maybeClearPath w ps
 
 maybeClearPath :: World -> (Int, Int, PathEdge) -> World
 maybeClearPath w (x, y, pe)
-    | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w
+    | not . null $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w =
-        = w
+        w
     | otherwise = w & cWorld . pathGraph %~ FGL.insEdge (x, y, pe & peObstacles .~ mempty) . FGL.delEdge (x, y)
 
 destroyDoor :: Door -> World -> World
-destroyDoor dr w = w
+destroyDoor dr w =
+    w
         & doDrWdWd (_drDeath dr) dr
         & deleteWallIDs wlids
         & cWorld . doors %~ IM.delete (_drID dr)
@@ -95,5 +100,6 @@ stopPushing :: Maybe Int -> World -> World
 stopPushing mdrid w = fromMaybe w $ do
     drid <- mdrid
     dr <- w ^? cWorld . doors . ix drid
-    return $ w & cWorld . doors . ix drid . drMech .~ DrWdId
+    return $
+        w & cWorld . doors . ix drid . drMech .~ DrWdId
             & stopPushing (_drPushes dr)

src/Dodge/Block/Debris.hs

@@ -1,19 +1,19 @@
 module Dodge.Block.Debris where
-import Dodge.Material.Sound
-import Dodge.WorldEvent.Sound
-import Dodge.Base
-import Dodge.Data
-import Shape
-import Geometry
-import Color
-import LensHelp
-import RandomHelp
-import Grid
-import qualified Quaternion as Q
 
+import Color
+import Data.Foldable
 import qualified Data.IntSet as IS
 import Data.Maybe
-import Data.Foldable
+import Dodge.Base
+import Dodge.Data.World
+import Dodge.Material.Sound
+import Dodge.WorldEvent.Sound
+import Geometry
+import Grid
+import LensHelp
+import qualified Quaternion as Q
+import RandomHelp
+import Shape
 
 makeDoorDebris :: Door -> World -> World
 makeDoorDebris dr w = w & makeDebris mt col p
@@ -26,7 +26,6 @@ makeDoorDebris dr w = w & makeDebris mt col p
         return (_wlMaterial wl, _wlColor wl)
 
 makeBlockDebris :: Block -> World -> World
---makeBlockDebris bl w = w & makeDebris mt col (_blPos bl)
 makeBlockDebris bl w = foldr (makeDebris mt col) w ps
   where
     dsize = debrisSize mt
@@ -43,9 +42,19 @@ makeDebrisToHeight = makeDebrisDirectedHeight 1 2 (2*pi) 0
 makeDebris :: Material -> Color -> Point2 -> World -> World
 makeDebris = makeDebrisDirected 1 2 (2 * pi) 0
 
-makeDebrisDirectedHeight :: Float -> Float -> Float -> Float -> Float -> Material 
+makeDebrisDirectedHeight ::
-    -> Color -> Point2 -> World -> World
+    Float ->
-makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
+    Float ->
+    Float ->
+    Float ->
+    Float ->
+    Material ->
+    Color ->
+    Point2 ->
+    World ->
+    World
+makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w =
+    w
         & flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
         & randGen .~ newg
         & originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
@@ -57,7 +66,8 @@ makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
         q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
         spinspeed <- randomR (-0.2, -0.1) & state
         basedebris <- baseDebris bm
-        return $ basedebris
+        return $
+            basedebris
                 & prColor .~ col
                 & prPos .~ p
                 & prVel .~ v
@@ -66,15 +76,18 @@ makeDebrisDirectedHeight mindist maxdist arcrad dir maxh bm col p w = w
                 & prVelZ .~ 0
                 & prPosZ .~ h
 
-makeDebrisDirected :: Float 
+makeDebrisDirected ::
-    -> Float 
+    Float ->
-    -> Float 
+    Float ->
-    -> Float 
+    Float ->
-    -> Material 
+    Float ->
-    -> Color
+    Material ->
-    -> Point2 
+    Color ->
-    -> World -> World
+    Point2 ->
-makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
+    World ->
+    World
+makeDebrisDirected mindist maxdist arcrad dir bm col p w =
+    w
         & flip (foldl' (flip $ plNew (cWorld . props) prID)) thedebris
         & randGen .~ newg
         & originsIDsAt [MaterialSound bm i | i <- [0, 1, 2]] (destroyMatS bm) p
@@ -85,7 +98,8 @@ makeDebrisDirected mindist maxdist arcrad dir bm col p w = w
         q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
         spinspeed <- randomR (-0.2, -0.1) & state
         basedebris <- baseDebris bm
-        return $ basedebris
+        return $
+            basedebris
                 & prColor .~ col
                 & prPos .~ p
                 & prVel .~ v
@@ -114,13 +128,15 @@ baseDebris mt = case mt of
     Wood -> return stoneDebris
     Metal -> do
         sh <- jaggedShape
-        return $ metalDebris
+        return $
+            metalDebris
                 & prDraw .~ PropDrawMovingShapeCol sh
     Electronics -> baseDebris Metal
     Flesh -> baseDebris Dirt <&> prColor .~ red
 
 stoneDebris :: Prop
-stoneDebris = PropZ
+stoneDebris =
+    PropZ
         { _prPos = 0
         , _prStartPos = 0
         , _prVel = 0
@@ -134,29 +150,39 @@ stoneDebris = PropZ
         , _prQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
         , _prColor = greyN 0.5
         }
+
 dirtDebris :: Prop
-dirtDebris = stoneDebris
+dirtDebris =
+    stoneDebris
         & prColor .~ dirtColor
         & prUpdate .~ PropFallSmallBounce
+
 dirtColor :: Color
 dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
 
 metalDebris :: Prop
-metalDebris = stoneDebris
+metalDebris =
+    stoneDebris
         & prDraw .~ PropDrawMovingShapeCol (shardShape 4)
         & prUpdate .~ PropFallSmallBounceDamage
 
 glassDebris :: Prop
-glassDebris = stoneDebris
+glassDebris =
+    stoneDebris
         & prDraw .~ PropDrawMovingShapeCol (shardShape 4)
         & prUpdate .~ PropFallSmallBounce
         & prColor .~ withAlpha 0.5 cyan
+
 crystalDebris :: Prop
-crystalDebris = glassDebris
+crystalDebris =
+    glassDebris
         & prColor .~ withAlpha 0.5 aquamarine
 
 shardShape :: Float -> Shape
-shardShape size = translateSHz (-size) $ upperPrismPoly size
+shardShape size =
+    translateSHz (- size) $
+        upperPrismPoly
+            size
             [ V2 size 0
             , V2 (- size) 1
             , V2 (- size) (-1)

src/Dodge/Bullet.hs

@@ -7,7 +7,7 @@ import Data.Maybe
 import Dodge.Base.Coordinate
 import Dodge.Creature.HandPos
 import Dodge.Creature.Test
-import Dodge.Data
+import Dodge.Data.World
 import Dodge.EnergyBall
 import Dodge.MagnetBuBu
 import Dodge.Movement.Turn

src/Dodge/Bullet/Draw.hs

@@ -1,11 +1,14 @@
-module Dodge.Bullet.Draw
+module Dodge.Bullet.Draw (
-    ( drawBul
+    drawBul,
 ) where
+
 import Dodge.Data.Bullet
-import Picture
 import Linear
+import Picture
+
 drawBul :: Bullet -> Picture
-drawBul pt = setLayer BloomNoZWrite
+drawBul pt =
+    setLayer BloomNoZWrite
         . setDepth 20
         . color (V4 200 200 200 2)
         $ thickLine (_buWidth pt) [_buOldPos pt, _buPos pt]

src/Dodge/Button/Draw.hs

@@ -1,9 +1,10 @@
 module Dodge.Button.Draw where
+
+import Color
 import Dodge.Data.Button
 import Geometry
-import Color
-import ShapePicture
 import Shape
+import ShapePicture
 
 drawButton :: ButtonDraw -> Button -> SPic
 drawButton bd = case bd of
@@ -13,16 +14,19 @@ drawButton bd = case bd of
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt
-    | _btState bt == BtOff 
+    | _btState bt == BtOff =
-                = flick $ pi/4
+        flick $ pi / 4
     | otherwise = flick (negate (pi / 4))
   where
-    flick a = ( mconcat
+    flick a =
+        ( mconcat
             [ colorSH col1 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
-        , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ reverse
+            , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $
-            $ rectNSWE 10 0 (-2) 2
+                reverse $
+                    rectNSWE 10 0 (-2) 2
             ]
-        , mempty)
+        , mempty
+        )
 
 defaultDrawButton :: Color -> Button -> SPic
 defaultDrawButton col bt =

src/Dodge/Button/Event.hs

@@ -1,14 +1,15 @@
 module Dodge.Button.Event where
-import Dodge.Data
-import Dodge.SoundLogic
 
-import Dodge.WorldEffect
 import Control.Lens
+import Dodge.Data.World
+import Dodge.SoundLogic
+import Dodge.WorldEffect
 
 doButtonEvent :: ButtonEvent -> Button -> World -> World
 doButtonEvent be = case be of
     ButtonDoNothing -> const id
-    ButtonPress newstate newevent thesound f -> \b -> doWdWd f
+    ButtonPress newstate newevent thesound f -> \b ->
+        doWdWd f
             . set (cWorld . buttons . ix (_btID b) . btState) newstate
             . set (cWorld . buttons . ix (_btID b) . btEvent) newevent
             . soundStart (LeverSound 0) (_btPos b) thesound Nothing
@@ -18,14 +19,17 @@ doButtonEvent be = case be of
 
 flipSwitch :: WdWd -> WdWd -> Button -> World -> World
 flipSwitch oneff offeff bt
-    | _btState bt == BtOff = doWdWd oneff . dosound
+    | _btState bt == BtOff =
+        doWdWd oneff . dosound
             . over (cWorld . buttons . ix (_btID bt)) turnon
-    | otherwise = doWdWd offeff . dosound
+    | otherwise =
+        doWdWd offeff . dosound
             . over (cWorld . buttons . ix (_btID bt)) turnoff
   where
     turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
     turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
     dosound = soundFromGeneral (LeverSound 0) (const $ _btPos bt) click1S Nothing
+
 --    switchEffect b = case _btState b of
 --        BtOff -> effOn  . (buttons . ix (_btID b) %~ turnOn )
 --        BtOn  -> effOff . (buttons . ix (_btID b) %~ turnOff)

src/Dodge/ChainEffect.hs

@@ -1,5 +1,5 @@
 module Dodge.ChainEffect where
-import Dodge.Data
+import Dodge.Data.World
 
 type ChainEffect = 
     (Item -> Creature -> World -> World)

src/Dodge/Cleat.hs

@@ -6,7 +6,7 @@ module Dodge.Cleat
     , rToOnward
     , cleatLabel
     ) where
-import Dodge.Data
+import Dodge.Data.GenWorld
 import Dodge.Tree.Compose
 
 import Data.Tree

src/Dodge/Clock.hs

@@ -1,7 +1,7 @@
 module Dodge.Clock
     ( clockCycle
     ) where
-import Dodge.Data
+import Dodge.Data.World
 
 import qualified Data.Vector as V
 clockCycle :: Int -> V.Vector a -> World -> a

src/Dodge/Combine.hs

@@ -1,36 +1,32 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Combine 
+module Dodge.Combine (
-    ( combinePoss
+    combinePoss,
-    , combineSizes
+    combineSizes,
-    , combineItemListYou
+    combineItemListYou,
-    , combineListInfo
+    combineListInfo,
-    , toggleCombineInv
+    toggleCombineInv,
-    , enterCombineInv
+    enterCombineInv,
 ) where
-import Dodge.Combine.Trie
+
+import Control.Lens
+import Control.Monad
+import Data.Bifunctor
+import Data.List (scanl', sortOn)
+import Data.Map.Merge.Strict
+import qualified Data.Map.Strict as M
+import Data.Maybe
 import Dodge.Base.You
-import Dodge.Data
+import Dodge.Combine.Trie
-import Dodge.Item.Amount
+import Dodge.Data.World
 import Dodge.Inventory.ItemSpace
---import Dodge.Combine.Module
+import Dodge.Item.Amount
 import Dodge.Module
---import Dodge.Combine.Data
+import qualified IntMapHelp as IM
---import Multiset
 import SimpleTrie
 
-import Data.Map.Merge.Strict
-import Control.Monad
-import Control.Lens
-import Data.Bifunctor
-import qualified IntMapHelp as IM
---import qualified Data.IntSet as IS
-import qualified Data.Map.Strict as M
---import Data.Map.Merge.Strict
-import Data.Maybe
-import Data.List (scanl',sortOn)
-
 invertInventory :: IM.IntMap Item -> [(ItemBaseType, ItAmount, Int)]
-invertInventory = IM.foldrWithKey
+invertInventory =
+    IM.foldrWithKey
         (\k it -> ((_iyBase $ _itType it, itStackAmount it, k) :))
         []
 
@@ -61,15 +57,18 @@ cmm inv (is,itm) = (is,itm & itType . iyModules %%~ flip combineModuleMaps mms)
   where
     mms = map (_iyModules . _itType . (inv IM.!)) is
 
-combineModuleMaps :: M.Map ModuleSlot ItemModuleType 
+combineModuleMaps ::
-    -> [M.Map ModuleSlot ItemModuleType]
+    M.Map ModuleSlot ItemModuleType ->
-    -> ([String],M.Map ModuleSlot ItemModuleType)
+    [M.Map ModuleSlot ItemModuleType] ->
+    ([String], M.Map ModuleSlot ItemModuleType)
 combineModuleMaps = foldM combineTwoModuleMaps
 
-combineTwoModuleMaps :: M.Map ModuleSlot ItemModuleType
+combineTwoModuleMaps ::
-    -> M.Map ModuleSlot ItemModuleType
+    M.Map ModuleSlot ItemModuleType ->
-    -> ([String],M.Map ModuleSlot ItemModuleType)
+    M.Map ModuleSlot ItemModuleType ->
-combineTwoModuleMaps = mergeA 
+    ([String], M.Map ModuleSlot ItemModuleType)
+combineTwoModuleMaps =
+    mergeA
         preserveMissing
         (filterAMissing f)
         (zipWithAMatched g)
@@ -80,6 +79,7 @@ combineTwoModuleMaps = mergeA
     g _ md EMPTYMODULE = ([], md)
     g _ md2 md1 = ([rm "REPLACES" md1 ++ rm " WITH" md2], md2)
     rm str md = str ++ " " ++ fullModuleName md
+
 -- g above could be a monoid of some description...
 
 fullModuleName :: ItemModuleType -> String

src/Dodge/Combine/Combinations.hs

@@ -18,23 +18,15 @@ itemCombinations =
     , po [cr CAN, cr HARDWARE] bangCone
     , po [HELD BANGCONE, cr PLANK] blunderbuss
     , po [HELD BLUNDERBUSS, cr DRUM] (grapeCannon 1)
-    , --    , po [BANGCONE,PUMP,HARDWARE] $ grenadeLauncher 1
+    , po [HELD (BANGSTICK 1), cr PLANK] rifle
-      --    , po [GRENADELAUNCHER 1,MOTOR,DRUM] $ grenadeLauncher 2
-
-      --    , po [cr PIPE, cr HARDWARE] (volleyGun 1)
-      po [HELD (BANGSTICK 1), cr PLANK] rifle
     , po [HELD (BANGSTICK 1), HELD (BANGSTICK 1), HELD (BANGSTICK 1)] (volleyGun 3)
     , po [HELD RIFLE, cr TIN] repeater
     , po [HELD REPEATER, cr SPRING] autoRifle
     , po [HELD REPEATER, cr CAN] burstRifle
-    --    , po [BURSTRIFLE,cr SPRING,cr HARDWARE] fastBurstRifle
-    --    , po [FASTBURSTRIFLE,cr SPRING,cr HARDWARE] completeBurstRifle
     ]
         ++ [ po [cr MOTOR, HELD (VOLLEYGUN i)] $ miniGunX i | i <- [3 .. 10]
            ]
-        ++
+        ++ [ po [HELD AMR, cr PIPE] sniperRifle
-        --    , po [BANGSTICK 1,cr TUBE]  elephantGun
-        [ po [HELD AMR, cr PIPE] sniperRifle
            , po [HELD RIFLE, cr PIPE] amr
            , po [HELD AMR, cr SPRING] autoAmr
            , po [HELD AMR, cr MOTOR] machineGun
@@ -48,12 +40,8 @@ itemCombinations =
            , po [HELD FLAMETHROWER, cr DRUM] flameWall
            , po [HELD FLAMETHROWER, cr PUMP] flameTorrent
            , p [o $ cr PRISM, o $ cr TRANSFORMER, o $ cr PIPE] lasGun
-           , --    , p [o LASGUN,o $ cr PRISM] lasSway
+           , po [HELD LASGUN, HELD LASGUN, cr HARDWARE] dualBeam
-             --    , p [o LASGUN,o $ cr HARDWARE] lasSwing
+           , po [HELD LASGUN, cr TRANSFORMER] (lasWide 2)
-             --    , p [o LASGUN,o PIPE] lasGunPulse
-             po [HELD LASGUN, HELD LASGUN, cr HARDWARE] dualBeam
-           , --    , p [o LASGUN,o $ cr PIPE, o $ cr PRISM] lasWidePulse
-             po [HELD LASGUN, cr TRANSFORMER] (lasWide 2)
            , po [HELD LASGUN, HELD LASGUN, HELD LASGUN, cr HARDWARE] lasCircle
            , p [o $ cr TRANSFORMER, p 2 $ cr CAN] sparkGun
            , p [o (HELD SPARKGUN), p 2 $ cr PIPE] teslaGun
@@ -77,7 +65,6 @@ itemCombinations =
            , po [cr TRANSFORMER, cr BATTERY, cr MICROCHIP] (makeTypeCraft STATICMODULE)
            ]
         ++ map (\i -> po [HELD (LASWIDE i), cr TRANSFORMER] $ lasWide (i + 1)) [2 .. 9]
-        --    ++ map (\i -> po [LASGUNWIDE i,cr HARDWARE] $ lasFocus i) [2..10]
         ++ map (\i -> po [cr PIPE, HELD (BANGSTICK i)] $ bangStick (i + 1)) [1 .. 8]
         ++ map (\i -> po [hd (REVOLVERX i), cr CAN] $ revolverX (i + 1)) [1 .. 5]
         ++ map (\i -> po [hd (VOLLEYGUN i), HELD (BANGSTICK 1)] $ volleyGun (i + 1)) [3 .. 5]
@@ -107,7 +94,6 @@ moduleCombinations =
             [ repeater
             , autoRifle
             , burstRifle
-            --            ,fastBurstRifle
             ]
         ,
             [ amod [cr DRUM, cr HARDWARE] DRUMMAG
@@ -214,15 +200,10 @@ batteryGuns =
     [ teslaGun
     , sparkGun
     , lasGun
-    --    , lasSway
-    --    , lasSwing
     ]
         ++ [ lasWide i | i <- [2 .. 10]
            ]
 
---    ++
---    [ lasFocus i | i <- [1..10]]
-
 teleportableWeapons :: [Item]
 teleportableWeapons = bulletWeapons ++ batteryGuns ++ homingLaunchers
 
@@ -242,9 +223,7 @@ bulletWeapons =
            , repeater
            , autoRifle
            , burstRifle
-           , --    ,fastBurstRifle
+           , bangCone
-             --    ,completeBurstRifle
-             bangCone
            , blunderbuss
            , machineGun
            , elephantGun

src/Dodge/Combine/Graph.hs

@@ -1,7 +1,7 @@
 --{-# LANGUAGE TypeSynonymInstances #-}
 --{-# LANGUAGE FlexibleInstances #-}
 module Dodge.Combine.Graph where
-import Dodge.Data hiding (East,West,North,South)
+import Dodge.Data.Item
 import Dodge.Combine.Combinations
 import LensHelp
 import GraphHelp

src/Dodge/Combine/Module.hs

@@ -1,16 +1,19 @@
 module Dodge.Combine.Module where
-import Dodge.Data
+
+import Dodge.Item.Targeting
+import Dodge.Data.Beam
+import Dodge.Data.Item
+--import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Tesla
-import Dodge.Item.Weapon.ExtraEffect
-import LensHelp
 import Geometry
+import LensHelp
 
 moduleModification :: ItemModuleType -> Item -> Item
 moduleModification imt = case imt of
     EMPTYMODULE -> id
     DRUMMAG -> itUse . heldConsumption . laMax .~ 45
     BELTMAG -> itUse . heldConsumption . laMax .~ 150
-    MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
+    MAGNETMAG -> itUse . heldDelay . rateMax .~ 4
     INCENDBUL -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
     BOUNCEBUL -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet
     PENBUL -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet
@@ -19,25 +22,29 @@ moduleModification imt = case imt of
     TARGCR -> itTargeting .~ targetRBCreature
     TARGLAS -> itTargeting .~ targetLaser
     TARGPOS -> itTargeting .~ targetRBPress
-    MAGNETTRAJ  -> (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
+    MAGNETTRAJ ->
+        (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0)
             . (itUse . heldConsumption . laAmmoType . amBullet . buVel .~ V2 10 0)
     FLECHETRAJ -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0
     BEZIERTRAJ -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
     INCENDLAS -> itParams . lasBeam .~ BeamCombine FlameBeamCombine
     SPLITLAS -> itParams . lasBeam .~ BeamCombine SplitBeamCombine
-    STATICLAS   -> (itParams . lasBeam .~ BeamCombine TeslaBeamCombine)
+    STATICLAS ->
+        (itParams . lasBeam .~ BeamCombine TeslaBeamCombine)
             . (itParams . subParams ?~ teslaParams)
     WEPTELE -> makeDirectedTele
     LAUNCHHOME -> itUse . heldConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
     EXTRABATTERY -> itUse . heldConsumption . laMax +~ 1000
     ATTACHTORCH -> id
   where
-    makeDirectedTele it = it 
+    makeDirectedTele it =
+        it
             & itTargeting .~ targetRBPress
-        & itUse . useMods %~ ModWithDirectedTeleport -- .:~ withPosDirWallCheck directedTelPos
+            & itUse . heldMods %~ ModWithDirectedTeleport -- .:~ withPosDirWallCheck directedTelPos
             -- for the camera: the simplest option is to remove all zoom/offset
-        & itUse . useAim . aimZoom . itZoomFac .~ 1
+            & itUse . heldAim . aimZoom . itZoomFac .~ 1
-        & itUse . useAim . aimRange .~ 0
+            & itUse . heldAim . aimRange .~ 0
+
 -- a better option would be to involve a "scope" centered on the firing
 -- position
 --    directedTelPos it cr w = (p,a)

src/Dodge/Combine/Trie.hs

@@ -1,19 +1,16 @@
 module Dodge.Combine.Trie where
-import Dodge.Combine.Combinations
-import Dodge.Data
---import Dodge.Combine.Module
---import Dodge.Combine.Data
---import Multiset
-import SimpleTrie
 
 import Data.Bifunctor
---import qualified Data.IntSet as IS
---import Data.Map.Merge.Strict
 import Data.List (sort)
+import Dodge.Combine.Combinations
+import Dodge.Data.Item
+import SimpleTrie
+import Data.Foldable
 
 combinationsTrie :: Trie (ItAmount, ItemBaseType) Item
 {-# INLINE combinationsTrie #-}
-combinationsTrie = foldr 
+combinationsTrie =
-    (uncurry insertInTrie . first sort) 
+    foldl'
+        (flip $ uncurry insertInTrie . first sort)
         emptyTrie
         itemCombinations

src/Dodge/Config/KeyConfig.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
---{-# LANGUAGE OverloadedStrings #-}
-module Dodge.Config.KeyConfig
-    ( KeyConfigSDL (..)
-    , defaultKeyConfigSDL 
-    , loadKeyConfig
-    )
-  where
---import Data.Aeson
---import Foreign.C.Types
-import GHC.Generics
---import qualified GHC.Int
-import qualified SDL
---import qualified SDL.Internal.Numbered
---import System.Directory
-
-data KeyConfigSDL = KeyConfigSDL
-  { moveUpKey   :: SDL.Scancode
-  , moveDownKey :: SDL.Scancode
-  , moveLeftKey :: SDL.Scancode
-  , moveRightKey :: SDL.Scancode
-  , pauseKey :: SDL.Scancode
-  , escapeKey :: SDL.Scancode
-  , dropItemKey :: SDL.Scancode
-  , toggleMapKey :: SDL.Scancode
-  , reloadKey :: SDL.Scancode
-  , testEventKey :: SDL.Scancode
-  , spaceActionKey :: SDL.Scancode
-  , rotateCameraPlusKey :: SDL.Scancode
-  , rotateCameraMinusKey :: SDL.Scancode
-  , zoomInKey :: SDL.Scancode
-  , zoomOutKey :: SDL.Scancode
-  , newMapKey :: SDL.Scancode
-  , modifierKey :: SDL.Scancode 
-  }
-  deriving (Generic, Show)
-
-defaultKeyConfigSDL :: KeyConfigSDL
-defaultKeyConfigSDL =
-  KeyConfigSDL
-    { moveUpKey = SDL.ScancodeW
-    , moveDownKey = SDL.ScancodeS
-    , moveLeftKey = SDL.ScancodeA
-    , moveRightKey = SDL.ScancodeD
-    , pauseKey = SDL.ScancodeP
-    , escapeKey = SDL.ScancodeEscape
-    , dropItemKey = SDL.ScancodeF
-    , toggleMapKey = SDL.ScancodeM
-    , reloadKey = SDL.ScancodeR
-    , testEventKey = SDL.ScancodeT
-    , spaceActionKey = SDL.ScancodeSpace
-    , rotateCameraPlusKey = SDL.ScancodeQ
-    , rotateCameraMinusKey = SDL.ScancodeE
-    , zoomInKey = SDL.ScancodeJ
-    , zoomOutKey = SDL.ScancodeK
-    , newMapKey = SDL.ScancodeN
-    , modifierKey = SDL.ScancodeCapsLock
-    }
-
-loadKeyConfig :: IO KeyConfigSDL
-loadKeyConfig = return defaultKeyConfigSDL

src/Dodge/CrGroupUpdate.hs

@@ -1,6 +1,6 @@
 module Dodge.CrGroupUpdate
     where
-import Dodge.Data
+import Dodge.Data.World
 
 doCrGroupUpdate :: CrGroupUpdate -> World -> CrGroupParams -> Maybe CrGroupParams
 doCrGroupUpdate cgu = case cgu of

src/Dodge/Creature.hs

@@ -8,18 +8,42 @@ module Dodge.Creature (
     spreadGunCrit,
     autoCrit,
     armourChaseCrit,
+    module Dodge.Creature.Action,
+    module Dodge.Creature.Boid,
+    module Dodge.Creature.ChainUpdates,
+    module Dodge.Creature.Impulse,
+    module Dodge.Creature.Perception,
+    module Dodge.Creature.ReaderUpdate,
+    module Dodge.Creature.SentinelAI,
+    module Dodge.Creature.State,
+    module Dodge.Creature.Strategy,
+    module Dodge.Creature.Test,
+    module Dodge.Creature.Volition,
+    module Dodge.Creature.YourControl,
 ) where
 
 import Control.Lens
+import Dodge.Creature.Action
 import Dodge.Creature.ArmourChase
 import Dodge.Creature.AutoCrit
+import Dodge.Creature.Boid
+import Dodge.Creature.ChainUpdates
 import Dodge.Creature.ChaseCrit
+import Dodge.Creature.Impulse
 import Dodge.Creature.Inanimate
 import Dodge.Creature.LauncherCrit
 import Dodge.Creature.LtAutoCrit
+import Dodge.Creature.Perception
 import Dodge.Creature.PistolCrit
+import Dodge.Creature.ReaderUpdate
+import Dodge.Creature.SentinelAI
 import Dodge.Creature.SpreadGunCrit
-import Dodge.Data
+import Dodge.Creature.State
+import Dodge.Creature.Strategy
+import Dodge.Creature.Test
+import Dodge.Creature.Volition
+import Dodge.Creature.YourControl
+import Dodge.Data.Creature
 import Dodge.Default
 import Dodge.Item
 import Geometry.Data
@@ -43,8 +67,8 @@ miniGunCrit =
 longCrit :: Creature
 longCrit =
     defaultCreature
-        & crActionPlan .~
+        & crActionPlan
-            ActionPlan
+            .~ ActionPlan
                 { _apImpulse = []
                 , _apAction = []
                 , _apStrategy = StrategyActions WatchAndWait [StartSentinelPost]

src/Dodge/Creature.hs.orig

@@ -4,7 +4,7 @@ module Dodge.Creature
     )
   where
 -- imports {{{
-import Dodge.Data
+import Dodge.Data.Creature
 import Dodge.AIs
 import Dodge.CreatureState
 import Dodge.Default

src/Dodge/Creature/Action.hs

@@ -17,12 +17,13 @@ module Dodge.Creature.Action (
     pickUpItem,
     pickUpItemID,
 ) where
+
 import Data.Bifunctor
 import Data.List (findIndex)
 import Data.Maybe
 import Dodge.Base
 import Dodge.CreatureEffect
-import Dodge.Data
+import Dodge.Data.World
 import Dodge.Default
 import Dodge.FloatFunction
 import Dodge.FloorItem

src/Dodge/Creature/ArmourChase.hs

@@ -1,26 +1,29 @@
-module Dodge.Creature.ArmourChase
+module Dodge.Creature.ArmourChase (
-    ( armourChaseCrit
+    armourChaseCrit,
-    , flockArmourChaseCrit
+    flockArmourChaseCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Creature.ChaseCrit
+import Dodge.Data.Creature
 import Dodge.Data.FloatFunction
 import Dodge.Default
-import Dodge.Creature.ChaseCrit
-import Dodge.Item.Equipment
 import Dodge.Item.Consumable
-
+import Dodge.Item.Equipment
 import qualified IntMapHelp as IM
-import Control.Lens
 
 flockArmourChaseCrit :: Creature
-flockArmourChaseCrit = defaultCreature
+flockArmourChaseCrit =
+    defaultCreature
         { _crName = "armourChaseCrit"
         , _crHP = 300
-    , _crInv = IM.fromList 
+        , _crInv =
+            IM.fromList
                 [ (0, frontArmour)
                 , (1, medkit 200)
                 ]
-    , _crActionPlan = ActionPlan
+        , _crActionPlan =
+            ActionPlan
                 { _apImpulse = []
                 , _apAction = []
                 , _apStrategy = FollowImpulses
@@ -31,11 +34,14 @@ flockArmourChaseCrit = defaultCreature
         , _crMvType = defaultChaseMvType
         }
         & crType . humanoidAI .~ FlockArmourChaseAI
+
 armourChaseCrit :: Creature
-armourChaseCrit = chaseCrit
+armourChaseCrit =
+    chaseCrit
         { _crName = "armourChaseCrit"
-    --, _crUpdate = defaultImpulsive []
+        , --, _crUpdate = defaultImpulsive []
-    , _crInv = IM.fromList 
+          _crInv =
+            IM.fromList
                 [ (0, frontArmour)
                 , (1, medkit 200)
                 ]

src/Dodge/Creature/AutoCrit.hs

@@ -1,17 +1,18 @@
-module Dodge.Creature.AutoCrit
+module Dodge.Creature.AutoCrit (
-    ( autoCrit 
+    autoCrit,
 ) where
-import Dodge.Data
+
+import Dodge.Item.Held.Cane
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
-
 autoCrit :: Creature
-autoCrit = defaultCreature
+autoCrit =
+    defaultCreature
         { _crInv = IM.fromList [(0, autoRifle), (1, medkit 100)]
         , _crRad = 10
         , _crHP = 300

src/Dodge/Creature/Boid.hs

@@ -1,20 +1,19 @@
-module Dodge.Creature.Boid
+module Dodge.Creature.Boid where
-    where
-import Dodge.Data
-import Dodge.Base
-import Geometry
---import Geometry.ConvexPoly
 
-import Control.Monad.Reader
 import Control.Lens
+import Control.Monad.Reader
+import Dodge.Base
+import Dodge.Data.World
+import Geometry
 import qualified IntMapHelp as IM
 
 interpWith :: Float -> Point2 -> Point2 -> Point2
 interpWith x a b = x *.* a +.+ (1 - x) *.* b
 
 invertEncircleDistP :: Float -> Creature -> Point2 -> Creature -> Point2
-invertEncircleDistP d tcr cenp cr = ypos +.+ 
+invertEncircleDistP d tcr cenp cr =
-    d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
+    ypos
+        +.+ d *.* reflectIn (cenp -.- ypos) (squashNormalizeV (cpos -.- cenp))
   where
     cpos = _crPos cr
     ypos = _crPos tcr
@@ -30,6 +29,7 @@ encircleP tcr cenp cr = ypos +.+ 50 *.* squashNormalizeV (cpos -.- cenp)
   where
     cpos = _crPos cr
     ypos = _crPos tcr
+
 --f x = 150 * sigmoid (x-10)
 
 encircleCloseP :: Creature -> Point2 -> Creature -> Point2
@@ -39,12 +39,12 @@ encircleCloseP tcr cenp cr = ypos +.+ f (max 0 (magV (ypos -.- cenp) - 80) ) *.*
     ypos = _crPos tcr
     f x = 150 * sigmoid (x -10)
 
-forbidFlee
+forbidFlee ::
-    :: (Creature -> Point2 -> Creature -> Point2)
+    (Creature -> Point2 -> Creature -> Point2) ->
-    -> Creature 
+    Creature ->
-    -> Point2 
+    Point2 ->
-    -> Creature 
+    Creature ->
-    -> Point2
+    Point2
 forbidFlee f tcr cenp cr
     | ptargTest = tpos
     | otherwise = ptarg
@@ -53,6 +53,7 @@ forbidFlee f tcr cenp cr
     tpos = _crPos tcr
     ptarg = f tcr cenp cr
     ptargTest = isLHS cpos (cpos +.+ rotateV (negate (pi / 2)) (cpos -.- tpos)) ptarg
+
 --      && isRHS cpos (cpos +.+ rotateV (pi/3) (cpos -.- tpos)) ptarg
 --targBehindCrit = isLHS cpos (vNormal $ cpos +.+ unitVectorAtAngle (_crDir cr)) ptarg
 
@@ -62,10 +63,10 @@ pincerP tcr cenp cr = tpos +.+ splitp -- +.+ 25 *.* (normalizeV $ tpos -.- cenp)
     cpos = _crPos cr
     tpos = _crPos tcr
     splitp
-        | isLHS cenp cpos tpos
+        | isLHS cenp cpos tpos =
-            = 150 *.* orthCenpTpos
+            150 *.* orthCenpTpos
-        | otherwise
+        | otherwise =
-            = negate 150 *.* orthCenpTpos
+            negate 150 *.* orthCenpTpos
     --d = min 150 (dist cpos tpos)
     --orthCenpTpos = safeNormalizeV (vNormal $ tpos -.- cpos)
     orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
@@ -81,18 +82,18 @@ pincerP''' tcr cenp cr = interpWith (sigmoid $ 0.05 * dtcen) cenawayp cenclosep
         | dist cenp tpos < dist cpos tpos = tpos +.+ splitp
         | otherwise = cenp +.+ splitp
     splitp
-        | isLHS cenp cpos tpos
+        | isLHS cenp cpos tpos =
-            = f (max 0 (magV (tpos -.- cenp) - 80) ) *.* orthCenpTpos
+            f (max 0 (magV (tpos -.- cenp) - 80)) *.* orthCenpTpos
-        | otherwise
+        | otherwise =
-            = negate ( f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
+            negate (f $ max 0 $ magV (tpos -.- cenp) - 80) *.* orthCenpTpos
     orthCenpTpos = squashNormalizeV (vNormal $ tpos -.- cenp)
-    cenclosep 
+    cenclosep =
-            = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
+        tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
 
 pincerP' :: Creature -> Point2 -> Creature -> Point2
 pincerP' tcr cenp cr
-    | dist cenp tpos > dist cpos tpos 
+    | dist cenp tpos > dist cpos tpos =
-                = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (cpos -.- cenp)
+        cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
     | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
   where
     cpos = _crPos cr
@@ -101,10 +102,10 @@ pincerP' tcr cenp cr
 
 pincerP'' :: Creature -> Point2 -> Creature -> Point2
 pincerP'' tcr cenp cr
-    | dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos
+    | dist cenp tpos > dist cpos tpos && isLHS cenp cpos tpos =
-        = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ tpos -.- cenp)
+        cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (vNormal $ tpos -.- cenp)
-    | dist cenp tpos > dist cpos tpos 
+    | dist cenp tpos > dist cpos tpos =
-        = cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80) ) *.* squashNormalizeV (vNormal $ cenp -.- tpos)
+        cenp +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (vNormal $ cenp -.- tpos)
     | otherwise = tpos +.+ f (max 0 (magV (tpos -.- cenp) - 80)) *.* squashNormalizeV (cpos -.- cenp)
   where
     cpos = _crPos cr
@@ -128,7 +129,8 @@ lineOrth tcr crs cr = p
     cpos = _crPos cr
     ps = map _crPos $ IM.elems crs
     cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 20 = ypos
+    p
+        | dist cen ypos < 20 = ypos
         | otherwise = errorClosestPointOnLine 500 ypos (ypos +.+ vNormal (cen -.- ypos)) cpos
 
 holdForm :: Creature -> IM.IntMap Creature -> Creature -> Point2
@@ -138,7 +140,8 @@ holdForm ycr crs cr = p
     cpos = _crPos cr
     ps = map _crPos $ IM.elems crs
     cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 20 = ypos
+    p
+        | dist cen ypos < 20 = ypos
         | otherwise = ypos +.+ cpos -.- cen
 
 lineUp :: Creature -> IM.IntMap Creature -> Creature -> Point2
@@ -158,18 +161,19 @@ spreadOut ycr crs cr = p
     cpos = _crPos cr
     ps = map _crPos $ IM.elems crs
     cen = (1 / fromIntegral (length ps)) *.* foldr1 (+.+) ps
-    p   | dist cen ypos < 30 = ypos
+    p
+        | dist cen ypos < 30 = ypos
         | otherwise = ypos +.+ (spreadFactor *.* cpos -.- cen)
     spreadFactor
         | dist ypos cpos > 90 = 1
         | otherwise = 1.5
 
-swarmUsingCenter
+swarmUsingCenter ::
-    :: (Creature -> Point2 -> Creature -> Creature) 
+    (Creature -> Point2 -> Creature -> Creature) ->
-    -> (Point2 -> Creature -> Creature)
+    (Point2 -> Creature -> Creature) ->
-    -> World
+    World ->
-    -> Creature
+    Creature ->
-    -> Creature
+    Creature
 swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
     Nothing -> upd cenp cr
     Just tcr -> updT tcr cenp cr
@@ -177,12 +181,14 @@ swarmUsingCenter updT upd w cr = case _targetCr $ _crIntention cr of
     cid = _crID cr
     cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup $ _creatures (_cWorld w) IM.! cid)
 
-flockChaseTarget
+flockChaseTarget ::
-    :: (Creature -> IM.IntMap Creature -> Creature -> Creature) -- ^ Update with target
+    -- | Update with target
-    -> (IM.IntMap Creature -> Creature -> Creature) -- ^ Update without target
+    (Creature -> IM.IntMap Creature -> Creature -> Creature) ->
-    -> World
+    -- | Update without target
-    -> Creature
+    (IM.IntMap Creature -> Creature -> Creature) ->
-    -> Creature
+    World ->
+    Creature ->
+    Creature
 flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
     Nothing -> upd crs cr
     Just tcr -> updT tcr crs cr
@@ -190,12 +196,13 @@ flockChaseTarget updT upd w cr = case _targetCr $ _crIntention cr of
     is = _swarm $ _crGroup cr
     crs = IM.restrictKeys (_creatures (_cWorld w)) is
 
-flockPointTarget
+flockPointTarget ::
-    :: (Creature -> IM.IntMap Creature -> Creature -> Point2)
+    (Creature -> IM.IntMap Creature -> Creature -> Point2) ->
-    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -- | Function for determining target
-    -> World 
+    (Creature -> World -> Maybe Creature) ->
-    -> Creature 
+    World ->
-    -> Creature 
+    Creature ->
+    Creature
 flockPointTarget f targFunc w cr = case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -204,23 +211,24 @@ flockPointTarget f targFunc w cr = case targFunc cr w of
         crs = IM.restrictKeys (_creatures (_cWorld w)) is
         p = f crTarg crs cr
 
-flockToPointUsing
+flockToPointUsing ::
-    :: (Creature -> Point2 -> Creature -> Point2)
+    (Creature -> Point2 -> Creature -> Point2) ->
-    -> (Point2 -> Creature -> Creature -> [Impulse])
+    (Point2 -> Creature -> Creature -> [Impulse]) ->
-    -> Creature
+    Creature ->
-    -> Reader World Creature
+    Reader World Creature
 flockToPointUsing pf mvf cr = reader $ \w -> case _targetCr $ _crIntention cr of
     Nothing -> cr
     Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
       where
         cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
         ptarg = pf tcr cenp cr
-flockToPointUsing'
+
-    :: (Creature -> Point2 -> Creature -> Point2)
+flockToPointUsing' ::
-    -> (Point2 -> Creature -> Creature -> [Impulse])
+    (Creature -> Point2 -> Creature -> Point2) ->
-    -> World
+    (Point2 -> Creature -> Creature -> [Impulse]) ->
-    -> Creature
+    World ->
-    -> Creature
+    Creature ->
+    Creature
 flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
     Nothing -> cr
     Just tcr -> cr & crActionPlan . apImpulse .~ mvf ptarg cr tcr
@@ -228,11 +236,12 @@ flockToPointUsing' pf mvf w cr = case _targetCr $ _crIntention cr of
         cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
         ptarg = pf tcr cenp cr
 
-flockFunc
+flockFunc ::
-    :: (Creature -> Point2 -> Creature -> Point2)
+    (Creature -> Point2 -> Creature -> Point2) ->
-    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -- | Function for determining target
-    -> Creature 
+    (Creature -> World -> Maybe Creature) ->
-    -> Reader World Creature 
+    Creature ->
+    Reader World Creature
 flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -240,11 +249,12 @@ flockFunc f targFunc cr = reader $ \w -> case targFunc cr w of
         cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
         p = f crTarg cenp cr
 
-flockCenterFunc
+flockCenterFunc ::
-    :: (Creature -> Point2 -> Creature -> Point2)
+    (Creature -> Point2 -> Creature -> Point2) ->
-    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -- | Function for determining target
-    -> Creature 
+    (Creature -> World -> Maybe Creature) ->
-    -> Reader World Creature 
+    Creature ->
+    Reader World Creature
 flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -252,11 +262,12 @@ flockCenterFunc f targFunc cr = reader $ \w -> case targFunc cr w of
         cenp = _crGroupCenter $ _creatureGroups (_cWorld w) IM.! _crGroupID (_crGroup cr)
         p = f crTarg cenp cr
 
-flockPointTargetR
+flockPointTargetR ::
-    :: (Creature -> IM.IntMap Creature -> Creature -> Point2)
+    (Creature -> IM.IntMap Creature -> Creature -> Point2) ->
-    -> (Creature -> World -> Maybe Creature)    -- ^ Function for determining target
+    -- | Function for determining target
-    -> Creature 
+    (Creature -> World -> Maybe Creature) ->
-    -> Reader World Creature 
+    Creature ->
+    Reader World Creature
 flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
     Nothing -> cr
     Just crTarg -> cr & crActionPlan . apImpulse .~ mvPointMeleeTarg p cr crTarg
@@ -265,43 +276,49 @@ flockPointTargetR f targFunc cr = reader $ \w -> case targFunc cr w of
         crs = IM.restrictKeys (_creatures (_cWorld w)) is
         p = f crTarg crs cr
 
-meleeHeadingMove
+meleeHeadingMove ::
-    :: Float -- ^ max turn speed
+    -- | max turn speed
-    -> Float -- ^ min turn speed
+    Float ->
-    -> Float -- ^ turn speed cutoff angle
+    -- | min turn speed
-    -> Float -- ^ move speed
+    Float ->
-    -> Point2 -- ^ target point
+    -- | turn speed cutoff angle
-    -> Creature -- ^ start creature
+    Float ->
-    -> Creature -- ^ target creature
+    -- | move speed
-    -> [Impulse]
+    Float ->
+    -- | target point
+    Point2 ->
+    -- | start creature
+    Creature ->
+    -- | target creature
+    Creature ->
+    [Impulse]
 meleeHeadingMove maxta minta tacutoff speed tp cr tcr
     | dist tpos cpos < combinedRad + 5
         && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
-            && _crMeleeCooldown cr == 0
+        && _crMeleeCooldown cr == 0 =
-        = [Melee (_crID tcr), Turn pi]
+        [Melee (_crID tcr), Turn pi]
     | dist tpos cpos < combinedRad + 5
-            && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff
+        && abs (_crDir cr - argV (tpos -.- cpos)) < tacutoff =
-        = [ TurnToward tpos minta ]
+        [TurnToward tpos minta]
-    | abs (_crDir cr - argV (tp -.- cpos)) < tacutoff
+    | abs (_crDir cr - argV (tp -.- cpos)) < tacutoff =
-                = [MoveForward speed , TurnToward tp maxta , RandomTurn maxta ]
+        [MoveForward speed, TurnToward tp maxta, RandomTurn maxta]
     | otherwise = [MoveForward speed, TurnToward tp minta, RandomTurn maxta]
   where
     cpos = _crPos cr
     tpos = _crPos tcr
     combinedRad = _crRad cr + _crRad tcr
 
-
 mvPointMeleeTarg :: Point2 -> Creature -> Creature -> [Impulse]
 mvPointMeleeTarg p cr crT
     | dist tpos cpos < combinedRad + 5
         && abs (_crDir cr - argV (tpos -.- cpos)) < pi / 4
-            && _crMeleeCooldown cr == 0
+        && _crMeleeCooldown cr == 0 =
-        = [Melee (_crID crT)]
+        [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 ]
+        [TurnToward tpos 0.05]
-    | abs (_crDir cr - argV (p -.- cpos)) < pi/4
+    | abs (_crDir cr - argV (p -.- cpos)) < pi / 4 =
-                = [MoveForward 3 , TurnToward p 0.2 , RandomTurn 0.2 ]
+        [MoveForward 3, TurnToward p 0.2, RandomTurn 0.2]
     | otherwise = [MoveForward 3, TurnToward p 0.05, RandomTurn 0.2]
   where
     cpos = _crPos cr

src/Dodge/Creature/ChainUpdates.hs

@@ -1,11 +1,13 @@
 module Dodge.Creature.ChainUpdates where
-import Dodge.Data
 
 import Data.Foldable
+import Dodge.Data.World
 
-chainCreatureUpdates
+chainCreatureUpdates ::
-    :: [World -> Creature -> Creature] 
+    [World -> Creature -> Creature] ->
-    -> World -> Creature -> Creature
+    World ->
+    Creature ->
+    Creature
 chainCreatureUpdates ls w cr = foldl' unf cr ls
   where
     unf cr' g = g w cr'

src/Dodge/Creature/ChaseCrit.hs

@@ -1,40 +1,46 @@
-module Dodge.Creature.ChaseCrit
+module Dodge.Creature.ChaseCrit (
-    (smallChaseCrit
+    smallChaseCrit,
-    ,invisibleChaseCrit
+    invisibleChaseCrit,
-    ,chaseCrit
+    chaseCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
 import Dodge.Item.Consumable
 import Dodge.Item.Equipment
 import Dodge.SoundLogic
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
---import System.Random
-
 smallChaseCrit :: Creature
-smallChaseCrit = chaseCrit
+smallChaseCrit =
+    chaseCrit
         { _crHP = 1
         , _crRad = 4
         , _crInv = IM.fromList [(0, medkit 200)]
         , _crCorpse = MakeDefaultCorpse
         }
+
 invisibleChaseCrit :: Creature
-invisibleChaseCrit = chaseCrit
+invisibleChaseCrit =
+    chaseCrit
         & crCamouflage .~ Invisible
         & crInv . at 0 ?~ wristInvisibility
         & crEquipment . at OnLeftWrist ?~ 0
         & crInvEquipped . at 0 ?~ OnLeftWrist
+
 chaseCrit :: Creature
-chaseCrit = defaultCreature
+chaseCrit =
+    defaultCreature
         { _crName = "chaseCrit"
         , _crHP = 150
         , _crInv = IM.fromList [(0, medkit 200)]
         , _crMeleeCooldown = 0
         , _crFaction = ColorFaction green
-    , _crVocalization = Vocalization seagullChatterS 
+        , _crVocalization =
+            Vocalization
+                seagullChatterS
                 [ seagullBarkS
                 , seagullChatterS
                 , seagullChatter1S
@@ -43,7 +49,9 @@ chaseCrit = defaultCreature
                 , seagullCryS
                 , seagullCry1S
                 , seagullCry2S
-        ] 50 0
+                ]
+                50
+                0
         , _crMvType = defaultChaseMvType
         }
         & crType . humanoidAI .~ ChaseAI

src/Dodge/Creature/ChooseTarget.hs

@@ -1,10 +1,8 @@
-module Dodge.Creature.ChooseTarget
+module Dodge.Creature.ChooseTarget where
-    where
-import Dodge.Data
-import Dodge.Base
 
 import Control.Lens
---import qualified IntMapHelp as IM
+import Dodge.Base
+import Dodge.Data.World
 
 targetYouLOS :: Creature -> World -> Maybe Creature
 {-# INLINE targetYouLOS #-}
@@ -15,8 +13,8 @@ targetYouLOS cr w
 targetYouCognizant :: Creature -> World -> Maybe Creature
 targetYouCognizant cr w
     | hasLOS (_crPos cr) (_crPos $ you w) w
-        && isCog (cr ^? crPerception . cpAwareness . ix 0) 
+        && isCog (cr ^? crPerception . cpAwareness . ix 0) =
-                = Just $ you w
+        Just $ you w
     | otherwise = Nothing
   where
     isCog x = case x of

src/Dodge/Creature/Damage.hs

@@ -1,14 +1,13 @@
 module Dodge.Creature.Damage where
-import Dodge.Data
+
-import Dodge.Creature.Test
-import Dodge.Spark
---import Dodge.Bullet
 import Color
+import Data.List
+import Dodge.Creature.Test
+import Dodge.Data.World
+import Dodge.Spark
 import Geometry
 import LensHelp
 
-import Data.List
-
 applyNoDamage :: [Damage] -> Creature -> World -> World
 applyNoDamage _ _ = id
 
@@ -19,7 +18,8 @@ applyCreatureDamage dms cr = case _crMaterial cr of
     _ -> defaultApplyDamage dms cr
 
 defaultApplyDamage :: [Damage] -> Creature -> World -> World
-defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
+defaultApplyDamage ds cr w =
+    foldl' (applyIndividualDamage cr) w ds'
         & cWorld . creatures . ix (_crID cr) %~ doPoisonDam
   where
     (ps, ds') = partition isPoison ds
@@ -30,19 +30,23 @@ defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
 
 applyDamageEffect :: Damage -> DamageEffect -> Creature -> World -> World
 applyDamageEffect dm de cr w = case de of
-    PushDamage push pushexp pushRad -> w
+    PushDamage push pushexp pushRad ->
+        w
             & cWorld . creatures . ix (_crID cr) . crPos .+.+~ pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir)
       where
         pushAmount
             | dist (_crPos cr) fromDir == 0 = 0
             | otherwise = min 5 $ (push * 5 * pushRad / (dist (_crPos cr) fromDir * _crMass cr)) ** pushexp
-    PushBackDamage pback -> w
+    PushBackDamage pback ->
+        w
             & cWorld . creatures . ix (_crID cr) . crPos .+.+~ (pback / _crMass cr) *.* (_dmTo dm -.- fromDir)
-    TorqueDamage rot -> w
+    TorqueDamage rot ->
+        w
             & cWorld . creatures . ix (_crID cr) . crDir +~ rot
     NoDamageEffect -> w
   where
     fromDir = _dmFrom dm
+
 --p = _dmAt dm
 
 applyIndividualDamage :: Creature -> World -> Damage -> World
@@ -62,7 +66,8 @@ applyPiercingDamage cr dm
     p1 = p +.+ 2 *.* squashNormalizeV (p -.- _crPos cr)
 
 damageHP :: Creature -> Int -> World -> World
-damageHP cr x = cWorld . creatures . ix (_crID cr) %~
+damageHP cr x =
-    ( (crHP -~ x)
+    cWorld . creatures . ix (_crID cr)
+        %~ ( (crHP -~ x)
                 . (crPastDamage +~ x)
            )

src/Dodge/Creature/HandPos.hs

@@ -1,27 +1,30 @@
 module Dodge.Creature.HandPos where
-import Dodge.Data
-import Dodge.Creature.Test
---import Shape
-import ShapePicture
-import Geometry
 
 import Control.Lens
 import Data.Maybe
+import Dodge.Creature.Test
+import Dodge.Data.Creature
+import Geometry
+import ShapePicture
 
 -- the position of a weapon handle
 aimingWeaponHandlePos :: Creature -> Item -> Float
-aimingWeaponHandlePos cr it = case it ^? itUse. useAim . aimStance of
+aimingWeaponHandlePos cr it = case it ^? itUse . heldAim . aimStance of
     Just TwoHandTwist -> -5
     Just OneHand -> 14
     Just TwoHandFlat -> 1.2 * _crRad cr
     Just LeaveHolstered -> 0
     Nothing -> 0
+
 aimingWeaponZeroPos :: Creature -> Item -> Float
-aimingWeaponZeroPos cr it = aimingWeaponHandlePos cr it 
+aimingWeaponZeroPos cr it =
-    - fromMaybe 0 (it ^? itUse . useAim . aimHandlePos)
+    aimingWeaponHandlePos cr it
+        - fromMaybe 0 (it ^? itUse . heldAim . aimHandlePos)
+
 aimingMuzzlePos :: Creature -> Item -> Float
-aimingMuzzlePos cr it = aimingWeaponZeroPos cr it 
+aimingMuzzlePos cr it =
-    + fromMaybe 0 (it ^? itUse . useAim . aimMuzPos)
+    aimingWeaponZeroPos cr it
+        + fromMaybe 0 (it ^? itUse . heldAim . aimMuzPos)
 
 translatePointToRightHand :: Creature -> Point3 -> Point3
 translatePointToRightHand cr = translatePointToRightHand' cr . mirrorV3xz
@@ -116,7 +119,8 @@ translateToLeftWrist cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
 translateToLeftLeg :: Creature -> SPic -> SPic
-translateToLeftLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
+translateToLeftLeg cr =
+    rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
         Just (Walking sa LeftForward) -> translateSPf (f sa) off
         Just (Walking sa RightForward) -> translateSPf (- f sa) off
         _ -> translateSPf 0 off
@@ -126,7 +130,8 @@ translateToLeftLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance
     f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
 
 translateToRightLeg :: Creature -> SPic -> SPic
-translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
+translateToRightLeg cr =
+    rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStance . carriage of
         Just (Walking sa LeftForward) -> translateSPf (- f sa) (- off)
         Just (Walking sa RightForward) -> translateSPf (f sa) (- off)
         _ -> translateSPf 0 (- off)
@@ -137,17 +142,21 @@ translateToRightLeg cr = rotateSP (_crMvDir cr - _crDir cr) . case cr ^? crStanc
 
 translateToHead :: Creature -> SPic -> SPic
 translateToHead cr
-    | twists cr = translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25 
+    | twists cr =
+        translateSPz 20 . translateSPf 0 5 . rotateSP (-1) . translateSPf (negate 2.5) 0.25
             . rotateSP 1
-    | oneH   cr = translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0 
+    | oneH cr =
+        translateSPz 20 . rotateSP 0.5 . translateSPf 2.5 0
             . rotateSP (negate 0.5)
     | otherwise = translateSPz 20 . translateSPf 2.5 0
 
 translatePointToHead :: Creature -> Point3 -> Point3
 translatePointToHead cr
-    | twists cr = (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
+    | twists cr =
+        (+.+.+ V3 0 5 20) . rotate3 (-1) . (+.+.+ V3 (negate 2.5) 0.25 0)
             . rotate3 1
-    | oneH   cr = (+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
+    | oneH cr =
+        (+.+.+ V3 0 0 20) . rotate3 0.5 . (+.+.+ V3 2.5 0 0)
             . rotate3 (negate 0.5)
     | otherwise = (+.+.+ V3 2.5 0 20)
 
@@ -167,5 +176,6 @@ translateToBack cr
 
 shoulderSP :: SPic -> SPic
 shoulderSP = translateSPz 20
+
 waistSP :: SPic -> SPic
 waistSP = translateSPz 10

src/Dodge/Creature/Impulse.hs

@@ -1,48 +1,52 @@
 {-# LANGUAGE TupleSections #-}
-module Dodge.Creature.Impulse
-    ( impulsiveAIBefore
-    , followThenClearImpulses
-    ) where
-import Dodge.Data
-import Dodge.FloatFunction
-import Dodge.RandImpulse
-import Dodge.CreatureEffect
-import Dodge.Creature.Vocalization
-import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Impulse.UseItem
-import Dodge.SoundLogic
-import Geometry
-import LensHelp
 
-import qualified IntMapHelp as IM
+module Dodge.Creature.Impulse (
-import System.Random
+    impulsiveAIBefore,
+    followThenClearImpulses,
+) where
+
 import Control.Monad.State
 import Data.Bifunctor
---import Data.Maybe
+import Dodge.Creature.Impulse.Movement
---
+import Dodge.Creature.Impulse.UseItem
-impulsiveAIBeforeAfter 
+import Dodge.Creature.Vocalization
-    :: (World -> Creature -> Creature)
+import Dodge.CreatureEffect
-    -> (World -> Creature -> Creature)
+import Dodge.Data.World
-    -> Creature -> World -> World
+import Dodge.FloatFunction
+import Dodge.RandImpulse
+import Dodge.SoundLogic
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
+import System.Random
+
+impulsiveAIBeforeAfter ::
+    (World -> Creature -> Creature) ->
+    (World -> Creature -> Creature) ->
+    Creature ->
+    World ->
+    World
 impulsiveAIBeforeAfter startup endup cr w = w' & cWorld . creatures . ix (_crID cr) .~ endup w' cr'
   where
     w' = g w
     (g, cr') = impulsiveAI startup cr w
 
-impulsiveAIBefore :: (World -> Creature -> Creature)
+impulsiveAIBefore ::
-    -> Creature -> World -> World
+    (World -> Creature -> Creature) ->
+    Creature ->
+    World ->
+    World
 impulsiveAIBefore f cr w = g w & cWorld . creatures . ix (_crID cr) .~ cr'
   where
     (g, cr') = impulsiveAI f cr w
 
-impulsiveAI 
+impulsiveAI ::
-    :: (World -> Creature -> Creature) -- | internal creature update
+    (World -> Creature -> Creature) ->
-    -> Creature
+    Creature ->
-    -> World
+    World ->
-    -> (World -> World , Creature)
+    (World -> World, Creature)
 impulsiveAI f cr w = followImpulses w $ f w cr
 
-
 followThenClearImpulses :: Creature -> World -> World
 followThenClearImpulses = impulsiveAIBeforeAfter (const id) (const $ crActionPlan . apImpulse .~ [])
 
@@ -66,8 +70,10 @@ followImpulse cr w imp = case imp of
     ChangePosture post -> crup $ cr & crStance . posture .~ post
     UseItem -> (useItem cr, cr)
     SwitchToItem i -> crup $ cr & crInvSel .~ InvSel i NoInvSelAction
-    Melee cid'      -> (hitCr cid'
+    Melee cid' ->
-        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20)
+        ( hitCr cid'
+        , crMvBy (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crMeleeCooldown .~ 20
+        )
     RandomTurn a -> (randGen .~ snd (rr a), creatureTurn (fst $ rr a) cr)
     MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
     DropItem -> undefined
@@ -84,8 +90,9 @@ followImpulse cr w imp = case imp of
         _ -> crup cr
     ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
     MvForward -> crup $ crMvForward speed cr
-    MvTurnToward p  -> crup
+    MvTurnToward p ->
-        $ creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
+        crup $
+            creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr
   where
     crup = (id,)
     mvType = _crMvType cr
@@ -96,7 +103,8 @@ followImpulse cr w imp = case imp of
     cid = _crID cr
     posFromID cid' = _crPos $ _creatures (_cWorld w) IM.! cid'
     rr a = randomR (- a, a) $ _randGen w
-    hitCr i = (cWorld . creatures . ix i . crState . csDamage 
+    hitCr i =
+        ( cWorld . creatures . ix i . crState . csDamage
             .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect
         )
             . soundStart (CrSound cid) cpos hitS Nothing

src/Dodge/Creature/Impulse/Flee.hs

@@ -1,16 +1,17 @@
-module Dodge.Creature.Impulse.Flee
+module Dodge.Creature.Impulse.Flee where
-    where
-import Dodge.Data
-import Geometry
-import FoldableHelp
 
-retreatPointForFrom
+import Dodge.Data.World
-    :: Float -> World -> Creature -> Point2 -> Maybe Point2
+import FoldableHelp
-retreatPointForFrom d _ cr p 
+import Geometry
-    = safeMinimumOn (dist cpos) 
+
-    $ divideCircle 10 p d
+retreatPointForFrom ::
+    Float -> World -> Creature -> Point2 -> Maybe Point2
+retreatPointForFrom d _ cr p =
+    safeMinimumOn (dist cpos) $
+        divideCircle 10 p d
   where
     cpos = _crPos cr
+
 --    = head $ sortBy (compare `on` (\p -> dist p ypos < 300)) $ retreatP'' : retreatPs
 --  where
 --    retreatPs = sortBy (compare `on` dist cpos) $ map f $ nRaysRad 8 400

src/Dodge/Creature/Impulse/Movement.hs

@@ -1,23 +1,28 @@
 module Dodge.Creature.Impulse.Movement where
-import Dodge.Data
+
+import Control.Lens
 import Dodge.Creature.Statistics
+import Dodge.Data.World
 import Geometry
 
---import Data.Maybe
---import qualified IntMapHelp as IM
-import Control.Lens
 {- | 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. -}
+For now, though, this cannot fail.
-crMvBy :: Point2   -- ^ Movement translation vector, will be made relative to creature direction
+-}
-    -> Creature -> Creature
+crMvBy ::
+    -- | Movement translation vector, will be made relative to creature direction
+    Point2 ->
+    Creature ->
+    Creature
 crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
 
-crMvAbsolute
+crMvAbsolute ::
-    :: Point2   -- ^ Movement translation vector
+    -- | Movement translation vector
-    -> Creature 
+    Point2 ->
-    -> Creature
+    Creature ->
-crMvAbsolute p' cr = advanceStepCounter (magV p) cr
+    Creature
+crMvAbsolute p' cr =
+    advanceStepCounter (magV p) cr
         & crPos %~ (+.+ p)
         & crMvDir .~ argV p
   where
@@ -29,16 +34,18 @@ strengthFactor i
     | i < 1 = 0
     | otherwise = 0.1 * fromIntegral i
 
-crMvForward 
+crMvForward ::
-    :: Float    -- ^ Speed
+    -- | Speed
-    -> Creature 
+    Float ->
-    -> Creature
+    Creature ->
+    Creature
 crMvForward speed = crMvBy (V2 speed 0)
 
-advanceStepCounter
+advanceStepCounter ::
-    :: Float    -- ^ Speed
+    -- | Speed
-    -> Creature 
+    Float ->
-    -> Creature
+    Creature ->
+    Creature
 advanceStepCounter speed = crStance . carriage %~ f
   where
     f car = case car of
@@ -59,16 +66,18 @@ creatureTurnTo p cr
 
 -- the following is perhaps not ideal because it mixes normalizeAngle with
 -- angleVV, but it seems to work
-creatureTurnTowardDir 
+creatureTurnTowardDir ::
-    :: Float -- ^ Angle
+    -- | Angle
-    -> Float -- ^ Turn speed
+    Float ->
-    -> Creature
+    -- | Turn speed
-    -> Creature
+    Float ->
+    Creature ->
+    Creature
 creatureTurnTowardDir a turnSpeed cr
-    | normalizeAngle (abs (a - cdir)) <= turnSpeed
+    | normalizeAngle (abs (a - cdir)) <= turnSpeed =
-                = cr & crDir .~ dirToTarget
+        cr & crDir .~ dirToTarget
-    | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) 
+    | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) =
-                = cr & crDir +~ turnSpeed
+        cr & crDir +~ turnSpeed
     | otherwise = cr & crDir -~ turnSpeed
   where
     cdir = _crDir cr
@@ -78,14 +87,14 @@ creatureTurnTowardDir a turnSpeed cr
 creatureTurnToward :: Point2 -> Float -> Creature -> Creature
 creatureTurnToward p turnSpeed cr
     | vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
-    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
+    | errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed =
-                                        = cr & crDir .~ dirToTarget
+        cr & crDir .~ dirToTarget
     | isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
     | otherwise = cr & crDir -~ turnSpeed
   where
     vToTarg = p -.- _crPos cr
     dirToTarget = argV vToTarg
 
-{- | Speed modifier of an item when not aiming. -}
+-- | Speed modifier of an item when not aiming.
 equipSpeed :: Item -> Float
 equipSpeed _ = 1

src/Dodge/Creature/Impulse/UseItem.hs

@@ -4,12 +4,11 @@ module Dodge.Creature.Impulse.UseItem (
     itemEffect,
 ) where
 
---import qualified Data.IntSet as IS
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Cuse
-import Dodge.Data
+import Dodge.Data.World
 import Dodge.Euse
 import Dodge.HeldUse
 import Dodge.Inventory
@@ -29,7 +28,7 @@ useItem cr' w = fromMaybe (f w) $ do
 
 itemEffect :: Creature -> Item -> World -> World
 itemEffect cr it w = case it ^. itUse of
-    RightUse{_rUse = eff, _useMods = usemods} ->
+    HeldUse{_heldUse = eff, _heldMods = usemods} ->
         hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
     LeftUse{} -> doequipmentchange
     EquipUse{} -> doequipmentchange
@@ -53,7 +52,7 @@ tryReload cr it w f
     | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
         crToggleReloading cr
     | otherwise =
-        (runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . useHammer .~ HammerDown)))
+        (runIdentity . pointerToItemLocation (_itLocation it) (return . (itUse . heldHammer .~ HammerDown)))
             . f
 
 itNeedsLoading :: Item -> Bool
@@ -104,8 +103,8 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     crpoint = cWorld . creatures . ix (_crID cr)
     itmat i = _crInv cr IM.! i
     itm = itmat (crSel cr)
-    onequip itm' = useE ((_eqOnEquip . _eqEq . _itUse) itm') itm'
+    onequip itm' = useE ((_eeOnEquip . _equipEffect . _itUse) itm') itm'
-    onremove itm' = useE ((_eqOnRemove . _eqEq . _itUse) itm') itm'
+    onremove itm' = useE ((_eeOnRemove . _equipEffect . _itUse) itm') itm'
 
 useLeftItem :: Int -> World -> World
 useLeftItem cid w
@@ -114,16 +113,16 @@ useLeftItem cid w
     | otherwise = fromMaybe w $ do
         invid <- _crLeftInvSel cr
         itm <- cr ^? crInv . ix invid
-        f <- cr ^? crInv . ix invid . itUse . lUse
+        f <- cr ^? crInv . ix invid . itUse . leftUse
         return
-            . (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . useHammer .~ HammerDown)))
+            . (runIdentity . pointerToItemLocation (_itLocation itm) (return . (itUse . leftHammer .~ HammerDown)))
             . useL f itm cr
             $ w
   where
     cr = _creatures (_cWorld w) IM.! cid
     itmShouldBeUsed =
         isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
-            || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
+            || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . equipEffect . eeUse)
                     && _crLeftInvSel cr /= Just (crSel cr)
                )
 

src/Dodge/Creature/Inanimate.hs

@@ -2,32 +2,37 @@
 {-
 Inanimate objects such as lamps, barrels, etc
 -}
-module Dodge.Creature.Inanimate
+module Dodge.Creature.Inanimate (
-    ( barrel
+    barrel,
-    , explosiveBarrel
+    explosiveBarrel,
-    , module Dodge.Creature.Lamp
+    module Dodge.Creature.Lamp,
 ) where
-import Dodge.Data
+
 import Dodge.Creature.Lamp
+import Dodge.Data.Creature
 import Dodge.Default
 import qualified IntMapHelp as IM
 import LensHelp
 
 barrel :: Creature
-barrel = defaultInanimate
+barrel =
+    defaultInanimate
         { _crHP = 500
         , _crType = Barreloid PlainBarrel
-    , _crState = defaultState 
+        , _crState =
+            defaultState
                 { _csSpState = Barrel []
                 }
         , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 
 explosiveBarrel :: Creature
-explosiveBarrel = defaultInanimate
+explosiveBarrel =
+    defaultInanimate
         { _crHP = 400
         , _crType = Barreloid ExplosiveBarrel
-    , _crState = defaultState 
+        , _crState =
+            defaultState
                 { _csSpState = Barrel []
                 }
         , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]

src/Dodge/Creature/Lamp.hs

@@ -1,19 +1,23 @@
-module Dodge.Creature.Lamp 
+module Dodge.Creature.Lamp (
-    ( lamp
+    lamp,
-    , colorLamp
+    colorLamp,
 ) where
-import Dodge.Data
+
+import Dodge.Data.Creature
 import Dodge.Default
 import Geometry.Data
-colorLamp 
+
-    :: Point3   -- color of lamp
+colorLamp ::
-    -> Float    -- height of lamp
+    Point3 -> -- color of lamp
-    -> Creature
+    Float -> -- height of lamp
-colorLamp col h = defaultInanimate
+    Creature
+colorLamp col h =
+    defaultInanimate
         { _crHP = 100
         , _crType = Lampoid h col Nothing
         , _crRad = 3
         , _crMass = 3
         }
+
 lamp :: Float -> Creature
 lamp = colorLamp 0.75

src/Dodge/Creature/LauncherCrit.hs

@@ -1,17 +1,17 @@
-module Dodge.Creature.LauncherCrit
+module Dodge.Creature.LauncherCrit (
-    ( launcherCrit
+    launcherCrit,
-    )
+) where
-    where
+
-import Dodge.Data
+import Dodge.Item.Held.Launcher
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Weapon.Launcher
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
-
 launcherCrit :: Creature
-launcherCrit = defaultCreature
+launcherCrit =
+    defaultCreature
         { _crInv = IM.fromList [(0, launcher)]
         , _crRad = 10
         , _crState = defaultState
@@ -19,6 +19,3 @@ launcherCrit = defaultCreature
         }
         & crType . skinUpper .~ light4 red
         & crType . humanoidAI .~ LauncherAI
-
-    
-    

src/Dodge/Creature/LtAutoCrit.hs

@@ -1,21 +1,21 @@
-module Dodge.Creature.LtAutoCrit
+module Dodge.Creature.LtAutoCrit (
-    ( ltAutoCrit 
+    ltAutoCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
+import Dodge.Item.Held.Stick
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
-
 ltAutoCrit :: Creature
-ltAutoCrit = defaultCreature
+ltAutoCrit =
+    defaultCreature
         { _crInv = IM.fromList [(0, autoPistol), (1, medkit 100)]
         , _crRad = 10
         , _crHP = 500
         }
         & crType . humanoidAI .~ LtAutoAI
         & crType . skinUpper .~ light4 red
-

src/Dodge/Creature/Perception.hs

@@ -1,31 +1,28 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Creature.Perception
+module Dodge.Creature.Perception (
-    ( perceptionUpdate
+    perceptionUpdate,
-    , chaseCritPerceptionUpdate
+    chaseCritPerceptionUpdate,
---    , newSounds
 ) where
-import Dodge.Data
-import Dodge.FloatFunction
-import Dodge.Creature.Vocalization
-import Dodge.Base.Collide
-import RandomHelp
---import Dodge.SoundLogic
-import Geometry.Vector
---import Geometry.Data
-import Geometry.Data
-import Sound.Data
---import StrictHelp
 
-import Data.Maybe
 import Control.Lens
-import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
+import Data.Maybe
+import Dodge.Base.Collide
+import Dodge.Creature.Vocalization
+import Dodge.Data.World
+import Dodge.FloatFunction
+import Geometry.Data
+import Geometry.Vector
+import qualified IntMapHelp as IM
+import RandomHelp
+import Sound.Data
 
-perceptionUpdate
+perceptionUpdate ::
-    :: [Int]    -- ^ List of creature ids that may direct attention and awareness
+    -- | List of creature ids that may direct attention and awareness
-    -> World
+    [Int] ->
-    -> Creature
+    World ->
-    -> Creature
+    Creature ->
+    Creature
 perceptionUpdate is w = rememberSounds w . basicAwarenessUpdate . basicAttentionUpdate is w
 
 chaseCritPerceptionUpdate :: [Int] -> World -> Creature -> Creature
@@ -33,12 +30,15 @@ chaseCritPerceptionUpdate is w =
     rememberSounds w . chaseCritAwarenessUpdate w . basicAttentionUpdate is w
 
 {- | Update a creatures awareness based upon the creatures' current direction
- of attention -} -- TODO delete?
+ of attention
+-} -- TODO delete?
 basicAwarenessUpdate :: Creature -> Creature
 basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
-    Fixated i -> cr & crPerception . cpAwareness
+    Fixated i ->
+        cr & crPerception . cpAwareness
             %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
-    AttentiveTo is -> cr 
+    AttentiveTo is ->
+        cr
             & crPerception . cpAwareness
                 %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
             & maybeBark
@@ -52,8 +52,9 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
         --return $ Move p
         maybeBark
             | becomesCognizant = case vocalizationTest cr of
-                Just sid -> crActionPlan . apAction .~ 
+                Just sid ->
-                    [ImpulsesList
+                    crActionPlan . apAction
+                        .~ [ ImpulsesList
                                 [ [Bark sid]
                                 , [RandomImpulse thejitter]
                                 , [RandomImpulse thejitter]
@@ -68,9 +69,11 @@ basicAwarenessUpdate cr = case _cpAttention $ _crPerception cr of
 -- TODO fold in randgen update, requires that this is a world to world function
 chaseCritAwarenessUpdate :: World -> Creature -> Creature
 chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
-    Fixated i -> cr & crPerception . cpAwareness 
+    Fixated i ->
+        cr & crPerception . cpAwareness
             %~ (IM.insert i (Cognizant 10000) . IM.mapMaybe decreaseAwareness)
-    AttentiveTo is -> cr 
+    AttentiveTo is ->
+        cr
             & crPerception . cpAwareness
                 %~ (IM.mapMaybe decreaseAwareness . IM.unionWith combineAwareness is)
             & maybeBark
@@ -85,12 +88,17 @@ chaseCritAwarenessUpdate w cr = case _cpAttention $ _crPerception cr of
         --    return $ Move p
         maybeBark
             | becomesCognizant -- && randBool
-                && cr ^? crVocalization . vcCoolDown == Just 0 
+                && cr ^? crVocalization . vcCoolDown == Just 0 =
-                = let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
+                let soundid = evalState (takeOne (_vcWarnings (_crVocalization cr))) (_randGen w)
                     numjits = fst $ randomR (15, 25) (_randGen w)
-                  in crActionPlan . apStrategy .~ StrategyActions WarningCry 
+                 in crActionPlan . apStrategy
-                        [ImpulsesList ([Bark soundid]: replicate numjits [RandomImpulse thejitter]++
+                        .~ StrategyActions
-                            [[ChangeStrategy $ CloseToMelee 0] ])
+                            WarningCry
+                            [ ImpulsesList
+                                ( [Bark soundid] :
+                                  replicate numjits [RandomImpulse thejitter]
+                                    ++ [[ChangeStrategy $ CloseToMelee 0]]
+                                )
                             , AimAt 0 (_crPos $ _creatures (_cWorld w) IM.! 0)
                             ]
             | otherwise = id
@@ -111,8 +119,7 @@ combineAwareness (Suspicious x) (Cognizant y) = Cognizant $ min 10000 $ x + y
 combineAwareness (Cognizant x) (Suspicious y) = Cognizant $ min 10000 $ x + y
 combineAwareness (Cognizant x) (Cognizant y) = Cognizant $ min 10000 $ x + y
 
-{- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
+-- | Decrease awareness level. Returns 'Maybe' value for use with 'IM.mapMaybe'
- -}
 decreaseAwareness :: Awareness -> Maybe Awareness
 decreaseAwareness (Suspicious 0) = Nothing
 decreaseAwareness (Suspicious x) = Just $ Suspicious (x - 50)
@@ -120,20 +127,25 @@ decreaseAwareness (Cognizant 0) = Just $ Suspicious 1000
 decreaseAwareness (Cognizant x) = Just $ Cognizant $ x - 50
 
 {- | Given a fixed group of creatures, direct attention to those of them that
- - are in view. -}
+ - are in view.
-basicAttentionUpdate
+-}
-    :: [Int] -- ^ Creatures that may attract this creature's attention
+basicAttentionUpdate ::
-    -> World
+    -- | Creatures that may attract this creature's attention
-    -> Creature
+    [Int] ->
-    -> Creature
+    World ->
-basicAttentionUpdate cids w cr = cr & crPerception . cpAttention .~
+    Creature ->
-    AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
+    Creature
+basicAttentionUpdate cids w cr =
+    cr & crPerception . cpAttention
+        .~ AttentiveTo (IM.mapMaybe (newExtraAwareness cr w) $ IM.fromList $ zip cids cids)
 
-newExtraAwareness 
+newExtraAwareness ::
-    :: Creature -- ^ source creature
+    -- | source creature
-    -> World 
+    Creature ->
-    -> Int      -- ^ target creature id
+    World ->
-    -> Maybe Awareness
+    -- | target creature id
+    Int ->
+    Maybe Awareness
 newExtraAwareness cr w cid
     | not $ canSeeIndirect (_crID cr) cid w = Nothing
     | otherwise = Just . Suspicious $ doFloatFloat (_viFOV vi) ang * doFloatFloat (_viDist vi) d * awakeLevelPerception cr
@@ -160,17 +172,20 @@ newSounds = mapMaybe f . M.elems . _playingSounds
         _ -> Nothing
 
 rememberSounds :: World -> Creature -> Creature
-rememberSounds w cr = cr 
+rememberSounds w cr =
+    cr
         & crMemory . soundsToInvestigate .~ closesounds
         & awakeupdate
   where
-    awakeupdate | null closesounds = id
+    awakeupdate
+        | null closesounds = id
         | otherwise = crPerception . cpVigilance .~ Vigilant
     closesounds = map fst (filter (soundIsClose w cr) (newSounds w))
 
 -- TODO work out correct form for sounds passing through walls
 soundIsClose :: World -> Creature -> (Point2, Float) -> Bool
-soundIsClose w cr (pos,vol) = dist cpos pos < 2000 
+soundIsClose w cr (pos, vol) =
+    dist cpos pos < 2000
         && vol > doFloatFloat (_auDist . _cpAudition $ _crPerception cr) (dist pos cpos)
         && hasLOS cpos pos w
   where

src/Dodge/Creature/Picture.hs

@@ -1,31 +1,32 @@
 --{-# LANGUAGE TupleSections #-}
+
 {- |
 Drawing of creatures.
-Takes into account damage etc. -}
+Takes into account damage etc.
-module Dodge.Creature.Picture
+-}
-    ( basicCrPict
+module Dodge.Creature.Picture (
-    , drawCrEquipment
+    basicCrPict,
-    , circLine
+    drawCrEquipment,
-    , picAtCrPos
+    circLine,
-    , shapeAtCrPos
+    picAtCrPos,
-    , picAtCrPosNoRot
+    shapeAtCrPos,
---    , basicCrCorpse
+    picAtCrPosNoRot,
-    , deadScalp
+    deadScalp,
-    , deadUpperBody
+    deadUpperBody,
-    , deadFeet
+    deadFeet,
 ) where
-import Dodge.Data
-import Dodge.Creature.HandPos (translateToRightHand,translateToLeftHand)
-import Dodge.Creature.Test
-import Dodge.Damage
-import Dodge.Item.Draw
-import Picture
-import Geometry
-import Shape
-import ShapePicture
-import qualified Quaternion as Q
 
 import Control.Lens
+import Dodge.Creature.HandPos (translateToLeftHand, translateToRightHand)
+import Dodge.Creature.Test
+import Dodge.Damage
+import Dodge.Data.Creature
+import Dodge.Item.Draw
+import Geometry
+import Picture
+import qualified Quaternion as Q
+import Shape
+import ShapePicture
 
 basicCrPict :: Creature -> SPic
 basicCrPict cr = drawCrEquipment cr <> (basicCrShape cr, mempty)
@@ -39,12 +40,14 @@ shapeAtCrPos sh cr =
     , mempty
     )
 
-basicCrShape 
+basicCrShape ::
-    :: Creature 
+    Creature ->
-    -> Shape
+    Shape
 basicCrShape cr
     | _crCamouflage cr == Invisible = mempty
-    | otherwise = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
+    | otherwise =
+        tr . scaleSH (V3 crsize crsize crsize) $
+            mconcat
                 [ --rotdir . _spShape $ drawEquipment cr
                   rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr
                 , rotdir $ colorSH (_skinUpper cskin) $ upperBody cr
@@ -79,15 +82,18 @@ basicCrShape cr
 feet :: Creature -> Shape
 {-# INLINE feet #-}
 feet cr = case cr ^? crStance . carriage of
-    Just (Walking sa LeftForward)  -> mconcat
+    Just (Walking sa LeftForward) ->
+        mconcat
             [ translateSHf (f sa) off aFoot
             , translateSHf (- f sa) (- off) aFoot
             ]
-    Just (Walking sa RightForward) -> mconcat
+    Just (Walking sa RightForward) ->
+        mconcat
             [ translateSHf (- f sa) off aFoot
             , translateSHf (f sa) (- off) aFoot
             ]
-    _ -> mconcat
+    _ ->
+        mconcat
             [ translateSHf 0 off aFoot
             , translateSHf 0 (- off) aFoot
             ]
@@ -101,15 +107,18 @@ feet cr = case cr ^? crStance . carriage of
 deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
 deadFeet cr = case cr ^? crStance . carriage of
-    Just (Walking sa LeftForward)  -> mconcat
+    Just (Walking sa LeftForward) ->
+        mconcat
             [ translateSHf (f sa) off aFoot
             , translateSHf (- f sa) (- off) aFoot
             ]
-    Just (Walking sa RightForward) -> mconcat
+    Just (Walking sa RightForward) ->
+        mconcat
             [ translateSHf (- f sa) off aFoot
             , translateSHf (f sa) (- off) aFoot
             ]
-    _ -> mconcat
+    _ ->
+        mconcat
             [ translateSHf 0 off aFoot
             , translateSHf 0 (- off) aFoot
             ]
@@ -122,8 +131,11 @@ deadFeet cr = case cr ^? crStance . carriage of
 
 arms :: Creature -> Shape
 {-# INLINE arms #-}
-arms cr = fst $ translateToRightHand cr aHand
+arms cr =
+    fst $
+        translateToRightHand cr aHand
             <> translateToLeftHand cr aHand
+  where
     --arms cr
     --    | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
     --    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat
@@ -136,9 +148,10 @@ arms cr = fst $ translateToRightHand cr aHand
     --        Just (Walking sa LeftForward)  -> waistSH $ translateSHf (-f sa) (-off) aHand
     --        Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off    aHand
     --        _ -> emptySH
-  where
+
     aHand :: SPic
     aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
+
 --    off = 8
 --    sLen = _strideLength $ _crStance cr
 --    f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -149,7 +162,10 @@ deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
 deadRot :: Creature -> Shape -> Shape
 deadRot cr = overPosSH (Q.rotateToZ d)
   where
-    d = maybe (V3 1 0 0) (addZ 0 . unitVectorAtAngle . subtract (_crDir cr+pi))
+    d =
+        maybe
+            (V3 1 0 0)
+            (addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
             (damageDirection . _csDamage $ _crState cr)
 
 scalp :: Creature -> Shape
@@ -169,15 +185,20 @@ scalp cr
 torso :: Creature -> Shape
 {-# INLINE torso #-}
 torso cr
-    | oneH cr   = rotateSH 0.5 $ mconcat
+    | oneH cr =
+        rotateSH 0.5 $
+            mconcat
                 [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
                 , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
                 ]
-    | twists cr = translateSHf 0 5 . rotateSH (-1) $ mconcat
+    | twists cr =
+        translateSHf 0 5 . rotateSH (-1) $
+            mconcat
                 [ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
                 , rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
                 ]
-    | otherwise = mconcat
+    | otherwise =
+        mconcat
             [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
             , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
             ]
@@ -195,17 +216,18 @@ baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10
 upperBody :: Creature -> Shape
 {-# INLINE upperBody #-}
 --upperBody col cr = colorSH (light4 col) $ mconcat
-upperBody cr = mconcat
+upperBody cr =
+    mconcat
         [ arms cr
         , shoulderSH $ torso cr
         ]
 
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
+
 --waistSH :: Shape -> Shape
 --waistSH = translateSHz 10
 
-
 --drawAwakeLevel
 --    :: Creature
 --    -> Picture
@@ -218,6 +240,7 @@ shoulderSH = translateSHz 20
 drawEquipment :: Creature -> SPic
 {-# INLINE drawEquipment #-}
 drawEquipment cr = foldMap (itemEquipPict cr) (_crInv cr)
+
 --drawEquipment cr = foldMap f (_crInv cr)
 --  where
 --    f itm = _itEquipPict itm cr itm
@@ -232,4 +255,3 @@ picAtCrPos thePic cr = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
 picAtCrPosNoRot :: Picture -> Creature -> SPic
 --{-# INLINE picAtCrPos #-}
 picAtCrPosNoRot thePic cr = (,) emptySH $ uncurryV translate (_crPos cr) thePic
-

src/Dodge/Creature/Picture/Awareness.hs

@@ -1,13 +1,14 @@
 module Dodge.Creature.Picture.Awareness where
-import Dodge.Data
-import Dodge.Clock
-import Picture
-import Geometry
 
 import qualified Data.Vector as V
+import Dodge.Clock
+import Dodge.Data.World
+import Geometry
+import Picture
 
 creatureDisplayText :: World -> Creature -> Picture
-creatureDisplayText w cr = setLayer DebugLayer 
+creatureDisplayText w cr =
+    setLayer DebugLayer
         . setDepth 20
         . translate x y
         . color white
@@ -15,11 +16,15 @@ creatureDisplayText w cr = setLayer DebugLayer
         --    . rotate (argV v - 0.5 * pi)
         . scale theScale theScale
         . stackText
-    $ clockCycle 25 (V.fromList 
+        $ clockCycle
+            25
+            ( V.fromList
                 [ \cr' -> [crDisplayVigilance cr']
                 , \cr' -> [crDisplayAwareness cr']
                 ]
-        ) w cr
+            )
+            w
+            cr
   where
     campos = _cameraViewFrom (_cWorld w)
     theScale = 0.15 / _cameraZoom (_cWorld w)

src/Dodge/Creature/PistolCrit.hs

@@ -1,23 +1,21 @@
-module Dodge.Creature.PistolCrit
+module Dodge.Creature.PistolCrit (
-    ( pistolCrit 
+    pistolCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
+import Dodge.Item.Held.Stick
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
-
 pistolCrit :: Creature
-pistolCrit = defaultCreature
+pistolCrit =
+    defaultCreature
         { _crInv = IM.fromList [(0, pistol), (1, medkit 100)]
         , _crRad = 10
         , _crHP = 500
         }
         & crType . humanoidAI .~ PistolAI
         & crType . skinUpper .~ light4 red
-
-    
-

src/Dodge/Creature/ReaderUpdate.hs

@@ -1,31 +1,32 @@
-{- | Functions updating a creature in a Reader World environment -}
+-- | Functions updating a creature in a Reader World environment
-module Dodge.Creature.ReaderUpdate
+module Dodge.Creature.ReaderUpdate (
-    ( doStrategyActions
+    doStrategyActions,
-    , setTargetMv
+    setTargetMv,
-    , targetYouWhenCognizant
+    targetYouWhenCognizant,
-    , overrideMeleeCloseTarget
+    overrideMeleeCloseTarget,
-    , watchUpdateStrat
+    watchUpdateStrat,
-    , reloadOverride
+    reloadOverride,
-    , overrideInternal
+    overrideInternal,
-    , searchIfDamaged
+    searchIfDamaged,
-    , goToTarget
+    goToTarget,
-    , flockACC
+    flockACC,
-    , chaseCritMv
+    chaseCritMv,
-    , setMvPos
+    setMvPos,
-    , setViewPos
+    setViewPos,
 ) where
+
+import Control.Applicative
+import Control.Lens
+import Data.Bifunctor
+import Data.Maybe
+import Dodge.Base
+import Dodge.Creature.Volition
+import Dodge.Data.CreatureEffect
+import Dodge.Data.World
 import Dodge.Zoning.Creature
 import FoldableHelp
-import Dodge.Data
-import Dodge.Creature.Volition
-import Dodge.Base
 import Geometry
-
 import qualified IntMapHelp as IM
-import Control.Lens
-import Control.Applicative
-import Data.Maybe
-import Data.Bifunctor
 
 overrideMeleeCloseTarget :: Creature -> Creature
 overrideMeleeCloseTarget cr = maybe cr (tryMeleeAttack cr) (_targetCr $ _crIntention cr)
@@ -34,8 +35,8 @@ tryMeleeAttack :: Creature -> Creature -> Creature
 tryMeleeAttack cr tcr
     | _crMeleeCooldown cr == 0
         && dist (_crPos tcr) cpos < _crRad cr + _crRad tcr + 5
-        && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi/4
+        && abs (_crDir cr - argV (_crPos tcr -.- cpos)) < pi / 4 =
-                = cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
+        cr & crActionPlan . apImpulse .~ [Melee $ _crID tcr]
     | otherwise = cr
   where
     cpos = _crPos cr
@@ -49,8 +50,10 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
         if hasLOSIndirect (_crPos cr) tpos w
             then Just tpos
             else Nothing
-    mpos = mtpos 
+    mpos =
+        mtpos
             <|> _mvToPoint int
+
 --        <|> listToMaybe (_soundsToInvestigate $ _crMemory cr)
 
 setViewPos :: Creature -> Creature
@@ -58,9 +61,14 @@ setViewPos cr = cr & crIntention . viewPoint %~ (<|> mpos)
   where
     mpos = listToMaybe (_soundsToInvestigate $ _crMemory cr)
 
-setTargetMv :: (World -> Creature -> Maybe Creature)    -- ^ Function for determining target
+setTargetMv ::
-    -> World -> Creature -> Creature 
+    -- | Function for determining target
-setTargetMv targFunc w cr = maybe 
+    (World -> Creature -> Maybe Creature) ->
+    World ->
+    Creature ->
+    Creature
+setTargetMv targFunc w cr =
+    maybe
         cr
         (\ctarg -> cr & crIntention . mvToPoint ?~ _crPos ctarg)
         (targFunc w cr)
@@ -72,10 +80,12 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
     Just tcr ->
         let tpos = _crPos tcr
             cpos = _crPos cr
-            isFarACC cr' = _crGroup cr' == _crGroup cr 
+            isFarACC cr' =
+                _crGroup cr' == _crGroup cr
                     && _crID cr' /= _crID cr
                     && dist (_crPos cr') tpos > dist cpos tpos
-            macr = safeMinimumOn (dist cpos . _crPos) 
+            macr =
+                safeMinimumOn (dist cpos . _crPos)
                     . filter isFarACC
                     $ crsNearCirc cpos 50 w
          in case macr of
@@ -83,7 +93,8 @@ flockACC w cr = case cr ^? crIntention . targetCr . _Just of
                 Just acr ->
                     let r = _crRad acr + _crRad cr + 10
                         horDir = normalizeV (vNormal (cpos -.- tpos))
-                        horShift = if isLHS tpos cpos (_crPos acr)
+                        horShift =
+                            if isLHS tpos cpos (_crPos acr)
                                 then r *.* horDir
                                 else negate r *.* horDir
                      in cr & crIntention . mvToPoint ?~ tpos +.+ horShift
@@ -93,8 +104,10 @@ chaseCritMv w cr = case _apStrategy (_crActionPlan cr) of
     StrategyActions _ _ -> cr
     WarningCry -> cr
     _ -> case cr ^? crIntention . mvToPoint . _Just of
-        Just p | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
+        Just p
-            | otherwise -> cr & crActionPlan . apAction .~ [bfsThenReturn 500]
+            | dist (_crPos cr) p > _crRad cr -> cr & crActionPlan . apAction .~ [PathTo p]
+            | otherwise ->
+                cr & crActionPlan . apAction .~ [bfsThenReturn 500]
                     & crIntention . mvToPoint .~ Nothing
         _ -> viewTarget w cr
 
@@ -105,13 +118,16 @@ goToTarget w cr =
         _ -> viewTarget w cr
 
 lookAroundSelf :: Action
-lookAroundSelf = UseSelf CrTurnAround -- $ \cr -> TurnToPoint (_crPos cr -.- 10 *.* unitVectorAtAngle (_crDir cr))
+lookAroundSelf = UseSelf CrTurnAround
 
 viewTarget :: World -> Creature -> Creature
 viewTarget w cr = do
     case cr ^? crIntention . viewPoint . _Just of
-        Just p | hasLOSIndirect p (_crPos cr) w -> cr'
+        Just p
-                    & crActionPlan . apAction %~ replaceNullWith 
+            | hasLOSIndirect p (_crPos cr) w ->
+                cr'
+                    & crActionPlan . apAction
+                        %~ replaceNullWith
                             ( TurnToPoint p
                                 `DoActionThen` 40 `WaitThen` lookAroundSelf
                                 `DoActionThen` 20 `WaitThen` lookAroundSelf
@@ -128,7 +144,8 @@ replaceNullWith _ xs = xs
 
 doStrategyActions :: Creature -> Creature
 doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
-    Just (StrategyActions strat acs) -> cr 
+    Just (StrategyActions strat acs) ->
+        cr
             & crActionPlan . apAction .~ acs
             & crActionPlan . apStrategy .~ strat
     _ -> cr
@@ -136,14 +153,16 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
 reloadOverride :: Creature -> Creature
 reloadOverride cr
     | cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0
-            && cr ^. crStance . posture == Aiming
+        && cr ^. crStance . posture == Aiming =
-        = cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
+        cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
     | otherwise = cr
   where
     reloadActions =
         [ holsterWeapon
-        , 1 `WaitThen` 
+        , 1
-            DoActionWhileInterrupt NoAction (WdCrBlfromCrBl CrIsReloading) 
+            `WaitThen` DoActionWhileInterrupt
+                NoAction
+                (WdCrBlfromCrBl CrIsReloading)
                 (DoImpulses [ChangeStrategy WatchAndWait])
         ]
 
@@ -152,13 +171,14 @@ overrideInternal test update cr
     | test cr = update cr
     | otherwise = cr
 
-watchUpdateStrat
+watchUpdateStrat ::
-    :: [ (World -> Creature -> Bool, World -> Creature -> Strategy) ]
+    [(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
-    -> World
+    World ->
-    -> Creature
+    Creature ->
-    -> Creature
+    Creature
 watchUpdateStrat fs w cr = case cr ^? crActionPlan . apStrategy of
-    Just WatchAndWait -> cr 
+    Just WatchAndWait ->
+        cr
             & crActionPlan . apStrategy .~ listGuard (map (first uncurry) fs, \_ _ -> WatchAndWait) (w, cr) w cr
     _ -> cr
 
@@ -178,8 +198,11 @@ targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
 searchIfDamaged :: Creature -> Creature
 searchIfDamaged cr
     | _crPastDamage cr > 0 = case _apStrategy (_crActionPlan cr) of
-        WatchAndWait -> cr & crPerception . cpVigilance .~ Vigilant
+        WatchAndWait ->
-            & crActionPlan . apStrategy .~ StrategyActions LookAround 
+            cr & crPerception . cpVigilance .~ Vigilant
+                & crActionPlan . apStrategy
+                    .~ StrategyActions
+                        LookAround
                         [ TurnToPoint (_crPos cr -.- unitVectorAtAngle (_crDir cr))
                             `DoActionThen` 40 `WaitThen` bfsThenReturn 500
                         ]
@@ -188,6 +211,7 @@ searchIfDamaged cr
 
 bfsThenReturn :: Int -> Action
 bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
+
 --    theaction
 --  where
 --    theaction cr w = fromMaybe NoAction $ do
@@ -195,5 +219,3 @@ bfsThenReturn t = ArbitraryAction (CrWdBFSThenReturn t)
 --        let as = take 20 $ map PathTo $ bfsNodePoints n w
 --        return $ DoReplicate t $
 --            foldr DoActionThen NoAction as
-        
-    

src/Dodge/Creature/SentinelAI.hs

@@ -1,26 +1,31 @@
-module Dodge.Creature.SentinelAI
+module Dodge.Creature.SentinelAI (
-    ( sentinelAI
+    sentinelAI,
-    , sentinelFireType
+    sentinelFireType,
-    , sentinelExtraWatchUpdate
+    sentinelExtraWatchUpdate,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Data.Maybe
+import Dodge.Creature.Action
 import Dodge.Creature.ChainUpdates
-import Dodge.Creature.Test
+import Dodge.Creature.Perception
-import Dodge.Creature.Volition
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Strategy
-import Dodge.Creature.Action
+import Dodge.Creature.Test
-import Dodge.Creature.Perception
+import Dodge.Creature.Volition
+import Dodge.Data.CreatureEffect
+import Dodge.Data.World
 import Geometry.Data
 
-import Data.Maybe
-import Control.Lens
-
 sentinelAI :: World -> Creature -> Creature
-sentinelAI w = reloadOverride .
+sentinelAI w =
-    sentinelExtraWatchUpdate
+    reloadOverride
-    [ (crHasTargetLOS
+        . sentinelExtraWatchUpdate
-      , \ _ cr -> StrategyActions (ShootAt (fromJust $ tcid cr)) 
+            [
+                ( crHasTargetLOS
+                , \_ cr ->
+                    StrategyActions
+                        (ShootAt (fromJust $ tcid cr))
                         [ DoActionIf
                             (WdCrNegate $ WdCrBlfromCrBl CrIsAiming)
                             (drawWeapon `DoActionThen` (50 `WaitThen` NoAction))
@@ -42,12 +47,16 @@ sentinelAI w = reloadOverride .
 --chainCreatureUpdates :: [World -> Creature -> Creature] -> World -> Creature -> Creature
 --chainCreatureUpdates ls w cr = foldr (\f -> f w) cr ls
 
-
 sentinelFireType :: (Int -> Action) -> World -> Creature -> Creature
-sentinelFireType f = chainCreatureUpdates
+sentinelFireType f =
+    chainCreatureUpdates
         [ performActions
         , watchUpdateStrat
-      [ (crHasTargetLOS, \_ _ -> StrategyActions (ShootAt 0) 
+            [
+                ( crHasTargetLOS
+                , \_ _ ->
+                    StrategyActions
+                        (ShootAt 0)
                         [ drawwp `DoActionThen` f 0 `DoActionThen` DoImpulses [ChangeStrategy WatchAndWait]
                         , aiming
                         ]
@@ -55,34 +64,38 @@ sentinelFireType f = chainCreatureUpdates
             , (const crAwayFromPost, const goToPostStrat)
             ]
         , perceptionUpdate [0]
---    , Left $ perceptionUp 0
+        , --    , Left $ perceptionUp 0
-    , const doStrategyActions
+          const doStrategyActions
         , const reloadOverride
         , targetYouWhenCognizant
-    , const $ overrideInternal
+        , const $
+            overrideInternal
                 (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
                 (crActionPlan . apStrategy .~ WatchAndWait)
         ]
   where
     drawwp = DoActionIfElse NoAction (WdCrBlfromCrBl CrIsAiming) (DoActionThen drawWeapon (WaitThen 50 NoAction))
-    aiming = AimAt
+    aiming =
+        AimAt
             { _targetID = 0
             , _targetSeenAt = V2 0 0 -- hack
             }
 
-sentinelExtraWatchUpdate
+sentinelExtraWatchUpdate ::
-    :: [(World -> Creature -> Bool , World -> Creature -> Strategy)]
+    [(World -> Creature -> Bool, World -> Creature -> Strategy)] ->
-    -> World
+    World ->
-    -> Creature
+    Creature ->
-    -> Creature
+    Creature
-sentinelExtraWatchUpdate xs = chainCreatureUpdates
+sentinelExtraWatchUpdate xs =
+    chainCreatureUpdates
         [ performActions
         , watchUpdateStrat
             (xs ++ [(const crAwayFromPost, const goToPostStrat)])
         , perceptionUpdate [0]
         , const doStrategyActions
         , targetYouWhenCognizant
-    , const $ overrideInternal
+        , const $
+            overrideInternal
                 (\cr -> crHasTarget cr && crStratConMatches (GetTo (V2 0 0)) cr)
                 (crActionPlan . apStrategy .~ WatchAndWait)
         ]

src/Dodge/Creature/SetTarget.hs

@@ -1,15 +1,15 @@
-{- | Deals with setting a target for creatures -}
+-- | Deals with setting a target for creatures
 module Dodge.Creature.SetTarget where
-import Dodge.Data
 
 import Control.Lens
+import Dodge.Data.World
 import qualified IntMapHelp as IM
-{- | Assumes that you are id 0: if creature is cognizant of you, sets you as target -}
+
-targetYouWhenCognizant
+-- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
-    :: World
+targetYouWhenCognizant ::
-    -> Creature
+    World ->
-    -> Creature
+    Creature ->
+    Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
     Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
     _ -> cr & crIntention . targetCr .~ Nothing
-

src/Dodge/Creature/SpreadGunCrit.hs

@@ -1,21 +1,21 @@
-module Dodge.Creature.SpreadGunCrit
+module Dodge.Creature.SpreadGunCrit (
-    ( spreadGunCrit 
+    spreadGunCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Consumable
+import Dodge.Item.Held.Stick
+import qualified IntMapHelp as IM
 import Picture
 
-import qualified IntMapHelp as IM
-import Control.Lens
-
 spreadGunCrit :: Creature
-spreadGunCrit = defaultCreature
+spreadGunCrit =
+    defaultCreature
         { _crInv = IM.fromList [(0, bangStick 6), (1, medkit 100)]
         , _crRad = 10
         , _crHP = 500
         }
         & crType . humanoidAI .~ SpreadGunAI
         & crType . skinUpper .~ light4 red
-

src/Dodge/Creature/State.hs

@@ -1,34 +1,38 @@
-module Dodge.Creature.State 
+module Dodge.Creature.State (
-    ( stateUpdate
+    stateUpdate,
-    , doDamage
+    doDamage,
 ) where
-import Dodge.Corpse.Make
+
-import Dodge.Data
-import Dodge.Targeting
-import Dodge.ItEffect
-import Dodge.Euse
-import Dodge.EnergyBall
-import Dodge.Damage
-import Dodge.Hammer
-import Dodge.Reloading
-import Dodge.Prop.Gib
 import Dodge.Base
-import Dodge.Creature.State.WalkCycle
+import Dodge.Corpse.Make
-import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Damage
-import Dodge.LightSource.Torch
-import Dodge.SoundLogic
-import RandomHelp
 import Dodge.Creature.Action
+import Dodge.Creature.Damage
+import Dodge.Creature.Impulse.Movement
+import Dodge.Creature.State.WalkCycle
+import Dodge.Damage
+import Dodge.Data.World
+import Dodge.EnergyBall
+import Dodge.Euse
+import Dodge.Hammer
+import Dodge.ItEffect
+import Dodge.LightSource.Torch
+import Dodge.Prop.Gib
+import Dodge.Reloading
+import Dodge.SoundLogic
+import Dodge.Targeting
 import Geometry
-import Picture
-import Shape
-import ShapePicture
 import qualified IntMapHelp as IM
 import LensHelp
+import Picture
+import RandomHelp
+import Shape
+import ShapePicture
 
-foldCr :: [Creature -> World -> World]
+foldCr ::
-    -> Creature -> World -> World
+    [Creature -> World -> World] ->
+    Creature ->
+    World ->
+    World
 --foldCr xs cr w = foldr ($ cr) w xs
 foldCr xs cr w = foldr f w xs
   where
@@ -36,14 +40,16 @@ foldCr xs cr w = foldr f w xs
         Just cr' -> g cr' w'
         Nothing -> w'
 
--- | this seems to work, but I am not sure about the ordering:
+{- | this seems to work, but I am not sure about the ordering:
--- previously, the movement was updated before the ai in order to correctly set the oldpos.
+ previously, the movement was updated before the ai in order to correctly set the oldpos.
--- This should be made more sensible: should the movement side effects apply to
+ This should be made more sensible: should the movement side effects apply to
--- the creature before or after it has moved?
+ the creature before or after it has moved?
--- at what point invSideEffects is applied wrt to when the creature moves
+ at what point invSideEffects is applied wrt to when the creature moves
--- may affect whether the shield moves correctly
+ may affect whether the shield moves correctly
+-}
 stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World
-stateUpdate f = foldCr
+stateUpdate f =
+    foldCr
         [ equipmentEffects
         , invSideEff
         , upInv -- upInv must be called before invSideEff 22.05.23
@@ -58,7 +64,8 @@ stateUpdate f = foldCr
 checkDeath :: Creature -> World -> World
 checkDeath cr w
     | _crHP cr > 0 = w
-    | otherwise = w 
+    | otherwise =
+        w
             --        & creatures . at (_crID cr) .~ Nothing
             & dropByState cr
             & removecr
@@ -66,20 +73,25 @@ checkDeath cr w
             & corpseOrGib cr
   where
     removecr
-        | _crID cr == 0 = (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
+        | _crID cr == 0 =
+            (cWorld . creatures . ix (_crID cr) . crType .~ NonDrawnCreature)
                 . (cWorld . creatures . ix (_crID cr) . crHP .~ 0)
         -- hack to get around player creature being killed but left with more than 0 hp
         | otherwise = cWorld . creatures . at (_crID cr) .~ Nothing
+
 corpseOrGib :: Creature -> World -> World
 corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
     Just (FLAMING, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ scorchSPic)
     Just (ELECTRICAL, _) -> w & plNew (cWorld . corpses) cpID thecorpse
     Just (POISONDAM, _) -> w & plNew (cWorld . corpses) cpID (thecorpse & cpSPic %~ poisonSPic)
-    _ | _crPastDamage cr > 200 -> w & addCrGibs cr
+    _
+        | _crPastDamage cr > 200 ->
+            w & addCrGibs cr
                 & bloodPuddleAt cpos
                 & bloodPuddleAt cpos
                 & bloodPuddleAt cpos
-    _ -> w
+    _ ->
+        w
             & bloodPuddleAt cpos
             & bloodPuddleAt cpos
             & plNew (cWorld . corpses) cpID thecorpse
@@ -88,11 +100,13 @@ corpseOrGib cr w = case maxDamageType (_csDamage (_crState cr)) of
     thecorpse = makeDefaultCorpse cr
 
 scorchSPic :: SPic -> SPic
-scorchSPic = over _1 $
+scorchSPic =
+    over _1 $
         overColSH (mixColors 0.9 0.1 black . normalizeColor)
 
 poisonSPic :: SPic -> SPic
-poisonSPic = over _1 $
+poisonSPic =
+    over _1 $
         overColSH (mixColors 0.5 0.5 green . normalizeColor)
 
 --scorchSPic :: World -> SPic -> SPic
@@ -103,22 +117,27 @@ poisonSPic = over _1 $
 ----    (return . mixColorsLinear 0.9 0.1 black)
 
 bloodPuddleAt :: Point2 -> World -> World
-bloodPuddleAt p w = w
+bloodPuddleAt p w =
-    & snd . plNewID (cWorld . decorations)
+    w
+        & snd
+            . plNewID
+                (cWorld . decorations)
                 (color (dark $ dark red) . setDepth 01 . uncurryV translate (p +.+ q) $ circleSolid 10)
         & randGen .~ g
   where
     (q, g) = randInCirc 10 & runState $ _randGen w
 
 internalUpdate :: Creature -> World -> World
-internalUpdate cr = cWorld . creatures . ix (_crID cr) %~ 
+internalUpdate cr =
-    ( (crHammerPosition %~ moveHammerUp)
+    cWorld . creatures . ix (_crID cr)
+        %~ ( (crHammerPosition %~ moveHammerUp)
                 . stepReloading
                 . updateMovement
            )
 
--- | Drop items according to the creature state.
+{- | Drop items according to the creature state.
--- TODO make sure this doesn't mess up any ItemPosition
+ TODO make sure this doesn't mess up any ItemPosition
+-}
 dropByState :: Creature -> World -> World
 dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath of
     DropAll -> IM.keys $ _crInv cr
@@ -126,11 +145,13 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o
     DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w)
 
 clearDamage :: Creature -> World -> World
-clearDamage cr w = w
+clearDamage cr w =
+    w
         & cWorld . creatures . ix (_crID cr) . crState . csDamage .~ []
 
 doDamage :: Creature -> World -> World
-doDamage cr w = w
+doDamage cr w =
+    w
         & applyPastDamages cr
         & applyCreatureDamage dams cr
   where
@@ -139,13 +160,16 @@ doDamage cr w = w
 -- TODO generalise shake to arbitrary damage amounts
 applyPastDamages :: Creature -> World -> World
 applyPastDamages cr w
-    | _crPastDamage cr > 200 = let (p,g) = runState (randInCirc 3) (_randGen w)
+    | _crPastDamage cr > 200 =
+        let (p, g) = runState (randInCirc 3) (_randGen w)
          in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 100))
                 & randGen .~ g
-    | _crPastDamage cr > 20 = let (p,g) = runState (randInCirc 2) (_randGen w)
+    | _crPastDamage cr > 20 =
+        let (p, g) = runState (randInCirc 2) (_randGen w)
          in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 10))
                 & randGen .~ g
-    | _crPastDamage cr > 0 = let (p,g) = runState (randInCirc 1) (_randGen w)
+    | _crPastDamage cr > 0 =
+        let (p, g) = runState (randInCirc 1) (_randGen w)
          in w & cWorld . creatures . ix (_crID cr) %~ (crMvBy p . (crPastDamage -~ 1))
                 & randGen .~ g
     | otherwise = w
@@ -153,7 +177,8 @@ applyPastDamages cr w
 movementSideEff :: Creature -> World -> World
 movementSideEff cr w
     | hasJetPack = case cr ^? crStance . carriage of
-        Just (Boosting v) -> w
+        Just (Boosting v) ->
+            w
                 & randGen .~ g
                 & makeFlamelet
                     (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
@@ -167,33 +192,39 @@ movementSideEff cr w
     hasJetPack = any (\it -> it ^? itType . iyBase == Just (EQUIP JETPACK)) $ _crInv cr
     oldPos = _crOldPos cr
     momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
-    momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'
+    momentum''
+        | magV momentum' > 3 = 3 *.* normalizeV momentum'
         | otherwise = momentum'
     momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng
     (randDir, g) = randomR (-0.5, 0.5) $ _randGen w
     (randAng, _) = randomR (0, 2 * pi) $ _randGen w
 
 useUpdate :: ItemUse -> ItemUse
-useUpdate = (useHammer %~ moveHammerUp)
+useUpdate =
-    . (useDelay . warmTime %~ decreaseToZero)
+    (heldHammer %~ moveHammerUp)
-    . (useDelay . rateTime %~ decreaseToZero)
+        . (heldDelay . warmTime %~ decreaseToZero)
+        . (heldDelay . rateTime %~ decreaseToZero)
 
 useEquipment :: Creature -> Int -> World -> World
-useEquipment cr i = useE (_eqUse (_eqEq $ _itUse itm)) itm cr
+useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr
   where
     itm = _crInv cr IM.! i
+
 -- a map updating all inventory items
 upInv :: Creature -> World -> World
 upInv cr = cWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr)
+
 -- a loop going over equipped items
 equipmentEffects :: Creature -> World -> World
 equipmentEffects cr = flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr)
+
 -- a loop going over all inventory items
 invSideEff :: Creature -> World -> World
 invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
   where
-    f i it w' = itemInvSideEffect cr it 
+    f i it w' =
-        $ doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
+        itemInvSideEffect cr it $
+            doItemTargeting i cr w' & maybe id (\g -> doInvEffect g it cr) (it ^? itEffect . ieInv)
 
 itemInvSideEffect :: Creature -> Item -> World -> World
 itemInvSideEffect cr it
@@ -212,27 +243,37 @@ itemUpdate cr i
     | i == crSel cr = baseupdate True
     | otherwise = baseupdate False
   where
-    baseupdate bool = updateAutoRecharge . (itUse %~ useUpdate) 
+    baseupdate bool =
+        updateAutoRecharge . (itUse %~ useUpdate)
             . (itLocation .~ InInv (_crID cr) i)
             . (itIsHeld .~ bool)
+
 updateAutoRecharge :: Item -> Item
 updateAutoRecharge it = case it ^? itUse . leftConsumption of
     Just (AutoRecharging l m t p)
         | l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l + 1) m t t
         | l < m -> it & itUse . leftConsumption . arProgress -~ 1
     _ -> it
+
 doItemTargeting :: Int -> Creature -> World -> World
 doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of
     Nothing -> w
     Just NoTargeting -> w
-    Just t  -> let (w',t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
+    Just t ->
+        let (w', t') = updateTargeting (_tgUpdate t) (_crInv cr IM.! invid) cr w t
          in w' & cWorld . creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ t'
 
 weaponReloadSounds :: Creature -> World -> World
 weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
-    Just ReloadAction{_reloadAction = la} -> soundContinue 
+    Just ReloadAction{_reloadAction = la} ->
-        (CrReloadSound cid) (_crPos cr) (_actionSound la) (Just 1) w
+        soundContinue
+            (CrReloadSound cid)
+            (_crPos cr)
+            (_actionSound la)
+            (Just 1)
+            w
     _ -> w
+  where
     --        PassiveReload stype | Just (_laReloadTime am) == am ^? laTransfer . transferTime
     --                                        -> soundContinue (CrReloadSound 0) (_crPos cr) stype Nothing w
     --        PassiveReload _ -> w
@@ -246,7 +287,7 @@ weaponReloadSounds cr w = case cr ^? crInvSel . iselAction of
     --    Just NoConsumption {} -> w
     --    Just ItemItselfConsumable {} -> w
     --    Nothing -> w
-  where 
+
     cid = _crID cr
 
 updateMovement :: Creature -> Creature
@@ -255,7 +296,8 @@ updateMovement cr
     | otherwise = updateWalkCycle cr
   where
     momentum' = 0.98 *.* (_crPos cr -.- _crOldPos cr)
-    momentum'' | magV momentum' > 1 = 1 *.* normalizeV momentum'
+    momentum''
+        | magV momentum' > 1 = 1 *.* normalizeV momentum'
         | otherwise = momentum'
     momentum = momentum''
 

src/Dodge/Creature/State/WalkCycle.hs

@@ -1,15 +1,14 @@
-module Dodge.Creature.State.WalkCycle
+module Dodge.Creature.State.WalkCycle (
-    ( updateWalkCycle
+    updateWalkCycle,
-    , footstepSideEffect
+    footstepSideEffect,
-    )
+) where
-    where
+
-import Dodge.Data
+import Control.Lens
+import Dodge.Data.World
 import Dodge.SoundLogic
 import Geometry.Data
 import Sound.Data
 
-import Control.Lens
-
 updateWalkCycle :: Creature -> Creature
 updateWalkCycle cr = case cr ^? crStance . carriage of
     Just (Walking x ff) | x > maxStride -> cr & crStance . carriage .~ Walking 0 (normalGait ff)

src/Dodge/Creature/Statistics.hs

@@ -3,11 +3,10 @@ module Dodge.Creature.Statistics (
     getCrDexterity,
 ) where
 
---import Data.Strict.IntMap.Autogen.Merge.Strict
 import Data.IntMap.Merge.Strict
 import Data.Maybe
 import Dodge.Creature.Test
-import Dodge.Data
+import Dodge.Data.Creature
 import qualified IntMapHelp as IM
 import LensHelp
 
@@ -38,5 +37,5 @@ crCurrentEquipment cr =
 strFromHeldItem :: Creature -> Int
 strFromHeldItem cr
     | _posture (_crStance cr) == Aiming || crIsReloading cr =
-        negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
+        negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimWeight
     | otherwise = 0

src/Dodge/Creature/Strategy.hs

@@ -1,18 +1,20 @@
-module Dodge.Creature.Strategy
+module Dodge.Creature.Strategy (
-    ( goToPostStrat
+    goToPostStrat,
-    )
+) where
-    where
-import Dodge.Data
-import Dodge.Creature.Test
-import Dodge.Creature.Volition
 
 import Data.List
+import Dodge.Creature.Test
+import Dodge.Creature.Volition
+import Dodge.Data.Creature
 
 goToPostStrat :: Creature -> Strategy
 goToPostStrat cr = case find sentinelGoal $ _apGoal $ _crActionPlan cr of
-    Just (SentinelAt p _) -> StrategyActions (GetTo p)
+    Just (SentinelAt p _) ->
-        [DoActionThen (WaitThen 150 holsterIfAiming)
+        StrategyActions
-            $ DoActionThen (PathTo p) 
+            (GetTo p)
+            [ DoActionThen (WaitThen 150 holsterIfAiming) $
+                DoActionThen
+                    (PathTo p)
                     NoAction
                     --     $ DoImpulses [ChangeStrategy WatchAndWait]
             ]

src/Dodge/Creature/SwarmCrit.hs

@@ -1,14 +1,15 @@
-module Dodge.Creature.SwarmCrit
+module Dodge.Creature.SwarmCrit (
-    ( swarmCrit
+    swarmCrit,
 ) where
-import Dodge.Data
+
+import Control.Lens
+import Dodge.Data.Creature
 import Dodge.Default
 import Picture
 
-import Control.Lens
-
 swarmCrit :: Creature
-swarmCrit = defaultCreature
+swarmCrit =
+    defaultCreature
         { _crHP = 1
         , _crRad = 2
         , _crMass = 2
@@ -25,5 +26,3 @@ swarmCrit = defaultCreature
 --  where
 --    cpos = _crPos cr
 --    ypos = _crPos tcr
-
-

src/Dodge/Creature/Test.hs

@@ -5,34 +5,31 @@ Note that if there is a world parameter,
 the creature NEED NOT be the same as the creature with that id in the world,
 in fact a creature with that id need not exist.
 -}
-module Dodge.Creature.Test
+module Dodge.Creature.Test (
-    ( crIsAiming
+    crIsAiming,
-    , crIsReloading
+    crIsReloading,
-    , crIsArmouredFrom
+    crIsArmouredFrom,
-    , oneH
+    oneH,
-    , twists
+    twists,
-    , twoFlat
+    twoFlat,
-    , crWeaponReady
+    crWeaponReady,
-    , crInAimStance
+    crInAimStance,
-    , crNearPoint
+    crNearPoint,
-    , isAnimate
+    isAnimate,
-    , crCanShoot
+    crCanShoot,
-    , crHasTargetLOS
+    crHasTargetLOS,
-    , crAwayFromPost
+    crAwayFromPost,
-    , crHasTarget
+    crHasTarget,
-    , crStratConMatches
+    crStratConMatches,
-    , crSafeDistFromTarg
+    crSafeDistFromTarg,
-    )
+) where
-    where
-import Dodge.Data
-import Dodge.Base.Collide
-import Geometry
---import SameConstr
 
+import Control.Lens
 import Data.List (find)
 import Data.Maybe
---import qualified IntMapHelp as IM
+import Dodge.Base.Collide
-import Control.Lens
+import Dodge.Data.World
+import Geometry
 
 crIsReloading :: Creature -> Bool
 crIsReloading cr = case cr ^? crInvSel . iselAction of
@@ -65,6 +62,7 @@ crSafeDistFromTarg d cr = case cr ^? crIntention . targetCr . _Just of
 
 crStratConMatches :: Strategy -> Creature -> Bool
 crStratConMatches strat cr = strat == _apStrategy (_crActionPlan cr)
+
 -- this equality check might be slow...
 
 crAwayFromPost :: Creature -> Bool
@@ -79,8 +77,9 @@ crCanShoot :: Creature -> Bool
 crCanShoot cr = crIsAiming cr && crWeaponReady cr
 
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr = crIsAiming cr
+crInAimStance as cr =
-    && cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance == Just as
+    crIsAiming cr
+        && cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance == Just as
 
 oneH :: Creature -> Bool
 oneH = crInAimStance OneHand
@@ -101,11 +100,13 @@ hasFrontArmour :: Point2 -> Creature -> Bool
 hasFrontArmour p cr = fromMaybe False $ do
     invid <- cr ^? crEquipment . ix OnChest
     ittype <- cr ^? crInv . ix invid . itType . iyBase
-    return $ EQUIP FRONTARMOUR == ittype
+    return $
+        EQUIP FRONTARMOUR == ittype
             && p /= _crOldPos cr
             && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
--- even though angleVV can generate NaN, the comparison seems to deal with it
   where
+    -- even though angleVV can generate NaN, the comparison seems to deal with it
+
     frontarmdirection
         | crInAimStance OneHand cr = 0.5
         | crInAimStance TwoHandTwist cr = negate 1

src/Dodge/Creature/Update.hs

@@ -1,14 +1,14 @@
 module Dodge.Creature.Update where
-import Dodge.Data
-import Dodge.Creature.State
-import Dodge.Creature.Impulse
-import Dodge.Creature.ChainUpdates
-import Dodge.Lampoid
-import Dodge.Humanoid
-import Dodge.Turretoid
-import Dodge.Barreloid
-import LensHelp
 
+import Dodge.Barreloid
+import Dodge.Creature.ChainUpdates
+import Dodge.Creature.Impulse
+import Dodge.Creature.State
+import Dodge.Data.World
+import Dodge.Humanoid
+import Dodge.Lampoid
+import Dodge.Turretoid
+import LensHelp
 import System.Random
 
 updateCreature :: Creature -> World -> World
@@ -19,11 +19,14 @@ updateCreature cr = case _crType cr of
     Barreloid{} -> updateBarreloid cr
     NonDrawnCreature -> id
 
-
 -- bit of a hack to get new random generators after each creature's update
-defaultImpulsive :: [World -> Creature -> Creature]
+defaultImpulsive ::
-    -> Creature -> World -> World
+    [World -> Creature -> Creature] ->
+    Creature ->
+    World ->
+    World
 defaultImpulsive = fmap (fmap updateRandGen) . stateUpdate . impulsiveAIBefore . chainCreatureUpdates
   where
-    updateRandGen w = let (_,g) = randomR (0,1::Int) (_randGen w)
+    updateRandGen w =
+        let (_, g) = randomR (0, 1 :: Int) (_randGen w)
          in w & randGen .~ g

src/Dodge/Creature/Vocalization.hs

@@ -1,8 +1,8 @@
 module Dodge.Creature.Vocalization where
-import Dodge.Data
-import Sound.Data
 
 import Control.Lens
+import Dodge.Data.Creature
+import Sound.Data
 
 vocalizationTest :: Creature -> Maybe SoundID
 vocalizationTest cr = case cr ^? crVocalization . vcCoolDown of

src/Dodge/Creature/Volition.hs

@@ -1,12 +1,13 @@
-{- | Not a good name, perhaps: internal creature actions. -}
+-- | Not a good name, perhaps: internal creature actions.
-module Dodge.Creature.Volition
+module Dodge.Creature.Volition (
-    ( holsterWeapon
+    holsterWeapon,
-    , drawWeapon
+    drawWeapon,
-    , shootTillEmpty
+    shootTillEmpty,
---    , fleeFrom
+    shootFirstMiss,
-    , shootFirstMiss
 ) where
-import Dodge.Data
+
+import Dodge.Data.Creature
+import Dodge.Data.CreatureEffect
 import Dodge.SoundLogic.LoadSound
 import Geometry
 
@@ -14,10 +15,10 @@ holsterWeapon, drawWeapon :: Action
 holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
 drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
 
-
 shootTillEmpty :: Action
 --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])
-shootTillEmpty = (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
+shootTillEmpty =
+    (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem])
         `DoActionThen` 20 `WaitThen` holsterWeapon
 
 --advanceShoot :: Int -> Action
@@ -31,7 +32,7 @@ shootTillEmpty = (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoImpulses [UseItem]
 
 shootFirstMiss :: Action
 shootFirstMiss =
-    LeadTarget (V2 30 50) `DoActionThen`
+    LeadTarget (V2 30 50)
-    DoImpulses [UseItem] `DoActionThen`
+        `DoActionThen` DoImpulses [UseItem]
-    (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0),DoImpulses [UseItem]])
+        `DoActionThen` (WdCrBlfromCrBl CrCanShoot `DoActionWhile` DoActions [LeadTarget (V2 0 0), DoImpulses [UseItem]])
         `DoActionThen` 20 `WaitThen` holsterWeapon

src/Dodge/Creature/YourControl.hs

@@ -1,25 +1,27 @@
-module Dodge.Creature.YourControl
+module Dodge.Creature.YourControl (
-    ( yourControl
+    yourControl,
 ) where
-import Dodge.Data
+
-import Dodge.LightSource
+import qualified Data.Map.Strict as M
 import Dodge.Base.Coordinate
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Test
-import Dodge.Update.UsingInput
+import Dodge.Data.World
 import Dodge.InputFocus
+import Dodge.LightSource
+import Dodge.Update.UsingInput
 import Geometry
 import LensHelp
-
 import qualified SDL
-import qualified Data.Map.Strict as M
+
-{- | The AI equivalent for your control. -}
+-- | The AI equivalent for your control.
 yourControl :: Creature -> World -> World
 yourControl cr w
     | inTermFocus w = dimCreatureLight cr w & updateUsingInput
-    | otherwise = dimCreatureLight cr w
+    | otherwise =
-        & cWorld . creatures . ix (_crID cr) %~ 
+        dimCreatureLight cr w
-            (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
+            & cWorld . creatures . ix (_crID cr)
+                %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w))
             & updateUsingInput
 
 dimCreatureLight :: Creature -> World -> World
@@ -27,23 +29,25 @@ dimCreatureLight cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (
 
 -- note the order of operation, setting the posture first--this prevents the twist fire bug
 
-{- | Turn key presses into creature movement.  -}
+-- | Turn key presses into creature movement.
-wasdWithAiming 
+wasdWithAiming ::
-    :: World
+    World ->
-    -> Float    -- ^ Base speed
+    -- | Base speed
-    -> Creature 
+    Float ->
-    -> Creature
+    Creature ->
+    Creature
 wasdWithAiming w speed cr
     | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
-    | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w
+    | crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons w =
-                = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
+        addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
     | otherwise = theMovement $ theTurn $ removeTwist cr
   where
     twistamount = 1.6
-    removeTwist cr' = cr' 
+    removeTwist cr' =
+        cr'
             & crDir +~ _crTwist cr'
             & crTwist .~ 0
-    anytwist = case cr ^? crInv . ix (crSel cr) . itUse . useAim . aimStance of
+    anytwist = case cr ^? crInv . ix (crSel cr) . itUse . heldAim . aimStance of
         Just TwoHandTwist -> twistamount * pi
         _ -> 0
     addAnyTwist = crTwist .~ anytwist
@@ -70,11 +74,11 @@ wasdM scancode = case scancode of
 wasdDir :: World -> Point2
 wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
 
-{- | Set posture according to mouse presses. -}
+-- | Set posture according to mouse presses.
 mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
 mouseActionsCr pkeys cr
-    | rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction
+    | rbPressed && cr ^?! crInvSel . iselAction == NoInvSelAction =
-                = cr & crStance . posture .~ Aiming
+        cr & crStance . posture .~ Aiming
     | otherwise = cr & crStance . posture .~ AtEase
   where
     rbPressed = SDL.ButtonRight `M.member` pkeys

src/Dodge/CreatureEffect.hs

@@ -1,12 +1,13 @@
 module Dodge.CreatureEffect where
-import Dodge.Creature.Test
-import Dodge.Data
-import Geometry
-import Dodge.Base.Collide
-import Dodge.Path
-import qualified IntMapHelp as IM
 
 import Data.Maybe
+import Dodge.Base.Collide
+import Dodge.Creature.Test
+import Dodge.Data.CreatureEffect
+import Dodge.Data.World
+import Dodge.Path
+import Geometry
+import qualified IntMapHelp as IM
 
 doWdCrCr :: WdCrCr -> World -> Creature -> Creature
 doWdCrCr ce = case ce of
@@ -38,7 +39,10 @@ doWdCrBl wcb = case wcb of
     WdCrTrue -> const $ const True
     WdCrBlfromCrBl cb -> \_ cr -> doCrBl cb cr
     WdCrNegate wcb' -> \w -> not . doWdCrBl wcb' w
-    WdCrLOSTarget -> \w cr -> maybe False (\cid -> canSee (_crID cr) cid w) 
+    WdCrLOSTarget -> \w cr ->
+        maybe
+            False
+            (\cid -> canSee (_crID cr) cid w)
             (_crID <$> _targetCr (_crIntention cr))
     WdCrSafeDistFromTarget x -> \_ -> crSafeDistFromTarg x -- currently ignores walls etc
 
@@ -74,21 +78,22 @@ doCrWdAc cw = case cw of
     CrWdBFSThenReturn t -> \cr w -> fromMaybe NoAction $ do
         n <- walkableNodeNear w (_crPos cr)
         let as = take 20 $ map PathTo $ bfsNodePoints n w
-        return $ DoReplicate t $
+        return $
+            DoReplicate t $
                 foldr DoActionThen NoAction as
     ChooseMovementSpreadGun -> chooseMovementSpreadGun
     ChooseMovementLtAuto -> chooseMovementLtAuto
 
 chooseMovementSpreadGun :: Creature -> World -> Action
 chooseMovementSpreadGun cr w
-    | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi
+    | dist cpos p < 30 && safeAngleVV (p -.- cpos) (unitVectorAtAngle (_crDir cr)) > pi =
-        = DoImpulses [UseItem, MoveForward (-3)]
+        DoImpulses [UseItem, MoveForward (-3)]
     | d < 30 = DoImpulses [UseItem, TurnToward p 0.06]
     | d < 60 = DoImpulses [UseItem, TurnToward p 0.06, MoveForward 3]
     | d < 100 = DoImpulses [TurnToward p 0.06, MoveForward 3]
     | d < 200 = DoImpulses [TurnToward p (0.06 + 0.002 * (d -100)), MoveForward 3]
-    | otherwise
+    | otherwise =
-          = DoImpulses [TurnToward p 0.26, MoveForward 3]
+        DoImpulses [TurnToward p 0.26, MoveForward 3]
   where
     d = dist cpos p
     cpos = _crPos cr
@@ -99,10 +104,10 @@ chooseMovementLtAuto :: Creature -> World -> Action
 chooseMovementLtAuto cr w
     | dist cpos p > 200 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward 3]
     | dist cpos p < 80 = DoImpulses [UseItem, TurnToward p 0.05, MoveForward (-3)]
-    | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4
+    | errorAngleVV 22 (p' -.- cpos) (unitVectorAtAngle (_crDir cr)) < 0.4 =
-          = DoImpulses [UseItem,TurnToward p' 0.01, Move (V2 0 3)]
+        DoImpulses [UseItem, TurnToward p' 0.01, Move (V2 0 3)]
-    | otherwise
+    | otherwise =
-          = DoImpulses [UseItem,TurnToward p' 0.05, Move (V2 0 3)]
+        DoImpulses [UseItem, TurnToward p' 0.05, Move (V2 0 3)]
   where
     cpos = _crPos cr
     tcr = _creatures (_cWorld w) IM.! 0

src/Dodge/CullBox.hs

@@ -1,14 +1,13 @@
-module Dodge.CullBox 
+module Dodge.CullBox (
-    ( updateBounds
+    updateBounds,
-    ) 
+) where
-  where
-import Dodge.Data
-import Dodge.Base.Window
-import Geometry
-import Dodge.Update.Camera
 
-import Data.Maybe
 import Control.Lens
+import Data.Maybe
+import Dodge.Base.Window
+import Dodge.Data.Universe
+import Dodge.Update.Camera
+import Geometry
 
 findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
 findBoundDists cfig w
@@ -19,7 +18,8 @@ findBoundDists cfig w
     hh = halfHeight cfig
 
 updateBounds :: Universe -> Universe
-updateBounds uv = uv
+updateBounds uv =
+    uv
         & uvWorld . cWorld . boundDist .~ bdists
         & uvWorld . cWorld . boundBox .~ map ((+.+ _cameraCenter (_cWorld w)) . rotateV (_cameraRot (_cWorld w))) (rectNSWE n s w' e)
   where

src/Dodge/Cuse.hs

@@ -1,7 +1,7 @@
 module Dodge.Cuse where
-import Dodge.Data
 
 import Control.Lens
+import Dodge.Data.World
 
 useC :: Cuse -> Item -> Creature -> World -> World
 useC cu = case cu of

src/Dodge/Damage.hs

@@ -1,11 +1,13 @@
 module Dodge.Damage where
-import Dodge.Data
+
+import qualified Data.Map.Strict as M
+import Dodge.Data.CrWlID
+import Dodge.Data.World
 import Dodge.Wall.Damage
 import FoldableHelp
 import Geometry.Vector
 import LensHelp
 
-import qualified Data.Map.Strict as M
 damageCrWlID :: Damage -> CrWlID -> World -> World
 damageCrWlID dam crwl = case crwl of
     NothingID -> id

src/Dodge/DamageCircle.hs

@@ -1,15 +1,17 @@
-module Dodge.DamageCircle 
+module Dodge.DamageCircle (
-    ( damageCircle
+    damageCircle,
 ) where
-import Dodge.Data
-import Dodge.WorldEvent.ThingsHit
-import Geometry
-import LensHelp
 
 import Data.Foldable
+import Dodge.Data.World
+import Dodge.WorldEvent.ThingsHit
+import Geometry
 import qualified IntMapHelp as IM
+import LensHelp
+
 damageCircle :: Float -> Point2 -> DamageType -> Int -> World -> World
-damageCircle r sp dt da w = w
+damageCircle r sp dt da w =
+    w
         & cWorld . wallDamages %~ addwalldamages
         & cWorld . creatures %~ addcreaturedamages
   where
@@ -21,10 +23,16 @@ damageCircle r sp dt da w = w
     crdam p cr = Damage dt da sp p (_crPos cr) NoDamageEffect
     crstodam = crsHitRadial sp r w
 
-damageWlCircle :: (Point2 -> Damage) 
+damageWlCircle ::
-    -> IM.IntMap [Damage] -> (Point2,Wall) -> IM.IntMap [Damage]
+    (Point2 -> Damage) ->
+    IM.IntMap [Damage] ->
+    (Point2, Wall) ->
+    IM.IntMap [Damage]
 damageWlCircle f wldams (p, wl) = IM.insertWith (++) (_wlID wl) [f p] wldams
 
-damageCrCircle :: (Point2 -> Creature -> Damage) 
+damageCrCircle ::
-    -> IM.IntMap Creature -> (Point2,Creature) -> IM.IntMap Creature
+    (Point2 -> Creature -> Damage) ->
+    IM.IntMap Creature ->
+    (Point2, Creature) ->
+    IM.IntMap Creature
 damageCrCircle crdam crs (p, cr) = crs & ix (_crID cr) . crState . csDamage .:~ crdam p cr

src/Dodge/Data.hs

@@ -1,27 +1,22 @@
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {- |
 Contains base datatypes that cannot be seperated into
 different modules because they are interdependent;
 circular imports are probably not a good idea.
-
-WARNING: orphan instances concerning Aeson classes and SDL datatypes have been introduced.
-The warnings have been disabled.
 -}
 module Dodge.Data (
-    module Dodge.Data,
+    module Dodge.Data.World,
+    module Dodge.Data.WorldEffect,
     module Dodge.Data.ArcStep,
+    module Dodge.Data.Config,
     module Dodge.Data.Zoning,
     module Dodge.Data.Distortion,
     module Dodge.Data.Material,
-    module Dodge.Data.SoundOrigin,
+    module Dodge.Data.GenWorld,
+    module Dodge.Data.Universe,
     module Dodge.Data.Hammer,
-    module Dodge.Data.RightButtonOptions,
-    module Dodge.Data.Config,
     module MaybeHelp,
     module Dodge.Data.RoomCluster,
     module Dodge.Data.Room,
@@ -32,272 +27,22 @@ module Dodge.Data (
     module Dodge.Data.MountedObject,
 ) where
 
-import Color
+import Dodge.Data.Config
-import Control.Lens
+import Dodge.Data.WorldEffect
-import Control.Monad.State
-import qualified Data.Map.Strict as M
-import Data.Preload
-import qualified Data.Set as S
-import qualified Data.Text as T
-import Data.Tile
-import Dodge.Config.KeyConfig
 import Dodge.Data.ActionPlan
 import Dodge.Data.ArcStep
 import Dodge.Data.CWorld
-import Dodge.Data.Config
 import Dodge.Data.CrWlID
 import Dodge.Data.CreatureEffect
 import Dodge.Data.Distortion
+import Dodge.Data.GenWorld
 import Dodge.Data.Hammer
 import Dodge.Data.Material
 import Dodge.Data.MountedObject
 import Dodge.Data.ObjectType
-import Dodge.Data.RightButtonOptions
 import Dodge.Data.Room
 import Dodge.Data.RoomCluster
-import Dodge.Data.SoundOrigin
+import Dodge.Data.Universe
+import Dodge.Data.World
 import Dodge.Data.Zoning
-import Geometry.Data
-import qualified IntMapHelp as IM
 import MaybeHelp
-import Picture.Data
-import SDL (MouseButton, Scancode)
-import Sound.Data
-import Streaming
-import System.Random
-
-type CRUpdate' = Creature -> World -> (World -> World, Creature)
-
-data Universe = Universe
-    { _uvWorld :: World
-    , _preloadData :: PreloadData
-    , _menuLayers :: [ScreenLayer]
-    , _savedWorlds :: M.Map SaveSlot World
-    , _keyConfig :: KeyConfigSDL
-    , _uvIOEffects :: Universe -> IO Universe
-    , _uvConfig :: Configuration
-    , _uvTestString :: Universe -> [String]
-    }
-
-data GenWorld = GenWorld
-    { _gwWorld :: World
-    , _genPlacements :: IM.IntMap [(Placement, Int)]
-    , _genRooms :: IM.IntMap Room
-    }
-
-data World = World
-    { _cWorld :: CWorld
-    , _randGen :: StdGen
-    , _toPlaySounds :: M.Map SoundOrigin Sound
-    , _playingSounds :: M.Map SoundOrigin Sound
-    , _mousePos :: Point2
-    , _keys :: S.Set Scancode
-    , _mouseButtons :: M.Map MouseButton Bool
-    , _hammers :: M.Map WorldHammer HammerPosition
-    , _testFloat :: Float
-    , _lLine :: (Point2, Point2)
-    , _rLine :: (Point2, Point2)
-    , _lSelect :: Point2
-    , _rSelect :: Point2
-    , _backspaceTimer :: Int
-    , _timeFlow :: TimeFlowStatus
-    , _rbOptions :: RightButtonOptions
-    }
-
-data TimeFlowStatus
-    = RewindingNow
-    | RewindingLastFrame
-    | NormalTimeFlow
-    deriving (Eq, Ord, Show, Read)
-
-data WorldHammer
-    = SubInvHam
-    | DoubleMouseHam
-    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
-data SaveSlot
-    = QuicksaveSlot
-    | LevelStartSlot
-    | SaveSlotNum Int
-    deriving (Eq, Ord, Show, Read)
-
-data OptionScreenFlag = NormalOptions | GameOverOptions
-    deriving (Eq, Ord, Show, Read)
-
-data ScreenLayer
-    = OptionScreen
-        { _scTitle :: Universe -> String
-        , _scOptions :: [MenuOption]
-        , _scDefaultEff :: Universe -> IO (Maybe Universe)
-        , _scOptionFlag :: OptionScreenFlag
-        , _scOptionsOffset :: Int
-        }
-    | ColumnsScreen
-        { _scTitle :: Universe -> String
-        , _scColumns :: [(String, String)]
-        }
-    | InputScreen
-        { _scInput :: T.Text
-        , _scFooter :: String
-        }
-    | WaitScreen
-        { _scWaitMessage :: Universe -> String
-        , _scWaitTime :: Int
-        }
-    | DisplayScreen
-        { _scDisplay :: Universe -> Picture
-        }
-
-data MenuOption
-    = Toggle
-        { _moEff :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
-        , _moKey :: Scancode
-        }
-    | Toggle2
-        { _moKey1 :: Scancode
-        , _moEff1 :: Universe -> IO (Maybe Universe)
-        , _moKey2 :: Scancode
-        , _moEff2 :: Universe -> IO (Maybe Universe)
-        , _moString :: Universe -> Either String (String, String)
-        }
-    | InvisibleToggle
-        { _moKey :: Scancode
-        , _moEff :: Universe -> IO (Maybe Universe)
-        }
-
-data IntID a = IntID Int a
-
-type HitEffect' =
-    Flame ->
-    Stream (Of (Point2, Either Creature Wall)) Identity () ->
-    World ->
-    (World, Maybe Flame)
-
----- ROOM DATATYPES
-data PSType
-    = PutCrit {_unPutCrit :: Creature}
-    | PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
-    | PutLS LightSource
-    | PutButton {_putButton :: Button}
-    | PutProp Prop
-    | PutTerminal {_unputTerminal :: Terminal}
-    | PutFlIt {_putItem :: Item}
-    | PutPPlate PressPlate
-    | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2]}
-    | PutCoord Point2
-    | PutMod Modification
-    | PutTrigger Bool
-    | PutLineBlock
-        { _putWall :: Wall
-        , _putWidth :: Float
-        , _putStartPoint :: Point2
-        , _putEndPoint :: Point2
-        }
-    | PutWall {_pwPoly :: [Point2], _pwWall :: Wall}
-    | PutSlideDr Door Wall EdgeObstacle Float Point2 Point2
-    | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
-    | RandPS (State StdGen PSType)
-    | PutForeground ForegroundShape
-    | PutDecoration Picture
-    | PutWorldUpdate (PlacementSpot -> World -> World)
-    | PutNothing
-    | PutUsingGenParams (World -> (World, PSType))
-    | PutID {_putID :: Int}
-
--- maybe there is a monadic implementation of this?
--- add room effect for any placement spot?
-data PlacementSpot
-    = PS {_psPos :: Point2, _psRot :: Float}
-    | PSNoShiftCont {_psPos :: Point2, _psRot :: Float}
-    | PSPos
-        { _psSelect :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
-        , _psRoomEff :: RoomPos -> Room -> Room
-        , _psFallback :: Maybe Placement
-        }
-    | PSRoomRand
-        { _psRoomRandPointNum :: Int
-        , _psRandShift :: (Point2, Float) -> PlacementSpot
-        }
-
--- TODO attempt to unify/simplify this union type
-data Placement
-    = Placement
-        { _plOrder :: Int
-        , _plSpot :: PlacementSpot
-        , _plType :: PSType
-        , _plMID :: Maybe Int
-        , _plIDCont :: World -> Placement -> Maybe Placement
-        }
-    | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
-    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
-    | PickOnePlacement Int Placement
-
-{- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
-Link pairs contain a position and rotation to attach to another room;
-0 is for links going to another room to the north, pi/2 for links going to a room to the west, etc.
-TODO : Explain path, does it need both directions?
-Placement spots allow things to be put in the room during level generation.
-Room bounds between a new room and previously placed rooms are checked during level generation,
-assigning no bounds will allow rooms to overlap.  -}
-data Room = Room
-    { _rmPolys :: [[Point2]]
-    , _rmLinks :: [RoomLink]
-    , --  the Int is the number of previous outlinks that have been assigned
-      _rmLinkEff ::
-        RoomLink -> -- child link
-        Room -> -- child room
-        Int -> -- child number
-        RoomLink -> -- parent link
-        Room -> -- parent room
-        Room
-    , _rmPos :: [RoomPos]
-    , _rmPath :: S.Set (Point2, Point2)
-    , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [InPlacement]
-    , _rmOutPmnt :: [OutPlacement]
-    , _rmBound :: [[Point2]]
-    , _rmFloor :: Floor
-    , _rmName :: String
-    , _rmShift :: (Point2, Float)
-    , _rmViewpoints :: [Point2]
-    , _rmRandPSs :: [State StdGen (Point2, Float)]
-    , _rmStartWires :: IM.IntMap RoomWire
-    , _rmEndWires :: IM.IntMap RoomWire
-    , _rmConnectsTo :: S.Set RoomLinkType -> Bool
-    , _rmMID :: Maybe Int
-    , _rmMParent :: Maybe Int
-    , _rmChildren :: [Int]
-    , _rmType :: RoomType
-    , _rmClusterStatus :: ClusterStatus
-    }
-
-data OutPlacement = OutPlacement
-    { _opPlacement :: Placement
-    , _opPlacementID :: Int
-    }
-
-data InPlacement = InPlacement
-    { _ipPlacement :: [Placement] -> Placement
-    , _ipPlacementID :: Int
-    }
-
-makeLenses ''World
-
-makeLenses ''Universe
-makeLenses ''ScreenLayer
-makeLenses ''GenWorld
-
------ ROOM LENSES
-
-makeLenses ''Room
-makeLenses ''RoomType
-makeLenses ''PSType
-makeLenses ''PlacementSpot
-makeLenses ''Placement
-
-_itUseAimStance :: Item -> AimStance
-_itUseAimStance = _aimStance . _useAim . _itUse
-
-crSel :: Creature -> Int
-crSel = _iselPos . _crInvSel

src/Dodge/Data.hs.orig

@@ -1,5 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
+--{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Data 
     ( module Dodge.Data

src/Dodge/Data/ArcStep.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -6,8 +5,8 @@ module Dodge.Data.ArcStep where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.CrWlID
-import GHC.Generics
 import Geometry.Data
 
 data ArcStep = ArcStep
@@ -15,21 +14,13 @@ data ArcStep = ArcStep
     , _asDir :: Float
     , _asObject :: CrWlID --Maybe (Either Creature Wall)
     }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON ArcStep where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON ArcStep
 
 data NextArcStep
     = EndArc
     | DefaultArcStep
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON NextArcStep where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON NextArcStep
 
 makeLenses ''ArcStep
+deriveJSON defaultOptions ''ArcStep
+deriveJSON defaultOptions ''NextArcStep

src/Dodge/Data/Beam.hs

@@ -1,12 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Beam where
-import GHC.Generics
+
-import Data.Aeson
-import Geometry.Data
 import Color
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
 {- | Linear beams. Last only one frame.
  - Can interact with one another in a limited manner
  - can probably be moved to a separate file
@@ -24,33 +26,31 @@ data Beam = Beam
     , _bmOrigin :: Maybe Int
     , _bmType :: BeamType
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Beam  where
+
-    toEncoding = genericToEncoding defaultOptions
+data BeamDraw
-instance FromJSON Beam 
+    = BasicBeamDraw
-data BeamDraw = BasicBeamDraw
     | BeamDrawColor Color
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BeamDraw  where
+
-    toEncoding = genericToEncoding defaultOptions
+data BeamCombineType
-instance FromJSON BeamDraw 
+    = FlameBeamCombine
-data BeamCombineType = FlameBeamCombine
     | LasBeamCombine
     | TeslaBeamCombine
     | SplitBeamCombine
     | NoBeamCombine
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BeamCombineType  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BeamCombineType 
 data BeamType
     = BeamCombine
         { _beamCombine :: BeamCombineType -- (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World
         }
     | BeamSimple
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BeamType  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BeamType 
 makeLenses ''BeamType
 makeLenses ''Beam
+deriveJSON defaultOptions ''BeamType
+deriveJSON defaultOptions ''Beam
+deriveJSON defaultOptions ''BeamDraw
+deriveJSON defaultOptions ''BeamCombineType

src/Dodge/Data/Block.hs

@@ -1,16 +1,22 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Block where
+{-# LANGUAGE TemplateHaskell #-}
-import GHC.Generics
+
-import Data.Aeson
+module Dodge.Data.Block (
-import Shape.Data
+    module Dodge.Data.Block,
+    module Dodge.Data.Material,
+    module Dodge.Data.PathGraph,
+) where
+
 import Color
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import qualified Data.IntSet as IS
 import Dodge.Data.Material
 import Dodge.Data.PathGraph
 import Geometry
-import Control.Lens
+import Shape.Data
-import qualified Data.IntSet as IS
+
 data Block = Block
     { _blID :: Int
     , _blWallIDs :: IS.IntSet
@@ -24,22 +30,21 @@ data Block = Block
     , _blDraw :: BlockDraw --Block -> SPic
     , _blObstructs :: [(Int, Int, PathEdge)]
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Block  where
+
-    toEncoding = genericToEncoding defaultOptions
+data BlockDraw
-instance FromJSON Block 
+    = BlockDrawMempty
-data BlockDraw = BlockDrawMempty
     | BlockDrawBlSh BlSh
     | BlockDraws [BlockDraw]
     | BlockDrawColHeightPoss Color Float [Point2]
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BlockDraw  where
+
-    toEncoding = genericToEncoding defaultOptions
+data BlSh
-instance FromJSON BlockDraw 
+    = BlShMempty
-data BlSh = BlShMempty
     | BlShConst Shape
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BlSh  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BlSh 
 makeLenses ''Block
+deriveJSON defaultOptions ''Block
+deriveJSON defaultOptions ''BlockDraw
+deriveJSON defaultOptions ''BlSh

src/Dodge/Data/Bounds.hs

@@ -1,11 +1,11 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Bounds
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
+module Dodge.Data.Bounds where
+
 import Control.Lens
-import GHC.Generics
 import Data.Aeson
+import Data.Aeson.TH
 
 data Bounds = Bounds
     { _bdMinX :: Float
@@ -13,11 +13,10 @@ data Bounds = Bounds
     , _bdMinY :: Float
     , _bdMaxY :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Bounds  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Bounds 
 defaultBounds :: Bounds
 defaultBounds = Bounds 0 0 0 0
 
 makeLenses ''Bounds
+deriveJSON defaultOptions ''Bounds

src/Dodge/Data/Bullet.hs

@@ -1,8 +1,10 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Bullet where
+module Dodge.Data.Bullet 
+    ( module Dodge.Data.Bullet 
+    , module Dodge.Data.Damage
+    )where
 
 import Control.Lens
 import Data.Aeson

src/Dodge/Data/Button.hs

@@ -1,29 +1,31 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Button where
-import GHC.Generics
+
-import Data.Aeson
+import Color
-import Dodge.Data.WorldEffect
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.WorldEffect
 import Geometry.Data
 import Sound.Data
-import Color
+
-data ButtonDraw = DefaultDrawButton Color
+data ButtonDraw
+    = DefaultDrawButton Color
     | DefaultDrawSwitch Color Color
     | DrawNoButton
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ButtonDraw  where
+
-    toEncoding = genericToEncoding defaultOptions
+data ButtonEvent
-instance FromJSON ButtonDraw 
+    = ButtonDoNothing
-data ButtonEvent = ButtonDoNothing
     | ButtonPress
         { _bpState :: ButtonState
         , _bpEvent :: ButtonEvent
         , _bpSound :: SoundID
         , _bpEff :: WdWd
         }
---    | ButtonSwitch
+    | --    | ButtonSwitch
       --        {_bonState :: ButtonState
       --        ,_bonEvent :: ButtonEvent
       --        ,_bonSound :: SoundID
@@ -33,15 +35,13 @@ data ButtonEvent = ButtonDoNothing
       --        ,_boffSound :: SoundID
       --        ,_boffEff :: WorldEffect
       --        }
-    | ButtonSimpleSwith
+      ButtonSimpleSwith
         { _bonEff :: WdWd
         , _boffEff :: WdWd
         }
     | ButtonAccessTerminal
-  deriving (Eq,Show,Read,Generic)
+    deriving (Eq, Show, Read)
-instance ToJSON ButtonEvent  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ButtonEvent 
 data Button = Button
     { _btPict :: ButtonDraw --Button -> SPic
     , _btPos :: Point2
@@ -54,14 +54,14 @@ data Button = Button
     , _btName :: String
     , _btColor :: Color
     }
-  deriving (Eq,Show,Read,Generic)
+    deriving (Eq, Show, Read)
-instance ToJSON Button  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Button 
 data ButtonState = BtOn | BtOff | BtNoLabel
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ButtonState  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ButtonState 
 makeLenses ''Button
 makeLenses ''ButtonEvent
+deriveJSON defaultOptions ''ButtonDraw
+deriveJSON defaultOptions ''ButtonEvent
+deriveJSON defaultOptions ''Button
+deriveJSON defaultOptions ''ButtonState

src/Dodge/Data/CamouflageStatus.hs

@@ -1,11 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.CamouflageStatus where
-import GHC.Generics
+
 import Data.Aeson
+import Data.Aeson.TH
+
 data CamouflageStatus
     = FullyVisible
     | Invisible
-  deriving (Eq,Ord,Enum,Read,Show,Bounded,Generic)
+    deriving (Eq, Ord, Enum, Read, Show, Bounded)
-instance ToJSON CamouflageStatus where
+
-    toEncoding = genericToEncoding defaultOptions
+deriveJSON defaultOptions ''CamouflageStatus
-instance FromJSON CamouflageStatus

src/Dodge/Data/Cloud.hs

@@ -1,18 +1,19 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Cloud where
-import GHC.Generics
+
-import Data.Aeson
-import Geometry
 import Color
 import Control.Lens
-data CloudDraw = CloudColor Float Float Color -- radius-multiply fade-time color
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry
+
+data CloudDraw
+    = CloudColor Float Float Color -- radius-multiply fade-time color
     | DrawGasCloud Color
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CloudDraw  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CloudDraw 
 data Cloud = Cloud
     { _clPos :: Point3
     , _clVel :: Point3
@@ -22,15 +23,14 @@ data Cloud = Cloud
     , _clTimer :: Int
     , _clType :: CloudType
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Cloud  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Cloud 
 data CloudType
     = SmokeCloud
     | GasCloud
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CloudType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CloudType
 makeLenses ''Cloud
+deriveJSON defaultOptions ''CloudDraw
+deriveJSON defaultOptions ''Cloud
+deriveJSON defaultOptions ''CloudType

src/Dodge/Data/Config.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -6,8 +5,8 @@ module Dodge.Data.Config where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import qualified Data.Set as S
-import GHC.Generics
 
 {-# ANN module "HLint: ignore Use camelCase" #-}
 
@@ -27,7 +26,7 @@ data Configuration = Configuration
     , _debug_view_clip_bounds :: RoomClipping
     , _debug_booleans :: S.Set DebugBool -- consider using Data.BitSet
     }
-    deriving (Generic, Show)
+    deriving (Show)
 
 data DebugBool
     = Show_ms_frame
@@ -52,23 +51,13 @@ data DebugBool
     | Inspect_wall
     | Show_nodes_near_select
     | Show_path_between
-    deriving (Generic, Eq, Ord, Bounded, Enum, Show)
+    deriving (Eq, Ord, Bounded, Enum, Show)
 
 data ResFactor = FullRes | HalfRes | QuarterRes
-    deriving (Generic, Show, Eq, Ord, Enum, Bounded)
+    deriving (Show, Eq, Ord, Enum, Bounded)
-
-instance ToJSON ResFactor where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON ResFactor
 
 data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
-    deriving (Generic, Show, Eq, Ord, Enum, Bounded)
+    deriving (Show, Eq, Ord, Enum, Bounded)
-
-instance ToJSON RoomClipping where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON RoomClipping
 
 resFactorNum :: ResFactor -> Int
 resFactorNum rf = case rf of
@@ -76,18 +65,6 @@ resFactorNum rf = case rf of
     HalfRes -> 2
     QuarterRes -> 4
 
-makeLenses ''Configuration
-
-instance ToJSON DebugBool where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON DebugBool
-
-instance ToJSON Configuration where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Configuration
-
 defaultConfig :: Configuration
 defaultConfig =
     Configuration
@@ -105,18 +82,13 @@ defaultConfig =
         , _gameplay_rotate_to_wall = True
         , _debug_booleans = S.singleton Show_ms_frame
         , _debug_view_clip_bounds = NoRoomClipBoundaries
-        --    , _debug_show_sound           = False
-        --    , _debug_seconds_frame  = True
-        --    , _debug_noclip         = False
-        --    , _debug_mouse_position = False
-        --    , _debug_cr_status      = False
-        --    , _debug_cr_awareness   = False
-        --    , _debug_view_boundaries = False
-        --    , _debug_pathing    = False
-        --    , _debug_walls    = False
-        --    , _debug_remove_LOS      = False
-        --    , _debug_cull_more_lights     = False
         }
 
 debugOn :: DebugBool -> Configuration -> Bool
 debugOn db = S.member db . _debug_booleans
+
+makeLenses ''Configuration
+deriveJSON defaultOptions ''ResFactor
+deriveJSON defaultOptions ''RoomClipping
+deriveJSON defaultOptions ''DebugBool
+deriveJSON defaultOptions ''Configuration

src/Dodge/Data/Corpse.hs

@@ -1,18 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Corpse where
-import GHC.Generics
-import Data.Aeson
-import ShapePicture.Data
-import Geometry.Data
 
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+import ShapePicture.Data
+
 data CorpseResurrection = NoResurrection
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CorpseResurrection  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CorpseResurrection 
 data Corpse = Corpse
     { _cpID :: Int
     , _cpPos :: Point2
@@ -20,8 +19,8 @@ data Corpse = Corpse
     , _cpSPic :: SPic
     , _cpRes :: CorpseResurrection
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Corpse  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Corpse 
 makeLenses ''Corpse
+deriveJSON defaultOptions ''CorpseResurrection
+deriveJSON defaultOptions ''Corpse

src/Dodge/Data/CrGroupParams.hs

@@ -1,26 +1,25 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.CrGroupParams
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
-import GHC.Generics
+module Dodge.Data.CrGroupParams where
-import Data.Aeson
+
-import Geometry.Data
-import qualified Data.IntSet as IS
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import qualified Data.IntSet as IS
+import Geometry.Data
+
 data CrGroupParams = CrGroupParams
     { _crGroupParamID :: Int
     , _crGroupIDs :: IS.IntSet
     , _crGroupCenter :: Point2
     , _crGroupUpdate :: CrGroupUpdate --World -> CrGroupParams -> Maybe CrGroupParams
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CrGroupParams  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CrGroupParams 
 data CrGroupUpdate = DefaultCrGroupUpdate
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CrGroupUpdate  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CrGroupUpdate 
 makeLenses ''CrGroupParams
+deriveJSON defaultOptions ''CrGroupParams
+deriveJSON defaultOptions ''CrGroupUpdate

src/Dodge/Data/Creature.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -9,11 +8,15 @@ module Dodge.Data.Creature (
     module Dodge.Data.Creature.Perception,
     module Dodge.Data.Creature.Memory,
     module Dodge.Data.Creature.Stance,
-    module Dodge.Data.ActionPlan
+    module Dodge.Data.ActionPlan,
+    module Dodge.Data.Item,
+    module Dodge.Data.Material,
+    module Dodge.Data.Hammer,
 ) where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import qualified Data.Map.Strict as M
 import Dodge.Data.ActionPlan
 import Dodge.Data.Creature.Memory
@@ -24,7 +27,6 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Hammer
 import Dodge.Data.Item
 import Dodge.Data.Material
-import GHC.Generics
 import Geometry.Data
 import qualified IntMapHelp as IM
 
@@ -68,32 +70,23 @@ data Creature = Creature
     , _crStatistics :: CreatureStatistics
     , _crCamouflage :: CamouflageStatus
     }
-    deriving (Eq, Show, Read, Generic)
+    deriving (Eq, Show, Read)
-
-instance ToJSON Creature where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Creature
 
 data CreatureCorpse = MakeDefaultCorpse
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON CreatureCorpse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CreatureCorpse
 
 data Intention = Intention
     { _targetCr :: Maybe Creature
     , _mvToPoint :: Maybe Point2
     , _viewPoint :: Maybe Point2
     }
-    deriving (Eq, Show, Read, Generic)
+    deriving (Eq, Show, Read)
 
-instance ToJSON Intention where
+crSel :: Creature -> Int
-    toEncoding = genericToEncoding defaultOptions
+crSel = _iselPos . _crInvSel
-
-instance FromJSON Intention
 
 makeLenses ''Creature
 makeLenses ''Intention
+deriveJSON defaultOptions ''Creature
+deriveJSON defaultOptions ''CreatureCorpse
+deriveJSON defaultOptions ''Intention

src/Dodge/Data/Creature/Memory.hs

@@ -1,18 +1,18 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature.Memory
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
-import GHC.Generics
+module Dodge.Data.Creature.Memory where
-import Data.Aeson
+
-import Geometry.Data
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
 data Memory = Memory
     { _soundsToInvestigate :: [Point2]
     , _nodesSearched :: [Int]
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Memory  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Memory 
 makeLenses ''Memory
+deriveJSON defaultOptions ''Memory

src/Dodge/Data/Creature/Misc.hs

@@ -1,27 +1,27 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature.Misc
+{-# LANGUAGE TemplateHaskell #-}
-    ( module Dodge.Data.Creature.Misc
+
-    , module Dodge.Data.CamouflageStatus
+module Dodge.Data.Creature.Misc (
+    module Dodge.Data.Creature.Misc,
+    module Dodge.Data.CamouflageStatus,
 ) where
-import GHC.Generics
+
-import Data.Aeson
-import Dodge.Data.FloatFunction
-import Dodge.Data.CamouflageStatus
-import Sound.Data
-import Geometry.Data
 import Color
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.CamouflageStatus
+import Dodge.Data.FloatFunction
+import Geometry.Data
+import Sound.Data
+
 data CreatureStatistics = CreatureStatistics
     { _strength :: Int
     , _dexterity :: Int
     , _intelligence :: Int
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CreatureStatistics  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CreatureStatistics 
 data Vocalization
     = Mute
     | Vocalization
@@ -30,10 +30,8 @@ data Vocalization
         , _vcMaxCoolDown :: Int
         , _vcCoolDown :: Int
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Vocalization  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Vocalization 
 data CrMvType
     = NoMvType
     | MvWalking {_mvSpeed :: Float}
@@ -43,17 +41,24 @@ data CrMvType
         , _mvTurnJit :: Float
         , _mvAimSpeed :: FloatFloat
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CrMvType  where
+
-    toEncoding = genericToEncoding defaultOptions
+data HumanoidAI
-instance FromJSON CrMvType 
+    = YourAI
-data HumanoidAI = YourAI | ChaseAI | InanimateAI | SpreadGunAI | PistolAI
+    | ChaseAI
-    | LtAutoAI | LauncherAI | SwarmAI | AutoAI | FlockArmourChaseAI | MiniGunAI
+    | InanimateAI
-    | LongAI | MultGunAI
+    | SpreadGunAI
-  deriving (Eq,Ord,Show,Read,Generic)
+    | PistolAI
-instance ToJSON HumanoidAI  where
+    | LtAutoAI
-    toEncoding = genericToEncoding defaultOptions
+    | LauncherAI
-instance FromJSON HumanoidAI 
+    | SwarmAI
+    | AutoAI
+    | FlockArmourChaseAI
+    | MiniGunAI
+    | LongAI
+    | MultGunAI
+    deriving (Eq, Ord, Show, Read)
+
 data CreatureType
     = Humanoid
         { _skinHead :: Color
@@ -65,16 +70,18 @@ data CreatureType
     | Lampoid {_lampHeight :: Float, _lampColor :: Point3, _lampLSID :: Maybe Int}
     | Turretoid
     | NonDrawnCreature
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CreatureType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CreatureType
 data BarrelType = PlainBarrel | ExplosiveBarrel
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BarrelType  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BarrelType 
 makeLenses ''CreatureStatistics
 makeLenses ''Vocalization
 makeLenses ''CrMvType
 makeLenses ''CreatureType
+deriveJSON defaultOptions ''CreatureStatistics
+deriveJSON defaultOptions ''Vocalization
+deriveJSON defaultOptions ''CrMvType
+deriveJSON defaultOptions ''HumanoidAI
+deriveJSON defaultOptions ''CreatureType
+deriveJSON defaultOptions ''BarrelType

src/Dodge/Data/Creature/Perception.hs

@@ -1,31 +1,32 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature.Perception
+{-# LANGUAGE TemplateHaskell #-}
-    ( Perception (..)
+
-    , Vigilance (..)
+module Dodge.Data.Creature.Perception (
-    , Attention (..)
+    Perception (..),
-    , Awareness (..)
+    Vigilance (..),
-    , Vision (..)
+    Attention (..),
-    , Audition (..)
+    Awareness (..),
+    Vision (..),
+    Audition (..),
     -- lenses
-    , getAttentiveTo
+    getAttentiveTo,
-    , getFixated
+    getFixated,
-    , cpAttention
+    cpAttention,
-    , cpVigilance
+    cpVigilance,
-    , cpAwareness
+    cpAwareness,
-    , cpVision
+    cpVision,
-    , cpAudition
+    cpAudition,
-    , viFOV
+    viFOV,
-    , viDist
+    viDist,
-    , auDist
+    auDist,
-    )
+) where
-    where
+
-import GHC.Generics
-import Data.Aeson
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.FloatFunction
 import qualified IntMapHelp as IM
+
 data Perception = Perception
     { _cpVigilance :: Vigilance
     , _cpAttention :: Attention
@@ -33,50 +34,44 @@ data Perception = Perception
     , _cpVision :: Vision
     , _cpAudition :: Audition
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Perception  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Perception 
 data Vision = Eyes
     { _viFOV :: FloatFloat
     , _viDist :: FloatFloat
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Vision  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Vision 
 newtype Audition = Ears
     { _auDist :: FloatFloat
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Audition  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Audition 
 data Vigilance
     = Comatose
     | Asleep
     | Lethargic
     | Vigilant
     | Overstrung
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Vigilance where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Vigilance
 data Attention
     = AttentiveTo {_getAttentiveTo :: IM.IntMap Awareness}
     | Fixated {_getFixated :: Int}
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Attention where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Attention
 data Awareness
     = Suspicious Float
     | Cognizant Float
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Awareness where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Awareness
 makeLenses ''Perception
 makeLenses ''Vision
 makeLenses ''Audition
 makeLenses ''Attention
+deriveJSON defaultOptions ''Perception
+deriveJSON defaultOptions ''Vision
+deriveJSON defaultOptions ''Audition
+deriveJSON defaultOptions ''Vigilance
+deriveJSON defaultOptions ''Attention
+deriveJSON defaultOptions ''Awareness

src/Dodge/Data/Creature/Stance.hs

@@ -1,22 +1,20 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature.Stance
+{-# LANGUAGE TemplateHaskell #-}
-  where
+
-import GHC.Generics
+module Dodge.Data.Creature.Stance where
-import Data.Aeson
-import Geometry.Data
 
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
 data Stance = Stance
     { _carriage :: Carriage
     , _posture :: Posture
     , _strideLength :: Int
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Stance  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Stance 
 data Carriage
     = Walking
         { _strideAmount :: Int
@@ -26,25 +24,24 @@ data Carriage
     | Floating
     | Flying
     | Boosting Point2
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Carriage  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Carriage 
 data FootForward
     = LeftForward
     | RightForward
     | WasLeftForward
     | WasRightForward
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON FootForward where
+
-    toEncoding = genericToEncoding defaultOptions
+data Posture
-instance FromJSON FootForward
+    = Aiming
-data Posture = Aiming 
     | AtEase
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Posture  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Posture 
 makeLenses ''Stance
 makeLenses ''Carriage
 makeLenses ''Posture
+deriveJSON defaultOptions ''Stance
+deriveJSON defaultOptions ''Carriage
+deriveJSON defaultOptions ''FootForward
+deriveJSON defaultOptions ''Posture

src/Dodge/Data/Creature/State.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -7,9 +6,9 @@ module Dodge.Data.Creature.State where
 import Color
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import qualified Data.IntSet as IS
 import Dodge.Data.Damage
-import GHC.Generics
 import Geometry.Data
 
 data CreatureState = CrSt
@@ -17,33 +16,18 @@ data CreatureState = CrSt
     , _csSpState :: CrSpState
     , _csDropsOnDeath :: CreatureDropType
     }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON CreatureState where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CreatureState
 
 data CreatureDropType
     = DropAll
     | DropAmount Int
     | DropSpecific [Int]
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON CreatureDropType where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CreatureDropType
 
 data CrSpState
     = Barrel {_piercedPoints :: [Point2]}
     | GenCr
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON CrSpState where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CrSpState
 
 data Faction
     = GenericFaction Int
@@ -54,12 +38,7 @@ data Faction
     | NoFaction
     | ColorFaction Color
     | PlayerFaction
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Faction where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Faction
 
 data CrGroup
     = LoneWolf
@@ -69,13 +48,13 @@ data CrGroup
         }
     | CrGroupID {_crGroupID :: Int}
     | ShieldGroup
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON CrGroup where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CrGroup
 
 makeLenses ''CreatureState
 makeLenses ''CrSpState
 makeLenses ''CrGroup
+deriveJSON defaultOptions ''CreatureState
+deriveJSON defaultOptions ''CreatureDropType
+deriveJSON defaultOptions ''CrSpState
+deriveJSON defaultOptions ''Faction
+deriveJSON defaultOptions ''CrGroup

src/Dodge/Data/Damage.hs

@@ -1,19 +1,21 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 {-
 Datatypes describing the type of damage effects that are to be applied to
 creatures.
 -}
-module Dodge.Data.Damage 
+module Dodge.Data.Damage (
-    ( module Dodge.Data.Damage
+    module Dodge.Data.Damage,
-    , module Dodge.Data.Damage.Type
+    module Dodge.Data.Damage.Type,
 ) where
-import GHC.Generics
+
+import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.Damage.Type
 import Geometry.Data
-import Control.Lens
+
 data DamageEffect
     = PushDamage
         { _dePush :: Float
@@ -23,27 +25,30 @@ data DamageEffect
     | TorqueDamage {_deTorque :: Float}
     | PushBackDamage {_dePushBack :: Float}
     | NoDamageEffect
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON DamageEffect where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON DamageEffect
 data Damage = Damage
     { _dmType :: DamageType
-    , _dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 
+    , _dmAmount :: Int
+    , _dmFrom :: Point2
+    , _dmAt :: Point2
+    , _dmTo :: Point2
     , _dmEffect :: DamageEffect
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Damage  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Damage 
 isElectrical :: Damage -> Bool
 isElectrical dm = case _dmType dm of
     ELECTRICAL -> True
     _ -> False
+
 isMovementDam :: Damage -> Bool
 isMovementDam dm = case _dmType dm of
     TORQUEDAM -> True
     PUSHDAM -> True
     _ -> False
+
 makeLenses ''Damage
 makeLenses ''DamageEffect
+deriveJSON defaultOptions ''DamageEffect
+deriveJSON defaultOptions ''Damage

src/Dodge/Data/Damage/Type.hs

@@ -1,8 +1,11 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Damage.Type where
-import GHC.Generics
+
 import Data.Aeson
+import Data.Aeson.TH
+
 data DamageType
     = PIERCING
     | BLUNT
@@ -19,9 +22,10 @@ data DamageType
     | PUSHDAM
     | POISONDAM
     | ENTERREMENT
-  deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic)
+    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-instance ToJSON DamageType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON DamageType 
 instance ToJSONKey DamageType
+
 instance FromJSONKey DamageType
+
+deriveJSON defaultOptions ''DamageType

src/Dodge/Data/Distortion.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
 module Dodge.Data.Distortion where

src/Dodge/Data/Door.hs

@@ -1,27 +1,31 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Door where
+{-# LANGUAGE TemplateHaskell #-}
-import GHC.Generics
+
-import Data.Aeson
+module Dodge.Data.Door (
-import Dodge.Data.PathGraph
+    module Dodge.Data.Door,
-import Dodge.Data.MountedObject
+    module Dodge.Data.MountedObject,
-import Geometry.Data
+    module Dodge.Data.PathGraph,
-import Dodge.Data.WorldEffect
+    module Dodge.Data.WorldEffect,
-import qualified Data.IntSet as IS
+) where
+
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import qualified Data.IntSet as IS
+import Dodge.Data.MountedObject
+import Dodge.Data.PathGraph
+import Dodge.Data.WorldEffect
+import Geometry.Data
+
 data DoorStatus = DoorOpen | DoorClosed | DoorHalfway | DoorInt Int
-  deriving (Eq, Ord, Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON DoorStatus  where
+
-    toEncoding = genericToEncoding defaultOptions
+data PushSource
-instance FromJSON DoorStatus 
+    = PushesItself
-data PushSource = PushesItself
     | PushedBy Int
     | NotPushed
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON PushSource  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON PushSource 
 data Door = Door
     { _drID :: Int
     , _drWallIDs :: IS.IntSet
@@ -40,8 +44,9 @@ data Door = Door
     , _drObstructs :: [(Int, Int, PathEdge)]
     , _drObstacleType :: EdgeObstacle
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Door  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Door 
 makeLenses ''Door
+deriveJSON defaultOptions ''DoorStatus
+deriveJSON defaultOptions ''PushSource
+deriveJSON defaultOptions ''Door

src/Dodge/Data/EnergyBall.hs

@@ -1,13 +1,15 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.EnergyBall where
-import GHC.Generics
+
-import Data.Aeson
-import Geometry.Data
 import Color
-import Dodge.Data.Damage.Type
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.Damage.Type
+import Geometry.Data
+
 data EnergyBall = EnergyBall
     { _ebVel :: Point2
     , _ebColor :: Color
@@ -18,8 +20,7 @@ data EnergyBall = EnergyBall
     , _ebZ :: Float
     , _ebRot :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON EnergyBall  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EnergyBall 
 makeLenses ''EnergyBall
+deriveJSON defaultOptions ''EnergyBall

src/Dodge/Data/Equipment/Misc.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
-module Dodge.Data.Equipment.Misc
+
-    where
+module Dodge.Data.Equipment.Misc where
-import GHC.Generics
+
 import Data.Aeson
+import Data.Aeson.TH
+
 data EquipSite
     = GoesOnHead
     | GoesOnChest
@@ -11,10 +13,8 @@ data EquipSite
     | GoesOnWrist
     | GoesOnLegs
     | GoesOnSpecial
-    deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON EquipSite where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EquipSite
 data EquipPosition
     = OnHead
     | OnChest
@@ -23,9 +23,11 @@ data EquipPosition
     | OnRightWrist
     | OnLegs
     | OnSpecial
-    deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON EquipPosition where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EquipPosition
 instance ToJSONKey EquipPosition
+
 instance FromJSONKey EquipPosition
+
+deriveJSON defaultOptions ''EquipSite
+deriveJSON defaultOptions ''EquipPosition

src/Dodge/Data/Flame.hs

@@ -1,12 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Flame where
-import GHC.Generics
+
-import Data.Aeson
-import Control.Lens
-import Geometry.Data
 import Color
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
 data Flame = Flame
     { _flVel :: Point2
     , _flColor :: Color
@@ -16,8 +18,7 @@ data Flame = Flame
     , _flZ :: Float
     , _flOriginalVel :: Point2
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Flame  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Flame 
 makeLenses ''Flame
+deriveJSON defaultOptions ''Flame

src/Dodge/Data/Flare.hs

@@ -1,12 +1,14 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Flare where
-import GHC.Generics
+
-import Data.Aeson
 import Color
-import Geometry
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry
+
 data Flare
     = MuzFlare
         { _flarePoly :: [Point2]
@@ -20,8 +22,7 @@ data Flare
         , _flareTran3 :: Point3
         , _flareTime :: Int
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Flare where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Flare
 makeLenses ''Flare
+deriveJSON defaultOptions ''Flare

src/Dodge/Data/FloatFunction.hs

@@ -1,13 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.FloatFunction where
-import GHC.Generics
+
 import Data.Aeson
-data FloatFloat = FloatID
+import Data.Aeson.TH
+
+data FloatFloat
+    = FloatID
     | FloatFOV Float
     | FloatLessCheck Float
     | FloatAbsCheckGreaterLess Float Float Float
     | FloatConst Float
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON FloatFloat  where
+
-    toEncoding = genericToEncoding defaultOptions
+deriveJSON defaultOptions ''FloatFloat
-instance FromJSON FloatFloat