Defunction-ify item modules, requires more cleanup

src/Dodge/Annotation/Data.hs

@@ -20,8 +20,8 @@ data Annotation
     | AnoApplyInt Int (Int -> State StdGen (LabSubCompTree Room))
     | AnoNewInt (Int -> State StdGen (SubCompTree Room))
     | PassthroughLockKeyLists Int 
-        [(Int -> State StdGen (LabSubCompTree Room), State StdGen CombineType)]
+        [(Int -> State StdGen (LabSubCompTree Room), State StdGen ItemBaseType)]
-        [(CombineType, State StdGen (LabSubCompTree Room))]
+        [(ItemBaseType, State StdGen (LabSubCompTree Room))]
 --    | SetLabel Int (State g Room)
 --    | UseLabel Int (State g Room)
     | ChainAnos [[Annotation]]

src/Dodge/Beam.hs

@@ -0,0 +1,158 @@
+module Dodge.Beam where
+import Dodge.Data
+import Dodge.Particle.Flame
+import Dodge.Particle.TeslaArc
+import Dodge.Item.Location
+import Dodge.WorldEvent.Damage
+import Dodge.WorldEvent.HelperParticle
+import Dodge.Item.Weapon.LaserPath
+import Geometry
+import LensHelp
+import Picture
+import Dodge.RandomHelp
+import Dodge.Zone
+import Dodge.Base.Collide
+import Shape
+
+import Data.List (sortOn)
+import System.Random
+import MonadHelp
+import Control.Monad.State
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+
+flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+flameBeamCombine (p,(a,b,_),(x,y,_))
+    = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
+lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+lasBeamCombine (p,(a,b,_),(x,y,_)) 
+    = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
+
+splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+splitBeamCombine (p,(a,b,_),(x,y,_)) 
+    = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
+    . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
+  where
+    dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
+
+teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
+    -> World -> World
+teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
+    = w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip
+  where
+    itid = fromJust $ _bmOrigin bm
+    dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
+    (w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w
+    it = case getItem itid w of
+        Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
+        Just itm -> itm
+
+lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
+lasRayAt col dam phasev pos dir = LaserParticle
+    { _ptDraw = const blank
+    , _ptUpdate = mvLaser phasev pos dir
+    , _ptRange = 800
+    , _ptDamage = dam
+    , _ptPhaseV = phasev
+    , _ptColor = col
+    }
+mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
+    -> Point2 
+    -> Float 
+    -> World 
+    -> Particle 
+    -> (World, Maybe Particle)
+mvLaser phasev pos dir w pt
+    = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) pos xp thHit w
+      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
+      )
+  where
+    dam = _ptDamage pt
+    xp = pos +.+ 800 *.* unitVectorAtAngle dir
+    (thHit, ps) = reflectLaserAlong phasev [] pos xp w
+    col = _ptColor pt
+    pic = setLayer BloomNoZWrite $ pictures
+        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
+        , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  (pos:ps)
+        ]
+
+shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
+shootTeslaArc' ip pos dir w = 
+    (w & randGen .~ g
+       & instantParticles .:~ aTeslaArcAt col newarc
+    , ip & currentArc ?~ newarc
+    )
+  where
+    (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
+    newarc = createArc ip w pos dir & evalState $ _randGen w
+
+createArc :: ItemParams
+    -> World
+    -> Point2
+    -> Float
+    -> State StdGen [ArcStep]
+createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
+createArc arcparams w p dir = updateArc arcparams w p dir
+
+createNewArc :: ItemParams -> World -> Point2 -> Float
+    -> State StdGen [ArcStep]
+createNewArc arcparams w p dir = take (_arcNumber arcparams)
+    <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)
+
+defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
+    -> State g (Maybe ArcStep)
+defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
+defaultArcStep itparams w (ArcStep p dir _) = do
+    let csize = _arcSize itparams
+    --rot <- takeOne [pi/4,negate pi/4]
+    rot <- takeOne [0]
+    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
+    newp <- (center +.+) <$> randInCirc csize
+    let mcr = listToMaybe 
+            . sortOn (dist center . _crPos) 
+            . filter (\cr -> dist center (_crPos cr) < csize)
+            . IM.elems
+            $ _creatures w
+        wlsnearpoint = wallsNearPoint p w
+        mwl = listToMaybe
+            . sortOn (dist p . fst)
+            . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
+            $ polyCirc 6 csize
+        f (q,wl) = ArcStep q dir (Just $ Right wl)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos))
+        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]
+
+updateArc :: ItemParams
+    -> World
+    -> Point2
+    -> Float
+    -> State StdGen [ArcStep]
+updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc
+  where
+    carc = tail $ fromJust $ _currentArc ip
+
+zipArcs :: ItemParams
+    -> World
+    -> ArcStep
+    -> [ArcStep]
+    -> State StdGen [ArcStep]
+zipArcs ip w x (y:ys) = (x :) <$> do  
+    defaultnext <- _newArcStep ip ip w x
+    case defaultnext of
+        Nothing -> return []
+        Just z@(ArcStep _ _ (Just _)) -> return [z]
+        Just z -> do
+            p <- randInCirc 5
+            let csize = _arcSize ip
+                center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
+                newp = _asPos y +.+ p
+                --newdir = argV $ newp -.- _asPos x
+                newdir = _asDir x
+            if dist newp center < csize
+                then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
+                else zipArcs ip w z ys
+zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)

src/Dodge/Combine.hs

@@ -12,7 +12,8 @@ import Dodge.Base.You
 import Dodge.Data
 import Dodge.Item.Amount
 import Dodge.Inventory.ItemSpace
---import Dodge.Combine.Data
+import Dodge.Combine.Module
+import Dodge.Combine.Data
 import Multiset
 import SimpleTrie
 
@@ -25,7 +26,7 @@ import Data.Map.Merge.Strict
 import Data.Maybe
 import Data.List (scanl',sortOn)
 
-combinationsTrie :: Trie (Int,CombineType) Item
+combinationsTrie :: Trie (Int,ItemBaseType) Item
 combinationsTrie = foldr 
     (uncurry insertInTrie . first (sortOn snd)) 
     emptyTrie
@@ -35,25 +36,25 @@ combinationsTrie = foldr
 -- trie going through each combine type in your inventory in order, rather than
 -- creating all multisets of combine types.
 
-lookupItems :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
+lookupItems :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] 
-    -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
+    -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
 lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
 
-lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)] 
+lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)] 
-    -> Trie (Int,CombineType) Item 
+    -> Trie (Int,ItemBaseType) Item 
-    -> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
+    -> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
 lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
 lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
     n' <- [1..min n 4]
     let is = replicate n' (mods,i)
     concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
 
-invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]]
+invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]]
 invertListInvMult = powlistUpToN 4 . invertListInv
 
-invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
+invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,Int)]
 invertListInv = IM.foldrWithKey
-    (\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) )
+    (\k it -> ((_iyModules $ _itType it,_iyBase $ _itType it, k, itStackAmount it) :) )
     []
 
 -- gives a list of indices-item pairs.
@@ -65,21 +66,21 @@ combineItemListYou = map (second fst) . combineItemListYou'
 combineItemListYou' :: World -> [([Int],(Item,[String]))]
 combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv
 
-addModules :: ([(M.Map ModuleSlot ItemModule,Int)],Item) 
+addModules :: ([(M.Map ModuleSlot ItemModuleType,Int)],Item) 
     -> ([Int],(Item,[String]))
 addModules (ps,it) = (is , (applyModules newm it, ss))
   where
     (ms,is) = unzip ps
-    m = ([],_itModules it)
+    m = ([],_iyModules $ _itType it)
     (ss,newm) = foldr f m ms
     f m' (s,m'') = (s ++ s',m''')
       where
         (s',m''') = combineModules m' m''
 
-applyModules :: M.Map ModuleSlot ItemModule -> Item -> Item
+applyModules :: M.Map ModuleSlot ItemModuleType -> Item -> Item
-applyModules ms it = foldr f (it & itModules .~ ms) ms
+applyModules ms it = foldr f (it & itType . iyModules .~ ms) ms
   where
-    f m = fromMaybe id (m ^? modModification)
+    f m = fromMaybe id (fromModuleType m ^? modModification)
 --    (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
 --  where
 --    (ms,is) = unzip ps
@@ -88,20 +89,22 @@ applyModules ms it = foldr f (it & itModules .~ ms) ms
 --    f ims imss = concatMap (g ims) imss
 --    g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
 
-combineModules :: M.Map ModuleSlot ItemModule 
+combineModules :: M.Map ModuleSlot ItemModuleType 
-    -> M.Map ModuleSlot ItemModule
+    -> M.Map ModuleSlot ItemModuleType
-    -> ([String],M.Map ModuleSlot ItemModule)
+    -> ([String],M.Map ModuleSlot ItemModuleType)
 combineModules = mergeA 
     (traverseMaybeMissing f)
     (traverseMissing g)
     (zipWithAMatched h)
   where
-    f _ ItemModule{_modName=ss} = ("WARNING:REMOVES":ss,Nothing)
+    f _ imt | imt /= EMPTYMODULE = ("WARNING:REMOVES":ss imt,Nothing)
     f _ _ = ([],Nothing)
     g _ m = ([], m)
-    h _ ItemModule{_modName=ss} im@ItemModule{} = ("WARNING:REMOVES":ss,im)
+    h _ im1 im2 | im1 /= EMPTYMODULE && im2 /= EMPTYMODULE 
-    h _ _ im@ItemModule{} = ([],im)
+        = ("WARNING:REMOVES":ss im1,im2)
+    h _ _ im | im /= EMPTYMODULE = ([],im)
     h _ im _ = ([],im)
+    ss imt = _modName $ fromModuleType imt
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _hudElement (_hud w) of

src/Dodge/Combine/Combinations.hs

@@ -8,12 +8,13 @@ import Dodge.Particle.Damage
 import Dodge.Item.Equipment
 import Dodge.Item.Craftable
 import Dodge.Item.Weapon
+import Dodge.Combine.Module
 import Dodge.Base
 import LensHelp
 
 import Data.Maybe
 
-itemCombinations :: [([(Int,CombineType)],Item)]
+itemCombinations :: [([(Int,ItemBaseType)],Item)]
 itemCombinations =
     [ po [PIPE, HARDWARE]             (bangStick 1)
     , po [BANGSTICK 1, TIN]         pistol
@@ -90,7 +91,8 @@ itemCombinations =
     ++ map (\i -> po [REVOLVERX i,CAN]  $ revolverX (i+1)) [1..5]
     ++ map (\i -> p [o (BANGCANEX i),p 2 PIPE] $ bangCaneX (i+1)) [1..5]
     ++ map (\i -> po [MINIGUNX i,BANGCANE] $ miniGunX (i+1)) [3..15]
-    ++ [ po (_itType it:mtype) $ it & itModules . ix modtype .~ m
+
+    ++ [ po (_iyBase (_itType it):mtype) $ it & itType . iyModules . ix modtype .~ m
             | (modtype,is,ms) <- moduleCombinations
             , it <- is
             , (mtype,m)  <- ms
@@ -100,7 +102,7 @@ itemCombinations =
     po xs it = (map o xs,it)
     o = (1,)
 
-moduleCombinations :: [( ModuleSlot, [Item], [([CombineType],ItemModule)] )]
+moduleCombinations :: [( ModuleSlot, [Item], [([ItemBaseType],ItemModuleType)] )]
 moduleCombinations =
     [   ( ModRifleMag
         ,   [repeater
@@ -108,8 +110,8 @@ moduleCombinations =
             ,burstRifle
             ,fastBurstRifle
             ]
-        ,   [amod [DRUM,HARDWARE]  "+DRUM MAG"  (itConsumption . laMax .~ 45)
+        ,   [amod [DRUM,HARDWARE]  DRUMMAG
-            ,amod [MOTOR,HARDWARE] "+BELT FEED" (itConsumption . laMax .~ 150)
+            ,amod [MOTOR,HARDWARE] BELTMAG
             ]
         )
     ,   ( ModAutoMag
@@ -117,78 +119,56 @@ moduleCombinations =
             ,autoPistol
             ,smg
             ]
-        ,   [amod [MAGNET,HARDWARE] "+MAGNET FEED" (itUse . useDelay . rateMax .~ 4)
+        ,   [amod [MAGNET,HARDWARE] MAGNETMAG
             ]
         )
     ,   ( ModBullet
         ,   bulletWeapons
-        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall)
+        ,   [amod [INCENDIARYMODULE] INCENDBUL
-            ,amod [BOUNCEMODULE]     "+BOUNCE"     (f $ expireAndDamage bounceBulDams)
+            ,amod [BOUNCEMODULE]     BOUNCEBUL
-            ,amod [STATICMODULE]     "+STATIC"     (f $ expireAndDamage $ spawnAtBulDams aStaticBall)
+            ,amod [STATICMODULE]     STATICBUL
-            ,amod [CONCUSSMODULE]    "+CONCUSS"    (f $ expireAndDamage $ spawnAtBulDams concBall)
+            ,amod [CONCUSSMODULE]    CONCUSBUL
             ]
         )
     ,   ( ModTarget
         , homingLaunchers ++ bulletWeapons
-        ,   [amod [MICROCHIP,CREATURESENSOR] "+CREATURETARGETING" (itTargeting .~ targetRBCreature)
+        ,   [amod [MICROCHIP,CREATURESENSOR]    TARGCR
-            ,amod [MICROCHIP,PRISM] "+LASERTARGETING" (itTargeting .~ targetLaser)
+            ,amod [MICROCHIP,PRISM]             TARGLAS
-            ,amod [MICROCHIP,TIN] "+POSTIONALTARGETING" (itTargeting .~ targetRBPress)
+            ,amod [MICROCHIP,TIN]               TARGPOS
             ]
         )
     ,   ( ModBulletTrajectory
         ,   bulletWeapons
-        ,   [amod [MAGNET,MICROCHIP,HARDWARE] "+MAGNETTRAJECTORY" 
+        ,   [amod [MAGNET,MICROCHIP,HARDWARE] MAGNETTRAJ
-                ( (itConsumption . laType . amBulTraj .~ MagnetTrajectory) 
+            ,amod [MICROCHIP,HARDWARE]        FLECHETRAJ
-                . (itConsumption . laType . amBulVel  .~ V2 10 0)
+            ,amod [ANTIMATTER,HARDWARE]       BEZIERTRAJ
-                )
-            ,amod [MICROCHIP,HARDWARE] "+FLECHETTETRAJECTORY"
-                (itConsumption . laType . amBulTraj .~ FlechetteTrajectory)
-            ,amod [ANTIMATTER,HARDWARE] "+BEZIERTRAJECTORY" 
-                (itConsumption . laType . amBulTraj .~ BezierTrajectory)
             ]
         )
     ,   ( ModDualBeam
         ,   [lasGunDual]
-        ,   [amod [INCENDIARYMODULE] "+INCENDIARY" (itParams . lasBeam .~ BeamCombine flameBeamCombine)
+        ,   [amod [INCENDIARYMODULE] INCENDLAS
-            ,amod [STATICMODULE]     "+STATIC" 
+            ,amod [TRANSFORMER]      SPLITLAS
-                ( (itParams . lasBeam .~ BeamCombine teslaBeamCombine)
+            ,amod [STATICMODULE]     STATICLAS
-                . (itParams . subParams ?~ teslaParams)
-                )
-            ,amod [TRANSFORMER]      "+SPLIT"  (itParams . lasBeam .~ BeamCombine splitBeamCombine)
             ]
         )
     ,   ( ModTeleport
         ,   teleportableWeapons
-        ,   [amod [TELEPORTMODULE,MICROCHIP] "+DIRECTEDTELE" makeDirectedTele
+        ,   [amod [TELEPORTMODULE,MICROCHIP] WEPTELE
             ]
         )
     ,   ( ModLauncherHoming
         ,   homingLaunchers
-        ,   [ amod [MICROCHIP,TRANSMITTER] "+TARGET HOMING" 
+        ,   [ amod [MICROCHIP,TRANSMITTER] LAUNCHHOME
-                (itConsumption . laType . amPjCreation .~ fireTrackingShell)
             ]
         )
     ,   ( ModBattery
         , batteryGuns
-        ,   [amod [BATTERY] "+BATTERY" (itConsumption . laMax +~ 1000)
+        ,   [amod [BATTERY] EXTRABATTERY
             ]
         )
     ]
   where
-    makeDirectedTele it = it 
+    amod = (,)
-        & itTargeting .~ targetRBPress
-        & itUse . useMods .:~ withPosDirWallCheck directedTelPos
--- for the camera: the simplest option is to remove all zoom/offset
-        & itUse . useAim . aimZoom . itZoomFac .~ 1
-        & itUse . useAim . aimRange .~ 0
--- a better option would be to involve a "scope" centered on the firing
--- position
-    directedTelPos it cr w = (p,a)
-      where
-        p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
-        a = argV (mouseWorldPos w -.- p)
-    f ameff = itConsumption . laType . amBulEff .~ ameff
-    amod cts str func = (cts,ItemModule [str] 1 func)
 
 homingLaunchers :: [Item]
 homingLaunchers = launcher : [launcherX i | i <- [2..10]]

src/Dodge/Combine/Data.hs

@@ -1,11 +1,22 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Dodge.Combine.Data
-    (CombineType (..)
+    where
-    ,Detector (..)
-    ) where
 import Dodge.Equipment.Data
+import Control.Lens
+import qualified Data.Map.Strict as M
+
+-- this should probably store loaded ammo
+data ItemType = ItemType 
+    {_iyBase :: ItemBaseType
+    ,_iyModules :: M.Map ModuleSlot ItemModuleType
+    }
+  deriving (Eq,Ord,Show)
+
 -- TODO make this an enum somehow...?
-data CombineType
+data ItemBaseType
     = NOTDEFINED
+    | EFFGUN String
+    | AUTOEFFGUN String
     -- Weapons
     | BANGSTICK Int
     | PISTOL
@@ -76,6 +87,7 @@ data CombineType
     | BLINKERUNSAFE
     | FORCEFIELDGUN
     | SHRINKER
+    | SPAWNER
     -- Equipment
     | CLICKDETECTOR Detector
     | AUTODETECTOR Detector
@@ -86,6 +98,7 @@ data CombineType
     | INVISIBILITYEQUIPMENT EquipSite
     | BRAINHAT
     | HEADLAMP
+    | HEADLAMP1
     | POWERLEGS
     | SPEEDLEGS
     | JUMPLEGS
@@ -141,11 +154,50 @@ data CombineType
     --
     | KEYCARD Int
     --
+    | MEDKIT Int
+    --
     | NoCombineType
   deriving (Eq,Ord,Show)
 
+data ItemModuleType 
+    = EMPTYMODULE
+    | DRUMMAG
+    | BELTMAG
+    | MAGNETMAG
+    | INCENDBUL
+    | BOUNCEBUL
+    | STATICBUL
+    | CONCUSBUL
+    | TARGCR 
+    | TARGLAS
+    | TARGPOS
+    | MAGNETTRAJ
+    | FLECHETRAJ
+    | BEZIERTRAJ
+    | INCENDLAS
+    | SPLITLAS
+    | STATICLAS
+    | WEPTELE
+    | LAUNCHHOME
+    | EXTRABATTERY
+  deriving (Eq,Ord,Show)
+
 data Detector
     = ITEMDETECTOR
     | CREATUREDETECTOR
     | WALLDETECTOR
   deriving (Eq,Ord,Show)
+
+data ModuleSlot
+    = ModBullet
+    | ModRifleMag
+    | ModAutoMag
+    | ModTarget
+    | ModBulletTrajectory
+    | ModLauncherHoming
+    | ModBattery
+    | ModTeleport
+    | ModDualBeam
+  deriving (Eq,Ord,Show)
+
+makeLenses ''ItemType

src/Dodge/Combine/Module.hs

@@ -0,0 +1,64 @@
+module Dodge.Combine.Module where
+import Dodge.Data
+import Dodge.Tesla
+import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.WorldEvent.SpawnParticle
+import Dodge.Particle.Damage
+import Dodge.IncBall
+import Dodge.Item.Weapon.ExtraEffect
+import Dodge.Item.Weapon.Launcher
+import Dodge.Item.Weapon.TriggerType
+import LensHelp
+import Geometry
+--import Dodge.Item.Weapon.BatteryGuns
+import Dodge.Beam
+import Dodge.Base.Coordinate
+
+import Data.Maybe
+
+fromModuleType :: ItemModuleType -> ItemModule
+fromModuleType imt = case imt of
+    EMPTYMODULE -> ItemModule ["EMPTYMODULE"] 1 id
+    DRUMMAG     -> mod "+DRUM MAG"  (itConsumption . laMax .~ 45)
+    BELTMAG     -> mod "+BELT FEED" (itConsumption . laMax .~ 150)
+    MAGNETMAG   -> mod "+MAGNET FEED" (itUse . useDelay . rateMax .~ 4)
+    INCENDBUL   -> mod "+INCENDIARY" (f $ expireAndDamage $ spawnAtBulDams incBall)
+    BOUNCEBUL   -> mod "+BOUNCE"     (f $ expireAndDamage bounceBulDams)
+    STATICBUL   -> mod "+STATIC"     (f $ expireAndDamage $ spawnAtBulDams aStaticBall)
+    CONCUSBUL   -> mod "+CONCUSS"    (f $ expireAndDamage $ spawnAtBulDams concBall)
+    TARGCR      -> mod "+CREATURETARGETING" (itTargeting .~ targetRBCreature)
+    TARGLAS     -> mod "+LASERTARGETING" (itTargeting .~ targetLaser)
+    TARGPOS     -> mod "+POSTIONALTARGETING" (itTargeting .~ targetRBPress)
+    MAGNETTRAJ  -> mod "+MAGNETTRAJECTORY" 
+                ( (itConsumption . laType . amBulTraj .~ MagnetTrajectory) 
+                . (itConsumption . laType . amBulVel  .~ V2 10 0)
+                )
+    FLECHETRAJ  -> mod "+FLECHETTETRAJECTORY"
+                (itConsumption . laType . amBulTraj .~ FlechetteTrajectory)
+    BEZIERTRAJ  -> mod "+BEZIERTRAJECTORY" 
+                (itConsumption . laType . amBulTraj .~ BezierTrajectory)
+    INCENDLAS   -> mod "+INCENDIARY" (itParams . lasBeam .~ BeamCombine flameBeamCombine)
+    SPLITLAS    -> mod "+SPLIT"  (itParams . lasBeam .~ BeamCombine splitBeamCombine)
+    STATICLAS   -> mod "+STATIC" 
+                ( (itParams . lasBeam .~ BeamCombine teslaBeamCombine)
+                . (itParams . subParams ?~ teslaParams)
+                )
+    WEPTELE     -> mod "+DIRECTEDTELE" makeDirectedTele
+    LAUNCHHOME  -> mod "+TARGET HOMING" (itConsumption . laType . amPjCreation .~ fireTrackingShell)
+    EXTRABATTERY -> mod "+BATTERY" (itConsumption . laMax +~ 1000)
+  where
+    mod str func = ItemModule [str] 1 func
+    f ameff = itConsumption . laType . amBulEff .~ ameff
+    makeDirectedTele it = it 
+        & itTargeting .~ targetRBPress
+        & itUse . useMods .:~ withPosDirWallCheck directedTelPos
+-- for the camera: the simplest option is to remove all zoom/offset
+        & itUse . useAim . aimZoom . itZoomFac .~ 1
+        & itUse . useAim . aimRange .~ 0
+-- a better option would be to involve a "scope" centered on the firing
+-- position
+    directedTelPos it cr w = (p,a)
+      where
+        p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
+        a = argV (mouseWorldPos w -.- p)
+    --amod cts str func = (cts,ItemModule [str] 1 func)

src/Dodge/Creature.hs

@@ -262,7 +262,7 @@ stackedInventory = IM.fromList $ zip [0..]
     ,tractorGun
     ,longGun
     ,autoGun
-    ,ltAutoGun
+    ,autoPistol
     ,pistol
     ,teslaGun
     ,blinkGun

src/Dodge/Creature/Impulse/Movement.hs

@@ -91,9 +91,3 @@ creatureTurnToward p turnSpeed cr
 {- | Speed modifier of an item when not aiming. -}
 equipSpeed :: Item -> Float
 equipSpeed _ = 1
-{- | Speed modifier of an item when aiming. -}
-equipAimSpeed :: Item -> Float -- TODO remove/rethink
-equipAimSpeed it 
-    | _itType it == FRONTARMOUR = 0.5
-    | _itType it == FLAMESHIELD = 0.5
-    | otherwise                     = 1

src/Dodge/Creature/LtAutoCrit.hs

@@ -49,7 +49,7 @@ ltAutoCrit = defaultCreature
         , _crStrategy   = StrategyActions WatchAndWait [StartSentinelPost]
         , _crGoal       = []
         }
-    , _crInv = IM.fromList [(0,ltAutoGun),(1,medkit 100)]
+    , _crInv = IM.fromList [(0,autoPistol),(1,medkit 100)]
     , _crInvSel = 0
     , _crRad = 10
     , _crHP = 500

src/Dodge/Creature/State.hs

@@ -185,7 +185,7 @@ movementSideEff cr w
         _   -> w
     | otherwise = footstepSideEffect cr w
   where 
-    hasJetPack = any (\it -> it ^? itType == Just JETPACK) $ _crInv cr
+    hasJetPack = any (\it -> it ^? itType . iyBase == Just JETPACK) $ _crInv cr
     oldPos = _crOldPos cr
     momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr)
     momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum'

src/Dodge/Creature/Statistics.hs

@@ -15,7 +15,7 @@ strFromEquipment :: Creature -> Int
 strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
 
 equipmentStrValue :: Item -> Int
-equipmentStrValue itm = case _itType itm of
+equipmentStrValue itm = case _iyBase $ _itType itm of
     FRONTARMOUR -> negate 3
     POWERLEGS   -> 3
     _ -> 0

src/Dodge/Creature/Test.hs

@@ -89,7 +89,7 @@ crIsArmouredFrom = hasFrontArmour
 hasFrontArmour :: Point2 -> Creature -> Bool
 hasFrontArmour p cr = fromMaybe False $ do
     invid <- cr ^? crEquipment . ix OnChest
-    ittype <- cr ^? crInv . ix invid . itType
+    ittype <- cr ^? crInv . ix invid . itType . iyBase
     return $ FRONTARMOUR == ittype
         && p /= _crOldPos cr 
         && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi/2

src/Dodge/Data.hs

@@ -487,11 +487,10 @@ data ItemConsumption
         }
     | NoConsumption
 data Item = Item
-    { _itName           :: String
+    { _itConsumption    :: ItemConsumption
-    , _itConsumption    :: ItemConsumption
     , _itUse        :: ItemUse
     , _itEquipPict  :: Creature -> Item -> SPic
-    , _itType       :: CombineType
+    , _itType       :: ItemType
     , _itAttachment :: ItAttachment
     , _itID         :: Maybe Int
     , _itInvPos     :: Maybe Int
@@ -504,7 +503,6 @@ data Item = Item
     , _itDimension  :: ItemDimension
     , _itCurseStatus :: CurseStatus
     , _itTweaks     :: ItemTweaks
-    , _itModules    :: M.Map ModuleSlot ItemModule
     , _itScope      :: Scope
     , _itValue      :: ItemValue
     , _itParams     :: ItemParams
@@ -523,17 +521,6 @@ data Targeting
         , _tgID     :: Maybe Int
         , _tgActive :: Bool
         }
-data ModuleSlot
-    = ModBullet
-    | ModRifleMag
-    | ModAutoMag
-    | ModTarget
-    | ModBulletTrajectory
-    | ModLauncherHoming
-    | ModBattery
-    | ModTeleport
-    | ModDualBeam
-  deriving (Eq,Ord)
 
 data ItemModule
     = DefaultModule
@@ -555,6 +542,7 @@ data ItemPortage
         , _muzPos    :: Float
         }
     | WornItem
+    | NoPortage
 
 data ReloadType 
     = ActiveClear
@@ -600,6 +588,7 @@ data WorldBeams = WorldBeams
     }
 {- | Linear beams. Last only one frame.
  - Can interact with one another in a limited manner
+ - can probably be moved to a separate file
  -}
 data Beam = Beam
     { _bmDraw   :: Beam -> Picture
@@ -1000,7 +989,7 @@ data Sensor = NoSensor
   deriving (Eq,Ord)
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}
-    | RequireEquipment {_proxReqEquipment :: CombineType}
+    | RequireEquipment {_proxReqEquipment :: ItemBaseType}
     | RequireImpossible
   deriving (Eq,Ord,Show)
 data CloseToggle = NotClose | IsClose

src/Dodge/Default.hs

@@ -4,8 +4,14 @@ Description : Instances of data structures
 
 This module contains prototypical data structures.
 -}
-module Dodge.Default where
+module Dodge.Default 
+    ( module Dodge.Default
+    , module Dodge.Default.Item
+    , module Dodge.Default.LightSource
+    ) where
 import Dodge.Default.Weapon
+import Dodge.Default.LightSource
+import Dodge.Default.Item
 import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.Wall.Delete
@@ -149,57 +155,21 @@ defaultState = CrSt
     , _crSpState = GenCr
     , _crDropsOnDeath = DropAll
     }
+
 defaultEquipment :: Item
-defaultEquipment = Item
+defaultEquipment = defaultItem
-    { _itCurseStatus = Uncursed
+    { _itInvColor = yellow
-    , _itType = NOTDEFINED
-    , _itName = "genericEquipment"
---    ,_itIdentity = Generic
-    , _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itEffect = NoItEffect
-    , _itID = Nothing
-    , _itIsHeld = False
-    , _itInvColor = yellow
-    , _itInvDisplay = \it -> [_itName it]
-    , _itInvSize = 1
-    , _itInvPos = Nothing
     , _itDimension = defItDimCol yellow
-    , _itConsumption = NoConsumption
     , _itUse = EquipUse defaultEquip
     , _itAttachment = NoItAttachment
-    , _itParams = NoParams
-    , _itTweaks = NoTweaks
-    , _itModules = M.empty 
-    , _itScope = NoScope
-    , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
     }
 defaultItZoom :: ItZoom
 defaultItZoom = ItZoom 20 0.2 1
 defaultConsumable :: Item
-defaultConsumable = Item
+defaultConsumable = defaultItem
-    { _itUse = NoUse
+    { _itConsumption = ItemItselfConsumable  {_itAmount = 1}
---    , _itIdentity = Generic
-    , _itInvSize = 1
-    , _itCurseStatus = Uncursed
-    , _itName = "genericConsumable"
-    , _itConsumption = ItemItselfConsumable  {_itAmount = 1}
-    , _itEquipPict = \_ _ -> mempty
-    , _itID = Nothing
-    , _itInvPos = Nothing
-    , _itIsHeld = False
     , _itInvColor = blue
-    , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)]
-    , _itEffect = NoItEffect
-    , _itAttachment = NoItAttachment
-    , _itType = NoCombineType
-    , _itParams = NoParams
     , _itDimension = defItDimCol blue
-    , _itTweaks = NoTweaks
-    , _itModules = M.empty 
-    , _itScope = NoScope
-    , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
     }
 
 defaultFlIt :: FloorItem
@@ -299,36 +269,6 @@ defaultPP = PressPlate
     , _ppID = -1
     , _ppText = "Pressure plate"
     }
-defaultLS :: LightSource
-defaultLS = LS
-    { _lsID = 0
-    , _lsParam = LSParam
-        { _lsPos = V3 0 0 50
-        , _lsRad = 700
-        , _lsCol = 0.6
-        }
-    , _lsDir = 0
-    , _lsPict = defLSPic 
-    }
-defLSPic :: LightSource -> Picture
-defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
-  where
-    col = V4 r g b 2
-    V3 r g b = _lsCol $ _lsParam ls
-defaultTLS :: TempLightSource
-defaultTLS = TLS
-    { _tlsParam = LSParam
-        { _lsPos = 0
-        , _lsRad = 0
-        , _lsCol = 0.5
-        }
-    , _tlsUpdate = f
-    , _tlsTime = 1
-    }
-  where
-    f _ t 
-        | _tlsTime t <= 0 = Nothing
-        | otherwise       = Just $ t & tlsTime -~ 1
 
 upHammer :: HammerType
 upHammer = HasHammer HammerUp

src/Dodge/Default/Item.hs

@@ -0,0 +1,88 @@
+module Dodge.Default.Item
+    ( basicItemDisplay
+    , maybeWarmupStatus
+    , maybeRateStatus
+    , moduleStrings
+    , defaultItem
+    ) where
+import Dodge.Data
+import Padding
+import Dodge.Inventory.ItemSpace
+import Dodge.Module
+import Picture
+import ShapePicture
+import Shape
+
+import Data.Maybe
+import Data.Sequence
+import Control.Lens
+
+defaultItem :: Item
+defaultItem = Item
+    { _itCurseStatus = Uncursed
+    , _itType = defaultItemType
+    , _itEquipPict = \_ _ -> (,) emptySH blank
+    , _itEffect = NoItEffect
+    , _itID = Nothing
+    , _itIsHeld = False
+    , _itInvColor = yellow
+    , _itInvDisplay = basicItemDisplay
+    , _itInvSize = 1
+    , _itInvPos = Nothing
+    , _itDimension = ItemDimension 0 0 NoPortage (const mempty)
+    , _itConsumption = NoConsumption
+    , _itUse = NoUse
+    , _itAttachment = NoItAttachment
+    , _itParams = NoParams
+    , _itTweaks = NoTweaks
+    , _itScope = NoScope
+    , _itTargeting = NoTargeting
+    , _itValue = ItemValue 0 MundaneItem
+    }
+
+{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
+basicItemDisplay :: Item -> [String]
+basicItemDisplay it = Prelude.take (itSlotsTaken it) $
+    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
+    : moduleStrings it ++ repeat "*"
+  where 
+    thename  = show . _iyBase $ _itType it
+    thenumber = case it ^? itConsumption of
+        Just am@LoadableAmmo{} -> case _laReloadState am of 
+            Nothing' -> show (_laLoaded am)
+            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
+        Just am@ChargeableAmmo{} -> show $ _wpCharge am
+        Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x)
+        Just NoConsumption -> ""
+        Nothing -> ""
+    theparam = fromMaybe []
+        . listToMaybe 
+        $ mapMaybe ($ it) 
+        [ maybeModeStatus
+--        , maybeWarmupStatus
+--        , maybeRateStatus
+        ]
+-- this can be moved to Dodge/Module and unified with moduleSizes
+
+maybeModeStatus :: Item -> Maybe String
+maybeModeStatus it = case it ^? itAttachment of
+    Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c]
+    Just ItMode {_itMode = i} -> Just $ show i
+    _   -> Nothing
+
+maybeRateStatus :: Item -> Maybe String
+maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
+    Nothing -> Nothing
+    _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it))
+
+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
+                in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n
+
+defaultItemType :: ItemType
+defaultItemType = ItemType NOTDEFINED mempty
+

src/Dodge/Default/LightSource.hs

@@ -0,0 +1,36 @@
+module Dodge.Default.LightSource where
+import Dodge.Data
+import Picture
+import Geometry
+import LensHelp
+
+defaultLS :: LightSource
+defaultLS = LS
+    { _lsID = 0
+    , _lsParam = LSParam
+        { _lsPos = V3 0 0 50
+        , _lsRad = 700
+        , _lsCol = 0.6
+        }
+    , _lsDir = 0
+    , _lsPict = defLSPic 
+    }
+defLSPic :: LightSource -> Picture
+defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
+  where
+    col = V4 r g b 2
+    V3 r g b = _lsCol $ _lsParam ls
+defaultTLS :: TempLightSource
+defaultTLS = TLS
+    { _tlsParam = LSParam
+        { _lsPos = 0
+        , _lsRad = 0
+        , _lsCol = 0.5
+        }
+    , _tlsUpdate = f
+    , _tlsTime = 1
+    }
+  where
+    f _ t 
+        | _tlsTime t <= 0 = Nothing
+        | otherwise       = Just $ t & tlsTime -~ 1

src/Dodge/Default/Weapon.hs

@@ -1,6 +1,7 @@
 module Dodge.Default.Weapon
     where
 import Dodge.Data
+import Dodge.Default.Item
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Draw
 import Picture
@@ -94,11 +95,10 @@ defaultAimParams = AimParams
     , _aimStance = OneHand
     }
 
+
 defaultGun :: Item
-defaultGun = Item 
+defaultGun = defaultItem 
-    { _itName = "default"
+    { _itCurseStatus = Uncursed
-    , _itType = NoCombineType
-    , _itCurseStatus = Uncursed
     , _itConsumption = defaultAmmo
     , _itUse = defaultrUse
     , _itDimension = defItDimCol white
@@ -113,41 +113,23 @@ defaultGun = Item
     , _itInvSize  = 1
     , _itParams = NoParams
     , _itTweaks = NoTweaks
-    , _itModules = M.fromList 
-        [(ModBullet, DefaultModule)
-        ,(ModTarget, DefaultModule)
-        ,(ModBulletTrajectory, DefaultModule)
-        ,(ModTeleport, DefaultModule)
-        ]
     , _itScope = NoScope
     , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
     } 
+    & itType . iyModules .~ M.fromList 
+        [(ModBullet, EMPTYMODULE)
+        ,(ModTarget, EMPTYMODULE)
+        ,(ModBulletTrajectory, EMPTYMODULE)
+        ,(ModTeleport, EMPTYMODULE)
+        ]
+
 defaultItemValue :: ItemValue
 defaultItemValue = ItemValue 10 MundaneItem
 defaultCraftable :: Item
-defaultCraftable = Item 
+defaultCraftable = defaultItem 
-    { _itName = "default"
+    { _itEquipPict = pictureWeaponOnAim
-    , _itType = NoCombineType
-    , _itCurseStatus = Uncursed
-    , _itConsumption = NoConsumption
-    , _itUse = NoUse
-    , _itEquipPict = pictureWeaponOnAim
-    , _itAttachment = NoItAttachment
-    , _itID = Nothing
-    , _itInvPos = Nothing
-    , _itIsHeld = False
-    , _itEffect = NoItEffect
-    , _itInvDisplay = basicItemDisplay
     , _itInvColor = green
-    , _itInvSize  = 1
-    , _itParams = NoParams
     , _itDimension = defItDimCol green
-    , _itTweaks = NoTweaks
-    , _itModules = M.empty
-    , _itScope = NoScope
-    , _itTargeting = NoTargeting
-    , _itValue = defaultItemValue
     }
 defItDim :: ItemDimension
 defItDim = ItemDimension

src/Dodge/IncBall.hs

@@ -0,0 +1,10 @@
+module Dodge.IncBall where
+import Dodge.Data
+import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.Particle.Damage
+import Dodge.PtFlicker
+import Geometry
+import Picture
+
+import System.Random
+import Control.Monad.State

src/Dodge/Item.hs

@@ -3,6 +3,10 @@ module Dodge.Item
     , module Dodge.Item.Consumable
     , module Dodge.Item.PassKey
     ) where
+import Dodge.Data
 import Dodge.Item.Weapon
 import Dodge.Item.Consumable
 import Dodge.Item.PassKey
+
+fromType :: ItemType -> Item
+fromType ct = undefined

src/Dodge/Item/Consumable.hs

@@ -14,13 +14,13 @@ import qualified Data.IntMap.Strict as IM
 
 medkit :: Int -> Item
 medkit i = defaultConsumable
-    { _itName = "MEDKIT" ++ show i
+    { _itUse = ConsumeUse 
-    , _itUse = ConsumeUse 
         {_cUse = \_ cr w -> w & creatures . ix (_crID cr) . crHP +~ i
         }
     , _itEquipPict = pictureWeaponAim $ const $ (,) emptySH $ color blue $ circleSolid 3
     , _itID = Nothing
     }
+    & itType . iyBase .~ MEDKIT i
 
 heal25 :: Int -> World -> Maybe World
 heal25 = heal 25

src/Dodge/Item/Craftable.hs

@@ -9,19 +9,18 @@ import Color
 --import Geometry
 import Control.Lens
 
-makeTypeCraftNum :: Int -> CombineType -> Item
+makeTypeCraftNum :: Int -> ItemBaseType -> Item
 makeTypeCraftNum i ct = defaultCraftable
     { _itInvSize = 0.5
     , _itCurseStatus = Uncursed
-    , _itName = show ct
-    , _itType = ct
     , _itConsumption = ItemItselfConsumable i
     }
+    & itType . iyBase .~ ct
 
-makeTypeCraft :: CombineType -> Item
+makeTypeCraft :: ItemBaseType -> Item
 makeTypeCraft = makeTypeCraftNum 1
 
-makeModule :: CombineType -> Item
+makeModule :: ItemBaseType -> Item
 makeModule ct = makeTypeCraft ct
     & itInvSize .~ 1
     & itInvColor .~ chartreuse

src/Dodge/Item/Equipment.hs

@@ -22,14 +22,13 @@ import LensHelp
 import Data.Maybe
 magShield :: Item
 magShield = defaultEquipment
-    { _itType = MAGSHIELD
+    { _itEquipPict = \_ _ -> (,) emptySH blank
-    , _itName = "MAGSHIELD"
-    , _itEquipPict = \_ _ -> (,) emptySH blank
     , _itID = Nothing
     , _itAttachment = ItMInt Nothing
     }
     & itUse . eqEq . eqUse .~ useMagShield 
     & itUse . eqEq . eqSite .~ GoesOnWrist
+    & itType . iyBase .~ MAGSHIELD
 useMagShield :: Item -> Creature -> World -> World
 useMagShield it cr w = w & magnets . at mgid ?~ themagnet
   where
@@ -46,37 +45,34 @@ useMagShield it cr w = w & magnets . at mgid ?~ themagnet
 
 flameShield :: Item 
 flameShield = defaultEquipment
-    { _itType = FLAMESHIELD
+    { _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
-    , _itName = "FLAMESHIELD"
-    , _itEquipPict = \cr _ -> (,) emptySH $ setDepth 20 $ pictures [color cyan $ circle (_crRad cr+2)]
     , _itID = Nothing
     } & itUse . eqEq . eqSite .~ GoesOnChest
+    & itType . iyBase .~ FLAMESHIELD
 {- | Slows you down, blocks forward projectiles. -}
 frontArmour :: Item
 frontArmour = defaultEquipment
-    { _itType = FRONTARMOUR
+    { _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures
-    , _itName = "FARMOUR"
-    , _itEquipPict = pictureOnEquip (emptySH , setDepth 20 $ pictures
         [color thecol $ thickArc 0        (pi/2) 10 5
         ,color thecol $ thickArc (3*pi/2) (2*pi) 10 5
         ])
     , _itID = Nothing
     }
     & itUse . eqEq . eqSite .~ GoesOnChest
+    & itType . iyBase .~ FRONTARMOUR
   where
     thecol = yellow -- (greyN 0.1)
 
 wristArmour :: Item
 wristArmour = defaultEquipment
-    { _itType = WRISTARMOUR
+    { _itEquipPict = spicForWrist mempty
-    , _itName = "WRISTARMOUR"
-    , _itEquipPict = spicForWrist mempty
     , _itID = Nothing
     }
     & itUse . eqEq . eqSite .~ GoesOnWrist
     & itUse . eqEq . eqOnEquip .~ onEquipWristShield
     & itUse . eqEq . eqUse .~ setWristShieldPos
     & itUse . eqEq . eqOnRemove .~ onRemoveWristShield
+    & itType . iyBase .~ WRISTARMOUR
 
 onEquipWristShield :: Item -> Creature -> World -> World
 onEquipWristShield itm cr w = w
@@ -114,8 +110,6 @@ flatShield = defaultEquipment
     , _itEffect = effectOnOffHeld createShieldWall removeShieldWall
         -- the above seems to work, but I am not sure why: it may break on edge
         -- cases
-    , _itName   = "FLATSHIELD"
-    , _itType = FLATSHIELD
     , _itUse  = RightUse
         { _rUse = \_ _ -> id
         , _useDelay = NoDelay
@@ -135,6 +129,7 @@ flatShield = defaultEquipment
         ,"*" ++ replicate 13 ' ' ++ "*"
         ]
     }
+    & itType . iyBase .~ FLATSHIELD
 flatShieldEquipSPic :: Item -> SPic
 flatShieldEquipSPic _ = 
     ( colorSH yellow $ upperPrismPoly 10 (rectWH 2 10)
@@ -215,29 +210,25 @@ effectOnOffHeld f f' = ItInvEffectID
 {- | Increases speed, reduces friction, cannot only move forwards. -}
 jetPack :: Item
 jetPack = defaultEquipment
-    { _itType = JETPACK
+    { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
-    , _itName = "JETPACK"
-    , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 20
         $ pictures [color yellow $ polygon $ rectNSEW 5 (-5) (-3) (-11) ]
     , _itEffect = NoItEffect
     , _itID = Nothing
     }   & itUse . eqEq . eqSite .~ GoesOnBack
+    & itType . iyBase .~ JETPACK
 
 brainHat :: Item
 brainHat = defaultEquipment
-    { _itType = BRAINHAT
+    { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
-    , _itName = "BRAINHAT"
-    , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ upperPrismPoly 3 $ rectWH 4 4)
     , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ BRAINHAT
 
 headLamp1 :: Item
 headLamp1 = defaultEquipment
-    { _itType = HEADLAMP
+    { _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
-    , _itName = "HEADLAMP1"
-    , _itEquipPict = pictureOnEquip (noPic $ colorSH yellow $ 
             translateSHf 5 2 (upperPrismPoly 8 $ rectWH 4 1)
             <> translateSHf 5 (-2) (upperPrismPoly 8 $ rectWH 4 1)
             -- <> (upperPrismPoly 3 $ rectWH 4 4)
@@ -247,16 +238,16 @@ headLamp1 = defaultEquipment
     }
     & itUse . eqEq . eqUse .~ createHeadLamp
     & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ HEADLAMP1
 headLamp :: Item
 headLamp = defaultEquipment
-    { _itType = HEADLAMP
+    { _itEquipPict = pictureOnEquip (noPic headLampShape)
-    , _itName = "HEADLAMP"
-    , _itEquipPict = pictureOnEquip (noPic headLampShape)
     , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqEq . eqUse .~ createHeadLamp
     & itUse . eqEq . eqSite .~ GoesOnHead
+    & itType . iyBase .~ HEADLAMP
 
 headLampShape :: Shape
 headLampShape = colorSH yellow $ 
@@ -271,34 +262,28 @@ createHeadLamp _ cr = tempLightSources .:~ tlsTimeRadColPos 1 200 0.7
 
 powerLegs :: Item
 powerLegs = defaultEquipment
-    { _itType = POWERLEGS
+    { _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itName = "POWERLEGS"
-    , _itEquipPict = pictureOnEquip (noPic $ translateSH (V3 0 4 0) $ colorSH yellow $ upperPrismPoly 3 $ rectWH 2 2)
     , _itEffect = NoItEffect
     , _itID = Nothing
     }
     & itUse . eqEq . eqSite .~ GoesOnLegs
+    & itType . iyBase .~ POWERLEGS
 speedLegs :: Item
 speedLegs = powerLegs
-    { _itType = SPEEDLEGS
+    & itType . iyBase .~ SPEEDLEGS
-    , _itName = "SPEEDLEGS"
-    }
 jumpLegs :: Item
 jumpLegs = powerLegs
-    { _itType = JUMPLEGS
+    & itType . iyBase .~ JUMPLEGS
-    , _itName = "JUMPLEGS"
-    }
 
 wristInvisibility :: Item
 wristInvisibility = defaultEquipment
-    { _itType = INVISIBILITYEQUIPMENT GoesOnWrist
+    { _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itName = "WRISTINVISIBILITY"
-    , _itEquipPict = shapeForWrist (colorSH chartreuse $ upperPrismPoly 3 $ rectWH 2 2)
     , _itID = Nothing
     }
     & itUse . eqEq . eqSite .~ GoesOnWrist
     & itUse . eqEq . eqOnEquip  .~ overCID (crCamouflage .~ Invisible)
     & itUse . eqEq . eqOnRemove .~ overCID (crCamouflage .~ FullyVisible)
+    & itType . iyBase .~ INVISIBILITYEQUIPMENT GoesOnWrist
 
 overCID :: (Creature -> Creature) -> Item -> Creature -> World -> World
 overCID f _ cr = creatures . ix (_crID cr) %~ f

src/Dodge/Item/PassKey.hs

@@ -3,19 +3,19 @@ import Dodge.Data
 import Dodge.Default
 import Picture
 import Geometry.Data
+import LensHelp
 --import ShapePicture
 import Shape
 keyCard :: Int -> Item
 keyCard n = defaultEquipment
-    { _itType = KEYCARD n
+    { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
-    , _itName = "KEYCARD-"++show n
-    , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic
     , _itEffect = NoItEffect
     , _itID = Nothing
 --    , _itZoom = defaultItZoom
     , _itInvColor = aquamarine
-    , _itInvDisplay = (:[]) . _itName
     }
+    & itType . iyBase .~ KEYCARD n
+
 keyPic :: Picture
 keyPic = color green $
               pictures [translate (-4) 0 $ thickCircle 4 2
@@ -25,9 +25,7 @@ keyPic = color green $
 
 latchkey :: Int -> Item
 latchkey n = defaultEquipment
-    { _itType = NOTDEFINED
+    { _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
-    , _itName = "KEY "++show n
-    , _itEquipPict = \_ _ -> (,) emptySH $ setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) latchkeyPic
     , _itEffect = NoItEffect
     , _itID = Nothing
 --    , _itZoom = defaultItZoom

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -17,6 +17,8 @@ module Dodge.Item.Weapon.BatteryGuns
     , splitBeamCombine
     ) where
 import Dodge.Data
+import Dodge.Tesla
+import Dodge.Beam
 import Dodge.Item.Weapon.LaserPath
 import Dodge.Item.Location
 import Dodge.Creature.HandPos
@@ -52,28 +54,25 @@ import Control.Monad.State
 
 defaultBatteryGun :: Item
 defaultBatteryGun = defaultGun
-    & itModules .~ batteryModules
+    & itType . iyModules .~ batteryModules
 
-batteryModules :: M.Map ModuleSlot ItemModule
+batteryModules :: M.Map ModuleSlot ItemModuleType
 batteryModules = M.fromList 
-    [(ModBattery, DefaultModule)
+    [(ModBattery,  EMPTYMODULE)
-    ,(ModTeleport, DefaultModule)
+    ,(ModTeleport, EMPTYMODULE)
     ]
 
 defaultAutoBatteryGun :: Item
 defaultAutoBatteryGun = defaultAutoGun
-    & itModules .~ batteryModules
+    & itType . iyModules .~ batteryModules
 
 sparkGun :: Item
 sparkGun = teslaGun
-    & itName .~ "SPARKGUN"
+    & itType . iyBase .~ SPARKGUN
-    & itType .~ SPARKGUN
     & itParams . arcSize .~ 10
 teslaGun :: Item
 teslaGun = defaultBatteryGun 
-    { _itName = "TESLA"
+    { _itConsumption = defaultAmmo
-    , _itType = TESLAGUN
-    , _itConsumption = defaultAmmo
         { _laMax = 200
         , _laLoaded = 200
         , _laReloadTime = 80
@@ -97,14 +96,7 @@ teslaGun = defaultBatteryGun
         }
     , _itParams = teslaParams
     }
-teslaParams :: ItemParams
+    & itType . iyBase .~ TESLAGUN
-teslaParams = Arcing 
-    { _currentArc = Nothing
-    , _arcSize = 20
-    , _arcNumber = 10
-    , _newArcStep = defaultArcStep
-    , _previousArcEffect = NoPreviousArcEffect
-    }
 teslaGunPic :: Item -> SPic
 teslaGunPic _ = noPic $ colorSH blue $
            upperPrismPoly 5 (rectNESW xb    8 xa    0)
@@ -114,8 +106,7 @@ teslaGunPic _ = noPic $ colorSH blue $
     xb = 9
 lasGunPulse :: Item
 lasGunPulse = lasGun
-    & itName .~ "PULSELAS"
+    & itType . iyBase .~ LASPULSE
-    & itType .~ LASPULSE
     & itUse . useMods .~
         [ ammoCheckI
         , withItem $ \it -> withTempLight 1 (100 * frac it) (xyzV4 (_lasColor $ _itParams it))
@@ -134,8 +125,7 @@ lasGunPulse = lasGun
 
 lasGunWide :: Int -> Item
 lasGunWide n = lasGun
-    & itName .~ "PARALELLAS"++show n
+    & itType . iyBase .~ LASGUNWIDE n
-    & itType .~ LASGUNWIDE n
     & itParams . lasColor .~ orange
     & itParams . lasDamage .~ 2
     & itUse .~ ( ruseInstant shootLaser NoHammer
@@ -155,8 +145,7 @@ lasGunWide n = lasGun
     xs = [ 0.25 * (fromIntegral x - fromIntegral (n'-1) /2)  | x <- [0..n'-1] ]
 lasGunWidePulse :: Item
 lasGunWidePulse = lasGun
-    & itName .~ "LASWIDEPULSE"
+    & itType . iyBase .~ LASGUNWIDEPULSE
-    & itType .~ LASGUNWIDEPULSE
     & itParams . lasColor .~ orange
     & itParams . lasDamage .~ 2
     & itUse .~ ( ruseInstant shootLaser NoHammer
@@ -183,8 +172,7 @@ lasGunWidePulse = lasGun
         n' = (ceiling $ (150 :: Float) * frac it) :: Int
 lasGunSway :: Item
 lasGunSway = lasGun
-    & itName .~ "SWAYLAS"
+    & itType . iyBase .~ LASGUNSWAY
-    & itType .~ LASGUNSWAY
     & itParams . lasColor .~ orange
     & itParams . lasDamage .~ 11
     & itUse .~ ( ruseInstant shootLaser NoHammer
@@ -206,8 +194,7 @@ lasGunSway = lasGun
         x' = _lasCycle $ _itParams it
 lasGunFocus :: Int -> Item
 lasGunFocus n = lasGunWide n
-    & itName .~ "FOCALAS"++show n
+    & itType . iyBase .~ LASGUNFOCUS n
-    & itType .~ LASGUNFOCUS n
     & itParams . lasColor .~ red
     & itUse . useMods .~
         [ ammoCheckI
@@ -223,8 +210,7 @@ lasGunFocus n = lasGunWide n
 
 lasGunDual :: Item
 lasGunDual = lasGun
-    & itName .~ "DUALAS"
+    & itType . iyBase .~ LASGUNDUAL
-    & itType .~ LASGUNDUAL
     & itParams .~ DualBeam
         { _phaseV = 1
         , _lasColor = orange
@@ -246,11 +232,10 @@ lasGunDual = lasGun
         & useAim . aimRange .~ 1
         & useAim . aimStance .~ TwoHandTwist
         )
-    & itModules . at ModDualBeam ?~ DefaultModule
+    & itType . iyModules . at ModDualBeam ?~ EMPTYMODULE
 lasGunSwing :: Item
 lasGunSwing = lasGun
-    & itName .~ "SWINGLAS"
+    & itType . iyBase .~ LASGUNSWING
-    & itType .~ LASGUNSWING
     & itParams . lasColor .~ orange
     & itUse . useMods .~
         [ ammoCheckI
@@ -268,9 +253,7 @@ lasGunSwing = lasGun
         x' = _lasCycle $ _itParams it
 lasGun :: Item
 lasGun = defaultAutoBatteryGun 
-    { _itName = "LASGUN"
+    { _itConsumption = defaultAmmo
-    , _itType = LASGUN
-    , _itConsumption = defaultAmmo
         { _laMax = 200
         , _laLoaded = 200
         , _laReloadTime = 80
@@ -303,6 +286,8 @@ lasGun = defaultAutoBatteryGun
         , _dimSPic = lasGunPic
         }
     }
+    & itType . iyBase .~ LASGUN
+
 lasGunPic :: Item -> SPic
 lasGunPic it = 
     ( colorSH blue $ 
@@ -335,9 +320,7 @@ lasGunTweak = TweakParam
 
 tractorGun :: Item
 tractorGun = lasGun 
-    { _itName = "TRACTORGUN"
+    { _itConsumption = defaultAmmo
-    , _itType = TRACTORGUN
-    , _itConsumption = defaultAmmo
         { _laMax = 10000
         , _laLoaded = 10000
         , _laReloadTime = 40
@@ -360,6 +343,8 @@ tractorGun = lasGun
         , _tweakSel = 0
         }
     }
+    & itType . iyBase .~ TRACTORGUN
+
 tractorGunTweak :: TweakParam
 tractorGunTweak = TweakParam
     { _doTweak = thetweak
@@ -400,84 +385,6 @@ shootTeslaArc it cr w = w'
     pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
 
-shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
-shootTeslaArc' ip pos dir w = 
-    (w & randGen .~ g
-       & instantParticles .:~ aTeslaArcAt col newarc
-    , ip & currentArc ?~ newarc
-    )
-  where
-    (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
-    newarc = createArc ip w pos dir & evalState $ _randGen w
-
-
-createArc :: ItemParams
-    -> World
-    -> Point2
-    -> Float
-    -> State StdGen [ArcStep]
-createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
-createArc arcparams w p dir = updateArc arcparams w p dir
-
-createNewArc :: ItemParams -> World -> Point2 -> Float
-    -> State StdGen [ArcStep]
-createNewArc arcparams w p dir = take (_arcNumber arcparams)
-    <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)
-
-defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
-    -> State g (Maybe ArcStep)
-defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
-defaultArcStep itparams w (ArcStep p dir _) = do
-    let csize = _arcSize itparams
-    --rot <- takeOne [pi/4,negate pi/4]
-    rot <- takeOne [0]
-    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
-    newp <- (center +.+) <$> randInCirc csize
-    let mcr = listToMaybe 
-            . sortOn (dist center . _crPos) 
-            . filter (\cr -> dist center (_crPos cr) < csize)
-            . IM.elems
-            $ _creatures w
-        wlsnearpoint = wallsNearPoint p w
-        mwl = listToMaybe
-            . sortOn (dist p . fst)
-            . mapMaybe (\ q -> collidePointWallsWall p (center +.+ q) wlsnearpoint)
-            $ polyCirc 6 csize
-        f (q,wl) = ArcStep q dir (Just $ Right wl)
-        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
-    return . listToMaybe . sortOn (dist p . (^. asPos))
-        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]
-
-updateArc :: ItemParams
-    -> World
-    -> Point2
-    -> Float
-    -> State StdGen [ArcStep]
-updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc
-  where
-    carc = tail $ fromJust $ _currentArc ip
-
-zipArcs :: ItemParams
-    -> World
-    -> ArcStep
-    -> [ArcStep]
-    -> State StdGen [ArcStep]
-zipArcs ip w x (y:ys) = (x :) <$> do  
-    defaultnext <- _newArcStep ip ip w x
-    case defaultnext of
-        Nothing -> return []
-        Just z@(ArcStep _ _ (Just _)) -> return [z]
-        Just z -> do
-            p <- randInCirc 5
-            let csize = _arcSize ip
-                center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
-                newp = _asPos y +.+ p
-                --newdir = argV $ newp -.- _asPos x
-                newdir = _asDir x
-            if dist newp center < csize
-                then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
-                else zipArcs ip w z ys
-zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)
 
 shootLaser :: Item -> Creature -> World -> World
 shootLaser it cr = instantParticles .:~ lasRayAt (_lasColor $ _itParams it) dam phasev pos dir
@@ -537,64 +444,6 @@ dualRayAt :: BeamType -> Int -> World -> Color -> Int -> Float -> Point2 -> Floa
 dualRayAt bt itid w col dam phasev pos dir = basicBeamAt itid w col dam phasev pos dir
     & bmType .~ bt
 
-flameBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-flameBeamCombine (p,(a,b,_),(x,y,_))
-    = makeFlame p (2 *.* normalizeV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
-
-lasBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-lasBeamCombine (p,(a,b,_),(x,y,_)) 
-    = instantParticles .:~ lasRayAt yellow 11 1 p (argV (normalizeV (b-.-a)+.+normalizeV (y-.-x)))
-
-splitBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-splitBeamCombine (p,(a,b,_),(x,y,_)) 
-    = (instantParticles .:~ lasRayAt yellow 11 1 p (dir+0.5*pi))
-    . (instantParticles .:~ lasRayAt yellow 11 1 p (dir-0.5*pi))
-  where
-    dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
-
-teslaBeamCombine :: (Point2,(Point2,Point2,Beam),(Point2,Point2,Beam))
-    -> World -> World
-teslaBeamCombine (p,(a,b,bm),(x,y,_)) w
-    = w' & pointToItem (_itemPositions w IM.! itid) . itParams . subParams ?~ ip
-  where
-    itid = fromJust $ _bmOrigin bm
-    dir = argV (normalizeV (b-.-a)+.+normalizeV (y-.-x))
-    (w',ip) = shootTeslaArc' (fromJust . _subParams $ _itParams it) p dir w
-    it = case getItem itid w of
-        Nothing -> error "tried to get item use teslaBeamCombine that doesn't exist"
-        Just itm -> itm
-
-lasRayAt :: Color -> Int -> Float -> Point2 -> Float -> Particle
-lasRayAt col dam phasev pos dir = LaserParticle
-    { _ptDraw = const blank
-    , _ptUpdate = mvLaser phasev pos dir
-    , _ptRange = 800
-    , _ptDamage = dam
-    , _ptPhaseV = phasev
-    , _ptColor = col
-    }
-mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
-    -> Point2 
-    -> Float 
-    -> World 
-    -> Particle 
-    -> (World, Maybe Particle)
-mvLaser phasev pos dir w pt
-    = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) pos xp thHit w
-      , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
-      )
-  where
-    dam = _ptDamage pt
-    xp = pos +.+ 800 *.* unitVectorAtAngle dir
-    (thHit, ps) = reflectLaserAlong phasev [] pos xp w
-    col = _ptColor pt
-    pic = setLayer BloomNoZWrite $ pictures
-        [ setDepth 19   . color (brightX 0 0.5 col) $ thickLine 20 (pos:ps)
-        , setDepth 19.5 . color (brightX 10 1 col)  $ thickLine 3  (pos:ps)
-        ]
 aTractorBeam :: Item -> Creature -> World -> World
 aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
   where 

src/Dodge/Item/Weapon/Booster.hs

@@ -110,9 +110,7 @@ maxT = 20
 
 boosterGun :: Item
 boosterGun = defaultGun 
-    { _itName = "BOOSTER"
+    { _itInvColor = cyan
-    , _itType = BOOSTER
-    , _itInvColor = cyan
     , _itConsumption = defaultAmmo
         { _laMax = 100
         , _laLoaded = 100
@@ -121,6 +119,7 @@ boosterGun = defaultGun
     , _itUse = luseInstantNoH $ boostSelfL 10
     , _itEffect = resetAttachmentID
     }
+    & itType . iyBase .~ BOOSTER
 resetAttachmentID :: ItEffect
 resetAttachmentID = ItInvEffect f 0
   where

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

@@ -41,9 +41,7 @@ import Data.Maybe
 
 bangCane :: Item
 bangCane = defaultGun
-    { _itName = "BANGCANE"
+    { _itParams = BulletShooter
-    , _itType = BANGCANE
-    , _itParams = BulletShooter
         { _muzVel = 0.8
         , _rifling = 0.9
         , _bore = 2
@@ -82,11 +80,10 @@ bangCane = defaultGun
             <> makeSingleClipAt (V3 5 0 3) it
         }
     } & itUse . useAim . aimStance .~ OneHand
+    & itType . iyBase .~ BANGCANE
 bangCaneX :: Int -> Item
 bangCaneX i = bangCane
-    { _itName = "BANGCANEx"++show i
+    { _itUse = ruseAmmoParamsRate 6 upHammer
-    , _itType = BANGCANEX i
-    , _itUse = ruseAmmoParamsRate 6 upHammer
         [ ammoHammerCheck
         , useTimeCheck
         , withSoundItemChoiceStart caneStickSoundChoice
@@ -121,6 +118,7 @@ bangCaneX i = bangCane
         ,_brlInaccuracy = 0.1
         }
     & itParams . torqueAfter .~ 0.48 + 0.2 * fromIntegral i
+    & itType . iyBase .~ BANGCANEX i
 caneStickSoundChoice :: Item -> SoundID
 caneStickSoundChoice it
     | _laLoaded (_itConsumption it) < 2 = tap3S 
@@ -146,8 +144,7 @@ rifle = bangCane
         }
     }
     & itUse . useAim . aimStance .~ TwoHandTwist
-    & itName .~ "RIFLE"
+    & itType . iyBase .~ RIFLE
-    & itType .~ RIFLE
     & itConsumption . laMax .~ 1
     & itUse . useAim . aimWeight .~ 6
     & itUse . useAim . aimRange .~ 1
@@ -155,9 +152,8 @@ rifle = bangCane
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 2}
 repeater :: Item
 repeater = rifle
-    & itModules . at ModRifleMag ?~ DefaultModule
+    & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
-    & itName .~ "REPEATER"
+    & itType . iyBase .~ REPEATER
-    & itType .~ REPEATER
     & itConsumption . laReloadType .~ ActiveClear
     & itConsumption . laReloadTime .~ 80
     & itConsumption . laMax .~ 15
@@ -173,15 +169,13 @@ baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
 
 autoRifle :: Item
 autoRifle = repeater
-    & itName .~ "AUTORIFLE"
+    & itType . iyBase .~ AUTORIFLE
-    & itType .~ AUTORIFLE
     & itUse . useMods %~ ((ammoCheckI :) . tail)
-    & itModules . at ModAutoMag ?~ DefaultModule
+    & itType . iyModules . at ModAutoMag ?~ EMPTYMODULE
 --    & itUse . useDelay . rateMax .~ 6
 burstRifle :: Item
 burstRifle = repeater
-    & itName .~ "BURSTRIFLE"
+    & itType . iyBase .~ BURSTRIFLE
-    & itType .~ BURSTRIFLE
     & itParams . gunBarrels . brlInaccuracy .~ 0.05
     & itUse . useDelay . rateMax .~ 18
     & itUse . useMods .~
@@ -198,8 +192,7 @@ burstRifle = repeater
         ]
 fastBurstRifle :: Item
 fastBurstRifle = repeater
-    & itName .~ "FASTBURSTRIFLE"
+    & itType . iyBase .~ FASTBURSTRIFLE
-    & itType .~ FASTBURSTRIFLE
     & itParams . gunBarrels . brlInaccuracy .~ 0.06
     & itUse . useDelay . rateMax .~ 18
     & itUse . useMods .~
@@ -216,9 +209,8 @@ fastBurstRifle = repeater
         ]
 completeBurstRifle :: Item
 completeBurstRifle = repeater
-    & itName .~ "COMPLETEBURSTRIFLE"
+    & itType . iyBase .~ COMPLETEBURSTRIFLE
-    & itType .~ COMPLETEBURSTRIFLE
+    & itType . iyModules . at ModRifleMag .~ Nothing
-    & itModules . at ModRifleMag .~ Nothing
     & itParams . gunBarrels . brlInaccuracy .~ 0.1
     & itUse . useDelay . rateMax .~ 28
     & itUse . useMods .~
@@ -262,9 +254,7 @@ miniGunUse i = ruseInstant (useAmmoParams $ Just 1) NoHammer $
 
 miniGunX :: Int -> Item
 miniGunX i = defaultAutoGun 
-    { _itName = "MINIGUN-" ++ show i
+    { _itConsumption = defaultAmmo 
-    , _itType = MINIGUNX i
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet
         , _laMax = 1500
         , _laLoaded = 1500
@@ -308,7 +298,7 @@ miniGunX i = defaultAutoGun
         }
     }
     & itDimension . dimPortage . muzPos .~ 40
-
+    & itType . iyBase .~ MINIGUNX i
 miniGunXPictItem :: Int -> Item -> SPic
 miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _itConsumption it)
   where

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

@@ -7,6 +7,7 @@ module Dodge.Item.Weapon.BulletGun.Rod
     , machineGun
     ) where
 import Dodge.Data
+import Dodge.Default.Item
 import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Particle.HitEffect
@@ -41,9 +42,7 @@ import Data.Maybe
 
 bangRod :: Item
 bangRod = defaultGun
-    { _itName = "BANGROD"
+    { _itParams = BulletShooter
-    , _itType = BANGROD
-    , _itParams = BulletShooter
         { _muzVel = 0.8
         , _rifling = 1
         , _bore = 2
@@ -79,6 +78,7 @@ bangRod = defaultGun
         , _laReloadTime = 20
         }
     } 
+    & itType . iyBase .~ BANGROD
     & itUse . useAim . aimWeight .~ 8
     & itUse . useAim . aimRange .~ 1
     & itUse . useAim . aimStance .~ OneHand
@@ -90,8 +90,7 @@ baseAMRShape :: Shape
 baseAMRShape = colorSH orange $ upperPrismPoly 3 $ rectXH 30 2
 elephantGun :: Item
 elephantGun = bangRod
-    & itName .~ "ELEPHANTGUN"
+    & itType . iyBase .~ ELEPHANTGUN
-    & itType .~ ELEPHANTGUN
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itParams . gunBarrels .~ SingleBarrel 0.05
     & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape
@@ -112,8 +111,7 @@ elephantGun = bangRod
     & itParams . torqueAfter .~ 0.1
 amr :: Item
 amr = elephantGun
-    & itName .~ "ANTIMATERIELRIFLE"
+    & itType . iyBase .~ AMR
-    & itType .~ AMR
     & itConsumption . laMax .~ 15
     & itDimension . dimSPic .~ (\it -> noPic $ baseAMRShape
             <> makeTinClipAt 0 (V3 10 (-2) 0) it
@@ -121,14 +119,12 @@ amr = elephantGun
 
 autoAmr :: Item
 autoAmr = amr
-    & itName .~ "AUTOAMR"
+    & itType . iyBase .~ AUTOAMR
-    & itType .~ AUTOAMR
     & itUse . useMods %~ ((ammoCheckI :) . tail)
 
 sniperRifle :: Item
 sniperRifle = elephantGun
-    & itName .~ "SNIPERRIFLE"
+    & itType . iyBase .~ SNIPERRIFLE
-    & itType .~ SNIPERRIFLE
     & itParams . gunBarrels .~ SingleBarrel 0
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}
     & itUse . heldScroll  .~ zoomLongGun
@@ -137,8 +133,7 @@ sniperRifle = elephantGun
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1}
 machineGun :: Item
 machineGun = bangRod
-    & itName .~ "MACHINEGUN"
+    & itType . iyBase .~ MACHINEGUN
-    & itType .~ MACHINEGUN
     & itUse .~ (ruseAmmoParamsRate 25 NoHammer
         [ ammoCheckI
         , rateIncAB (torqueBeforeAtLeast 0.1 0.1) withTorqueAfter

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

@@ -41,11 +41,7 @@ bangStickSoundChoice it
 
 bangStick :: Int -> Item
 bangStick i = defaultGun 
-    { _itName = case i of
+    { _itConsumption = defaultAmmo 
-        1 -> "BANGSTICK"
-        _ -> "BANGSTICKx"++ show i
-    , _itType = BANGSTICK i
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet
         , _laMax = i
         , _laReloadTime = 10
@@ -62,8 +58,6 @@ bangStick i = defaultGun
 --        , applyInaccuracy
         , withRecoil
         ]
-    , _itID = Nothing
-    , _itInvColor = white
     , _itParams = BulletShooter
         { _muzVel = 0.8
         , _rifling = 0.8
@@ -89,6 +83,7 @@ bangStick i = defaultGun
             <> stickClip it
         }
     }
+    & itType . iyBase .~ BANGSTICK i
 baseStickShapeX :: Int -> Shape
 baseStickShapeX i = foldMap f [0..i-1]
   where
@@ -115,9 +110,7 @@ stickClip it = case it ^? itConsumption . laLoaded of
 
 revolver :: Item
 revolver = pistol
-    { _itName = "REVOLVER"
+    { _itConsumption = defaultAmmo 
-    , _itType = REVOLVER
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet
         , _laMax = 6
         , _laLoaded = 0
@@ -126,6 +119,7 @@ revolver = pistol
         }
     }
     & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> revolverClip it)
+    & itType . iyBase .~ REVOLVER
 
 revolverClip :: Item -> Shape
 revolverClip it = case it ^? itConsumption . laLoaded of
@@ -170,9 +164,7 @@ smgAfterHamMods =
 
 pistol :: Item
 pistol = (bangStick 1)
-    { _itName = "PISTOL"
+    { _itConsumption = defaultAmmo 
-    , _itType = PISTOL
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet
         , _laMax = 15
         , _laLoaded = 0
@@ -183,8 +175,6 @@ pistol = (bangStick 1)
         (ammoHammerCheck : pistolAfterHamMods)
 --    , _itZoom = defaultItZoom
 --    , _itEquipPict = pictureWeaponAim pistolPic
-    , _itID = Nothing
-    , _itInvColor = white
     } & itDimension . dimSPic .~ (\it -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it)
     & itParams %~
         ( ( muzVel .~ 0.8 )
@@ -194,25 +184,23 @@ pistol = (bangStick 1)
         . ( recoil .~ 10 )
         . ( torqueAfter .~ 0.2 )
         )
+    & itType . iyBase .~ PISTOL
 autoPistol :: Item
 autoPistol = pistol 
     & itUse . useMods .~ (ammoCheckI : pistolAfterHamMods)
-    & itName .~ "AUTOPISTOL"
+    & itType . iyBase .~ AUTOPISTOL
-    & itType .~ AUTOPISTOL
+    & itType . iyModules . at ModAutoMag ?~ EMPTYMODULE
-    & itModules . at ModAutoMag ?~ DefaultModule
 machinePistol :: Item
 machinePistol = autoPistol 
     & itUse . useDelay . rateMax .~ 2
     & itUse . useMods .~ (ammoCheckI : machinePistolAfterHamMods)
-    & itName .~ "MACHINEPISTOL"
+    & itType . iyBase .~ MACHINEPISTOL
-    & itType .~ MACHINEPISTOL
+    & itType . iyModules . at ModAutoMag .~ Nothing
-    & itModules . at ModAutoMag .~ Nothing
     & itParams . recoil .~ 20
 smg :: Item
 smg = autoPistol -- & some parameter affecting stability
     & itUse . useMods .~ (ammoCheckI : smgAfterHamMods)
-    & itName .~ "SMG"
+    & itType . iyBase .~ SMG
-    & itType .~ SMG
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itDimension . dimPortage . handlePos .~ 2
     & itParams . torqueAfter .~ 0.05
@@ -220,9 +208,7 @@ smg = autoPistol -- & some parameter affecting stability
         <> makeTinClipAt 0 (V3 7 (-2) 0) it)
 revolverX :: Int -> Item
 revolverX i = revolver
-    { _itName = "REVx"++show i
+    { _itUse = ruseAmmoParamsRate 8 upHammer
-    , _itType = REVOLVERX i
-    , _itUse = ruseAmmoParamsRate 8 upHammer
         [ ammoHammerCheck
         , useTimeCheck
         -- rather than locking the inventory, a better solution may be to check
@@ -238,3 +224,4 @@ revolverX i = revolver
         , withRecoil
         ]
     }   & itConsumption . laMax .~ i * 6
+    & itType . iyBase .~ REVOLVERX i

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -5,7 +5,6 @@ module Dodge.Item.Weapon.BulletGuns
     , biggerBlunderbuss
     , biggestBlunderbuss
     , grenadeLauncher
-    , ltAutoGun
     , autogunSpread
     , autoGun
     , autoGunPic
@@ -44,9 +43,7 @@ import System.Random
 
 autoGun :: Item
 autoGun = defaultAutoGun 
-    { _itName = "AUTOGUN"
+    { _itConsumption = defaultAmmo 
-    , _itType = AUTOGUN
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet    
         , _laMax = 30
         , _laLoaded = 30
@@ -88,6 +85,7 @@ autoGun = defaultAutoGun
         }
     }
     & itUse . heldScroll .~ scrollCharMode
+    & itType . iyBase .~ AUTOGUN
 autoGunPic :: Item -> SPic
 autoGunPic it = noPic $
      colorSH red (prismPoly 
@@ -100,9 +98,7 @@ autoGunPic it = noPic $
 
 bangCone :: Item
 bangCone = defaultGun 
-    { _itName = "BANGCONE"
+    { _itConsumption = defaultAmmo 
-    , _itType = BANGCONE
-    , _itConsumption = defaultAmmo 
         { _laType = basicBullet
         , _laMax = 5
         , _laReloadTime = 25
@@ -143,6 +139,7 @@ bangCone = defaultGun
             <> upperPrismPoly 6 (rectNSEW 4 (-4) 15 5)
         }
     }
+    & itType . iyBase .~ BANGCONE
 coneRandItemUpdate :: State StdGen (Item -> Item)
 coneRandItemUpdate = do
     wth <- state $ randomR (1,5)
@@ -158,9 +155,7 @@ coneRandItemParams = do
 
 blunderbuss :: Item
 blunderbuss = bangCone
-    {_itName = "BLUNDERBUSS"
+    {_itDimension = ItemDimension
-    ,_itType = BLUNDERBUSS
-    , _itDimension = ItemDimension
         { _dimRad = 8
         , _dimCenter = V3 5 0 0
         , _dimPortage = HeldItem
@@ -175,11 +170,10 @@ blunderbuss = bangCone
     & itConsumption . laReloadTime .~ 30
     & itUse . useAim . aimStance .~ TwoHandTwist
     & itUse . useAim . aimWeight .~ 6
+    & itType . iyBase .~ BLUNDERBUSS
 bigBlunderbuss :: Item
 bigBlunderbuss = blunderbuss
-    {_itName = "BIGBLUNDERBUSS"
+    & itType . iyBase .~ BIGBLUNDERBUSS
-    ,_itType = BIGBLUNDERBUSS
-    }
     & itConsumption . laMax .~ 50
     & itConsumption . laReloadTime .~ 36
     & itParams . recoil .~ 200
@@ -187,9 +181,7 @@ bigBlunderbuss = blunderbuss
     & itParams . randomOffset .~ 16
 biggerBlunderbuss :: Item
 biggerBlunderbuss = bigBlunderbuss
-    {_itName = "BIGGERBLUNDERBUSS"
+    & itType . iyBase .~ BIGGERBLUNDERBUSS
-    ,_itType = BIGGERBLUNDERBUSS
-    }
     & itConsumption . laMax .~ 75
     & itConsumption . laReloadTime .~ 43
     & itParams . recoil .~ 250
@@ -197,9 +189,7 @@ biggerBlunderbuss = bigBlunderbuss
     & itParams . randomOffset .~ 20
 biggestBlunderbuss :: Item
 biggestBlunderbuss = biggerBlunderbuss
-    {_itName = "BIGGESTBLUNDERBUSS"
+    & itType . iyBase .~ BIGGESTBLUNDERBUSS
-    ,_itType = BIGGESTBLUNDERBUSS
-    }
     & itConsumption . laMax .~ 100
     & itConsumption . laReloadTime .~ 50
     & itParams . recoil .~ 300
@@ -209,39 +199,9 @@ biggestBlunderbuss = biggerBlunderbuss
 grenadeLauncher :: Int -> Item
 grenadeLauncher _ = bangCone
 
-ltAutoGun :: Item                           
-ltAutoGun = defaultAutoGun 
-    { _itName = "AUTO-LT"
-    , _itType = LTAUTOGUN
-    , _itConsumption = defaultAmmo 
-        { _laType = basicBullet
-        , _laMax = 15
-        , _laLoaded = 0
-        , _laReloadTime = 90
-        }
-    , _itUse = ruseAmmoParamsRate 2 NoHammer
-        [ ammoCheckI
-        , useTimeCheck
-        , withSoundStart tap1S
-        , useAmmoAmount 1
-        , applyInaccuracy
-        , withTorqueAfter
-        , withSidePushI 50
-        , modClock 2 withMuzFlareI
-        ]
---    , _itFloorPict = ltAutoGunPic
-    , _itParams = defBulletShooter
-        { _muzVel = 1
-        , _rifling = 0.8
-        , _bore = 2
-        , _gunBarrels = SingleBarrel autogunSpread
-        }
-    }
 longGun :: Item
 longGun = defaultGun
-    { _itName = "LONGGUN"
+    { _itConsumption = defaultAmmo
-    , _itType = LONGGUN
-    , _itConsumption = defaultAmmo
         { _laType = hvBullet
         , _laMax = 1
         , _laLoaded = 1
@@ -267,6 +227,7 @@ longGun = defaultGun
     , _itScope = ZoomScope (V2 0 0) 0 1 0.1 False
 --    , _itEffect = itemLaserScopeEffect
     }
+    & itType . iyBase .~ LONGGUN
 
 autogunSpread :: Float
 autogunSpread = 0.07

src/Dodge/Item/Weapon/Drone.hs

@@ -20,9 +20,7 @@ import Control.Lens
 
 lasDrones :: Item
 lasDrones = defaultGun 
-    { _itName = "DRONES"
+    { _itConsumption = defaultAmmo 
-    , _itType = DRONELAUNCHER
-    , _itConsumption = defaultAmmo 
         { _laType = DroneAmmo { _amString = "LASDRONE" }
         , _laMax = 2
         , _laLoaded = 2
@@ -39,6 +37,7 @@ lasDrones = defaultGun
         & useAim . aimStance .~ TwoHandTwist
     , _itEffect = NoItEffect
     }
+    & itType . iyBase .~ DRONELAUNCHER
 
 lasDronesPic :: Item -> SPic
 lasDronesPic _ = 

src/Dodge/Item/Weapon/Grenade.hs

@@ -220,7 +220,7 @@ throwRemoteBomb :: Creature -> World -> World
 throwRemoteBomb cr w = setLocation 
     $ removePict 
     $ resetFire 
-    $ resetName 
+--    $ resetName 
     $ over props addG w
   where 
     cid = _crID cr
@@ -237,7 +237,7 @@ throwRemoteBomb cr w = setLocation
     v   | magV v' > 6 = 6 *.* normalizeV v'
         | otherwise   = v'
     j = _crInvSel cr
-    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
+--    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTE"
     removePict = set (creatures . ix cid . crInv . ix j . itEquipPict) $ \ _ _ -> emptyBlank
     resetFire = set (creatures . ix cid . crInv . ix j . itUse . rUse) 
         $ \_ -> explodeRemoteBomb itid i
@@ -258,14 +258,14 @@ explodeRemoteBomb itid pjid cr w
     = set (props . ix pjid . pjUpdate) (\_ -> retireRemoteBomb itid 30 pjid)
 --        $ set (props . ix pjid . pjDraw) (\_ -> blank)
         $ set (creatures . ix cid . crInv . ix j . itUse . rUse) (\_ -> const id)
-        $ resetName
+--        $ resetName
         $ resetPict
 --        $ resetScope
         $ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
         -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
   where 
     cid = _crID cr
-    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
+--    resetName = set (creatures . ix cid . crInv . ix j . itName) "REMOTEBOMB"
     resetPict = set (creatures . ix cid . crInv . ix j . itEquipPict ) 
                     (pictureWeaponAim $ \_ -> (,) emptySH remoteBombUnarmedPic)
 --    resetScope = creatures . ix cid . crInv . ix j . itScope . _Just . scopePos .~ (0,0)

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -2,11 +2,7 @@
 Display of weapon strings in the inventory.
  -}
 module Dodge.Item.Weapon.InventoryDisplay
-    ( basicItemDisplay
+ where
-    , maybeWarmupStatus
-    , maybeRateStatus
-    , moduleStrings
-    ) where
 import Dodge.Data
 import Padding
 import Dodge.Inventory.ItemSpace
@@ -15,46 +11,4 @@ import Dodge.Module
 import Data.Maybe
 import Data.Sequence
 import Control.Lens
-{- | Displays the item name, ammo if loaded, and any selected '_itCharMode'.  -}
-basicItemDisplay :: Item -> [String]
-basicItemDisplay it = Prelude.take (itSlotsTaken it) $
-    (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
-    : moduleStrings it ++ repeat "*"
-  where 
-    thename  = _itName it
-    thenumber = case it ^? itConsumption of
-        Just am@LoadableAmmo{} -> case _laReloadState am of 
-            Nothing' -> show (_laLoaded am)
-            Just' x  -> show x ++ "R" ++ show (_laLoaded am)
-        Just am@ChargeableAmmo{} -> show $ _wpCharge am
-        Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x)
-        Just NoConsumption -> ""
-        Nothing -> ""
-    theparam = fromMaybe []
-        . listToMaybe 
-        $ mapMaybe ($ it) 
-        [ maybeModeStatus
---        , maybeWarmupStatus
---        , maybeRateStatus
-        ]
 
--- this can be moved to Dodge/Module and unified with moduleSizes
-
-maybeModeStatus :: Item -> Maybe String
-maybeModeStatus it = case it ^? itAttachment of
-    Just ItCharMode {_itCharMode = (c :<| _)} -> Just [' ',c]
-    Just ItMode {_itMode = i} -> Just $ show i
-    _   -> Nothing
-
-maybeRateStatus :: Item -> Maybe String
-maybeRateStatus it = case it ^? itUse . useDelay . rateMaxMax of
-    Nothing -> Nothing
-    _ -> Just $ leftPad 3 ' ' (show (_rateMax . _useDelay $ _itUse it))
-
-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
-                in Just $ Prelude.take (4 - Prelude.length n) "WARM" ++ n

src/Dodge/Item/Weapon/Launcher.hs

@@ -38,9 +38,7 @@ import System.Random
 
 launcher :: Item
 launcher = defaultGun 
-    { _itName = "ROCKO"
+    { _itConsumption = defaultAmmo 
-    , _itType = LAUNCHER
-    , _itConsumption = defaultAmmo 
         { _laType = ProjectileAmmo 
             { _amPayload = makeExplosionAt
             , _amString = "EXPLOSIVE SHELL"
@@ -71,7 +69,6 @@ launcher = defaultGun
         , _tweakParams = basicAmPjMoves
         }
     , _itInvSize = 3
-    , _itInvDisplay = basicItemDisplay
     , _itDimension = ItemDimension
         { _dimRad = 9
         , _dimCenter = V3 10 0 0
@@ -82,12 +79,12 @@ launcher = defaultGun
         , _dimSPic = launcherPic
         }
     }
-    & itModules . at ModLauncherHoming ?~ DefaultModule
+    & itType . iyBase .~ LAUNCHER
+    & itType . iyModules . at ModLauncherHoming ?~ EMPTYMODULE
 
 launcherX :: Int -> Item
 launcherX i = launcher
-    & itName .~ ("ROCKO-" ++ show i)
+    & itType . iyBase .~ LAUNCHERX i
-    & itType .~ LAUNCHERX i
     & itConsumption . laMax .~ i
     & itConsumption . laLoaded  .~ i
     & itUse . rUse .~ usePjCreationX i
@@ -287,8 +284,7 @@ remoteLauncherName = "ROCKO-REMOTE"
 
 remoteLauncher :: Item
 remoteLauncher = launcher 
-    & itName .~ remoteLauncherName
+    & itType . iyBase .~ REMOTELAUNCHER
-    & itType .~ REMOTELAUNCHER
     & itUse . rUse .~ fireRemoteShell
     & itScope .~ RemoteScope (V2 0 0) 1 True
     & itConsumption . laType . amPjDraw .~ drawRemoteShell
@@ -297,7 +293,7 @@ remoteLauncher = launcher
 fireRemoteShell :: Item -> Creature -> World -> World
 fireRemoteShell it cr w = set (creatures . ix cid . crInv . ix j . itUse . rUse)
         (\_ _ -> explodeRemoteRocket itid i)
-    $ set (creatures . ix cid . crInv . ix j . itName) remoteLauncherName
+--    $ set (creatures . ix cid . crInv . ix j . itName) remoteLauncherName
     $ addRemRocket w'
   where
     (w',itid) = getHeldItemLoc cr w
@@ -358,7 +354,7 @@ explodeRemoteRocket itid pjid w = w
     & props . ix pjid . pjUpdate .~ (\_ -> retireRemoteProj fireRemoteShell itid 30 pjid)
     & props . ix pjid . prDraw   .~ const mempty
     & itPoint . itUse . rUse     .~ (\_ _ -> id)
-    & itPoint . itName           .~ "REMOTELAUNCHER"
+--    & itPoint . itName           .~ "REMOTELAUNCHER"
     & _pjPayload thepj (_pjPos thepj)
   where 
     itPoint = pointToItem $ _itemPositions w IM.! itid

src/Dodge/Item/Weapon/Radar.hs

@@ -23,9 +23,7 @@ import Control.Lens
 Sends out pulses that display walls.  -}
 clickDetector :: Detector -> Item
 clickDetector dt = defaultGun 
-    { _itName = show dt
+    { _itConsumption = defaultAmmo
-    , _itType = CLICKDETECTOR dt
-    , _itConsumption = defaultAmmo
     , _itUse = ruseRate 20 (detectorEffect dt) upHammer
         [ ammoUseCheck
         ]
@@ -34,12 +32,11 @@ clickDetector dt = defaultGun
 --    , _itZoom       = defaultItZoom { _itZoomMax = 1}
     , _itEquipPict = pictureWeaponAim $ \_ -> (,) emptySH $ color blue $ polygon $ rectNESW 5 5 (-5) (-5)
     }
+    & itType . iyBase .~ CLICKDETECTOR dt
 
 autoDetector :: Detector -> Item
 autoDetector dt = defaultEquipment
-    { _itType = AUTODETECTOR dt
+    {_itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
-    , _itName = "AUTO-" ++ show dt
-    , _itEquipPict = shapeForWrist (colorSH (detectorColor dt) $ upperPrismPoly 3 $ rectWH 2 2)
 --    , _itEffect = autoRadarEffect
     , _itID = Nothing
     } 
@@ -47,6 +44,7 @@ autoDetector dt = defaultEquipment
     & itUse . eqEq . eqUse  .~ autoEffect (detectorEffect dt) 100 click1S
     & itUse . eqEq . eqParams .~ EquipCounter 0
     & itUse . eqEq . eqViewDist ?~ 350
+    & itType . iyBase .~ AUTODETECTOR dt
 
 detectorColor :: Detector -> Color
 detectorColor dt = case dt of

src/Dodge/Item/Weapon/SonicGuns.hs

@@ -30,9 +30,7 @@ import LensHelp
 
 sonicGun :: Item
 sonicGun = defaultAutoGun 
-    { _itName = "SONICGUN"
+    { _itConsumption = defaultAmmo
-    , _itType = SONICGUN
-    , _itConsumption = defaultAmmo
         { _laMax = 10
         , _laLoaded = 10
         , _laReloadTime = 80
@@ -54,6 +52,7 @@ sonicGun = defaultAutoGun
         , _dimSPic = const $ noPic baseSonicShape
         }
     }
+    & itType . iyBase .~ SONICGUN
 baseSonicShape :: Shape
 baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
 

src/Dodge/Item/Weapon/Spawn.hs

@@ -16,8 +16,7 @@ import Control.Lens
 Creates a creature next to the creature using the item.  -}
 spawnGun :: Creature -> Item
 spawnGun cr = defaultGun
-    { _itName       = "SPAWNER"
+    { _itConsumption = defaultAmmo
-    , _itConsumption = defaultAmmo
         { _laMax    = 1
         , _laLoaded = 1
         , _laReloadTime = 80
@@ -29,6 +28,7 @@ spawnGun cr = defaultGun
         , hammerCheckI
         ]
     }
+    & itType . iyBase .~ SPAWNER
 spawnCrNextTo 
     :: Creature -- ^ Creature to spawn
     -> Creature -- ^ existing creature that will be spawned next to

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -39,9 +39,7 @@ import Control.Monad.State
 import System.Random
 poisonSprayer :: Item
 poisonSprayer = flameThrower 
-    { _itName = "POISONSPRAYER"
+    & itType . iyBase .~ POISONSPRAYER
-    , _itType = POISONSPRAYER
-    }
     & itConsumption . laType .~ GasAmmo
         { _amString = "POISONGAS"
         , _amCreateGas = aGasCloud
@@ -68,8 +66,7 @@ flamerPic it =
     am = fractionLoadedAmmo2 it
 flameSpitter :: Item
 flameSpitter = flameThrower
-    & itName .~ "FLAMESPITTER"
+    & itType . iyBase .~ FLAMESPITTER
-    & itType .~ FLAMESPITTER
     & itConsumption . laMax .~ 10
     & itConsumption . laReloadTime  .~ 20
     & itParams . sprayNozzles . ix 0 . nzPressure .~ 4
@@ -92,8 +89,7 @@ flameSpitter = flameThrower
 
 flameTorrent :: Item
 flameTorrent = flameThrower 
-    & itName .~ "FLAMETORRENT"
+    & itType . iyBase .~ FLAMETORRENT
-    & itType .~ FLAMETORRENT
     & itUse . useAim . aimZoom .~ defaultItZoom
     & itParams . sprayNozzles . ix 0 %~ 
         ( (nzPressure .~ 10)
@@ -103,12 +99,10 @@ flameTorrent = flameThrower
 
 blowTorch :: Item
 blowTorch = flameThrower
-    & itName .~ "BLOWTORCH"
+    & itType . iyBase .~ BLOWTORCH
-    & itType .~ BLOWTORCH
 flameWall :: Item
 flameWall = flameThrower 
-    & itName .~ "FLAMEWALL"
+    & itType . iyBase .~ FLAMEWALL
-    & itType .~ FLAMEWALL
     & itParams . sprayNozzles .~ zipWith makeNozzle [0,0.6,-0.6] [2,2.5,2.5]
   where
     makeNozzle dir pres = Nozzle
@@ -122,9 +116,7 @@ flameWall = flameThrower
 
 flameThrower :: Item
 flameThrower = defaultAutoGun
-    { _itName = "FLAMETHROWER"
+    { _itConsumption = defaultAmmo
-    , _itType = FLAMETHROWER
-    , _itConsumption = defaultAmmo
         { _laMax = 250
         , _laLoaded = 0
         , _laReloadTime = 100
@@ -145,7 +137,6 @@ flameThrower = defaultAutoGun
         & useAim . aimStance .~ TwoHandTwist
 --    , _itFloorPict = flamerPic
 --    , _itZoom       = defaultItZoom
-    , _itAttachment = NoItAttachment
     , _itParams = Sprayer
         { _sprayNozzles = 
             [ Nozzle 
@@ -169,6 +160,7 @@ flameThrower = defaultAutoGun
         }
 --    , _itFloorPict = flamerPic
     }
+    & itType . iyBase .~ FLAMETHROWER
 
 aGasCloud :: Float -> Point2 -> Float -> Creature -> World -> World
 aGasCloud pressure pos dir cr = makeGasCloud pos 

src/Dodge/Item/Weapon/Utility.hs

@@ -23,9 +23,7 @@ import Control.Lens
 
 rewindGun :: Item
 rewindGun = defaultGun
-    { _itName = "REWINDER"
+    { _itInvColor = cyan
-    , _itType = REWINDER
-    , _itInvColor = cyan
     , _itConsumption = ChargeableAmmo
         { _wpMaxCharge  = 250
         , _wpCharge = 0
@@ -35,6 +33,7 @@ rewindGun = defaultGun
         & lUse .~ useRewindGun
         & eqEq . eqSite .~ GoesOnChest
     }
+    & itType . iyBase .~ REWINDER
 rewindEffect :: Item -> Creature -> World -> World
 rewindEffect itm cr w 
     | Just invid == _crLeftInvSel cr = w & rewindWorlds %~ (take maxcharge . (w' : ))
@@ -65,14 +64,13 @@ useRewindGun _ _ w = case _rewindWorlds w of
 -- needs to shift this item to the current inventory slot
 shrinkGun :: Item
 shrinkGun = defaultGun
-    { _itName = "SHRINKER"
+    { _itConsumption = defaultAmmo
-    , _itType = SHRINKER
-    , _itConsumption = defaultAmmo
     , _itUse = defaultlUse {_lUse = hammerCheckL useShrinkGun}
             & useHammer .~ upHammer
 --    , _itFloorPict = shrinkGunPic
     , _itAttachment = ItBool True
     }
+    & itType . iyBase .~ SHRINKER
 
 shrinkGunPic :: Item -> SPic
 shrinkGunPic _ = noPic $ colorSH violet $ upperPrismPoly 5 $ square 5
@@ -92,9 +90,7 @@ useShrinkGun it cr w = if _itBool $ _itAttachment it
 
 blinkGun :: Item
 blinkGun = defaultGun 
-    { _itName = "BLINKER"
+    { _itInvColor = cyan
-    , _itType = BLINKER
-    , _itInvColor = cyan
     , _itConsumption = defaultAmmo
     , _itUse = defaultlUse 
         & lUse .~ hammerCheckL (shootL $ const blinkAction)
@@ -102,42 +98,36 @@ blinkGun = defaultGun
         & eqEq . eqSite .~ GoesOnWrist
 --    , _itFloorPict = const . noPic . colorSH chartreuse $ upperPrismPoly 2 $ square 2
     }
+    & itType . iyBase .~ BLINKER
 
 unsafeBlinkGun :: Item
 unsafeBlinkGun = blinkGun
-    & itName .~ "BLINKER-UNSAFE"
+    & itType . iyBase .~ BLINKERUNSAFE
-    & itType .~ BLINKERUNSAFE
     & itUse . lUse .~ hammerCheckL (shootL $ const unsafeBlinkAction)
     & itUse . eqEq . eqViewDist ?~ 400
 
 effectGun :: String -> (Creature -> World -> World) -> Item
 effectGun name eff = defaultGun
-    { _itName = name ++ "Gun"
+    { _itUse = defaultrUse
-    , _itUse = defaultrUse
         & rUse .~ const eff
         & useMods .~ [hammerCheckI]
     }
-effectGunCont :: String -> (Creature -> World -> World) -> Item
+    & itType . iyBase .~ EFFGUN name
-effectGunCont name eff = defaultGun
-    { _itName = name ++ "Gun"
-    , _itUse = defaultrUse {_rUse = const eff}
-    }
 autoEffectGun :: String -> (Creature -> World -> World) -> Item
-autoEffectGun name eff = defaultAutoGun
+autoEffectGun name eff = defaultGun
-    { _itName = name ++ "Gun"
+    { _itUse = defaultrUse {_rUse = const eff}
-    , _itUse = defaultrUse {_rUse = const eff}
     }
+    & itType . iyBase .~ AUTOEFFGUN name
 forceFieldGun :: Item
 forceFieldGun = defaultGun 
-    { _itName = "FORCEFIELDGUN"
+    { _itConsumption = defaultAmmo & laType .~ ForceFieldAmmo forceField
-    , _itType = FORCEFIELDGUN
-    , _itConsumption = defaultAmmo & laType .~ ForceFieldAmmo forceField
     , _itUse = ruseInstant useForceFieldGun (HasHammer HammerUp)
         [ hammerCheckI , ammoCheckI , useAmmoAmount 1]
 --    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-4,-4),(-4,4),(4,4),(4,0),(0,0),(0,-4)]
     , _itTargeting = targetRBPress & tgDraw .~ targetDistanceDraw
     , _itParams = ParamMID Nothing
     }
+    & itType . iyBase .~ FORCEFIELDGUN
 -- 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

src/Dodge/LightSource.hs

@@ -13,7 +13,7 @@ module Dodge.LightSource
     ) where
 import Dodge.Data
 import Geometry.Data
-import Dodge.Default
+import Dodge.Default.LightSource
 import LensHelp
 
 lsPosRad :: Point3 -> Float -> LightSource

src/Dodge/LockAndKey.hs

@@ -15,12 +15,12 @@ import Dodge.Item
 import System.Random
 import Control.Monad.State
 
-bossKeyItems :: RandomGen g => [ (State g (SubCompTree Room), State g CombineType) ]
+bossKeyItems :: RandomGen g => [ (State g (SubCompTree Room), State g ItemBaseType) ]
 bossKeyItems = 
     [(return . UseAll <$> bossRoom autoCrit, takeOne [PISTOL])
     ]
 
-lockRoomMultiItems :: RandomGen g => [ ( State g (LabSubCompTree Room) , State g [CombineType] ) ]
+lockRoomMultiItems :: RandomGen g => [ ( State g (LabSubCompTree Room) , State g [ItemBaseType] ) ]
 lockRoomMultiItems = 
     [ (blinkAcrossChallenge, takeOne [[BLINKERUNSAFE,AUTODETECTOR WALLDETECTOR]
                                     ,[BLINKERUNSAFE,CLICKDETECTOR WALLDETECTOR]
@@ -28,7 +28,7 @@ lockRoomMultiItems =
         )
     ]
 
-lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ]
+lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g ItemBaseType ) ]
 lockRoomKeyItems = 
     [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] )
     ,(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )
@@ -40,12 +40,12 @@ lockRoomKeyItems =
     ,(const $ lasTunnelRunPast 400, takeOne [FLATSHIELD,FORCEFIELDGUN])
     ,(keyCardRoomRunPast 0, return (KEYCARD 0))
     ]
-keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ]
+keyCardRunPastRand :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g ItemBaseType ) ]
 keyCardRunPastRand = 
     [(keyCardRoomRunPast 0, return (KEYCARD 0))
     ]
 
-itemRooms :: RandomGen g => [(CombineType, State g (LabSubCompTree Room))]
+itemRooms :: RandomGen g => [(ItemBaseType, State g (LabSubCompTree Room))]
 itemRooms = 
     [ (LAUNCHER , join $ takeOne 
         [corridorBoss launcherCrit

src/Dodge/Module.hs

@@ -3,15 +3,24 @@ module Dodge.Module
     , moduleStrings
     ) where
 import Dodge.Data
+--import Dodge.Combine.Module
 
+import qualified Data.Map.Strict as M
 import Control.Lens
 import Data.Maybe
 
+--moduleSizes :: Item -> Int
+--moduleSizes = moduleFold (+) (^? modSize) 0
 moduleSizes :: Item -> Int
-moduleSizes = moduleFold (+) (^? modSize) 0
+moduleSizes = length . _iyModules . _itType
 
+--moduleStrings :: Item -> [String]
+--moduleStrings = moduleFold (++) (^? modName) []
 moduleStrings :: Item -> [String]
-moduleStrings = moduleFold (++) (^? modName) []
+moduleStrings = map show . M.elems . _iyModules . _itType
 
-moduleFold :: (m -> m -> m) -> (ItemModule -> Maybe m) -> m -> Item -> m
+--moduleFold :: (m -> m -> m) -> (ItemModule -> Maybe m) -> m -> Item -> m
-moduleFold g f e = foldr (g . fromMaybe e . f) e . _itModules
+--moduleFold g f e = foldr (g . fromMaybe e . f) e 
+--    . fmap fromModuleType 
+--    . _iyModules
+--    . _itType

src/Dodge/Placement/Instance/Analyser.hs

@@ -78,7 +78,7 @@ mcProximitySensorUpdate mc w = case
 mcProxTest :: Machine -> World -> Bool
 mcProxTest mc w = case mc ^? mcSensor . proxRequirement of
     Just (RequireHealth x)      -> _crHP cr >= x
-    Just (RequireEquipment ct)  -> any (\itm -> _itType itm == ct) (_crInv cr)
+    Just (RequireEquipment ct)  -> any (\itm -> _iyBase (_itType itm) == ct) (_crInv cr)
     _ -> False
   where
     cr = you w

src/Dodge/PtFlicker.hs

@@ -0,0 +1,11 @@
+module Dodge.PtFlicker where
+import Dodge.Data
+import Dodge.LightSource
+import LensHelp
+import Geometry
+
+ptFlicker :: Particle -> World -> World
+ptFlicker pt 
+    | _ptTimer pt `mod` 7 == 0 = tempLightSources 
+        .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ptColor pt)) (addZ 10 $ _ptPos pt)
+    | otherwise = id

src/Dodge/Render/HUD.hs

@@ -172,10 +172,10 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a
     midtext str = listTextPictureAt 252 0 cfig curpos (text str)
     extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
     deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
-        Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k)
+        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
         Nothing -> ""
     curpos = invSelPos w
-    otheritem j = _itName (_crInv (you w) IM.! j)
+    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
 drawRBOptions _ _ _ = mempty
 
 eqPosText :: EquipPosition -> String

src/Dodge/Room/Containing.hs

@@ -24,7 +24,7 @@ roomsContaining crs its = do
         ]
     return (treeFromPost [] $ UseAll endroom
         ,TreeSubLabelling ("roomsContaining-creatures:" ++ intercalate "," (map _crName crs) 
-            ++ "-items:" ++ intercalate "," (map _itName its)) Nothing)
+            ++ "-items:" ++ intercalate "," (map (show . _iyBase . _itType) its)) Nothing)
 
 pedestalRoom :: RandomGen g => Item -> State g Room
 pedestalRoom it = do

src/Dodge/Tesla.hs

@@ -0,0 +1,12 @@
+module Dodge.Tesla where
+import Dodge.Data
+import Dodge.Beam
+
+teslaParams :: ItemParams
+teslaParams = Arcing 
+    { _currentArc = Nothing
+    , _arcSize = 20
+    , _arcNumber = 10
+    , _newArcStep = defaultArcStep
+    , _previousArcEffect = NoPreviousArcEffect
+    }

src/Dodge/WorldEvent/Flash.hs

@@ -15,6 +15,7 @@ module Dodge.WorldEvent.Flash
     , flareCircleAt
     ) where
 import Dodge.Data
+import Dodge.PtFlicker
 import Dodge.LightSource
 import Dodge.WorldEvent.HelperParticle
 --import Dodge.Default
@@ -52,8 +53,3 @@ explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc
         | x < 10 = 1 / (10 - fromIntegral x)
         | otherwise = 1
 
-ptFlicker :: Particle -> World -> World
-ptFlicker pt 
-    | _ptTimer pt `mod` 7 == 0 = tempLightSources 
-        .:~ tlsTimeRadColPos 1 70 (0.5 *.*.* xyzV4 (_ptColor pt)) (addZ 10 $ _ptPos pt)
-    | otherwise = id

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -12,6 +12,7 @@ import Dodge.Base
 import Dodge.Zone
 import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Particle.Damage
+import Dodge.IncBall
 --import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
@@ -114,21 +115,6 @@ moveFlame rotd w pt
     reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
         +.+ (0.2 *.* vel)
 
-incBall :: RandomGen g => Point2 -> State g Particle
-incBall p = do
-    rot <- state $ randomR (0,3)
-    return PtZ 
-        { _ptDraw       = drawFlameletZ rot
-        , _ptUpdate     = moveFlamelet
-        , _ptVel        = 0
-        , _ptColor      = red
-        , _ptPos        = p
-        , _ptCrIgnore   = Nothing
-        , _ptWidth      = 3
-        , _ptTimer      = 20
-        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
-        , _ptZ          = 20
-        }
 
 concBall :: Point2 -> State g Particle
 concBall p = return Shockwave
@@ -207,6 +193,67 @@ drawStaticBall pt = setLayer BloomNoZWrite
     . uncurryV translate (_ptPos pt)
     $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5)
 
+
+moveStaticBall :: World -> Particle -> (World, Maybe Particle)
+moveStaticBall = moveFlamelet
+
+-- | Note damgeInRadius by itself never destroys the particle
+damageInRadius :: Float -> Particle -> World -> World
+damageInRadius size pt w = damwls damcrs
+  where
+    p = _ptPos pt
+    damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w
+    damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w
+    closeWls wl = uncurry circOnSeg (_wlLine wl) p size
+    isClose cr = dist p (_crPos cr) < _crRad cr + size
+    hiteff = _ptHitEff pt pt
+
+-- | At writing the radius is half the size of the effect area
+makeGasCloud 
+    :: Point2   -- ^ Position
+    -> Point2   -- ^ Velocity
+    -> World 
+    -> World
+makeGasCloud pos vel w = w
+    & clouds    .:~ theCloud
+    & randGen   .~ g
+  where 
+    theCloud = Cloud 
+        {  _clPos = addZ 20 pos
+        , _clVel = addZ 0 vel
+        , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
+                                          $ circleSolid 20
+        , _clRad = 10
+        , _clAlt = 25
+        , _clTimer = 400
+        , _clType = GasCloud
+        , _clEffect = cloudPoisonDamage
+        }
+    (col, g) = runState (takeOne [green,yellow]) $ _randGen w
+{- Attach poison cloud damage to creatures near cloud.  -}
+cloudPoisonDamage :: Cloud -> World -> World
+cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
+  where 
+    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w
+    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
+    doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
+    clpos = stripZ $ _clPos c
+
+incBall :: RandomGen g => Point2 -> State g Particle
+incBall p = do
+    rot <- state $ randomR (0,3)
+    return PtZ 
+        { _ptDraw       = drawFlameletZ rot
+        , _ptUpdate     = moveFlamelet
+        , _ptVel        = 0
+        , _ptColor      = red
+        , _ptPos        = p
+        , _ptCrIgnore   = Nothing
+        , _ptWidth      = 3
+        , _ptTimer      = 20
+        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
+        , _ptZ          = 20
+        }
 drawFlameletZ
     :: Float    -- ^ Rotation
     -> Particle
@@ -252,8 +299,6 @@ drawFlameletZ rot pt = pictures
     s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
     s2 = 0.5 * (sc + s1)
 
-moveStaticBall :: World -> Particle -> (World, Maybe Particle)
-moveStaticBall = moveFlamelet
 {- Update of a flamelet.
 Applies movement and attaches damage to nearby creatures.  -}
 -- This should be unified in many ways with moveFlame
@@ -267,45 +312,3 @@ moveFlamelet w pt
         & ptPos      .~ _ptPos pt +.+ _ptVel pt
         & ptCrIgnore .~ Nothing
         & ptVel      .*.*~ 0.8
-
--- | Note damgeInRadius by itself never destroys the particle
-damageInRadius :: Float -> Particle -> World -> World
-damageInRadius size pt w = damwls damcrs
-  where
-    p = _ptPos pt
-    damcrs = foldr (\cr -> fst . hiteff [(p,Left cr)]) w $ IM.filter isClose $ _creatures w
-    damwls w' = foldr (\wl -> fst . hiteff [(p,Right wl)]) w' $ IM.filter closeWls $ wallsNearPoint p w
-    closeWls wl = uncurry circOnSeg (_wlLine wl) p size
-    isClose cr = dist p (_crPos cr) < _crRad cr + size
-    hiteff = _ptHitEff pt pt
-
--- | At writing the radius is half the size of the effect area
-makeGasCloud 
-    :: Point2   -- ^ Position
-    -> Point2   -- ^ Velocity
-    -> World 
-    -> World
-makeGasCloud pos vel w = w
-    & clouds    .:~ theCloud
-    & randGen   .~ g
-  where 
-    theCloud = Cloud 
-        {  _clPos = addZ 20 pos
-        , _clVel = addZ 0 vel
-        , _clPict = \_ -> setLayer MidLayer . setDepth 30 $ color (withAlpha 0.05 col) 
-                                          $ circleSolid 20
-        , _clRad = 10
-        , _clAlt = 25
-        , _clTimer = 400
-        , _clType = GasCloud
-        , _clEffect = cloudPoisonDamage
-        }
-    (col, g) = runState (takeOne [green,yellow]) $ _randGen w
-{- Attach poison cloud damage to creatures near cloud.  -}
-cloudPoisonDamage :: Cloud -> World -> World
-cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
-  where 
-    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w
-    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
-    doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect
-    clpos = stripZ $ _clPos c