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
 

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,31 +1,61 @@
-module Dodge.Bullet 
-    ( updateBullet
-    , useAmmoParams
+module Dodge.Bullet (
+    updateBullet,
+    useAmmoParams,
 ) where
-import Dodge.MagnetBuBu
-import qualified ListHelp as List
-import Dodge.EnergyBall
+
+import Data.Maybe
+import Dodge.Base.Coordinate
+import Dodge.Creature.HandPos
 import Dodge.Creature.Test
 import Dodge.Data
-import Dodge.Creature.HandPos
-import Dodge.Base.Coordinate
+import Dodge.EnergyBall
+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
-import Data.Maybe
-import Dodge.Movement.Turn
-import Dodge.WorldEvent.ThingsHit
-
 updateBullet :: World -> Bullet -> (World, Maybe Bullet)
-updateBullet w bu = case _buState bu of
-    DelayedBullet x -> mvBullet x w bu
-    _ -> mvBullet 1 w bu
+updateBullet w bu = case _buDelayFraction bu of
+    1 -> mvBullet 1 w bu
+    x -> mvBullet x w (bu & buDelayFraction .~ 1)
+
+mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
+mvBullet x w bu
+    | _buTimer bu <= 0 || magV (_buVel bu) < 1 = (endspawn w, Nothing)
+    | 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 =
+    w & cWorld . instantBullets
+        .:~ ( _amBullet bultype
                 & buPos .~ sp
                 & buTrajectory %~ settrajectory
                 & buVel %~ (rotateV dir . (muzvel *.*))
@@ -34,7 +64,7 @@ useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
   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,32 +79,6 @@ 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 (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
@@ -87,23 +91,31 @@ bulletSpawn bu = case _buSpawn bu of
     BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
     BulBall TeslaBall -> Just makeStaticBall
 
-hitEffFromBul :: Float -> Bullet
-    -> [(Point2, Either Creature Wall)]
-    -> World 
-    -> (World,Maybe Bullet)
-hitEffFromBul x bu hitstream w = case _buEffect bu of
+hitEffFromBul ::
+    Float ->
+    World ->
+    Bullet ->
+    (World, Maybe Bullet)
+hitEffFromBul x w bu = case _buEffect bu of
     PenetrateBullet -> movePenBullet x bu hitstream w
     BounceBullet -> case List.safeHead hitstream of
         Nothing -> (w, moveBullet x bu)
         Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
             dir <- bounceDir (hp, crwl)
-            return (w,Just $ bu
+            return
+                ( w
+                , Just $
+                    bu
                         & 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)
@@ -117,34 +129,44 @@ damageThingHit bu (p,crwl) = case crwl of
   where
     dams = setFromToDams bu p
 
-expireAndDamage :: Float
-    -> Bullet
-    -> [(Point2, Either Creature Wall)]
-    -> World
-    -> (World, Maybe Bullet)
+expireAndDamage ::
+    Float ->
+    Bullet ->
+    [(Point2, Either Creature Wall)] ->
+    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 =
+    Just $
+        pt
             & buPos %~ (+.+ x *.* _buVel pt)
             & buOldPos .~ _buPos pt
             & buTimer -~ 1
 
 destroyAt :: Point2 -> Bullet -> Maybe Bullet
-destroyAt hitp pt = Just $ pt 
+destroyAt hitp pt =
+    Just $
+        pt
             & buPos .~ hitp +.+ normalizeV (p -.- hitp)
             & buOldPos .~ p
             & buVel .~ 0
   where
     p = _buPos pt
 
-movePenBullet :: Float -> Bullet -> [(Point2, Either Creature Wall)]
-    -> World -> (World, Maybe Bullet)
+movePenBullet ::
+    Float ->
+    Bullet ->
+    [(Point2, Either Creature Wall)] ->
+    World ->
+    (World, Maybe Bullet)
 movePenBullet x bu hitstream w = case hitstream of
     [] -> (w, moveBullet x bu)
-    ((p,crwl):strm) -> if penThing crwl
+    ((p, crwl) : strm) ->
+        if penThing crwl
             then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w
             else expireAndDamage x bu hitstream w
 

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))]
-splitIcAmounts = concatMap f
+splitItAmounts :: [(ItemBaseType,ItAmount,Int)] -> [((ItAmount,ItemBaseType),(ItAmount,Int))]
+splitItAmounts = concatMap f
   where
     f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
 
-lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
-lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
+lookupItems :: IM.IntMap Item -> [([(ItAmount,Int)],Item)]
+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
-    BELTMAG     -> itConsumption . laMax .~ 150
+    DRUMMAG     -> itUse . heldConsumption . laMax .~ 45
+    BELTMAG     -> itUse . heldConsumption . laMax .~ 150
     MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
-    INCENDBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
-    BOUNCEBUL   -> itConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet 
-    PENBUL    -> itConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet 
-    STATICBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
-    CONCUSBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
+    INCENDBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
+    BOUNCEBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet 
+    PENBUL      -> itUse . heldConsumption . laAmmoType . amBullet . buEffect .~ PenetrateBullet 
+    STATICBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
+    CONCUSBUL   -> itUse . heldConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
-    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
-        . (itConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
-    FLECHETRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
-    BEZIERTRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
+    MAGNETTRAJ  -> (itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
+        . (itUse . heldConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
+    FLECHETRAJ  -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
+    BEZIERTRAJ  -> itUse . heldConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
     INCENDLAS   -> itParams . lasBeam .~ BeamCombine FlameBeamCombine
     SPLITLAS    -> itParams . lasBeam .~ BeamCombine SplitBeamCombine
     STATICLAS   -> (itParams . lasBeam .~ BeamCombine TeslaBeamCombine)
         . (itParams . subParams ?~ teslaParams)
     WEPTELE     -> makeDirectedTele
-    LAUNCHHOME  -> itConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
-    EXTRABATTERY -> itConsumption . laMax +~ 1000
+    LAUNCHHOME  -> itUse . heldConsumption . laAmmoType . amPjCreation .~ CreateTrackingShell
+    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,9 +1,9 @@
-module Dodge.Config.Load
-    ( loadDodgeConfig
+module Dodge.Config.Load (
+    loadDodgeConfig,
 ) where
-import Dodge.Config.Data
 
 import Data.Aeson
+import Dodge.Data.Config
 import System.Directory
 
 loadDodgeConfig :: IO Configuration

src/Dodge/Config/Update.hs

@@ -1,30 +1,30 @@
 {- |
 IO actions that apply config side effects and save configuration settings to disk.
 -}
-module Dodge.Config.Update
-    ( saveConfig
-    , setVolThen
-    , applyWorldConfig
-    , setVol
+module Dodge.Config.Update (
+    saveConfig,
+    setVolThen,
+    applyWorldConfig,
+    setVol,
 ) 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" 
-        $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
+    BS.writeFile "data/dodge.config.json" $
+        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.
 -}
@@ -32,18 +32,20 @@ setVol :: Configuration -> IO ()
 setVol cfig = do
     setSoundVolume (_volume_master cfig * _volume_sound 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
-    :: Configuration 
-    -> PreloadData
-    -> IO PreloadData
+applyWorldConfig ::
+    Configuration ->
+    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,23 +1,23 @@
-module Dodge.Creature.Impulse.UseItem
-    ( useItem
-    , useLeftItem
-    , itemEffect
+module Dodge.Creature.Impulse.UseItem (
+    useItem,
+    useLeftItem,
+    itemEffect,
 ) 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
@@ -28,38 +28,42 @@ useItem cr' w = fromMaybe (f w) $ do
     f = cWorld . creatures . ix (_crID cr') . crHammerPosition .~ HammerDown
 
 itemEffect :: Creature -> Item -> World -> World
-itemEffect cr it w = case it ^? itUse of
-    Just RightUse {_rUse = eff,_useMods = usemods} 
-                    -> hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
-    Just LeftUse {} -> doequipmentchange
-    Just EquipUse{} -> doequipmentchange
+itemEffect cr it w = case it ^. itUse of
+    RightUse{_rUse = eff, _useMods = usemods} ->
+        hammerTest $ tryReload cr it w $ foldr ($) (useHeld eff) (useMod usemods) it cr
+    LeftUse{} -> 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)
-    Just NoUse  -> setuhamdown w
-    Nothing     -> setuhamdown w
+    (ConsumeUse eff _) -> setuhamdown $ hammerTest $ useC eff it cr . rmInvItem (_crID cr) (crSel cr)
+    CraftUse{} -> 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
-        . activateEquipmentAt (_rbOptions w) cr)
+    doequipmentchange =
+        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
-        = crToggleReloading cr
-    | otherwise 
-        = (runIdentity . pointToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
+    | _crID cr == _yourID (_cWorld w) && itNeedsLoading it && _mouseButtons w M.!? SDL.ButtonLeft == Just False =
+        crToggleReloading cr
+    | otherwise =
+        (runIdentity . pointerToItem (_itPos it) (return . (itUse . useHammer .~ HammerDown)))
             . 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 =
+    cWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
         (Just i, _) -> crLeftInvSel ?~ i
         (_, Just _) -> crLeftInvSel .~ Nothing
         _ -> id
@@ -67,31 +71,31 @@ activateEquipmentAt rbo cr = cWorld . creatures . ix (_crID cr) %~ case (rbo ^?
 toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
 toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     Just DoNotMoveEquipment -> w
-    Just PutOnEquipment {_allocNewPos = newp}
-        -> w 
+    Just PutOnEquipment{_allocNewPos = newp} ->
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & onequip itm cr
-    Just MoveEquipment {_allocNewPos=newp,_allocOldPos = oldp }
-        -> w 
+    Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
+        w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid ?~ newp
-    Just SwapEquipment {_allocNewPos=newp, _allocOldPos = oldp, _allocSwapID = sid }
-        -> w 
+    Just SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
+        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 }
-        -> w 
+    Just ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
+        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 }
-        -> w 
+    Just RemoveEquipment{_allocOldPos = oldp} ->
+        w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid .~ Nothing
             & onremove itm cr
@@ -112,13 +116,15 @@ useLeftItem cid w
         itm <- cr ^? crInv . ix invid
         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 . cUse)
             || ( isJust (cr ^? crInv . ix (crSel cr) . itUse . eqEq . eqUse)
                     && _crLeftInvSel cr /= Just (crSel cr)
                )
+
 -- 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
-    AutoRecharging l m t p
-        | l < m && p <= 0 -> it & itConsumption .~ AutoRecharging (l+1) m t t
-        | l < m -> it & itConsumption . arProgress -~ 1
+updateAutoRecharge it = case it ^? itUse . leftConsumption of
+    Just (AutoRecharging l m t p)
+        | l < m && p <= 0 -> it & itUse . leftConsumption .~ AutoRecharging (l+1) m t t
+        | l < m -> it & itUse . leftConsumption . arProgress -~ 1
     _ -> it
 doItemTargeting :: Int -> Creature -> World -> World
 doItemTargeting invid cr w = case cr ^? crInv . ix invid . itTargeting of

src/Dodge/Creature/Statistics.hs

@@ -1,16 +1,16 @@
-module Dodge.Creature.Statistics 
-    ( getCrStrength
-    , getCrDexterity
+module Dodge.Creature.Statistics (
+    getCrStrength,
+    getCrDexterity,
 ) 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)
 
@@ -27,12 +27,16 @@ equipmentStrValue itm = case _iyBase $ _itType itm of
     _ -> 0
 
 crCurrentEquipment :: Creature -> IM.IntMap Item
-crCurrentEquipment cr = merge dropMissing dropMissing (zipWithMatched (\_ _ itm -> itm))
+crCurrentEquipment cr =
+    merge
+        dropMissing
+        dropMissing
+        (zipWithMatched (\_ _ itm -> itm))
         (_crInvEquipped cr)
         (_crInv cr)
 
 strFromHeldItem :: Creature -> Int
 strFromHeldItem cr
-    | _posture (_crStance cr) == Aiming || crIsReloading cr
-        = negate $ fromMaybe 0 $ cr ^? crInv . ix (crSel cr) . itUse . useAim . aimWeight
+    | _posture (_crStance cr) == Aiming || crIsReloading cr =
+        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.Distortion.Data,
+    module Dodge.Data.Distortion,
     module Dodge.Data.Damage,
     module Dodge.Data.SoundOrigin,
-    module Dodge.Config.Data,
+    module Dodge.Data.Config,
     module MaybeHelp,
-    module Dodge.Data.ItemAmount,
-    module Dodge.RoomCluster.Data,
+    module Dodge.Data.RoomCluster,
     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.Config.Data
+import Dodge.Data.Config
 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.RoomCluster.Data
+import Dodge.Data.Distortion
+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)
-
-instance ToJSON ActionPlan where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON ActionPlan
+    deriving (Eq, Ord, Show, Read)
 
 data RandImpulse
     = RandImpulseList [Impulse]
     | RandImpulseCircMove Float
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON RandImpulse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON RandImpulse
+    deriving (Eq, Ord, Show, Read)
 
 data Impulse
     = Move Point2
@@ -70,12 +58,7 @@ data Impulse
         { _impulseUseAheadPos :: P2Imp
         }
     | ImpulseNothing
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Impulse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Impulse
+    deriving (Eq, Ord, Show, Read)
 
 infixr 9 `WaitThen`
 
@@ -182,12 +165,7 @@ data Action
         { _sideImpulses :: [Impulse]
         , _mainAction :: Action
         }
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Action where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Action
+    deriving (Eq, Ord, Show, Read)
 
 data Strategy
     = Flank Int
@@ -205,24 +183,20 @@ data Strategy
     | Reload
     | Flee
     | MeleeStrike
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Strategy where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Strategy
+    deriving (Eq, Ord, Show, Read)
 
 data Goal
     = LiveLongAndProsper
     | Kill Int
     | SentinelAt Point2 Float
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Goal where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Goal
+    deriving (Eq, Ord, Show, Read)
 
+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,24 +1,22 @@
-{-# 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)
-instance ToJSON ProjectileDraw  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileDraw 
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
 data ProjectileCreate = CreateShell | CreateTrackingShell
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
-instance ToJSON ProjectileCreate  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileCreate 
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
 data ProjectileUpdate
     = PJThrust {_pjuStart :: Int, _pjuEnd :: Int}
     | PJSpin {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
@@ -27,10 +25,8 @@ data ProjectileUpdate
     | 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)
-instance ToJSON ProjectileUpdate  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProjectileUpdate 
+    deriving (Show, Read, Eq, Ord)
+
 data AmmoType
     = ProjectileAmmo
         { _amPayload :: Payload
@@ -52,9 +48,11 @@ data AmmoType
         { _amForceFieldType :: Wall
         }
     | GenericAmmo
- deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON AmmoType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AmmoType
+    deriving (Eq, Ord, Show, Read)
+
 makeLenses ''ProjectileUpdate
 makeLenses ''AmmoType
+deriveJSON defaultOptions ''ProjectileDraw
+deriveJSON defaultOptions ''ProjectileCreate
+deriveJSON defaultOptions ''ProjectileUpdate
+deriveJSON defaultOptions ''AmmoType

src/Dodge/Data/Bullet.hs

@@ -1,14 +1,17 @@
 {-# 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
     , _buSpawn :: BulletSpawn
     , _buUpdateMod :: BulletUpdateMod
@@ -21,46 +24,34 @@ data Bullet = Bullet
     , _buTimer :: Int
     , _buDamages :: [Damage]
     }
-  deriving (Show,Read,Eq,Ord,Generic)
-instance ToJSON Bullet  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Bullet 
+    deriving (Show, Read, Eq, Ord)
+
 data EnergyBallType = IncBall | TeslaBall | ConcBall
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
-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 
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
 data BulletUpdateMod = NoBulletUpdateMod
-  deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic)
-instance ToJSON BulletUpdateMod  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletUpdateMod 
+    deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
 data BulletEffect
     = DestroyBullet
     | BounceBullet
     | PenetrateBullet
-  deriving (Eq,Ord,Show,Read,Enum,Bounded,Generic)
-instance ToJSON BulletEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletEffect 
+    deriving (Eq, Ord, Show, Read, Enum, Bounded)
+
 data BulletSpawn = BulBall EnergyBallType | BulSpark
-  deriving (Show,Read,Eq,Ord,Generic)
-instance ToJSON BulletSpawn  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletSpawn 
+    deriving (Show, Read, Eq, Ord)
+
 data BulletTrajectory
     = BasicBulletTrajectory
     | BezierTrajectory Point2 Point2 Point2
     | FlechetteTrajectory Point2
     | MagnetTrajectory Point2
-  deriving (Show,Read,Eq,Ord,Generic)
-instance ToJSON BulletTrajectory where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BulletTrajectory
+    deriving (Show, Read, Eq, Ord)
+
 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)
-
-instance ToJSON WorldBeams where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON WorldBeams
+    deriving (Eq, Ord, Show, Read)
 
+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,31 +1,33 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Creature 
-    ( module Dodge.Data.Creature
-    , module Dodge.Data.Creature.Misc
-    , module Dodge.Data.Creature.State
-    , module Dodge.Data.Creature.Perception
-    , module Dodge.Data.Creature.Memory
-    , module Dodge.Data.Creature.Stance
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Creature (
+    module Dodge.Data.Creature,
+    module Dodge.Data.Creature.Misc,
+    module Dodge.Data.Creature.State,
+    module Dodge.Data.Creature.Perception,
+    module Dodge.Data.Creature.Memory,
+    module Dodge.Data.Creature.Stance,
 ) where
-import GHC.Generics
+
+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 Dodge.Data.Hammer
-import Dodge.Data.Creature.Perception
-import Dodge.Data.Creature.Memory
-import Dodge.Data.Creature.Stance
+import GHC.Generics
 import Geometry.Data
 import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
 
-import Control.Lens
 data Creature = Creature
     { _crPos :: Point2
     , _crOldPos :: Point2
@@ -66,23 +68,32 @@ data Creature = Creature
     , _crStatistics :: CreatureStatistics
     , _crCamouflage :: CamouflageStatus
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 instance ToJSON Creature where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Creature
+
 data CreatureCorpse = MakeDefaultCorpse
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON CreatureCorpse where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON CreatureCorpse
+
 data Intention = Intention
     { _targetCr :: Maybe Creature
     , _mvToPoint :: Maybe Point2
     , _viewPoint :: Maybe Point2
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 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,29 +1,38 @@
 {-# 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)
+
 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}
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON SubInventory where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON SubInventory
+
 data HUD = HUD
     { _hudElement :: HUDElement
     , _carteCenter :: Point2
@@ -31,9 +40,12 @@ data HUD = HUD
     , _carteRot :: Float
     }
     deriving (Eq, Ord, Show, Read, Generic)
+
 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,33 +1,35 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Item 
-    ( module Dodge.Data.Item
-    , module Dodge.Data.Item.Misc
-    , module Dodge.Data.Item.Tweak
-    , module Dodge.Data.Item.Params
-    , module Dodge.Data.Item.Use
-    , module Dodge.Data.Item.Consumption
-    , module Dodge.Data.Item.CurseStatus
-    , module Dodge.Data.Item.Attachment
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Item (
+    module Dodge.Data.Item,
+    module Dodge.Data.Item.Effect,
+    module Dodge.Data.Item.Misc,
+    module Dodge.Data.Item.Tweak,
+    module Dodge.Data.Item.Params,
+    module Dodge.Data.Item.Use,
+    module Dodge.Data.Item.CurseStatus,
+    module Dodge.Data.Item.Attachment,
+    module Dodge.Data.Item.Combine,
+    module Dodge.Data.Item.Targeting,
 ) where
-import GHC.Generics
-import Data.Aeson
+
+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.Targeting
-import Dodge.Combine.Data
-import Dodge.Data.Item.Attachment
-import Color
+import Dodge.Data.Item.Tweak
+import Dodge.Data.Item.Use
+import Dodge.Data.Item.Targeting
+
 data Item = Item
-    { _itConsumption    :: ItemConsumption
-    , _itUse        :: ItemUse
+    { _itUse :: ItemUse
     , _itType :: ItemType
     , _itAttachment :: ItAttachment
     , _itID :: Maybe Int
@@ -44,8 +46,7 @@ data Item = Item
     , _itValue :: ItemValue
     , _itParams :: ItemParams
     }
-   deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Item  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Item 
+    deriving (Eq, Show, Read)
+
 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
-    where
-import GHC.Generics
-import Data.Aeson
-import Geometry.Data
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Item.Attachment where
+
 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}
-    | AttachCharMode {_atCharMode :: Seq.Seq Char }
     | AttachTargetPos {_atTargetPos :: Point2}
     | AttachInt {_atInt :: Int}
     | AttachMInt {_atMInt :: Maybe Int}
     | AttachFloat {_atFloat :: Float}
     | AttachBool {_atBool :: Bool}
     | NoItAttachment
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItAttachment  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItAttachment 
-data Scope = NoScope
+    deriving (Eq, Ord, Show, Read)
+
+data Scope
+    = NoScope
     | RemoteScope
-        {_scopePos        :: Point2 -- ^ a camera offset
+        { -- | a camera offset
+          _scopePos :: Point2
         , _scopeZoom :: Float
-        ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
+        , -- | if the camera offset is also the center of vision
+          _scopeIsCamera :: Bool
         }
     | ZoomScope
-        {_scopePos        :: Point2 -- ^ a camera offset
+        { -- | a camera offset
+          _scopePos :: Point2
         , _scopeZoomChange :: Int
         , _scopeZoom :: Float
         , _scopeDefaultZoom :: Float
-        ,_scopeIsCamera   :: Bool   -- ^ if the camera offset is also the center of vision
+        , -- | if the camera offset is also the center of vision
+          _scopeIsCamera :: Bool
         }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Scope  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Scope 
+    deriving (Eq, Ord, Show, Read)
+
 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
-import GHC.Generics
-import Data.Aeson
-import Dodge.Data.Equipment.Misc
-import Dodge.Data.ItemAmount
+
+module Dodge.Data.Item.Combine where
+
+import Dodge.Data.Item.Use.Consumption
 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
     , _iyModules :: M.Map ModuleSlot ItemModuleType
     , _iyStack :: Stack
     }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItemType  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemType 
-data Stack = NoStack | Stack IcAmount
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Stack  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Stack 
+    deriving (Eq, Ord, Show, Read)
+
+data Stack = NoStack | Stack ItAmount
+    deriving (Eq, Ord, Show, Read)
+
 data CraftType
     = PIPE
     | TUBE
@@ -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)
-instance ToJSON CraftType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CraftType
--- TODO make this an enum somehow...?
+    deriving (Eq, Ord, Show, Enum, Read)
+
 data ItemBaseType
-    = NOTDEFINED
-    | EFFGUN String
-    | AUTOEFFGUN String
-    -- Weapons
-    | HELD {_ibtHeld :: HeldItemType}
+    = HELD {_ibtHeld :: HeldItemType}
     | LEFT {_ibtLeft :: LeftItemType}
     | EQUIP {_ibtEquip :: EquipItemType}
---    | GRENADE
---    | REMOTEBOMB
-    -- Utility items
-    -- Equipment
-    --
-    | KEYCARD Int
-    --
-    | MEDKIT Int
+    | Consumable {_ibtConsumable :: ConsumableItemType}
     | CRAFT CraftType
-    --
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItemBaseType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemBaseType
+    deriving (Eq, Ord, Show, Read)
+
+data ConsumableItemType
+    = MEDKIT Int
+    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)
-instance ToJSON EquipItemType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON EquipItemType
+    deriving (Eq, Ord, Show, Read)
+
 data LeftItemType
     = BOOSTER
     | REWINDER
@@ -126,10 +105,8 @@ data LeftItemType
     | BLINKERUNSAFE
     | SHRINKER
     | SPAWNER
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON LeftItemType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON LeftItemType
+    deriving (Eq, Ord, Show, Read)
+
 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
---    | MINIGUN
-    | MINIGUNX {_xNum :: Int}
+      MINIGUNX {_xNum :: Int}
     | VOLLEYGUN {_xNum :: Int}
     | RIFLE
     | REPEATER
     | AUTORIFLE
     | BURSTRIFLE
---    | FASTBURSTRIFLE
+    | --    | FASTBURSTRIFLE
       --    | COMPLETEBURSTRIFLE
-    | BANGROD
+      BANGROD
     | ELEPHANTGUN
     | AMR
     | AUTOAMR
@@ -167,33 +143,30 @@ data HeldItemType
     | TESLAGUN
     | LASGUN
     | LASCIRCLE
---    | LASPULSE
-    | DUALBEAM
---    | LASGUNSWING
+    | --    | LASPULSE
+      DUALBEAM
+    | --    | LASGUNSWING
+
       -- | LASGUNSWAY
       --    | LASGUNWIDEPULSE
-    | LASWIDE {_xNum :: Int}
-    -- | LASGUNFOCUS Int
+      LASWIDE {_xNum :: Int}
+    | -- | LASGUNFOCUS Int
       -- | SONICGUN
-    | TRACTORGUN
+      TRACTORGUN
     | LAUNCHER
     | LAUNCHERX {_xNum :: Int}
---    | TRACKINGLAUNCHER
-    | REMOTELAUNCHER
+    | --    | TRACKINGLAUNCHER
+      REMOTELAUNCHER
     | POISONSPRAYER
     | DRONELAUNCHER
-    
     | SHATTERGUN
-
     | FORCEFIELDGUN
-
     | HELDDETECTOR Detector
     | TORCH
     | FLATSHIELD
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON HeldItemType where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON HeldItemType
+    | KEYCARD Int
+    deriving (Eq, Ord, Show, Read)
+
 data ItemModuleType
     = EMPTYMODULE
     | DRUMMAG
@@ -217,18 +190,14 @@ data ItemModuleType
     | LAUNCHHOME
     | EXTRABATTERY
     | ATTACHTORCH
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItemModuleType  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemModuleType 
+    deriving (Eq, Ord, Show, Read)
+
 data Detector
     = ITEMDETECTOR
     | CREATUREDETECTOR
     | WALLDETECTOR
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Detector where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Detector
+    deriving (Eq, Ord, Show, Read)
+
 data ModuleSlot
     = ModBullet
     | ModBulletSpawn
@@ -241,12 +210,23 @@ data ModuleSlot
     | ModTeleport
     | ModDualBeam
     | ModHeldAttach
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ModuleSlot where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ModuleSlot
+    deriving (Eq, Ord, Show, Read)
+
 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
-  deriving (Eq,Ord,Enum,Bounded,Show,Read,Generic)
-instance ToJSON HeldScroll  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON HeldScroll 
+import Data.Aeson.TH
+import qualified Data.Sequence as Seq
+
+data 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)
-
-instance ToJSON HeldUse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON HeldUse
+    deriving (Eq, Ord, Show, Read)
 
 data Cuse
     = CDoNothing
     | CHeal Int
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Cuse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Cuse
+    deriving (Eq, Ord, Show, Read)
 
 data Euse
     = EDoNothing
@@ -50,12 +40,7 @@ data Euse
     | ECamouflage CamouflageStatus
     | EonWristShield
     | EoffWristShield
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Euse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Euse
+    deriving (Eq, Ord, Show, Read)
 
 data Luse
     = LDoNothing
@@ -64,12 +49,7 @@ data Luse
     | LBlink
     | LUnsafeBlink
     | LBoost
-    deriving (Eq, Ord, Show, Read, Generic)
-
-instance ToJSON Luse where
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON Luse
+    deriving (Eq, Ord, Show, Read)
 
 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
-    toEncoding = genericToEncoding defaultOptions
-
-instance FromJSON HeldMod
+deriveJSON defaultOptions ''Cuse
+deriveJSON defaultOptions ''HeldMod
+deriveJSON defaultOptions ''Euse
+deriveJSON defaultOptions ''HeldUse
+deriveJSON defaultOptions ''Luse

src/Dodge/Data/Item/Params.hs

@@ -1,14 +1,16 @@
-{-# 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
@@ -57,15 +59,16 @@ data ItemParams
         , _previousArcEffect :: PreviousArcEffect
         }
     | ParamMID {_paramMID :: Maybe Int}
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ItemParams where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemParams
+    | BoostPropIX {_boostPropIX :: Maybe Int}
+    deriving (Eq, Ord, Show, Read)
+
+
+
 data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON PreviousArcEffect  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON PreviousArcEffect 
+    deriving (Eq, Ord, Show, Read)
+
+
+
 data GunBarrels
     = MultiBarrel
         { _brlSpread :: BarrelSpread
@@ -77,10 +80,10 @@ data GunBarrels
         , _brlInaccuracy :: Float
         }
     | SingleBarrel {_brlInaccuracy :: Float}
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON GunBarrels where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON GunBarrels
+    deriving (Eq, Ord, Show, Read)
+
+
+
 data Nozzle = Nozzle
     { _nzPressure :: Float
     , _nzDir :: Float
@@ -89,19 +92,24 @@ data Nozzle = Nozzle
     , _nzWalkSpeed :: Float
     , _nzLength :: Float
     }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Nozzle  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Nozzle 
+    deriving (Eq, Ord, Show, Read)
+
+
+
 data BarrelSpread
     = AlignedBarrels
     | SpreadBarrels {_spreadAngle :: Float}
     | RotatingBarrels {_rotatingBarrelInaccuracy :: Float}
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON BarrelSpread where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON BarrelSpread
+    deriving (Eq, Ord, Show, Read)
+
+
+
 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
-    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON ItemUse where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItemUse
+    | CraftUse
+        {_useAmount :: ItAmount}
+    deriving (Eq, Show, Read)
+
 data AimParams = AimParams
     { _aimWeight :: Int
     , _aimRange :: Float
@@ -53,28 +56,26 @@ data AimParams = AimParams
     , _aimHandlePos :: Float
     , _aimMuzPos :: Float
     }
-    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON AimParams where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AimParams
+    deriving (Eq, Ord, Show, Read)
+
 data AimStance
     = TwoHandTwist
     | TwoHandFlat
     | OneHand
     | LeaveHolstered
-    deriving (Eq, Show, Ord, Enum, Read, Generic)
-instance ToJSON AimStance where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON AimStance
+    deriving (Eq, Show, Ord, Enum, Read)
+
 data ItZoom = ItZoom
     { _itZoomMax :: Float
     , _itZoomMin :: Float
     , _itZoomFac :: Float
     }
-    deriving (Eq, Ord, Show, Read, Generic)
-instance ToJSON ItZoom where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ItZoom
+    deriving (Eq, Ord, Show, Read)
+
 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,30 +1,36 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Machine
-    where
-import GHC.Generics
-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
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Machine where
+
 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
-data MachineDraw = MachineDrawMempty
+import Dodge.Data.Damage
+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)
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON MachineDraw where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON MachineDraw
+
 data Machine = Machine
     { _mcID :: Int
     , _mcWallIDs :: IS.IntSet
@@ -41,10 +47,13 @@ data Machine = Machine
     , _mcName :: String
     , _mcCloseSound :: Maybe SoundID
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 instance ToJSON Machine where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Machine
+
 data MachineType
     = StaticMachine
     | Turret
@@ -53,9 +62,12 @@ data MachineType
         , _tuFireTime :: Int
         , _tuMCrID :: Maybe Int
         }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 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
-import qualified Data.Set as S
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.RoomCluster where
+
 import Control.Lens
+import qualified Data.Set as S
 
 data ClusterStatus = ClusterStatus
     { _csName :: String

src/Dodge/Data/Sensor.hs

@@ -1,13 +1,16 @@
-{-# 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
@@ -19,22 +22,19 @@ data Sensor = NoSensor
         , _proxRequirement :: ProximityRequirement
         , _sensToggle :: Bool
         }
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON Sensor  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON Sensor 
+    deriving (Eq, Ord, Show, Read)
+
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}
     | RequireEquipment {_proxReqEquipment :: ItemBaseType}
     | RequireImpossible
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON ProximityRequirement where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON ProximityRequirement
+    deriving (Eq, Ord, Show, Read)
+
 data CloseToggle = NotClose | IsClose
-  deriving (Eq,Ord,Show,Read,Generic)
-instance ToJSON CloseToggle  where
-    toEncoding = genericToEncoding defaultOptions
-instance FromJSON CloseToggle 
+    deriving (Eq, Ord, Show, Read)
+
 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,35 +1,47 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Data.Terminal
-    where
-import GHC.Generics
-import Data.Aeson
-import Dodge.Data.WorldEffect
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Terminal where
+
 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)
+
 instance ToJSON TerminalStatus where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalStatus
+
 data TerminalInput = TerminalInput
     { _tiText :: T.Text
     , _tiFocus :: Bool
     , _tiSel :: (Int, Int)
     }
     deriving (Eq, Ord, Show, Read, Generic)
+
 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
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalBootProgram
+
 data Terminal = Terminal
     { _tmID :: Int
     , _tmBootProgram :: TerminalBootProgram -- Terminal -> World -> [TerminalLine]
@@ -48,22 +60,32 @@ data Terminal = Terminal
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 instance ToJSON Terminal where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON Terminal
+
 data TerminalLineString = TerminalLineConst String Color
     deriving (Eq, Ord, Show, Read, Generic)
+
 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)
+
 instance ToJSON TmTm where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TmTm
+
 data TerminalLine
     = TerminalLineDisplay
         { _tlPause :: Int
@@ -77,36 +99,50 @@ data TerminalLine
         { _tlPause :: Int
         , _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)
+
 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)
+
 instance ToJSON BlBl where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON BlBl
+
 data EffectArguments
     = NoArguments {_cmdEffect :: [TerminalLine]}
     | OneArgument
         { _argType :: String
         , _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
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON TerminalCommandEffect
+
 data TerminalCommand = TerminalCommand
     { _tcString :: String
     , _tcAlias :: [String]
     , _tcHelp :: String
     , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
     }
-  deriving (Eq,Ord,Show,Read,Generic)
+    deriving (Eq, Show, Read, Generic)
+
 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 Geometry.Data
+import Dodge.Data.Item
 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)
+
 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,25 +36,37 @@ 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
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdWd
-data WdP2 = WdP2Const Point2
+
+data WdP2
+    = WdP2Const Point2
     | WdYouPos
     deriving (Eq, Ord, Show, Read, Generic)
+
 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)
+
 instance ToJSON MdWdWd where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON MdWdWd
-data WdBl = WdTrig Int
+
+data WdBl
+    = WdTrig Int
     | WdBlDoorMoving Int
     | WdBlConst Bool
     | WdBlNegate WdBl
@@ -55,29 +74,43 @@ data WdBl = WdTrig Int
     | WdBlBtOn Int
     | WdBlBtNotOff Int
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON WdBl where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdBl
-data WdP2f = WdP2f0
+
+data WdP2f
+    = WdP2f0
     | WdP2fDoorPosition Int
     deriving (Eq, Ord, Show, Read, Generic)
+
 instance ToJSON WdP2f where
     toEncoding = genericToEncoding defaultOptions
+
 instance FromJSON WdP2f
-data DrWdWd = DrWdId
+
+data DrWdWd
+    = DrWdId
     | DrWdMakeDoorDebris
     | DrWdMechanismStepwise Int [Int] [(Point2, Point2)]
     | DoorMechanism
     deriving (Eq, Ord, Show, Read, Generic)
+
 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
     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}
-    , _itInvColor = blue
-    }
+    & itUse .~ ConsumeUse CDoNothing 1
+    & 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
-    ( defaultItem
+module Dodge.Default.Item (
+    defaultItem,
 ) where
-import Dodge.Data
-import Picture
+
+import Dodge.Data.Item
 import Geometry.Data
---import Shape
+import Picture
 
 defaultItem :: Item
-defaultItem = Item
+defaultItem =
+    Item
         { _itCurseStatus = Uncursed
         , _itType = defaultItemType
---    , _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itEffect = NoItEffect
+        , --    , _itEquipPict = \_ _ -> (,) emptySH blank
+          _itEffect = NoItEffect
         , _itID = Nothing
         , _itIsHeld = False
         , _itInvColor = yellow
         , _itInvSize = 1
         , _itPos = VoidItm
         , _itDimension = ItemDimension 2 0 (V3 10 (-5) 3)
-    , _itConsumption = NoConsumption
-    , _itUse = NoUse
-    , _itAttachment = NoItAttachment
+        , _itUse = CraftUse (ItAmount 1)
         , _itParams = NoParams
         , _itTweaks = NoTweaks
         , _itScope = NoScope
         , _itTargeting = NoTargeting
         , _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,21 +1,22 @@
-module Dodge.Default.Weapon
-    where
-import Dodge.Data
-import Dodge.Reloading.Action
-import Dodge.Item.Weapon.Bullet
-import Dodge.Default.Item
+module Dodge.Default.Weapon where
+
+import Control.Lens
+import qualified Data.Map.Strict as M
+import Dodge.Data.Ammo
+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
-import Control.Lens
-
-defaultLeftLoadable :: ItemConsumption
+defaultLeftLoadable :: LeftConsumption
 defaultLeftLoadable = AutoRecharging 10 10 100 100
 
-defaultLoadable :: ItemConsumption
-defaultLoadable = LoadableAmmo 
+defaultLoadable :: HeldConsumption
+defaultLoadable =
+    LoadableAmmo
         { _laAmmoType = GenericAmmo
         , _laMax = 15
         , _laLoaded = 0
@@ -23,29 +24,38 @@ defaultLoadable = LoadableAmmo
         , _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 =
+    RightUse
         { _rUse = HeldDoNothing
         , _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
         , _useMods = HeldModNothing
         , _useHammer = HammerUp
         , _useAim = defaultAimParams
         , _heldScroll = HeldScrollDoNothing
+        , _heldConsumption = defaultLoadable
         }
+
 defaultlUse :: ItemUse
-defaultlUse = LeftUse
+defaultlUse =
+    LeftUse
         { _lUse = LDoNothing
         , _useDelay = FixedRate{_rateMax = 8, _rateTime = 0}
         , _useHammer = HammerUp
         , _eqEq = defaultEquip
+        , _leftConsumption = defaultLeftLoadable
         }
+
 defaultEquip :: Equipment
-defaultEquip = Equipment
+defaultEquip =
+    Equipment
         { _eqSite = GoesOnSpecial
         , _eqUse = EDoNothing
         , _eqOnEquip = EDoNothing
@@ -55,28 +65,32 @@ defaultEquip = Equipment
         }
 
 luseInstantNoH :: Luse -> ItemUse
-luseInstantNoH f = defaultlUse 
+luseInstantNoH f =
+    defaultlUse
         & lUse .~ f
         & useDelay .~ NoDelay
 
 -- TODO change this
 defaultLeftItem :: Item
-defaultLeftItem = defaultWeapon
-    & itConsumption .~ defaultLeftLoadable
+defaultLeftItem =
+    defaultWeapon
+        & itUse .~ defaultlUse
 
 defaultWeapon :: Item
-defaultWeapon = defaultItem 
-    & itConsumption .~ defaultLoadable
+defaultWeapon =
+    defaultItem
         & itUse .~ defaultrUse
         & itInvColor .~ white
-    & itType . iyModules .~ M.fromList 
+        & itType . iyModules
+            .~ M.fromList
                 [ (ModTarget, EMPTYMODULE)
                 , (ModTeleport, EMPTYMODULE)
                 ]
 
 defaultBulletWeapon :: Item
-defaultBulletWeapon = defaultWeapon 
-    & itConsumption .~ defaultBulletLoadable 
+defaultBulletWeapon =
+    defaultWeapon
+        & itUse . heldConsumption .~ defaultBulletLoadable
         & itUse . rUse .~ HeldUseAmmoParams -- useAmmoParams
         & itType . iyModules . at ModBullet ?~ EMPTYMODULE
         & itType . iyModules . at ModBulletSpawn ?~ EMPTYMODULE
@@ -84,12 +98,16 @@ defaultBulletWeapon = defaultWeapon
 
 defaultItemValue :: ItemValue
 defaultItemValue = ItemValue 10 MundaneItem
+
 defaultCraftable :: Item
-defaultCraftable = defaultItem 
+defaultCraftable =
+    defaultItem
         { _itInvColor = green
         }
+
 defBulletShooter :: ItemParams
-defBulletShooter = BulletShooter
+defBulletShooter =
+    BulletShooter
         { _muzVel = 1
         , _rifling = 0.8
         , _bore = 2
@@ -100,5 +118,6 @@ defBulletShooter = BulletShooter
         }
 
 defaultAutoGun :: Item
-defaultAutoGun = defaultBulletWeapon 
+defaultAutoGun =
+    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)
-    (_crInvEquipped cr)  (_crInv cr) 
+getCrEquipment cr =
+    merge
+        dropMissing
+        dropMissing
+        (zipWithMatched $ \_ _ -> id)
+        (_crInvEquipped cr)
+        (_crInv cr)

src/Dodge/Event.hs

@@ -11,27 +11,27 @@ 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
-    ( handleEvent
+module Dodge.Event (
+    handleEvent,
 ) 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)
@@ -46,7 +46,10 @@ handleEvent e = case eventPayload e of
     _ -> return . Just
 
 handleMouseMotionEvent :: MouseMotionEventData -> Universe -> Maybe Universe
-handleMouseMotionEvent mmev u = Just $ u & uvWorld . mousePos .~ V2
+handleMouseMotionEvent mmev u =
+    Just $
+        u & uvWorld . mousePos
+            .~ V2
                 (fromIntegral x - 0.5 * _windowX cfig)
                 (0.5 * _windowY cfig - fromIntegral y)
   where
@@ -60,19 +63,23 @@ handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
   where
     thebutton = mouseButtonEventButton mbev
 
-{- | Sets window position in config. -}
+-- | Sets window position in config.
 handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Maybe Universe
-handleWindowMoveEvent mev = Just
+handleWindowMoveEvent mev =
+    Just
         . (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 =
+    return . Just $
+        u
             & uvConfig . windowX .~ fromIntegral x
             & uvConfig . windowY .~ fromIntegral y
             & uvIOEffects %~ sideEffectUpdatePreload divRes x y
@@ -104,29 +111,36 @@ wheelEvent y w = case _hudElement $ _hud (_cWorld w) of
         | lbDown -> w & cWorld . cameraZoom +~ y
         | invKeyDown -> changeSwapInvSel 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
-    DisplayInventory (CombineInventory _) -> w
+    DisplayInventory CombineInventory{} ->
+        w
             & cWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
     DisplayInventory (DisplayTerminal tmid)
-        | rbDown && inTermFocus w -> guardDisconnectedID tmid w $ w
+        | rbDown && inTermFocus w ->
+            guardDisconnectedID tmid w $
+                w
                     & cWorld . terminals . ix tmid %~ updatetermsubsel
-        | inTermFocus w -> w
+        | inTermFocus w ->
+            w
                 & cWorld . terminals . ix tmid %~ updatetermsel
     _ -> w
   where
     updatetermsel tm = case tm ^? tmInput . tiSel of
         Nothing -> tm & tmInput . tiSel .~ (0, 0)
-        Just (i,_) -> let newi = (i - yi) `mod` length (scrollCommands tm)
+        Just (i, _) ->
+            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)
-        Just (i,j) -> let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
+        Just (i, j) ->
+            let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
              in tm & setInput i newj w
-    setInput i j w' tm = tm
+    setInput i j w' tm =
+        tm
             & tmInput . tiSel .~ (i, j)
             & tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
       where
@@ -149,8 +163,10 @@ getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
 
 scrollCommands :: Terminal -> [TerminalCommand]
 scrollCommands = (nullCommand :) . _tmScrollCommands
+
 nullCommand :: TerminalCommand
-nullCommand = TerminalCommand
+nullCommand =
+    TerminalCommand
         { _tcString = ""
         , _tcAlias = []
         , _tcHelp = ""
@@ -165,16 +181,16 @@ scrollRBOption y 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))
-                    . itTweaks . tweakSel %~ (`mod` length l) . subtract i
+    Just l -> w & cWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
     _ -> w
-changeTweakParam :: Int -> World -> World
-changeTweakParam i w = w
-    & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w)) %~
-        ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
-        . doTweak (_tweakType params) x)
-  where
-    tweaks = _itTweaks . fromJust $ yourItem w
-    params = _tweakParams tweaks IM.! paramid
-    x = (_tweakVal params + i) `mod` _tweakMax params
-    paramid = _tweakSel tweaks
+
+changeTweakParam :: Maybe Int -> Int -> World -> World
+changeTweakParam mi i w = fromMaybe w $ do
+    paramid <- mi
+    params <- yourItem w ^? _Just . itTweaks . tweakParams . ix paramid
+    let x = (_tweakVal params + i) `mod` _tweakMax params
+    return $
+        w & cWorld . creatures . ix (_yourID (_cWorld w)) . crInv . ix (crSel (you w))
+            %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
+                    . 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 he = case he of
-    DisplayInventory TweakInventory -> DisplayInventory NoSubInventory
-    _                               -> DisplayInventory TweakInventory
+toggleTweakInv :: World -> World
+toggleTweakInv w = case w ^. cWorld . hud . hudElement of
+    DisplayInventory TweakInventory{} -> w & thepointer .~ DisplayInventory NoSubInventory
+    _                               ->  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
-scrollCharMode
-    :: Float    -- ^ Amount scrolled
-    -> Creature
-    -> Item
-    -> Item
-scrollCharMode x _ 
-    | x > 0 = incCharMode
-    | x < 0 = decCharMode
-    | otherwise = id
+    HeldScrollCharMode {} -> \ x _ -> itUse . heldScroll . hsCharMode %~ cycleSignum x
+    HeldScrollInt {} -> undefined
 
-incCharMode 
-    :: Item 
-    -> Item
-incCharMode = itAttachment . atCharMode %~ cycleL
-  where
+cycleSignum :: Float -> Seq a -> Seq a
+cycleSignum x
+    | x > 0 = cycleL
+    | otherwise = cycleR
+
+cycleL,cycleR :: Seq a -> Seq a
 cycleL (x :<| xs) = xs |> x
 cycleL xs = xs
-decCharMode 
-    :: Item 
-    -> Item
-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
-    Just x | x > 1 -> w & cWorld . creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1
+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 . 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
---import Control.Lens
-
--- | checks whether or not an item will fit in your inventory
--- 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)
-                = Just $ findItemSlot it inv
+    | crNumFreeSlots ycr >= ceiling (_itInvSize it) =
+        Just $ findItemSlot it inv
     | otherwise = Nothing
   where
     ycr = you w
@@ -21,9 +22,9 @@ 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
-    ItemItselfConsumable _ 
-        -> fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
+findItemSlot it inv = case it ^? itUse . useAmount of
+    Just _ ->
+        fromMaybe newslot $ IM.findIndex (\it' -> _itType it == _itType it') inv
     _ -> newslot
   where
     newslot = maybe 0 ((+ 1) . fst) $ IM.lookupMax inv

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
-    maxcharge = _wpMaxCharge . _itConsumption $ itm
+    ptrWpCharge = cWorld . creatures . ix (_crID cr) . crInv . ix invid . itUse . leftConsumption . wpCharge
+    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
-    --REMOTEBOMB
-    -- Utility items
+    Consumable et -> itemFromConsumableType et
     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 it = fromMaybe 1 $ it ^? itConsumption . icAmount
+itStackAmount :: Item -> ItAmount
+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 
-        {_cUse = CHeal i
-        }
-    , _itID = Nothing
-    }
-    & itType . iyBase .~ MEDKIT i
+    & itUse . cUse .~ CHeal i
+    & itType . iyBase .~ Consumable (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,17 +1,36 @@
-module Dodge.Item.Display 
-    ( itemDisplay
-    , selectedItemDisplay
-    , itemString
-    )
-    where
-import Dodge.Module
-import Dodge.Data
-import Dodge.Inventory.ItemSpace
-import Padding
-import LensHelp
+module Dodge.Item.Display (
+    itemDisplay,
+    selectedItemDisplay,
+    itemString,
+) where
 
 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
@@ -22,63 +41,46 @@ itemBaseName it = case  _iyBase $ _itType it of
     HELD hit -> case hit ^? xNum of
         Just i -> takeWhile (/= ' ') (show hit) ++ show i
         Nothing -> show hit
-    x -> show x
-
-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
-        ]
+    LEFT lit -> show lit
+    EQUIP eit -> show eit
+    Consumable cit -> show cit
 
 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'.  -}
--- TODO make work on remote launchers
-itemDisplay :: Item -> [String]
-itemDisplay it = itemDisplayWithNumber (showConsumption (_itConsumption it)) it
+-- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.
+showSelectedConsumption :: Creature -> ItemUse -> String
+showSelectedConsumption cr iu = case iu of
+    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
-showSelectedConsumption cr ic = case ic of
-    LoadableAmmo{} -> showReloadProgress cr ic
-    AutoRecharging {} -> showAutoRechargeProgress ic
-    ChargeableAmmo{} -> show $ _wpCharge ic
-    ItemItselfConsumable{} -> show (_icAmount ic)
-    NoConsumption -> ""
+showAutoRechargeProgress :: LeftConsumption -> String
+showAutoRechargeProgress lc = case lc of
+    AutoRecharging{}
+        | _arLoaded lc < _arMax lc -> show (_arProgress lc) ++ "C" ++ show (_arLoaded lc)
+        | otherwise -> show (_arLoaded lc)
+    ChargeableAmmo{} -> show (_wpCharge lc)
 
-showAutoRechargeProgress :: ItemConsumption -> String
-showAutoRechargeProgress ic
-    | l < _arMax ic = show (_arProgress ic) ++ "C" ++ show l
-    | otherwise    = show l
-  where
-    l = _arLoaded ic
-
-showReloadProgress :: Creature -> ItemConsumption -> String
+showReloadProgress :: Creature -> HeldConsumption -> 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
-showLoadProgress x mlas = case mlas ^? _Just . ix 0 of
-    Just la -> show (_actionTime la) ++ showLoadActionType la x
-    Nothing -> show x
+showConsumption :: ItemUse -> String
+showConsumption iu = case iu of
+    RightUse{} -> showReloadProgress' (_heldConsumption iu)
+    LeftUse{} -> showAutoRechargeProgress (_leftConsumption iu)
+    EquipUse{} -> ""
+    _ -> show $ iu ^?! useAmount . getItAmount
 
-showConsumption :: ItemConsumption -> String
-showConsumption ic = case ic of
-    LoadableAmmo{} -> showLoadProgress (_laLoaded ic) (_laProgress ic)
-    AutoRecharging {} -> showAutoRechargeProgress ic
-    ChargeableAmmo{} -> show $ _wpCharge ic
-    ItemItselfConsumable{} -> show (_icAmount ic)
-    NoConsumption -> ""
+showReloadProgress' :: HeldConsumption -> String
+showReloadProgress' ic = case ic ^? laProgress . _Just . ix 0 of
+    Nothing -> show $ _laLoaded ic
+    Just la -> show (_actionTime la) ++ showLoadActionType la (_laLoaded ic)
 
 showLoadActionType :: LoadAction -> Int -> String
 showLoadActionType la x = case la of
@@ -91,14 +93,16 @@ maybeWarmupStatus :: Item -> Maybe String
 maybeWarmupStatus it = case it ^? itUse . useDelay . warmMax of
     Nothing -> Nothing
     Just m -> case m - (_warmTime . _useDelay $ _itUse it) of
-        x | x <= 1      -> Just "*WARM"
-          | otherwise   -> let n = show x
+        x
+            | x <= 1 -> Just "*WARM"
+            | 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
-    Just AttachCharMode {_atCharMode = (c :<| _)} -> Just [' ',c]
-    Just AttachMode {_atMode = i} -> Just $ show i
+maybeModeStatus it = case it ^? itUse . heldScroll of
+    Just HeldScrollCharMode{_hsCharMode = (c :<| _)} -> Just [' ', c]
+    Just HeldScrollInt{_hsInt = i} -> Just $ show i
     _ -> Nothing
 
 maybeRateStatus :: Item -> Maybe String

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
-    EFFGUN _        -> defSPic
-    AUTOEFFGUN _    -> defSPic
-
---
---
-    KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic)
---    
-    MEDKIT _  -> defSPic
+    Consumable {}  -> 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,59 +1,60 @@
-module Dodge.Item.Equipment 
-    ( module Dodge.Item.Equipment.Booster
-    , torch
-    , magShield
-    , powerLegs
-    , flatShield
-    , wristInvisibility
-    , wristArmour
-    , hat
-    , brainHat
-    , frontArmour
-    , headLamp
-    , headLamp1
-    , jetPack
-    , speedLegs
-    , jumpLegs
-    , flameShield
-
-    , useMagShield
-    , setWristShieldPos
-    , createHeadLamp
-    , overCID
-    , onEquipWristShield
-    , onRemoveWristShield
-
-    , createShieldWall
-    , removeShieldWall
+module Dodge.Item.Equipment (
+    module Dodge.Item.Equipment.Booster,
+    torch,
+    magShield,
+    powerLegs,
+    flatShield,
+    wristInvisibility,
+    wristArmour,
+    hat,
+    brainHat,
+    frontArmour,
+    headLamp,
+    headLamp1,
+    jetPack,
+    speedLegs,
+    jumpLegs,
+    flameShield,
+    useMagShield,
+    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 Data.Maybe
 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 Data.Maybe
+import Picture
 
 magShield :: Item
-magShield = defaultEquipment
+magShield =
+    defaultEquipment
         { _itID = Nothing
         , _itAttachment = AttachMInt Nothing
         }
         & itUse . eqEq . eqUse .~ EMagShield --useMagShield
         & 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 =
+        Magnet
             { _mgID = mgid
             , _mgUpdate = MagnetUpdateTimer 1
             , _mgPos = _crPos cr
@@ -62,23 +63,29 @@ useMagShield it cr w = w & cWorld . magnets . at mgid ?~ themagnet
     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 =
+    defaultEquipment
         { _itID = Nothing
-    } & itUse . eqEq . eqSite .~ GoesOnChest
+        }
+        & itUse . eqEq . eqSite .~ GoesOnChest
         & itType . iyBase .~ EQUIP FLAMESHIELD
-{- | Slows you down, blocks forward projectiles. -}
+
+-- | Slows you down, blocks forward projectiles.
 frontArmour :: Item
-frontArmour = defaultEquipment
+frontArmour =
+    defaultEquipment
         { _itID = Nothing
         }
         & itUse . eqEq . eqSite .~ GoesOnChest
         & itType . iyBase .~ EQUIP FRONTARMOUR
 
 wristArmour :: Item
-wristArmour = defaultEquipment
+wristArmour =
+    defaultEquipment
         { _itID = Nothing
         }
         & itUse . eqEq . eqSite .~ GoesOnWrist
@@ -88,7 +95,8 @@ wristArmour = defaultEquipment
         & itType . iyBase .~ EQUIP WRISTARMOUR
 
 onEquipWristShield :: Item -> Creature -> World -> World
-onEquipWristShield itm cr w = w
+onEquipWristShield itm cr w =
+    w
         & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itUse . eqEq . eqParams .~ EquipID i
         & cWorld . walls . at i ?~ forceField{_wlID = i}
         & setWristShieldPos (itm & itUse . eqEq . eqParams .~ EquipID i) cr
@@ -96,13 +104,16 @@ onEquipWristShield itm cr w = w
     i = IM.newKey (_walls (_cWorld w))
 
 onRemoveWristShield :: Item -> Creature -> World -> World
-onRemoveWristShield itm cr w = w
+onRemoveWristShield itm cr w =
+    w
         & 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 =
+    w
         & moveWallIDUnsafe i wlline
   where
     i = _eparamID $ _eqParams $ _eqEq $ _itUse itm
@@ -112,28 +123,27 @@ 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
+        | twists cr = (+.+.+ V3 (-5) 10 0)
         | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
 torch :: Item
-torch = defaultWeapon
+torch =
+    defaultWeapon
         & itEffect .~ effectOnOffHeld CreateHeldLight NoInvEffect -- createHeldLight (const $ const id)
         & itType . iyBase .~ HELD TORCH
         & itUse . useAim . aimHandlePos .~ 5
         & itUse . useAim . aimMuzPos .~ 10
 
 flatShield :: Item
-flatShield = defaultWeapon
-    & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall --createShieldWall removeShieldWall
-        -- the above seems to work, but I am not sure why: it may break on edge
-        -- cases
-    & itUse .~ defaultrUse
-        { _rUse = HeldDoNothing
-        , _useDelay = NoDelay
-        , _useMods = HeldModNothing
-        , _useHammer = HammerUp
-        , _useAim = AimParams
+flatShield =
+    defaultWeapon
+        & itEffect .~ effectOnOffHeld CreateShieldWall RemoveShieldWall
+        & itUse
+            .~ defaultrUse
+                { _useAim =
+                    AimParams
                         { _aimWeight = 5
                         , _aimRange = 0
                         , _aimZoom = ItZoom 20 0.2 1
@@ -146,7 +156,8 @@ flatShield = defaultWeapon
         & itType . iyBase .~ HELD FLATSHIELD
 
 shieldWall :: Int -> Wall
-shieldWall crid = defaultWall
+shieldWall crid =
+    defaultWall
         { _wlColor = yellow
         , _wlOpacity = SeeAbove
         , _wlPathable = True
@@ -166,8 +177,9 @@ shieldWall crid = defaultWall
 --    _ -> w
 
 createShieldWall :: Item -> Creature -> World -> World
-createShieldWall it cr w = case _ieMID $ _itEffect it of
-    Nothing -> let (wlid,w') = createWall ((shieldWall crid) {_wlLine = wlline,_wlID = wlid}) w
+createShieldWall it cr w = case it ^? itEffect . ieMID . _Just of
+    Nothing ->
+        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
@@ -179,43 +191,54 @@ createShieldWall it cr w = case _ieMID $ _itEffect it of
     rad = _crRad cr + 2
     a = crpos +.+ rad *.* crdirv -.- 10 *.* therot crdirv
     b = crpos +.+ rad *.* crdirv +.+ 10 *.* therot crdirv
-    therot  | crIsAiming cr = vNormal
+    therot
+        | 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 ->
+        w & deleteWallID wid
             & cWorld . creatures . ix crid . crInv . ix invid . itEffect . ieMID .~ Nothing
   where
     crid = _crID cr
     invid = fromJust (_itID it)
 
-effectOnOffHeld 
-    :: ItInvEffect     -- ^ effect when held
-    -> ItInvEffect     -- ^ effect when not held
-    -> ItEffect
-effectOnOffHeld f f' = ItInvEffectID
+effectOnOffHeld ::
+    -- | effect when held
+    ItInvEffect ->
+    -- | effect when not held
+    ItInvEffect ->
+    ItEffect
+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 =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
-    }   & itUse . eqEq . eqSite .~ GoesOnBack
+        }
+        & itUse . eqEq . eqSite .~ GoesOnBack
         & itType . iyBase .~ EQUIP JETPACK
 
 brainHat :: Item
-brainHat = defaultEquipment
+brainHat =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
         }
         & itUse . eqEq . eqSite .~ GoesOnHead
         & itType . iyBase .~ EQUIP BRAINHAT
+
 hat :: Item
-hat = defaultEquipment
+hat =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
         }
@@ -223,15 +246,18 @@ hat = defaultEquipment
         & itType . iyBase .~ EQUIP HAT
 
 headLamp1 :: Item
-headLamp1 = defaultEquipment
+headLamp1 =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
         }
         & itUse . eqEq . eqUse .~ EHeadLamp --createHeadLamp
         & itUse . eqEq . eqSite .~ GoesOnHead
         & itType . iyBase .~ EQUIP HEADLAMP1
+
 headLamp :: Item
-headLamp = defaultEquipment
+headLamp =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
         }
@@ -239,27 +265,37 @@ headLamp = defaultEquipment
         & itUse . eqEq . eqSite .~ GoesOnHead
         & itType . iyBase .~ EQUIP HEADLAMP
 
-
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr = cWorld . tempLightSources .:~ tlsTimeRadColPos 1 200 0.7 
+createHeadLamp _ cr =
+    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 =
+    defaultEquipment
         { _itEffect = NoItEffect
         , _itID = Nothing
         }
         & itUse . eqEq . eqSite .~ GoesOnLegs
         & itType . iyBase .~ EQUIP POWERLEGS
+
 speedLegs :: Item
-speedLegs = powerLegs
+speedLegs =
+    powerLegs
         & itType . iyBase .~ EQUIP SPEEDLEGS
+
 jumpLegs :: Item
-jumpLegs = powerLegs
+jumpLegs =
+    powerLegs
         & itType . iyBase .~ EQUIP JUMPLEGS
 
 wristInvisibility :: Item
-wristInvisibility = defaultEquipment
+wristInvisibility =
+    defaultEquipment
         { _itID = Nothing
         }
         & itUse . eqEq . eqSite .~ GoesOnWrist

src/Dodge/Item/Equipment/Booster.hs

@@ -1,84 +1,20 @@
-module Dodge.Item.Equipment.Booster
-    ( boosterGun
-    , boostSelfL
+module Dodge.Item.Equipment.Booster (
+    boosterGun,
 ) where
-import Dodge.Data
-import Dodge.Base
+
+import Control.Lens
+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 =
+    defaultLeftItem
         { _itInvColor = cyan
-    , _itConsumption = defaultChargeable
         , _itUse = luseInstantNoH LBoost
         , _itEffect = resetAttachmentID
         }
         & 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
-pointToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
-pointToItem _ = const pure
+pointerToItem (InInv cid invid) = cWorld . creatures . ix cid . crInv . ix invid
+pointerToItem (OnFloor flid) = cWorld . floorItems . ix flid . flIt
+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
-    & itConsumption . laCycle .~ [loadEject 10, loadInsert 10 , loadPrime 60]
+    & itUse . heldConsumption . laMax .~ 200
+    & 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
-        & itConsumption . laCycle .~ [loadPartialInsert 10 1]
+        & itUse . heldConsumption . laMax .~ 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
-        & itConsumption . laCycle .~ [loadEject 5, loadInsert 5, loadPrime 5]
+        & itUse . heldConsumption . laMax .~ 1
+        & 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]
-        & itConsumption . laMax .~ 15
+        & itUse . heldConsumption . laCycle .~ [loadEject 20, loadInsert 20, loadPrime 20]
+        & itUse . heldConsumption . laMax .~ 15
 
 autoRifle :: Item
 autoRifle =
@@ -120,21 +120,20 @@ miniGunUse i =
 miniGunX :: Int -> Item
 miniGunX i =
     defaultAutoGun
-        { _itConsumption =
-            defaultBulletLoadable
-                { _laMax = 1500
-                , _laLoaded = 1500
-                }
-                & laCycle .~ [loadEject 40, loadInsert 40, loadPrime 40]
-        , _itUse =
+        { _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
-          _itParams =
+                & heldConsumption
+                    .~ 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
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 5]
+    & itUse . heldConsumption . laMax .~ 1
+    & 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
-    & itConsumption . laCycle .~ [loadEject 10, loadInsert 40 , loadPrime 10]
+    & itUse . heldConsumption . laMax .~ 100
+    & 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
-    & itConsumption . laCycle .~ [loadPartialInsert 10 1]
+    & itUse . heldConsumption . laMax .~ i
+    & 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
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
+    & itUse . heldConsumption . laMax .~ 5
+    & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 20 , loadPrime 5]
 
 blunderbuss :: Item
 blunderbuss = bangCone
-    & itConsumption . laMax .~ 25
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 30 , loadPrime 5]
+    & itUse . heldConsumption . laMax .~ 25
+    & 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
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert (30 + i * 10) , loadPrime 5]
+    & itUse . heldConsumption . laMax .~ 25 + 25 * i
+    & 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" }
-    & itConsumption . laMax .~ 2
+    & itUse . heldConsumption . laAmmoType .~ DroneAmmo { _amString = "LASDRONE" }
+    & 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,41 +1,33 @@
-module Dodge.Item.Weapon.Launcher
-    ( launcher
-    , launcherX
-    , remoteLauncher
-    , fireTrackingShell
-    , explodeRemoteRocket
+module Dodge.Item.Weapon.Launcher (
+    launcher,
+    launcherX,
+    remoteLauncher,
+    fireTrackingShell,
+    explodeRemoteRocket,
 ) 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 
-    { _itConsumption = defaultLoadable
-        & laAmmoType .~ ProjectileAmmo 
-            { _amPayload = ExplosionPayload
-            , _amString = "EXPLOSIVE SHELL"
-            , _amPjDraw = DrawShell
-            , _amPjCreation = CreateShell
-            }
-        & laMax .~ 1
-        & laLoaded .~ 1
-        & laCycle .~ [loadEject 30, loadInsert 30, loadPrime 10]
-    , _itParams = ShellLauncher
+launcher =
+    defaultWeapon
+        { _itParams =
+            ShellLauncher
                 { _shellSpinDrag = 1
                 , _shellSpinAmount = 2
                 , _shellThrustDelay = 20
                 }
-    , _itTweaks = Tweakable
-        { _tweakSel = 0
-        , _tweakParams = basicAmPjMoves
+        , _itTweaks =
+            Tweakable
+                { _tweakParams = basicAmPjMoves
                 }
         , _itInvSize = 3
         }
@@ -49,62 +41,82 @@ launcher = defaultWeapon
         & itUse . useAim . aimStance .~ TwoHandTwist
         & itUse . useAim . aimHandlePos .~ 5
         & itUse . useAim . aimMuzPos .~ 20
+        & itUse . heldConsumption . laAmmoType .~ ProjectileAmmo
+                        { _amPayload = ExplosionPayload
+                        , _amString = "EXPLOSIVE SHELL"
+                        , _amPjDraw = DrawShell
+                        , _amPjCreation = CreateShell
+                        }
+        & itUse . heldConsumption . laMax .~ 1
+        & 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 =
+    launcher
         & itType . iyBase .~ HELD (LAUNCHERX i)
-    & itConsumption . laMax .~ i
-    & itConsumption . laLoaded  .~ i
+        & itUse . heldConsumption . laMax .~ i
+        & itUse . heldConsumption . laLoaded .~ i
         & itUse . rUse .~ HeldPJCreationX i
         & itUse . useMods .~ LauncherXMod i
 
 basicAmPjMoves :: IM.IntMap TweakParam
-basicAmPjMoves = IM.fromList . zip [0..] $
+basicAmPjMoves =
+    IM.fromList . zip [0 ..] $
         [ spinDrag
         , spinStart
         , thrustParam
         ]
+
 spinDrag :: TweakParam
-spinDrag = TweakParam
+spinDrag =
+    TweakParam
         { _tweakType = TweakSpinDrag
         , _tweakVal = 1
         , _tweakMax = 5
         }
+
 spinStart :: TweakParam
-spinStart = TweakParam
+spinStart =
+    TweakParam
         { _tweakType = TweakSpinAmount
         , _tweakVal = 2
         , _tweakMax = 5
         }
+
 thrustParam :: TweakParam
-thrustParam = TweakParam
+thrustParam =
+    TweakParam
         { _tweakType = TweakThrustDelay
         , _tweakVal = 1
         , _tweakMax = 5
         }
 
 remoteLauncher :: Item
-remoteLauncher = launcher 
+remoteLauncher =
+    launcher
         & itType . iyBase .~ HELD REMOTELAUNCHER
         & itUse . rUse .~ HeldFireRemoteShell --fireRemoteShell
         & itScope .~ RemoteScope (V2 0 0) 1 True
-    & itConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
+        & itUse . heldConsumption . laAmmoType . amPjDraw .~ DrawRemoteShell
+
 -- TODO consider allowing tweaking rocket speed
 
-explodeRemoteRocket 
-    :: Int  -- ^ Item id
-    -> Int  -- ^ Projectile id
-    -> World 
-    -> World
-explodeRemoteRocket itid pjid w = w
+explodeRemoteRocket ::
+    -- | Item id
+    Int ->
+    -- | Projectile id
+    Int ->
+    World ->
+    World
+explodeRemoteRocket itid pjid w =
+    w
         & 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,55 +1,64 @@
-module Dodge.Item.Weapon.SprayGuns
-    ( poisonSprayer
-    , flameSpitter
-    , blowTorch
-    , flameThrower
-    , flameTorrent
-    , flameWall
+module Dodge.Item.Weapon.SprayGuns (
+    poisonSprayer,
+    flameSpitter,
+    blowTorch,
+    flameThrower,
+    flameTorrent,
+    flameWall,
 ) where
+
 import Dodge.Data
-import Dodge.Reloading.Action
 import Dodge.Default
+import Dodge.Reloading.Action
 import Geometry
 import LensHelp
 
 poisonSprayer :: Item
-poisonSprayer = flameThrower 
+poisonSprayer =
+    flameThrower
         & itType . iyBase .~ HELD POISONSPRAYER
-    & itConsumption . laAmmoType .~ GasAmmo
+        & itUse . heldConsumption . laAmmoType
+            .~ GasAmmo
                 { _amString = "POISONGAS"
                 , _amCreateGas = CreatePoisonGas --aGasCloud
                 }
         & itUse . useMods .~ PoisonSprayerMod
 
 flameSpitter :: Item
-flameSpitter = flameThrower
+flameSpitter =
+    flameThrower
         & itType . iyBase .~ HELD FLAMESPITTER
-    & itConsumption . laMax .~ 10
-    & itConsumption . laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
+        & itUse . heldConsumption . laMax .~ 10
+        & itUse . heldConsumption . laCycle .~ [loadEject 5, loadInsert 10, loadPrime 20]
         & itParams . sprayNozzles . ix 0 . nzPressure .~ 4
         & itUse . useAim . aimStance .~ OneHand
         & itUse . useDelay .~ FixedRate{_rateMax = 12, _rateTime = 0}
         & itUse . useMods .~ FlameSpitterMod
 
 flameTorrent :: Item
-flameTorrent = flameThrower 
+flameTorrent =
+    flameThrower
         & itType . iyBase .~ HELD FLAMETORRENT
         & itUse . useAim . aimZoom .~ defaultItZoom
-    & itParams . sprayNozzles . ix 0 %~ 
-        ( (nzPressure .~ 10)
+        & itParams . sprayNozzles . ix 0
+            %~ ( (nzPressure .~ 10)
                     . (nzMaxWalkAngle .~ 1.5)
                     . (nzWalkSpeed .~ 0.05)
                )
 
 blowTorch :: Item
-blowTorch = flameThrower
+blowTorch =
+    flameThrower
         & itType . iyBase .~ HELD BLOWTORCH
+
 flameWall :: Item
-flameWall = flameThrower 
+flameWall =
+    flameThrower
         & 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 =
+        Nozzle
             { _nzPressure = pres
             , _nzDir = dir
             , _nzMaxWalkAngle = 0
@@ -59,15 +68,10 @@ flameWall = flameThrower
             }
 
 flameThrower :: Item
-flameThrower = defaultAutoGun
-    { _itConsumption = defaultLoadable
-        & laMax .~ 250
-        & laAmmoType .~ GasAmmo
-            {_amString = "FLAME"
-            ,_amCreateGas = CreateFlame --aFlame
-            }
-        & laCycle .~ [loadEject 5, loadInsert 10 , loadPrime 20]
-    , _itParams = Sprayer
+flameThrower =
+    defaultAutoGun
+        { _itParams =
+            Sprayer
                 { _sprayNozzles =
                     [ Nozzle
                         { _nzPressure = 4
@@ -90,6 +94,14 @@ flameThrower = defaultAutoGun
         & itUse . useAim . aimStance .~ TwoHandTwist
         & itUse . useAim . aimHandlePos .~ 0
         & itUse . useAim . aimMuzPos .~ 18
+        & itUse . heldConsumption
+            .~ ( 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,35 +1,40 @@
 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 =
+    defaultLeftItem
         { _itInvColor = cyan
-    , _itConsumption = ChargeableAmmo
-        { _wpMaxCharge  = 250
-        , _wpCharge = 0
-        }
         , _itEffect = ItRewindEffect RewindEffect -- []
-    , _itUse = defaultlUse 
+        , _itUse =
+            defaultlUse
                 & lUse .~ LRewind --useRewindGun
                 & eqEq . eqSite .~ GoesOnChest
         }
         & itType . iyBase .~ LEFT REWINDER
+        & itUse . leftConsumption
+            .~ ChargeableAmmo
+                { _wpMaxCharge = 250
+                , _wpCharge = 0
+                }
 
 -- needs to shift this item to the current inventory slot
 shrinkGun :: Item
-shrinkGun = defaultLeftItem
+shrinkGun =
+    defaultLeftItem
         { _itUse = defaultlUse & lUse .~ LShrink -- hammerCheckL useShrinkGun
         --    , _itFloorPict = shrinkGunPic
         , _itAttachment = AttachBool True
@@ -39,11 +44,12 @@ shrinkGun = defaultLeftItem
 shrinkGunPic :: Item -> SPic
 shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5
 
-
 blinkGun :: Item
-blinkGun = defaultLeftItem 
+blinkGun =
+    defaultLeftItem
         { _itInvColor = cyan
-    , _itUse = defaultlUse 
+        , _itUse =
+            defaultlUse
                 & lUse .~ LBlink --hammerCheckL (shootL $ const blinkAction)
                 & eqEq . eqSite .~ GoesOnWrist
                 --    , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
@@ -51,7 +57,8 @@ blinkGun = defaultLeftItem
         & itType . iyBase .~ LEFT BLINKER
 
 unsafeBlinkGun :: Item
-unsafeBlinkGun = blinkGun
+unsafeBlinkGun =
+    blinkGun
         & itType . iyBase .~ LEFT BLINKERUNSAFE
         & itUse . lUse .~ LUnsafeBlink --hammerCheckL (shootL $ const unsafeBlinkAction)
         & itUse . eqEq . eqViewDist ?~ 400
@@ -69,17 +76,18 @@ unsafeBlinkGun = blinkGun
 --    }
 --    & itType . iyBase .~ AUTOEFFGUN name
 forceFieldGun :: Item
-forceFieldGun = defaultWeapon 
-    { _itConsumption = defaultLoadable & laAmmoType .~ ForceFieldAmmo forceField
-    , _itTargeting = targetRBPress & tgDraw .~ TargetDistanceDraw
-    , _itParams = ParamMID Nothing
-    }
+forceFieldGun =
+    defaultWeapon
+        & itTargeting .~ (targetRBPress & tgDraw .~ TargetDistanceDraw)
+        & itParams .~ ParamMID Nothing
         & itUse . rUse .~ HeldForceField --useForceFieldGun
         & itUse . useDelay .~ NoDelay
         & itUse . useMods .~ AmmoHammerTimeUseOneMod -- this is slightly different
         -- than the list below
         --[ hammerCheckI , ammoCheckI , useAmmoAmount 1]
         & 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
@@ -89,7 +97,8 @@ useForceFieldGun itm cr w = fromMaybe w $ do
     let mwp = mouseWorldPos w
         b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
         wlline = (a, b)
-    return $ w 
+    return $
+        w
             & cWorld . walls %~ IM.insertWith (\_ x -> x) i forceField{_wlID = i}
             & cWorld . creatures . ix (_crID cr) . crInv . ix (_ipInvID (_itPos itm)) . itParams . paramMID ?~ i
             & moveWallIDUnsafe i wlline

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
@@ -22,8 +26,11 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
     _ -> w
   where
     rewindusing :: CWorld -> [CWorld] -> World
-    rewindusing w' ws = w
-        & cWorld . maybeWorld .~ Just' ( w'
+    rewindusing w' ws =
+        w
+            & cWorld . maybeWorld
+                .~ Just'
+                    ( w'
                         & rewindWorlds .~ ws
                     )
 
@@ -31,11 +38,80 @@ useRewindGun _ _ w = case _rewindWorlds (_cWorld w) of
 -- 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 =
+    if _atBool $ _itAttachment it
         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 %~
-        ( (itAttachment . atBool .~ isInUse) . (itCurseStatus .~ cstatus) )
+    f isInUse 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,26 +1,27 @@
 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 =
+        mcApplyDamage (_mcDamage mc) mc
             . mcPlaySound mc
             . mcSensorTriggerUpdate mc
             . mcTurretUpdate mc
@@ -34,12 +35,14 @@ 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 =
+        w & cWorld . machines %~ IM.delete mcid
             & deleteWallIDs (_mcWallIDs mc)
             & makeExplosionAt mcpos
             & copyItemToFloor mcpos lasGun
             & deleteHomonculus
-    | otherwise = w 
+    | otherwise =
+        w
             & initHomonculus
             & dodamage
             & maybeFire
@@ -49,14 +52,17 @@ updateTurret rotSpeed mc w
         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 ->
+            w' & cWorld . machines . ix mcid . mcType . tuMCrID ?~ cid
                 & cWorld . creatures . at cid ?~ thecreature
           where
             cid = IM.newKey (_creatures (_cWorld w'))
-            thecreature = defaultCreature
+            thecreature =
+                defaultCreature
                     & crID .~ cid
-                & crInv . at 0 ?~ (_tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
-                    & itConsumption . laLoaded .~ 1
+                    & crInv . at 0
+                        ?~ ( _tuWeapon (_mcType mc) & itUse . useAim . aimHandlePos -~ 10
+                                & itUse . heldConsumption . laLoaded .~ 1
                            )
                     & crPos .~ mcpos
                     & crOldPos .~ mcpos
@@ -64,19 +70,21 @@ updateTurret rotSpeed mc w
                     & crDir .~ mcdir
                     & crStance . posture .~ Aiming
                     & crMaterial .~ Crystal
-        Just cid -> w'
+        Just cid ->
+            w'
                 & cWorld . creatures . ix cid . crPos .~ mcpos
                 & cWorld . creatures . ix cid . crDir .~ mcdir
-    dodamage = cWorld . machines . ix mcid %~ 
-        ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect])
+    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
-            = fromMaybe id $ do
+        | _tuFireTime (_mcType mc) > 0 =
+            fromMaybe id $ do
                 cid <- _tuMCrID (_mcType mc)
                 return $ cWorld . creatures . ix cid . crActionPlan . apImpulse .~ [UseItem]
         | otherwise = id
@@ -110,8 +118,9 @@ mcTriggerVal mc = case mc ^. mcSensor of
 
 mcPlaySound :: Machine -> World -> World
 mcPlaySound mc w = case _mcCloseSound mc of
-    Just sid | d < 100 
-        -> soundContinueVol (1-0.01*d) (MachineSound mid) (_mcPos mc) sid (Just 2) w
+    Just sid
+        | d < 100 ->
+            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)
@@ -119,8 +128,9 @@ mcPlaySound mc w = case _mcCloseSound mc of
 
 mcApplyDamage :: [Damage] -> Machine -> World -> World
 mcApplyDamage ds mc = case _mcSensor mc of
-    NoSensor -> cWorld . machines . ix (_mcID mc) %~
-        ( (mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)) )
+    NoSensor ->
+        cWorld . machines . ix (_mcID mc)
+            %~ ((mcDamage .~ []) . (mcHP -~ sum (map _dmAmount ds)))
     _ -> id
 
 mcSensorUpdate :: Machine -> World -> World
@@ -130,17 +140,19 @@ mcSensorUpdate mc w = case _mcSensor mc of
     ProximitySensor{} -> mcProximitySensorUpdate mc w
 
 mcProximitySensorUpdate :: Machine -> World -> World
-mcProximitySensorUpdate mc w = case 
-        ( _proxStatus sens
+mcProximitySensorUpdate mc w = case ( _proxStatus sens
                                     , _sensToggle sens
                                     , mcProxTest mc w
-        , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of
+                                    , dist (_crPos ycr) (_mcPos mc) < _proxDist sens
+                                    ) of
     (_, 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
     _ -> w
@@ -158,7 +170,8 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
     cr = you w
 
 senseDamage :: DamageType -> Machine -> World -> World
-senseDamage dt mc = (cWorld . machines . ix mcid %~ upmc)
+senseDamage dt mc =
+    (cWorld . machines . ix mcid %~ upmc)
         . updatels
   where
     upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5))
@@ -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,54 +1,58 @@
-module Dodge.Menu
-    ( scodeToChar
-    , pauseMenu
-    , gameOverMenu
+module Dodge.Menu (
+    scodeToChar,
+    pauseMenu,
+    gameOverMenu,
 ) where
-import Dodge.Config.Data
-import LensHelp
-import Dodge.Menu.OptionType
-import Dodge.StartNewGame
-import Dodge.Menu.PushPop
+
+import Dodge.Config.Update
 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 =
+    OptionScreen
         { _scTitle = const title
         , _scOptions = ops
         , _scDefaultEff = eff
         , _scOptionFlag = NormalOptions
         , _scOptionsOffset = 0
         }
+
 pauseMenu :: ScreenLayer
 pauseMenu = slTitleOptionsEff "PAUSED" pauseMenuOptions (return . unpause)
+
 pauseMenuOptions :: [MenuOption]
-pauseMenuOptions = basicKeyOptions
+pauseMenuOptions =
+    basicKeyOptions
         [ Toggle (return . Just . startNewGame) (opText "NEW LEVEL")
         , Toggle (return . Just . loadSaveSlot LevelStartSlot) (opText "RESTART")
         , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "START FROM SEED")
         , 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
@@ -59,7 +63,9 @@ trySeedFromClipboard :: Universe -> IO (Maybe Universe)
 trySeedFromClipboard u = do
     mcstr <- getClipboardString
     case mcstr >>= readMaybe of
-        Nothing -> pushScreen (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
+        Nothing ->
+            pushScreen
+                (seedStartMenu "CLIPBOARD UNUSABLE, NEED INTEGER")
                 (u & menuLayers %~ tail)
         Just i -> return . Just $ startSeedGame i u
 
@@ -70,26 +76,35 @@ optionMenu :: ScreenLayer
 optionMenu = slTitleOptionsEff "OPTIONS" optionsOptions popScreen
 
 optionsOptions :: [MenuOption]
-optionsOptions = basicKeyOptions
+optionsOptions =
+    basicKeyOptions
         [ makeSubmenuOption soundMenu $ Left "VOLUME"
         , makeSubmenuOption graphicsMenu $ Left "GRAPHICS"
         , makeSubmenuOption gameplayMenu $ Left "GAMEPLAY"
         , makeSubmenuOption debugMenu $ Left "DEBUG OPTIONS"
         ]
+
 debugMenu :: ScreenLayer
-debugMenu = slTitleOptions
+debugMenu =
+    slTitleOptions
         "OPTIONS:GAMEPLAY"
         debugMenuOptions
+
 debugMenuOptions :: [MenuOption]
-debugMenuOptions = zipWith ($)
+debugMenuOptions =
+    zipWith
+        ($)
         (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 =
+        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")
+
 --    zipWith ($)
 --    [ makeBoolOption debug_seconds_frame "SHOW SECONDS/FRAME"
 --    , makeBoolOption debug_noclip "NOCLIP"
@@ -105,19 +120,23 @@ debugMenuOptions = zipWith ($)
 --    ]
 --    $ map Scancode [4 ..]
 gameplayMenu :: ScreenLayer
-gameplayMenu  = slTitleOptions
+gameplayMenu =
+    slTitleOptions
         "OPTIONS:GAMEPLAY"
         gameplayMenuOptions
 
 gameplayMenuOptions :: [MenuOption]
-gameplayMenuOptions = basicKeyOptions
+gameplayMenuOptions =
+    basicKeyOptions
         [ makeBoolOption gameplay_rotate_to_wall "ROTATE TO WALL"
         ]
+
 basicKeyOptions :: [Scancode -> c] -> [c]
 basicKeyOptions xs = zipWith ($) xs $ map Scancode [4 ..]
 
 soundMenu :: ScreenLayer
-soundMenu = slTitleOptions
+soundMenu =
+    slTitleOptions
         "OPTIONS:VOLUME"
         soundMenuOptions
 
@@ -128,7 +147,8 @@ soundMenuOptions =
     , theoption ScancodeN volume_music ScancodeM "MUSIC VOLUME" _volume_music
     ]
   where
-    theoption scod1 stype scod2 str voltype = Toggle2
+    theoption scod1 stype scod2 str voltype =
+        Toggle2
             scod1
             (change dec stype)
             scod2
@@ -146,7 +166,8 @@ graphicsMenu :: ScreenLayer
 graphicsMenu = slTitleOptions "OPTIONS:GRAPHICS" graphicsMenuOptions
 
 graphicsMenuOptions :: [MenuOption]
-graphicsMenuOptions = basicKeyOptions
+graphicsMenuOptions =
+    basicKeyOptions
         [ makeEnumOption graphics_resolution_factor "RESOLUTION" updateFramebufferSize
         , makeBoolOption graphics_wall_textured "WALL TEXTURES"
         , makeBoolOption graphics_object_shadows "OBJECT SHADOWS"
@@ -154,7 +175,8 @@ graphicsMenuOptions = basicKeyOptions
         ]
 
 gameOverMenu :: ScreenLayer
-gameOverMenu = OptionScreen
+gameOverMenu =
+    OptionScreen
         { _scTitle = const "GAME OVER"
         , _scOptions = pauseMenuOptions
         , _scDefaultEff = return . Just
@@ -166,7 +188,6 @@ gameOverMenu = OptionScreen
 scodeToChar :: Scancode -> Char
 scodeToChar = toEnum . (+ 61) . fromIntegral . unwrapScancode
 
-
 --charToScode :: Char -> Scancode
 --charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
 

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.Shell
+import Dodge.Item.Weapon.Launcher
 import Dodge.Item.Weapon.Remote
+import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Movement.Turn
-import Dodge.Base
-import Dodge.Zone
+import Dodge.Payload
+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 qualified Streaming.Prelude as S
---import qualified Data.Set as S
-import qualified Data.Map.Strict as M
+import RandomHelp
 import qualified SDL
-import Data.Maybe
-import Control.Lens
-
+import qualified Streaming.Prelude as S
 
 updateProjectile :: Proj -> World -> World
 updateProjectile pj = case pj of
@@ -35,7 +36,8 @@ updateProjectile pj = case pj of
 
 updateRemoteShell :: Proj -> World -> World
 updateRemoteShell pj w
-    | time > 340 = if circOnSomeWall oldPos 4 w
+    | time > 340 =
+        if circOnSomeWall oldPos 4 w
             then doExplode
             else w
     | anythingHitCirc 2 oldPos newPos w = doExplode
@@ -43,7 +45,8 @@ updateRemoteShell pj w
     | otherwise = doExplode
   where
     time = _prjTimer pj
-    doExplode = w
+    doExplode =
+        w
             & usePayload (_prjPayload pj) oldPos
             & stopSoundFrom (ShellSound i)
             & cWorld . projectiles %~ IM.delete i
@@ -52,12 +55,14 @@ updateRemoteShell pj w
     vel = _prjVel pj
     newPos = oldPos +.+ vel
 
-explodeRemoteRocket' 
-    :: Maybe Int  -- ^ Item id
-    -> Proj
-    -> World 
-    -> World
-explodeRemoteRocket' mitid thepj w = w
+explodeRemoteRocket' ::
+    -- | Item id
+    Maybe Int ->
+    Proj ->
+    World ->
+    World
+explodeRemoteRocket' mitid thepj w =
+    w
         & cWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
         & usePayload (_prjPayload thepj) (_prjPos thepj)
         & updateitem
@@ -65,13 +70,15 @@ explodeRemoteRocket' mitid thepj w = w
     updateitem = fromMaybe (cWorld . projectiles . at pjid .~ Nothing) $ do
         itid <- mitid
         itpos <- w ^? cWorld . itemPositions . ix itid
-        return $ (pointToItem itpos . itUse . rUse     .~ HeldDoNothing)
+        return $
+            (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 =
+        if circOnSomeWall oldPos 4 w
             then doExplode
             else w
     | anythingHitCirc 2 oldPos newPos w = doExplode
@@ -79,7 +86,8 @@ updateShell pj w
     | otherwise = doExplode
   where
     time = _prjTimer pj
-    doExplode = w
+    doExplode =
+        w
             & usePayload (_prjPayload pj) oldPos
             & stopSoundFrom (ShellSound i)
             & cWorld . projectiles %~ IM.delete i
@@ -115,9 +123,10 @@ upProjectile pu pj = case pu of
     ain t = time == t
 
 retireRemoteProj'' :: Int -> Int -> World -> World
-retireRemoteProj'' itid pjid w = w
-    & pointToItem (_itemPositions (_cWorld w) IM.! itid) %~ 
-        ( (itScope . scopePos .~ V2 0 0)
+retireRemoteProj'' itid pjid w =
+    w
+        & pointerToItem (_itemPositions (_cWorld w) IM.! itid)
+            %~ ( (itScope . scopePos .~ V2 0 0)
                     . (itUse . rUse .~ HeldFireRemoteShell)
                )
         & cWorld . props %~ IM.delete pjid
@@ -129,12 +138,13 @@ 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
-                    = _cameraRot (_cWorld w) + argV (_mousePos w)
+                == w ^? cWorld . itemPositions . ix itid . ipInvID =
+            _cameraRot (_cWorld w) + argV (_mousePos w)
         | otherwise = _prjDir pj
 
 doThrust' :: Proj -> World -> World
-doThrust' pj w = w
+doThrust' pj w =
+    w
         & randGen .~ g
         & cWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
         & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
@@ -150,12 +160,14 @@ doThrust' pj w = w
     (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
     r1 = randInCirc 10 & evalState $ _randGen w
 
-trySpinByCID'
-    :: Int -- ^ creature id
-    -> Int -- ^ Spin amount
-    -> Proj
-    -> World 
-    -> World
+trySpinByCID' ::
+    -- | creature id
+    Int ->
+    -- | Spin amount
+    Int ->
+    Proj ->
+    World ->
+    World
 trySpinByCID' cid i pj w = w & cWorld . projectiles . ix pjid . prjSpin .~ newSpin
   where
     pjid = _prjID pj
@@ -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 $
+            cWorld . projectiles . ix (_prjID pj) . prjSpin
+                .~ turnToAmount
+                    0.15
+                    (_prjPos pj)
+                    tpos
                     (argV $ _prjAcc pj)
-    itPoint = pointToItem $ _itemPositions (_cWorld w) IM.! itid
+    itPoint = pointerToItem $ _itemPositions (_cWorld w) IM.! itid
 
 reduceSpinBy' :: Float -> Proj -> World -> World
 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) . itConsumption %~ rotateActionProgress
+            & crInv . ix (crSel cr) . itUse . heldConsumption %~ doLoadAction la
+            & 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
-        Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
+    f (i:is) = case yourInv w ^? ix i . itUse . useAmount of
+        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,36 +1,15 @@
 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 <-
+        takeOne
             [ [itemFromBase $ CRAFT TUBE]
             , [itemFromBase $ CRAFT PIPE]
             , [itemFromBase $ CRAFT HARDWARE]

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)