Cleanup

src/Dodge/Base/WinScale.hs

@@ -1,5 +1,6 @@
 module Dodge.Base.WinScale where
-import Dodge.Config.Data
+
+import Dodge.Data.Config
 import Geometry
 import Picture
 
@@ -8,4 +9,4 @@ winScale :: Configuration -> Picture -> Picture
 winScale cfig = scale (2 / _windowX cfig) (2 / _windowY cfig)
 
 doWindowScale :: Configuration -> Point2 -> Point2
-doWindowScale cfig (V2 x y) = V2 ( x * 2 / _windowX cfig) ( y * 2 / _windowY cfig)
+doWindowScale cfig (V2 x y) = V2 (x * 2 / _windowX cfig) (y * 2 / _windowY cfig)

src/Dodge/Beam.hs

@@ -40,7 +40,7 @@ splitBeamCombine (p,(a,b,_),(x,y,_))
 teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
     -> World -> World
 teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
-    = w' & pointToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
+    = w' & pointerToItem (_itemPositions (_cWorld w) IM.! itid) . itParams . subParams ?~ ip
   where
     itid = fromJust $ _bmOrigin bm
     dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))

src/Dodge/Bullet.hs

@@ -1,40 +1,70 @@
-module Dodge.Bullet 
+module Dodge.Bullet (
-    ( updateBullet
+    updateBullet,
-    , useAmmoParams
+    useAmmoParams,
-    ) where
+) where
-import Dodge.MagnetBuBu
+
-import qualified ListHelp as List
+import Data.Maybe
-import Dodge.EnergyBall
+import Dodge.Base.Coordinate
+import Dodge.Creature.HandPos
 import Dodge.Creature.Test
 import Dodge.Data
-import Dodge.Creature.HandPos
+import Dodge.EnergyBall
-import Dodge.Base.Coordinate
+import Dodge.MagnetBuBu
+import Dodge.Movement.Turn
 import Dodge.WorldEvent.SpawnParticle
+import Dodge.WorldEvent.ThingsHit
 import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
+import qualified ListHelp as List
 import StreamingHelp
 
-import qualified IntMapHelp as IM
+updateBullet :: World -> Bullet -> (World, Maybe Bullet)
-import Data.Maybe
+updateBullet w bu = case _buDelayFraction bu of
-import Dodge.Movement.Turn
+    1 -> mvBullet 1 w bu
-import Dodge.WorldEvent.ThingsHit
+    x -> mvBullet x w (bu & buDelayFraction .~ 1)
 
-updateBullet :: World -> Bullet -> (World,Maybe Bullet)
+mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
-updateBullet w bu = case _buState bu of
+mvBullet x w bu
-    DelayedBullet x -> mvBullet x w bu
+    | _buTimer bu <= 0 || magV (_buVel bu) < 1 = (endspawn w, Nothing)
-    _ -> mvBullet 1 w bu
+    | otherwise =
+        second (fmap updateBulVel)
+            . hitEffFromBul x w
+            $ applyMagnetsToBul bu w
+  where
+    endspawn = fromMaybe id $ do
+        partspawn <- bulletSpawn bu
+        return $ partspawn p
+    p = _buPos bu
+
+applyMagnetsToBul :: Bullet -> World -> Bullet
+applyMagnetsToBul bu =
+    foldr (\mg -> doMagnetBuBu (_mgField mg) mg) bu . _magnets . _cWorld
+
+updateBulVel :: Bullet -> Bullet
+updateBulVel bt = case _buTrajectory bt of
+    BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
+    MagnetTrajectory tpos -> bt & buVel %~ (clipV 20 . (+.+ 5 *.* normalizeV (tpos -.- _buPos bt)))
+    FlechetteTrajectory tpos -> bt & buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
+    BezierTrajectory spos tpos xpos ->
+        let bf tm = bQuadToF (spos, xpos, tpos) $ (100 - tm) * 0.05
+         in bt & buVel .~ bf (fromIntegral $ t - 1) -.- bf (fromIntegral t)
+  where
+    t = _buTimer bt
 
 useAmmoParams :: Item -> Creature -> World -> World
-useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
+useAmmoParams it cr w =
-    & buPos .~ sp 
+    w & cWorld . instantBullets
-    & buTrajectory %~ settrajectory
+        .:~ ( _amBullet bultype
-    & buVel %~ (rotateV dir . (muzvel *.*))
+                & buPos .~ sp
-    & buDrag *~ _rifling (_itParams it)
+                & buTrajectory %~ settrajectory
-    )
+                & buVel %~ (rotateV dir . (muzvel *.*))
+                & buDrag *~ _rifling (_itParams it)
+            )
   where
     sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
     dir = _crDir cr
-    bultype = _laAmmoType $ _itConsumption it
+    bultype = _laAmmoType $ _heldConsumption $ _itUse it
     muzvel = _muzVel $ _itParams it
     muzlength = aimingMuzzlePos cr it
     settrajectory traj = case traj of
@@ -49,35 +79,9 @@ useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
             tpos <- it ^? itTargeting . tgPos . _Just
             return $ BezierTrajectory sp tpos (mouseWorldPos w)
 
-{- Update for a generic bullet.  -}
-mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
-mvBullet x w bt' 
-    | t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
-    | otherwise = second (fmap dodrag) $ 
-        hiteff bt hitstream w
-  where
-    endspawn w' = fromMaybe w' $ do
-        partspawn <- bulletSpawn bt'
-        return $ partspawn p w'
-    hitstream = thingsHit p (p +.+ vel) w
-    bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w))
-        & buState .~ NormalBulletState
-    dodrag = case _buTrajectory bt of
-        BasicBulletTrajectory -> buVel .*.*~ drag
-        MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt)
-        FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
-        BezierTrajectory spos tpos xpos -> 
-            let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05
-            in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt)
-    drag = _buDrag bt
-    p       = _buPos bt
-    vel     = _buVel bt
-    hiteff  = hitEffFromBul x
-    t       = _buTimer bt
-
 bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
-bounceDir (_,Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
+bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
-bounceDir (p,Left  cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
+bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
 bounceDir _ = Nothing
 
 bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
@@ -87,66 +91,84 @@ bulletSpawn bu = case _buSpawn bu of
     BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
     BulBall TeslaBall -> Just makeStaticBall
 
-hitEffFromBul :: Float -> Bullet
+hitEffFromBul ::
-    -> [(Point2, Either Creature Wall)]
+    Float ->
-    -> World 
+    World ->
-    -> (World,Maybe Bullet)
+    Bullet ->
-hitEffFromBul x bu hitstream w = case _buEffect bu of
+    (World, Maybe Bullet)
+hitEffFromBul x w bu = case _buEffect bu of
     PenetrateBullet -> movePenBullet x bu hitstream w
-    BounceBullet  -> case List.safeHead hitstream of
+    BounceBullet -> case List.safeHead hitstream of
         Nothing -> (w, moveBullet x bu)
-        Just (hp,crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
+        Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
-            dir <- bounceDir (hp,crwl)
+            dir <- bounceDir (hp, crwl)
-            return (w,Just $ bu
+            return
-                & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
+                ( w
-                & buVel %~ reflectIn dir
+                , Just $
-                & buTrajectory .~ BasicBulletTrajectory
+                    bu
-                & buTimer -~ 1
+                        & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
+                        & buVel %~ reflectIn dir
+                        & buTrajectory .~ BasicBulletTrajectory
+                        & buTimer -~ 1
                 )
     DestroyBullet -> expireAndDamage x bu hitstream w
+  where
+    ep = sp +.+ x *.* _buVel bu
+    sp = _buPos bu
+    hitstream = thingsHit sp ep w
 
 setFromToDams :: Bullet -> Point2 -> [Damage]
 setFromToDams bu p = map f (_buDamages bu)
   where
     f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
 
-damageThingHit :: Bullet -> (Point2,Either Creature Wall) -> World -> World
+damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
-damageThingHit bu (p,crwl) = case crwl of
+damageThingHit bu (p, crwl) = case crwl of
     Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
     Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
   where
     dams = setFromToDams bu p
 
-expireAndDamage :: Float
+expireAndDamage ::
-    -> Bullet
+    Float ->
-    -> [(Point2, Either Creature Wall)]
+    Bullet ->
-    -> World
+    [(Point2, Either Creature Wall)] ->
-    -> (World, Maybe Bullet)
+    World ->
+    (World, Maybe Bullet)
 expireAndDamage y bt things w = case List.safeHead things of
     Nothing -> (w, moveBullet y bt)
     Just x -> (damageThingHit bt x w, destroyAt (fst x) bt)
 
 moveBullet :: Float -> Bullet -> Maybe Bullet
-moveBullet x pt = Just $ pt
+moveBullet x pt =
-    & buPos %~ (+.+ x *.* _buVel pt)
+    Just $
-    & buOldPos .~ _buPos pt
+        pt
-    & buTimer -~ 1
+            & buPos %~ (+.+ x *.* _buVel pt)
+            & buOldPos .~ _buPos pt
+            & buTimer -~ 1
 
 destroyAt :: Point2 -> Bullet -> Maybe Bullet
-destroyAt hitp pt = Just $ pt 
+destroyAt hitp pt =
-    & buPos     .~ hitp +.+ normalizeV (p -.- hitp)
+    Just $
-    & buOldPos  .~ p
+        pt
-    & buVel     .~ 0
+            & buPos .~ hitp +.+ normalizeV (p -.- hitp)
+            & buOldPos .~ p
+            & buVel .~ 0
   where
     p = _buPos pt
 
-movePenBullet :: Float -> Bullet -> [(Point2, Either Creature Wall)]
+movePenBullet ::
-    -> World -> (World, Maybe Bullet)
+    Float ->
+    Bullet ->
+    [(Point2, Either Creature Wall)] ->
+    World ->
+    (World, Maybe Bullet)
 movePenBullet x bu hitstream w = case hitstream of
-    [] -> (w,moveBullet x bu)
+    [] -> (w, moveBullet x bu)
-    ((p,crwl):strm) -> if penThing crwl
+    ((p, crwl) : strm) ->
-        then first (damageThingHit bu (p,crwl)) $ movePenBullet x bu strm w
+        if penThing crwl
-        else expireAndDamage x bu hitstream w
+            then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w
+            else expireAndDamage x bu hitstream w
 
 penThing :: Either Creature Wall -> Bool
 penThing (Left _) = True

src/Dodge/Combine.hs

@@ -29,23 +29,23 @@ import qualified Data.Map.Strict as M
 import Data.Maybe
 import Data.List (scanl',sortOn)
 
-invertInventory :: IM.IntMap Item -> [(ItemBaseType,IcAmount,Int)]
+invertInventory :: IM.IntMap Item -> [(ItemBaseType,ItAmount,Int)]
 invertInventory = IM.foldrWithKey
     (\k it -> ((_iyBase $ _itType it, itStackAmount it,k) :) )
     []
 
-splitIcAmounts :: [(ItemBaseType,IcAmount,Int)] -> [((IcAmount,ItemBaseType),(IcAmount,Int))]
+splitItAmounts :: [(ItemBaseType,ItAmount,Int)] -> [((ItAmount,ItemBaseType),(ItAmount,Int))]
-splitIcAmounts = concatMap f
+splitItAmounts = concatMap f
   where
     f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
 
-lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
+lookupItems :: IM.IntMap Item -> [([(ItAmount,Int)],Item)]
-lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
+lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitItAmounts . invertInventory
 
 combineItemListYouX :: World -> [([Int],Item)]
 combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
   where
-    g (amount,i) = replicate (_toInt amount) i
+    g (amount,i) = replicate (_getItAmount amount) i
 
 combineListInfo :: World -> [([Int],([String],Item))]
 combineListInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w

src/Dodge/Combine/Combinations.hs

@@ -14,7 +14,7 @@ import LensHelp
 
 --import Data.Maybe
 
-itemCombinations :: [([(IcAmount,ItemBaseType)],Item)]
+itemCombinations :: [([(ItAmount,ItemBaseType)],Item)]
 itemCombinations =
     [ po [CRAFT PIPE, CRAFT HARDWARE]      (bangStick 1)
     , po [HELD (BANGSTICK 1), CRAFT TIN]         pistol

src/Dodge/Combine/Graph.hs

@@ -19,7 +19,7 @@ data CombClust
     | JoinClust
   deriving (Eq,Ord,Show,Enum,Bounded)
 
-newtype CombNode = CombNode {_unCombNode :: Either ItemBaseType [(IcAmount,ItemBaseType)]}
+newtype CombNode = CombNode {_unCombNode :: Either ItemBaseType [(ItAmount,ItemBaseType)]}
   deriving (Eq,Ord,Show)
 
 instance Labellable CombNode where
@@ -32,7 +32,7 @@ instance Labellable CombEdge where
     toLabelValue (CombEdge 0) = StrLabel (pack "")
     toLabelValue (CombEdge x) = StrLabel (pack $ show x)
 
-bulletCombinations :: [([(IcAmount,ItemBaseType)],Item)]
+bulletCombinations :: [([(ItAmount,ItemBaseType)],Item)]
 bulletCombinations = filter 
     ( (`elem` map totype bulletWeapons)
     . totype
@@ -63,7 +63,7 @@ itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) itemCombinat
         | otherwise =  (CombNode $ Right abts,CombNode $  Left bt,0) :  map g abts
       where
         bts = map snd abts
-        g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_toInt am)
+        g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_getItAmount am)
 
 combinationsGraph :: FGL.Gr CombNode CombEdge
 combinationsGraph = FGL.labnfilter (f . _unCombNode . snd) 

src/Dodge/Combine/Module.hs

@@ -8,28 +8,28 @@ import Geometry
 moduleModification :: ItemModuleType -> Item -> Item
 moduleModification imt = case imt of
     EMPTYMODULE -> id
-    DRUMMAG     -> itConsumption . laMax .~ 45
+    DRUMMAG     -> itUse . heldConsumption . laMax .~ 45
-    BELTMAG     -> itConsumption . laMax .~ 150
+    BELTMAG     -> itUse . heldConsumption . laMax .~ 150
     MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
-    INCENDBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
+    INCENDBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
-    BOUNCEBUL   -> itConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet 
+    BOUNCEBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet 
-    PENBUL    -> itConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet 
+    PENBUL      -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet 
-    STATICBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
+    STATICBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
-    CONCUSBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
+    CONCUSBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
-    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
+    MAGNETTRAJ  -> (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
-        . (itConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
+        . (itUse . heldConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
-    FLECHETRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
+    FLECHETRAJ  -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
-    BEZIERTRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 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)
         . (itParams . subParams ?~ teslaParams)
     WEPTELE     -> makeDirectedTele
-    LAUNCHHOME  -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
+    LAUNCHHOME  -> itUse . heldConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
-    EXTRABATTERY -> itConsumption . laMax +~ 1000
+    EXTRABATTERY -> itUse . heldConsumption . laMax +~ 1000
     ATTACHTORCH  -> id
   where
     makeDirectedTele it = it 

src/Dodge/Combine/Trie.hs

@@ -11,7 +11,7 @@ import Data.Bifunctor
 --import Data.Map.Merge.Strict
 import Data.List (sort)
 
-combinationsTrie :: Trie (IcAmount,ItemBaseType) Item
+combinationsTrie :: Trie (ItAmount,ItemBaseType) Item
 {-# INLINE combinationsTrie #-}
 combinationsTrie = foldr 
     (uncurry insertInTrie . first sort) 

src/Dodge/Config/Data.hs

@@ -1,112 +0,0 @@
---{-# LANGUAGE FlexibleInstances #-}
---{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Config.Data where
-import Data.Aeson
-import qualified Data.Set as S
-import GHC.Generics
-import Control.Lens
---import Data.Enum.Set.Base
-{-# ANN module "HLint: ignore Use camelCase" #-}
-data Configuration = Configuration
-    { _volume_master        :: Float
-    , _volume_sound         :: Float
-    , _volume_music         :: Float
-    , _graphics_wall_textured        :: Bool
-    , _graphics_cloud_shadows        :: Bool
-    , _graphics_object_shadows       :: Bool
-    , _graphics_resolution_factor    :: ResFactor
-    , _windowX              :: Float
-    , _windowY              :: Float
-    , _windowPosX           :: Int
-    , _windowPosY           :: Int
-    , _gameplay_rotate_to_wall :: Bool
-    , _debug_view_clip_bounds :: RoomClipping
-    , _debug_booleans       :: S.Set DebugBool  -- consider using Data.BitSet
-    }
-  deriving (Generic, Show)
-data DebugBool
-    = Show_ms_frame
-    | Show_debug
-    | Show_sound
-    | Noclip
-    | Cr_status
-    | Cr_awareness
-    | Mouse_position
-    | View_boundaries
-    | Walls_info
-    | Pathing        
-    | Remove_LOS    
-    | Cull_more_lights
-    | Close_shape_culling
-    | Show_bound_box
-    | Bound_box_screen
-    | Show_wall_search_rays
-    | Show_dda_test
-    | Show_far_wall_detect
-    | Show_select
-    | Inspect_wall
-    | Show_nodes_near_select
-    | Show_path_between
-  deriving (Generic, Eq,Ord,Bounded, Enum, Show)
-data ResFactor = FullRes | HalfRes | QuarterRes
-  deriving (Generic, 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)
-instance ToJSON RoomClipping where
-  toEncoding = genericToEncoding defaultOptions
-instance FromJSON RoomClipping
-resFactorNum :: ResFactor -> Int
-resFactorNum rf = case rf of
-    FullRes     -> 1
-    HalfRes     -> 2
-    QuarterRes  -> 4
-
-makeLenses ''Configuration
-instance ToJSON DebugBool where
-  toEncoding = genericToEncoding defaultOptions
-
-instance ToJSON Configuration where
-  toEncoding = genericToEncoding defaultOptions
-
---deriving instance Generic a => Generic (EnumSet Word a)
---instance FromJSON (EnumSet Word a)
-
-instance FromJSON DebugBool
-instance FromJSON Configuration
-
-defaultConfig  :: Configuration
-defaultConfig = Configuration
-    { _volume_master        = 1
-    , _volume_sound         = 1
-    , _volume_music         = 1
-    , _graphics_wall_textured        = True
-    , _graphics_cloud_shadows        = True
-    , _graphics_object_shadows       = True
-    , _graphics_resolution_factor    = FullRes
-    , _windowX              = 800
-    , _windowY              = 600
-    , _windowPosX           = 0
-    , _windowPosY           = 0
-    , _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

src/Dodge/Config/Load.hs

@@ -1,22 +1,22 @@
-module Dodge.Config.Load
+module Dodge.Config.Load (
-    ( loadDodgeConfig
+    loadDodgeConfig,
-    ) where
+) where
-import Dodge.Config.Data
 
 import Data.Aeson
+import Dodge.Data.Config
 import System.Directory
 
 loadDodgeConfig :: IO Configuration
 loadDodgeConfig = do
     fExists <- doesFileExist "data/dodge.config.json"
     if fExists
-    then do
+        then do
-        mayConfig <- decodeFileStrict "data/dodge.config.json"
+            mayConfig <- decodeFileStrict "data/dodge.config.json"
-        case mayConfig of
+            case mayConfig of
-          Just config -> return config
+                Just config -> return config
-          Nothing -> do
+                Nothing -> do
-            putStrLn "invalid data/dodge.config.json, loading defaults"
+                    putStrLn "invalid data/dodge.config.json, loading defaults"
+                    return defaultConfig
+        else do
+            putStrLn "No data/data/dodge.config.json found, loading defaults"
             return defaultConfig
-    else do
-        putStrLn "No data/data/dodge.config.json found, loading defaults"
-        return defaultConfig

src/Dodge/Config/Update.hs

@@ -1,49 +1,51 @@
-{-|
+{- |
 IO actions that apply config side effects and save configuration settings to disk.
 -}
-module Dodge.Config.Update
+module Dodge.Config.Update (
-    ( saveConfig
+    saveConfig,
-    , setVolThen
+    setVolThen,
-    , applyWorldConfig
+    applyWorldConfig,
-    , setVol
+    setVol,
-    ) where
+) where
---import Dodge.Data.SoundOrigin
-import Dodge.Config.Data
-import Sound
-import Data.Preload
-import Preload.Update
 
 import qualified Data.Aeson.Encode.Pretty as AEP
 import qualified Data.ByteString.Lazy as BS
---import Control.Monad (when)
+import Data.Preload
+import Dodge.Data.Config
+import Preload.Update
+import Sound
+
 {- |
 Write the current world configuration to disk as a json file.
- -}
+-}
 saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
 saveConfig cfig f x = do
     putStrLn "Saving config to data/dodge.config.json"
-    BS.writeFile "data/dodge.config.json" 
+    BS.writeFile "data/dodge.config.json" $
-        $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
+        AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
     f x
+
 {- |
 Apply the volume settings from the world configuration to the running game.
- -}
+-}
 setVol :: Configuration -> IO ()
 setVol cfig = do
-    setSoundVolume ( _volume_master cfig * _volume_sound cfig)
+    setSoundVolume (_volume_master cfig * _volume_sound cfig)
-    setMusicVolume ( _volume_master cfig * _volume_music cfig)
+    setMusicVolume (_volume_master cfig * _volume_music cfig)
+
 -- what?
 setVolThen :: Configuration -> (a -> IO a) -> a -> IO a
 setVolThen cfig f a = do
     setVol cfig
     f a
+
 {- |
 Apply /all/ of the values in the world configuration to the running game.
- -}
+-}
-applyWorldConfig
+applyWorldConfig ::
-    :: Configuration 
+    Configuration ->
-    -> PreloadData
+    PreloadData ->
-    -> IO PreloadData
+    IO PreloadData
 applyWorldConfig cfig pdata = do
     setVol cfig
     pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y pdata

src/Dodge/Creature/Impulse/UseItem.hs

@@ -1,97 +1,101 @@
-module Dodge.Creature.Impulse.UseItem
+module Dodge.Creature.Impulse.UseItem (
-    ( useItem
+    useItem,
-    , useLeftItem
+    useLeftItem,
-    , itemEffect
+    itemEffect,
-    ) where
+) where
-import Dodge.Data
-import Dodge.Luse
-import Dodge.Cuse
-import Dodge.Euse
-import Dodge.Inventory
-import Dodge.Reloading
-import Dodge.Item.Location
-import Dodge.HeldUse
 
-import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
-import qualified SDL
 --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.Euse
+import Dodge.HeldUse
+import Dodge.Inventory
+import Dodge.Item.Location
+import Dodge.Luse
+import Dodge.Reloading
+import qualified IntMapHelp as IM
+import qualified SDL
 
 useItem :: Creature -> World -> World
 useItem cr' w = fromMaybe (f w) $ do
-    cr <-  w ^? cWorld . creatures . ix (_crID cr')
+    cr <- w ^? cWorld . creatures . ix (_crID cr')
     it <- cr ^? crInv . ix (crSel cr)
     return $ itemEffect cr it w
   where
     f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
 
 itemEffect :: Creature -> Item -> World -> World
-itemEffect cr it w = case it ^? itUse of
+itemEffect cr it w = case it ^. itUse of
-    Just RightUse {_rUse = eff,_useMods = usemods} 
+    RightUse{_rUse = eff, _useMods = usemods} ->
-                    -> hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
+        hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
-    Just LeftUse {} -> doequipmentchange
+    LeftUse{} -> doequipmentchange
-    Just EquipUse{} -> doequipmentchange
+    EquipUse{} -> doequipmentchange
     -- ConsumeUse will cause problems if the item is not selected
-    Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
+    (ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
-    Just NoUse  -> setuhamdown w
+    CraftUse{} -> setuhamdown w
-    Nothing     -> setuhamdown w
   where
     hammerTest f = case _crHammerPosition cr of
         HammerUp -> f w
         _ -> w & setuhamdown
     setuhamdown = cWorld . creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
-    doequipmentchange = setuhamdown $ hammerTest (toggleEquipmentAt (_rbOptions w) (crSel cr) cr
+    doequipmentchange =
-        . activateEquipmentAt (_rbOptions w) cr)
+        setuhamdown $
+            hammerTest
+                ( toggleEquipmentAt (_rbOptions w) (crSel cr) cr
+                    . activateEquipmentAt (_rbOptions w) cr
+                )
 
 tryReload :: Creature -> Item -> World -> (World -> World) -> World -> World
 tryReload cr it w f
-    | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False
+    | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
-        = crToggleReloading cr
+        crToggleReloading cr
-    | otherwise 
+    | otherwise =
-        = (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
+        (runIdentity . pointerToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
-        . f
+            . f
 
 itNeedsLoading :: Item -> Bool
 itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
   where
-    ic = _itConsumption it
+    ic = _heldConsumption (_itUse it)
 
 activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
-activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
+activateEquipmentAt rbo cr =
-    (Just i,_) -> crLeftInvSel ?~ i
+    cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
-    (_,Just _) -> crLeftInvSel .~ Nothing
+        (Just i, _) -> crLeftInvSel ?~ i
-    _ -> id
+        (_, Just _) -> crLeftInvSel .~ Nothing
+        _ -> id
 
 toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
 toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     Just DoNotMoveEquipment -> w
-    Just PutOnEquipment {_allocNewPos = newp}
+    Just PutOnEquipment{_allocNewPos = newp} ->
-        -> w 
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & onequip itm cr
-    Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
+    Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
-        -> w 
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid ?~ newp
-    Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
+    Just SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
-        -> w 
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp ?~ sid
             & crpoint . crInvEquipped . at invid ?~ newp
             & crpoint . crInvEquipped . at sid ?~ oldp
-    Just ReplaceEquipment {_allocNewPos = newp, _allocRemoveID = rid }
+    Just ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
-        -> w 
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & crpoint . crInvEquipped . at rid .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
-    Just RemoveEquipment {_allocOldPos = oldp }
+    Just RemoveEquipment{_allocOldPos = oldp} ->
-        -> w 
+        w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid .~ Nothing
             & onremove itm cr
@@ -110,15 +114,17 @@ 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 . lUse
         return
-            . (runIdentity . pointToItem (_itPos itm) (return . (itUse . useHammer .~ HammerDown)))
+            . (runIdentity . pointerToItem (_itPos itm) (return . (itUse . useHammer .~ HammerDown)))
             . useL f itm cr
             $ w
   where
     cr = _creatures (_cWorld w) IM.! cid
-    itmShouldBeUsed = isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
+    itmShouldBeUsed =
-        || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
+        isJust (cr ^? crInv . ix (crSel cr) . itUse . cUse)
-            && _crLeftInvSel cr /= Just (crSel cr)
+            || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
-            )
+                    && _crLeftInvSel cr /= Just (crSel cr)
-    -- TODO determine itmShouldBeUsed with reference to config options
+               )
+
+-- TODO determine itmShouldBeUsed with reference to config options

src/Dodge/Creature/ReaderUpdate.hs

@@ -135,7 +135,7 @@ doStrategyActions cr = case cr ^? crActionPlan . apStrategy of
 
 reloadOverride :: Creature -> Creature
 reloadOverride cr
-    | cr ^? crInv . ix (crSel cr) . itConsumption . laLoaded == Just 0 
+    | cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded == Just 0 
             && cr ^. crStance . posture == Aiming
         = cr & crActionPlan . apStrategy .~ StrategyActions Reload reloadActions
     | otherwise = cr

src/Dodge/Creature/State.hs

@@ -216,10 +216,10 @@ itemUpdate cr i
         . (itPos    .~ InInv (_crID cr) i) 
         . (itIsHeld .~ bool)
 updateAutoRecharge :: Item -> Item
-updateAutoRecharge it = case _itConsumption it of
+updateAutoRecharge it = case it ^? itUse . leftConsumption of
-    AutoRecharging l m t p
+    Just (AutoRecharging l m t p)
-        | l < m && p <= 0 -> it & itConsumption .~ AutoRecharging (l+1) m t t
+        | l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l+1) m t t
-        | l < m -> it & itConsumption . arProgress -~ 1
+        | l < m -> it & itUse . leftConsumption . arProgress -~ 1
     _ -> it
 doItemTargeting :: Int -> Creature -> World -> World
 doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of

src/Dodge/Creature/Statistics.hs

@@ -1,16 +1,16 @@
-module Dodge.Creature.Statistics 
+module Dodge.Creature.Statistics (
-    ( getCrStrength
+    getCrStrength,
-    , getCrDexterity
+    getCrDexterity,
-    ) where
+) where
-import Dodge.Data
+
+--import Data.Strict.IntMap.Autogen.Merge.Strict
+import Data.IntMap.Merge.Strict
+import Data.Maybe
 import Dodge.Creature.Test
+import Dodge.Data
 import qualified IntMapHelp as IM
 import LensHelp
 
-import Data.Maybe
-import Data.Strict.IntMap.Autogen.Merge.Strict
---import Data.IntMap.Merge.Strict
-
 getCrDexterity :: Creature -> Int
 getCrDexterity cr = _dexterity (_crStatistics cr)
 
@@ -23,16 +23,20 @@ strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
 equipmentStrValue :: Item -> Int
 equipmentStrValue itm = case _iyBase $ _itType itm of
     EQUIP FRONTARMOUR -> negate 3
-    EQUIP POWERLEGS   -> 3
+    EQUIP POWERLEGS -> 3
     _ -> 0
 
 crCurrentEquipment :: Creature -> IM.IntMap Item
-crCurrentEquipment cr = merge dropMissing dropMissing (zipWithMatched (\_ _ itm -> itm))
+crCurrentEquipment cr =
-    (_crInvEquipped cr)
+    merge
-    (_crInv cr)
+        dropMissing
+        dropMissing
+        (zipWithMatched (\_ _ itm -> itm))
+        (_crInvEquipped cr)
+        (_crInv cr)
 
 strFromHeldItem :: Creature -> Int
 strFromHeldItem cr
-    | _posture (_crStance cr) == Aiming || crIsReloading 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 . useAim . aimWeight
     | otherwise = 0

src/Dodge/Creature/Test.hs

@@ -41,7 +41,7 @@ crIsReloading cr = case cr ^? crInvSel . iselAction of
 
 crWeaponReady :: Creature -> Bool
 crWeaponReady cr = fromMaybe False $ do
-    ic <- cr ^? crInv . ix (crSel cr) . itConsumption
+    ic <- cr ^? crInv . ix (crSel cr) . itUse . heldConsumption
     return (_laLoaded ic > 0 && _laPrimed ic)
 
 crCanSeeCr :: Creature -> (World, Creature) -> Bool

src/Dodge/Data.hs

@@ -22,8 +22,6 @@ module Dodge.Data (
     module Dodge.Data.WorldEffect,
     module Dodge.Data.Button,
     module Dodge.Data.Beam,
-    module Dodge.Data.Targeting,
-    module Dodge.Data.ItEffect,
     module Dodge.Data.Hammer,
     module Dodge.Data.ArcStep,
     module Dodge.Data.CrWlID,
@@ -54,14 +52,12 @@ module Dodge.Data (
     module Dodge.Data.Zoning,
     module Dodge.Data.Bounds,
     module Dodge.Data.Sensor,
-    module Dodge.Combine.Data,
+    module Dodge.Data.Distortion,
-    module Dodge.Distortion.Data,
     module Dodge.Data.Damage,
     module Dodge.Data.SoundOrigin,
-    module Dodge.Config.Data,
+    module Dodge.Data.Config,
     module MaybeHelp,
-    module Dodge.Data.ItemAmount,
+    module Dodge.Data.RoomCluster,
-    module Dodge.RoomCluster.Data,
     module Dodge.Data.Room,
     module Dodge.Data.RadarBlip,
     module Dodge.Data.PathGraph,
@@ -93,8 +89,7 @@ import Data.Preload
 import qualified Data.Set as S
 import qualified Data.Text as T
 import Data.Tile
-import Dodge.Combine.Data
+import Dodge.Data.Config
-import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Dodge.Data.ActionPlan
 import Dodge.Data.Ammo
@@ -122,9 +117,7 @@ import Dodge.Data.GenParams
 import Dodge.Data.Gust
 import Dodge.Data.HUD
 import Dodge.Data.Hammer
-import Dodge.Data.ItEffect
 import Dodge.Data.Item
-import Dodge.Data.ItemAmount
 import Dodge.Data.Laser
 import Dodge.Data.LightSource
 import Dodge.Data.LinearShockwave
@@ -149,15 +142,14 @@ import Dodge.Data.Sensor
 import Dodge.Data.Shockwave
 import Dodge.Data.SoundOrigin
 import Dodge.Data.Spark
-import Dodge.Data.Targeting
 import Dodge.Data.Terminal
 import Dodge.Data.TeslaArc
 import Dodge.Data.TractorBeam
 import Dodge.Data.Wall
 import Dodge.Data.WorldEffect
 import Dodge.Data.Zoning
-import Dodge.Distortion.Data
+import Dodge.Data.Distortion
-import Dodge.RoomCluster.Data
+import Dodge.Data.RoomCluster
 import GHC.Generics
 import Geometry.Data
 import qualified IntMapHelp as IM

src/Dodge/Data/ActionPlan.hs

@@ -1,15 +1,13 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
---{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.ActionPlan where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.Creature.Stance
 import Dodge.Data.CreatureEffect
-import GHC.Generics
 import Geometry.Data
 import Sound.Data
 
@@ -21,22 +19,12 @@ data ActionPlan
         , _apStrategy :: Strategy
         , _apGoal :: [Goal]
         }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON ActionPlan where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON ActionPlan
 
 data RandImpulse
     = RandImpulseList [Impulse]
     | RandImpulseCircMove Float
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON RandImpulse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON RandImpulse
 
 data Impulse
     = Move Point2
@@ -70,12 +58,7 @@ data Impulse
         { _impulseUseAheadPos :: P2Imp
         }
     | ImpulseNothing
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Impulse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Impulse
 
 infixr 9 `WaitThen`
 
@@ -182,12 +165,7 @@ data Action
         { _sideImpulses :: [Impulse]
         , _mainAction :: Action
         }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Action where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Action
 
 data Strategy
     = Flank Int
@@ -205,24 +183,20 @@ data Strategy
     | Reload
     | Flee
     | MeleeStrike
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Strategy where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Strategy
 
 data Goal
     = LiveLongAndProsper
     | Kill Int
     | SentinelAt Point2 Float
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Goal where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Goal
 
+deriveJSON defaultOptions ''ActionPlan
+deriveJSON defaultOptions ''RandImpulse
+deriveJSON defaultOptions ''Impulse
+deriveJSON defaultOptions ''Action
+deriveJSON defaultOptions ''Strategy
+deriveJSON defaultOptions ''Goal
 makeLenses ''ActionPlan
 makeLenses ''Impulse
 makeLenses ''Action

src/Dodge/Data/Ammo.hs

@@ -1,36 +1,32 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Ammo where
-import GHC.Generics
+
+import Control.Lens
 import Data.Aeson
-import Dodge.Data.Payload
+import Data.Aeson.TH
 import Dodge.Data.Bullet
 import Dodge.Data.Gas
+import Dodge.Data.Payload
 import Dodge.Data.Wall
-import Control.Lens
+
 data ProjectileDraw = DrawShell | DrawRemoteShell | DrawDrone | DrawBlankProjectile
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
-instance ToJSON ProjectileDraw  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileDraw 
 data ProjectileCreate = CreateShell | CreateTrackingShell
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
-instance ToJSON ProjectileCreate  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileCreate 
 data ProjectileUpdate
     = PJThrust {_pjuStart :: Int, _pjuEnd :: Int}
-    | PJSpin   {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
+    | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
-    | PJTrack  {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int}
+    | PJTrack {_pjuStart :: Int, _pjuEnd :: Int, _pjuITID :: Int}
     | PJReduceSpin {_pjuReduceSpin :: Float}
     | PJRemoteDirection {_pjuStart :: Int, _pjuEnd :: Int, _pjuCID :: Int, _pjuITID :: Int}
     | PJSetScope {_pjuITID :: Int}
     | PJRetireRemote {_pjuITID :: Int, _pjuTimer :: Int, _pjuPJID :: Int}
-  deriving (Show,Read,Eq,Ord,Generic)
+    deriving (Show, Read, Eq, Ord)
-instance ToJSON ProjectileUpdate  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileUpdate 
 data AmmoType
     = ProjectileAmmo
         { _amPayload :: Payload
@@ -43,18 +39,20 @@ data AmmoType
         , _amBullet :: Bullet
         }
     | DroneAmmo
-        { _amString :: String }
+        {_amString :: String}
     | GasAmmo
-        { _amString    :: String
+        { _amString :: String
         , _amCreateGas :: GasCreate
         }
     | ForceFieldAmmo
         { _amForceFieldType :: Wall
         }
     | GenericAmmo
- deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON AmmoType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AmmoType
 makeLenses ''ProjectileUpdate
 makeLenses ''AmmoType
+deriveJSON defaultOptions ''ProjectileDraw
+deriveJSON defaultOptions ''ProjectileCreate
+deriveJSON defaultOptions ''ProjectileUpdate
+deriveJSON defaultOptions ''AmmoType

src/Dodge/Data/Bullet.hs

@@ -1,66 +1,57 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Bullet where
-import GHC.Generics
+
+import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.Damage
 import Geometry.Data
-import Control.Lens
+
 data Bullet = Bullet
-    { _buState      :: BulletState
+    { _buDelayFraction :: Float
-    , _buEffect     :: BulletEffect
+    , _buEffect :: BulletEffect
-    , _buSpawn      :: BulletSpawn
+    , _buSpawn :: BulletSpawn
-    , _buUpdateMod  :: BulletUpdateMod
+    , _buUpdateMod :: BulletUpdateMod
     , _buTrajectory :: BulletTrajectory
-    , _buVel        :: Point2
+    , _buVel :: Point2
-    , _buDrag       :: Float
+    , _buDrag :: Float
-    , _buPos        :: Point2
+    , _buPos :: Point2
-    , _buOldPos     :: Point2
+    , _buOldPos :: Point2
-    , _buWidth      :: Float 
+    , _buWidth :: Float
-    , _buTimer      :: Int
+    , _buTimer :: Int
-    , _buDamages    :: [Damage]
+    , _buDamages :: [Damage]
     }
-  deriving (Show,Read,Eq,Ord,Generic)
+    deriving (Show, Read, Eq, Ord)
-instance ToJSON Bullet  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Bullet 
 data EnergyBallType = IncBall | TeslaBall | ConcBall
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
-instance ToJSON EnergyBallType  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EnergyBallType 
-data BulletState = NormalBulletState
-    | DelayedBullet Float
-  deriving (Show,Read,Eq,Ord,Generic)
-instance ToJSON BulletState  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletState 
 data BulletUpdateMod = NoBulletUpdateMod
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
-instance ToJSON BulletUpdateMod  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletUpdateMod 
 data BulletEffect
     = DestroyBullet
     | BounceBullet
     | PenetrateBullet
-  deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic)
+    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-instance ToJSON BulletEffect  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletEffect 
 data BulletSpawn = BulBall EnergyBallType | BulSpark
-  deriving (Show,Read,Eq,Ord,Generic)
+    deriving (Show, Read, Eq, Ord)
-instance ToJSON BulletSpawn  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletSpawn 
 data BulletTrajectory
     = BasicBulletTrajectory
     | BezierTrajectory Point2 Point2 Point2
     | FlechetteTrajectory Point2
     | MagnetTrajectory Point2
-  deriving (Show,Read,Eq,Ord,Generic)
+    deriving (Show, Read, Eq, Ord)
-instance ToJSON BulletTrajectory where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletTrajectory
 makeLenses ''Bullet
+deriveJSON defaultOptions ''Bullet
+deriveJSON defaultOptions ''EnergyBallType
+deriveJSON defaultOptions ''BulletUpdateMod
+deriveJSON defaultOptions ''BulletEffect
+deriveJSON defaultOptions ''BulletSpawn
+deriveJSON defaultOptions ''BulletTrajectory

src/Dodge/Data/Button.hs

@@ -38,7 +38,7 @@ data ButtonEvent = ButtonDoNothing
         ,_boffEff :: WdWd
         }
     | ButtonAccessTerminal
-  deriving (Eq,Ord,Show,Read,Generic)
+  deriving (Eq,Show,Read,Generic)
 instance ToJSON ButtonEvent  where
     toEncoding = genericToEncoding defaultOptions
 instance FromJSON ButtonEvent 
@@ -54,7 +54,7 @@ data Button = Button
     , _btName   :: String
     , _btColor  :: Color
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+  deriving (Eq,Show,Read,Generic)
 instance ToJSON Button  where
     toEncoding = genericToEncoding defaultOptions
 instance FromJSON Button 

src/Dodge/Data/CWorld.hs

@@ -1,11 +1,13 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.CWorld where
+module Dodge.Data.CWorld (
+    module Dodge.Data.CWorld,
+) where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Data.Graph.Inductive
 import qualified Data.IntSet as IS
 import Dodge.Data.Beam
@@ -18,6 +20,7 @@ import Dodge.Data.Corpse
 import Dodge.Data.CrGroupParams
 import Dodge.Data.Creature
 import Dodge.Data.Damage
+import Dodge.Data.Distortion
 import Dodge.Data.Door
 import Dodge.Data.EnergyBall
 import Dodge.Data.Flame
@@ -48,9 +51,7 @@ import Dodge.Data.TeslaArc
 import Dodge.Data.TractorBeam
 import Dodge.Data.Wall
 import Dodge.Data.WorldEffect
-import Dodge.Distortion.Data
 import Dodge.GameRoom
-import GHC.Generics
 import Geometry.ConvexPoly
 import Geometry.Data
 import qualified IntMapHelp as IM
@@ -135,12 +136,6 @@ data CWorld = CWorld
     , _genParams :: GenParams
     , _deathDelay :: Maybe Int
     }
-    deriving (Eq, Show, Read, Generic)
-
-instance ToJSON CWorld where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON CWorld
 
 data WorldBeams = WorldBeams
     { _blockingBeams :: [Beam]
@@ -148,12 +143,9 @@ data WorldBeams = WorldBeams
     , _positronBeams :: [Beam]
     , _electronBeams :: [Beam]
     }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON WorldBeams where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON WorldBeams
 
+deriveJSON defaultOptions ''CWorld
+deriveJSON defaultOptions ''WorldBeams
 makeLenses ''CWorld
 makeLenses ''WorldBeams

src/Dodge/Data/Config.hs

@@ -0,0 +1,122 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Config where
+
+import Control.Lens
+import Data.Aeson
+import qualified Data.Set as S
+import GHC.Generics
+
+{-# ANN module "HLint: ignore Use camelCase" #-}
+
+data Configuration = Configuration
+    { _volume_master :: Float
+    , _volume_sound :: Float
+    , _volume_music :: Float
+    , _graphics_wall_textured :: Bool
+    , _graphics_cloud_shadows :: Bool
+    , _graphics_object_shadows :: Bool
+    , _graphics_resolution_factor :: ResFactor
+    , _windowX :: Float
+    , _windowY :: Float
+    , _windowPosX :: Int
+    , _windowPosY :: Int
+    , _gameplay_rotate_to_wall :: Bool
+    , _debug_view_clip_bounds :: RoomClipping
+    , _debug_booleans :: S.Set DebugBool -- consider using Data.BitSet
+    }
+    deriving (Generic, Show)
+
+data DebugBool
+    = Show_ms_frame
+    | Show_debug
+    | Show_sound
+    | Noclip
+    | Cr_status
+    | Cr_awareness
+    | Mouse_position
+    | View_boundaries
+    | Walls_info
+    | Pathing
+    | Remove_LOS
+    | Cull_more_lights
+    | Close_shape_culling
+    | Show_bound_box
+    | Bound_box_screen
+    | Show_wall_search_rays
+    | Show_dda_test
+    | Show_far_wall_detect
+    | Show_select
+    | Inspect_wall
+    | Show_nodes_near_select
+    | Show_path_between
+    deriving (Generic, Eq, Ord, Bounded, Enum, Show)
+
+data ResFactor = FullRes | HalfRes | QuarterRes
+    deriving (Generic, 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)
+
+instance ToJSON RoomClipping where
+    toEncoding = genericToEncoding defaultOptions
+
+instance FromJSON RoomClipping
+
+resFactorNum :: ResFactor -> Int
+resFactorNum rf = case rf of
+    FullRes -> 1
+    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
+        { _volume_master = 1
+        , _volume_sound = 1
+        , _volume_music = 1
+        , _graphics_wall_textured = True
+        , _graphics_cloud_shadows = True
+        , _graphics_object_shadows = True
+        , _graphics_resolution_factor = FullRes
+        , _windowX = 800
+        , _windowY = 600
+        , _windowPosX = 0
+        , _windowPosY = 0
+        , _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

src/Dodge/Data/Creature.hs

@@ -1,88 +1,99 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature 
+{-# LANGUAGE TemplateHaskell #-}
-    ( module Dodge.Data.Creature
+
-    , module Dodge.Data.Creature.Misc
+module Dodge.Data.Creature (
-    , module Dodge.Data.Creature.State
+    module Dodge.Data.Creature,
-    , module Dodge.Data.Creature.Perception
+    module Dodge.Data.Creature.Misc,
-    , module Dodge.Data.Creature.Memory
+    module Dodge.Data.Creature.State,
-    , module Dodge.Data.Creature.Stance
+    module Dodge.Data.Creature.Perception,
-    ) where
+    module Dodge.Data.Creature.Memory,
-import GHC.Generics
+    module Dodge.Data.Creature.Stance,
+) where
+
+import Control.Lens
 import Data.Aeson
+import qualified Data.Map.Strict as M
+import Dodge.Data.ActionPlan
+import Dodge.Data.Creature.Memory
 import Dodge.Data.Creature.Misc
+import Dodge.Data.Creature.Perception
+import Dodge.Data.Creature.Stance
 import Dodge.Data.Creature.State
+import Dodge.Data.Hammer
 import Dodge.Data.Item
 import Dodge.Data.LoadAction
 import Dodge.Data.Material
-import Dodge.Data.ActionPlan
+import GHC.Generics
-import Dodge.Data.Hammer
-import Dodge.Data.Creature.Perception
-import Dodge.Data.Creature.Memory
-import Dodge.Data.Creature.Stance
 import Geometry.Data
 import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
 
-import Control.Lens
 data Creature = Creature
-    { _crPos            :: Point2
+    { _crPos :: Point2
-    , _crOldPos         :: Point2
+    , _crOldPos :: Point2
-    , _crVel            :: Point2
+    , _crVel :: Point2
-    , _crDir            :: Float
+    , _crDir :: Float
-    , _crOldDir         :: Float
+    , _crOldDir :: Float
-    , _crMvDir          :: Float
+    , _crMvDir :: Float
-    , _crTwist          :: Float
+    , _crTwist :: Float
-    , _crType           :: CreatureType
+    , _crType :: CreatureType
-    , _crID             :: Int
+    , _crID :: Int
-    , _crRad            :: Float
+    , _crRad :: Float
-    , _crMass           :: Float
+    , _crMass :: Float
-    , _crHP             :: Int
+    , _crHP :: Int
-    , _crMaxHP          :: Int
+    , _crMaxHP :: Int
-    , _crInv            :: IM.IntMap Item
+    , _crInv :: IM.IntMap Item
-    , _crInvSel         :: InvSel
+    , _crInvSel :: InvSel
-    , _crInvCapacity    :: Int
+    , _crInvCapacity :: Int
-    , _crInvLock        :: Bool
+    , _crInvLock :: Bool
-    , _crInvEquipped    :: IM.IntMap EquipPosition
+    , _crInvEquipped :: IM.IntMap EquipPosition
-    , _crEquipment      :: M.Map EquipPosition Int
+    , _crEquipment :: M.Map EquipPosition Int
-    , _crLeftInvSel     :: Maybe Int
+    , _crLeftInvSel :: Maybe Int
-    , _crState          :: CreatureState
+    , _crState :: CreatureState
-    , _crCorpse         :: CreatureCorpse --Creature -> Corpse -> SPic
+    , _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
-    , _crMaterial       :: Material
+    , _crMaterial :: Material
-    , _crPastDamage     :: Int
+    , _crPastDamage :: Int
-    , _crStance         :: Stance
+    , _crStance :: Stance
-    , _crActionPlan     :: ActionPlan
+    , _crActionPlan :: ActionPlan
-    , _crMeleeCooldown  :: Int
+    , _crMeleeCooldown :: Int
-    , _crPerception     :: Perception
+    , _crPerception :: Perception
-    , _crMemory         :: Memory
+    , _crMemory :: Memory
-    , _crVocalization   :: Vocalization
+    , _crVocalization :: Vocalization
-    , _crFaction        :: Faction
+    , _crFaction :: Faction
-    , _crGroup          :: CrGroup
+    , _crGroup :: CrGroup
-    , _crIntention      :: Intention
+    , _crIntention :: Intention
-    , _crMvType         :: CrMvType
+    , _crMvType :: CrMvType
     , _crHammerPosition :: HammerPosition
-    , _crName           :: String
+    , _crName :: String
-    , _crStatistics     :: CreatureStatistics
+    , _crStatistics :: CreatureStatistics
-    , _crCamouflage     :: CamouflageStatus
+    , _crCamouflage :: CamouflageStatus
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON Creature  where
+
+instance ToJSON Creature where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Creature
+
 data CreatureCorpse = MakeDefaultCorpse
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON CreatureCorpse  where
+
+instance ToJSON CreatureCorpse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON CreatureCorpse
+
 data Intention = Intention
-    { _targetCr     :: Maybe Creature
+    { _targetCr :: Maybe Creature
-    , _mvToPoint    :: Maybe Point2
+    , _mvToPoint :: Maybe Point2
-    , _viewPoint    :: Maybe Point2
+    , _viewPoint :: Maybe Point2
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON Intention  where
+
+instance ToJSON Intention where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Intention
+
 makeLenses ''Creature
 makeLenses ''Intention

src/Dodge/Data/Distortion.hs

@@ -0,0 +1,13 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Data.Distortion where
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry
+
+data Distortion 
+    = RadialDistortion Point2 Point2 Point2 Float
+  deriving (Eq,Ord,Show,Read)
+
+deriveJSON defaultOptions ''Distortion

src/Dodge/Data/FloorItem.hs

@@ -9,7 +9,7 @@ import GHC.Generics
 import Data.Aeson
 import Control.Lens
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
-  deriving (Eq,Ord,Show,Read,Generic)
+  deriving (Eq,Show,Read,Generic)
 instance ToJSON FloorItem where
     toEncoding = genericToEncoding defaultOptions
 instance FromJSON FloorItem

src/Dodge/Data/HUD.hs

@@ -1,39 +1,51 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.HUD where
-import GHC.Generics
+
-import Data.Aeson
-import Geometry.Data
 import Control.Lens
+import Data.Aeson
+import GHC.Generics
+import Geometry.Data
+
 data HUDElement
     = DisplayInventory {_subInventory :: SubInventory}
     | DisplayCarte
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON HUDElement  where
+
+instance ToJSON HUDElement where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON HUDElement
+
 data SubInventory
     = NoSubInventory
-    | TweakInventory
+    | TweakInventory {_tweakInvSel :: Maybe Int}
     | CombineInventory {_combineInvSel :: Maybe Int}
     | InspectInventory
     | LockedInventory
-    | DisplayTerminal {_termID :: Int }
+    | DisplayTerminal {_termID :: Int}
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON SubInventory  where
+
+instance ToJSON SubInventory where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON SubInventory
+
 data HUD = HUD
-    { _hudElement   :: HUDElement
+    { _hudElement :: HUDElement
-    , _carteCenter  :: Point2
+    , _carteCenter :: Point2
-    , _carteZoom    :: Float
+    , _carteZoom :: Float
-    , _carteRot     :: Float
+    , _carteRot :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON HUD  where
+
+instance ToJSON HUD where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON HUD
+
 makeLenses ''HUD
 makeLenses ''HUDElement
 makeLenses ''SubInventory

src/Dodge/Data/ItEffect.hs

@@ -1,58 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Data.ItEffect where
-import GHC.Generics
-import Data.Aeson
-import Control.Lens
--- I believe this is called every frame, not sure when though
-data ItEffect 
-    = NoItEffect
-    | ItInvEffect 
-        {_ieInv       :: ItInvEffect --Item -> Creature -> World -> World
-        ,_ieCounter   :: Int
-        }
-    | ItRewindEffect
-        {_ieInv       :: ItInvEffect --Item -> Creature -> World -> World
---        ,_ieStoredWorlds    :: [World]
-        }
-    | ItEffect 
-        {_ieInv       :: ItInvEffect --Item -> Creature -> World -> World 
-        ,_ieFloor     :: ItFloorEffect --Int -> World -> World 
-        ,_ieCounter   :: Int
-        }
-    | ItInvEffectID
-        {_ieInv       :: ItInvEffect --Item -> Creature -> World -> World
-        ,_ieMID   :: Maybe Int
-        }  -- the duplication of ieMID may cause errors...
-    | ItInvEffectDrop
-        { _ieInv  :: ItInvEffect --Item -> Creature -> World -> World
-        , _ieDrop    :: ItDropEffect --Item -> Creature -> World -> World
-        , _ieMID     :: Maybe Int
-        }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItEffect 
-data ItInvEffect = NoInvEffect
-    | RewindEffect
-    | ResetAttachmentEffect
-    | OnOffHeldEffect ItInvEffect ItInvEffect
-    | CreateHeldLight
-    | CreateShieldWall
-    | RemoveShieldWall
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItInvEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItInvEffect 
-data ItFloorEffect = NoFloorEffect
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItFloorEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItFloorEffect 
-data ItDropEffect = NoDropEffect
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItDropEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItDropEffect 
-makeLenses ''ItEffect

src/Dodge/Data/Item.hs

@@ -1,51 +1,52 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Item 
+{-# LANGUAGE TemplateHaskell #-}
-    ( module Dodge.Data.Item
+
-    , module Dodge.Data.Item.Misc
+module Dodge.Data.Item (
-    , module Dodge.Data.Item.Tweak
+    module Dodge.Data.Item,
-    , module Dodge.Data.Item.Params
+    module Dodge.Data.Item.Effect,
-    , module Dodge.Data.Item.Use
+    module Dodge.Data.Item.Misc,
-    , module Dodge.Data.Item.Consumption
+    module Dodge.Data.Item.Tweak,
-    , module Dodge.Data.Item.CurseStatus
+    module Dodge.Data.Item.Params,
-    , module Dodge.Data.Item.Attachment
+    module Dodge.Data.Item.Use,
-    ) where
+    module Dodge.Data.Item.CurseStatus,
-import GHC.Generics
+    module Dodge.Data.Item.Attachment,
-import Data.Aeson
+    module Dodge.Data.Item.Combine,
+    module Dodge.Data.Item.Targeting,
+) where
+
+import Color
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.Item.Combine
+import Dodge.Data.Item.Effect
+import Dodge.Data.Item.Attachment
 import Dodge.Data.Item.CurseStatus
 import Dodge.Data.Item.Misc
-import Dodge.Data.Item.Tweak
-import Dodge.Data.Item.Consumption
-import Dodge.Data.Item.Use
 import Dodge.Data.Item.Params
-import Dodge.Data.ItEffect
+import Dodge.Data.Item.Tweak
-import Dodge.Data.Targeting
+import Dodge.Data.Item.Use
-import Dodge.Combine.Data
+import Dodge.Data.Item.Targeting
-import Dodge.Data.Item.Attachment
+
-import Color
 data Item = Item
-    { _itConsumption    :: ItemConsumption
+    { _itUse :: ItemUse
-    , _itUse        :: ItemUse
+    , _itType :: ItemType
-    , _itType       :: ItemType
     , _itAttachment :: ItAttachment
-    , _itID         :: Maybe Int
+    , _itID :: Maybe Int
-    , _itPos        :: ItemPos
+    , _itPos :: ItemPos
-    , _itIsHeld     :: Bool
+    , _itIsHeld :: Bool
-    , _itEffect     :: ItEffect
+    , _itEffect :: ItEffect
-    , _itInvSize    :: Float
+    , _itInvSize :: Float
-    , _itInvColor   :: Color
+    , _itInvColor :: Color
-    , _itTargeting  :: Targeting
+    , _itTargeting :: Targeting
-    , _itDimension  :: ItemDimension
+    , _itDimension :: ItemDimension
-    , _itCurseStatus    :: CurseStatus
+    , _itCurseStatus :: CurseStatus
-    , _itTweaks     :: ItemTweaks
+    , _itTweaks :: ItemTweaks
-    , _itScope      :: Scope
+    , _itScope :: Scope
-    , _itValue      :: ItemValue
+    , _itValue :: ItemValue
-    , _itParams     :: ItemParams
+    , _itParams :: ItemParams
     }
-   deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read)
-instance ToJSON Item  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Item 
 makeLenses ''Item
+deriveJSON defaultOptions ''Item

src/Dodge/Data/Item/Attachment.hs

@@ -1,43 +1,44 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Item.Attachment
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
-import GHC.Generics
+module Dodge.Data.Item.Attachment where
-import Data.Aeson
+
-import Geometry.Data
 import Control.Lens
-import qualified Data.Sequence as Seq
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
 data ItAttachment
     = AttachFuse {_atFuseTime :: Int}
-    | AttachMode {_atMode :: Int}
+    | AttachTargetPos {_atTargetPos :: Point2}
-    | AttachCharMode {_atCharMode :: Seq.Seq Char }
+    | AttachInt {_atInt :: Int}
-    | AttachTargetPos { _atTargetPos :: Point2 }
+    | AttachMInt {_atMInt :: Maybe Int}
-    | AttachInt { _atInt :: Int }
+    | AttachFloat {_atFloat :: Float}
-    | AttachMInt { _atMInt :: Maybe Int }
+    | AttachBool {_atBool :: Bool}
-    | AttachFloat { _atFloat :: Float }
-    | AttachBool  { _atBool  :: Bool  }
     | NoItAttachment
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ItAttachment  where
+
-    toEncoding = genericToEncoding defaultOptions
+data Scope
-instance FromJSON ItAttachment 
+    = NoScope
-data Scope = NoScope
     | RemoteScope
-        {_scopePos        :: Point2 -- ^ a camera offset
+        { -- | a camera offset
-        ,_scopeZoom       :: Float 
+          _scopePos :: Point2
-        ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
+        , _scopeZoom :: Float
+        , -- | if the camera offset is also the center of vision
+          _scopeIsCamera :: Bool
         }
     | ZoomScope
-        {_scopePos        :: Point2 -- ^ a camera offset
+        { -- | a camera offset
-        ,_scopeZoomChange :: Int
+          _scopePos :: Point2
-        ,_scopeZoom       :: Float 
+        , _scopeZoomChange :: Int
-        ,_scopeDefaultZoom  :: Float
+        , _scopeZoom :: Float
-        ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
+        , _scopeDefaultZoom :: Float
+        , -- | if the camera offset is also the center of vision
+          _scopeIsCamera :: Bool
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Scope  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Scope 
 makeLenses ''ItAttachment
 makeLenses ''Scope
+deriveJSON defaultOptions ''ItAttachment
+deriveJSON defaultOptions ''Scope

src/Dodge/Data/Item/Combine.hs

@@ -1,28 +1,25 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TemplateHaskell #-}
-module Dodge.Combine.Data
+
-    where
+module Dodge.Data.Item.Combine where
-import GHC.Generics
+
-import Data.Aeson
+import Dodge.Data.Item.Use.Consumption
-import Dodge.Data.Equipment.Misc
-import Dodge.Data.ItemAmount
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
 import qualified Data.Map.Strict as M
--- this should probably store loaded ammo
+import Dodge.Data.Equipment.Misc
+
 data ItemType = ItemType
-    {_iyBase    :: ItemBaseType
+    { _iyBase :: ItemBaseType
-    ,_iyModules :: M.Map ModuleSlot ItemModuleType
+    , _iyModules :: M.Map ModuleSlot ItemModuleType
-    ,_iyStack   :: Stack
+    , _iyStack :: Stack
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ItemType  where
+
-    toEncoding = genericToEncoding defaultOptions
+data Stack = NoStack | Stack ItAmount
-instance FromJSON ItemType 
+    deriving (Eq, Ord, Show, Read)
-data Stack = NoStack | Stack IcAmount
+
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Stack  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Stack 
 data CraftType
     = PIPE
     | TUBE
@@ -47,7 +44,7 @@ data CraftType
     | MICROCHIP
     | AIUNIT
     | CAMERA
-    | MINIDISPLAY  -- visual display unit
+    | MINIDISPLAY -- visual display unit
     | LED
     | NAILBOX
     | IRONBAR
@@ -59,8 +56,6 @@ data CraftType
     | BATTERY
     | FUELCELL
     | PORTABLEFUSION
-    -- Modules
-    -- bullet
     | INCENDIARYMODULE
     | STATICMODULE
     | CONCUSSMODULE
@@ -68,38 +63,24 @@ data CraftType
     | FLASHMODULE
     | BOUNCEMODULE
     | PENMODULE
-    --
     | TELEPORTMODULE
     | TIMEMODULE
     | SIZEMODULE
     | GRAVITYMODULE
-  deriving (Eq,Ord,Show,Enum,Read,Generic)
+    deriving (Eq, Ord, Show, Enum, Read)
-instance ToJSON CraftType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CraftType
--- TODO make this an enum somehow...?
 data ItemBaseType
-    = NOTDEFINED
+    = HELD {_ibtHeld :: HeldItemType}
-    | EFFGUN String
-    | AUTOEFFGUN String
-    -- Weapons
-    | HELD {_ibtHeld :: HeldItemType}
     | LEFT {_ibtLeft :: LeftItemType}
     | EQUIP {_ibtEquip :: EquipItemType}
---    | GRENADE
+    | Consumable {_ibtConsumable :: ConsumableItemType}
---    | REMOTEBOMB
-    -- Utility items
-    -- Equipment
-    --
-    | KEYCARD Int
-    --
-    | MEDKIT Int
     | CRAFT CraftType
-    --
+    deriving (Eq, Ord, Show, Read)
-  deriving (Eq,Ord,Show,Read,Generic)
+
-instance ToJSON ItemBaseType where
+data ConsumableItemType
-    toEncoding = genericToEncoding defaultOptions
+    = MEDKIT Int
-instance FromJSON ItemBaseType
+    deriving (Eq, Ord, Show, Read)
+
 data EquipItemType
     = MAGSHIELD
     | FLAMESHIELD
@@ -115,10 +96,8 @@ data EquipItemType
     | JUMPLEGS
     | JETPACK
     | AUTODETECTOR Detector
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON EquipItemType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EquipItemType
 data LeftItemType
     = BOOSTER
     | REWINDER
@@ -126,10 +105,8 @@ data LeftItemType
     | BLINKERUNSAFE
     | SHRINKER
     | SPAWNER
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON LeftItemType where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON LeftItemType
 data HeldItemType
     = BANGSTICK {_xNum :: Int}
     | PISTOL
@@ -141,18 +118,17 @@ data HeldItemType
     | BANGCONE
     | BLUNDERBUSS
     | GRAPECANNON {_xNum :: Int}
---    | GRENADELAUNCHER Int -- number of chambers that can be reloaded
+    | --    | GRENADELAUNCHER Int -- number of chambers that can be reloaded
---    | MORTARCONE / HANDMORTAR
+      --    | MORTARCONE / HANDMORTAR
---    | MINIGUN
+      MINIGUNX {_xNum :: Int}
-    | MINIGUNX {_xNum :: Int}
     | VOLLEYGUN {_xNum :: Int}
     | RIFLE
     | REPEATER
     | AUTORIFLE
     | BURSTRIFLE
---    | FASTBURSTRIFLE
+    | --    | FASTBURSTRIFLE
---    | COMPLETEBURSTRIFLE
+      --    | COMPLETEBURSTRIFLE
-    | BANGROD
+      BANGROD
     | ELEPHANTGUN
     | AMR
     | AUTOAMR
@@ -167,33 +143,30 @@ data HeldItemType
     | TESLAGUN
     | LASGUN
     | LASCIRCLE
---    | LASPULSE
+    | --    | LASPULSE
-    | DUALBEAM
+      DUALBEAM
---    | LASGUNSWING
+    | --    | LASGUNSWING
-    -- | LASGUNSWAY
+
---    | LASGUNWIDEPULSE
+      -- | LASGUNSWAY
-    | LASWIDE {_xNum :: Int}
+      --    | LASGUNWIDEPULSE
-    -- | LASGUNFOCUS Int
+      LASWIDE {_xNum :: Int}
-    -- | SONICGUN
+    | -- | LASGUNFOCUS Int
-    | TRACTORGUN
+      -- | SONICGUN
+      TRACTORGUN
     | LAUNCHER
     | LAUNCHERX {_xNum :: Int}
---    | TRACKINGLAUNCHER
+    | --    | TRACKINGLAUNCHER
-    | REMOTELAUNCHER
+      REMOTELAUNCHER
     | POISONSPRAYER
     | DRONELAUNCHER
-    
     | SHATTERGUN
-
     | FORCEFIELDGUN
-
     | HELDDETECTOR Detector
     | TORCH
     | FLATSHIELD
-  deriving (Eq,Ord,Show,Read,Generic)
+    | KEYCARD Int
-instance ToJSON HeldItemType where
+    deriving (Eq, Ord, Show, Read)
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON HeldItemType
 data ItemModuleType
     = EMPTYMODULE
     | DRUMMAG
@@ -217,18 +190,14 @@ data ItemModuleType
     | LAUNCHHOME
     | EXTRABATTERY
     | ATTACHTORCH
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ItemModuleType  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemModuleType 
 data Detector
     = ITEMDETECTOR
     | CREATUREDETECTOR
     | WALLDETECTOR
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Detector where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Detector
 data ModuleSlot
     = ModBullet
     | ModBulletSpawn
@@ -241,12 +210,23 @@ data ModuleSlot
     | ModTeleport
     | ModDualBeam
     | ModHeldAttach
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ModuleSlot where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ModuleSlot
 instance ToJSONKey ModuleSlot
+
 instance FromJSONKey ModuleSlot
+
+deriveJSON defaultOptions ''ItemType
+deriveJSON defaultOptions ''Stack
+deriveJSON defaultOptions ''CraftType
+deriveJSON defaultOptions ''ItemBaseType
+deriveJSON defaultOptions ''ConsumableItemType
+deriveJSON defaultOptions ''EquipItemType
+deriveJSON defaultOptions ''LeftItemType
+deriveJSON defaultOptions ''HeldItemType
+deriveJSON defaultOptions ''ItemModuleType
+deriveJSON defaultOptions ''Detector
+deriveJSON defaultOptions ''ModuleSlot
 makeLenses ''ItemType
 makeLenses ''ItemBaseType
 makeLenses ''HeldItemType

src/Dodge/Data/Item/Consumption.hs

@@ -1,38 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Data.Item.Consumption where
-import GHC.Generics
-import Data.Aeson
-import Control.Lens
-import Dodge.Data.Ammo
-import Dodge.Data.LoadAction
-import Dodge.Data.ItemAmount
-data ItemConsumption
-    = LoadableAmmo
-        { _laAmmoType   :: AmmoType
-        , _laMax        :: Int
-        , _laLoaded     :: Int
-        , _laPrimed     :: Bool
-        , _laCycle      :: [LoadAction]
-        , _laProgress   :: Maybe [LoadAction]
-        }
-    | AutoRecharging
-        { _arLoaded     :: Int
-        , _arMax        :: Int
-        , _arTime       :: Int
-        , _arProgress   :: Int
-        }
-    | ChargeableAmmo
-        { _wpMaxCharge  :: Int
-        , _wpCharge     :: Int
-        }
-    | ItemItselfConsumable
-        { _icAmount   :: IcAmount
-        }
-    | NoConsumption
- deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItemConsumption where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemConsumption
-makeLenses ''ItemConsumption

src/Dodge/Data/Item/Effect.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Item.Effect where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+
+data ItEffect
+    = NoItEffect
+    | ItInvEffect
+        { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
+        , _ieCounter :: Int
+        }
+    | ItRewindEffect
+        { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
+        }
+    | ItEffect
+        { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
+        , _ieFloor :: ItFloorEffect --Int -> World -> World
+        , _ieCounter :: Int
+        }
+    | ItInvEffectID
+        { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
+        , _ieMID :: Maybe Int
+        } -- the duplication of ieMID may cause errors...
+    | ItInvEffectDrop
+        { _ieInv :: ItInvEffect --Item -> Creature -> World -> World
+        , _ieDrop :: ItDropEffect --Item -> Creature -> World -> World
+        , _ieMID :: Maybe Int
+        }
+    deriving (Eq, Ord, Show, Read)
+
+data ItInvEffect
+    = NoInvEffect
+    | RewindEffect
+    | ResetAttachmentEffect
+    | OnOffHeldEffect ItInvEffect ItInvEffect
+    | CreateHeldLight
+    | CreateShieldWall
+    | RemoveShieldWall
+    deriving (Eq, Ord, Show, Read)
+
+data ItFloorEffect = NoFloorEffect
+    deriving (Eq, Ord, Show, Read)
+
+data ItDropEffect = NoDropEffect
+    deriving (Eq, Ord, Show, Read)
+
+makeLenses ''ItEffect
+deriveJSON defaultOptions ''ItEffect
+deriveJSON defaultOptions ''ItInvEffect
+deriveJSON defaultOptions ''ItFloorEffect
+deriveJSON defaultOptions ''ItDropEffect

src/Dodge/Data/Item/HeldScroll.hs

@@ -1,10 +1,23 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Item.HeldScroll where
-import GHC.Generics
+
+import Control.Lens
 import Data.Aeson
-data HeldScroll = HeldScrollDoNothing | HeldScrollZoom | HeldScrollCharMode
+import Data.Aeson.TH
-  deriving (Eq,Ord,Enum,Bounded,Show,Read,Generic)
+import qualified Data.Sequence as Seq
-instance ToJSON HeldScroll  where
+
-    toEncoding = genericToEncoding defaultOptions
+data HeldScroll
-instance FromJSON HeldScroll 
+    = HeldScrollDoNothing
+    | HeldScrollZoom
+    | HeldScrollCharMode
+        {_hsCharMode :: Seq.Seq Char}
+    | HeldScrollInt
+        { _hsInt :: Int
+        , _hsMaxInt :: Int
+        }
+    deriving (Eq, Ord, Show, Read)
+
+makeLenses ''HeldScroll
+deriveJSON defaultOptions ''HeldScroll

src/Dodge/Data/Item/HeldUse.hs

@@ -1,12 +1,12 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.Item.HeldUse where
 
 import Data.Aeson
-import Dodge.Combine.Data
+import Data.Aeson.TH
 import Dodge.Data.CamouflageStatus
-import GHC.Generics
+import Dodge.Data.Item.Combine
 
 data HeldUse
     = HeldDoNothing
@@ -24,22 +24,12 @@ data HeldUse
     | HeldTractor
     | HeldForceField
     | HeldShatter
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON HeldUse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON HeldUse
 
 data Cuse
     = CDoNothing
     | CHeal Int
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Cuse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Cuse
 
 data Euse
     = EDoNothing
@@ -50,12 +40,7 @@ data Euse
     | ECamouflage CamouflageStatus
     | EonWristShield
     | EoffWristShield
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Euse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Euse
 
 data Luse
     = LDoNothing
@@ -64,12 +49,7 @@ data Luse
     | LBlink
     | LUnsafeBlink
     | LBoost
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-
-instance ToJSON Luse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Luse
 
 data HeldMod
     = HeldModNothing
@@ -107,9 +87,10 @@ data HeldMod
     | RevolverXMod
     | RevolverXRepeatMod
     | BangConeMod
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
 
-instance ToJSON HeldMod where
+deriveJSON defaultOptions ''Cuse
-    toEncoding = genericToEncoding defaultOptions
+deriveJSON defaultOptions ''HeldMod
-
+deriveJSON defaultOptions ''Euse
-instance FromJSON HeldMod
+deriveJSON defaultOptions ''HeldUse
+deriveJSON defaultOptions ''Luse

src/Dodge/Data/Item/Params.hs

@@ -1,19 +1,21 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Item.Params where
-import GHC.Generics
+
-import Data.Aeson
-import Dodge.Data.Beam
-import Dodge.Data.ArcStep
-import Geometry.Data
 import Color
 import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.ArcStep
+import Dodge.Data.Beam
+import Geometry.Data
+
 data ItemParams
     = NoParams
     | ShellLauncher
-        { _shellSpinDrag    :: Int
+        { _shellSpinDrag :: Int
-        , _shellSpinAmount  :: Int
+        , _shellSpinAmount :: Int
         , _shellThrustDelay :: Int
         }
     | Refracting
@@ -31,19 +33,19 @@ data ItemParams
         , _lasDamage :: Int
         , _lasBeam :: BeamType
         , _subParams :: Maybe ItemParams
-        , _dbGap    :: Float
+        , _dbGap :: Float
         }
-    | Attracting    {_attractionPower :: Point2}
+    | Attracting {_attractionPower :: Point2}
     | BulletShooter
-        { _muzVel   :: Float
+        { _muzVel :: Float
-        , _rifling  :: Float
+        , _rifling :: Float
-        , _bore     :: Float
+        , _bore :: Float
         , _gunBarrels :: GunBarrels
-        , _recoil       :: Float
+        , _recoil :: Float
-        , _torqueAfter  :: Float
+        , _torqueAfter :: Float
         , _randomOffset :: Float
         }
-    | Sprayer { _sprayNozzles :: [Nozzle] }
+    | Sprayer {_sprayNozzles :: [Nozzle]}
     | AngleWalk
         { _maxWalkAngle :: Float
         , _currentWalkAngle :: Float
@@ -57,51 +59,57 @@ data ItemParams
         , _previousArcEffect :: PreviousArcEffect
         }
     | ParamMID {_paramMID :: Maybe Int}
-  deriving (Eq,Ord,Show,Read,Generic)
+    | BoostPropIX {_boostPropIX :: Maybe Int}
-instance ToJSON ItemParams where
+    deriving (Eq, Ord, Show, Read)
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON ItemParams
+
+
 data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON PreviousArcEffect  where
+
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON PreviousArcEffect 
+
 data GunBarrels
     = MultiBarrel
-        { _brlSpread     :: BarrelSpread
+        { _brlSpread :: BarrelSpread
-        , _brlNum        :: Int
+        , _brlNum :: Int
         , _brlInaccuracy :: Float
         }
     | RotBarrel
-        { _brlNum    :: Int
+        { _brlNum :: Int
         , _brlInaccuracy :: Float
         }
-    | SingleBarrel  {_brlInaccuracy :: Float}
+    | SingleBarrel {_brlInaccuracy :: Float}
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON GunBarrels where
+
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON GunBarrels
+
 data Nozzle = Nozzle
     { _nzPressure :: Float
     , _nzDir :: Float
     , _nzMaxWalkAngle :: Float
     , _nzCurrentWalkAngle :: Float
-    , _nzWalkSpeed  :: Float
+    , _nzWalkSpeed :: Float
-    , _nzLength     :: Float
+    , _nzLength :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Nozzle  where
+
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON Nozzle 
+
 data BarrelSpread
     = AlignedBarrels
-    | SpreadBarrels   {_spreadAngle :: Float}
+    | SpreadBarrels {_spreadAngle :: Float}
     | RotatingBarrels {_rotatingBarrelInaccuracy :: Float}
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON BarrelSpread where
+
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON BarrelSpread
+
 makeLenses ''BarrelSpread
 makeLenses ''ItemParams
 makeLenses ''Nozzle
 makeLenses ''GunBarrels
+deriveJSON defaultOptions ''ItemParams
+deriveJSON defaultOptions ''PreviousArcEffect
+deriveJSON defaultOptions ''GunBarrels
+deriveJSON defaultOptions ''Nozzle
+deriveJSON defaultOptions ''BarrelSpread

src/Dodge/Data/Item/Targeting.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Item.Targeting where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+
+data Targeting
+    = NoTargeting
+    | Targeting
+        { _tgPos :: Maybe Point2
+        , _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
+        , _tgDraw :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
+        , _tgID :: Maybe Int
+        , _tgActive :: Bool
+        }
+    deriving (Eq, Ord, Show, Read)
+
+data TargetUpdate
+    = NoTargetUpdate
+    | TargetLaserUpdate
+    | TargetRBPressUpdate
+    | TargetRBCreatureUpdate
+    | TargetCursorUpdate
+    deriving (Eq, Ord, Show, Read)
+
+data TargetDraw
+    = NoTargetDraw
+    | TargetDistanceDraw
+    | SimpleDrawTarget
+    | TargetRBCreatureDraw
+    deriving (Eq, Ord, Show, Read)
+
+makeLenses ''Targeting
+deriveJSON defaultOptions ''Targeting
+deriveJSON defaultOptions ''TargetUpdate
+deriveJSON defaultOptions ''TargetDraw

src/Dodge/Data/Item/Tweak.hs

@@ -10,7 +10,6 @@ data ItemTweaks
     = NoTweaks
     | Tweakable
         { _tweakParams :: IM.IntMap TweakParam
-        , _tweakSel    :: Int
         }
   deriving (Eq,Ord,Show,Read,Generic)
 instance ToJSON ItemTweaks where

src/Dodge/Data/Item/Use.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -8,16 +7,18 @@ module Dodge.Data.Item.Use (
     module Dodge.Data.Item.HeldUse,
     module Dodge.Data.Item.HeldScroll,
     module Dodge.Data.Item.UseDelay,
+    module Dodge.Data.Item.Use.Consumption,
 ) where
 
 import Control.Lens
 import Data.Aeson
+import Data.Aeson.TH
 import Dodge.Data.Hammer
 import Dodge.Data.Item.HeldScroll
 import Dodge.Data.Item.HeldUse
+import Dodge.Data.Item.Use.Consumption
 import Dodge.Data.Item.Use.Equipment
 import Dodge.Data.Item.UseDelay
-import GHC.Generics
 
 data ItemUse
     = RightUse
@@ -27,24 +28,26 @@ data ItemUse
         , _useHammer :: HammerPosition
         , _useAim :: AimParams
         , _heldScroll :: HeldScroll
+        , _heldConsumption :: HeldConsumption
         }
     | LeftUse
         { _lUse :: Luse
         , _useDelay :: UseDelay
         , _useHammer :: HammerPosition
         , _eqEq :: Equipment
+        , _leftConsumption :: LeftConsumption
         }
     | ConsumeUse
         { _cUse :: Cuse
+        , _useAmount :: ItAmount
         }
     | EquipUse
         { _eqEq :: Equipment
         }
-    | NoUse
+    | CraftUse
-    deriving (Eq, Ord, Show, Read, Generic)
+        {_useAmount :: ItAmount}
-instance ToJSON ItemUse where
+    deriving (Eq, Show, Read)
-    toEncoding = genericToEncoding defaultOptions
+
-instance FromJSON ItemUse
 data AimParams = AimParams
     { _aimWeight :: Int
     , _aimRange :: Float
@@ -53,28 +56,26 @@ data AimParams = AimParams
     , _aimHandlePos :: Float
     , _aimMuzPos :: Float
     }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON AimParams where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AimParams
 data AimStance
     = TwoHandTwist
     | TwoHandFlat
     | OneHand
     | LeaveHolstered
-    deriving (Eq, Show, Ord, Enum, Read, Generic)
+    deriving (Eq, Show, Ord, Enum, Read)
-instance ToJSON AimStance where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AimStance
 data ItZoom = ItZoom
     { _itZoomMax :: Float
     , _itZoomMin :: Float
     , _itZoomFac :: Float
     }
-    deriving (Eq, Ord, Show, Read, Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ItZoom where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItZoom
 makeLenses ''ItemUse
 makeLenses ''AimParams
 makeLenses ''ItZoom
+deriveJSON defaultOptions ''ItemUse
+deriveJSON defaultOptions ''AimParams
+deriveJSON defaultOptions ''AimStance
+deriveJSON defaultOptions ''ItZoom

src/Dodge/Data/Item/Use/Consumption.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Item.Use.Consumption where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.Ammo
+import Dodge.Data.LoadAction
+
+data HeldConsumption
+    = LoadableAmmo
+        { _laAmmoType :: AmmoType
+        , _laMax :: Int
+        , _laLoaded :: Int
+        , _laPrimed :: Bool
+        , _laCycle :: [LoadAction]
+        , _laProgress :: Maybe [LoadAction]
+        }
+    | NoConsumption
+    deriving (Eq, Show, Read)
+
+data LeftConsumption
+    = AutoRecharging
+        { _arLoaded :: Int
+        , _arMax :: Int
+        , _arTime :: Int
+        , _arProgress :: Int
+        }
+    | ChargeableAmmo
+        { _wpMaxCharge :: Int
+        , _wpCharge :: Int
+        }
+    deriving (Eq, Show, Read)
+
+newtype ItAmount = ItAmount {_getItAmount :: Int}
+    deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral)
+
+makeLenses ''HeldConsumption
+makeLenses ''LeftConsumption
+makeLenses ''ItAmount
+deriveJSON defaultOptions ''HeldConsumption
+deriveJSON defaultOptions ''LeftConsumption
+deriveJSON defaultOptions ''ItAmount

src/Dodge/Data/ItemAmount.hs

@@ -1,10 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Dodge.Data.ItemAmount where
-import GHC.Generics
-import Data.Aeson
-newtype IcAmount = IcAmount {_toInt :: Int}
-  deriving (Eq,Ord,Num,Integral,Real,Enum,Read,Show,Generic)
-instance ToJSON IcAmount  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON IcAmount

src/Dodge/Data/Machine.hs

@@ -1,61 +1,73 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Machine
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
-import GHC.Generics
+module Dodge.Data.Machine where
-import Data.Aeson
+
-import Dodge.Data.GenParams
-import Dodge.Data.Item
-import Sound.Data
-import Dodge.Data.Object
-import Dodge.Data.Damage
-import Dodge.Data.Sensor
-import Geometry.Data
 import Color
-import Dodge.Data.Material
+import Control.Lens
+import Data.Aeson
 import qualified Data.IntSet as IS
 import qualified Data.Map.Strict as M
-import Control.Lens
+import Dodge.Data.Damage
-data MachineDraw = MachineDrawMempty
+import Dodge.Data.GenParams
+import Dodge.Data.Item
+import Dodge.Data.Material
+import Dodge.Data.Object
+import Dodge.Data.Sensor
+import GHC.Generics
+import Geometry.Data
+import Sound.Data
+
+data MachineDraw
+    = MachineDrawMempty
     | MachineDrawTerminal
     | MachineDrawTurret
-    | MachineDrawDamageSensor Float (PaletteColor,DecorationShape)
+    | MachineDrawDamageSensor Float (PaletteColor, DecorationShape)
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON MachineDraw  where
+
+instance ToJSON MachineDraw where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON MachineDraw
+
 data Machine = Machine
-    { _mcID     :: Int
+    { _mcID :: Int
-    , _mcWallIDs    :: IS.IntSet
+    , _mcWallIDs :: IS.IntSet
-    , _mcDraw   :: MachineDraw --Machine -> SPic
+    , _mcDraw :: MachineDraw --Machine -> SPic
     , _mcMaterial :: Material
-    , _mcPos    :: Point2
+    , _mcPos :: Point2
-    , _mcDir    :: Float
+    , _mcDir :: Float
-    , _mcColor  :: Color
+    , _mcColor :: Color
-    , _mcHP     :: Int
+    , _mcHP :: Int
     , _mcSensor :: Sensor
     , _mcDamage :: [Damage]
-    , _mcType   :: MachineType
+    , _mcType :: MachineType
     , _mcMounts :: M.Map ObjectType Int
-    , _mcName   :: String
+    , _mcName :: String
-    , _mcCloseSound  :: Maybe SoundID
+    , _mcCloseSound :: Maybe SoundID
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON Machine  where
+
+instance ToJSON Machine where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Machine
+
 data MachineType
     = StaticMachine
     | Turret
-        { _tuWeapon     :: Item
+        { _tuWeapon :: Item
-        , _tuTurnSpeed  :: Float
+        , _tuTurnSpeed :: Float
-        , _tuFireTime   :: Int
+        , _tuFireTime :: Int
-        , _tuMCrID      :: Maybe Int
+        , _tuMCrID :: Maybe Int
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON MachineType  where
+
+instance ToJSON MachineType where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON MachineType
+
 makeLenses ''Machine
 makeLenses ''MachineType

src/Dodge/Data/RoomCluster.hs

@@ -1,8 +1,10 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.RoomCluster.Data where
+{-# LANGUAGE TemplateHaskell #-}
-import qualified Data.Set as S
+
+module Dodge.Data.RoomCluster where
+
 import Control.Lens
+import qualified Data.Set as S
 
 data ClusterStatus = ClusterStatus
     { _csName :: String
@@ -10,6 +12,6 @@ data ClusterStatus = ClusterStatus
     }
 
 data ClusterLink = OnwardCluster | SideCluster | LabelCluster Int
-  deriving (Ord,Eq,Show)
+    deriving (Ord, Eq, Show)
 
 makeLenses ''ClusterStatus

src/Dodge/Data/Sensor.hs

@@ -1,40 +1,40 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Dodge.Data.Sensor where
-import GHC.Generics
+
-import Data.Aeson
-import Dodge.Combine.Data
-import Dodge.Data.Damage.Type
 import Control.Lens
-data Sensor = NoSensor
+import Data.Aeson
+import Data.Aeson.TH
+import Dodge.Data.Item.Combine
+import Dodge.Data.Damage.Type
+
+data Sensor
+    = NoSensor
     | DamageSensor
         { _sensToggle :: Bool
         , _sensAmount :: Int
-        , _sensType   :: DamageType
+        , _sensType :: DamageType
         }
     | ProximitySensor
-        { _proxStatus   :: CloseToggle
+        { _proxStatus :: CloseToggle
         , _proxDist :: Float
         , _proxRequirement :: ProximityRequirement
         , _sensToggle :: Bool
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON Sensor  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Sensor 
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}
     | RequireEquipment {_proxReqEquipment :: ItemBaseType}
     | RequireImpossible
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON ProximityRequirement where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProximityRequirement
 data CloseToggle = NotClose | IsClose
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read)
-instance ToJSON CloseToggle  where
+
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CloseToggle 
 makeLenses ''Sensor
 makeLenses ''ProximityRequirement
+deriveJSON defaultOptions ''Sensor
+deriveJSON defaultOptions ''ProximityRequirement
+deriveJSON defaultOptions ''CloseToggle

src/Dodge/Data/Targeting.hs

@@ -1,39 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Data.Targeting where
-import GHC.Generics
-import Data.Aeson
-import Geometry.Data
-import Control.Lens
-data Targeting
-    = NoTargeting
-    | Targeting
-        { _tgPos    :: Maybe Point2
-        , _tgUpdate :: TargetUpdate --Item -> Creature -> World -> Targeting -> (World, Targeting)
-        , _tgDraw   :: TargetDraw --Item -> Creature -> Configuration -> World -> Picture
-        , _tgID     :: Maybe Int
-        , _tgActive :: Bool
-        }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Targeting where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Targeting
-data TargetUpdate = NoTargetUpdate
-    | TargetLaserUpdate
-    | TargetRBPressUpdate
-    | TargetRBCreatureUpdate
-    | TargetCursorUpdate
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON TargetUpdate  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON TargetUpdate 
-data TargetDraw = NoTargetDraw
-    | TargetDistanceDraw
-    | SimpleDrawTarget
-    | TargetRBCreatureDraw
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON TargetDraw  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON TargetDraw 
-makeLenses ''Targeting

src/Dodge/Data/Terminal.hs

@@ -1,112 +1,148 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Terminal
+{-# LANGUAGE TemplateHaskell #-}
-    where
+
-import GHC.Generics
+module Dodge.Data.Terminal where
-import Data.Aeson
+
-import Dodge.Data.WorldEffect
 import Color
 import Control.Lens
-import qualified Data.Text as T
+import Data.Aeson
 import qualified Data.Map.Strict as M
+import qualified Data.Text as T
+import Dodge.Data.WorldEffect
+import GHC.Generics
+
 data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON TerminalStatus  where
+
+instance ToJSON TerminalStatus where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalStatus
+
 data TerminalInput = TerminalInput
-    { _tiText   :: T.Text
+    { _tiText :: T.Text
-    , _tiFocus  :: Bool
+    , _tiFocus :: Bool
-    , _tiSel    :: (Int,Int)
+    , _tiSel :: (Int, Int)
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON TerminalInput  where
+
+instance ToJSON TerminalInput where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalInput
-data TerminalBootProgram = TerminalBootMempty
+
+data TerminalBootProgram
+    = TerminalBootMempty
     | TerminalBootLines [TerminalLine]
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON TerminalBootProgram  where
+
+instance ToJSON TerminalBootProgram where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalBootProgram
+
 data Terminal = Terminal
-    { _tmID         :: Int 
+    { _tmID :: Int
-    , _tmBootProgram    :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
+    , _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
-    , _tmButtonID   :: Int
+    , _tmButtonID :: Int
-    , _tmMachineID  :: Int
+    , _tmMachineID :: Int
-    , _tmName       :: String
+    , _tmName :: String
-    , _tmDisplayedLines :: [(String,Color)]
+    , _tmDisplayedLines :: [(String, Color)]
-    , _tmFutureLines    :: [TerminalLine]
+    , _tmFutureLines :: [TerminalLine]
-    , _tmMaxLines   :: Int
+    , _tmMaxLines :: Int
-    , _tmTitle  :: String
+    , _tmTitle :: String
-    , _tmInput  :: TerminalInput
+    , _tmInput :: TerminalInput
     , _tmScrollCommands :: [TerminalCommand]
-    , _tmWriteCommands  :: [TerminalCommand]
+    , _tmWriteCommands :: [TerminalCommand]
-    , _tmDeathEffect    :: TmWdWd -- Terminal -> World -> World
+    , _tmDeathEffect :: TmWdWd -- Terminal -> World -> World
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON Terminal  where
+
+instance ToJSON Terminal where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Terminal
+
 data TerminalLineString = TerminalLineConst String Color
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON TerminalLineString  where
+
+instance ToJSON TerminalLineString where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalLineString
-data TmTm = TmId
+
+data TmTm
+    = TmId
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON TmTm  where
+
+instance ToJSON TmTm where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TmTm
+
 data TerminalLine
     = TerminalLineDisplay
-        {_tlPause :: Int
+        { _tlPause :: Int
-        ,_tlString :: TerminalLineString -- World -> (String, Color)
+        , _tlString :: TerminalLineString -- World -> (String, Color)
         }
     | TerminalLineTerminalEffect
-        {_tlPause :: Int
+        { _tlPause :: Int
-        ,_tlTermEffect :: TmTm -- Terminal -> Terminal
+        , _tlTermEffect :: TmTm -- Terminal -> Terminal
         }
     | TerminalLineEffect
-        {_tlPause :: Int
+        { _tlPause :: Int
-        ,_tlEffect :: TmWdWd --Terminal -> World -> World
+        , _tlEffect :: TmWdWd --Terminal -> World -> World
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 instance ToJSON TerminalLine where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalLine
+
 data TerminalToggle = TerminalToggle
     { _ttTriggerID :: Int
     , _ttDeathEffect :: BlBl
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON TerminalToggle  where
+
+instance ToJSON TerminalToggle where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalToggle
-data BlBl = BlNegate
+
+data BlBl
+    = BlNegate
     | BlConst Bool
     | BlId
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON BlBl  where
+
+instance ToJSON BlBl where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON BlBl
+
 data EffectArguments
     = NoArguments {_cmdEffect :: [TerminalLine]}
     | OneArgument
-        {_argType :: String
+        { _argType :: String
-        ,_argList :: M.Map String [TerminalLine]
+        , _argList :: M.Map String [TerminalLine]
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 instance ToJSON EffectArguments where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON EffectArguments
-data TerminalCommandEffect = TerminalCommandArguments EffectArguments 
+
+data TerminalCommandEffect
+    = TerminalCommandArguments EffectArguments
     | TerminalCommandEffectDamageCoding
     | TerminalCommandEffectSensorParameter
     | TerminalCommandEffectLinkedObject
@@ -115,20 +151,26 @@ data TerminalCommandEffect = TerminalCommandArguments EffectArguments
     | TerminalCommandEffectCommands
     | TerminalCommandEffectSingleCommand WdWd [String]
     | TerminalCommandEffectNone
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON TerminalCommandEffect  where
+
+instance ToJSON TerminalCommandEffect where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalCommandEffect
+
 data TerminalCommand = TerminalCommand
     { _tcString :: String
-    , _tcAlias  :: [String]
+    , _tcAlias :: [String]
-    , _tcHelp   :: String
+    , _tcHelp :: String
     , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON TerminalCommand  where
+
+instance ToJSON TerminalCommand where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalCommand
+
 makeLenses ''TerminalInput
 makeLenses ''Terminal
 makeLenses ''TerminalLine

src/Dodge/Data/WorldEffect.hs

@@ -1,23 +1,30 @@
+{-# LANGUAGE DeriveGeneric #-}
 --{-# LANGUAGE DeriveGeneric #-}
 --{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-{-# LANGUAGE DeriveGeneric #-}
+
 module Dodge.Data.WorldEffect where
-import Dodge.Data.Item
+
 import Data.Aeson
-import GHC.Generics
 import Dodge.Data.CreatureEffect
-import Sound.Data
+import Dodge.Data.Item
-import Geometry.Data
 import Dodge.Data.SoundOrigin
-data ItCrWdWd = ItCrWdId
+import GHC.Generics
+import Geometry.Data
+import Sound.Data
+
+data ItCrWdWd
+    = ItCrWdId
     | ItCrWdItemEffect
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON ItCrWdWd  where
+
+instance ToJSON ItCrWdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON ItCrWdWd
 
-data WdWd = NoWorldEffect
+data WdWd
+    = NoWorldEffect
     | SetTrigger Bool Int
     | WorldEffects [WdWd]
     | SetLSCol Point3 Int
@@ -29,55 +36,81 @@ data WdWd = NoWorldEffect
     | WdWdNegateTrig Int
     | WdWdFromItixCrixWdWd Int Int ItCrWdWd
     | WdWdFromItCrixWdWd Item Int ItCrWdWd
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON WdWd  where
+
+instance ToJSON WdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdWd
-data WdP2 = WdP2Const Point2
+
+data WdP2
+    = WdP2Const Point2
     | WdYouPos
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON WdP2  where
+
+instance ToJSON WdP2 where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdP2
-data MdWdWd = MdWdId
+
+data MdWdWd
+    = MdWdId
     | MdTrigIf MdWdWd MdWdWd
     | MdSetLSCol Point3
     | MdFlickerUpdate
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON MdWdWd  where
+
+instance ToJSON MdWdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON MdWdWd
-data WdBl = WdTrig Int
+
+data WdBl
+    = WdTrig Int
     | WdBlDoorMoving Int
     | WdBlConst Bool
     | WdBlNegate WdBl
     | WdBlCrFilterNearPoint Float Point2 CrBl
     | WdBlBtOn Int
     | WdBlBtNotOff Int
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON WdBl  where
+
+instance ToJSON WdBl where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdBl
-data WdP2f = WdP2f0
+
+data WdP2f
+    = WdP2f0
     | WdP2fDoorPosition Int
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON WdP2f  where
+
+instance ToJSON WdP2f where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdP2f
-data DrWdWd = DrWdId
+
+data DrWdWd
+    = DrWdId
     | DrWdMakeDoorDebris
-    | DrWdMechanismStepwise Int [Int] [(Point2,Point2)]
+    | DrWdMechanismStepwise Int [Int] [(Point2, Point2)]
     | DoorMechanism
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON DrWdWd  where
+
+instance ToJSON DrWdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON DrWdWd
-data TmWdWd = TmWdId
+
+data TmWdWd
+    = TmWdId
     | TmWdWdDisconnectTerminal
     | TmWdWdfromWdWd WdWd
     | TmWdWdTermSound SoundID
     | TmWdWdDoDeathTriggers
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
-instance ToJSON TmWdWd  where
+
+instance ToJSON TmWdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TmWdWd

src/Dodge/Default.hs

@@ -23,6 +23,7 @@ import Dodge.Data
 import Dodge.SoundLogic
 import Geometry
 import Picture
+import Control.Lens
 
 defaultEquipment :: Item
 defaultEquipment = defaultItem
@@ -34,9 +35,8 @@ defaultItZoom :: ItZoom
 defaultItZoom = ItZoom 20 0.2 1
 defaultConsumable :: Item
 defaultConsumable = defaultItem
-    { _itConsumption = ItemItselfConsumable  {_icAmount = 1}
+    & itUse .~ ConsumeUse CDoNothing 1
-    , _itInvColor = blue
+    & itInvColor .~ blue
-    }
 
 defaultFlIt :: FloorItem
 defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}

src/Dodge/Default/Item.hs

@@ -1,32 +1,32 @@
-module Dodge.Default.Item
+module Dodge.Default.Item (
-    ( defaultItem
+    defaultItem,
-    ) where
+) where
-import Dodge.Data
+
-import Picture
+import Dodge.Data.Item
 import Geometry.Data
---import Shape
+import Picture
 
 defaultItem :: Item
-defaultItem = Item
+defaultItem =
-    { _itCurseStatus = Uncursed
+    Item
-    , _itType = defaultItemType
+        { _itCurseStatus = Uncursed
---    , _itEquipPict = \_ _ -> (,) emptySH blank
+        , _itType = defaultItemType
-    , _itEffect = NoItEffect
+        , --    , _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itID = Nothing
+          _itEffect = NoItEffect
-    , _itIsHeld = False
+        , _itID = Nothing
-    , _itInvColor = yellow
+        , _itIsHeld = False
-    , _itInvSize = 1
+        , _itInvColor = yellow
-    , _itPos = VoidItm
+        , _itInvSize = 1
-    , _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
+        , _itPos = VoidItm
-    , _itConsumption = NoConsumption
+        , _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
-    , _itUse = NoUse
+        , _itUse = CraftUse (ItAmount 1)
-    , _itAttachment = NoItAttachment
+        , _itParams = NoParams
-    , _itParams = NoParams
+        , _itTweaks = NoTweaks
-    , _itTweaks = NoTweaks
+        , _itScope = NoScope
-    , _itScope = NoScope
+        , _itTargeting = NoTargeting
-    , _itTargeting = NoTargeting
+        , _itValue = ItemValue 0 MundaneItem
-    , _itValue = ItemValue 0 MundaneItem
+        , _itAttachment = NoItAttachment
-    }
+        }
 
 defaultItemType :: ItemType
-defaultItemType = ItemType NOTDEFINED mempty NoStack
+defaultItemType = ItemType (error "defaultItemType not initialized") mempty NoStack

src/Dodge/Default/Weapon.hs

@@ -1,104 +1,123 @@
-module Dodge.Default.Weapon
+module Dodge.Default.Weapon where
-    where
+
-import Dodge.Data
+import Control.Lens
-import Dodge.Reloading.Action
+import qualified Data.Map.Strict as M
-import Dodge.Item.Weapon.Bullet
+import Dodge.Data.Ammo
-import Dodge.Default.Item
+import Dodge.Data.Hammer
+import Dodge.Data.Item
 import Dodge.Default.AimParams
---import Dodge.Item.Draw
+import Dodge.Default.Item
+import Dodge.Item.Weapon.Bullet
+import Dodge.Reloading.Action
 import Picture
 
-import qualified Data.Map.Strict as M
+defaultLeftLoadable :: LeftConsumption
-import Control.Lens
-
-defaultLeftLoadable :: ItemConsumption
 defaultLeftLoadable = AutoRecharging 10 10 100 100
 
-defaultLoadable :: ItemConsumption
+defaultLoadable :: HeldConsumption
-defaultLoadable = LoadableAmmo 
+defaultLoadable =
-    { _laAmmoType   = GenericAmmo
+    LoadableAmmo
-    , _laMax        = 15
+        { _laAmmoType = GenericAmmo
-    , _laLoaded     = 0
+        , _laMax = 15
-    , _laPrimed     = True
+        , _laLoaded = 0
-    , _laCycle      = [loadEject 10, loadInsert 10, loadPrime 10]
+        , _laPrimed = True
-    , _laProgress   = Nothing
+        , _laCycle = [loadEject 10, loadInsert 10, loadPrime 10]
-    }
+        , _laProgress = Nothing
-defaultBulletLoadable :: ItemConsumption
+        }
+
+defaultBulletLoadable :: HeldConsumption
 defaultBulletLoadable = defaultLoadable & laAmmoType .~ basicBullet
-defaultChargeable :: ItemConsumption
+
+defaultChargeable :: LeftConsumption
 defaultChargeable = ChargeableAmmo 100 100
 
 defaultrUse :: ItemUse
-defaultrUse = RightUse
+defaultrUse =
-    { _rUse = HeldDoNothing
+    RightUse
-    , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
+        { _rUse = HeldDoNothing
-    , _useMods = HeldModNothing
+        , _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
-    , _useHammer  = HammerUp
+        , _useMods = HeldModNothing
-    , _useAim = defaultAimParams
+        , _useHammer = HammerUp
-    , _heldScroll = HeldScrollDoNothing
+        , _useAim = defaultAimParams
-    }
+        , _heldScroll = HeldScrollDoNothing
+        , _heldConsumption = defaultLoadable
+        }
+
 defaultlUse :: ItemUse
-defaultlUse = LeftUse
+defaultlUse =
-    { _lUse = LDoNothing
+    LeftUse
-    , _useDelay = FixedRate {_rateMax = 8, _rateTime = 0}
+        { _lUse = LDoNothing
-    , _useHammer    = HammerUp
+        , _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
-    , _eqEq = defaultEquip
+        , _useHammer = HammerUp
-    }
+        , _eqEq = defaultEquip
+        , _leftConsumption = defaultLeftLoadable
+        }
+
 defaultEquip :: Equipment
-defaultEquip = Equipment
+defaultEquip =
-    { _eqSite = GoesOnSpecial
+    Equipment
-    , _eqUse = EDoNothing
+        { _eqSite = GoesOnSpecial
-    , _eqOnEquip = EDoNothing
+        , _eqUse = EDoNothing
-    , _eqOnRemove = EDoNothing
+        , _eqOnEquip = EDoNothing
-    , _eqParams = NoEquipParams
+        , _eqOnRemove = EDoNothing
-    , _eqViewDist = Nothing
+        , _eqParams = NoEquipParams
-    }
+        , _eqViewDist = Nothing
+        }
 
 luseInstantNoH :: Luse -> ItemUse
-luseInstantNoH f = defaultlUse 
+luseInstantNoH f =
-    & lUse .~ f
+    defaultlUse
-    & useDelay .~ NoDelay
+        & lUse .~ f
+        & useDelay .~ NoDelay
 
 -- TODO change this
 defaultLeftItem :: Item
-defaultLeftItem = defaultWeapon
+defaultLeftItem =
-    & itConsumption .~ defaultLeftLoadable
+    defaultWeapon
+        & itUse .~ defaultlUse
 
 defaultWeapon :: Item
-defaultWeapon = defaultItem 
+defaultWeapon =
-    & itConsumption .~ defaultLoadable
+    defaultItem
-    & itUse .~ defaultrUse
+        & itUse .~ defaultrUse
-    & itInvColor .~ white
+        & itInvColor .~ white
-    & itType . iyModules .~ M.fromList 
+        & itType . iyModules
-        [(ModTarget, EMPTYMODULE)
+            .~ M.fromList
-        ,(ModTeleport, EMPTYMODULE)
+                [ (ModTarget, EMPTYMODULE)
-        ]
+                , (ModTeleport, EMPTYMODULE)
+                ]
 
 defaultBulletWeapon :: Item
-defaultBulletWeapon = defaultWeapon 
+defaultBulletWeapon =
-    & itConsumption .~ defaultBulletLoadable 
+    defaultWeapon
-    & itUse . rUse .~ HeldUseAmmoParams -- useAmmoParams
+        & itUse . heldConsumption .~ defaultBulletLoadable
-    & itType . iyModules . at ModBullet ?~ EMPTYMODULE
+        & itUse . rUse .~ HeldUseAmmoParams -- useAmmoParams
-    & itType . iyModules . at ModBulletSpawn ?~ EMPTYMODULE
+        & itType . iyModules . at ModBullet ?~ EMPTYMODULE
-    & itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
+        & itType . iyModules . at ModBulletSpawn ?~ EMPTYMODULE
+        & itType . iyModules . at ModBulletTrajectory ?~ EMPTYMODULE
 
 defaultItemValue :: ItemValue
 defaultItemValue = ItemValue 10 MundaneItem
+
 defaultCraftable :: Item
-defaultCraftable = defaultItem 
+defaultCraftable =
-    { _itInvColor = green
+    defaultItem
-    }
+        { _itInvColor = green
+        }
+
 defBulletShooter :: ItemParams
-defBulletShooter = BulletShooter
+defBulletShooter =
-    { _muzVel = 1
+    BulletShooter
-    , _rifling = 0.8
+        { _muzVel = 1
-    , _bore = 2
+        , _rifling = 0.8
-    , _gunBarrels = SingleBarrel 0
+        , _bore = 2
-    , _recoil = 0
+        , _gunBarrels = SingleBarrel 0
-    , _torqueAfter = 0
+        , _recoil = 0
-    , _randomOffset = 0
+        , _torqueAfter = 0
-    }
+        , _randomOffset = 0
+        }
 
 defaultAutoGun :: Item
-defaultAutoGun = defaultBulletWeapon 
+defaultAutoGun =
-    & itUse . useAim . aimStance .~ TwoHandTwist
+    defaultBulletWeapon
+        & itUse . useAim . aimStance .~ TwoHandTwist

src/Dodge/Distortion.hs

@@ -1,5 +1,5 @@
 module Dodge.Distortion where
-import Dodge.Distortion.Data
+import Dodge.Data.Distortion
 
 updateDistortion :: Distortion -> Maybe Distortion
 updateDistortion  dt = case dt of

src/Dodge/Distortion/Data.hs

@@ -1,14 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
---{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StrictData #-}
-module Dodge.Distortion.Data where
-import GHC.Generics
-import Data.Aeson
-import Geometry
-
-data Distortion 
-    = RadialDistortion Point2 Point2 Point2 Float
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Distortion  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Distortion 

src/Dodge/Equipment.hs

@@ -1,10 +1,15 @@
 module Dodge.Equipment where
-import Dodge.Data
 
+--import Data.Strict.IntMap.Autogen.Merge.Strict
+import Data.IntMap.Merge.Strict
+import Dodge.Data
 import qualified IntMapHelp as IM
-import Data.Strict.IntMap.Autogen.Merge.Strict
---import Data.IntMap.Merge.Strict
 
 getCrEquipment :: Creature -> IM.IntMap Item
-getCrEquipment cr = merge dropMissing dropMissing (zipWithMatched $ \_ _ -> id)
+getCrEquipment cr =
-    (_crInvEquipped cr)  (_crInv cr) 
+    merge
+        dropMissing
+        dropMissing
+        (zipWithMatched $ \_ _ -> id)
+        (_crInvEquipped cr)
+        (_crInv cr)

src/Dodge/Event.hs

@@ -11,44 +11,47 @@ Nor could we handle continuous mouse button input.
 Instead we store button presses (in a Map) and deal with the combinations in
 the simulation step; in particular see 'updatePressedButtons'.
 -}
-module Dodge.Event
+module Dodge.Event (
-    ( handleEvent
+    handleEvent,
-    ) where
+) where
-import Dodge.Terminal
-import Dodge.Tweak
-import Dodge.HeldScroll
-import Dodge.InputFocus
-import Dodge.Combine
-import Dodge.Event.Keyboard
-import Dodge.Base
-import Dodge.Data
-import Dodge.PreloadData
-import Dodge.Inventory
-import Dodge.SoundLogic
-import qualified IntMapHelp           as IM
 
 import Control.Lens
-import Data.Maybe
 import qualified Data.Map.Strict as M
+import Data.Maybe
 import qualified Data.Set as S
 import qualified Data.Text as T
+import Dodge.Base
+import Dodge.Combine
+import Dodge.Data
+import Dodge.Event.Keyboard
+import Dodge.HeldScroll
+import Dodge.InputFocus
+import Dodge.Inventory
+import Dodge.PreloadData
+import Dodge.SoundLogic
+import Dodge.Terminal
+import Dodge.Tweak
+import qualified IntMapHelp as IM
 import SDL
 
 handleEvent :: Event -> Universe -> IO (Maybe Universe)
 handleEvent e = case eventPayload e of
-    TextInputEvent tev         -> return . Just . handleTextInput (textInputEventText tev)
+    TextInputEvent tev -> return . Just . handleTextInput (textInputEventText tev)
-    KeyboardEvent kev          -> handleKeyboardEvent kev
+    KeyboardEvent kev -> handleKeyboardEvent kev
-    MouseMotionEvent mmev      -> return . handleMouseMotionEvent mmev
+    MouseMotionEvent mmev -> return . handleMouseMotionEvent mmev
-    MouseButtonEvent mbev      -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
+    MouseButtonEvent mbev -> return . Just . over uvWorld (handleMouseButtonEvent mbev)
-    MouseWheelEvent mwev       -> return . handleMouseWheelEvent mwev
+    MouseWheelEvent mwev -> return . handleMouseWheelEvent mwev
     WindowSizeChangedEvent sev -> handleResizeEvent sev
-    WindowMovedEvent mev       -> return . handleWindowMoveEvent mev
+    WindowMovedEvent mev -> return . handleWindowMoveEvent mev
-    _                          -> return . Just
+    _ -> return . Just
 
 handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
-handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
+handleMouseMotionEvent mmev u =
-    (fromIntegral x - 0.5*_windowX cfig)
+    Just $
-    (0.5*_windowY cfig - fromIntegral y)
+        u & uvWorld . mousePos
+            .~ V2
+                (fromIntegral x - 0.5 * _windowX cfig)
+                (0.5 * _windowY cfig - fromIntegral y)
   where
     cfig = _uvConfig u
     P (V2 x y) = mouseMotionEventPos mmev
@@ -56,26 +59,30 @@ handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
 handleMouseButtonEvent :: MouseButtonEventData -> World -> World
 handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
     Released -> mouseButtons . at thebutton .~ Nothing
-    Pressed  -> mouseButtons . at thebutton ?~ False
+    Pressed -> mouseButtons . at thebutton ?~ False
   where
     thebutton = mouseButtonEventButton mbev
 
-{- | Sets window position in config. -}
+-- | Sets window position in config.
 handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
-handleWindowMoveEvent mev = Just
+handleWindowMoveEvent mev =
-    . (uvConfig . windowPosX .~ fromIntegral x)
+    Just
-    . (uvConfig . windowPosY .~ fromIntegral y)
+        . (uvConfig . windowPosX .~ fromIntegral x)
+        . (uvConfig . windowPosY .~ fromIntegral y)
   where
     P (V2 x y) = windowMovedEventPosition mev
 
-{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -}
+-- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.
+
 -- using a sideeffect here for the io change seems to work better, more testing
 -- later may be a good idea
 handleResizeEvent :: WindowSizeChangedEventData -> Universe -> IO (Maybe Universe)
-handleResizeEvent sev u = return . Just $ u
+handleResizeEvent sev u =
-    & uvConfig . windowX .~ fromIntegral x
+    return . Just $
-    & uvConfig . windowY .~ fromIntegral y
+        u
-    & uvIOEffects %~ sideEffectUpdatePreload divRes x y
+            & uvConfig . windowX .~ fromIntegral x
+            & uvConfig . windowY .~ fromIntegral y
+            & uvIOEffects %~ sideEffectUpdatePreload divRes x y
   where
     x = fromIntegral x'
     y = fromIntegral y'
@@ -91,44 +98,51 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
 wheelEvent :: Float -> World -> World
 wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
     DisplayCarte
-        | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
+        | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
         | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi)
     DisplayInventory NoSubInventory
-            -- functions that modify the inventory should be centralised so that
+        -- functions that modify the inventory should be centralised so that
-            -- this lock can be sensibly applied, perhaps
+        -- this lock can be sensibly applied, perhaps
         | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> w
-        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll,_rbOptions w) of
+        | rbDown -> case (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
-            (_,EquipOptions{}) -> scrollRBOption y w
+            (_, EquipOptions{}) -> scrollRBOption y w
-            (Nothing,_) -> closeObjScrollDir y w
+            (Nothing, _) -> closeObjScrollDir y w
-            (Just f,_)  -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
+            (Just f, _) -> w & cWorld . creatures . ix 0 . crInv . ix (crSel $ you w) %~ doHeldScroll f y (you w)
         | lbDown -> w & cWorld . cameraZoom +~ y
         | invKeyDown -> changeSwapInvSel yi w
-        | otherwise  -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
+        | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
-    DisplayInventory TweakInventory
+    DisplayInventory (TweakInventory mi)
         | invKeyDown && rbDown -> w & moveTweakSel yi
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
-        | rbDown ->     w & changeTweakParam yi
+        | rbDown -> w & changeTweakParam mi yi
-        | otherwise ->  w & moveTweakSel yi
+        | otherwise -> w & moveTweakSel yi
-    DisplayInventory (CombineInventory _) -> w
+    DisplayInventory CombineInventory{} ->
-        & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
+        w
+            & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
     DisplayInventory (DisplayTerminal tmid)
-        | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
+        | rbDown && inTermFocus w ->
-            & cWorld . terminals . ix tmid %~ updatetermsubsel
+            guardDisconnectedID tmid w $
-        | inTermFocus w -> w
+                w
-            & cWorld . terminals . ix tmid %~ updatetermsel
+                    & cWorld . terminals . ix tmid %~ updatetermsubsel
+        | inTermFocus w ->
+            w
+                & cWorld . terminals . ix tmid %~ updatetermsel
     _ -> w
   where
     updatetermsel tm = case tm ^? tmInput . tiSel of
-        Nothing -> tm & tmInput . tiSel .~ (0,0)
+        Nothing -> tm & tmInput . tiSel .~ (0, 0)
-        Just (i,_) -> let newi = (i - yi) `mod` length (scrollCommands tm)
+        Just (i, _) ->
-            in tm & setInput newi 0 w
+            let newi = (i - yi) `mod` length (scrollCommands tm)
+             in tm & setInput newi 0 w
     updatetermsubsel tm = case tm ^? tmInput . tiSel of
-        Nothing -> tm & tmInput . tiSel .~ (0,0)
+        Nothing -> tm & tmInput . tiSel .~ (0, 0)
-        Just (i,j) -> let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
+        Just (i, j) ->
-            in tm & setInput i newj w
+            let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
-    setInput i j w' tm = tm
+             in tm & setInput i newj w
-        & tmInput . tiSel .~ (i,j)
+    setInput i j w' tm =
-        & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
+        tm
+            & tmInput . tiSel .~ (i, j)
+            & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
       where
         tc = scrollCommands tm !! i
         arg = getArguments' tc tm w' !! j
@@ -144,37 +158,39 @@ getArguments' tc tm = ("" :) . getArguments tc tm
 
 getArguments :: TerminalCommand -> Terminal -> World -> [String]
 getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
-    NoArguments {} -> []
+    NoArguments{} -> []
     OneArgument _ m -> M.keys m
 
 scrollCommands :: Terminal -> [TerminalCommand]
 scrollCommands = (nullCommand :) . _tmScrollCommands
+
 nullCommand :: TerminalCommand
-nullCommand = TerminalCommand
+nullCommand =
-    { _tcString = ""
+    TerminalCommand
-    , _tcAlias  = []
+        { _tcString = ""
-    , _tcHelp   = ""
+        , _tcAlias = []
-    , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
+        , _tcHelp = ""
-    }
+        , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
+        }
 
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w
-    | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
+    | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))
     | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
     | otherwise = w
 
 moveTweakSel :: Int -> World -> World
 moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
-    Just l -> w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
+    Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
-                    . itTweaks . tweakSel %~ (`mod` length l) . subtract i
     _ -> w
-changeTweakParam :: Int -> World -> World
+
-changeTweakParam i w = w
+changeTweakParam :: Maybe Int -> Int -> World -> World
-    & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
+changeTweakParam mi i w = fromMaybe w $ do
-        ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
+    paramid <- mi
-        . doTweak (_tweakType params) x)
+    params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
-  where
+    let x = (_tweakVal params + i) `mod` _tweakMax params
-    tweaks = _itTweaks . fromJust $ yourItem w
+    return $
-    params = _tweakParams tweaks IM.! paramid
+        w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
-    x = (_tweakVal params + i) `mod` _tweakMax params
+            %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
-    paramid = _tweakSel tweaks
+                    . doTweak (_tweakType params) x
+               )

src/Dodge/Event/Keyboard.hs

@@ -93,7 +93,7 @@ handlePressedKeyInGame scode uv = case scode of
     ScancodeM       -> over uvWorld toggleMap uv
     ScancodeR       -> over uvWorld (crToggleReloading (you w)) uv
     ScancodeT       -> over uvWorld testEvent uv
-    ScancodeX       -> uv & uvWorld . cWorld . hud . hudElement %~ toggleTweakInv
+    ScancodeX       -> uv & uvWorld %~ toggleTweakInv
     ScancodeC       -> over uvWorld toggleCombineInv uv
     ScancodeI       -> uv & uvWorld . cWorld . hud . hudElement %~ toggleInspectInv
     _               -> uv
@@ -114,10 +114,13 @@ handlePressedKeyTerminal tmid scode w = case scode of
         Nothing -> t
         Just (t',_) -> t'
 
-toggleTweakInv :: HUDElement -> HUDElement
+toggleTweakInv :: World -> World
-toggleTweakInv he = case he of
+toggleTweakInv w = case w ^. cWorld . hud . hudElement of
-    DisplayInventory TweakInventory -> DisplayInventory NoSubInventory
+    DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
-    _                               -> DisplayInventory TweakInventory
+    _                               ->  w & thepointer .~ DisplayInventory (TweakInventory mi)
+  where
+    thepointer = cWorld . hud . hudElement
+    mi = 0 <$ (yourItem w >>= (^? itTweaks . tweakParams . ix 0))
 
 toggleInspectInv :: HUDElement -> HUDElement
 toggleInspectInv he = case he of

src/Dodge/FloorItem.hs

@@ -28,7 +28,7 @@ copyItemToFloorID pos it w = (,) flid $ w'
         _ -> id
     flid = IM.newKey $ _floorItems (_cWorld w)
     theflit = FlIt 
-        {_flIt = it & itConsumption . icAmount %~ const 1
+        {_flIt = it & itUse . useAmount %~ const 1
         ,_flItPos = p'
         ,_flItRot = rot
         ,_flItID = flid

src/Dodge/HeldScroll.hs

@@ -10,28 +10,16 @@ doHeldScroll :: HeldScroll -> Float -> Creature -> Item -> Item
 doHeldScroll hs = case hs of
     HeldScrollDoNothing -> const . const id
     HeldScrollZoom -> zoomLongGun
-    HeldScrollCharMode -> scrollCharMode
+    HeldScrollCharMode {} -> \ x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
-scrollCharMode
+    HeldScrollInt {} -> undefined
-    :: Float    -- ^ Amount scrolled
-    -> Creature
-    -> Item
-    -> Item
-scrollCharMode x _ 
-    | x > 0 = incCharMode
-    | x < 0 = decCharMode
-    | otherwise = id
 
-incCharMode 
+cycleSignum :: Float -> Seq a -> Seq a
-    :: Item 
+cycleSignum x
-    -> Item
+    | x > 0 = cycleL
-incCharMode = itAttachment . atCharMode %~ cycleL
+    | otherwise = cycleR
-  where
+
-    cycleL (x :<| xs) = xs |> x
+cycleL,cycleR :: Seq a -> Seq a
-    cycleL xs = xs
+cycleL (x :<| xs) = xs |> x
-decCharMode 
+cycleL xs = xs
-    :: Item 
+cycleR (xs :|> x) = x <| xs
-    -> Item
+cycleR xs = xs
-decCharMode = itAttachment . atCharMode %~ cycleR
-  where
-    cycleR (xs :|> x) = x <| xs
-    cycleR xs = xs

src/Dodge/HeldUse.hs

@@ -349,7 +349,7 @@ useMod hm = case hm of
       where
         p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
         a = argV (mouseWorldPos w -.- p)
-    moddelay x = itConsumption . laAmmoType . amBullet . buState .~ DelayedBullet x
+    moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
     modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr)
         & crPos %~ tweenPoints x (_crOldPos cr)
 
@@ -373,14 +373,14 @@ useHeld hu = case hu of
     HeldExplodeRemoteShell itid pjid -> const $ const $ explodeRemoteRocket itid pjid
 
 usePjCreation :: Item -> Creature -> World -> World
-usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it
+usePjCreation it = createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it
 
 usePjCreationX :: Int -> Item -> Creature -> World -> World
 usePjCreationX i it cr = foldr f 
-    (createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it cr)
+    (createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it cr)
     [1..i-1]
   where
-    f n = (. createProjectile (_amPjCreation (_laAmmoType (_itConsumption it))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
+    f n = (. createProjectile (_amPjCreation (_laAmmoType (_heldConsumption (_itUse it)))) it (cr & crDir +~ (2*pi*fromIntegral n / fromIntegral i)))
 
 overNozzles :: (Nozzle -> Item -> Creature -> World -> World)
     -> Item -> Creature -> World -> World
@@ -407,7 +407,7 @@ overNozzle eff it cr w nz =
     wa = min maxa $ max (negate maxa) (_nzCurrentWalkAngle nz + walkamount)
 
 useGasParams :: Nozzle -> Item -> Creature -> World -> World
-useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_itConsumption it))) 
+useGasParams nz it cr = createGas (_amCreateGas (_laAmmoType (_heldConsumption (_itUse it)))) 
     (_nzPressure nz) pos dir cr
   where 
     dir = _crDir cr
@@ -430,18 +430,18 @@ fireRemoteShell it cr w = set (cWorld . creatures . ix cid . crInv . ix j . itUs
 
 caneStickSoundChoice :: Item -> SoundID
 caneStickSoundChoice it
-    | _laLoaded (_itConsumption it) < 2 = tap3S 
+    | _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S 
     | otherwise = shotgunS
 
 bangStickSoundChoice :: Item -> SoundID
 bangStickSoundChoice it
-    | _laLoaded (_itConsumption it) < 2 = tap3S 
+    | _laLoaded (_heldConsumption (_itUse it)) < 2 = tap3S 
     | otherwise = shotgunS
 
 coneRandItemUpdate :: State StdGen (Item -> Item)
 coneRandItemUpdate = do
     wth <- state $ randomR (1,5)
-    return (itConsumption . laAmmoType . amBullet . buWidth .~ wth)
+    return (itUse . heldConsumption . laAmmoType . amBullet . buWidth .~ wth)
 coneRandItemParams :: State StdGen (ItemParams -> ItemParams)
 coneRandItemParams = do
     muzv <- state $ randomR (0.5,1)

src/Dodge/Inventory.hs

@@ -53,8 +53,8 @@ rmInvItem :: Int      -- ^ Creature id
     -> Int      -- ^ Inventory position
     -> World 
     -> World
-rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount of
+rmInvItem cid invid w = case w ^? cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount of
-    Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
+    Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itUse . useAmount %~ subtract 1
     _ -> w 
         & cWorld . creatures . ix cid . crInv %~ f
         & cWorld . creatures . ix cid . crInvSel %~ stopCrInvSelAction

src/Dodge/Inventory/Add.hs

@@ -15,7 +15,7 @@ putItemInInvID cid flid w = fromMaybe (Nothing,w) $ do
     return (Just i,w')
 
 putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
-putItemInInvSlot = IM.insertWith (const $ itConsumption . icAmount +~ 1)
+putItemInInvSlot = IM.insertWith (const $ itUse . useAmount +~ 1)
 
 {- | Pick up a specific item. -}
 tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int,World)

src/Dodge/Inventory/CheckSlots.hs

@@ -1,18 +1,19 @@
 module Dodge.Inventory.CheckSlots where
-import Dodge.Data
+
+import Control.Lens
+import Data.Maybe
 import Dodge.Base.You
+import Dodge.Data
 import Dodge.Inventory.ItemSpace
 import qualified IntMapHelp as IM
 
-import Data.Maybe
+{- | checks whether or not an item will fit in your inventory
---import Control.Lens
+ if so return Just the next slot to be used
-
+-}
--- | checks whether or not an item will fit in your inventory
--- if so return Just the next slot to be used
 checkInvSlotsYou :: Item -> World -> Maybe Int
 checkInvSlotsYou it w
-    | crNumFreeSlots ycr >= ceiling (_itInvSize it)
+    | crNumFreeSlots ycr >= ceiling (_itInvSize it) =
-                = Just $ findItemSlot it inv
+        Just $ findItemSlot it inv
     | otherwise = Nothing
   where
     ycr = you w
@@ -21,12 +22,12 @@ checkInvSlotsYou it w
 -- Assumes that the item is singular.
 -- Do not want to stack floor items for now
 findItemSlot :: Item -> IM.IntMap Item -> Int
-findItemSlot it inv = case _itConsumption it of
+findItemSlot it inv = case it ^? itUse . useAmount of
-    ItemItselfConsumable _ 
+    Just _ ->
-        -> fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
+        fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
-    _   -> newslot
+    _ -> newslot
   where
-    newslot = maybe 0 ((+1) . fst) $ IM.lookupMax inv
+    newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv
 
 crNumFreeSlots :: Creature -> Int
 crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)

src/Dodge/Inventory/ItemSpace.hs

@@ -8,6 +8,6 @@ import Control.Lens
 --import Data.Maybe
 
 itSlotsTaken :: Item -> Int
-itSlotsTaken it = case it ^? itConsumption . icAmount of
+itSlotsTaken it = case it ^? itUse . useAmount of
     Nothing -> moduleSizes it + ceiling (_itInvSize it)
     Just i  -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)

src/Dodge/ItEffect.hs

@@ -35,8 +35,8 @@ rewindEffect itm cr w
         & ptrWpCharge .~ 0
   where
     invid = _ipInvID $ _itPos itm
-    ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
+    ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
-    maxcharge = _wpMaxCharge . _itConsumption $ itm
+    maxcharge = itm ^?! itUse . leftConsumption . wpMaxCharge
     cw = _cWorld w 
         & rewindWorlds .~ []
 

src/Dodge/Item.hs

@@ -5,31 +5,24 @@ module Dodge.Item
     , module Dodge.Item.PassKey
     , module Dodge.Item.Craftable
     , itemFromBase
-    , baseToFamily
     ) where
 import Dodge.Data
 import Dodge.Item.Weapon
 import Dodge.Item.Equipment
 import Dodge.Item.Consumable
 import Dodge.Item.PassKey
-import Dodge.Item.Family
 import Dodge.Item.Craftable
 
 -- this is not ideal, should fold the itemtype into a stackable/unstackable type
 itemFromBase :: ItemBaseType -> Item
 itemFromBase ibt = case ibt of
-    NOTDEFINED -> error "cannot create undefined item"
-    EFFGUN _ -> undefined
-    AUTOEFFGUN _ -> undefined
-    -- Weapons
     HELD ht -> itemFromHeldType ht
     LEFT lt -> itemFromLeftType lt
     EQUIP et -> itemFromEquipType et
-    --GRENADE
+    Consumable et -> itemFromConsumableType et
-    --REMOTEBOMB
-    -- Utility items
     CRAFT cr -> makeTypeCraft cr
-    KEYCARD i -> keyCard i
+itemFromConsumableType :: ConsumableItemType -> Item
+itemFromConsumableType ct = case ct of
     MEDKIT i -> medkit i
 itemFromEquipType :: EquipItemType -> Item
 itemFromEquipType et = case et of
@@ -59,6 +52,7 @@ itemFromLeftType lt = case lt of
     -- Equipment
 itemFromHeldType :: HeldItemType -> Item
 itemFromHeldType ht = case ht of
+    KEYCARD i -> keyCard i
     TORCH       -> torch
     SHATTERGUN        -> shatterGun
     BANGSTICK i -> bangStick i
@@ -118,17 +112,3 @@ itemFromHeldType ht = case ht of
     HELDDETECTOR d -> clickDetector d
 
     FLATSHIELD      -> flatShield
-baseToFamily :: ItemBaseType -> ItemFamily
-baseToFamily ibt = case ibt of
-    NOTDEFINED -> undefined
-    EFFGUN _ -> undefined
-    AUTOEFFGUN _ -> undefined
-    HELD _ -> HeldFamily
-    LEFT _ -> LeftClickFamily
-    EQUIP _ -> EquipmentFamily
-    CRAFT _ -> CraftingFamily
-    
-    KEYCARD _   -> HeldFamily
-    
-    MEDKIT _    -> ConsumableFamily
-

src/Dodge/Item/Amount.hs

@@ -3,5 +3,5 @@ import Dodge.Data
 import Data.Maybe
 import Control.Lens
 
-itStackAmount :: Item -> IcAmount
+itStackAmount :: Item -> ItAmount
-itStackAmount it = fromMaybe 1 $ it ^? itConsumption . icAmount
+itStackAmount it = fromMaybe 1 $ it ^? itUse . useAmount

src/Dodge/Item/Attachment.hs

@@ -16,7 +16,7 @@ charFiringStratI
     :: [(Char, ChainEffect)] -- ^ Different firing effects for different characters
     -> ChainEffect
 charFiringStratI strats eff item cr w = case w ^? cWorld . creatures . ix cid . crInv 
-        . ix (crSel $ _creatures (_cWorld w) IM.! cid) . itAttachment . atCharMode of
+        . ix (crSel $ _creatures (_cWorld w) IM.! cid) . itUse . heldScroll . hsCharMode of
     Just (c :<| _) -> fromMaybe id (Prelude.lookup c strats) eff item cr w
     _ -> w
   where

src/Dodge/Item/Consumable.hs

@@ -14,12 +14,8 @@ import qualified IntMapHelp as IM
 
 medkit :: Int -> Item
 medkit i = defaultConsumable
-    { _itUse = ConsumeUse 
+    & itUse . cUse .~ CHeal i
-        {_cUse = CHeal i
+    & itType . iyBase .~ Consumable (MEDKIT i)
-        }
-    , _itID = Nothing
-    }
-    & itType . iyBase .~ MEDKIT i
 
 heal25 :: Int -> World -> Maybe World
 heal25 = heal 25

src/Dodge/Item/Craftable.hs

@@ -13,7 +13,7 @@ makeTypeCraftNum :: Int -> CraftType -> Item
 makeTypeCraftNum i ct = defaultCraftable
     & itInvSize .~ 0.5
     & itCurseStatus .~ Uncursed
-    & itConsumption .~ ItemItselfConsumable (IcAmount i)
+    & itUse . useAmount .~ fromIntegral i
     & itType . iyBase .~ CRAFT ct
 
 makeTypeCraft :: CraftType -> Item

src/Dodge/Item/Display.hs

@@ -1,105 +1,109 @@
-module Dodge.Item.Display 
+module Dodge.Item.Display (
-    ( itemDisplay
+    itemDisplay,
-    , selectedItemDisplay
+    selectedItemDisplay,
-    , itemString
+    itemString,
-    )
+) where
-    where
-import Dodge.Module
-import Dodge.Data
-import Dodge.Inventory.ItemSpace
-import Padding
-import LensHelp
 
 import Data.Maybe
 import Data.Sequence
+import Dodge.Data
+import Dodge.Inventory.ItemSpace
+import Dodge.Module
+import LensHelp
+import Padding
+
+itemDisplay :: Item -> [String]
+itemDisplay it = itemDisplayWithNumber (showConsumption (_itUse it)) it
+
+itemDisplayWithNumber :: String -> Item -> [String]
+itemDisplayWithNumber numberstr it =
+    Prelude.take (itSlotsTaken it) $
+        (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam) :
+        catMaybes [maybeWarmupStatus it, maybeRateStatus it]
+            ++ moduleStrings it
+            ++ repeat "*"
+  where
+    thename = itemBaseName it
+    theparam =
+        fromMaybe []
+            . listToMaybe
+            $ mapMaybe
+                ($ it)
+                [ maybeModeStatus
+                ]
 
 itemString :: Item -> String
 itemString = head . itemDisplay
 
 itemBaseName :: Item -> String
-itemBaseName it = case  _iyBase $ _itType it of
+itemBaseName it = case _iyBase $ _itType it of
     CRAFT str -> show str
-    HELD hit  -> case hit ^? xNum of
+    HELD hit -> case hit ^? xNum of
-        Just i -> takeWhile (/=' ') (show hit) ++ show i
+        Just i -> takeWhile (/= ' ') (show hit) ++ show i
         Nothing -> show hit
-    x -> show x
+    LEFT lit -> show lit
-
+    EQUIP eit -> show eit
-itemDisplayWithNumber :: String -> Item -> [String]
+    Consumable cit -> show cit
-itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $
-    (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam)
-    : catMaybes [maybeWarmupStatus it,maybeRateStatus it]
-    ++ moduleStrings it ++ repeat "*"
-  where 
-    thename  = itemBaseName it
-    theparam = fromMaybe []
-        . listToMaybe 
-        $ mapMaybe ($ it) 
-        [ maybeModeStatus
-        ]
 
 selectedItemDisplay :: Creature -> Item -> [String]
-selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itConsumption it)) it
+selectedItemDisplay cr it = itemDisplayWithNumber (showSelectedConsumption cr (_itUse it)) it
 
-{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
+-- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.
--- TODO make work on remote launchers
+showSelectedConsumption :: Creature -> ItemUse -> String
-itemDisplay :: Item -> [String]
+showSelectedConsumption cr iu = case iu of
-itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it
+    RightUse{} -> showReloadProgress cr (_heldConsumption iu)
+    LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
+    EquipUse{} -> ""
+    _ -> show $ iu ^?! useAmount . getItAmount -- partial, be careful if adding new data constructors
 
-showSelectedConsumption :: Creature -> ItemConsumption -> String
+showAutoRechargeProgress :: LeftConsumption -> String
-showSelectedConsumption cr ic = case ic of
+showAutoRechargeProgress lc = case lc of
-    LoadableAmmo{} -> showReloadProgress cr ic
+    AutoRecharging{}
-    AutoRecharging {} -> showAutoRechargeProgress ic
+        | _arLoaded lc < _arMax lc -> show (_arProgress lc) ++ "C" ++ show (_arLoaded lc)
-    ChargeableAmmo{} -> show $ _wpCharge ic
+        | otherwise -> show (_arLoaded lc)
-    ItemItselfConsumable{} -> show (_icAmount ic)
+    ChargeableAmmo{} -> show (_wpCharge lc)
-    NoConsumption -> ""
 
-showAutoRechargeProgress :: ItemConsumption -> String
+showReloadProgress :: Creature -> HeldConsumption -> String
-showAutoRechargeProgress ic
-    | l < _arMax ic = show (_arProgress ic) ++ "C" ++ show l
-    | otherwise    = show l
-  where
-    l = _arLoaded ic
-
-showReloadProgress :: Creature -> ItemConsumption -> String
 showReloadProgress cr ic = case cr ^?! crInvSel . iselAction of
     ReloadAction i la _ -> show i ++ showLoadActionType la (_laLoaded ic)
     _ -> case ic ^? laProgress . _Just . ix 0 of
         Nothing -> show $ _laLoaded ic
         Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
 
-showLoadProgress :: Int -> Maybe [LoadAction] -> String
+showConsumption :: ItemUse -> String
-showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
+showConsumption iu = case iu of
-    Just la -> show (_actionTime la) ++ showLoadActionType la x
+    RightUse{} -> showReloadProgress' (_heldConsumption iu)
-    Nothing -> show x
+    LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
+    EquipUse{} -> ""
+    _ -> show $ iu ^?! useAmount . getItAmount
 
-showConsumption :: ItemConsumption -> String
+showReloadProgress' :: HeldConsumption -> String
-showConsumption ic = case ic of
+showReloadProgress' ic = case ic ^? laProgress . _Just . ix 0 of
-    LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic)
+    Nothing -> show $ _laLoaded ic
-    AutoRecharging {} -> showAutoRechargeProgress ic
+    Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
-    ChargeableAmmo{} -> show $ _wpCharge ic
-    ItemItselfConsumable{} -> show (_icAmount ic)
-    NoConsumption -> ""
 
 showLoadActionType :: LoadAction -> Int -> String
 showLoadActionType la x = case la of
-    LoadEject   {}  -> "E"
+    LoadEject{} -> "E"
-    LoadInsert  {}  -> "L"
+    LoadInsert{} -> "L"
-    LoadAdd     {}  -> "A" ++ show x
+    LoadAdd{} -> "A" ++ show x
-    LoadPrime   {}  -> "P"
+    LoadPrime{} -> "P"
 
 maybeWarmupStatus :: Item -> Maybe String
 maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
     Nothing -> Nothing
-    Just m  -> case m - (_warmTime . _useDelay $ _itUse it) of
+    Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
-        x | x <= 1      -> Just "*WARM"
+        x
-          | otherwise   -> let n = show x
+            | x <= 1 -> Just "*WARM"
-                in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
+            | otherwise ->
+                let n = show x
+                 in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n
 
 maybeModeStatus :: Item -> Maybe String
-maybeModeStatus it = case it ^? itAttachment of
+maybeModeStatus it = case it ^? itUse . heldScroll of
-    Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
+    Just HeldScrollCharMode{_hsCharMode = (c :<| _)} -> Just [' ', c]
-    Just AttachMode {_atMode = i} -> Just $ show i
+    Just HeldScrollInt{_hsInt = i} -> Just $ show i
-    _   -> Nothing
+    _ -> Nothing
 
 maybeRateStatus :: Item -> Maybe String
 maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of

src/Dodge/Item/Draw/SPic.hs

@@ -16,15 +16,7 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) <> case it ^. i
     HELD ht -> heldItemSPic ht it
     LEFT lt -> leftItemSPic lt it
     EQUIP et -> equipItemSPic et it
-    NOTDEFINED      -> defSPic
+    Consumable {}  -> defSPic
-    EFFGUN _        -> defSPic
-    AUTOEFFGUN _    -> defSPic
-
---
---
-    KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
---    
-    MEDKIT _  -> defSPic
 
 equipItemSPic :: EquipItemType -> Item -> SPic
 equipItemSPic et _ = case et of
@@ -100,6 +92,7 @@ heldItemSPic ht it = case ht of
     DRONELAUNCHER   -> defSPic
     SHATTERGUN      -> shatterGunSPic
     HELDDETECTOR dt -> noPic (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
+    KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
 
 torchShape :: Shape
 torchShape =  colorSH blue 
@@ -132,7 +125,7 @@ baseStickShape :: Shape
 baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2
 
 stickClip :: Item -> Shape
-stickClip it = case it ^? itConsumption . laLoaded of
+stickClip it = case it ^? itUse . heldConsumption . laLoaded of
     Just x | x > 0 -> foldMap f [0..x-1] 
     _ -> mempty
   where
@@ -163,7 +156,7 @@ baseRifleShape :: Shape
 baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
 
 makeSingleClipAt :: Point3 -> Item -> Shape
-makeSingleClipAt p it = case it ^? itConsumption . laLoaded of
+makeSingleClipAt p it = case it ^? itUse . heldConsumption . laLoaded of
     Just 0 -> mempty
     _ -> translateSH p $ upperPrismPoly 1 $ square 1.5
 
@@ -172,7 +165,7 @@ makeTinClipAt r p it = translateSH p . overPosSH (rotate3z r) $ upperPrismPoly 1
     $ rectNSWE 0 (-y) (-2) 2
   where
     y = fromIntegral y' * 0.3
-    y' = fromMaybe 0 $ it ^? itConsumption . laLoaded
+    y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laLoaded
 
 volleyGunSPic :: Int -> Item -> SPic
 volleyGunSPic i it = noPic $ 
@@ -183,7 +176,7 @@ volleyGunSPic i it = noPic $
 
 
 caneClipX :: Int -> Item -> Shape
-caneClipX i it = case  it ^? itConsumption . laLoaded of
+caneClipX i it = case  it ^? itUse . heldConsumption . laLoaded of
     Just la | la > 0 -> foldMap 
             ( (\y -> translateSH (V3 5 0 3) . upperPrismPoly 1 $ map (+.+ V2 0 y) $ square 1.5)
             . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))) 
@@ -191,9 +184,9 @@ caneClipX i it = case  it ^? itConsumption . laLoaded of
     _ -> mempty
 
 miniGunXPictItem :: Int -> Item -> SPic
-miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _itConsumption it)
+miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _heldConsumption (_itUse it))
   where
-    spin = (-10) * _laLoaded (_itConsumption it) + _warmTime (_useDelay $ _itUse it)
+    spin = (-10) * _laLoaded (_heldConsumption (_itUse it)) + _warmTime (_useDelay $ _itUse it)
 
 miniGunXPict :: Int -> Int -> Int -> SPic
 miniGunXPict i spin _ = 
@@ -216,7 +209,7 @@ baseSonicShape :: Shape
 baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
 
 revolverClip :: Item -> Shape
-revolverClip it = case it ^? itConsumption . laLoaded of
+revolverClip it = case it ^? itUse . heldConsumption . laLoaded of
     Just al | al > 0 -> translateSH (V3 5 0 1) $ foldMap f [1..al]
     _ -> mempty
   where

src/Dodge/Item/Equipment.hs

@@ -1,109 +1,120 @@
-module Dodge.Item.Equipment 
+module Dodge.Item.Equipment (
-    ( module Dodge.Item.Equipment.Booster
+    module Dodge.Item.Equipment.Booster,
-    , torch
+    torch,
-    , magShield
+    magShield,
-    , powerLegs
+    powerLegs,
-    , flatShield
+    flatShield,
-    , wristInvisibility
+    wristInvisibility,
-    , wristArmour
+    wristArmour,
-    , hat
+    hat,
-    , brainHat
+    brainHat,
-    , frontArmour
+    frontArmour,
-    , headLamp
+    headLamp,
-    , headLamp1
+    headLamp1,
-    , jetPack
+    jetPack,
-    , speedLegs
+    speedLegs,
-    , jumpLegs
+    jumpLegs,
-    , flameShield
+    flameShield,
+    useMagShield,
+    setWristShieldPos,
+    createHeadLamp,
+    overCID,
+    onEquipWristShield,
+    onRemoveWristShield,
+    createShieldWall,
+    removeShieldWall,
+) where
 
-    , useMagShield
+import Data.Maybe
-    , setWristShieldPos
-    , createHeadLamp
-    , overCID
-    , onEquipWristShield
-    , onRemoveWristShield
-
-    , createShieldWall
-    , removeShieldWall
-    ) where
-import Dodge.Data
-import Dodge.Item.Draw
-import Dodge.Item.Equipment.Booster
-import Dodge.LightSource
-import Dodge.Default
-import Dodge.Creature.Test
 import Dodge.Creature.HandPos
+import Dodge.Creature.Test
+import Dodge.Data
+import Dodge.Default
+import Dodge.Item.Equipment.Booster
+import Dodge.Item.HeldOffset
+import Dodge.LightSource
 import Dodge.Wall
 import Dodge.Wall.ForceField
-import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
-
+import Picture
-import Data.Maybe
 
 magShield :: Item
-magShield = defaultEquipment
+magShield =
-    { _itID = Nothing
+    defaultEquipment
-    , _itAttachment = AttachMInt Nothing
+        { _itID = Nothing
-    }
+        , _itAttachment = AttachMInt Nothing
-    & itUse . eqEq . eqUse .~ EMagShield --useMagShield 
+        }
-    & itUse . eqEq . eqSite .~ GoesOnWrist
+        & itUse . eqEq . eqUse .~ EMagShield --useMagShield
-    & itType . iyBase .~ EQUIP MAGSHIELD
+        & itUse . eqEq . eqSite .~ GoesOnWrist
+        & itType . iyBase .~ EQUIP MAGSHIELD
+
 useMagShield :: Item -> Creature -> World -> World
 useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
   where
-    themagnet = Magnet
+    themagnet =
-        {_mgID = mgid
+        Magnet
-        ,_mgUpdate = MagnetUpdateTimer 1
+            { _mgID = mgid
-        ,_mgPos = _crPos cr
+            , _mgUpdate = MagnetUpdateTimer 1
-        ,_mgField = MagnetBuBuCurveAroundField 50 200
+            , _mgPos = _crPos cr
-        }
+            , _mgField = MagnetBuBuCurveAroundField 50 200
+            }
     mgid = case it ^? itAttachment . atMInt . _Just of
         Just mgid' -> mgid'
         Nothing -> IM.newKey $ _magnets (_cWorld w)
+
 --    it = _crInv cr IM.! invid
 
 flameShield :: Item
-flameShield = defaultEquipment
+flameShield =
-    { _itID = Nothing
+    defaultEquipment
-    } & itUse . eqEq . eqSite .~ GoesOnChest
+        { _itID = Nothing
-    & itType . iyBase .~ EQUIP FLAMESHIELD
+        }
-{- | Slows you down, blocks forward projectiles. -}
+        & itUse . eqEq . eqSite .~ GoesOnChest
+        & itType . iyBase .~ EQUIP FLAMESHIELD
+
+-- | Slows you down, blocks forward projectiles.
 frontArmour :: Item
-frontArmour = defaultEquipment
+frontArmour =
-    {  _itID = Nothing
+    defaultEquipment
-    }
+        { _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnChest
+        }
-    & itType . iyBase .~ EQUIP FRONTARMOUR
+        & itUse . eqEq . eqSite .~ GoesOnChest
+        & itType . iyBase .~ EQUIP FRONTARMOUR
 
 wristArmour :: Item
-wristArmour = defaultEquipment
+wristArmour =
-    {_itID = Nothing
+    defaultEquipment
-    }
+        { _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnWrist
+        }
-    & itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
+        & itUse . eqEq . eqSite .~ GoesOnWrist
-    & itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
+        & itUse . eqEq . eqOnEquip .~ EonWristShield --onEquipWristShield
-    & itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
+        & itUse . eqEq . eqUse .~ EWristShield --setWristShieldPos
-    & itType . iyBase .~ EQUIP WRISTARMOUR
+        & itUse . eqEq . eqOnRemove .~ EoffWristShield --onRemoveWristShield
+        & itType . iyBase .~ EQUIP WRISTARMOUR
 
 onEquipWristShield :: Item -> Creature -> World -> World
-onEquipWristShield itm cr w = w
+onEquipWristShield itm cr w =
-    & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
+    w
-    & cWorld . walls . at i ?~ forceField {_wlID = i}
+        & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
-    & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
+        & cWorld . walls . at i ?~ forceField{_wlID = i}
+        & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
   where
     i = IM.newKey (_walls (_cWorld w))
 
 onRemoveWristShield :: Item -> Creature -> World -> World
-onRemoveWristShield itm cr w = w
+onRemoveWristShield itm cr w =
-    & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
+    w
-    & deleteWallID i
+        & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ NoEquipParams
+        & deleteWallID i
   where
     i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
+
 setWristShieldPos :: Item -> Creature -> World -> World
-setWristShieldPos itm cr w = w
+setWristShieldPos itm cr w =
-    & moveWallIDUnsafe i wlline
+    w
+        & moveWallIDUnsafe i wlline
   where
     i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
     wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
@@ -112,51 +123,51 @@ setWristShieldPos itm cr w = w
     handtrans = case cr ^? crInvEquipped . ix invid of
         Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
         _ -> translatePointToRightHand
-    g | twists cr = (+.+.+ V3 (-5) 10 0)
+    g
-      | otherwise = id
+        | twists cr = (+.+.+ V3 (-5) 10 0)
+        | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
 torch :: Item
-torch = defaultWeapon
+torch =
-    & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect-- createHeldLight (const $ const id)
+    defaultWeapon
-    & itType . iyBase .~ HELD TORCH
+        & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
-    & itUse . useAim . aimHandlePos .~ 5
+        & itType . iyBase .~ HELD TORCH
-    & itUse . useAim . aimMuzPos .~ 10
+        & itUse . useAim . aimHandlePos .~ 5
+        & itUse . useAim . aimMuzPos .~ 10
 
 flatShield :: Item
-flatShield = defaultWeapon
+flatShield =
-    & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall --createShieldWall removeShieldWall
+    defaultWeapon
-        -- the above seems to work, but I am not sure why: it may break on edge
+        & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
-        -- cases
+        & itUse
-    & itUse .~ defaultrUse
+            .~ defaultrUse
-        { _rUse = HeldDoNothing
+                { _useAim =
-        , _useDelay = NoDelay
+                    AimParams
-        , _useMods = HeldModNothing
+                        { _aimWeight = 5
-        , _useHammer = HammerUp
+                        , _aimRange = 0
-        , _useAim = AimParams
+                        , _aimZoom = ItZoom 20 0.2 1
-            { _aimWeight = 5
+                        , _aimStance = TwoHandFlat
-            , _aimRange = 0
+                        , _aimHandlePos = 0
-            , _aimZoom = ItZoom 20 0.2 1
+                        , _aimMuzPos = 0
-            , _aimStance = TwoHandFlat
+                        }
-            , _aimHandlePos = 0
+                }
-            , _aimMuzPos = 0
+        & itInvSize .~ 3
-            }
+        & itType . iyBase .~ HELD FLATSHIELD
-        }
-    & itInvSize .~ 3
-    & itType . iyBase .~ HELD FLATSHIELD
 
 shieldWall :: Int -> Wall
-shieldWall crid = defaultWall
+shieldWall crid =
-    {_wlColor = yellow
+    defaultWall
-    ,_wlOpacity = SeeAbove
+        { _wlColor = yellow
-    ,_wlPathable = True
+        , _wlOpacity = SeeAbove
-    ,_wlWalkable = True
+        , _wlPathable = True
-    ,_wlFireThrough = True
+        , _wlWalkable = True
-    ,_wlReflect = True
+        , _wlFireThrough = True
-    ,_wlUnshadowed = False
+        , _wlReflect = True
-    ,_wlRotateTo = False
+        , _wlUnshadowed = False
-    ,_wlStructure = CreaturePart crid -- shieldWallDamage
+        , _wlRotateTo = False
-    }
+        , _wlStructure = CreaturePart crid -- shieldWallDamage
+        }
 
 -- TODO the reflection should be controled by the particle
 --shieldWallDamage :: Damage -> Wall -> Int -> World -> World
@@ -166,106 +177,131 @@ shieldWall crid = defaultWall
 --    _ -> w
 
 createShieldWall :: Item -> Creature -> World -> World
-createShieldWall it cr w = case _ieMID $ _itEffect it of
+createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
-    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
+    Nothing ->
-        in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
+        let (wlid, w') = createWall ((shieldWall crid){_wlLine = wlline, _wlID = wlid}) w
+         in w' & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID ?~ wlid
     Just wid -> moveWallID wid wlline w
   where
     invid = fromJust $ _itID it
     crid = _crID cr
-    wlline = (a,b)
+    wlline = (a, b)
     crdirv = unitVectorAtAngle $ _crDir cr
     crpos = _crPos cr
     rad = _crRad cr + 2
     a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
     b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
-    therot  | crIsAiming cr = vNormal
+    therot
-            | otherwise = rotateV (twoFlatHRot cr) . vNormal
+        | crIsAiming cr = vNormal
+        | otherwise = rotateV (twoFlatHRot cr) . vNormal
+
 removeShieldWall :: Item -> Creature -> World -> World
 removeShieldWall it cr w = case _ieMID $ _itEffect it of
     Nothing -> w
-    Just wid -> w & deleteWallID wid 
+    Just wid ->
-        & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
+        w & deleteWallID wid
+            & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
   where
     crid = _crID cr
     invid = fromJust (_itID it)
 
-effectOnOffHeld 
+effectOnOffHeld ::
-    :: ItInvEffect     -- ^ effect when held
+    -- | effect when held
-    -> ItInvEffect     -- ^ effect when not held
+    ItInvEffect ->
-    -> ItEffect
+    -- | effect when not held
-effectOnOffHeld f f' = ItInvEffectID
+    ItInvEffect ->
-    { _ieInv = OnOffHeldEffect f f'
+    ItEffect
-    , _ieMID = Nothing
+effectOnOffHeld f f' =
-    }
+    ItInvEffectID
+        { _ieInv = OnOffHeldEffect f f'
+        , _ieMID = Nothing
+        }
 
-{- | Increases speed, reduces friction, cannot only move forwards. -}
+-- | Increases speed, reduces friction, cannot only move forwards.
 jetPack :: Item
-jetPack = defaultEquipment
+jetPack =
-    { _itEffect = NoItEffect
+    defaultEquipment
-    , _itID = Nothing
+        { _itEffect = NoItEffect
-    }   & itUse . eqEq . eqSite .~ GoesOnBack
+        , _itID = Nothing
-    & itType . iyBase .~ EQUIP JETPACK
+        }
+        & itUse . eqEq . eqSite .~ GoesOnBack
+        & itType . iyBase .~ EQUIP JETPACK
 
 brainHat :: Item
-brainHat = defaultEquipment
+brainHat =
-    { _itEffect = NoItEffect
+    defaultEquipment
-    , _itID = Nothing
+        { _itEffect = NoItEffect
-    }
+        , _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnHead
+        }
-    & itType . iyBase .~ EQUIP BRAINHAT
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP BRAINHAT
+
 hat :: Item
-hat = defaultEquipment
+hat =
-    { _itEffect = NoItEffect
+    defaultEquipment
-    , _itID = Nothing
+        { _itEffect = NoItEffect
-    }
+        , _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnHead
+        }
-    & itType . iyBase .~ EQUIP HAT
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP HAT
 
 headLamp1 :: Item
-headLamp1 = defaultEquipment
+headLamp1 =
-    { _itEffect = NoItEffect
+    defaultEquipment
-    , _itID = Nothing
+        { _itEffect = NoItEffect
-    }
+        , _itID = Nothing
-    & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
+        }
-    & itUse . eqEq . eqSite .~ GoesOnHead
+        & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
-    & itType . iyBase .~ EQUIP HEADLAMP1
+        & itUse . eqEq . eqSite .~ GoesOnHead
-headLamp :: Item
+        & itType . iyBase .~ EQUIP HEADLAMP1
-headLamp = defaultEquipment
-    { _itEffect = NoItEffect
-    , _itID = Nothing
-    }
-    & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
-    & itUse . eqEq . eqSite .~ GoesOnHead
-    & itType . iyBase .~ EQUIP HEADLAMP
 
+headLamp :: Item
+headLamp =
+    defaultEquipment
+        { _itEffect = NoItEffect
+        , _itID = Nothing
+        }
+        & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
+        & itUse . eqEq . eqSite .~ GoesOnHead
+        & itType . iyBase .~ EQUIP HEADLAMP
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 
+createHeadLamp _ cr =
-    ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+    cWorld . tempLightSources
+        .:~ tlsTimeRadColPos
+            1
+            200
+            0.7
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
 
 powerLegs :: Item
-powerLegs = defaultEquipment
+powerLegs =
-    { _itEffect = NoItEffect
+    defaultEquipment
-    , _itID = Nothing
+        { _itEffect = NoItEffect
-    }
+        , _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnLegs
+        }
-    & itType . iyBase .~ EQUIP POWERLEGS
+        & itUse . eqEq . eqSite .~ GoesOnLegs
+        & itType . iyBase .~ EQUIP POWERLEGS
+
 speedLegs :: Item
-speedLegs = powerLegs
+speedLegs =
-    & itType . iyBase .~ EQUIP SPEEDLEGS
+    powerLegs
+        & itType . iyBase .~ EQUIP SPEEDLEGS
+
 jumpLegs :: Item
-jumpLegs = powerLegs
+jumpLegs =
-    & itType . iyBase .~ EQUIP JUMPLEGS
+    powerLegs
+        & itType . iyBase .~ EQUIP JUMPLEGS
 
 wristInvisibility :: Item
-wristInvisibility = defaultEquipment
+wristInvisibility =
-    { _itID = Nothing
+    defaultEquipment
-    }
+        { _itID = Nothing
-    & itUse . eqEq . eqSite .~ GoesOnWrist
+        }
-    & itUse . eqEq . eqOnEquip  .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
+        & itUse . eqEq . eqSite .~ GoesOnWrist
-    & itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
+        & itUse . eqEq . eqOnEquip .~ ECamouflage Invisible --overCID (crCamouflage .~ Invisible)
-    & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
+        & itUse . eqEq . eqOnRemove .~ ECamouflage FullyVisible --overCID (crCamouflage .~ FullyVisible)
+        & itType . iyBase .~ EQUIP (INVISIBILITYEQUIPMENT GoesOnWrist)
 
 overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
 overCID f _ cr = cWorld . creatures . ix (_crID cr) %~ f

src/Dodge/Item/Equipment/Booster.hs

@@ -1,84 +1,20 @@
-module Dodge.Item.Equipment.Booster
+module Dodge.Item.Equipment.Booster (
-    ( boosterGun
+    boosterGun,
-    , boostSelfL
+) where
-    ) where
+
-import Dodge.Data
+import Control.Lens
-import Dodge.Base
+import Dodge.Data.Item
 import Dodge.Default.Weapon
-import Geometry
-import qualified IntMapHelp as IM
 import Picture
 
-import Data.Maybe
-import Control.Lens
-{- | Move a creature towards the mouse position, with shockwave -}
-boostPoint
-    :: Float    -- ^ boost amount
-    -> Creature
-    -> World
-    -> Either Point2 Point2
-boostPoint x cr w = case mayp2 of
-    Nothing -> Right p1
-    Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
-  where
-    cpos = _crPos cr
-    r = 1.5 * _crRad cr
-    p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
-    mayp2 = bouncePoint (const True) 1 cpos p1 w
-
-boostSelfL
-    :: Float    -- ^ boost amount
-    -> Item
-    -> Creature
-    -> World
-    -> World
-boostSelfL x itm cr w = case boostPoint x cr w of
-    Left p  -> crEff p (itConsumption . laLoaded .~ 0)
-    Right p -> crEff p (itConsumption . laLoaded -~ 1)
-  where
-    invid = _ipInvID $ _itPos itm
-    cid = _crID cr
-    cpos = _crPos cr
-    r = _crRad cr
-    pid = fromMaybe (IM.newKey $ _props (_cWorld w)) 
-        (cr ^? crInv . ix invid . itAttachment . atInt)
-    crEff p ammoEff = addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
-        & cWorld . creatures . ix cid %~ 
-             (crPos .~ p) 
-            . (crInv . ix invid %~ 
-                ammoEff
-                . (itEffect . ieCounter .~ 1)
-                . (itAttachment .~ AttachInt pid)
-                )
-
-addBoostShockwave
-    :: Int
-    -> Point2
-    -> Point2
-    -> World
-    -> World
-addBoostShockwave pjid p v w = w & cWorld . linearShockwaves %~
-    IM.insertWith f pjid thePJ
-  where
-    thePJ = LinearShockwave
-        { _lwPos = p
-        , _lwID = pjid
-        , _lwPoints = [(p,v)]
-        , _lwTimer = maxT
-        }
-    f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
-
-maxT :: Int
-maxT = 20
-
 boosterGun :: Item
-boosterGun = defaultLeftItem 
+boosterGun =
-    { _itInvColor = cyan
+    defaultLeftItem
-    , _itConsumption = defaultChargeable
+        { _itInvColor = cyan
-    , _itUse = luseInstantNoH LBoost
+        , _itUse = luseInstantNoH LBoost
-    , _itEffect = resetAttachmentID
+        , _itEffect = resetAttachmentID
-    }
+        }
-    & itType . iyBase .~ LEFT BOOSTER
+        & itType . iyBase .~ LEFT BOOSTER
+
 resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect ResetAttachmentEffect 0
-

src/Dodge/Item/Location.hs

@@ -30,8 +30,8 @@ getItem itid w = do
         InInv cid invid -> w ^? cWorld . creatures . ix cid . crInv . ix invid
         VoidItm -> Nothing
 
-pointToItem :: Applicative f =>
+pointerToItem :: Applicative f =>
     ItemPos -> (Item -> f Item) -> World -> f World
-pointToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
+pointerToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
-pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
+pointerToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
-pointToItem _ = const pure
+pointerToItem _ = const pure

src/Dodge/Item/PassKey.hs

@@ -10,7 +10,7 @@ keyCard n = defaultEquipment
 --    , _itZoom = defaultItZoom
     , _itInvColor = aquamarine
     }
-    & itType . iyBase .~ KEYCARD n
+    & itType . iyBase .~ HELD (KEYCARD n)
 
 latchkey :: Int -> Item
 latchkey _ = defaultEquipment

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -55,8 +55,8 @@ sparkGun = teslaGun
     & itParams . arcSize .~ 10
 teslaGun :: Item
 teslaGun = defaultBatteryGun 
-    & itConsumption . laMax .~ 200
+    & itUse . heldConsumption . laMax .~ 200
-    & itConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
+    & itUse . heldConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
     & itDimension . dimRad .~ 9
     & itDimension . dimCenter .~ V3 4 0 0
     & itParams .~ teslaParams
@@ -91,7 +91,7 @@ lasCircle = lasGun
     & itType . iyBase .~ HELD LASCIRCLE
     & itParams . lasColor .~ orange
     & itParams . lasDamage .~ 2
-    & itConsumption . laMax .~ 10000
+    & itUse . heldConsumption . laMax .~ 10000
     & itUse . rUse .~ HeldLaser --shootLaser
     & itUse . useDelay .~ NoDelay
     & itUse . rUse .~ HeldCircleLaser --circleLaser
@@ -212,7 +212,7 @@ dualBeam = lasGun
 --        x' = _lasCycle $ _itParams it
 lasGun :: Item
 lasGun = defaultAutoBatteryGun 
-    & itConsumption .~ ( defaultLoadable
+    & itUse . heldConsumption .~ ( defaultLoadable
         & laMax .~ 200
         & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
         )
@@ -225,7 +225,6 @@ lasGun = defaultAutoBatteryGun
         }
     & itTweaks .~ Tweakable
         { _tweakParams = IM.fromList [(0,lasGunTweak)]
-        , _tweakSel = 0
         }
     & itDimension . dimRad .~ 10
     & itDimension . dimCenter .~ V3 15 0 0
@@ -247,14 +246,13 @@ lasGunTweak = TweakParam
     }
 tractorGun :: Item
 tractorGun = lasGun 
-    & itConsumption .~
+    & itUse . heldConsumption .~
         ( defaultLoadable
             & laMax .~ 10000
             & laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]   )
     & itParams .~ Attracting  {_attractionPower = 1}
     & itTweaks .~ Tweakable
         { _tweakParams = IM.fromList [(0,tractorGunTweak)]
-        , _tweakSel = 0
         }
     & itUse . rUse .~ HeldTractor --aTractorBeam
     & itUse . useDelay .~ NoDelay

src/Dodge/Item/Weapon/Bullet.hs

@@ -13,7 +13,7 @@ basicBullet = BulletAmmo
     }
 defaultBullet :: Bullet
 defaultBullet = Bullet
-    { _buState  = NormalBulletState
+    { _buDelayFraction  = 1
     , _buEffect = DestroyBullet
     , _buSpawn  = BulSpark
     , _buUpdateMod  = NoBulletUpdateMod

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -37,8 +37,8 @@ defaultBangCane =
         & itUse . useAim . aimHandlePos .~ 5
         & itUse . useAim . aimMuzPos .~ 15
         & itType . iyBase .~ error "undefined bangCane baseitemtype"
-        & itConsumption . laMax .~ 1
+        & itUse . heldConsumption . laMax .~ 1
-        & itConsumption . laCycle .~ [loadPartialInsert 10 1]
+        & itUse . heldConsumption . laCycle .~ [loadPartialInsert 10 1]
 
 volleyGun :: Int -> Item
 volleyGun i =
@@ -51,7 +51,7 @@ volleyGun i =
         & itUse . useAim . aimZoom .~ defaultItZoom{_itZoomFac = 1.5}
         & itUse . useAim . aimHandlePos .~ 5
         & itUse . useAim . aimMuzPos .~ 15
-        & itConsumption . laMax .~ i
+        & itUse . heldConsumption . laMax .~ i
         & itParams
             .~ BulletShooter
                 { _muzVel = 0.8
@@ -79,8 +79,8 @@ rifle =
     defaultBangCane
         & itUse . useAim . aimStance .~ TwoHandTwist
         & itType . iyBase .~ HELD RIFLE
-        & itConsumption . laMax .~ 1
+        & itUse . heldConsumption . laMax .~ 1
-        & itConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
+        & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
         & itUse . useAim . aimWeight .~ 6
         & itUse . useAim . aimRange .~ 1
         & itUse . useAim . aimZoom .~ defaultItZoom{_itZoomFac = 2}
@@ -91,8 +91,8 @@ repeater =
     rifle
         & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
         & itType . iyBase .~ HELD REPEATER
-        & itConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
+        & itUse . heldConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
-        & itConsumption . laMax .~ 15
+        & itUse . heldConsumption . laMax .~ 15
 
 autoRifle :: Item
 autoRifle =
@@ -120,21 +120,20 @@ miniGunUse i =
 miniGunX :: Int -> Item
 miniGunX i =
     defaultAutoGun
-        { _itConsumption =
+        { _itUse =
-            defaultBulletLoadable
-                { _laMax = 1500
-                , _laLoaded = 1500
-                }
-                & laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
-        , _itUse =
             miniGunUse i
                 & useDelay .~ WarmUpNoDelay{_warmTime = 0, _warmMax = 100}
                 & useAim . aimWeight .~ 6
                 & useAim . aimRange .~ 1
                 & useAim . aimStance .~ TwoHandTwist
                 & useAim . aimZoom .~ defaultItZoom{_itZoomFac = 1.5}
-        , --    , _itFloorPict = miniGunPictItem
+                & heldConsumption
-          _itParams =
+                    .~ defaultBulletLoadable
+                        { _laMax = 1500
+                        , _laLoaded = 1500
+                        }
+                & heldConsumption . laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
+        , _itParams =
             BulletShooter
                 { _muzVel = 1
                 , _rifling = 0.9

src/Dodge/Item/Weapon/BulletGun/Rod.hs

@@ -30,8 +30,8 @@ bangRod = defaultBulletWeapon
     & itUse . useMods .~ BangRodMod
     & itDimension . dimRad .~ 12
     & itDimension . dimCenter .~ V3 5 0 0
-    & itConsumption . laMax .~ 1
+    & itUse . heldConsumption . laMax .~ 1
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
+    & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
     & itType . iyBase .~ HELD BANGROD
     & itUse . useAim . aimWeight .~ 8
     & itUse . useAim . aimRange .~ 1
@@ -39,7 +39,7 @@ bangRod = defaultBulletWeapon
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 30
-    & itConsumption . laAmmoType .~ hvBullet
+    & itUse . heldConsumption . laAmmoType .~ hvBullet
 elephantGun :: Item
 elephantGun = bangRod
     & itType . iyBase .~ HELD ELEPHANTGUN
@@ -51,7 +51,7 @@ elephantGun = bangRod
 amr :: Item
 amr = elephantGun
     & itType . iyBase .~ HELD AMR
-    & itConsumption . laMax .~ 15
+    & itUse . heldConsumption . laMax .~ 15
 
 autoAmr :: Item
 autoAmr = amr
@@ -77,7 +77,7 @@ machineGun = bangRod
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
     & itUse . useDelay .~ VariableRate {_rateMax = 25, _rateMaxMax = 24, _rateMinMax = 7, _rateTime = 0}
-    & itConsumption . laMax .~ 100
+    & itUse . heldConsumption . laMax .~ 100
-    & itConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
+    & itUse . heldConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
     & itInvSize .~ 3
     & itParams. torqueAfter .~ 0.2 -- not sure if this is necessary?

src/Dodge/Item/Weapon/BulletGun/Stick.hs

@@ -36,15 +36,15 @@ bangStick i = defaultBulletWeapon
     & itType . iyBase .~ HELD (BANGSTICK i)
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 10
-    & itConsumption . laMax .~ i
+    & itUse . heldConsumption . laMax .~ i
-    & itConsumption . laCycle .~ [loadPartialInsert 10 1]
+    & itUse . heldConsumption . laCycle .~ [loadPartialInsert 10 1]
 
 baseStickSpread :: Float
 baseStickSpread = 0.2
 
 revolver :: Item
 revolver = pistol
-    & itConsumption .~ 
+    & itUse . heldConsumption .~ 
         (defaultBulletLoadable
             & laMax .~ 6
             & laCycle .~ [loadPartialInsert 10 1] )
@@ -52,7 +52,7 @@ revolver = pistol
 
 pistol :: Item
 pistol = bangStick 1
-    & itConsumption .~ ( defaultBulletLoadable
+    & itUse . heldConsumption .~ ( defaultBulletLoadable
         & laMax .~ 15
         & laCycle .~ [loadEject 5, loadInsert 5 , loadPrime 5] )
     & itUse . useDelay . rateMax .~ 6
@@ -89,5 +89,5 @@ revolverX :: Int -> Item
 revolverX i = revolver
     & itUse . useDelay . rateMax .~ 8
     & itUse . useMods .~ RevolverXMod
-    & itConsumption . laMax .~ i * 6
+    & itUse . heldConsumption . laMax .~ i * 6
     & itType . iyBase .~ HELD (REVOLVERX i)

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -82,13 +82,13 @@ bangCone = defaultBulletWeapon
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 15
     & itType . iyBase .~ HELD BANGCONE
-    & itConsumption . laMax .~ 5
+    & itUse . heldConsumption . laMax .~ 5
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
+    & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
 
 blunderbuss :: Item
 blunderbuss = bangCone
-    & itConsumption . laMax .~ 25
+    & itUse . heldConsumption . laMax .~ 25
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
+    & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itUse . useAim . aimWeight .~ 6
     & itUse . useAim . aimHandlePos .~ 5
@@ -97,8 +97,8 @@ blunderbuss = bangCone
 grapeCannon :: Int -> Item
 grapeCannon i = blunderbuss
     & itType . iyBase .~ HELD (GRAPECANNON i)
-    & itConsumption . laMax .~ 25 + 25 * i
+    & itUse . heldConsumption . laMax .~ 25 + 25 * i
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert (30 + i * 10) , loadPrime 5]
+    & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert (30 + i * 10) , loadPrime 5]
     & itParams . recoil .~ (150 + fromIntegral i * 50)
     & itParams . torqueAfter .~ (0.1 + 0.2 * fromIntegral i)
     & itParams . randomOffset .~ (12 + 4 * fromIntegral i)

src/Dodge/Item/Weapon/Drone.hs

@@ -16,8 +16,8 @@ droneLauncher = defaultWeapon
     & itUse . useAim . aimWeight .~ 8
     & itUse . useAim . aimRange .~ 0.5
     & itUse . useAim . aimStance .~ TwoHandTwist
-    & itConsumption . laAmmoType .~ DroneAmmo { _amString = "LASDRONE" }
+    & itUse . heldConsumption . laAmmoType .~ DroneAmmo { _amString = "LASDRONE" }
-    & itConsumption . laMax .~ 2
+    & itUse . heldConsumption . laMax .~ 2
     & itType . iyBase .~ HELD DRONELAUNCHER
 
 lasDronesPic :: Item -> SPic

src/Dodge/Item/Weapon/FractionLoaded.hs

@@ -6,17 +6,17 @@ import Dodge.Data
 
 ---- this shouldn't really be used
 loadedAmmo :: Item -> Int
-loadedAmmo = _laLoaded . _itConsumption
+loadedAmmo = _laLoaded . _heldConsumption . _itUse
 --    | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it)
 --    | otherwise = 0
 
 fractionLoadedAmmo :: Item -> Float
 fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it)
   where
-    itmaxammo = _laMax . _itConsumption
+    itmaxammo = _laMax . _heldConsumption . _itUse
 
 fractionLoadedAmmo2 :: Item -> Float
 fractionLoadedAmmo2 it = 1 - 
     (1 - fromIntegral (loadedAmmo it) / fromIntegral (itMaxAmmo it))**2
   where
-    itMaxAmmo = _laMax . _itConsumption
+    itMaxAmmo = _laMax . _heldConsumption . _itUse

src/Dodge/Item/Weapon/Launcher.hs

@@ -1,110 +1,122 @@
-module Dodge.Item.Weapon.Launcher
+module Dodge.Item.Weapon.Launcher (
-    ( launcher
+    launcher,
-    , launcherX
+    launcherX,
-    , remoteLauncher
+    remoteLauncher,
-    , fireTrackingShell
+    fireTrackingShell,
-    , explodeRemoteRocket
+    explodeRemoteRocket,
-    ) where
+) where
+
+import Control.Lens
 import Dodge.Data
-import Dodge.Projectile.Create
-import Dodge.Payload
-import Dodge.Reloading.Action
 import Dodge.Default.Weapon
 import Dodge.Item.Location
+import Dodge.Payload
+import Dodge.Projectile.Create
+import Dodge.Reloading.Action
 import Geometry
 import qualified IntMapHelp as IM
 
-import Control.Lens
-
 launcher :: Item
-launcher = defaultWeapon 
+launcher =
-    { _itConsumption = defaultLoadable
+    defaultWeapon
-        & laAmmoType .~ ProjectileAmmo 
+        { _itParams =
-            { _amPayload = ExplosionPayload
+            ShellLauncher
-            , _amString = "EXPLOSIVE SHELL"
+                { _shellSpinDrag = 1
-            , _amPjDraw = DrawShell
+                , _shellSpinAmount = 2
-            , _amPjCreation = CreateShell
+                , _shellThrustDelay = 20
-            }
+                }
-        & laMax .~ 1
+        , _itTweaks =
-        & laLoaded .~ 1
+            Tweakable
-        & laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
+                { _tweakParams = basicAmPjMoves
-    , _itParams = ShellLauncher
+                }
-        { _shellSpinDrag        = 1
+        , _itInvSize = 3
-        , _shellSpinAmount      = 2
-        , _shellThrustDelay     = 20
         }
-    , _itTweaks = Tweakable
+        & itDimension . dimRad .~ 9
-        { _tweakSel = 0
+        & itDimension . dimCenter .~ V3 10 0 0
-        , _tweakParams = basicAmPjMoves
+        & itUse . useDelay . rateMax .~ 20
-        }
+        & itUse . rUse .~ HeldPJCreation --usePjCreation
-    , _itInvSize = 3
+        & itUse . useMods .~ LauncherMod
-    }
+        & itUse . useAim . aimWeight .~ 8
-    & itDimension . dimRad .~ 9
+        & itUse . useAim . aimRange .~ 0.5
-    & itDimension . dimCenter .~ V3 10 0 0
+        & itUse . useAim . aimStance .~ TwoHandTwist
-    & itUse . useDelay . rateMax .~ 20 
+        & itUse . useAim . aimHandlePos .~ 5
-    & itUse . rUse .~ HeldPJCreation --usePjCreation
+        & itUse . useAim . aimMuzPos .~ 20
-    & itUse . useMods .~ LauncherMod
+        & itUse . heldConsumption . laAmmoType .~ ProjectileAmmo
-    & itUse . useAim . aimWeight .~ 8
+                        { _amPayload = ExplosionPayload
-    & itUse . useAim . aimRange .~ 0.5
+                        , _amString = "EXPLOSIVE SHELL"
-    & itUse . useAim . aimStance .~ TwoHandTwist
+                        , _amPjDraw = DrawShell
-    & itUse . useAim . aimHandlePos .~ 5
+                        , _amPjCreation = CreateShell
-    & itUse . useAim . aimMuzPos .~ 20
+                        }
-    & itType . iyBase .~ HELD LAUNCHER
+        & itUse . heldConsumption . laMax .~ 1
-    & itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
+        & itUse . heldConsumption . laLoaded .~ 1
+        & itUse . heldConsumption . laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
+        & itType . iyBase .~ HELD LAUNCHER
+        & itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
 
 launcherX :: Int -> Item
-launcherX i = launcher
+launcherX i =
-    & itType . iyBase .~ HELD (LAUNCHERX i)
+    launcher
-    & itConsumption . laMax .~ i
+        & itType . iyBase .~ HELD (LAUNCHERX i)
-    & itConsumption . laLoaded  .~ i
+        & itUse . heldConsumption . laMax .~ i
-    & itUse . rUse .~ HeldPJCreationX i
+        & itUse . heldConsumption . laLoaded .~ i
-    & itUse . useMods .~ LauncherXMod i
+        & itUse . rUse .~ HeldPJCreationX i
+        & itUse . useMods .~ LauncherXMod i
 
 basicAmPjMoves :: IM.IntMap TweakParam
-basicAmPjMoves = IM.fromList . zip [0..] $
+basicAmPjMoves =
-    [spinDrag
+    IM.fromList . zip [0 ..] $
-    ,spinStart
+        [ spinDrag
-    ,thrustParam
+        , spinStart
-    ]
+        , thrustParam
+        ]
+
 spinDrag :: TweakParam
-spinDrag = TweakParam
+spinDrag =
-    { _tweakType   = TweakSpinDrag
+    TweakParam
-    , _tweakVal  = 1
+        { _tweakType = TweakSpinDrag
-    , _tweakMax = 5
+        , _tweakVal = 1
-    }
+        , _tweakMax = 5
+        }
+
 spinStart :: TweakParam
-spinStart = TweakParam
+spinStart =
-    { _tweakType = TweakSpinAmount
+    TweakParam
-    , _tweakVal = 2
+        { _tweakType = TweakSpinAmount
-    , _tweakMax = 5
+        , _tweakVal = 2
-    }
+        , _tweakMax = 5
+        }
+
 thrustParam :: TweakParam
-thrustParam = TweakParam
+thrustParam =
-    { _tweakType = TweakThrustDelay
+    TweakParam
-    , _tweakVal = 1
+        { _tweakType = TweakThrustDelay
-    , _tweakMax = 5
+        , _tweakVal = 1
-    }
+        , _tweakMax = 5
+        }
 
 remoteLauncher :: Item
-remoteLauncher = launcher 
+remoteLauncher =
-    & itType . iyBase .~ HELD REMOTELAUNCHER
+    launcher
-    & itUse . rUse .~ HeldFireRemoteShell --fireRemoteShell
+        & itType . iyBase .~ HELD REMOTELAUNCHER
-    & itScope .~ RemoteScope (V2 0 0) 1 True
+        & itUse . rUse .~ HeldFireRemoteShell --fireRemoteShell
-    & itConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
+        & itScope .~ RemoteScope (V2 0 0) 1 True
+        & itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
+
 -- TODO consider allowing tweaking rocket speed
 
-explodeRemoteRocket 
+explodeRemoteRocket ::
-    :: Int  -- ^ Item id
+    -- | Item id
-    -> Int  -- ^ Projectile id
+    Int ->
-    -> World 
+    -- | Projectile id
-    -> World
+    Int ->
-explodeRemoteRocket itid pjid w = w
+    World ->
-    & cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
+    World
-    & cWorld . projectiles . ix pjid . prjDraw   .~ DrawBlankProjectile
+explodeRemoteRocket itid pjid w =
-    & itPoint . itUse . rUse     .~ HeldDoNothing
+    w
-    & usePayload (_prjPayload thepj) (_prjPos thepj)
+        & cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid]
+        & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
+        & itPoint . itUse . rUse .~ HeldDoNothing
+        & usePayload (_prjPayload thepj) (_prjPos thepj)
   where
-    itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
+    itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
     thepj = _projectiles (_cWorld w) IM.! pjid
-
-

src/Dodge/Item/Weapon/Remote.hs

@@ -1,5 +1,5 @@
 module Dodge.Item.Weapon.Remote
-    ( pointToItem
+    ( pointerToItem
     , setRemoteScope
     , setRemoteBombScope
     ) where

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -1,95 +1,107 @@
-module Dodge.Item.Weapon.SprayGuns
+module Dodge.Item.Weapon.SprayGuns (
-    ( poisonSprayer
+    poisonSprayer,
-    , flameSpitter
+    flameSpitter,
-    , blowTorch
+    blowTorch,
-    , flameThrower
+    flameThrower,
-    , flameTorrent
+    flameTorrent,
-    , flameWall
+    flameWall,
-    ) where
+) where
+
 import Dodge.Data
-import Dodge.Reloading.Action
 import Dodge.Default
+import Dodge.Reloading.Action
 import Geometry
 import LensHelp
 
 poisonSprayer :: Item
-poisonSprayer = flameThrower 
+poisonSprayer =
-    & itType . iyBase .~ HELD POISONSPRAYER
+    flameThrower
-    & itConsumption . laAmmoType .~ GasAmmo
+        & itType . iyBase .~ HELD POISONSPRAYER
-        { _amString = "POISONGAS"
+        & itUse . heldConsumption . laAmmoType
-        , _amCreateGas = CreatePoisonGas --aGasCloud
+            .~ GasAmmo
-        }
+                { _amString = "POISONGAS"
-    & itUse . useMods .~ PoisonSprayerMod
+                , _amCreateGas = CreatePoisonGas --aGasCloud
+                }
+        & itUse . useMods .~ PoisonSprayerMod
 
 flameSpitter :: Item
-flameSpitter = flameThrower
+flameSpitter =
-    & itType . iyBase .~ HELD FLAMESPITTER
+    flameThrower
-    & itConsumption . laMax .~ 10
+        & itType . iyBase .~ HELD FLAMESPITTER
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
+        & itUse . heldConsumption . laMax .~ 10
-    & itParams . sprayNozzles . ix 0 . nzPressure .~ 4
+        & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 10, loadPrime 20]
-    & itUse . useAim . aimStance .~ OneHand
+        & itParams . sprayNozzles . ix 0 . nzPressure .~ 4
-    & itUse . useDelay .~ FixedRate {_rateMax =12,_rateTime = 0}
+        & itUse . useAim . aimStance .~ OneHand
-    & itUse . useMods .~ FlameSpitterMod
+        & itUse . useDelay .~ FixedRate{_rateMax = 12, _rateTime = 0}
+        & itUse . useMods .~ FlameSpitterMod
 
 flameTorrent :: Item
-flameTorrent = flameThrower 
+flameTorrent =
-    & itType . iyBase .~ HELD FLAMETORRENT
+    flameThrower
-    & itUse . useAim . aimZoom .~ defaultItZoom
+        & itType . iyBase .~ HELD FLAMETORRENT
-    & itParams . sprayNozzles . ix 0 %~ 
+        & itUse . useAim . aimZoom .~ defaultItZoom
-        ( (nzPressure .~ 10)
+        & itParams . sprayNozzles . ix 0
-        . (nzMaxWalkAngle .~ 1.5)
+            %~ ( (nzPressure .~ 10)
-        . (nzWalkSpeed .~ 0.05)
+                    . (nzMaxWalkAngle .~ 1.5)
-        )
+                    . (nzWalkSpeed .~ 0.05)
+               )
 
 blowTorch :: Item
-blowTorch = flameThrower
+blowTorch =
-    & itType . iyBase .~ HELD BLOWTORCH
+    flameThrower
+        & itType . iyBase .~ HELD BLOWTORCH
+
 flameWall :: Item
-flameWall = flameThrower 
+flameWall =
-    & itType . iyBase .~ HELD FLAMEWALL
+    flameThrower
-    & itParams . sprayNozzles .~ zipWith makeNozzle [0,0.6,-0.6] [2,2.5,2.5]
+        & itType . iyBase .~ HELD FLAMEWALL
+        & itParams . sprayNozzles .~ zipWith makeNozzle [0, 0.6, -0.6] [2, 2.5, 2.5]
   where
-    makeNozzle dir pres = Nozzle
+    makeNozzle dir pres =
-        { _nzPressure = pres
+        Nozzle
-        , _nzDir = dir
+            { _nzPressure = pres
-        , _nzMaxWalkAngle = 0
+            , _nzDir = dir
-        , _nzWalkSpeed = 0
+            , _nzMaxWalkAngle = 0
-        , _nzCurrentWalkAngle = 0
+            , _nzWalkSpeed = 0
-        , _nzLength = 20
+            , _nzCurrentWalkAngle = 0
-        }
+            , _nzLength = 20
+            }
 
 flameThrower :: Item
-flameThrower = defaultAutoGun
+flameThrower =
-    { _itConsumption = defaultLoadable
+    defaultAutoGun
-        & laMax .~ 250
+        { _itParams =
-        & laAmmoType .~ GasAmmo
+            Sprayer
-            {_amString = "FLAME"
+                { _sprayNozzles =
-            ,_amCreateGas = CreateFlame --aFlame
+                    [ Nozzle
-            }
+                        { _nzPressure = 4
-        & laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
+                        , _nzDir = 0
-    , _itParams = Sprayer
+                        , _nzMaxWalkAngle = 0.2
-        { _sprayNozzles = 
+                        , _nzWalkSpeed = 0.01
-            [ Nozzle 
+                        , _nzCurrentWalkAngle = 0
-                { _nzPressure = 4
+                        , _nzLength = 10
-                , _nzDir = 0
+                        }
-                , _nzMaxWalkAngle = 0.2
+                    ]
-                , _nzWalkSpeed = 0.01
-                , _nzCurrentWalkAngle = 0
-                , _nzLength = 10
                 }
-            ]
         }
-    }
+        & itDimension . dimRad .~ 7
-    & itDimension . dimRad .~ 7
+        & itDimension . dimCenter .~ V3 9 0 0
-    & itDimension . dimCenter .~ V3 9 0 0
+        & itUse . rUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
-    & itUse . rUse .~ HeldOverNozzlesUseGasParams -- overNozzles useGasParams
+        & itUse . useDelay .~ NoDelay
-    & itUse . useDelay .~ NoDelay
+        & itUse . useMods .~ FlameThrowerMod
-    & itUse . useMods .~ FlameThrowerMod
+        & itUse . useAim . aimWeight .~ 5
-    & itUse . useAim . aimWeight .~ 5
+        & itUse . useAim . aimZoom .~ defaultItZoom{_itZoomMax = 5, _itZoomMin = 1.5}
-    & itUse . useAim . aimZoom  .~ defaultItZoom {_itZoomMax = 5, _itZoomMin = 1.5}
+        & itUse . useAim . aimStance .~ TwoHandTwist
-    & itUse . useAim . aimStance .~ TwoHandTwist
+        & itUse . useAim . aimHandlePos .~ 0
-    & itUse . useAim . aimHandlePos .~ 0
+        & itUse . useAim . aimMuzPos .~ 18
-    & itUse . useAim . aimMuzPos .~ 18
+        & itUse . heldConsumption
-    & itType . iyBase .~ HELD FLAMETHROWER
+            .~ ( defaultLoadable
-
+                    & laMax .~ 250
-
+                    & laAmmoType
+                        .~ GasAmmo
+                            { _amString = "FLAME"
+                            , _amCreateGas = CreateFlame --aFlame
+                            }
+                    & laCycle .~ [loadEject 5, loadInsert 10, loadPrime 20]
+               )
+        & itType . iyBase .~ HELD FLAMETHROWER

src/Dodge/Item/Weapon/TriggerType.hs

@@ -141,7 +141,7 @@ ammoCheckI eff itm cr w
     | _laLoaded ic <= 0 || not (_laPrimed ic) = w
     | otherwise = eff itm cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
   where
-    ic = _itConsumption itm
+    ic = _heldConsumption $ _itUse itm
 
 -- combined ammo and hammer check: want to be able to auto-reload even if the
 -- hammer is down?
@@ -152,13 +152,13 @@ ammoHammerCheck eff it cr w
         Just HammerUp -> eff it cr $ w & cWorld . creatures . ix (_crID cr) %~ crCancelReloading
         _             -> w
   where 
-    ic = _itConsumption it
+    ic = _heldConsumption $ _itUse it
 
 itUseCharge :: Int -> Item -> Item
-itUseCharge x = itConsumption . arLoaded %~ (max 0 . subtract x) 
+itUseCharge x = itUse . leftConsumption . arLoaded %~ (max 0 . subtract x) 
 
 itUseAmmo :: Int -> Item -> Item
-itUseAmmo x = itConsumption . laLoaded %~ (max 0 . subtract x)
+itUseAmmo x = itUse . heldConsumption . laLoaded %~ (max 0 . subtract x)
 
 {- | Fires at an increasing rate.
 Has different effect after first fire.
@@ -295,14 +295,14 @@ withSidePushAfterI maxSide eff item cr w = over (cWorld . creatures . ix cid) pu
     (pushAmount, g) = randomR (-maxSide,maxSide) $ _randGen w
 useAllAmmo :: ChainEffect
 useAllAmmo eff item cr = eff item cr
-    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded .~ 0)
+    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded .~ 0)
 useAmmoUpTo :: Int -> ChainEffect
 useAmmoUpTo amAmount eff item cr = eff item cr
-    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded 
+    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded 
         %~ (max 0 . subtract amAmount))
 useAmmoAmount :: Int -> ChainEffect
 useAmmoAmount amAmount eff item cr = eff item cr
-    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itConsumption . laLoaded -~ amAmount)
+    . (cWorld . creatures . ix (_crID cr) . crInv . ix (crSel cr) . itUse . heldConsumption . laLoaded -~ amAmount)
 {- | 
 Applies a world effect after an item use cooldown check. -}
 useTimeCheck :: ChainEffect
@@ -316,7 +316,7 @@ useTimeCheck f item cr w = case item ^? itUse . useDelay . rateTime of
 {- | Applies a world effect after a hammer position check. -}
 hammerCheckI :: ChainEffect
 hammerCheckI f it cr w = case it ^? itUse . useHammer of
-    Just HammerUp | _laPrimed (_itConsumption it) 
+    Just HammerUp | _laPrimed (_heldConsumption (_itUse it)) 
         -> f it cr w
     _   -> w
 
@@ -335,7 +335,7 @@ ammoUseCheck f item cr w
     pointerToItem = cWorld . creatures . ix cid . crInv . ix itRef
     fireCondition = crWeaponReady cr
         && _rateTime (_useDelay (_itUse item)) == 0
-        && _laLoaded (_itConsumption item) > 0
+        && _laLoaded (_heldConsumption (_itUse item)) > 0
 --    reloadCondition = _laLoaded (_itConsumption item) == 0
 {- | Applies a world effect after a hammer position check.
 Arbitrary inventory position. -}
@@ -366,7 +366,7 @@ shootL f item cr w
     invid = _ipInvID $ _itPos item
     pointerToItem = cWorld . creatures . ix cid . crInv . ix invid
     fireCondition = _rateTime (_useDelay (_itUse item)) == 0
-        && _arLoaded (_itConsumption item) > 0
+        && _arLoaded (_leftConsumption (_itUse item)) > 0
 --    reloadCondition = _laLoaded (_itConsumption item) == 0
 withItem :: (Item -> ChainEffect) -> ChainEffect
 withItem g f it = g it f it
@@ -541,7 +541,7 @@ spreadLoaded eff item cr w = foldr f w dirs
     dirs = subtract cd . (spread *) . fromIntegral <$> [0 .. numBulLoaded - 1]
     f dir = eff item (cr & crDir +~ dir)
     spread = _spreadAngle . _brlSpread . _gunBarrels $ _itParams item
-    numBulLoaded = _laLoaded $ _itConsumption item
+    numBulLoaded = _laLoaded $ _heldConsumption (_itUse item)
 
 sideEffectOnFrame :: Int 
     -> (Item -> Creature -> WdWd)
@@ -571,7 +571,7 @@ duplicateLoaded :: ChainEffect
 duplicateLoaded eff it cr w = foldr f w [1..numBul]
   where
     f _ = eff it cr
-    numBul = _laLoaded $ _itConsumption it
+    numBul = _laLoaded $ _heldConsumption (_itUse it)
 
 duplicateLoadedBarrels :: ChainEffect
 duplicateLoadedBarrels eff item cr w = foldr f w poss
@@ -582,7 +582,7 @@ duplicateLoadedBarrels eff item cr w = foldr f w poss
     poss = map (rotateV (_crDir cr) . V2 0 . (*5) . (+ cp) . fromIntegral) [0 .. numBul - 1]
     f pos = eff item (cr & crPos %~ (+.+ pos))
     numBar = _brlNum . _gunBarrels $ _itParams item
-    numBul = _laLoaded $ _itConsumption item
+    numBul = _laLoaded $ _heldConsumption (_itUse item)
 
 duplicateOffsetsFocus :: [Float] -> ChainEffect
 duplicateOffsetsFocus xs eff item cr w = foldr f w poss

src/Dodge/Item/Weapon/Utility.hs

@@ -1,60 +1,67 @@
 module Dodge.Item.Weapon.Utility where
-import Dodge.Data
+
+import Control.Lens
+import Data.Maybe
 import Dodge.Base.Coordinate
+import Dodge.Data
 import Dodge.Default
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Wall.ForceField
 import Dodge.Wall.Move
 import Geometry
-import Picture
 import qualified IntMapHelp as IM
+import Picture
 import Shape
 import ShapePicture
 
-import Data.Maybe
-import Control.Lens
 rewindGun :: Item
-rewindGun = defaultLeftItem
+rewindGun =
-    { _itInvColor = cyan
+    defaultLeftItem
-    , _itConsumption = ChargeableAmmo
+        { _itInvColor = cyan
-        { _wpMaxCharge  = 250
+        , _itEffect = ItRewindEffect RewindEffect -- []
-        , _wpCharge = 0
+        , _itUse =
+            defaultlUse
+                & lUse .~ LRewind --useRewindGun
+                & eqEq . eqSite .~ GoesOnChest
         }
-    , _itEffect = ItRewindEffect RewindEffect-- []
+        & itType . iyBase .~ LEFT REWINDER
-    , _itUse = defaultlUse 
+        & itUse . leftConsumption
-        & lUse .~ LRewind --useRewindGun
+            .~ ChargeableAmmo
-        & eqEq . eqSite .~ GoesOnChest
+                { _wpMaxCharge = 250
-    }
+                , _wpCharge = 0
-    & itType . iyBase .~ LEFT REWINDER
+                }
 
 -- needs to shift this item to the current inventory slot
 shrinkGun :: Item
-shrinkGun = defaultLeftItem
+shrinkGun =
-    {_itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
+    defaultLeftItem
---    , _itFloorPict = shrinkGunPic
+        { _itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
-    , _itAttachment = AttachBool True
+        --    , _itFloorPict = shrinkGunPic
-    }
+        , _itAttachment = AttachBool True
-    & itType . iyBase .~ LEFT SHRINKER
+        }
+        & itType . iyBase .~ LEFT SHRINKER
 
 shrinkGunPic :: Item -> SPic
 shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5
 
-
 blinkGun :: Item
-blinkGun = defaultLeftItem 
+blinkGun =
-    { _itInvColor = cyan
+    defaultLeftItem
-    , _itUse = defaultlUse 
+        { _itInvColor = cyan
-        & lUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
+        , _itUse =
-        & eqEq . eqSite .~ GoesOnWrist
+            defaultlUse
---    , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
+                & lUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
-    }
+                & eqEq . eqSite .~ GoesOnWrist
-    & itType . iyBase .~ LEFT BLINKER
+                --    , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
+        }
+        & itType . iyBase .~ LEFT BLINKER
 
 unsafeBlinkGun :: Item
-unsafeBlinkGun = blinkGun
+unsafeBlinkGun =
-    & itType . iyBase .~ LEFT BLINKERUNSAFE
+    blinkGun
-    & itUse . lUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
+        & itType . iyBase .~ LEFT BLINKERUNSAFE
-    & itUse . eqEq . eqViewDist ?~ 400
+        & itUse . lUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
+        & itUse . eqEq . eqViewDist ?~ 400
 
 --effectGun :: String -> (Creature -> World -> World) -> Item
 --effectGun name eff = defaultWeapon
@@ -69,17 +76,18 @@ unsafeBlinkGun = blinkGun
 --    }
 --    & itType . iyBase .~ AUTOEFFGUN name
 forceFieldGun :: Item
-forceFieldGun = defaultWeapon 
+forceFieldGun =
-    { _itConsumption = defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField
+    defaultWeapon
-    , _itTargeting = targetRBPress & tgDraw .~ TargetDistanceDraw
+        & itTargeting .~ (targetRBPress & tgDraw .~ TargetDistanceDraw)
-    , _itParams = ParamMID Nothing
+        & itParams .~ ParamMID Nothing
-    }
+        & itUse . rUse .~ HeldForceField --useForceFieldGun
-    & itUse . rUse .~ HeldForceField --useForceFieldGun
+        & itUse . useDelay .~ NoDelay
-    & itUse . useDelay .~ NoDelay
+        & itUse . useMods .~ AmmoHammerTimeUseOneMod -- this is slightly different
-    & itUse . useMods .~ AmmoHammerTimeUseOneMod -- this is slightly different
         -- than the list below
         --[ hammerCheckI , ammoCheckI , useAmmoAmount 1]
-    & itType . iyBase .~ HELD FORCEFIELDGUN
+        & itType . iyBase .~ HELD FORCEFIELDGUN
+        & itUse . heldConsumption .~ (defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField)
+
 -- I believe because the targeting returns to nothing straight after you release
 -- the rmb, it is possible for this to do nothing
 -- TODO investigate more and fix
@@ -88,11 +96,12 @@ useForceFieldGun itm cr w = fromMaybe w $ do
     a <- _tgPos $ _itTargeting itm
     let mwp = mouseWorldPos w
         b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
-        wlline = (a,b)
+        wlline = (a, b)
-    return $ w 
+    return $
-        & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField {_wlID = i}
+        w
-        & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
+            & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
-        & moveWallIDUnsafe i wlline
+            & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
+            & moveWallIDUnsafe i wlline
   where
     i = fromMaybe (IM.newKey (_walls (_cWorld w))) $ itm ^? itParams . paramMID . _Just
 

src/Dodge/Lampoid.hs

@@ -12,6 +12,7 @@ updateLampoid :: Creature -> World -> World
 updateLampoid cr w = case cr ^?! crType . lampLSID of
     Nothing -> let i = IM.newKey (_lightSources (_cWorld w))
         in w & cWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
+            & cWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
     Just i 
         | _crHP cr < 0 -> w
             & explosionFlashAt cpos 

src/Dodge/LockAndKey.hs

@@ -35,10 +35,10 @@ lockRoomKeyItems =
     ,(const longRoomRunPast, takeOne [HELD SNIPERRIFLE,HELD FLATSHIELD])
     ,(const glassLessonRunPast, takeOne [HELD LASGUN])
     ,(const $ lasTunnelRunPast 400, takeOne [HELD FLATSHIELD,HELD FORCEFIELDGUN])
-    ,(keyCardRoomRunPast 0, return (KEYCARD 0))
+    ,(keyCardRoomRunPast 0, return (HELD $ KEYCARD 0))
     ]
 keyCardRunPastRand :: RandomGen g => [ (Int -> State g (MetaTree Room String) , State g ItemBaseType ) ]
-keyCardRunPastRand = [(keyCardRoomRunPast 0, return (KEYCARD 0)) ]
+keyCardRunPastRand = [(keyCardRoomRunPast 0, return (HELD $ KEYCARD 0)) ]
 
 itemRooms :: RandomGen g => [(ItemBaseType, State g (MetaTree Room String))]
 itemRooms = 
@@ -76,7 +76,7 @@ itemRooms =
         [rc [forceFieldGun]
         ]
       )
-    , (KEYCARD 0   , join $ takeOne 
+    , (HELD $ KEYCARD 0   , join $ takeOne 
         [rc [keyCard 0]
         ]
       )

src/Dodge/Luse.hs

@@ -1,9 +1,13 @@
 module Dodge.Luse where
-import Dodge.Data
+
-import Dodge.Item.Weapon.TriggerType
+import Dodge.Base
+import Data.Maybe
 import Dodge.Creature.Action
-import Dodge.Item.Equipment.Booster
+import Dodge.Data
 import Dodge.Default.Creature
+import Dodge.Item.Weapon.TriggerType
+import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
 
 useL :: Luse -> Item -> Creature -> World -> World
@@ -17,25 +21,97 @@ useL lu = case lu of
 
 useRewindGun :: Item -> Creature -> World -> World
 useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
-    [w']        -> rewindusing w' [w']
+    [w'] -> rewindusing w' [w']
-    (w':ws)   -> rewindusing w' ws
+    (w' : ws) -> rewindusing w' ws
-    _           -> w
+    _ -> w
   where
     rewindusing :: CWorld -> [CWorld] -> World
-    rewindusing w' ws = w
+    rewindusing w' ws =
-        & cWorld . maybeWorld .~ Just' ( w'
+        w
-        & rewindWorlds .~ ws
+            & cWorld . maybeWorld
-        )
+                .~ Just'
+                    ( w'
+                        & rewindWorlds .~ ws
+                    )
 
 -- be careful changing this around; potential problems include updating the
 -- creature but using the old crInvSel value
 -- 22.05.23 this has been changed from using invids to items
 useShrinkGun :: Item -> Creature -> World -> World
-useShrinkGun it cr w = if _atBool $ _itAttachment it
+useShrinkGun it cr w =
-    then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
+    if _atBool $ _itAttachment it
-    else tryResize 1   $ f True Uncursed . setMinInvSize defaultInvSize cr
+        then tryResize 0.5 $ stripNoItems cr . f False UndroppableIdentified . dropExcept cr invid
+        else tryResize 1 $ f True Uncursed . setMinInvSize defaultInvSize cr
   where
     invid = _ipInvID $ _itPos it
     tryResize x g = maybe w g $ sizeSelf x cr w
-    f isInUse cstatus = cWorld . creatures . ix (_crID cr) . crInv . ix invid %~
+    f isInUse cstatus =
-        ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
+        cWorld . creatures . ix (_crID cr) . crInv . ix invid
+            %~ ((itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus))
+
+boostSelfL ::
+    -- | boost amount
+    Float ->
+    Item ->
+    Creature ->
+    World ->
+    World
+boostSelfL x itm cr w = case boostPoint x cr w of
+    Left p -> crEff p (itUse . leftConsumption . arLoaded .~ 0)
+    Right p -> crEff p (itUse . leftConsumption . arLoaded -~ 1)
+  where
+    invid = _ipInvID $ _itPos itm
+    cid = _crID cr
+    cpos = _crPos cr
+    r = _crRad cr
+    pid =
+        fromMaybe
+            (IM.newKey $ _props (_cWorld w))
+            (cr ^? crInv . ix invid . itAttachment . atInt)
+    crEff p ammoEff =
+        addBoostShockwave pid p (r *.* normalizeV (p -.- cpos)) w
+            & cWorld . creatures . ix cid
+                %~ (crPos .~ p)
+                    . ( crInv . ix invid
+                            %~ ammoEff
+                                . (itEffect . ieCounter .~ 1)
+                                . (itAttachment .~ AttachInt pid)
+                      )
+
+-- | Move a creature towards the mouse position, with shockwave
+boostPoint ::
+    -- | boost amount
+    Float ->
+    Creature ->
+    World ->
+    Either Point2 Point2
+boostPoint x cr w = case mayp2 of
+    Nothing -> Right p1
+    Just p2 -> Left $ mvPointTowardAtSpeed r cpos $ fst p2
+  where
+    cpos = _crPos cr
+    r = 1.5 * _crRad cr
+    p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
+    mayp2 = bouncePoint (const True) 1 cpos p1 w
+
+addBoostShockwave ::
+    Int ->
+    Point2 ->
+    Point2 ->
+    World ->
+    World
+addBoostShockwave pjid p v w =
+    w & cWorld . linearShockwaves
+        %~ IM.insertWith f pjid thePJ
+  where
+    thePJ =
+        LinearShockwave
+            { _lwPos = p
+            , _lwID = pjid
+            , _lwPoints = [(p, v)]
+            , _lwTimer = maxT
+            }
+    f newVal oldVal = newVal & lwPoints %~ (++ _lwPoints oldVal)
+
+maxT :: Int
+maxT = 20

src/Dodge/Machine/Update.hs

@@ -1,30 +1,31 @@
 module Dodge.Machine.Update where
-import Dodge.Data
-import Dodge.Machine.Destroy
-import Dodge.SoundLogic
-import Dodge.Base.You
-import Dodge.Base.Collide
-import Dodge.Wall.Delete
-import Dodge.WorldEvent.Explosion
-import Dodge.FloorItem
-import Dodge.Item.Weapon.BatteryGuns
-import Dodge.Default
-import Dodge.Movement.Turn
-import Geometry
-import LensHelp
-import qualified IntMapHelp as IM
 
 import Data.List (partition)
 import Data.Maybe
+import Dodge.Base.Collide
+import Dodge.Base.You
+import Dodge.Data
+import Dodge.Default
+import Dodge.FloorItem
+import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Machine.Destroy
+import Dodge.Movement.Turn
+import Dodge.SoundLogic
+import Dodge.Wall.Delete
+import Dodge.WorldEvent.Explosion
+import Geometry
+import qualified IntMapHelp as IM
+import LensHelp
 
 updateMachine :: Machine -> World -> World
 updateMachine mc
     | _mcHP mc < 1 = destroyMachine mc
-    | otherwise = mcApplyDamage (_mcDamage mc) mc
+    | otherwise =
-        . mcPlaySound mc
+        mcApplyDamage (_mcDamage mc) mc
-        . mcSensorTriggerUpdate mc
+            . mcPlaySound mc
-        . mcTurretUpdate mc
+            . mcSensorTriggerUpdate mc
-        . mcSensorUpdate mc
+            . mcTurretUpdate mc
+            . mcSensorUpdate mc
 
 mcTurretUpdate :: Machine -> World -> World
 mcTurretUpdate mc = case _mcType mc of
@@ -34,49 +35,56 @@ mcTurretUpdate mc = case _mcType mc of
 -- this needs a major cleanup
 updateTurret :: Float -> Machine -> World -> World
 updateTurret rotSpeed mc w
-    | _mcHP mc < 1 = w & cWorld . machines %~ IM.delete mcid
+    | _mcHP mc < 1 =
-        & deleteWallIDs (_mcWallIDs mc)
+        w & cWorld . machines %~ IM.delete mcid
-        & makeExplosionAt mcpos
+            & deleteWallIDs (_mcWallIDs mc)
-        & copyItemToFloor mcpos lasGun
+            & makeExplosionAt mcpos
-        & deleteHomonculus
+            & copyItemToFloor mcpos lasGun
-    | otherwise = w 
+            & deleteHomonculus
-        & initHomonculus
+    | otherwise =
-        & dodamage 
+        w
-        & maybeFire 
+            & initHomonculus
-        & elecDamBranch
+            & dodamage
+            & maybeFire
+            & elecDamBranch
   where
     deleteHomonculus = case _tuMCrID (_mcType mc) of
         Nothing -> id
         Just cid -> cWorld . creatures . at cid .~ Nothing
     initHomonculus w' = case w' ^? cWorld . machines . ix mcid . mcType . tuMCrID . _Just of
-        Nothing -> w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
+        Nothing ->
-            & cWorld . creatures . at cid ?~ thecreature
+            w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
+                & cWorld . creatures . at cid ?~ thecreature
           where
             cid = IM.newKey (_creatures (_cWorld w'))
-            thecreature = defaultCreature
+            thecreature =
-                & crID .~ cid
+                defaultCreature
-                & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
+                    & crID .~ cid
-                    & itConsumption . laLoaded .~ 1
+                    & crInv . at 0
-                    )
+                        ?~ ( _tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
-                & crPos .~ mcpos
+                                & itUse . heldConsumption . laLoaded .~ 1
-                & crOldPos .~ mcpos
+                           )
-                & crRad    .~ 1
+                    & crPos .~ mcpos
-                & crDir .~ mcdir
+                    & crOldPos .~ mcpos
-                & crStance . posture .~ Aiming
+                    & crRad .~ 1
-                & crMaterial .~ Crystal
+                    & crDir .~ mcdir
-        Just cid -> w'
+                    & crStance . posture .~ Aiming
-            & cWorld . creatures . ix cid . crPos .~ mcpos
+                    & crMaterial .~ Crystal
-            & cWorld . creatures . ix cid . crDir .~ mcdir
+        Just cid ->
-    dodamage = cWorld . machines . ix mcid %~ 
+            w'
-        ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
+                & cWorld . creatures . ix cid . crPos .~ mcpos
-        . (mcHP -~ dam)
+                & cWorld . creatures . ix cid . crDir .~ mcdir
-        )
+    dodamage =
+        cWorld . machines . ix mcid
+            %~ ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
+                    . (mcHP -~ dam)
+               )
     elecDamBranch
         | elecDam < 10 = updateFiringStatus . doTurn
         | otherwise = id
     maybeFire
-        | _tuFireTime (_mcType mc) > 0
+        | _tuFireTime (_mcType mc) > 0 =
-            = fromMaybe id $ do
+            fromMaybe id $ do
                 cid <- _tuMCrID (_mcType mc)
                 return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
         | otherwise = id
@@ -94,7 +102,7 @@ updateTurret rotSpeed mc w
     closeFireAngle = seesYou -- && angleVV (ypos -.- mcpos) (unitVectorAtAngle mcdir) < 1
     updateFiringStatus
         | closeFireAngle = cWorld . machines . ix mcid . mcType . tuFireTime .~ 20
-        | otherwise      = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
+        | otherwise = cWorld . machines . ix mcid . mcType . tuFireTime %~ (max 0 . subtract 1)
 
 mcSensorTriggerUpdate :: Machine -> World -> World
 mcSensorTriggerUpdate mc = fromMaybe id $ do
@@ -110,56 +118,61 @@ mcTriggerVal mc = case mc ^. mcSensor of
 
 mcPlaySound :: Machine -> World -> World
 mcPlaySound mc w = case _mcCloseSound mc of
-    Just sid | d < 100 
+    Just sid
-        -> soundContinueVol (1-0.01*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
+        | d < 100 ->
-    _   -> w
+            soundContinueVol (1 -0.01 * d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
+    _ -> w
   where
     d = max 0 (dist (_crPos $ you w) (_mcPos mc) - 100)
     mid = _mcID mc
 
 mcApplyDamage :: [Damage] -> Machine -> World -> World
 mcApplyDamage ds mc = case _mcSensor mc of
-    NoSensor -> cWorld . machines . ix (_mcID mc) %~
+    NoSensor ->
-        ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
+        cWorld . machines . ix (_mcID mc)
+            %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
     _ -> id
 
 mcSensorUpdate :: Machine -> World -> World
 mcSensorUpdate mc w = case _mcSensor mc of
     NoSensor -> w
-    s@DamageSensor{}  -> senseDamage (_sensType s) mc w
+    s@DamageSensor{} -> senseDamage (_sensType s) mc w
     ProximitySensor{} -> mcProximitySensorUpdate mc w
 
 mcProximitySensorUpdate :: Machine -> World -> World
-mcProximitySensorUpdate mc w = case 
+mcProximitySensorUpdate mc w = case ( _proxStatus sens
-        ( _proxStatus sens
+                                    , _sensToggle sens
-        , _sensToggle sens
+                                    , mcProxTest mc w
-        , mcProxTest mc w 
+                                    , dist (_crPos ycr) (_mcPos mc) < _proxDist sens
-        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
+                                    ) of
-    (_,True,_,_) -> w
+    (_, True, _, _) -> w
-    (_,False,True,True) -> w 
+    (_, False, True, True) ->
+        w
             & cWorld . machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
             & playsound dedaS
             & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-    (NotClose,_,False,True) -> w & playsound dedumS
+    (NotClose, _, False, True) ->
+        w & playsound dedumS
             & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ IsClose
-    (_,_,_,False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
+    (_, _, _, False) -> w & cWorld . machines . ix (_mcID mc) . mcSensor . proxStatus .~ NotClose
     _ -> w
- where
+  where
     playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
     ycr = you w
     sens = _mcSensor mc
 
 mcProxTest :: Machine -> World -> Bool
 mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
-    Just (RequireHealth x)      -> _crHP cr >= x
+    Just (RequireHealth x) -> _crHP cr >= x
-    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
+    Just (RequireEquipment ct) -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
     _ -> False
   where
     cr = you w
 
 senseDamage :: DamageType -> Machine -> World -> World
-senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc)
+senseDamage dt mc =
-    . updatels
+    (cWorld . machines . ix mcid %~ upmc)
+        . updatels
   where
     upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
     mcid = _mcID mc
@@ -173,4 +186,3 @@ damageUsing :: DamageType -> Damage -> Either Int Int
 damageUsing dt dm
     | _dmType dm == dt = Left $ _dmAmount dm
     | otherwise = Right 0
-

src/Dodge/Menu.hs

@@ -1,66 +1,72 @@
-module Dodge.Menu
+module Dodge.Menu (
-    ( scodeToChar
+    scodeToChar,
-    , pauseMenu
+    pauseMenu,
-    , gameOverMenu
+    gameOverMenu,
-    ) where
+) where
-import Dodge.Config.Data
+
-import LensHelp
+import Dodge.Config.Update
-import Dodge.Menu.OptionType
-import Dodge.StartNewGame
-import Dodge.Menu.PushPop
 import Dodge.Data
+import Dodge.Menu.OptionType
+import Dodge.Menu.PushPop
 import Dodge.PreloadData
 import Dodge.Save
-import Dodge.Config.Update
-import Padding
---import SDL.Internal.Numbered
---import Preload.Update
 import Dodge.SoundLogic
+import Dodge.StartNewGame
+import LensHelp
+import Padding
 --import Dodge.LevelGen
 
-import Text.Read
 import SDL
 import System.Clipboard
+import Text.Read
+
 --import Control.Lens
 --import System.Random
 
 slTitleOptionsEff :: String -> [MenuOption] -> (Universe -> IO (Maybe Universe)) -> ScreenLayer
-slTitleOptionsEff title ops eff = OptionScreen
+slTitleOptionsEff title ops eff =
-    { _scTitle = const title
+    OptionScreen
-    , _scOptions = ops
+        { _scTitle = const title
-    , _scDefaultEff = eff
+        , _scOptions = ops
-    , _scOptionFlag = NormalOptions
+        , _scDefaultEff = eff
-    , _scOptionsOffset = 0
+        , _scOptionFlag = NormalOptions
-    }
+        , _scOptionsOffset = 0
+        }
+
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
+
 pauseMenuOptions :: [MenuOption]
-pauseMenuOptions = basicKeyOptions
+pauseMenuOptions =
-    [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
+    basicKeyOptions
-    , Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
+        [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
-    , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
+        , Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
-    , Toggle (pushScreen optionMenu ) (opText "OPTIONS")
+        , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
-    , Toggle (pushScreen displayControls) (opText "CONTROLS")
+        , Toggle (pushScreen optionMenu) (opText "OPTIONS")
-    ]
+        , Toggle (pushScreen displayControls) (opText "CONTROLS")
-    ++
+        ]
-    [ InvisibleToggle ScancodeEscape (return . const Nothing)
+        ++ [ InvisibleToggle ScancodeEscape (return . const Nothing)
-    ]
+           ]
   where
     opText = const . Left
+
 seedStartMenu :: String -> ScreenLayer
 seedStartMenu str = slTitleOptionsEff str seedStartOptions popScreen
+
 seedStartOptions :: [MenuOption]
 seedStartOptions =
     [ Toggle trySeedFromClipboard (const $ Left "PASTE NUMBER FROM CLIPBOARD") ScancodeA
---    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
+    --    , Toggle ScancodeI (return . Just . loadSaveSlot LevelStartSlot) (const "INSERT NUMBER")
     ]
 
 trySeedFromClipboard :: Universe -> IO (Maybe Universe)
 trySeedFromClipboard u = do
     mcstr <- getClipboardString
     case mcstr >>= readMaybe of
-        Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
+        Nothing ->
-            (u & menuLayers %~ tail)
+            pushScreen
+                (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
+                (u & menuLayers %~ tail)
         Just i -> return . Just $ startSeedGame i u
 
 slTitleOptions :: String -> [MenuOption] -> ScreenLayer
@@ -70,26 +76,35 @@ optionMenu :: ScreenLayer
 optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 
 optionsOptions :: [MenuOption]
-optionsOptions = basicKeyOptions
+optionsOptions =
-    [ makeSubmenuOption soundMenu      $ Left "VOLUME"
+    basicKeyOptions
-    , makeSubmenuOption graphicsMenu   $ Left "GRAPHICS"
+        [ makeSubmenuOption soundMenu $ Left "VOLUME"
-    , makeSubmenuOption gameplayMenu   $ Left "GAMEPLAY"
+        , makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
-    , makeSubmenuOption debugMenu      $ Left "DEBUG OPTIONS"
+        , makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
-    ]
+        , makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
+        ]
+
 debugMenu :: ScreenLayer
-debugMenu = slTitleOptions
+debugMenu =
-    "OPTIONS:GAMEPLAY"
+    slTitleOptions
-    debugMenuOptions
+        "OPTIONS:GAMEPLAY"
+        debugMenuOptions
+
 debugMenuOptions :: [MenuOption]
-debugMenuOptions = zipWith ($)
+debugMenuOptions =
-    (map f [minBound..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return] )
+    zipWith
-    $ map Scancode [4..]
+        ($)
+        (map f [minBound ..] ++ [makeEnumOption debug_view_clip_bounds "SHOW ROOM CLIP" return])
+        $ map Scancode [4 ..]
   where
     f :: DebugBool -> Scancode -> MenuOption
-    f bd = Toggle (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
+    f bd =
-        (Right . g bd . (^? uvConfig . debug_booleans . ix bd))
+        Toggle
+            (return . Just . (uvConfig . debug_booleans . at bd %~ toggleJust))
+            (Right . g bd . (^? uvConfig . debug_booleans . ix bd))
     g bd Nothing = (show bd, "False")
-    g bd _       = (show bd, "True")
+    g bd _ = (show bd, "True")
+
 --    zipWith ($)
 --    [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
 --    , makeBoolOption debug_noclip "NOCLIP"
@@ -105,35 +120,40 @@ debugMenuOptions = zipWith ($)
 --    ]
 --    $ map Scancode [4 ..]
 gameplayMenu :: ScreenLayer
-gameplayMenu  = slTitleOptions
+gameplayMenu =
-    "OPTIONS:GAMEPLAY"
+    slTitleOptions
-    gameplayMenuOptions
+        "OPTIONS:GAMEPLAY"
+        gameplayMenuOptions
 
 gameplayMenuOptions :: [MenuOption]
-gameplayMenuOptions = basicKeyOptions
+gameplayMenuOptions =
-    [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
+    basicKeyOptions
-    ]
+        [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
+        ]
+
 basicKeyOptions :: [Scancode -> c] -> [c]
-basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 .. ]
+basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
 
 soundMenu :: ScreenLayer
-soundMenu = slTitleOptions
+soundMenu =
-    "OPTIONS:VOLUME"
+    slTitleOptions
-    soundMenuOptions
+        "OPTIONS:VOLUME"
+        soundMenuOptions
 
 soundMenuOptions :: [MenuOption]
 soundMenuOptions =
-    [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME"  _volume_master
+    [ theoption ScancodeY volume_master ScancodeU "MASTER VOLUME" _volume_master
-    , theoption ScancodeH volume_sound  ScancodeJ "EFFECTS VOLUME" _volume_sound
+    , theoption ScancodeH volume_sound ScancodeJ "EFFECTS VOLUME" _volume_sound
-    , theoption ScancodeN volume_music  ScancodeM "MUSIC VOLUME"   _volume_music
+    , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music
     ]
   where
-    theoption scod1 stype scod2 str voltype = Toggle2
+    theoption scod1 stype scod2 str voltype =
-        scod1
+        Toggle2
-        (change dec stype)
+            scod1
-        scod2
+            (change dec stype)
-        (change inc stype)
+            scod2
-        (\w -> Right (str , leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w)::Int)))
+            (change inc stype)
+            (\w -> Right (str, leftPad 2 '.' $ show (round $ 10 * voltype (_uvConfig w) :: Int)))
     change g vt uv = sw uv >> return (Just $ uv & uvConfig . vt %~ g)
     dec x = max 0 (x - 0.1)
     inc x = min 1 (x + 0.1)
@@ -146,27 +166,28 @@ graphicsMenu :: ScreenLayer
 graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
 
 graphicsMenuOptions :: [MenuOption]
-graphicsMenuOptions = basicKeyOptions
+graphicsMenuOptions =
-    [ makeEnumOption graphics_resolution_factor "RESOLUTION"    updateFramebufferSize
+    basicKeyOptions
-    , makeBoolOption graphics_wall_textured     "WALL TEXTURES"
+        [ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
-    , makeBoolOption graphics_object_shadows    "OBJECT SHADOWS"
+        , makeBoolOption graphics_wall_textured "WALL TEXTURES"
-    , makeBoolOption graphics_cloud_shadows     "CLOUD SHADOWS"
+        , makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
-    ]
+        , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
+        ]
 
 gameOverMenu :: ScreenLayer
-gameOverMenu = OptionScreen
+gameOverMenu =
-    { _scTitle = const "GAME OVER"
+    OptionScreen
-    , _scOptions = pauseMenuOptions
+        { _scTitle = const "GAME OVER"
-    , _scDefaultEff = return . Just
+        , _scOptions = pauseMenuOptions
-    , _scOptionFlag = GameOverOptions
+        , _scDefaultEff = return . Just
-    , _scOptionsOffset = 0
+        , _scOptionFlag = GameOverOptions
-    }
+        , _scOptionsOffset = 0
+        }
 
 -- | hacky - no longer used
 scodeToChar :: Scancode -> Char
 scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
 
-
 --charToScode :: Char -> Scancode
 --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
 
@@ -176,20 +197,20 @@ unpause w = Just . resumeSound $ w & menuLayers .~ []
 displayControls :: ScreenLayer
 displayControls = ColumnsScreen (const "CONTROLS") listControls
 
-listControls :: [(String,String)]
+listControls :: [(String, String)]
 listControls =
-    [("wasd",           "MOVEMENT")
+    [ ("wasd", "MOVEMENT")
-    ,("[rmb]",          "AIM")
+    , ("[rmb]", "AIM")
-    ,("[rmb+lmb]",      "SHOOT/USE/EQUIP SELECTED")
+    , ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
-    ,("[lmb]",          "USE EQUIPPED")
+    , ("[lmb]", "USE EQUIPPED")
-    ,("[wheelscroll]" , "SELECT ITEM"  )
+    , ("[wheelscroll]", "SELECT ITEM")
-    ,("[space]" ,       "PICKUP ITEM"  )
+    , ("[space]", "PICKUP ITEM")
-    ,("m" ,             "DISPLAY MAP"    )
+    , ("m", "DISPLAY MAP")
-    ,("f" ,             "DROP ITEM"    )
+    , ("f", "DROP ITEM")
-    ,("c" ,             "COMBINE ITEMS"    )
+    , ("c", "COMBINE ITEMS")
-    ,("x" ,             "TWEAK ITEMS"    )
+    , ("x", "TWEAK ITEMS")
-    ,("c[esc]" ,        "PAUSE"        )
+    , ("c[esc]", "PAUSE")
-    ,("qe" ,            "ROTATE CAMERA")
+    , ("qe", "ROTATE CAMERA")
-    ,("F5" ,            "QUICKSAVE")
+    , ("F5", "QUICKSAVE")
-    ,("F9" ,            "QUICKLOAD")
+    , ("F9", "QUICKLOAD")
     ]

src/Dodge/Placement/Instance/Turret.hs

@@ -61,7 +61,7 @@ updateTurret rotSpeed mc w
             thecreature = defaultCreature
                 & crID .~ cid
                 & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
-                    & itConsumption . laLoaded .~ 1
+                    & itUse . heldConsumption . laLoaded .~ 1
                     )
                 & crPos .~ mcpos
                 & crOldPos .~ mcpos

src/Dodge/Projectile/Create.hs

@@ -41,7 +41,7 @@ makeShell it cr theupdate w = w & cWorld . projectiles %~ IM.insert i Shell
     i = IM.newKey $ _props (_cWorld w)
     dir = _crDir cr
     pos = _crPos cr +.+ rotateV dir (V2 (_crRad cr + 1) 0)
-    am = _itConsumption it
+    am = _heldConsumption $ _itUse it
 
 --fireShell :: Item -> Creature -> World -> World
 --fireShell it cr = makeShell it cr $ \pj -> pjEffAtTime 35 (trySpinByCID (_crID cr) spinamount) pj 

src/Dodge/Projectile/Update.hs

@@ -1,32 +1,33 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
+
 module Dodge.Projectile.Update where
-import Dodge.Item.Weapon.Launcher
+
+--import qualified Data.Set as S
+
+import Control.Lens
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import Dodge.Base
 import Dodge.Data
-import Dodge.Payload
-import Dodge.Reloading.Action
-import Dodge.EnergyBall
 import Dodge.Default.Weapon
+import Dodge.EnergyBall
 import Dodge.Item.Location
-import Dodge.SoundLogic.LoadSound
+import Dodge.Item.Weapon.Launcher
-import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.Remote
+import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Movement.Turn
-import Dodge.Base
+import Dodge.Payload
-import Dodge.Zone
+import Dodge.Reloading.Action
 import Dodge.SoundLogic
+import Dodge.SoundLogic.LoadSound
 import Dodge.WorldEvent.Cloud
-import RandomHelp
+import Dodge.Zone
 import Geometry
 import qualified IntMapHelp as IM
-
+import RandomHelp
-import qualified Streaming.Prelude as S
---import qualified Data.Set as S
-import qualified Data.Map.Strict as M
 import qualified SDL
-import Data.Maybe
+import qualified Streaming.Prelude as S
-import Control.Lens
-
 
 updateProjectile :: Proj -> World -> World
 updateProjectile pj = case pj of
@@ -35,58 +36,65 @@ updateProjectile pj = case pj of
 
 updateRemoteShell :: Proj -> World -> World
 updateRemoteShell pj w
-    | time > 340 = if circOnSomeWall oldPos 4 w
+    | time > 340 =
-        then doExplode
+        if circOnSomeWall oldPos 4 w
-        else w
+            then doExplode
+            else w
     | anythingHitCirc 2 oldPos newPos w = doExplode
     | time > 0 = w
     | otherwise = doExplode
   where
     time = _prjTimer pj
-    doExplode = w
+    doExplode =
-        & usePayload (_prjPayload pj) oldPos 
+        w
-        & stopSoundFrom (ShellSound i)
+            & usePayload (_prjPayload pj) oldPos
-        & cWorld . projectiles %~ IM.delete i
+            & stopSoundFrom (ShellSound i)
+            & cWorld . projectiles %~ IM.delete i
     i = _prjID pj
-    oldPos   = _prjPos pj
+    oldPos = _prjPos pj
-    vel      = _prjVel pj
+    vel = _prjVel pj
-    newPos   = oldPos +.+ vel
+    newPos = oldPos +.+ vel
 
-explodeRemoteRocket' 
+explodeRemoteRocket' ::
-    :: Maybe Int  -- ^ Item id
+    -- | Item id
-    -> Proj
+    Maybe Int ->
-    -> World 
+    Proj ->
-    -> World
+    World ->
-explodeRemoteRocket' mitid thepj w = w
+    World
-    & cWorld . projectiles . ix pjid . prjDraw   .~ DrawBlankProjectile
+explodeRemoteRocket' mitid thepj w =
-    & usePayload (_prjPayload thepj) (_prjPos thepj)
+    w
-    & updateitem
+        & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
+        & usePayload (_prjPayload thepj) (_prjPos thepj)
+        & updateitem
   where
     updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
         itid <- mitid
         itpos <- w ^? cWorld . itemPositions . ix itid
-        return $ (pointToItem itpos . itUse . rUse     .~ HeldDoNothing)
+        return $
-            . (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
+            (pointerToItem itpos . itUse . rUse .~ HeldDoNothing)
+                . (cWorld . projectiles . ix pjid . prjUpdates .~ [PJRetireRemote itid 30 pjid])
     pjid = _prjID thepj
 
 updateShell :: Proj -> World -> World
 updateShell pj w
-    | time > 340 = if circOnSomeWall oldPos 4 w
+    | time > 340 =
-        then doExplode
+        if circOnSomeWall oldPos 4 w
-        else w
+            then doExplode
+            else w
     | anythingHitCirc 2 oldPos newPos w = doExplode
     | time > 0 = w
     | otherwise = doExplode
   where
     time = _prjTimer pj
-    doExplode = w
+    doExplode =
-        & usePayload (_prjPayload pj) oldPos 
+        w
-        & stopSoundFrom (ShellSound i)
+            & usePayload (_prjPayload pj) oldPos
-        & cWorld . projectiles %~ IM.delete i
+            & stopSoundFrom (ShellSound i)
+            & cWorld . projectiles %~ IM.delete i
     i = _prjID pj
-    oldPos   = _prjPos pj
+    oldPos = _prjPos pj
-    vel      = _prjVel pj
+    vel = _prjVel pj
-    newPos   = oldPos +.+ vel
+    newPos = oldPos +.+ vel
 
 upsProjectile :: Proj -> World -> World
 upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
@@ -115,12 +123,13 @@ upProjectile pu pj = case pu of
     ain t = time == t
 
 retireRemoteProj'' :: Int -> Int -> World -> World
-retireRemoteProj'' itid pjid w = w
+retireRemoteProj'' itid pjid w =
-    & pointToItem (_itemPositions (_cWorld w) IM.! itid) %~ 
+    w
-        ( (itScope . scopePos .~ V2 0 0)
+        & pointerToItem (_itemPositions (_cWorld w) IM.! itid)
-        . (itUse . rUse .~ HeldFireRemoteShell)
+            %~ ( (itScope . scopePos .~ V2 0 0)
-        )
+                    . (itUse . rUse .~ HeldFireRemoteShell)
-    & cWorld . props %~ IM.delete pjid
+               )
+        & cWorld . props %~ IM.delete pjid
 
 setRemoteDir :: Int -> Int -> Proj -> World -> World
 setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir .~ newdir
@@ -129,38 +138,41 @@ setRemoteDir cid itid pj w = w & cWorld . projectiles . ix (_prjID pj) . prjDir
     newdir
         | SDL.ButtonRight `M.member` _mouseButtons w
             && w ^? cWorld . creatures . ix cid . crInvSel . iselPos
-                == w ^? cWorld . itemPositions . ix itid . ipInvID
+                == w ^? cWorld . itemPositions . ix itid . ipInvID =
-                    = _cameraRot (_cWorld w) + argV (_mousePos w)
+            _cameraRot (_cWorld w) + argV (_mousePos w)
         | otherwise = _prjDir pj
 
 doThrust' :: Proj -> World -> World
-doThrust' pj w = w
+doThrust' pj w =
-    & randGen .~ g
+    w
-    & cWorld . projectiles . ix i . prjVel    %~ (\v -> accel +.+ frict *.* v)
+        & randGen .~ g
-    & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
+        & cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
-    & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10
+        & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
-    & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
+        & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi + sparkD) accel) 3 10
+        & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
   where
-    accel   = _prjAcc pj
+    accel = _prjAcc pj
-    i       = _prjID pj
+    i = _prjID pj
-    oldPos  = _prjPos pj
+    oldPos = _prjPos pj
-    vel     = _prjVel pj
+    vel = _prjVel pj
-    newPos  = oldPos +.+ vel
+    newPos = oldPos +.+ vel
-    (frict,g)  = randomR (0.6,0.9) $ _randGen w
+    (frict, g) = randomR (0.6, 0.9) $ _randGen w
-    (sparkD,_) = randomR (-0.2,0.2) $ _randGen w
+    (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
     r1 = randInCirc 10 & evalState $ _randGen w
 
-trySpinByCID'
+trySpinByCID' ::
-    :: Int -- ^ creature id
+    -- | creature id
-    -> Int -- ^ Spin amount
+    Int ->
-    -> Proj
+    -- | Spin amount
-    -> World 
+    Int ->
-    -> World
+    Proj ->
+    World ->
+    World
 trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
   where
     pjid = _prjID pj
-    dir      = argV $ _prjVel pj
+    dir = argV $ _prjVel pj
-    newSpin   = case w ^? cWorld . creatures . ix cid of
+    newSpin = case w ^? cWorld . creatures . ix cid of
         Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
         _ -> 0
     spinFactor = 5 * (6 - fromIntegral i)
@@ -170,9 +182,14 @@ pjTrack' itid pj w = rotateToTarget pj w
   where
     rotateToTarget _ = fromMaybe id $ do
         tpos <- w ^? itPoint . itTargeting . tgPos . _Just
-        return $ cWorld . projectiles . ix (_prjID pj) . prjSpin .~ turnToAmount 0.15 (_prjPos pj) tpos 
+        return $
-            (argV $ _prjAcc pj)
+            cWorld . projectiles . ix (_prjID pj) . prjSpin
-    itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
+                .~ turnToAmount
+                    0.15
+                    (_prjPos pj)
+                    tpos
+                    (argV $ _prjAcc pj)
+    itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
 
 reduceSpinBy' :: Float -> Proj -> World -> World
-reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) .  prjSpin *~ x
+reduceSpinBy' x pj = cWorld . projectiles . ix (_prjID pj) . prjSpin *~ x

src/Dodge/Reloading.hs

@@ -13,7 +13,7 @@ import Control.Lens
 
 crCancelReloading :: Creature -> Creature
 crCancelReloading cr = cr 
-    & crInv . ix (crSel cr) . itConsumption . laProgress %~ const Nothing
+    & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress %~ const Nothing
     & crInvSel . iselAction .~ NoInvSelAction
 
 stepReloading :: Creature -> Creature
@@ -24,13 +24,13 @@ stepReloading cr = case cr ^?! crInvSel . iselAction of
             & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
         | otherwise -> cr 
             & crInvSel . iselAction . actionHammer . hammerPosition %~ moveHammerUp
-            & crInv . ix (crSel cr) . itConsumption %~ doLoadAction la
+            & crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
-            & crInv . ix (crSel cr) . itConsumption %~ rotateActionProgress
+            & crInv . ix (crSel cr) . itUse . heldConsumption %~ rotateActionProgress
             & tryNextLoadAction
     _ -> cr
 
 tryNextLoadAction :: Creature -> Creature
-tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itConsumption . laProgress . _Just . ix 0 of
+tryNextLoadAction cr = case cr ^? crInv . ix (crSel cr) . itUse . heldConsumption . laProgress . _Just . ix 0 of
     Nothing -> cr & crInvSel . iselAction .~ NoInvSelAction
     Just la -> cr & crInvSel . iselAction . actionProgress .~ _actionTime la
         & crInvSel . iselAction . reloadAction .~ la
@@ -52,22 +52,22 @@ tryStartLoading cr = case ic ^? laProgress . _Just . ix 0 of
         Just [] -> error ("item has empty load cycle" ++ show (cr ^?! crInv . ix (crSel cr) . itType))
         Just _ | _laLoaded ic >= _laMax ic -> cr
         Just (la:las) -> cr & startLoadAction la
-            & crInv . ix (crSel cr) . itConsumption . laProgress ?~ (la:las)
+            & crInv . ix (crSel cr) . itUse . heldConsumption . laProgress ?~ (la:las)
   where
-    ic = cr ^?! crInv . ix (crSel cr) . itConsumption
+    ic = cr ^?! crInv . ix (crSel cr) . itUse . heldConsumption
 
 startLoadAction :: LoadAction -> Creature -> Creature
 startLoadAction la cr = cr & crInvSel . iselAction .~ ReloadAction (_actionTime la) la NoHammer
 
 
-rotateActionProgress :: ItemConsumption -> ItemConsumption
+rotateActionProgress :: HeldConsumption -> HeldConsumption
 rotateActionProgress ic = case ic ^? laProgress . _Just of
     Just (_:la:las) -> ic & laProgress . _Just .~ (la:las)
     _ | _laLoaded ic < _laMax ic -> ic & laProgress ?~ _laCycle ic
     _ -> ic & laProgress .~ Nothing
     
 
-doLoadAction :: LoadAction -> ItemConsumption -> ItemConsumption
+doLoadAction :: LoadAction -> HeldConsumption -> HeldConsumption
 doLoadAction la ic = case la of
     LoadEject {}    -> ic & laLoaded .~ 0 & laPrimed .~ False
     LoadInsert {}   -> ic & laLoaded .~ _laMax ic

src/Dodge/Render/HUD.hs

@@ -80,12 +80,12 @@ subInventoryDisplay subinv cfig w = case subinv of
         , equipcursor -- the order is important, this should go on top of the other equipcursors
         , rboptions
         ]
-    TweakInventory -> pictures
+    TweakInventory mtweaki -> pictures
         --[ mCurs it cfig w
         [ selcursor' listCursorNESW
 --        , cursorsZ cfig curpos it
         , fromMaybe mempty $ do
-            tweaki <-  it ^? _Just . itTweaks . tweakSel
+            tweaki <-  mtweaki
                 -- consider moving this functionality out into a tweaks module
             tparam <- it ^? _Just . itTweaks . tweakParams . ix tweaki
             return $ lnkMidInvSel cfig w curpos tweaki
@@ -234,8 +234,8 @@ lnkMidInvSel cfig w lefti midi = winScale cfig
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
   where
-    f (i:is) = case yourInv w ^? ix i . itConsumption of
+    f (i:is) = case yourInv w ^? ix i . itUse . useAmount of
-        Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
+        Just _ -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
         _ -> mempty
     f _ = mempty
 

src/Dodge/Render/ShapePicture.hs

@@ -27,7 +27,7 @@ import Dodge.Spark.Draw
 import Dodge.RadarBlip
 import Dodge.Flare
 import Dodge.ShortShow
-import Dodge.Config.Data
+import Dodge.Data.Config
 import Dodge.Render.InfoBox
 import Dodge.Debug.Picture
 import Dodge.Picture.SizeInvariant

src/Dodge/Room/Breather.hs

@@ -1,42 +1,21 @@
 module Dodge.Room.Breather where
---import Dodge.Cleat
-import Dodge.Combine.Data
-import Dodge.Data
---import Dodge.PlacementSpot
---import Dodge.RoomLink
---import Dodge.Default.Room
-import Dodge.Item
---import Dodge.Creature
---import Dodge.Room.Pillar
---import Dodge.Room.Girder
---import Dodge.Room.Modify.Girder
---import Dodge.LevelGen.Data
-import RandomHelp
-import Dodge.Tree
---import Dodge.Placement.Instance
---import Dodge.LevelGen.Data
---import Dodge.Room.Procedural
---import Dodge.Room.Corridor
---import Dodge.Room.Tanks
---import Dodge.Room.Link
---import Dodge.Room.Door
---import Dodge.Room.Airlock
-import Dodge.Room.Containing
---import Geometry
---import MonadHelp
---import LensHelp
 
---import qualified Data.Set as S
+import Dodge.Data
+import Dodge.Item
+import Dodge.Room.Containing
+import Dodge.Tree
+import RandomHelp
 
 firstBreather :: State StdGen (MetaTree Room String)
 firstBreather = do
-    itms <- takeOne 
+    itms <-
-        [[itemFromBase $ CRAFT TUBE]
+        takeOne
-        ,[itemFromBase $ CRAFT PIPE]
+            [ [itemFromBase $ CRAFT TUBE]
-        ,[itemFromBase $ CRAFT HARDWARE]
+            , [itemFromBase $ CRAFT PIPE]
-        ,[itemFromBase $ CRAFT CAN]
+            , [itemFromBase $ CRAFT HARDWARE]
-        ,[itemFromBase $ CRAFT TIN]
+            , [itemFromBase $ CRAFT CAN]
-        ,[itemFromBase $ CRAFT PLANK]
+            , [itemFromBase $ CRAFT TIN]
-        ,[itemFromBase $ CRAFT DRUM]
+            , [itemFromBase $ CRAFT PLANK]
-        ]
+            , [itemFromBase $ CRAFT DRUM]
+            ]
     roomsContaining [] itms

src/Dodge/Room/LasTurret.hs

@@ -65,7 +65,7 @@ keyCardRoomRunPast keyid rmid = do
         ]
 
 keyCardAnalyserByDoor :: Int -> Int -> Room -> Room
-keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (KEYCARD keyid))
+keyCardAnalyserByDoor keyid = analyserByDoor (RequireEquipment (HELD (KEYCARD keyid)))
 
 healthAnalyserByDoor :: Int -> Room -> Room
 healthAnalyserByDoor = analyserByDoor (RequireHealth 1100)