Add shrinkability and cursed items

appDodge/Main.hs

@@ -7,7 +7,6 @@ import Dodge.LevelGen
 import Dodge.Update
 import Dodge.Event
 import Dodge.Render
-import Dodge.Config.Data
 import Dodge.Config.KeyConfig
 import Dodge.Config.Load
 import Dodge.Config.Update

src/Dodge/Base/Window.hs

@@ -10,7 +10,6 @@ module Dodge.Base.Window
     )
     where
 import Dodge.Data
-import Dodge.Config.Data
 import Geometry
 
 -- | A box covering the screen in world coordinates

src/Dodge/Block.hs

@@ -1,6 +1,5 @@
 module Dodge.Block where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Zone
 import Dodge.WorldEvent.Sound

src/Dodge/Config/Data.hs

@@ -1,8 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
-module Dodge.Config.Data 
+module Dodge.Config.Data where
-    where
 import Data.Aeson
 import GHC.Generics
 import Control.Lens

src/Dodge/Creature.hs

@@ -15,6 +15,7 @@ module Dodge.Creature
 import Dodge.Creature.State.Data
 import Dodge.Item.Weapon.Grenade
 import Dodge.Item.Weapon.Booster
+import Dodge.Item.Weapon.Utility
 --import Dodge.Creature.ReaderUpdate
 --import Dodge.Creature.AlertLevel
 --import Dodge.Creature.SetTarget
@@ -158,14 +159,20 @@ startCr = defaultCreature
     , _crHP = 1000
     , _crMaxHP = 1500
     , _crInv = startInventory 
-    , _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
+    , _crCorpse = onLayer CorpseLayer 
+        $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
     , _crFaction = PlayerFaction
+    , _crMvType = MvWalking yourDefaultSpeed
     }
 {- | Items you start with.  -}
+startInvList :: [Item]
+startInvList =
+    [shrinkGun
+    ]
 startInventory :: IM.IntMap Item
-startInventory = IM.fromList $ zip [0..20] $ repeat NoItem
+startInventory = IM.fromList $ zip [0..defaultInvSize -1] $ startInvList ++ repeat NoItem
 stackedInventory :: IM.IntMap Item
-stackedInventory = IM.fromList (zip [0..20] 
+stackedInventory = IM.fromList (zip [0..25] 
     (
     [spreadGun
     ,tractorGun

src/Dodge/Creature/Action.hs

@@ -1,9 +1,14 @@
+{-# LANGUAGE TupleSections #-}
 {- | Actions performed by creatures within the world
  -}
 module Dodge.Creature.Action 
     ( performActionsR
+    , stripNoItems
+    , setMinInvSize
+    , dropUnselected
     , startReloadingWeapon
     , blinkAction
+    , sizeSelf
     , crAutoReload
     , copyItemToFloor
     , youDropItem
@@ -11,10 +16,10 @@ module Dodge.Creature.Action
     )
     where
 import Dodge.Path
+import Dodge.Default
 import Dodge.Creature.Stance.Data
 import Dodge.WorldEvent.Shockwave
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Zone
 import Dodge.Base.Collide
@@ -167,15 +172,15 @@ blinkAction
     -> World
 blinkAction cr w 
     = soundMultiFrom [TeleSound 0,TeleSound 1] p3 teleS Nothing
-    . over radDistortion (distortionBulge ++)
+    . over distortions (distortionBulge ++)
     . set (creatures . ix cid . crPos) p3
     . blinkShockwave cid p3
     $ inverseShockwaveAt cpos 40 2 2 w
   where
     distR = 120
     distortionBulge = 
-        [(p3,p3 +.+ V2 distR 0, p3 +.+ V2 0 distR,0.1)
+        [RadialDistortion p3   (p3 +.+ V2 distR 0)   (p3 +.+ V2 0 distR)   0.1
-        ,(cpos,cpos +.+ V2 distR 0, cpos +.+ V2 0 distR,1.9)
+        ,RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
         ]
     cid  = _crID cr
     p1 = mouseWorldPos w
@@ -191,14 +196,35 @@ blinkShockwave
     -> World
 blinkShockwave i p = makeShockwaveAt [i] p 60 1 2 cyan 
 
+setMinInvSize :: Int -> Creature -> World -> World
+setMinInvSize n cr = creatures . ix (_crID cr) . crInv %~ f 
+  where
+    f inv = IM.unionWith (\x _ -> x) inv $ IM.fromList $ [0..n-1] <&> (, NoItem)
+
+stripNoItems :: Creature -> World -> World
+stripNoItems cr = creatures . ix (_crID cr) . crInv %~ IM.mapMaybe f
+  where
+    f NoItem = Nothing
+    f x = Just x
+
+dropUnselected :: Creature -> World -> World
+dropUnselected cr w = foldr (dropItem cr) w . IM.keys $ unselectedItems
+  where
+    unselectedItems = _crInvSel cr `IM.delete` _crInv cr 
+
+dropItem :: Creature -> Int -> World -> World
+dropItem cr invid = rmInvItem cid invid . copyItemToFloor cr invid
+  where
+    cid = _crID cr
+
 {- | Get your creature to drop the item under the cursor.  -}
 youDropItem :: World -> World
-youDropItem w = case yourItem w of
+youDropItem w = case yourItem w ^? itCurseStatus of
-    NoItem -> w
+    Just Uncursed -> rmSelectedInvItem (_yourID w) 
-    _ -> rmSelectedInvItem (_yourID w) 
         . copyItemToFloor (you w) (_crInvSel cr)
         $ soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
         w
+    _ -> w
   where
     cr = you w
 {- | Copy an inventory item to the floor. -}
@@ -243,3 +269,21 @@ pickUpItem cid flit w = case maybeInvSlot of
         Nothing -> w'
         Just j  -> w' & itemPositions . ix j .~ InInv 0 invid
 
+sizeSelf :: Float -> Creature -> World -> World
+sizeSelf x cr w = w
+    & soundMultiFrom [TeleSound 0,TeleSound 1] cpos teleS Nothing
+    & over distortions (distortionBulge :)
+--    & inverseShockwaveAt cpos 40 0 2
+    & creatures . ix cid %~ 
+        ( (crRad .~ 10 * x) 
+        . (crMvType . mvSpeed .~ yourDefaultSpeed * x)
+        . (crStance . strideLength .~ ceiling (fromIntegral yourDefaultStrideLength * x))
+        )
+  where
+    distR = 120
+    distortionBulge 
+        | _crRad cr < 10 * x 
+            = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
+        | otherwise = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 0.1
+    cid  = _crID cr
+    cpos = _crPos cr

src/Dodge/Creature/ArmourChase.hs

@@ -5,7 +5,6 @@ module Dodge.Creature.ArmourChase
 import Dodge.Data
 import Dodge.Default
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.Picture

src/Dodge/Creature/Boid.hs

@@ -2,7 +2,6 @@ module Dodge.Creature.Boid
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Creature.State.Data
 import Geometry
 import Geometry.ConvexPoly
 

src/Dodge/Creature/ChaseCrit.hs

@@ -10,7 +10,6 @@ import Dodge.Creature.Impulse
 import Dodge.Creature.Action
 import Dodge.Creature.Perception
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Item.Consumable
 import Dodge.Picture.Layer
 import Dodge.SoundLogic

src/Dodge/Creature/ChooseTarget.hs

@@ -3,7 +3,6 @@ module Dodge.Creature.ChooseTarget
 import Dodge.Data
 import Dodge.Base
 import Dodge.Base.Collide
-import Dodge.Creature.Perception.Data
 
 import Control.Lens
 --import qualified Data.IntMap.Strict as IM

src/Dodge/Creature/Impulse.hs

@@ -4,12 +4,8 @@ module Dodge.Creature.Impulse
     where
 import Dodge.Data
 import Dodge.Creature.Vocalization
-import Dodge.Data.SoundOrigin
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
---import Dodge.Creature.Action.UseItem
-import Dodge.Creature.State.Data
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
 import Geometry
 

src/Dodge/Creature/Impulse/Movement.hs

@@ -1,8 +1,5 @@
-module Dodge.Creature.Impulse.Movement
+module Dodge.Creature.Impulse.Movement where
-    where
 import Dodge.Data
-import Dodge.Creature.Stance.Data
-import Dodge.Item.Data
 import Geometry
 
 import Data.Maybe

src/Dodge/Creature/Inanimate.hs

@@ -12,7 +12,6 @@ import Dodge.Data
 import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
 --import Dodge.Creature.Stance.Data
-import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.Creature.State
@@ -29,7 +28,6 @@ import Polyhedra
 import Shape
 import Dodge.WorldEvent
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 
 import System.Random
 import Data.List

src/Dodge/Creature/Perception.hs

@@ -5,9 +5,7 @@ module Dodge.Creature.Perception
     )
     where
 import Dodge.Data
-import Dodge.Creature.Perception.Data
 import Dodge.Creature.Vocalization
-import Dodge.Creature.Memory.Data
 import Dodge.Base.Collide
 --import Dodge.SoundLogic
 import Geometry.Vector

src/Dodge/Creature/Picture.hs

@@ -10,18 +10,10 @@ module Dodge.Creature.Picture
     , picAtCrPosNoRot
     ) where
 import Dodge.Data
-import Dodge.Config.Data
---import Dodge.Data.DamageType
 --import Dodge.Base
---import Dodge.Creature.Stance.Data
-import Dodge.Creature.Perception.Data
---import Dodge.Creature.State.Data
-import Dodge.Creature.Stance.Data
---import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 --import Dodge.Creature.AlertLevel.Data
 --import Dodge.Picture.Layer
-import Dodge.Item.Data
 import Dodge.Clock
 import Picture
 import Geometry
@@ -58,13 +50,14 @@ basicCrShape
     :: Color    -- ^ Creature color
     -> Creature 
     -> Shape
-basicCrShape col cr = tr $ mconcat
+basicCrShape col cr = tr . scaleSH (V3 crsize crsize crsize) $ mconcat
     [ rotdir . _spShape $ drawEquipment cr
     , rotdir . dm . translateSHz 20 $ scalp cr
     , rotdir . dm $ upperBody col cr
     , dm . rotmdir $ feet cr
     ]
   where 
+    crsize = 0.1 * _crRad cr
     dm = damageModSH cr
     tr = uncurryV translateSHf (_crPos cr)
     rotdir = rotateSH (_crDir cr)
@@ -161,7 +154,7 @@ arms :: Creature -> Shape
 {-# INLINE arms #-}
 arms cr 
     | oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
-    | twists cr = shoulderSH . translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat 
+    | twists cr = shoulderSH . translateSHf 0 5 . rotateSH (-1) $ mconcat 
         [ translateSHf 12 4    aHand
         , translateSHf 4 (-10) aHand
         ]
@@ -175,7 +168,6 @@ arms cr
     --crIt = _crInv cr IM.! _crInvSel cr
     aHand :: Shape
     aHand = translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
-    crad = _crRad cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
@@ -183,12 +175,11 @@ arms cr
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
 scalp cr
-    | twists cr = translateSHf 0 (0.5*crad) . rotateSH (-1) $ translateSHf (negate 0.25 * crad) 0.25 fhead
+    | twists cr = translateSHf 0 5 . rotateSH (-1) $ translateSHf (negate 2.5) 0.25 fhead
-    | oneH   cr = rotateSH 0.5 $ translateSHf (0.25 * crad) 0 fhead
+    | oneH   cr = rotateSH 0.5 $ translateSHf 2.5 0 fhead
-    | otherwise = translateSHf (0.25 * crad) 0 fhead
+    | otherwise = translateSHf 2.5 0 fhead
   where
-    fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 . polyCirc 4 $ crad * 0.5
+    fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 4 5
-    crad = _crRad cr
 
 oneH :: Creature -> Bool
 oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
@@ -212,7 +203,7 @@ torso cr
         [ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
         , translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
         ]
-    | twists cr = translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
+    | twists cr = translateSHf 0 5 . rotateSH (-1) $ mconcat
         [ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
         , rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
         ]
@@ -222,8 +213,7 @@ torso cr
         ]
   where
     --aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad
-    aShoulder = scaleSH (V3 crad crad 1) baseShoulder
+    aShoulder = scaleSH (V3 10 10 1) baseShoulder
-    crad = _crRad cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}

src/Dodge/Creature/Property.hs

@@ -4,7 +4,6 @@ module Dodge.Creature.Property
     , crNearPoint
     ) where
 import Dodge.Data
-import Dodge.Item.Data
 import Geometry
 
 import Control.Lens

src/Dodge/Creature/ReaderUpdate.hs

@@ -14,11 +14,8 @@ module Dodge.Creature.ReaderUpdate
     )
     where
 import Dodge.Data
-import Dodge.Creature.Stance.Data
-import Dodge.Creature.Memory.Data
 import Dodge.Creature.Test
 import Dodge.Creature.Volition
-import Dodge.Creature.Perception.Data
 import Dodge.Base
 import Dodge.Base.Collide
 import Geometry

src/Dodge/Creature/SetTarget.hs

@@ -1,10 +1,6 @@
-{- |
+{- | Deals with setting a target for creatures -}
-Deals with setting a target for creatures
+module Dodge.Creature.SetTarget where
--}
-module Dodge.Creature.SetTarget
-    where
 import Dodge.Data
-import Dodge.Creature.Perception.Data
 
 import Control.Lens
 import qualified Data.IntMap.Strict as IM

src/Dodge/Creature/State.hs

@@ -3,11 +3,7 @@ module Dodge.Creature.State
     , doDamage
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Item.Data
-import Dodge.Creature.State.Data
 import Dodge.Creature.State.WalkCycle
-import Dodge.Creature.Stance.Data
 --import Dodge.Creature.Test
 --import Dodge.Base
 import Dodge.SoundLogic

src/Dodge/Creature/State/WalkCycle.hs

@@ -4,8 +4,6 @@ module Dodge.Creature.State.WalkCycle
     )
     where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic
 import Geometry.Data
 import Sound.Data

src/Dodge/Creature/SwarmCrit.hs

@@ -10,7 +10,6 @@ import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.Perception
 import Dodge.Creature.Impulse
 import Dodge.Creature.State
-import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
 import Picture
 

src/Dodge/Creature/Test.hs

@@ -19,7 +19,6 @@ module Dodge.Creature.Test
     where
 import Dodge.Data
 import Dodge.Base.Collide
-import Dodge.Creature.Stance.Data
 import Geometry
 import SameConstr
 

src/Dodge/Creature/Volition.hs

@@ -9,7 +9,6 @@ module Dodge.Creature.Volition
 import Dodge.Data
 --import Dodge.Base.Collide
 import Dodge.Creature.Test
-import Dodge.Creature.Stance.Data
 import Dodge.SoundLogic.LoadSound
 import Geometry
 

src/Dodge/Creature/YourControl.hs

@@ -3,10 +3,8 @@ module Dodge.Creature.YourControl
     ) where
 import Dodge.Data
 import Dodge.Creature.Impulse.Movement
-import Dodge.Creature.Stance.Data
 import Dodge.Update.UsingInput
 import Dodge.Config.KeyConfig
-import Dodge.Item.Attachment.Data
 import Geometry
 
 import Control.Lens
@@ -24,7 +22,7 @@ yourControl cr w =
     , Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
     )
   where 
-    speed = 4
+    speed = _mvSpeed $ _crMvType cr
 {- | Turn key presses into creature movement.  -}
 wasdWithAiming 
     :: World 

src/Dodge/Data.hs

@@ -9,12 +9,22 @@ circular imports are probably not a good idea.
 {-# LANGUAGE DeriveGeneric #-}
 module Dodge.Data 
     ( module Dodge.Data
+    , module Dodge.Distortion.Data
     , module Dodge.Data.DamageType
+    , module Dodge.Data.SoundOrigin
+    , module Dodge.Creature.State.Data
+    , module Dodge.Creature.Stance.Data
+    , module Dodge.Creature.Perception.Data
+    , module Dodge.Creature.Memory.Data
+    , module Dodge.Item.Attachment.Data
+    , module Dodge.Item.Data
+    , module Dodge.Config.Data
     ) where
 import Dodge.Creature.State.Data
 import Dodge.Creature.Stance.Data
 import Dodge.Creature.Perception.Data
 import Dodge.Creature.Memory.Data
+import Dodge.Distortion.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
 import Dodge.Config.Data
@@ -98,7 +108,7 @@ data World = World
     , _sideEffects          :: World -> IO World
     , _inventoryMode        :: InventoryMode
     , _lClickHammer         :: HammerPosition
-    , _radDistortion        :: [(Point2,Point2,Point2,Float)]
+    , _distortions          :: [Distortion]
     , _worldBounds          :: Bounds
     , _gameRooms            :: [GameRoom]
     , _keyConfig            :: KeyConfigSDL
@@ -107,6 +117,7 @@ data World = World
     , _savedWorlds          :: M.Map SaveSlot World
     , _frameClock           :: Int
     }
+
 data SaveSlot = QuicksaveSlot | LevelStartSlot
   deriving (Eq,Ord)
 
@@ -150,6 +161,7 @@ data InventoryMode
     | TweakInventory
     | CombineInventory
     | InspectInventory
+    | LockedInventory
   deriving (Eq, Ord, Show)
 data CrGroupParams = CrGroupParams
     { _crGroupParamID   :: Int
@@ -239,6 +251,7 @@ data Intention = Intention
 
 data CrMvType 
     = NoMvType
+    | MvWalking { _mvSpeed :: Float }
     | ChaseMvType
         { _mvSpeed   :: Float
         , _mvTurnRad :: Float -> Float
@@ -316,6 +329,7 @@ data Item
         , _itAimStance :: AimStance
         , _wpNumBarrels :: Int
         , _itDimension  :: ItemDimension
+        , _itCurseStatus :: CurseStatus
         }
     | Consumable
         { _itName :: String
@@ -331,6 +345,7 @@ data Item
         , _itEffect :: ItEffect
         , _itHammer :: HammerPosition
         , _itAimStance :: AimStance
+        , _itCurseStatus :: CurseStatus
         }
     | Craftable
         { _itName :: String
@@ -343,6 +358,7 @@ data Item
         , _itInvDisplay :: Item -> String
         , _itInvColor :: Color
         , _itAimStance :: AimStance
+        , _itCurseStatus :: CurseStatus
         }
      | Equipment
         { _itName :: String
@@ -359,6 +375,7 @@ data Item
         , _itInvColor :: Color
         , _itHammer :: HammerPosition
         , _itAimStance :: AimStance
+        , _itCurseStatus :: CurseStatus
         }
      | Throwable
         { _itName       :: String
@@ -385,8 +402,10 @@ data Item
         , _itHammer     :: HammerPosition
         , _itScroll     :: Float -> Creature -> Item -> Item
         , _itAimStance  :: AimStance
+        , _itCurseStatus :: CurseStatus
         }
      | NoItem
+data CurseStatus = Uncursed | UndroppableIdentified | UndroppableUnidentified
 
 data ItemDimension = ItemDimension
     { _itDim    :: Point3 -- length width height

src/Dodge/Debug/Terminal.hs

@@ -1,7 +1,6 @@
 module Dodge.Debug.Terminal
     where
 import Dodge.Data
-import Dodge.Config.Data
 import Dodge.Creature
 
 import Control.Lens

src/Dodge/Default.hs

@@ -7,12 +7,6 @@ This module contains prototypical data structures.
 module Dodge.Default where
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Item.Data
-import Dodge.Creature.Stance.Data
-import Dodge.Creature.State.Data
-import Dodge.Creature.Perception.Data
-import Dodge.Creature.Memory.Data
 import Dodge.SoundLogic
 import Dodge.Picture.Layer
 import Dodge.Wall.Delete
@@ -50,7 +44,7 @@ defaultCreature = Creature
     , _crStance = Stance 
         {_carriage=Walking 0 WasLeftForward
         ,_posture=AtEase
-        ,_strideLength = 40
+        ,_strideLength = yourDefaultStrideLength
         }
     , _crVocalization = Mute
     , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
@@ -68,6 +62,9 @@ defaultCreatureMemory = MemoryState
     { _soundsToInvestigate = []
     }
 
+defaultInvSize :: Int
+defaultInvSize = 20
+
 defaultPerceptionState :: PerceptionState
 defaultPerceptionState = PerceptionState
     { _crAwakeLevel = Lethargic
@@ -118,6 +115,12 @@ defaultAimMvType = AimMvType
 defaultAimingCrit :: Creature
 defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
 
+yourDefaultSpeed :: Float
+yourDefaultSpeed = 4
+
+yourDefaultStrideLength :: Int
+yourDefaultStrideLength = 40
+
 defaultState :: CreatureState
 defaultState = CrSt 
     { _crDamage = []
@@ -128,6 +131,7 @@ defaultState = CrSt
 defaultEquipment :: Item
 defaultEquipment = Equipment
     { _itIdentity = Generic
+    , _itCurseStatus = Uncursed
     , _itName = "genericEquipment"
     , _itFloorPict = \_ -> (,) emptySH $ setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
     , _itEquipPict = \_ _ -> (,) emptySH blank
@@ -147,6 +151,7 @@ defaultItZoom = ItZoom 20 0.2 1
 defaultConsumable :: Item
 defaultConsumable = Consumable
     { _itIdentity = Generic
+    , _itCurseStatus = Uncursed
     , _itName = "genericConsumable"
     , _itMaxStack = 9
     , _itAmount = 1
@@ -194,6 +199,7 @@ defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = V2 0 0, _flItID = 0
 defaultIt :: Item
 defaultIt = Consumable
     { _itIdentity = Medkit25
+    , _itCurseStatus = Uncursed
     , _itName = "defaultIt"
     , _itMaxStack = 3
     , _itAmount = 2

src/Dodge/Default/Weapon.hs

@@ -3,8 +3,6 @@ module Dodge.Default.Weapon
 import Dodge.Data
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.InventoryDisplay
-import Dodge.Item.Attachment.Data
-import Dodge.Item.Data
 import Picture
 import ShapePicture
 
@@ -12,6 +10,7 @@ import Linear.V3
 defaultGun :: Item
 defaultGun = Weapon 
     { _itName = "default"
+    , _itCurseStatus = Uncursed
     , _itIdentity = Pistol
     , _wpMaxAmmo = 15
     , _wpLoadedAmmo = 15

src/Dodge/Default/World.hs

@@ -2,9 +2,7 @@ module Dodge.Default.World
     where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Config.Data
 import Dodge.Config.KeyConfig
-import Dodge.Item.Data
 import Dodge.Bounds
 --import Dodge.Menu
 --import Picture
@@ -81,7 +79,7 @@ defaultWorld = World
     , _inventoryMode = TopInventory
     , _lClickHammer = HammerUp
     , _foregroundShape = mempty
-    , _radDistortion = []
+    , _distortions     = []
     , _gameRooms = []
     , _preloadData = DummyPdata -- hack TODO remove this
     , _frameClock = 0

src/Dodge/Distortion.hs

@@ -0,0 +1,10 @@
+module Dodge.Distortion where
+import Dodge.Distortion.Data
+
+updateDistortion :: Distortion -> Maybe Distortion
+updateDistortion  dt = case dt of
+  RadialDistortion a b c v 
+    | v > 1 -> Just $ RadialDistortion a b c $ max 1 (v - 0.05)
+    | v < 1 -> Just $ RadialDistortion a b c $ min 1 (v + 0.05) 
+    | otherwise -> Nothing
+

src/Dodge/Distortion/Data.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Distortion.Data where
+import Geometry
+
+data Distortion 
+    = RadialDistortion Point2 Point2 Point2 Float

src/Dodge/Event.hs

@@ -16,13 +16,11 @@ module Dodge.Event
 import Dodge.Event.Keyboard
 --import Dodge.Event.Menu
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Base.Window
 --import Dodge.Creature.Action
 import Dodge.SoundLogic
 import Dodge.Inventory
-import Dodge.Config.Data
 --import Geometry
 import Preload.Update
 import qualified IntMapHelp as IM

src/Dodge/Initialisation.hs

@@ -2,7 +2,6 @@ module Dodge.Initialisation where
 import Dodge.Default.World
 import Dodge.Save
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Creature
 import Dodge.Story
 import Dodge.WorldEvent.Cloud

src/Dodge/Inventory.hs

@@ -2,6 +2,7 @@ module Dodge.Inventory
     ( checkInvSlotsYou
     , rmSelectedInvItem
     , addItem
+    , rmInvItem
     , updateCloseObjects
     , closeObjScrollDir
     )

src/Dodge/Item.hs

@@ -1,8 +1,6 @@
 module Dodge.Item
   where
 import Dodge.Data
-import Dodge.Item.Data
---import Dodge.Base
 import Dodge.Default
 import Dodge.Picture
 import Picture

src/Dodge/Item/Attachment.hs

@@ -5,7 +5,6 @@ module Dodge.Item.Attachment
     )
     where
 import Dodge.Data
-import Dodge.Item.Attachment.Data
 import Dodge.Default
 
 import Control.Lens hiding ((|>),(<|))

src/Dodge/Item/Attachment/Data.hs

@@ -19,6 +19,8 @@ data ItAttachment
     | ItCharMode {_itCharMode :: Seq.Seq Char }
     | ItTargetPos { _itTargetPos :: Point2 }
     | ItInt { _itInt :: Int }
+    | ItFloat { _itFloat :: Float }
+    | ItBool  { _itBool  :: Bool  }
     | NoItAttachment
 
 makeLenses ''ItAttachment

src/Dodge/Item/Consumable.hs

@@ -1,8 +1,5 @@
-module Dodge.Item.Consumable
+module Dodge.Item.Consumable where
-    where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Item.Data
 import Dodge.Picture.Layer
 import Dodge.Default
 import Dodge.SoundLogic

src/Dodge/Item/Draw.hs

@@ -1,9 +1,6 @@
-module Dodge.Item.Draw
+module Dodge.Item.Draw where
-    where
 import Dodge.Data
-import Dodge.Item.Data
 --import Dodge.Picture.Layer
-import Dodge.Creature.Stance.Data
 --import Picture
 --import Shape
 import ShapePicture

src/Dodge/Item/Equipment.hs

@@ -1,7 +1,5 @@
-module Dodge.Item.Equipment
+module Dodge.Item.Equipment where
-    where
 import Dodge.Data
-import Dodge.Item.Data
 import Dodge.Item.Draw
 import Dodge.Default
 import Dodge.Default.Wall
@@ -10,7 +8,6 @@ import Dodge.Item.Weapon.BatteryGuns
 import Dodge.Creature.Test
 import Dodge.Wall.Reflect
 import Dodge.Wall
-import Dodge.Creature.State.Data
 import Picture
 import Geometry
 import ShapePicture

src/Dodge/Item/Weapon.hs

@@ -2,22 +2,18 @@
 In progress: move out effects into other modules.  -}
 module Dodge.Item.Weapon where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Base
 import Dodge.Zone
 import Dodge.Picture.Layer
 import Dodge.SoundLogic
-import Dodge.Creature.Action
 import Dodge.WorldEvent
 import Dodge.Default
 import Dodge.Item.Draw
-import Dodge.Item.Data
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.Remote
-import Dodge.Item.Attachment.Data
 import Dodge.Default.Weapon
 import Dodge.Item.Weapon.Grenade
 import Geometry
@@ -83,40 +79,9 @@ removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachmen
     cr = _creatures w IM.! i
     itRef = _crInvSel cr
 
-blinkGun :: Item
-blinkGun = defaultGun 
-    { _itName = "BLINKER"
-    , _itIdentity = Blinker
-    , _wpMaxAmmo = 100
-    , _wpLoadedAmmo = 100
-    , _wpReloadTime = 20
-    , _wpReloadState = 0
-    , _itUseRate = 0
-    , _itUseTime = 0
-    , _itUse = const aSelf
-    , _itUseModifiers =
-        [ ammoCheckI
-        , hammerCheckI
-        ]
-    , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
-    , _wpSpread = 0.05
-    , _wpRange = 20
-    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
-    , _itAimingSpeed = 1
-    , _itAimingRange = 0
-    }
-
-
 shellExplosionAt :: Point2 -> World -> World
 shellExplosionAt = makeExplosionAt
 
-    
-aSelf :: Creature -> World -> World
-aSelf = blinkAction
-
-aSelfL :: Creature -> Int -> World -> World
-aSelfL cr _ = blinkAction cr
-
 reflect :: Float -> Float -> Float
 reflect a b = a + 2*(a-b)
 
@@ -270,6 +235,7 @@ remoteBombUnarmedPic = color (dark $ dark orange) $ circleSolid 5
 pipe :: Item
 pipe = Craftable
     { _itIdentity = Generic
+    , _itCurseStatus = Uncursed
     , _itName = "PIPE"
     , _itMaxStack = 3
     , _itAmount = 3

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -12,11 +12,9 @@ import Dodge.WorldEvent
 import Dodge.WorldEvent.Damage
 import Dodge.Default
 import Dodge.Item.Draw
-import Dodge.Item.Data
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.AmmoParams
-import Dodge.Item.Attachment.Data
 import Dodge.Default.Weapon
 import Dodge.Item.Attachment
 import Dodge.WorldEvent.HelperParticle

src/Dodge/Item/Weapon/Bezier.hs

@@ -4,13 +4,11 @@ module Dodge.Item.Weapon.Bezier
 import Dodge.Data
 import Dodge.Base
 import Dodge.Default.Weapon
-import Dodge.Item.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Targeting
 import Dodge.Item.Weapon.BulletGuns
 import Dodge.Item.Weapon.TriggerType
 import Dodge.Item.Weapon.ExtraEffect
-import Dodge.Item.Attachment.Data
 import Dodge.Default
 import Dodge.Particle.Bullet.Spawn
 import Dodge.Particle.Bullet.HitEffect

src/Dodge/Item/Weapon/Booster.hs

@@ -6,12 +6,10 @@ import Dodge.Base
 import Dodge.Zone
 import Dodge.Base.Collide
 import Dodge.Default.Weapon
-import Dodge.Item.Data
 import Geometry
 import qualified IntMapHelp as IM
 import Dodge.Picture.Layer
 import Picture
-import Dodge.Item.Attachment.Data
 import ShapePicture
 import Shape
 

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -15,11 +15,9 @@ import Dodge.Data
 import Dodge.Default.Weapon
 import Dodge.Default
 import Dodge.Item.Attachment
-import Dodge.Item.Attachment.Data
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.AmmoParams
-import Dodge.Item.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Bullet
 import Dodge.Item.Weapon.TriggerType
@@ -75,18 +73,15 @@ autoGun = defaultAutoGun
     , _wpAmmo = basicBullet    
     }
 autoGunPic :: Item -> SPic
-autoGunPic it =
+autoGunPic it = noPic $
-    ( colorSH red (prismPoly 
+     colorSH red (prismPoly 
         (map (addZ 5) $ rectNESW 2 12 (-2) (-8))
         (map (addZ 0) $ rectNESW 4 12 (-4) (-12))
         )
     <> translateSHf 0 (-1) (rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW (negate $ 3 + 0.25 * x) 0 3 (-5))
-    , mempty
-    )
   where
     x = fromIntegral $ loadedAmmo it
 
-
 pistol :: Item
 pistol = defaultGun 
     { _itName = "PISTOL"

src/Dodge/Item/Weapon/ExtraEffect.hs

@@ -11,7 +11,6 @@ module Dodge.Item.Weapon.ExtraEffect
     ) where
 import Dodge.Data
 import Dodge.Base
-import Dodge.Item.Data
 import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.UseEffect
 --import Dodge.Item.Attachment.Data

src/Dodge/Item/Weapon/Grenade.hs

@@ -2,8 +2,6 @@ module Dodge.Item.Weapon.Grenade
     ( grenade
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Item.Data
 import Dodge.Picture.Layer
 import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.TriggerType
@@ -11,7 +9,6 @@ import Dodge.Default
 import Dodge.Base
 import Dodge.Zone
 import Dodge.SoundLogic
-import Dodge.Item.Attachment.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.ExtraEffect
@@ -27,6 +24,7 @@ import qualified Data.IntMap.Strict as IM
 grenade :: Item
 grenade = Throwable
     { _itName = "GRENADE " ++ show fuseTime
+    , _itCurseStatus = Uncursed
     , _itIdentity = Grenade
     , _itMaxStack = 8
     , _itAmount = 1

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -5,7 +5,6 @@ module Dodge.Item.Weapon.InventoryDisplay
     ( basicWeaponDisplay
     ) where
 import Dodge.Data
-import Dodge.Item.Attachment.Data
 import Padding
 
 import Data.Sequence

src/Dodge/Item/Weapon/Launcher.hs

@@ -3,13 +3,10 @@ module Dodge.Item.Weapon.Launcher
     , remoteLauncher
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Default.Weapon
 import Dodge.Default.Shell
 import Dodge.SoundLogic.LoadSound
 import Dodge.WorldEvent.Explosion
-import Dodge.Item.Data
-import Dodge.Item.Attachment.Data
 import Dodge.Item.Draw
 import Dodge.Item.Weapon.Shell
 import Dodge.Item.Weapon.Remote

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -14,14 +14,12 @@ import Dodge.SoundLogic.LoadSound
 import Dodge.WorldEvent
 import Dodge.Default
 import Dodge.Item.Draw
-import Dodge.Item.Data
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
 --import Dodge.Item.Weapon.ExtraEffect
 --import Dodge.Item.Weapon.UseEffect
 import Dodge.Item.Weapon.AmmoParams
-import Dodge.Item.Attachment.Data
 import Dodge.Default.Weapon
 --import Dodge.Item.Attachment
 import Geometry

src/Dodge/Item/Weapon/TriggerType.hs

@@ -37,13 +37,10 @@ module Dodge.Item.Weapon.TriggerType
     )
     where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Dodge.Creature.Action (startReloadingWeapon)
 import Dodge.WorldEvent
 import Dodge.RandomHelp
-import Dodge.Item.Attachment.Data
-import Dodge.Item.Data
 import Dodge.Default
 import Sound.Data
 import Geometry

src/Dodge/Item/Weapon/Utility.hs

@@ -0,0 +1,79 @@
+module Dodge.Item.Weapon.Utility where
+import Dodge.Data
+import Dodge.Default
+import Dodge.Picture.Layer
+import Dodge.Creature.Action
+import Dodge.Item.Weapon.TriggerType
+import Dodge.Default.Weapon
+import Geometry
+import Picture
+--import qualified IntMapHelp as IM
+import Shape
+--import ShapePicture
+
+import Control.Lens
+shrinkGun :: Item
+shrinkGun = defaultGun
+    { _itName = "SHRINKER"
+    , _itIdentity = Generic
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 20
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itAimStance = TwoHandFlat
+    , _itUse = useShrinkGun
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        ]
+    , _itLeftClickUse = Nothing
+    , _wpSpread = 0.05
+    , _wpRange = 20
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    , _itAttachment = ItBool True
+    }
+
+useShrinkGun :: Item -> Creature -> World -> World
+useShrinkGun it cr = case _itBool $ _itAttachment it of
+    True -> sizeSelf 0.5 cr . f False UndroppableIdentified
+                . stripNoItems cr
+                . dropUnselected cr
+    False -> sizeSelf 1 cr . f True Uncursed
+                . setMinInvSize defaultInvSize cr
+  where
+    f isInUse cstatus = creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) %~
+        ( (itAttachment . itBool .~ isInUse) . (itCurseStatus .~ cstatus) )
+
+blinkGun :: Item
+blinkGun = defaultGun 
+    { _itName = "BLINKER"
+    , _itIdentity = Blinker
+    , _wpMaxAmmo = 100
+    , _wpLoadedAmmo = 100
+    , _wpReloadTime = 20
+    , _wpReloadState = 0
+    , _itUseRate = 0
+    , _itUseTime = 0
+    , _itUse = const blinkAction
+    , _itUseModifiers =
+        [ ammoCheckI
+        , hammerCheckI
+        ]
+    , _itLeftClickUse = Just $ hammerCheckL $ shootL aSelfL
+    , _wpSpread = 0.05
+    , _wpRange = 20
+    , _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2[(-2,-2),(-2,2),(2,2),(2,0),(0,0),(0,-2)]
+    , _itAimingSpeed = 1
+    , _itAimingRange = 0
+    }
+
+
+aSelf :: Creature -> World -> World
+aSelf = blinkAction
+
+aSelfL :: Creature -> Int -> World -> World
+aSelfL cr _ = blinkAction cr

src/Dodge/LevelGen/Data.hs

@@ -20,7 +20,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutProp Prop
     | PutFlIt Item
     | PutPressPlate PressPlate
-    | PutBlock BlockMaterial [Int] Color [Point2]
+    | PutBlock BlockMaterial [Int] Wall [Point2]
     | PutCoordinate Point2
     | PutMod Modification
     | PutTrigger (World -> Bool)

src/Dodge/LevelGen/Switch.hs

@@ -6,7 +6,6 @@ module Dodge.LevelGen.Switch
     ) where
 import Dodge.Data
 import Dodge.Default
-import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Picture
 import ShapePicture

src/Dodge/Menu.hs

@@ -8,7 +8,6 @@ module Dodge.Menu
     where
 import Dodge.Data
 import Dodge.Save
-import Dodge.Config.Data
 import Dodge.Config.Update
 import SDL
 import SDL.Internal.Numbered

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -5,14 +5,12 @@ module Dodge.Particle.Bullet.HitEffect
     where
 import Dodge.Data
 import Dodge.Particle.Spark
-import Dodge.Data.SoundOrigin
 import Dodge.Wall.Damage
 import Dodge.WorldEvent
 import Dodge.Particle.Bullet.Spawn
 import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.WorldEvent.Shockwave
-import Dodge.Creature.State.Data
 import Dodge.Creature.Property
 import Dodge.Wall.Reflect
 import Geometry

src/Dodge/Particle/Spark.hs

@@ -7,7 +7,6 @@ import Dodge.Data
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
 import Dodge.WorldEvent.HitEffect
-import Dodge.Creature.State.Data
 import Color
 import Geometry
 

src/Dodge/Particle/TeslaArc.hs

@@ -2,7 +2,6 @@ module Dodge.Particle.TeslaArc
     ( makeTeslaArcAt
     ) where
 import Dodge.Data
-import Dodge.Creature.State.Data
 import Dodge.WorldEvent.Damage
 import Dodge.Base
 import Dodge.Zone

src/Dodge/Placement/Instance/Turret.hs

@@ -8,7 +8,6 @@ import Dodge.WorldEvent.Explosion
 import Dodge.Item.Weapon.BatteryGuns
 import Dodge.SoundLogic.LoadSound
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 import Geometry
 import ShapePicture
 import Shape

src/Dodge/Placement/Instance/Wall.hs

@@ -23,9 +23,9 @@ lowWall ps = ps0j (PutForeground . colorSH col $ upperPrismPoly 30 ps)
 singleBlock :: Point2 -> [Placement]
 singleBlock a = 
     [sPS a 0 
-        $ PutBlock StoneBlock [5,20,20] (greyN 0.5)
+        $ PutBlock StoneBlock [5,20,20] baseBlockPane
         $ reverse 
-        $ rectNSWE 10 (-10) (-10) 10
+        $ square 10
     ]
 {-
 Places a line of blocks between two points.
@@ -82,6 +82,17 @@ baseBlockPane = defaultWall
     , _wlDraw = True
     , _wlFireThrough = True
     }
+dirtWall :: Wall
+dirtWall = defaultWall
+    { _wlLine = (V2 0 0,V2 50 0)
+    , _wlID = 0
+    , _wlColor = V4 (150/256) ( 75/256)  0 ( 250/256)
+    , _wlSeen = False
+    , _wlOpacity = Opaque
+    , _wlRotateTo = False
+    , _wlDraw = True
+    , _wlFireThrough = True
+    }
 baseWindowPane :: Wall
 baseWindowPane = defaultWall
     { _wlLine = (V2 0 0,V2 50 0)

src/Dodge/Placement/PlaceSpot.hs

@@ -102,7 +102,7 @@ placeSpotID ps pt w = case pt of
     PutDoor col f pss -> placeDoor col f (map (bimap doShift doShift) pss) w
     PutCoordinate coordp -> placeNewInto coordinates (doShift coordp) w
     PutSlideDoor pathing col f a b spd -> placeSlideDoor pathing col f (doShift a) (doShift b) spd w
-    PutBlock bm (hp:hps) col ps' -> placeBlock (map doShift ps') hp col Opaque hps bm w
+    PutBlock bm (hp:hps) wl ps' -> placeBlock (map doShift ps') hp wl hps bm w
     PutBlock{} -> error "messed up block placement somehow"
     PutLineBlock wl bm wdth dpth a b -> placeLineBlock wl bm wdth dpth (doShift a) (doShift b) w
     PutWall { _pwPoly = ps', _pwWall = wl } -> (0,placeWallPoly (map doShift ps') wl w)

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -8,10 +8,8 @@ import Dodge.Data
 import Dodge.Path
 import Dodge.Base
 import Dodge.Zone
-import Dodge.Default.Wall
 import Geometry
 import qualified IntMapHelp as IM
-import Color
 
 import Control.Lens
 import Data.List
@@ -19,16 +17,15 @@ import qualified Data.IntSet as IS
 
 addBlock 
     :: [Point2]     -- ^ Block polygon
+    -> Wall         -- ^ Base Pane
     -> Int          -- ^ First layer of health
-    -> Color 
-    -> Opacity         -- ^ Is the block see through?
     -> [Int]        -- ^ Extra layers of health
     -> BlockMaterial
     -> World 
     -> World
-addBlock (p:ps) hp col opacity hps bm w 
+addBlock (p:ps) wl hp hps bm w 
     | hp <= 0 && null hps = w
-    | hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) bm w
+    | hp <= 0 = addBlock (p:ps) wl (head hps + hp) (tail hps) bm w
     | otherwise = w
         & wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
         & walls  %~ IM.union panes
@@ -40,31 +37,28 @@ addBlock (p:ps) hp col opacity hps bm w
     i = IM.newKey $ _walls w
     is = [i.. i + length lns-1]
     panes = IM.fromList $ zipWith 
-        (\j (a,b) -> (,) j defaultWall 
+        (\j (a,b) -> (,) j wl 
             { _wlLine = (a,b)
             , _wlID = j
-            , _wlColor = col
-            , _wlOpacity = opacity
             , _wlStructure = BlockPart blid
-            , _wlFireThrough = True
             }
         ) is lns
-    wallInZone wl 
+    wallInZone wl'
-        | uncurry dist (_wlLine wl) <= 2*zoneSize 
+        | uncurry dist (_wlLine wl') <= 2*zoneSize 
-            = insertIMInZone x y wlid wl
+            = insertIMInZone x y wlid wl'
-        | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl)) ips
+        | otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl')) ips
       where 
         (x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
         wlid  = _wlID wl
         ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
-addBlock _ _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
+addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
         
-placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> BlockMaterial -> World -> (Int,World)
+placeBlock :: [Point2] -> Int -> Wall -> [Int] -> BlockMaterial -> World -> (Int,World)
-placeBlock poly i c opac is bm w 
+placeBlock poly i wl is bm w 
     = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
   where 
     pairs = loopPairs poly
-    wWithBlock = addBlock poly i c opac is bm w
+    wWithBlock = addBlock poly wl i is bm w
 
 {- | Splits a line into many four cornered blocks. -}
 placeLineBlock 

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -11,7 +11,6 @@ import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import Dodge.SoundLogic
-import Dodge.Data.SoundOrigin
 
 import Data.List
 import Control.Lens

src/Dodge/Render.hs

@@ -5,7 +5,6 @@ module Dodge.Render
     )
   where
 import Dodge.Data
-import Dodge.Config.Data
 import Dodge.Base.Window
 import Dodge.Render.Picture
 import Dodge.Render.ShapePicture
@@ -216,15 +215,15 @@ doDrawing pdata w = do
     depthFunc $= Just Always
     blendFunc $= (One,Zero)
     -- perform any radial distortion
-    case _radDistortion w of
+    case _distortions w of
         [] -> do
             bindTO $ fst $ snd $ _fboBase pdata
             bindFramebuffer Framebuffer $= defaultFramebufferObject
             --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
             drawShader (_fullscreenShader pdata) 4
         rds -> do
-            let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
+            let bindDrawDist :: Distortion -> IO ()
-                bindDrawDist ( V2 a b , V2 c d , V2 e f , g) = do
+                bindDrawDist (RadialDistortion (V2 a b) (V2 c d) (V2 e f) g) = do
                     pokeArray (shadVBOptr $ _barrelShader pdata) [a,b,c,d,e,f,g]
                     bindShaderBuffers [_barrelShader pdata] [1]
                     drawShader (_barrelShader pdata) 1

src/Dodge/Render/HUD.hs

@@ -37,6 +37,7 @@ drawInventory w = subInventoryDisplay w `appendPic` displayInv 0 w
 
 subInventoryDisplay :: World -> Picture
 subInventoryDisplay w = case _inventoryMode w of
+    LockedInventory -> topInvCursor col iPos w
     TopInventory -> pictures
         [ closeObjectTexts w
         , topInvCursor col iPos w
@@ -201,7 +202,13 @@ itemText :: Item -> Picture
 --itemText NoItem = dShadCol (greyN 0.5) $ text "----"
 --itemText it = dShadCol (_itInvColor it) $ text (_itInvDisplay it it)
 itemText NoItem = text "----"
-itemText it = color (_itInvColor it) $ text (_itInvDisplay it it)
+itemText it = case _itCurseStatus it of
+    UndroppableIdentified -> color black (text (_itInvDisplay it it)) 
+        <> color (withAlpha 0.5 thecolor) (polygon (rectNSEW 120 (-70) 900 (-100)))
+    _ -> color thecolor $ text (_itInvDisplay it it)
+  where
+    thecolor = _itInvColor it
+    
 
 openCursorAt 
     :: Float    -- ^ Width

src/Dodge/Room/Boss.hs

@@ -11,7 +11,6 @@ import Dodge.Room.Corridor
 import Dodge.Room.Path
 --import Dodge.LevelGen.Data
 import Dodge.Creature
-import Dodge.Creature.State.Data
 import Dodge.RandomHelp
 import Dodge.Layout.Tree.Polymorphic
 import Geometry

src/Dodge/Room/NoNeedWeapon.hs

@@ -4,7 +4,6 @@ module Dodge.Room.NoNeedWeapon
     ) where
 import Dodge.Data
 import Dodge.Creature
-import Dodge.Creature.State.Data
 --import Dodge.Creature.Inanimate
 import Dodge.LevelGen.Data
 import Dodge.Room.Procedural

src/Dodge/Room/Procedural.hs

@@ -13,6 +13,7 @@ import Dodge.Data
 import Dodge.Default.Wall
 import Dodge.PlacementSpot
 import Dodge.Placement.Instance
+import Dodge.Item.Weapon.Utility
 import Dodge.Room.Link
 import Dodge.Room.Path
 import Dodge.Default.Room

src/Dodge/Room/RoadBlock.hs

@@ -74,15 +74,20 @@ blockedCorridor = do
     sequence $ treeFromPost [] $ return $ Right $ set rmPmnts plmnts corridor
 
 dirtPoly :: [Point2] -> PSType
-dirtPoly = PutBlock DirtBlock [1] (V4 (150/256) ( 75/256)  0 ( 250/256)) . reverse
+dirtPoly = PutBlock DirtBlock [1] dirtWall . reverse
 
 -- | A single corridor with a destructible block blocking it.
 blockedCorridor' :: RandomGen g => State g Room
 blockedCorridor' = do
     r <- state $ randomR (0,pi)
-    theblocks <- takeOne [ [sPS (V2 20 40) r $ dirtPoly $ reverse $ square 10]
+    theblocks <- takeOne 
-        ,   [ sPS (V2 5 40) r $ dirtPoly $ square 10
+        [  -- [sPS (V2 20 40) r $ dirtPoly $ square 10]
-            , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10
+        --,   [ sPS (V2 5 40) r $ dirtPoly $ square 10
+        --    , sPS (V2 35 40) (r+0.5) $ dirtPoly $ square 10
+        --    ]
+        --,   
+          [ sPS (V2 5 50) r $ dirtPoly $ square 10
+            , sPS (V2 35 35) (r+0.5) $ dirtPoly $ square 10
             ]
         ]
     return $ corridor & rmPmnts .~ theblocks

src/Dodge/Room/Room.hs

@@ -18,7 +18,6 @@ import Dodge.Room.Link
 import Dodge.Room.Door
 import Dodge.Room.Airlock
 import Geometry
-import Picture
 import Tile
 
 import Control.Lens
@@ -147,7 +146,7 @@ miniRoom3 = do
         w <- state $ randomR (300,400)
         h <- state $ randomR (300,400)
         let cp = V2 0 (h/2+40)
-        let b = PutBlock StoneBlock [5,20,20] (greyN 0.5) $ map toV2 [(-10,-60) 
+        let b = PutBlock StoneBlock [5,20,20] baseBlockPane $ map toV2 [(-10,-60) 
                                                ,( 10,-60) 
                                                ,( 10,-80) 
                                                ,(-10,-80) 

src/Dodge/SoundLogic.hs

@@ -22,7 +22,6 @@ module Dodge.SoundLogic (
     , module Dodge.SoundLogic.LoadSound
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Sound.Data
 import Geometry.Data
 import Geometry.Vector

src/Dodge/Update.hs

@@ -5,10 +5,9 @@ Description : Simulation update
 module Dodge.Update (update) where
 import Dodge.Data
 import Dodge.Block
-import Dodge.Data.SoundOrigin
+import Dodge.Distortion
 import Dodge.SoundLogic
 import Dodge.Menu
-import Dodge.Config.Data
 import Dodge.Base
 import Dodge.Zone
 import Dodge.WallCreatureCollisions
@@ -46,7 +45,7 @@ functionalUpdate w = case _menuLayers w of
         w
     (_ : _) -> w
     []  -> checkEndGame 
-        . updateRadialDistortions
+        . updateDistortions
         . updateCreatureSoundPositions
         . ppEvents 
         . updateCamera
@@ -112,16 +111,8 @@ updateCreatureGroups :: World -> World
 updateCreatureGroups w = w & creatureGroups %~ 
     IM.mapMaybe (\cgp -> _crGroupUpdate cgp w cgp)
 
-updateRadialDistortions :: World -> World
+updateDistortions :: World -> World
-updateRadialDistortions = radDistortion %~ mapMaybe decreaseBulge
+updateDistortions = distortions %~ mapMaybe updateDistortion
-
-decreaseBulge 
-    :: (Point2,Point2,Point2,Float) 
-    -> Maybe (Point2,Point2,Point2,Float)
-decreaseBulge (a,b,c,v)
-    | v > 1 = Just (a,b,c,max 1 (v - 0.05) )
-    | v < 1 = Just (a,b,c,min 1 (v + 0.05) )
-    | otherwise = Nothing
 
 updateLightSources :: World -> World
 updateLightSources w = over tempLightSources f w

src/Dodge/Update/Camera.hs

@@ -12,7 +12,6 @@ import Dodge.Zone
 import Dodge.Base.Window
 import Dodge.Base.Collide
 import Dodge.Config.KeyConfig
-import Dodge.Item.Attachment.Data
 import Geometry
 --import Geometry.ConvexPoly
 import Dodge.GameRoom

src/Dodge/Update/UsingInput.hs

@@ -4,7 +4,6 @@ module Dodge.Update.UsingInput
     ( updateUsingInput
     ) where
 import Dodge.Data
-import Dodge.Item.Data
 import Dodge.Creature.Impulse.UseItem
 import Geometry
 

src/Dodge/WallCreatureCollisions.hs

@@ -7,7 +7,6 @@ import Dodge.Data
 --import Dodge.Creature.State.Data
 import Dodge.Zone
 import Dodge.Base
-import Dodge.Config.Data
 import Geometry
 
 import Data.Monoid

src/Dodge/WorldEvent/Damage.hs

@@ -2,7 +2,6 @@ module Dodge.WorldEvent.Damage
     ( damThingHitWith
     ) where
 import Dodge.Data
-import Dodge.Creature.State.Data
 import Geometry
 import Dodge.Wall.Damage
 

src/Dodge/WorldEvent/Explosion.hs

@@ -8,7 +8,6 @@ module Dodge.WorldEvent.Explosion
     , makeTeslaExplosionAt
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.Default
 import Dodge.Zone
 import Dodge.Base.Collide

src/Dodge/WorldEvent/HitEffect.hs

@@ -5,7 +5,6 @@ module Dodge.WorldEvent.HitEffect
     , penWalls
     ) where
 import Dodge.Data
-import Dodge.Creature.State.Data
 import Geometry
 
 import Data.Bifunctor

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,7 +4,6 @@ module Dodge.WorldEvent.Shockwave
     )
   where
 import Dodge.Data
-import Dodge.Creature.State.Data
 import Dodge.Wall.Damage
 import Dodge.Base
 import Dodge.Zone

src/Dodge/WorldEvent/Sound.hs

@@ -6,7 +6,6 @@ module Dodge.WorldEvent.Sound
     )
   where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
 import Dodge.SoundLogic
 import Sound.Data
 import Geometry.Data

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -7,9 +7,6 @@ module Dodge.WorldEvent.SpawnParticle
     , makeFlameletTimed
     ) where
 import Dodge.Data
-import Dodge.Data.SoundOrigin
-import Dodge.Creature.State.Data
---import Dodge.WorldEvent.Damage
 import Dodge.Base
 import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit

src/ShapePicture.hs

@@ -4,6 +4,7 @@ module ShapePicture
     , translateSPz
     , rotateSP
     , SPic
+    , noPic
     , _spShape
     , _spPicture
     )
@@ -16,6 +17,9 @@ import Data.Bifunctor
 
 type SPic =  (Shape, Picture)
 
+noPic :: Shape -> SPic
+noPic sh = (sh,mempty)
+
 _spShape :: SPic -> Shape
 _spShape = fst
 _spPicture :: SPic -> Picture