Allow movement when viewing terminals

AMEND: AimStance is also used when AtEase, so this is not a good solution

.gitignore

@@ -4,3 +4,4 @@
 loop.cabal
 *.lock
 keys.json
+log/*

appDodge/Main.hs

@@ -2,6 +2,7 @@ module Main (
     main,
 ) where
 
+import Dodge.StartNewGame
 import Control.Lens
 import Control.Monad
 import Control.Parallel
@@ -15,7 +16,7 @@ import Dodge.Data
 import Dodge.Event
 import Dodge.Initialisation
 import Dodge.LoadSeed
-import Dodge.Menu
+--import Dodge.Menu
 import Dodge.Render
 import Dodge.SoundLogic.LoadSound
 import Dodge.TestString
@@ -74,7 +75,7 @@ winConfig x y winpos =
 theCleanup :: Universe -> IO ()
 theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
 
-firstWorldLoad :: Configuration -> IO Universe
+firstWorldLoad :: Config -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     pdata <- doPreload >>= applyWorldConfig theConfig
@@ -100,7 +101,8 @@ firstWorldLoad theConfig = do
                 , _uvDebugMessageOffset = 0
                 , _uvSoundQueue = mempty
                 }
-    return $ u & uvScreenLayers .~ [splashMenu u]
+    --return $ u & uvScreenLayers .~ [splashMenu u]
+    return $ startNewGameInSlot 0 u
 
 theUpdateStep :: SDL.Window -> Universe -> IO Universe
 theUpdateStep win = doSideEffects <=< updateRenderSplit win

data/dodge.config.json

@@ -1,8 +1,6 @@
 {
   "_debug_booleans": [
-    "Show_ms_frame",
-    "Mouse_position",
-    "Collision_test"
+    "Show_ms_frame"
   ],
   "_debug_view_clip_bounds": "NoRoomClipBoundaries",
   "_gameplay_rotate_to_wall": true,
@@ -14,11 +12,11 @@
   "_graphics_num_shadow_casters": "NumShadowCasters20",
   "_graphics_shadow_rendering": "GeoObjShads",
   "_graphics_shadow_size": "Typical",
-  "_graphics_world_resolution": "QuarterRes",
+  "_graphics_world_resolution": "HalfRes",
   "_volume_master": 1,
   "_volume_music": 0,
   "_volume_sound": 1,
-  "_windowPosX": 0,
+  "_windowPosX": 800,
   "_windowPosY": 29,
   "_windowX": 800,
   "_windowY": 835

log/aGeneratedRoomLayout

@@ -1,145 +1,41 @@
-Seed: 7114951007332849727Layout with room names:
-rezBox-0
+Seed: 7114951007332849727
+Room layout (compact): 
+0,1,2,3,4,5,6
 |
-autoDoor-1
++- 7,8
 |
-rectPillars-2
++- 9,10
 |
-autoDoor-3
+11,12,13,14
+
+Layout with room names:
+Corridor-0
 |
-Corridor-4
+6gon-1
 |
-autoDoor-5
+defaultRoom-2
 |
-ElecautoRect-6
+autoRect-3
+|
+autoDoor-4
+|
+Corridor-5
+|
+doorToggle-6gon-6
 |
 +- triggerDoorRoom-7
 |  |
-|  autoDoor-8
-|  |
-|  autoDoor-9
-|  |
-|  Corridor-10
-|  |
-|  autoDoor-11
-|  |
-|  8gon-12
-|  |
-|  triggerDoorRoom-13
-|  |
-|  autoDoor-14
-|  |
-|  autoDoor-15
-|  |
-|  Corridor-16
-|  |
-|  autoRect-17
-|  |
-|  autoDoor-18
-|  |
-|  Corridor-19
-|  |
-|  autoDoor-20
-|  |
-|  6gon-21
-|  |
-|  +- triggerDoorRoom-22
-|  |  |
-|  |  autoDoor-23
-|  |  |
-|  |  autoDoor-24
-|  |  |
-|  |  Corridor-25
-|  |  |
-|  |  autoDoor-26
-|  |  |
-|  |  warningTerm-8gon-27
-|  |  |
-|  |  triggerDoorRoom-28
-|  |  |
-|  |  autoDoor-29
-|  |  |
-|  |  autoDoor-30
-|  |  |
-|  |  Corridor-31
-|  |  |
-|  |  autoRect-32
-|  |  |
-|  |  autoDoor-33
-|  |  |
-|  |  Corridor-34
-|  |  |
-|  |  autoDoor-35
-|  |  |
-|  |  Corridor-36
-|  |  |
-|  |  8gon-37
-|  |  |
-|  |  triggerDoorRoom-38
-|  |  |
-|  |  autoDoor-39
-|  |  |
-|  |  autoDoor-40
-|  |  |
-|  |  Corridor-41
-|  |  |
-|  |  tanksRoom-42
-|  |  |
-|  |  autoDoor-43
-|  |  |
-|  |  Corridor-44
-|  |  |
-|  |  autoDoor-45
-|  |  |
-|  |  rect-46
-|  |  |
-|  |  +- autoDoor-47
-|  |  |  |
-|  |  |  autoDoor-48
-|  |  |  |
-|  |  |  Corridor-49
-|  |  |  |
-|  |  |  autoRect-50
-|  |  |  |
-|  |  |  defaultRoom-51
-|  |  |  |
-|  |  |  autoRect-52
-|  |  |  |
-|  |  |  defaultRoom-53
-|  |  |  |
-|  |  |  autoRect-54
-|  |  |  |
-|  |  |  autoDoor-55
-|  |  |  |
-|  |  |  Corridor-56
-|  |  |  |
-|  |  |  autoDoor-57
-|  |  |  |
-|  |  |  8gon-58
-|  |  |  |
-|  |  |  triggerDoorRoom-59
-|  |  |  |
-|  |  |  autoDoor-60
-|  |  |  |
-|  |  |  autoDoor-61
-|  |  |  |
-|  |  |  Corridor-62
-|  |  |  |
-|  |  |  defaultRoom-63
-|  |  |
-|  |  Corridor-64
-|  |  |
-|  |  autoDoor-65
-|  |
-|  autoDoor-66
-|  |
-|  Corridor-67
-|  |
-|  autoRect-68
+|  autoRect-8
 |
-autoDoor-69
++- triggerDoorRoom-9
+|  |
+|  autoRect-10
 |
-Corridor-70
+Corridor-11
 |
-autoRect-71
+6gon-12
+|
+defaultRoom-13
+|
+autoRect-14
 

log/attemptedSeeds

@@ -1,4 +1,4 @@
 Generating level with seed 7114951007332849727
 
 After 1 attempt(s), Successful generation of level with seed 7114951007332849727
-72 rooms in total
+15 rooms in total

log/treeCluster

@@ -1,267 +1,49 @@
 Seed: 7114951007332849727
-0:startThenWeaponRoom
+0:teststart
 |
-1:corDoor
+1:TutDrop
 |
-2:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
+2:corDoor
 |
-3:corDoor
+3:DoorTest
 |
-4:lasSensorTurretTest
-|
-5:corDoor
-|
-6:SingleRoom
-|
-7:corDoor
-|
-8:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
-|
-9:corDoor
-|
-10:warningRooms
-|
-11:corDoor
-|
-12:chaseCrit+armourChaseCrit rectRoom
-|
-13:corDoor
-|
-14:healthTest
-|
-15:corDoor
-|
-16:empty tanksRoom
-|
-17:corDoor
-|
-18:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
-|
-19:corDoor
-|
-20:shootingRange
-|
-21:corDoor
-|
-22:lasSensorTurretTest
-|
-23:corDoor
-|
-24:randomFourCornerRoom
+4:TutDrop
 
-0:0:startThenWeaponRoom
+0:0:teststart
+
+0:0:0:Corridor
+
+1:0:TutDrop
+
+1:0:0:6gon
 |
-0:1:weaponBetweenPillars_BANGSTICK4
-
-0:0:0:rezBox'
-
-0:0:0:0:rezBox
+1:0:1:defaultRoom
 |
-0:0:0:1:autoDoor
+1:0:2:autoRect
 
-0:1:0:rectPillars
+2:0:corDoor
 
-1:0:corDoor
-
-1:0:0:autoDoor
+2:0:0:autoDoor
 |
-1:0:1:Corridor
+2:0:1:Corridor
 
-2:0:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
+3:0:DoorTest
 
-2:0:0:RassThroughLockKeyLists
+3:0:0:doorToggle-6gon
 |
-2:0:1:roomsContaining chaseCritchaseCritTRANSFORMERCANCAN
-
-2:0:0:0:sensorRoomRunPast
-
-2:0:0:0:0:autoDoor
-|
-2:0:0:0:1:ElecautoRect
-|
-+- 2:0:0:0:2:triggerDoorRoom
++- 3:0:1:triggerDoorRoom
 |  |
-|  2:0:0:0:3:autoDoor
+|  3:0:2:autoRect
 |
-2:0:0:0:4:autoDoor
-|
-2:0:0:0:5:Corridor
-
-2:0:1:0:autoRect
-
-3:0:corDoor
-
-3:0:0:autoDoor
-|
-3:0:1:Corridor
-
-4:0:lasSensorTurretTest
-
-4:0:0:autoDoor
-|
-4:0:1:8gon
-|
-4:0:2:triggerDoorRoom
-|
-4:0:3:autoDoor
-
-5:0:corDoor
-
-5:0:0:autoDoor
-|
-5:0:1:Corridor
-
-6:0:SingleRoom
-
-6:0:0:autoRect
-
-7:0:corDoor
-
-7:0:0:autoDoor
-|
-7:0:1:Corridor
-
-8:0:PassthroughLockKeyLists-HELD {_ibtHeld = KEYCARD 0}
-
-8:0:0:RassThroughLockKeyLists
-|
-8:0:1:roomsContaining chaseCritchaseCritchaseCritKEYCARD 0
-
-8:0:0:0:keyCardRoomRunPast
-
-8:0:0:0:0:autoDoor
-|
-8:0:0:0:1:6gon
-|
-+- 8:0:0:0:2:triggerDoorRoom
++- 3:0:3:triggerDoorRoom
 |  |
-|  8:0:0:0:3:autoDoor
+|  3:0:4:autoRect
 |
-8:0:0:0:4:autoDoor
+3:0:5:Corridor
+
+4:0:6gon
 |
-8:0:0:0:5:Corridor
-
-8:0:1:0:autoRect
-
-9:0:corDoor
-
-9:0:0:autoDoor
+4:1:defaultRoom
 |
-9:0:1:Corridor
-
-10:0:warningRooms
-
-10:0:0:autoDoor
-|
-10:0:1:warningTerm-8gon
-|
-10:0:2:triggerDoorRoom
-|
-10:0:3:autoDoor
-
-11:0:corDoor
-
-11:0:0:autoDoor
-|
-11:0:1:Corridor
-
-12:0:chaseCrit+armourChaseCrit rectRoom
-
-12:0:0:autoRect
-
-13:0:corDoor
-
-13:0:0:autoDoor
-|
-13:0:1:Corridor
-
-14:0:healthTest
-
-14:0:0:autoDoor
-|
-14:0:1:Corridor
-|
-14:0:2:8gon
-|
-14:0:3:triggerDoorRoom
-|
-14:0:4:autoDoor
-
-15:0:corDoor
-
-15:0:0:autoDoor
-|
-15:0:1:Corridor
-
-16:0:empty tanksRoom
-
-16:0:0:tanksRoom
-
-17:0:corDoor
-
-17:0:0:autoDoor
-|
-17:0:1:Corridor
-
-18:0:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
-
-18:0:0:RassThroughLockKeyLists
-|
-18:0:1:roomsContaining chaseCritchaseCritSNIPERRIFLE
-
-18:0:0:0:longRoomRunPast
-
-18:0:0:0:0:autoDoor
-|
-18:0:0:0:1:rect
-|
-+- 18:0:0:0:2:autoDoor
-|
-18:0:0:0:3:Corridor
-|
-18:0:0:0:4:autoDoor
-
-18:0:1:0:rectPillars
-
-19:0:corDoor
-
-19:0:0:autoDoor
-|
-19:0:1:Corridor
-
-20:0:shootingRange
-
-20:0:0:autoRect
-|
-20:0:1:defaultRoom
-|
-20:0:2:autoRect
-|
-20:0:3:defaultRoom
-|
-20:0:4:autoRect
-
-21:0:corDoor
-
-21:0:0:autoDoor
-|
-21:0:1:Corridor
-
-22:0:lasSensorTurretTest
-
-22:0:0:autoDoor
-|
-22:0:1:8gon
-|
-22:0:2:triggerDoorRoom
-|
-22:0:3:autoDoor
-
-23:0:corDoor
-
-23:0:0:autoDoor
-|
-23:0:1:Corridor
-
-24:0:defaultRoom
+4:2:autoRect
 

src/Dodge/Annotation.hs

@@ -1,37 +1,39 @@
 --{-# LANGUAGE TupleSections #-}
-{- | Annotating tree structures with desired properties for rooms.  -}
-module Dodge.Annotation 
-    ( module Dodge.Annotation.Data
-    , module Dodge.Annotation
+
+-- | Annotating tree structures with desired properties for rooms.
+module Dodge.Annotation (
+    module Dodge.Annotation.Data,
+    module Dodge.Annotation,
 ) where
-import Dodge.Cleat
-import RandomHelp
-import Dodge.Tree
-import Dodge.Data.GenWorld
-import Dodge.Annotation.Data
-import LensHelp
 
---import Control.Lens
 import Data.Maybe
+import Dodge.Annotation.Data
+import Dodge.Cleat
+--import Dodge.Data.GenWorld
+import Dodge.Tree
+import LensHelp
+import RandomHelp
 
-annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS
+annoToRoomTree :: Annotation -> State LayoutVars MTRS
 annoToRoomTree an = case an of
-    AnTree t -> zoom _1 t 
-    AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ())  <$> zoom _1 r <*> return []
+    AnTree t -> t
+--    AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ()) <$> zoom _1 r <*> return []
     OnwardList ans -> do
         mts <- mapM annoToRoomTree ans
         return $ foldr1 attachOnward' mts
-    IntAnno f -> do 
-        (g,i) <- get
-        put (g,i+1)
-        annoToRoomTree (f i)
-    ModifyTree f a -> f <$> annoToRoomTree a
-    PassthroughLockKeyLists ls ks i -> zoom _1 $ do
+--    IntAnno f -> do
+--        LayVars g i <- get
+--        put $ LayVars g (i + 1)
+--        annoToRoomTree (f i)
+    --PassthroughLockKeyLists ls ks i -> zoom lyGen $ do
+    PassthroughLockKeyLists ls ks -> do
+        i <- nextLayoutInt
         (functionlockroom, randomitemidentity) <- takeOne ls
-        lr <- functionlockroom i
-        ii <- randomitemidentity
-        keyroom <- fromJust $ lookup ii ks
-        return $ MTree ("PassthroughLockKeyLists-"++show ii) 
+        lr <- zoom lyGen $ functionlockroom i
+        ii <- zoom lyGen randomitemidentity
+        keyroom <- zoom lyGen . fromJust $ lookup ii ks
+        return $
+            MTree
+                ("PassthroughLockKeyLists-" ++ show ii)
                 (NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
                 []
-

src/Dodge/Annotation/Data.hs

@@ -11,15 +11,33 @@ import System.Random
 
 type MTRS = MetaTree Room String
 
+data LayoutVars = LayVars
+    { _lyGen :: StdGen
+    , _lyCounter :: Int
+    }
+
 data Annotation
-    = ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation
-    | OnwardList [Annotation]
-    | IntAnno (Int -> Annotation)
-    | AnRoom (State StdGen Room)
-    | AnTree (State StdGen (MetaTree Room String))
+    = OnwardList [Annotation]
+--    | IntAnno (Int -> Annotation)
+--    | AnRoom (State StdGen Room)
+    | AnTree (State LayoutVars (MetaTree Room String))
     | PassthroughLockKeyLists
         [(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
         [(ItemType, State StdGen (MetaTree Room String))]
-        Int
+--        Int
 
 makeLenses ''Annotation
+makeLenses ''LayoutVars
+
+instance RandomGen LayoutVars where
+    genWord32 x = let (y,g) = genWord32 (x ^. lyGen)
+        in (y,x & lyGen .~ g)
+    genWord64 x = let (y,g) = genWord64 (x ^. lyGen)
+        in (y,x & lyGen .~ g)
+    split x = let (g,h) = split (x ^. lyGen) in (x & lyGen .~ g, x & lyGen .~ h)
+
+nextLayoutInt :: State LayoutVars Int
+nextLayoutInt = do
+    LayVars g i <- get
+    put $ LayVars g (i + 1)
+    return i

src/Dodge/AssignHotkey.hs

@@ -1,21 +1,18 @@
-module Dodge.AssignHotkey (
-    assignHotkey,
-) where
+module Dodge.AssignHotkey (assignHotkey) where
 
-import Dodge.Data.Equipment.Misc
 import Control.Lens
 import Data.Maybe
+import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
 import NewInt
 
--- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or
--- World
 assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld
-assignHotkey (NInt itid) hk lw = lw
+assignHotkey i hk lw =
+    lw
         & handleoldposition
-        & hotkeys . at hk ?~ NInt itid
-        & imHotkeys . unNIntMap . at itid ?~ hk
+        & hotkeys . at hk ?~ i
+        & imHotkeys . at i ?~ hk
   where
     handleoldposition = fromMaybe id $ do
-        olditid <- lw ^? hotkeys . ix hk . unNInt
-        return $ imHotkeys . unNIntMap . at olditid .~ Nothing
+        oldi <- lw ^? hotkeys . ix hk
+        return $ imHotkeys . at oldi .~ Nothing

src/Dodge/Base/Collide.hs

@@ -143,7 +143,7 @@ collide3Floors sp cs (ep, mn) = maybe (ep, mn) (,Just (V3 0 0 1, OFloor)) mp
         let g (a, b) = isRHS a b (V2 x y)
             f = any g
         guard (all (f . loopPairs) cs)
-        return $ (V3 x y z)
+        return (V3 x y z)
 
 collide3Wall :: Point3 -> Wall -> (Point3, MPO) -> (Point3, MPO)
 collide3Wall sp wl (ep, mo) = maybe (ep, mo) (,Just (n, OWall wl)) $ intersectSegSurface sp ep p n ss

src/Dodge/Base/Coordinate.hs

@@ -12,7 +12,7 @@ import Dodge.Data.Input
 import Geometry
 
 ---- | Transform coordinates from world position to screen coordinates.
---worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
+--worldPosToScreenNorm :: Config -> World -> Point2 -> Point2
 --worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
 --  where
 --    doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)

src/Dodge/Base/NewID.hs

@@ -4,20 +4,13 @@ import LensHelp
 
 -- | generalised way of putting a new item into a lensed intmap, returning the
 -- new index as well
-plNewID :: ALens' b (IM.IntMap a)
-    -> a
-    -> b
-    -> (Int,b)
+plNewID :: ALens' b (IM.IntMap a) -> a -> b -> (Int,b)
 plNewID l x w = (i,w & l #%~ IM.insert i x)
   where
     i = IM.newKey $ w ^# l
 
 -- | place an new object into an intmap and update its id
-plNewUpID :: ALens' b (IM.IntMap a)
-    -> ALens' a Int
-    -> a
-    -> b
-    -> (Int,b)
+plNewUpID :: ALens' b (IM.IntMap a) -> ALens' a Int -> a -> b -> (Int,b)
 plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
   where
     i = IM.newKey $ w ^# l

src/Dodge/Base/Window.hs

@@ -14,7 +14,7 @@ import Dodge.Data.Config
 import Geometry
 
 -- | A box covering the screen in world coordinates
-screenPolygon :: Configuration -> Camera -> [Point2]
+screenPolygon :: Config -> Camera -> [Point2]
 screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
   where
     scRot = rotateV (w ^. camRot)
@@ -29,7 +29,7 @@ screenPolygonBord ::
     Float ->
     -- | Y border
     Float ->
-    Configuration ->
+    Config ->
     Camera ->
     [Point2]
 screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
@@ -45,16 +45,16 @@ screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
     br = theTransform (V2 hw (- hh))
     bl = theTransform (V2 (- hw) (- hh))
 
-halfWidth, halfHeight :: Configuration -> Float
+halfWidth, halfHeight :: Config -> Float
 halfWidth = (0.5 *) . windowXFloat
 halfHeight = (0.5 *) . windowYFloat
 
 -- | A box of the size of the screen in screen centered coordinates
-screenBox :: Configuration -> [Point2]
+screenBox :: Config -> [Point2]
 screenBox w = rectNSWE hh (- hh) (- hw) hw
   where
     hw = halfWidth w
     hh = halfHeight w
 
-pointIsOnScreen :: Configuration -> Camera -> Point2 -> Bool
+pointIsOnScreen :: Config -> Camera -> Point2 -> Bool
 pointIsOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w

src/Dodge/Base/You.hs

@@ -5,8 +5,9 @@ module Dodge.Base.You
     , yourRootItem
     )where
 
+import NewInt
 import Dodge.Data.World
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 import Control.Lens
 
 you :: World -> Creature
@@ -15,13 +16,15 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
 yourSelectedItem :: World -> Maybe Item
 yourSelectedItem w = do
     i <- you w ^? crManipulation . manObject . imSelectedItem
-    _crInv (you w) IM.!? i
+    j <- _crInv (you w) ^? ix i
+    w ^? cWorld . lWorld . items . ix j
 
 yourRootItem :: World -> Maybe Item
 yourRootItem w = do
     i <- you w ^? crManipulation . manObject . imRootSelectedItem
-    _crInv (you w) IM.!? i
+    j <- _crInv (you w) ^? ix i
+    w ^? cWorld . lWorld . items . ix j
 
-yourInv :: World -> IM.IntMap Item
-yourInv = _crInv . you
+yourInv :: World -> NewIntMap InvInt Item
+yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
 

src/Dodge/Bullet.hs

@@ -1,5 +1,6 @@
 module Dodge.Bullet (updateBullet) where
 
+import qualified Data.IntMap.Strict as IM
 import Dodge.Damage
 import Data.Bifunctor
 import Data.Foldable
@@ -105,10 +106,10 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
 --            tpos <- cr ^? crTargeting . ctPos . _Just
 --            return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
 
-bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
-bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
-bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p - _crPos cr
-bounceDir _ = Nothing
+bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
+bounceDir _ (_, Right wl) | _wlBouncy wl = Just $ uncurry (-) (_wlLine wl)
+bounceDir m (p, Left cr) | crIsArmouredFrom m p cr = Just $ vNormal $ p - _crPos cr
+bounceDir _ _ = Nothing
 
 useBulletPayload :: Bullet -> Point2 -> World -> World
 useBulletPayload bu = case _buPayload bu of
@@ -154,7 +155,7 @@ hitEffFromBul w bu = case _buEffect bu of
     PenetrateBullet -> movePenBullet bu hitstream w
     BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
         (hp, crwl) <- hitstream ^? _head
-        dir <- bounceDir (hp, crwl)
+        dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
         return
             ( w
             , bu

src/Dodge/Button/Draw.hs

@@ -11,8 +11,7 @@ drawButton :: Button -> SPic
 drawButton bt = case bt ^. btEvent of
     ButtonPress {_bpColor = col} -> defaultDrawButton col bt
     ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
-    ButtonAccessTerminal -> mempty
---    ButtonDoNothing -> mempty
+    ButtonAccessTerminal _ -> mempty
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt

src/Dodge/Button/Event.hs

@@ -5,7 +5,6 @@ import Control.Lens
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.WorldEffect
-import Sound.Data
 
 doButtonEvent :: ButtonEvent -> Button -> World -> World
 doButtonEvent = \case
@@ -13,10 +12,10 @@ doButtonEvent = \case
     ButtonPress False f _ -> buttonFlip f
     ButtonSwitch _ f _ _ True -> buttonFlip f
     ButtonSwitch f _ _ _ False -> buttonFlip f
-    ButtonAccessTerminal -> accessTerminal . _btTermMID
+    ButtonAccessTerminal tid -> const $ accessTerminal tid
 
 buttonFlip :: WdWd -> Button -> World -> World
 buttonFlip f bt =
     doWdWd f
-        . soundWithStatus ToStart (LeverSound 0) (bt ^. btPos) click1S Nothing
+        . soundStart (ButtonSound (bt ^. btID)) (bt ^. btPos) click1S Nothing
         . over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not

src/Dodge/Combine.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Combine (combineList) where
 
+import NewInt
 import Dodge.Data.CombAmount
 import Dodge.Item.InvSize
 import Dodge.Item.Grammar
@@ -21,18 +22,18 @@ combineList :: World -> [SelectionItem CombinableItem]
 combineList = map f . combineItemListYouX
   where
     f (is, itm) =
-        SelectionItem
+        SelItem
             { _siPictures = basicItemDisplay itm
             , _siHeight = itInvHeight itm
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = itemInvColor $ baseCI itm
             , _siOffX = 0
-            , _siPayload = CombinableItem is itm
+            , _siPayload = Just $ CombinableItem is itm
             }
 
 combineItemListYouX :: World -> [([Int], Item)]
-combineItemListYouX = map (first concat) . flatLookupItems . yourInv
+combineItemListYouX = map (first concat) . flatLookupItems . _unNIntMap . yourInv
 
 flatLookupItems :: IM.IntMap Item -> [([[Int]], Item)]
 flatLookupItems =

src/Dodge/Config/Load.hs

@@ -6,7 +6,7 @@ import Data.Aeson
 import Dodge.Data.Config
 import System.Directory
 
-loadDodgeConfig :: IO Configuration
+loadDodgeConfig :: IO Config
 loadDodgeConfig = do
     fExists <- doesFileExist "data/dodge.config.json"
     if fExists

src/Dodge/Config/Update.hs

@@ -17,7 +17,7 @@ import Sound
 {- |
 Write the current world configuration to disk as a json file.
 -}
-saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
+saveConfig :: Config -> (a -> IO a) -> a -> IO a
 saveConfig cfig f x = do
 --    putStrLn "Saving config to data/dodge.config.json"
     BS.writeFile "data/dodge.config.json" $
@@ -27,7 +27,7 @@ saveConfig cfig f x = do
 {- |
 Apply the volume settings from the world configuration to the running game.
 -}
-setVol :: Configuration -> IO ()
+setVol :: Config -> IO ()
 setVol cfig = do
     setSoundVolume (_volume_master cfig * _volume_sound cfig)
     setMusicVolume (_volume_master cfig * _volume_music cfig)
@@ -36,7 +36,7 @@ setVol cfig = do
 Apply /all/ of the values in the world configuration to the running game.
 -}
 applyWorldConfig ::
-    Configuration ->
+    Config ->
     PreloadData ->
     IO PreloadData
 applyWorldConfig cfig pdata = do

src/Dodge/Corpse/Make.hs

@@ -11,10 +11,7 @@ import Shape
 import ShapePicture
 
 makeCorpse :: Creature -> Corpse
-makeCorpse = makeDefaultCorpse
-
-makeDefaultCorpse :: Creature -> Corpse
-makeDefaultCorpse cr =
+makeCorpse cr =
     defaultCorpse
         & cpPos .~ _crPos cr
         & cpDir .~ _crDir cr

src/Dodge/Creature.hs

@@ -3,7 +3,7 @@ module Dodge.Creature (
     module Dodge.Creature.ChaseCrit,
     module Dodge.Creature.Inanimate,
     launcherCrit,
-    pistolCrit,
+--    pistolCrit,
     ltAutoCrit,
     spreadGunCrit,
     autoCrit,
@@ -38,7 +38,6 @@ import Dodge.Creature.Inanimate
 import Dodge.Creature.LauncherCrit
 import Dodge.Creature.LtAutoCrit
 import Dodge.Creature.Perception
-import Dodge.Creature.PistolCrit
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.SentinelAI
 import Dodge.Creature.SpreadGunCrit
@@ -58,34 +57,34 @@ spawnerCrit :: Creature
 spawnerCrit =
     defaultCreature
         & crHP .~ 300
-        & crInv .~ IM.empty
+--        & crInv .~ IM.empty
 --        & crType . skinUpper .~ lightx4 blue
 
 miniGunCrit :: Creature
 miniGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, miniGunX 3)]
+--        & crInv .~ IM.fromList [(0, miniGunX 3)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MiniGunAI
 
 longCrit :: Creature
 longCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, sniperRifle)]
+--        & crInv .~ IM.fromList [(0, sniperRifle)]
 --        & crType . humanoidAI .~ LongAI
 --        & crType . skinUpper .~ lightx4 red
 
 multGunCrit :: Creature
 multGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, volleyGun 4)]
+--        & crInv .~ IM.fromList [(0, volleyGun 4)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MultGunAI
 
 addArmour :: Creature -> Creature
 addArmour = over crInv insarmour
   where
-    insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
+    insarmour xs = xs -- IM.insert (IM.newKey xs) frontArmour xs
 
 {- | The creature you control.
 ID 0.
@@ -99,7 +98,7 @@ startCr =
         & crMvDir .~ pi / 2
         & crID .~ 0
         & crHP .~ 10000
-        & crInv .~ startInventory
+        & crInv .~ mempty
         & crFaction .~ PlayerFaction
 --        & crMvType .~ MvWalking yourDefaultSpeed
         & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
@@ -111,9 +110,9 @@ startInvList = []
 startInventory :: IM.IntMap Item
 startInventory = IM.fromList $ zip [0 ..] startInvList
 
-inventoryX :: Char -> [Item]
+inventoryX :: String -> [Item]
 inventoryX c = case c of
-    'A' ->
+    "A" ->
         [introScan t | t <- [minBound..maxBound]] <>
         [ flameThrower
         , fuelPack
@@ -123,7 +122,7 @@ inventoryX c = case c of
         , unigate
         , bingate
         ]
-    'B' ->
+    "B" ->
         [ wristArmour
         , wristArmour
         , volleyGun 5
@@ -147,15 +146,16 @@ inventoryX c = case c of
         , makeTypeCraftNum 2 PIPE
         , makeTypeCraftNum 1 CREATURESENSOR
         ]
-    'C' -> map makeTypeCraft [minBound..maxBound]
-    'D' ->
+    "BB" -> [ wristArmour , wristArmour]
+    "C" -> map makeTypeCraft [minBound..maxBound]
+    "D" ->
         [ blinker
         , unsafeBlinker
         , pulseChecker
         , detector WALLDETECTOR
         , battery
         ]
-    'E' -> [alteRifle
+    "E" -> [alteRifle
         , tinMag
         , tinMag
         ] <>
@@ -166,7 +166,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 1 STEELDRUM
         , makeTypeCraftNum 1 MOTOR
         ]
-    'F' -> fold
+    "F" -> fold
         [ makeTypeCraftNum 3 PIPE
         , makeTypeCraftNum 3 TUBE
         , makeTypeCraftNum 3 HARDWARE
@@ -183,7 +183,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 3 LIGHTER
 --        , makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
         ]
-    'G' ->
+    "G" ->
         [ autoPistol
         , tinMag
         , pistol
@@ -197,19 +197,19 @@ inventoryX c = case c of
 --        , makeTypeCraftNum 5 (BULBODYCRAFT BounceBullet)
 --        , makeTypeCraftNum 5 (BULBODYCRAFT PenetrateBullet)
         ]
-    'H' -> [shatterGun]
-    'I' ->
+    "H" -> [shatterGun]
+    "I" ->
         [ makeTypeCraft HARDDRIVE
         , makeTypeCraft RAM
         ] <> fold
         [ makeTypeCraftNum 2 MICROCHIP
         ]
-    'J' ->
+    "J" ->
         [ laser
         , battery
         --, dualBeam
         ] <> makeTypeCraftNum 10 TRANSFORMER
-    'K' ->
+    "K" ->
         [ autoRifle
         , tinMag
         ] <> fold
@@ -222,14 +222,14 @@ inventoryX c = case c of
         , makeTypeCraftNum 1 SOUNDSENSOR
         , makeTypeCraftNum 1 HEATSENSOR
         ]
-    'L' -> [burstRifle
+    "L" -> [burstRifle
             ,tinMag
             , bulletSynthesizer
             , battery
             ]
-    'M' -> stackedInventory
-    'N' -> [zoomScope,laser,battery, sniperRifle, tinMag]
-    'O' -> [ rLauncherX 2
+    "M" -> stackedInventory
+    "N" -> [zoomScope,laser,battery, sniperRifle, tinMag]
+    "O" -> [ rLauncherX 2
             , shellMag
             , shellMag
             , rLauncherX 3
@@ -239,9 +239,9 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
-    'P' -> [burstRifle , tinMag, bulletSynthesizer]
-    'T' -> testInventory
-    'U' ->
+    "P" -> [burstRifle , tinMag, bulletSynthesizer, battery]
+    "T" -> testInventory
+    "U" ->
         [targetingScope tt | tt <- [minBound .. maxBound]]
         <>
         [ gyroscope 
@@ -267,7 +267,7 @@ inventoryX c = case c of
         , stickyMod
         ]
         <> [shellModule p | p <- [minBound .. maxBound]]
-    'V' -> 
+    "V" -> 
         [targetingScope tt | tt <- [minBound .. maxBound]]
         <>
         [ battery

src/Dodge/Creature/Action.hs

@@ -13,6 +13,7 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import NewInt
 import Dodge.Creature.MoveType
 import Dodge.Creature.Radius
 import Dodge.Item.BackgroundEffect
@@ -166,36 +167,41 @@ performAction cr w ac = case ac of
 dropExcept :: Creature -> Int -> World -> World
 dropExcept cr invid w =
     foldr (dropItem cr) w . IM.keys $
-        invid `IM.delete` _crInv cr
+--        invid `IM.delete` _crInv cr
+        invid `IM.delete` _unNIntMap (_crInv cr)
 
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid =
+dropItem cr invid w' =
     doanyitemdropeffect
         . maybeshiftseldown
-        . rmInvItem (_crID cr) invid
         . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
+        . rmInvItem (_crID cr) (NInt invid) -- it is important 
+            -- to do this before copying the item to the floor!
         . soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
+        $ w'
   where
     --doanyitemdropeffect = fromMaybe id $ do
     --    rmf <- itm ^? itEffect . ieOnDrop
     --    return $ doInvEffect rmf itm cr
     doanyitemdropeffect = itEffectOnDrop itm cr
-    itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
+    itm = fromMaybe (error "dropItem cannot find item") $ do
+        itid <- cr ^? crInv . ix (NInt invid)
+        w' ^? cWorld . lWorld . items . ix itid
     maybeshiftseldown w = fromMaybe w $ do
-        3 <- w ^? hud . hudElement . diSelection . _Just . _1
-        return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
+        3 <- w ^? hud . diSelection . _Just . slSec
+        return $ w & hud . diSelection . _Just . slInt +~ 1
 
 -- | Get your creature to drop the item under the cursor.
 youDropItem :: World -> World
 youDropItem w = fromMaybe w $ do
     curpos <-
-        cr ^? crManipulation . manObject . imSelectedItem
-            <|> fmap fst (IM.lookupMax (cr ^. crInv))
+        cr ^? crManipulation . manObject . imSelectedItem . unNInt
+            <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
     --guard $ not $ _crInvLock cr
     guard $ not $ w ^. cWorld . lWorld . lInvLock
     return $ case cr ^. crStance . posture of
-        Aiming -> throwItem w
+        Aiming {} -> throwItem w
         AtEase -> dropItem cr curpos w
   where
     cr = you w

src/Dodge/Creature/ArmourChase.hs

@@ -3,23 +3,23 @@ module Dodge.Creature.ArmourChase (
     flockArmourChaseCrit,
 ) where
 
-import Dodge.Data.Equipment.Misc
-import Control.Lens
+--import Dodge.Data.Equipment.Misc
+--import Control.Lens
 import Dodge.Creature.ChaseCrit
 import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Equipment
-import qualified IntMapHelp as IM
+--import Dodge.Item.Equipment
+--import qualified IntMapHelp as IM
 
 flockArmourChaseCrit :: Creature
 flockArmourChaseCrit =
     defaultCreature
         { _crName = "armourChaseCrit"
         , _crHP = 300
-        , _crInv =
-            IM.fromList
-                [ (0, frontArmour)
-                ]
+        , _crInv = mempty
+--            IM.fromList
+--                [ --(0, frontArmour)
+--                ]
         , _crActionPlan =
             ActionPlan
                 { _apImpulse = []
@@ -36,11 +36,11 @@ armourChaseCrit :: Creature
 armourChaseCrit =
     chaseCrit
         { _crName = "armourChaseCrit"
-        , --, _crUpdate = defaultImpulsive []
-          _crInv =
-            IM.fromList
-                [ (0, frontArmour)
-                ]
+--        , --, _crUpdate = defaultImpulsive []
+--          _crInv =
+--            IM.fromList
+--                [ --(0, frontArmour)
+--                ]
 --        , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
         }
-        & crEquipment . at OnChest ?~ 0
+--        & crEquipment . at OnChest ?~ 0

src/Dodge/Creature/AutoCrit.hs

@@ -2,18 +2,18 @@ module Dodge.Creature.AutoCrit (
     autoCrit,
 ) where
 
-import Dodge.Item.Held.Cane
+--import Dodge.Item.Held.Cane
 --import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import Picture
 
 autoCrit :: Creature
 autoCrit =
     defaultCreature
-        { _crInv = IM.fromList [(0, autoRifle)]
-        , _crHP = 300
+        { --_crInv = IM.fromList [(0, autoRifle)]
+         _crHP = 300
 --        , _crMvType = defaultAimMvType
         }
 --        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/ChaseCrit.hs

@@ -4,11 +4,11 @@ module Dodge.Creature.ChaseCrit (
     chaseCrit,
 ) where
 
-import Dodge.Data.Equipment.Misc
-import Control.Lens
+--import Dodge.Data.Equipment.Misc
+--import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Equipment
+--import Dodge.Item.Equipment
 import Picture
 
 smallChaseCrit :: Creature
@@ -21,8 +21,8 @@ smallChaseCrit =
 invisibleChaseCrit :: Creature
 invisibleChaseCrit =
     chaseCrit
-        & crInv . at 0 ?~ wristInvisibility
-        & crEquipment . at OnLeftWrist ?~ 0
+--        & crInv . at 0 ?~ wristInvisibility
+--        & crEquipment . at OnLeftWrist ?~ 0
 
 chaseCrit :: Creature
 chaseCrit =

src/Dodge/Creature/Damage.hs

@@ -20,9 +20,10 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
     _ -> w & damageHP cr (_dmAmount dm)
 
 applyPiercingDamage :: Creature -> Damage -> World -> World
-applyPiercingDamage cr dm
-    | crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
-    | otherwise = f . damageHP cr (_dmAmount dm)
+applyPiercingDamage cr dm w
+    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
+        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
+    | otherwise = f . damageHP cr (_dmAmount dm) $ w
   where
     f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
             / V2 x x

src/Dodge/Creature/HandPos.hs

@@ -1,19 +1,18 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.HandPos (
+    equipSitePQ,
     translatePointToLeftHand,
     translatePointToRightHand,
-    translatePointToHead,
-    translateToLeftWrist,
-    translateToRightWrist,
     translateToLeftLeg,
     translateToRightLeg,
-    translateToHead,
-    translateToChest,
     translateToLeftHand,
     translateToRightHand,
     backPQ,
     headPQ,
+    translateToES,
 ) where
 
+import Dodge.Data.Equipment.Misc
 import qualified Quaternion as Q
 import Control.Lens
 import Dodge.Creature.Test
@@ -21,6 +20,19 @@ import Dodge.Data.Creature
 import Geometry
 import ShapePicture
 
+translateToES :: Creature -> EquipSite -> Point3 -> Point3
+translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
+
+equipSitePQ :: EquipSite -> Creature -> Point3Q
+equipSitePQ = \case
+    OnLeftWrist -> leftWristPQ
+    OnRightWrist -> rightWristPQ
+    OnHead -> headPQ
+    OnChest -> chestPQ
+    OnBack -> backPQ
+    OnLeftLeg -> leftLegPQ
+    OnRightLeg -> rightLegPQ
+
 translatePointToRightHand :: Creature -> Point3 -> Point3
 translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
 
@@ -37,14 +49,13 @@ rightHandPQ cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
-    g i = negate 2 + negate 6 * (i) / sLen
+    g i = negate 2 + negate 6 * i / sLen
 
 translateToRightHand :: Creature -> SPic -> SPic
 translateToRightHand = overPosSP . translatePointToRightHand
 
-translateToRightWrist :: Creature -> SPic -> SPic
-translateToRightWrist cr =  overPosSP
-    (\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
+rightWristPQ :: Creature -> Point3Q
+rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
 
 leftHandPQ :: Creature -> Point3Q
 leftHandPQ cr
@@ -59,7 +70,7 @@ leftHandPQ cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
-    g i = negate 2 + negate 6 * ( i) / sLen
+    g i = negate 2 + negate 6 * i / sLen
 
 translatePointToLeftHand :: Creature -> Point3 -> Point3
 translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
@@ -67,9 +78,8 @@ translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
 translateToLeftHand :: Creature -> SPic -> SPic
 translateToLeftHand = overPosSP . translatePointToLeftHand
 
-translateToLeftWrist :: Creature -> SPic -> SPic
-translateToLeftWrist cr = overPosSP 
-    (\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+leftWristPQ :: Creature -> Point3Q
+leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
 
 leftLegPQ :: Creature -> Point3Q
 leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -102,24 +112,18 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
 translateToRightLeg :: Creature -> SPic -> SPic
 translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
 
-translateToHead :: Creature -> SPic -> SPic
-translateToHead cr = overPosSP (\p -> fst $ (headPQ cr `Q.comp` (p,Q.qID)))
-
 headPQ :: Creature -> Point3Q
 headPQ cr
     | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
     | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
     | otherwise = (V3 2.5 0 20, Q.qID)
 
-translatePointToHead :: Creature -> Point3 -> Point3
-translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
+--translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
+--translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
 
 chestPQ :: Creature -> Point3Q
 chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
 
-translateToChest :: Creature -> SPic -> SPic
-translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
-
 backPQ :: Creature -> Point3Q
 backPQ cr
     | oneH cr = (V3 0 0 10, Q.qz 0.5)

src/Dodge/Creature/Impulse.hs

@@ -4,6 +4,7 @@ module Dodge.Creature.Impulse (
     impulsiveAIBefore,
 ) where
 
+import NewInt
 import Dodge.Creature.MoveType
 import Data.Foldable
 import Control.Monad.State
@@ -42,8 +43,8 @@ followImpulse cr w imp = case imp of
         let (newimp, newgen) = runState (doRandImpulse rimp) (_randGen w)
          in first ((randGen .~ newgen) .) $ followImpulse cr w newimp
     Bark sid -> (soundStart (CrMouth cid) cpos sid Nothing, resetCrVocCoolDown w cr)
-    Move p -> crup $ crMvBy p cr
-    MoveForward x -> crup $ crMvForward x cr
+    Move p -> crup $ crMvBy p (w ^. cWorld . lWorld) cr
+    MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
     Turn a -> crup $ cr & crDir +~ a
     TurnToward p a -> crup $ creatureTurnToward p a cr
     TurnTo p -> crup $ creatureTurnTo p cr
@@ -51,10 +52,10 @@ followImpulse cr w imp = case imp of
     UseItem -> undefined
 --    UseItem -> (useSelectedItem $ _crID cr
 --        , cr)
-    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
+    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
     Melee cid' ->
         ( hitCr cid'
-        , crMvAbsolute (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
+        , crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
         )
     RandomTurn a -> (randGen .~ snd (rr a), cr & crDir +~ fst (rr a))
     MakeSound sid -> (soundStart (CrSound (_crID cr)) (_crPos cr) sid Nothing, cr)
@@ -71,7 +72,7 @@ followImpulse cr w imp = case imp of
         Just tcr -> followImpulse cr w (doCrImp f tcr)
         _ -> crup cr
     ImpulseUseAheadPos f -> followImpulse cr w (doP2Imp f (_crPos cr +.+ 20 *.* unitVectorAtAngle (_crDir cr)))
-    MvForward -> crup $ crMvForward speed cr
+    MvForward -> crup $ crMvForward speed (w ^. cWorld . lWorld) cr
     MvTurnToward p ->
         crup $
             creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr

src/Dodge/Creature/Impulse/Movement.hs

@@ -20,17 +20,18 @@ For now, though, this cannot fail.
 crMvBy ::
     -- | Movement translation vector, will be made relative to creature direction
     Point2 ->
+    LWorld ->
     Creature ->
     Creature
-crMvBy p cr = crMvAbsolute (rotateV (_crDir cr) p) cr
+crMvBy p lw cr = crMvAbsolute lw (rotateV (_crDir cr) p) cr
 
-crMvAbsolute :: Point2 -> Creature -> Creature
-crMvAbsolute p' cr =
+crMvAbsolute :: LWorld -> Point2 -> Creature -> Creature
+crMvAbsolute lw p' cr =
     advanceStepCounter (magV p) cr
         & crPos +~ p
         & crMvDir .~ argV p
   where
-    p = strengthFactor (getCrMoveSpeed cr) *.* p'
+    p = strengthFactor (getCrMoveSpeed lw cr) *.* p'
 
 strengthFactor :: Int -> Float
 strengthFactor i
@@ -38,7 +39,7 @@ strengthFactor i
     | i < 1 = 0
     | otherwise = 0.02 * fromIntegral i
 
-crMvForward :: Float -> Creature -> Creature
+crMvForward :: Float -> LWorld -> Creature -> Creature
 crMvForward speed = crMvBy (V2 speed 0)
 
 advanceStepCounter :: Float -> Creature -> Creature

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
+import NewInt
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.ComposedItem
@@ -13,12 +14,13 @@ import Dodge.HeldUse
 import Dodge.Inventory
 import Dodge.Item.Grammar
 import Dodge.Item.Location
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 
 useItem :: Int -> Int -> World -> Maybe World
 useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    itmloc <- invIndents (_crInv cr) ^? ix invid . _2
+    itmloc <- invIndents ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr) 
+        ^? ix invid . _2
     useItemLoc cr itmloc pt w
 
 useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -43,8 +45,8 @@ useItemLoc cr loc pt w
         return $ w & pointerToItem itm . itUse . useToggle .~ not b
     | isJust $ itm ^? itType . ibtEquip
       , pt == 0
-      , Just invid' <- itm ^? itLocation . ilInvID =
-        return $ toggleEquipmentAt invid' cr w
+      , Just invid <- itm ^? itLocation . ilInvID =
+        return $ toggleEquipmentAt invid cr w
     | otherwise = (\loc' -> useItemLoc cr loc' pt w) =<< locUp' loc
   where
     aimuse 
@@ -62,50 +64,50 @@ activateDetonator det = fromMaybe id $ do
     pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
 
-toggleEquipmentAt :: Int -> Creature -> World -> World
-toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
+toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
+toggleEquipmentAt invid cr w = case equipmentDesignation invid w of
     DoNotMoveEquipment -> w
     PutOnEquipment{_allocNewPos = newp} ->
         w
-            & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
-            & onequip itm cr
+            & toequipment . at newp ?~ NInt itid
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & effectOnEquip itm cr
     MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
-            & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crEquipment . at oldp .~ Nothing
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
+            & toequipment . at newp ?~ NInt itid
+            & toequipment . at oldp .~ Nothing
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
     SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
         w
-            & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crEquipment . at oldp ?~ sid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
-            & crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
+            & toequipment . at newp ?~ NInt itid
+            & toequipment . at oldp ?~ sid
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix (_unNInt sid) . itLocation . ilEquipSite ?~ oldp
     ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
         w
-            & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
-            & crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
-            & onremove (itmat rid) cr
-            & onequip itm cr
+            & toequipment . at newp ?~ NInt itid
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix (_unNInt rid) . itLocation . ilEquipSite .~ Nothing
+            & effectOnRemove (itmat rid) cr
+            & effectOnEquip itm cr
     RemoveEquipment{_allocOldPos = oldp} ->
         w
-            & crpoint . crEquipment . at oldp .~ Nothing
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
-            & onremove itm cr
+            & toequipment . at oldp .~ Nothing
+            & toitems . ix itid . itLocation . ilEquipSite .~ Nothing
+            & effectOnRemove itm cr
   where
-    crpoint = cWorld . lWorld . creatures . ix (_crID cr)
-    itmat i = _crInv cr IM.! i
-    itm = itmat invid
-    onequip itm' = effectOnEquip itm'
-    onremove itm' = effectOnRemove itm'
+    toitems = cWorld . lWorld . items
+    itid = cr ^?! crInv . ix invid
+    toequipment = cWorld . lWorld . creatures . ix (_crID cr) . crEquipment
+    itmat i = w ^?! cWorld . lWorld . items . ix (_unNInt i)
+    itm = w ^?! cWorld . lWorld . items . ix itid
 
 toggleExamineInv :: World -> World
-toggleExamineInv w = case w ^? hud . hudElement . subInventory of
-    Just ExamineInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
-    _ -> w & hud . hudElement . subInventory .~ ExamineInventory
+toggleExamineInv w = case w ^? hud . subInventory of
+    Just ExamineInventory{} -> w & hud . subInventory .~ NoSubInventory
+    _ -> w & hud . subInventory .~ ExamineInventory
 
 toggleMapperInv :: Item -> World -> World
-toggleMapperInv itm w = case w ^? hud . hudElement . subInventory of
-    Just MapperInventory{} -> w & hud . hudElement . subInventory .~ NoSubInventory
-    _ -> w & hud . hudElement . subInventory .~ MapperInventory 0 1 (_itID itm)
+toggleMapperInv itm w = case w ^? hud . subInventory of
+    Just MapperInventory{} -> w & hud . subInventory .~ NoSubInventory
+    _ -> w & hud . subInventory .~ MapperInventory 0 1 (_itID itm)

src/Dodge/Creature/Inanimate.hs

@@ -11,7 +11,7 @@ module Dodge.Creature.Inanimate (
 import Dodge.Creature.Lamp
 import Dodge.Data.Creature
 import Dodge.Default
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import LensHelp
 
 barrel :: Creature
@@ -19,7 +19,7 @@ barrel =
     defaultInanimate
         { _crHP = 500
         , _crType = BarrelCrit PlainBarrel
-        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+--        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 
 explosiveBarrel :: Creature
@@ -27,6 +27,6 @@ explosiveBarrel =
     defaultInanimate
         { _crHP = 400
         , _crType = BarrelCrit (ExplosiveBarrel [])
-        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+--        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 --        & crMaterial .~ Crystal

src/Dodge/Creature/LauncherCrit.hs

@@ -2,18 +2,18 @@ module Dodge.Creature.LauncherCrit (
     launcherCrit,
 ) where
 
-import Dodge.Item.Held.Launcher
+--import Dodge.Item.Held.Launcher
 --import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import Picture
 
 launcherCrit :: Creature
 launcherCrit =
     defaultCreature
-        { _crInv = IM.fromList [(0, rLauncher)]
-        , _crHP = 300
+        { -- _crInv = IM.fromList [(0, rLauncher)]
+         _crHP = 300
         }
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ LauncherAI

src/Dodge/Creature/LtAutoCrit.hs

@@ -5,15 +5,15 @@ module Dodge.Creature.LtAutoCrit (
 --import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Held.Stick
-import qualified IntMapHelp as IM
+--import Dodge.Item.Held.Stick
+--import qualified IntMapHelp as IM
 --import Picture
 
 ltAutoCrit :: Creature
 ltAutoCrit =
     defaultCreature
-        { _crInv = IM.fromList [(0, autoPistol)]
-        , _crHP = 500
+        { --_crInv = IM.fromList [(0, autoPistol)]
+         _crHP = 500
         }
 --        & crType .~ LtAutoCrit
 --        & crType . humanoidAI .~ LtAutoAI

src/Dodge/Creature/Picture.hs

@@ -9,7 +9,9 @@ module Dodge.Creature.Picture (
     deadFeet,
 ) where
 
+import Dodge.Data.Equipment.Misc
 import Dodge.Creature.HandPos
+import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Dodge.Creature.Radius
 import Dodge.Creature.Shape
@@ -25,8 +27,8 @@ import Shape
 --import Shape
 import ShapePicture
 
-basicCrPict :: Creature -> SPic
-basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
+basicCrPict :: IM.IntMap Item -> Creature -> SPic
+basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
 
 crCamouflage :: Creature -> CamouflageStatus
 crCamouflage _ = FullyVisible
@@ -90,7 +92,7 @@ deadRot cr = overPosSH (Q.rotateToZ d)
 
 scalp :: Creature -> Shape
 {-# INLINE scalp #-}
-scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
+scalp cr = overPosSH (translateToES cr OnHead) fhead
 --    | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
 --    | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
 --    | otherwise = translateSHxy 2.5 0 fhead
@@ -99,15 +101,7 @@ scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
 
 torso :: Creature -> Shape
 {-# INLINE torso #-}
-torso cr = overPosSH (\p -> fst $ (backPQ cr `Q.comp` (p,Q.qID))) tsh
---    | oneH cr = rotateSH 0.5 tsh
---    | twists cr =
---        translateSHxy 0 3 . rotateSH (-1.3) $ tsh
-----            mconcat
-----                [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
-----                , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
-----                ]
---    | otherwise = tsh
+torso cr = overPosSH (translateToES cr OnBack) tsh
   where
     tsh = 
         mconcat
@@ -130,6 +124,6 @@ upperBody cr = arms cr <> shoulderSH (torso cr)
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
 
-drawEquipment :: Creature -> SPic
+drawEquipment :: IM.IntMap Item -> Creature -> SPic
 {-# INLINE drawEquipment #-}
-drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
+drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)

src/Dodge/Creature/PistolCrit.hs

@@ -1,19 +0,0 @@
-module Dodge.Creature.PistolCrit (
-    pistolCrit,
-) where
-
---import Control.Lens
-import Dodge.Data.Creature
-import Dodge.Default
-import Dodge.Item.Held.Stick
-import qualified IntMapHelp as IM
---import Picture
-
-pistolCrit :: Creature
-pistolCrit =
-    defaultCreature
-        { _crInv = IM.fromList [(0, pistol)]
-        , _crHP = 500
-        }
---        & crType . humanoidAI .~ PistolAI
---        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/SpreadGunCrit.hs

@@ -5,15 +5,14 @@ module Dodge.Creature.SpreadGunCrit (
 --import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import Dodge.Item.Held.Stick
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import Picture
 
 spreadGunCrit :: Creature
 spreadGunCrit =
     defaultCreature
-        { _crInv = IM.fromList [(0, bangStick 6)]
-        , _crHP = 500
+        { --_crInv = IM.fromList [(0, bangStick 6)]
+         _crHP = 500
         }
 --        & crType . humanoidAI .~ SpreadGunAI
 --        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/State.hs

@@ -4,6 +4,7 @@ module Dodge.Creature.State (
     invItemEffs,
 ) where
 
+import NewInt
 import Control.Applicative
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -53,7 +54,7 @@ applyPastDamages cr w
   where
     dojitter x y =
         let (p, g) = runState (randInCirc x) (_randGen w)
-         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p
+         in w & cWorld . lWorld . creatures . ix (_crID cr) %~ crMvBy p (w ^. cWorld . lWorld)
                 & cWorld . lWorld . creatures . ix (_crID cr) . crPain -~ y
                 & randGen .~ g
 
@@ -64,7 +65,7 @@ invItemEffs cid w = fromMaybe w $ do
     return . appEndo (
         foldMap
             (reduceLocDT (Endo . invItemLocUpdate cr) . LocDT TopDT)
-            (invDT' (_crInv cr))) $ w
+            (invDT' $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) (_crInv cr))) $ w
 
 invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World
 invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of
@@ -131,8 +132,8 @@ copierItemUpdate itm cr w = fromMaybe w $ do
     x <- itm ^? itScroll . itsInt
     invid <- itm ^? itLocation . ilInvID
     ip <- itm ^? itType . ibtPathing
-    i <- getInventoryPath x ip invid cr
-    itm' <- cr ^? crInv . ix i
+    i <- getInventoryPath x ip (_unNInt invid) cr
+    itm' <- cr ^? crInv . ix (NInt i) >>= \k -> w ^? cWorld . lWorld . items . ix k
     v <- getItemValue itm' w cr
     return $ w & pointerToItem itm . itUse . uValue .~ v
 
@@ -149,27 +150,27 @@ tryUseParent loc w = fromMaybe w $ do
 tryDrawToCapacitor :: LocationDT OItem -> World -> World
 tryDrawToCapacitor loc w = fromMaybe w $ do
     itm <- loc ^? locDT . dtValue . _1
-    i <- itm ^? itLocation . ilInvID
+    i <- itm ^? itID . unNInt
     x <- loc ^? locDT . dtValue . _1 . itConsumables . _Just
     guard $ x < 200
     bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
-    j <- bat ^? itLocation . ilInvID
+    j <- bat ^? itID . unNInt
     y <- bat ^? itConsumables . _Just
     let z = min y 10
     return $ w
         & invpoint . ix i . itConsumables . _Just +~ z
         & invpoint . ix j . itConsumables . _Just -~ z
   where
-    invpoint = cWorld . lWorld . creatures . ix 0 . crInv
+    invpoint = cWorld . lWorld . items
 
 trySynthBullet :: LocationDT OItem -> World -> World
 trySynthBullet loc w = fromMaybe w $ do
-    i <- itm ^? itLocation . ilInvID
+    i <- itm ^? itID . unNInt
     x <- itm ^? itUse . uaParams . apInt
     if x < 100
         then do
             bat <- loc ^? locDT . dtLeft . ix 0 . dtValue . _1
-            j <- bat ^? itLocation . ilInvID
+            j <- bat ^? itID . unNInt
             y <- bat ^. itConsumables
             guard $ y > 0
             return $ w
@@ -177,7 +178,7 @@ trySynthBullet loc w = fromMaybe w $ do
                     & invpoint . ix j . itConsumables . _Just -~ 1
         else do
             mag <- loc ^? locDtContext . cdtParent . _1
-            j <- mag ^? itLocation . ilInvID
+            j <- mag ^? itID . unNInt
             y <- mag ^. itConsumables
             ymax <- maxAmmo mag
             guard $ y < ymax
@@ -186,7 +187,7 @@ trySynthBullet loc w = fromMaybe w $ do
                     & invpoint . ix j . itConsumables . _Just +~ 1
   where
     itm = loc ^. locDT . dtValue . _1
-    invpoint = cWorld . lWorld . creatures . ix 0 . crInv
+    invpoint = cWorld . lWorld . items
 
 drawARHUD :: LocationDT OItem -> World -> World
 drawARHUD (LocDT con _) w = fromMaybe w $ do
@@ -202,13 +203,12 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft)
     i <- mag ^. dtValue . _1 . itConsumables
     guard $ i >= x
-    maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID
+    magitid <- mag ^? dtValue . _1 . itID . unNInt
     return $
         w
             & worldEventFlags . at InventoryChange ?~ ()
-            & cWorld . lWorld . creatures . ix (_crID cr)
-                . crInv
-                . ix maginvid
+            & cWorld . lWorld . items
+                . ix magitid
                 . itConsumables
                 . _Just
                 -~ x
@@ -230,9 +230,8 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d
     pos = _crPos cr + xyV3 (rotate3 cdir p)
     cdir = _crDir cr
     itm = itmtree ^. dtValue . _1
-    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
-    cid = _crID cr
-    invid = _ilInvID $ _itLocation itm
+    pointittarg = cWorld . lWorld . items . ix itid . itTargeting
+    itid = itm ^. itID . unNInt
     col = blue -- mixColors reloadFrac (1-reloadFrac) blue red
 
 shineTorch :: Creature -> LocationDT OItem -> World -> World
@@ -241,10 +240,10 @@ shineTorch cr loc = fromMaybe id $ do
     i <- mag ^. dtValue . _1 . itConsumables
     guard $ crIsAiming cr
     guard $ i >= x
-    invid <- mag ^? dtValue . _1 . itLocation . ilInvID
+    itid <- mag ^? dtValue . _1 . itID . unNInt
     return $
         (cWorld . lWorld . lights .:~ LSParam pos 250 0.7)
-            . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x)
+            . (cWorld . lWorld . items . ix itid . itConsumables . _Just -~ x)
   where
     itmtree = loc ^. locDT
     (p, q) = locOrient loc cr
@@ -281,9 +280,8 @@ updateItemTargeting tt cr itm w = case tt of
                     Nothing
                     True
   where
-    pointittarg = cWorld . lWorld . creatures . ix cid . crInv . ix invid . itTargeting
-    cid = _crID cr
-    invid = _ilInvID $ _itLocation itm
+    pointittarg = cWorld . lWorld . items . ix itid . itTargeting
+    itid = itm ^. itID . unNInt
     isattached = itm ^?! itLocation . ilIsAttached
     rbpressed = SDL.ButtonRight `M.member` _mouseButtons (_input w)
 

src/Dodge/Creature/Statistics.hs

@@ -6,10 +6,15 @@ module Dodge.Creature.Statistics (
     crIntelligence,
 ) where
 
+import Dodge.Data.Equipment.Misc
+import qualified Data.Map.Strict as M
+import NewInt
+import Dodge.Data.LWorld
 import Data.Maybe
-import Dodge.Data.Creature
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
+import qualified Data.IntMap.Strict as IM
 import LensHelp
+import qualified Data.IntSet as IS
 
 crDexterity :: Creature -> Int
 crDexterity cr = case cr ^. crType of
@@ -42,11 +47,11 @@ crIntelligence  cr = case cr ^. crType of
     LampCrit {} -> 0
     
 
-getCrMoveSpeed :: Creature -> Int
-getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
+getCrMoveSpeed :: LWorld -> Creature -> Int
+getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
 
-strFromEquipment :: Creature -> Int
-strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
+strFromEquipment :: LWorld -> Creature -> Int
+strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
 
 equipmentStrValue :: Item -> Int
 equipmentStrValue itm = case _itType itm of
@@ -54,14 +59,17 @@ equipmentStrValue itm = case _itType itm of
     EQUIP POWERLEGS -> 3
     _ -> 0
 
-crCurrentEquipment :: Creature -> IM.IntMap Item
-crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
+crCurrentEquipment :: LWorld -> Creature -> M.Map EquipSite Item
+crCurrentEquipment lw = fmap f . _crEquipment
+  where
+    f i = lw ^?! items . ix (_unNInt i)
 
-strFromHeldItem :: Creature -> Int
-strFromHeldItem cr = fromMaybe 0 $ do
-    Aiming <- cr ^? crStance . posture
-    i <- cr ^? crManipulation . manObject . imRootSelectedItem
-    fmap (negate . itemWeight) $ cr ^? crInv . ix i
+strFromHeldItem :: LWorld -> Creature -> Int
+strFromHeldItem lw cr = fromMaybe 0 $ do
+    Aiming {} <- cr ^? crStance . posture
+    is <- cr ^? crManipulation . manObject . imAttachedItems
+    let js = IM.elems $ IM.restrictKeys  (cr ^. crInv . unNIntMap) is
+    return . negate . sum . fmap itemWeight $ IM.restrictKeys (lw ^. items) $ IS.fromList js
 
 itemWeight :: Item -> Int
 itemWeight it = case it ^. itType of

src/Dodge/Creature/Test.hs

@@ -24,11 +24,11 @@ module Dodge.Creature.Test (
     crSafeDistFromTarg,
 ) where
 
-import Dodge.Item.Grammar
+import NewInt
+import qualified Data.IntMap.Strict as IM
 import Dodge.Creature.Radius
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.AimStance
-import Dodge.Item.AimStance
 import Control.Lens
 import Data.List (find)
 import Data.Maybe
@@ -87,18 +87,8 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
     sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False
 
---crCanShoot :: Creature -> Bool
---crCanShoot cr = crIsAiming cr && crWeaponReady cr
-
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr = crIsAiming cr && mitstance == Just as
-  where
-    mitstance = do
-        i <- cr ^? crManipulation . manObject . imRootSelectedItem
-        --itm <- invRootTrees' (cr ^. crInv) ^? ix i
-        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
-        return $ aimStance itm
-        --cr ^? crInv . ix i . itUse . heldAim . aimStance
+crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as
 
 oneH :: Creature -> Bool
 oneH = crInAimStance OneHand
@@ -112,20 +102,16 @@ twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
 -- Not sure if it is a good idea
-crIsArmouredFrom :: Point2 -> Creature -> Bool
-crIsArmouredFrom = hasFrontArmour
-
-hasFrontArmour :: Point2 -> Creature -> Bool
-hasFrontArmour p cr = fromMaybe False $ do
-    invid <- cr ^? crEquipment . ix OnChest
-    ittype <- cr ^? crInv . ix invid . itType
+crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
+crIsArmouredFrom m p cr = fromMaybe False $ do
+    NInt itid <- cr ^? crEquipment . ix OnChest
+    ittype <- m ^? ix itid . itType
     return $
         EQUIP FRONTARMOUR == ittype
             && p /= _crOldPos cr
             && angleVV (unitVectorAtAngle (_crDir cr + frontarmdirection)) (p -.- _crOldPos cr) < pi / 2
   where
     -- even though angleVV can generate NaN, the comparison seems to deal with it
-
     frontarmdirection
         | crInAimStance OneHand cr = 0.5
         | crInAimStance TwoHandUnder cr = negate 1

src/Dodge/Creature/Update.hs

@@ -1,5 +1,6 @@
 module Dodge.Creature.Update (updateCreature) where
 
+import NewInt
 import Color
 import qualified Data.IntMap.Strict as IM
 import qualified Data.List as List
@@ -61,7 +62,7 @@ crUpdate' f cr =
         . g
         . updateWalkCycle cid
   where
-    cid = (cr ^. crID)
+    cid = cr ^. crID
     g w' = maybe id f (w' ^? cWorld . lWorld . creatures . ix cid) w'
 
 checkDeath :: Int -> World -> World
@@ -99,7 +100,7 @@ destroyCreature cr
 
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World
-corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
+corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
     Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
     Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
     Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
@@ -116,7 +117,7 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 
 -- reverse keys, otherwise two or more inv items will cause errors
 dropAll :: Creature -> World -> World
-dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
 
 chasmTest :: Creature -> World -> World
 chasmTest cr w

src/Dodge/Creature/Volition.hs

@@ -6,6 +6,7 @@ module Dodge.Creature.Volition (
     shootFirstMiss,
 ) where
 
+import Dodge.Data.AimStance
 import Dodge.Data.Creature
 import Dodge.Data.CreatureEffect
 import Dodge.SoundLogic.LoadSound
@@ -13,7 +14,7 @@ import Geometry
 
 holsterWeapon, drawWeapon :: Action
 holsterWeapon = DoImpulses [ChangePosture AtEase, MakeSound whiteNoiseFadeOutS]
-drawWeapon = DoImpulses [ChangePosture Aiming, MakeSound whiteNoiseFadeInS]
+drawWeapon = DoImpulses [ChangePosture $ Aiming OneHand, MakeSound whiteNoiseFadeInS]
 
 shootTillEmpty :: Action
 --shootTillEmpty = (crCanShoot `DoActionWhile` DoImpulses [UseItem])

src/Dodge/Creature/YourControl.hs

@@ -1,19 +1,18 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Creature.YourControl (
-    yourControl,
-) where
+module Dodge.Creature.YourControl (yourControl) where
 
-import Dodge.Creature.MoveType
-import Dodge.Data.Equipment.Misc
 import Control.Monad
+import qualified Data.IntMap.Strict as IM
 import qualified Data.Map.Strict as M
 import Data.Maybe
+import Dodge.AssignHotkey
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
+import Dodge.Creature.MoveType
 import Dodge.Data.AimStance
+import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
-import Dodge.AssignHotkey
 import Dodge.InputFocus
 import Dodge.Inventory
 import Dodge.Item.AimStance
@@ -28,52 +27,59 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl _ w
     | inTextInputFocus w = w
-    | Just x <- w ^? hud . hudElement . subInventory
+    | Just x <- w ^? hud . subInventory
       , f x =
         w
             & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
             & tryClickUse pkeys
             & handleHotkeys
-    | otherwise =
-        w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
+    | otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
   where
-    f NoSubInventory = True
-    f ExamineInventory = True
-    f _ = False
+    f = \case
+        NoSubInventory -> True
+        ExamineInventory -> True
+        _ -> False
     pkeys = w ^. input . mouseButtons
 
+-- the following only works because modifier keys are ordered after scancode "hotkeys"
 handleHotkeys :: World -> World
 handleHotkeys w
     | ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
-      , Just hk <-
-            listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
+      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
       , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
-        w & cWorld . lWorld %~ assignHotkey itid hk
+      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
+        w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
     | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
-      , Just hk <-
-            listToMaybe . mapMaybe scancodeToHotkey . M.keys $
-                w ^. input . pressedKeys
+      , (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
       , Just itid <- lw ^? hotkeys . ix hk . unNInt
-      , Just invid <- lw ^? itemLocations . ix itid . ilInvID =
-        w & invSetSelectionPos 0 invid
+      , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
+        w & invSetSelectionPos 0 (_unNInt invid)
     | otherwise =
         M.foldl'
             useHotkey
             w
             (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
   where
+    pkeys = w ^. input . pressedKeys
     ispressed k = k `M.member` _pressedKeys (_input w)
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
     lw = w ^. cWorld . lWorld
 
+--modifierKeys :: S.Set SDL.Scancode
+--modifierKeys = S.fromList 
+--    [ SDL.ScancodeLShift
+--    , SDL.ScancodeRShift
+--    , SDL.ScancodeRCtrl
+--    , SDL.ScancodeLCtrl
+--    ]
+
 useHotkey :: World -> (NewInt ItmInt, Int) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
-    invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
+    invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
     useItem invid pt w
 
 hotkeyToScancode :: Hotkey -> SDL.Scancode
-hotkeyToScancode x = case x of
+hotkeyToScancode = \case
     HotkeyQ -> SDL.ScancodeQ
     HotkeyE -> SDL.ScancodeE
     HotkeyR -> SDL.ScancodeE
@@ -93,7 +99,7 @@ hotkeyToScancode x = case x of
     Hotkey0 -> SDL.Scancode0
 
 scancodeToHotkey :: SDL.Scancode -> Maybe Hotkey
-scancodeToHotkey x = case x of
+scancodeToHotkey = \case
     SDL.ScancodeQ -> Just HotkeyQ
     SDL.ScancodeE -> Just HotkeyE
     SDL.ScancodeR -> Just HotkeyR
@@ -117,7 +123,7 @@ scancodeToHotkey x = case x of
  within wasdMovement should probably be done first
 -}
 wasdWithAiming :: World -> Creature -> Creature
-wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
+wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
   where
     speed = _mvSpeed $ crMvType cr
     inp = w ^. input
@@ -127,31 +133,40 @@ wasdAim :: Input -> World -> Creature -> Creature
 wasdAim inp w cr
     | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
       , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
-        setAimPosture cr
-    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
-    | Aiming <- cr ^. crStance . posture = removeAimPosture cr
+        setAimPosture (w ^. cWorld . lWorld . items) cr
+    | SDL.ButtonRight `M.member` _mouseButtons inp =
+        aimTurn (w ^. cWorld . lWorld) mousedir cr
+    | Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
     | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
 
-setAimPosture :: Creature -> Creature
-setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
+setAimPosture :: IM.IntMap Item -> Creature -> Creature
+setAimPosture m cr = fromMaybe cr $ do
+    invid <- cr ^? crManipulation . manObject . imRootSelectedItem
+    itid <- cr ^? crInv . ix invid
+    as <- fmap itemBaseStance $ m ^? ix itid
+    return $ cr
+        & crStance . posture .~ Aiming as
+        & doAimTwist as (- twoHandTwistAmount)
 
-doAimTwist :: Float -> Creature -> Creature
-doAimTwist x cr = fromMaybe cr $ do
-    itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
-    astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
-    guard $ astance == TwoHandOver || astance == TwoHandUnder
-    return $ cr & crDir +~ x
+doAimTwist :: AimStance -> Float -> Creature -> Creature
+doAimTwist as x
+    | as == TwoHandOver || as == TwoHandUnder = crDir +~ x
+    | otherwise = id
 
 removeAimPosture :: Creature -> Creature
-removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
+removeAimPosture cr = fromMaybe cr $ do
+    as <- cr ^? crStance . posture . aimStance
+    return $ cr
+        & crStance . posture .~ AtEase
+        & doAimTwist as twoHandTwistAmount
 
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi
 
-wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
-wasdMovement inp cam speed = theMovement . setMvAim
+wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
+wasdMovement lw inp cam speed = theMovement . setMvAim
   where
     setMvAim = fromMaybe id $ do
         dir <- safeArgV movDir
@@ -160,14 +175,14 @@ wasdMovement inp cam speed = theMovement . setMvAim
     movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
     theMovement
         | movDir == V2 0 0 = id
-        | otherwise = crMvAbsolute (speed *.* movAbs)
+        | otherwise = crMvAbsolute lw (speed *.* movAbs)
 
-aimTurn :: Float -> Creature -> Creature
-aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
+aimTurn :: LWorld -> Float -> Creature -> Creature
+aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
   where
     x = fromMaybe 1 $ do
         itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
-        fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
+        fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
 
 itemBulkiness :: ItemType -> Float
 itemBulkiness = \case
@@ -227,6 +242,7 @@ tryClickUse pkeys w = fromMaybe w $ do
         ^? cWorld . lWorld . creatures . ix 0
             . crManipulation
             . manObject
-            . imSelectedItem of
+            . imSelectedItem
+            . unNInt of
         Just invid -> useItem invid ltime w
         Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w

src/Dodge/Data/AimStance.hs

@@ -1,6 +1,12 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.AimStance where
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
 
 data AimStance
     = TwoHandUnder
@@ -8,3 +14,6 @@ data AimStance
     | TwoHandFlat
     | OneHand
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+makeLenses ''AimStance
+deriveJSON defaultOptions ''AimStance

src/Dodge/Data/Button.hs

@@ -25,14 +25,13 @@ data ButtonEvent
         , _bsColor2 :: Color
         , _btOn :: Bool
         }
-    | ButtonAccessTerminal
+    | ButtonAccessTerminal {_btTermID :: Int}
 
 data Button = Button
     { _btPos :: Point2
     , _btRot :: Float
     , _btEvent :: ButtonEvent
     , _btID :: Int
-    , _btTermMID :: Maybe Int
     }
 
 makeLenses ''Button

src/Dodge/Data/CardinalPoint.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
 module Dodge.Data.CardinalPoint where
+import Control.Lens
 
 data CardinalPoint
     = North
@@ -23,3 +25,8 @@ data CardinalCover
     | NSE
     | NSW
     | NS
+
+data XInfinity a = NegInf | NonInf {_nonInf :: a} | PosInf
+    deriving (Eq, Ord, Show)
+
+makeLenses ''XInfinity

src/Dodge/Data/Config.hs

@@ -35,7 +35,7 @@ data NumShadowCasters
     | NumShadowCasters20
     deriving (Show,Eq,Bounded,Ord,Enum)
 
-data Configuration = Configuration
+data Config = Config
     { _volume_master :: Float
     , _volume_sound :: Float
     , _volume_music :: Float
@@ -58,9 +58,9 @@ data Configuration = Configuration
     }
     deriving (Show)
 
-windowXFloat :: Configuration -> Float
+windowXFloat :: Config -> Float
 windowXFloat = fromIntegral . _windowX
-windowYFloat :: Configuration -> Float
+windowYFloat :: Config -> Float
 windowYFloat = fromIntegral . _windowY
 
 data DebugBool
@@ -88,8 +88,8 @@ data DebugBool
     | Show_walls_near_point_you
     | Show_walls_near_segment
     | Show_zone_near_point_cursor
+    | Show_zone_circ
     | Inspect_wall
-    | Show_nodes_near_select
     | Show_path_between
     | Select_creature
     deriving (Eq, Ord, Bounded, Enum, Show)
@@ -124,9 +124,9 @@ applyResFactor  rf = case rf of
 --    EighthRes -> 8
 --    SixteenthRes -> 16
 
-defaultConfig :: Configuration
+defaultConfig :: Config
 defaultConfig =
-    Configuration
+    Config
         { _volume_master = 1
         , _volume_sound = 1
         , _volume_music = 0
@@ -148,13 +148,13 @@ defaultConfig =
         , _debug_view_clip_bounds = NoRoomClipBoundaries
         }
 
-debugOn :: DebugBool -> Configuration -> Bool
+debugOn :: DebugBool -> Config -> Bool
 debugOn db = S.member db . _debug_booleans
 
-makeLenses ''Configuration
+makeLenses ''Config
 deriveJSON defaultOptions ''NumShadowCasters
 deriveJSON defaultOptions ''ResFactor
 deriveJSON defaultOptions ''ShadowRendering
 deriveJSON defaultOptions ''RoomClipping
 deriveJSON defaultOptions ''DebugBool
-deriveJSON defaultOptions ''Configuration
+deriveJSON defaultOptions ''Config

src/Dodge/Data/Creature.hs

@@ -17,6 +17,7 @@ module Dodge.Data.Creature (
     module Dodge.Data.Item.Use.Consumption.LoadAction,
 ) where
 
+import NewInt
 import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.Equipment.Misc
 import Control.Lens
@@ -32,7 +33,7 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 
 data Creature = Creature
     { _crPos :: Point2
@@ -45,9 +46,9 @@ data Creature = Creature
     , _crType :: CreatureType
     , _crID :: Int
     , _crHP :: Int
-    , _crInv :: IM.IntMap Item
+    , _crInv :: NewIntMap InvInt Int
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite Int
+    , _crEquipment :: M.Map EquipSite (NewInt ItmInt)
     , _crDamage :: [Damage]
     , _crPain :: Int
     , _crStance :: Stance

src/Dodge/Data/Creature/Stance.hs

@@ -3,8 +3,12 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Creature.Stance where
+module Dodge.Data.Creature.Stance 
+    ( module Dodge.Data.Creature.Stance
+    , module Dodge.Data.AimStance
+    )where
 
+import Dodge.Data.AimStance
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -32,7 +36,7 @@ data FootForward = LeftForward | RightForward
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data Posture
-    = Aiming
+    = Aiming {_aimStance :: AimStance}
     | AtEase
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 

src/Dodge/Data/EquipType.hs

@@ -22,9 +22,9 @@ eitType = \case
     BRAINHAT -> GoesOnHead
     HAT -> GoesOnHead
     HEADLAMP -> GoesOnHead
-    POWERLEGS -> GoesOnLegs
-    SPEEDLEGS -> GoesOnLegs
-    JUMPLEGS -> GoesOnLegs
+    POWERLEGS -> GoesOnLeg
+    SPEEDLEGS -> GoesOnLeg
+    JUMPLEGS -> GoesOnLeg
     FUELPACK -> GoesOnBack
     BULLETBELTPACK -> GoesOnBack
     BULLETBELTBRACER -> GoesOnWrist

src/Dodge/Data/Equipment/Misc.hs

@@ -13,7 +13,7 @@ data EquipType
     | GoesOnChest
     | GoesOnBack
     | GoesOnWrist
-    | GoesOnLegs
+    | GoesOnLeg
     deriving (Eq, Ord, Show, Read)
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
@@ -24,8 +24,9 @@ data EquipSite
     | OnBack
     | OnLeftWrist
     | OnRightWrist
-    | OnLegs
-    | OnSpecial
+    | OnLeftLeg
+    | OnRightLeg
+--    | OnSpecial
     deriving (Eq, Ord, Show, Read)
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/FloorItem.hs

@@ -5,15 +5,14 @@
 
 module Dodge.Data.FloorItem where
 
-import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Item
+--import Dodge.Data.Item
 import Geometry.Data
 
 
-data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: NewInt FloorInt}
+data FloorItem = FlIt {_flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
     --deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''FloorItem

src/Dodge/Data/GenWorld.hs

@@ -29,7 +29,12 @@ data GenWorld = GenWorld
 ---- ROOM DATATYPES
 data PSType
     = PutCrit {_unPutCrit :: Creature}
-    | PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
+    | PutMachine
+        { _putMachinePoly :: [Point2]
+        , _putMachineMachine :: Machine
+        , _putMachineWall :: Wall
+        , _putMachineMaybeItem :: Maybe Item
+        }
     | PutLS LightSource
     | PutButton {_putButton :: Button}
     | PutProp Prop
@@ -107,7 +112,8 @@ data Room = Room
     , _rmPath :: S.Set (Point2, Point2)
     , _rmPmnts :: [Placement]
     , _rmInPmnt :: [InPlacement] 
-    , _rmOutPmnt :: [OutPlacement]
+    -- note that in placements form a list: multiple InPlacements can use the same id
+    , _rmOutPmnt :: IM.IntMap Placement
     , _rmBound :: [[Point2]]
     , _rmFloor :: Floor
     , _rmName :: String
@@ -124,13 +130,10 @@ data Room = Room
     , _rmClusterStatus :: ClusterStatus
     }
 
-data OutPlacement = OutPlacement
-    { _opPlacement :: Placement
-    , _opPlacementID :: Int
-    }
+--data OutPlacement = OutPlacement { _opPlacement :: Placement }
 
 data InPlacement = InPlacement
-    { _ipPlacement :: [Placement] -> Placement
+    { _ipPlacement :: World -> [Placement] -> Placement
     , _ipPlacementID :: Int
     }
 

src/Dodge/Data/HUD.hs

@@ -5,25 +5,13 @@
 
 module Dodge.Data.HUD where
 
-import qualified Data.IntSet as IS
-import Dodge.Data.Item.Location
-import NewInt
 import Control.Lens
-import Data.IntMap
-import Data.IntSet (IntSet)
+import qualified Data.IntSet as IS
 import Dodge.Data.Combine
+import Dodge.Data.Item.Location
 import Dodge.Data.SelectionList
 import Geometry.Data
-
-data HUDElement
-    = DisplayInventory
-        { _subInventory :: SubInventory
-        , _diSections :: IMSS ()
-        , _diSelection :: Maybe (Int, Int, IntSet)
-        , _diInvFilter :: Maybe String
-        , _diCloseFilter :: Maybe String
-        }
---    | DisplayCarte
+import NewInt
 
 data SubInventory
     = NoSubInventory
@@ -34,22 +22,27 @@ data SubInventory
         , _mapInvItmID :: NewInt ItmInt
         }
     | CombineInventory
-        { _ciSections :: IntMap (SelectionSection CombinableItem)
-        , _ciSelection :: Maybe (Int, Int, IS.IntSet)
+        { _ciSections :: IMSS CombinableItem
+        , _ciSelection :: Maybe Selection
         , _ciFilter :: Maybe String
         }
---    | LockedInventory
     | DisplayTerminal {_termID :: Int}
 
 data HUD = HUD
-    { _hudElement :: HUDElement
+    { _subInventory :: SubInventory
+    , _diSections :: IMSS ()
+    , _diSelection :: Maybe Selection
+    , _diInvFilter :: Maybe String
+    , _diCloseFilter :: Maybe String
     , _carteCenter :: Point2
     , _carteZoom :: Float
     , _carteRot :: Float
-    , _closeItems :: [NewInt FloorInt]
+    , _closeItems :: [NewInt ItmInt]
     , _closeButtons :: [Int]
     }
 
+data Selection = Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
+
 makeLenses ''HUD
-makeLenses ''HUDElement
+makeLenses ''Selection
 makeLenses ''SubInventory

src/Dodge/Data/Input.hs

@@ -5,6 +5,7 @@
 
 module Dodge.Data.Input where
 
+import Dodge.Data.Terminal.Status
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Geometry.Data
@@ -16,20 +17,16 @@ data MouseContext
     | MouseInGame
     | MouseMenuClick {_mcoMenuClick :: Int}
     | MouseMenuCursor
-    | OverInvDrag {_mcoDragSection :: Int
-        , _mcoMaybeSelect :: Maybe (Int,Int)
-        , _mcoAboveSelect :: Maybe (Int,Int)
-        , _mcoBelowSelect :: Maybe (Int,Int)
-        }
-    | OverInvDragSelect { _mcoSecSelStart :: (Int,Int), _mcoSelEnd :: Maybe Int }
+    | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
+    | OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverCombFiltInv { _mcoInvFilt :: (Int,Int)}
     | OverCombSelect { _mcoCombSelect :: (Int,Int)}
     | OverCombCombine { _mcoCombCombine :: (Int,Int)}
     | OverCombFilter
     | OverCombEscape
-    | OverTerminalReturn {_mcoTermID :: Int}
-    | OverTerminalEscape
+    | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
+    | OutsideTerminal
     | MouseGameRotate
     deriving (Show)
 

src/Dodge/Data/Item.hs

@@ -3,7 +3,6 @@
 
 module Dodge.Data.Item (
     module Dodge.Data.Item,
-    --module Dodge.Data.Item.Effect,
     module Dodge.Data.Item.Misc,
     module Dodge.Data.Item.Params,
     module Dodge.Data.Item.Use,
@@ -12,30 +11,18 @@ module Dodge.Data.Item (
     module Dodge.Data.Item.Location,
 ) where
 
-import Geometry.Data
---import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.Item.Combine
---import Dodge.Data.Item.Effect
 import Dodge.Data.Item.Location
 import Dodge.Data.Item.Misc
 import Dodge.Data.Item.Params
 import Dodge.Data.Item.Scope
 import Dodge.Data.Item.Use
+import Geometry.Data
 import NewInt
 
-data ItID = ItID 
-    deriving (Eq, Ord, Show, Read)
-
---data Consumables
---    = NoConsumables
---    | AmmoMag
---        { _magLoadStatus :: ReloadStatus
---        }
---    deriving (Eq, Show, Read)
-
 data Item = Item
     { _itUse :: ItemUse
     , _itConsumables :: Maybe Int
@@ -53,7 +40,8 @@ data ItemScroll
     | ItemScrollInt {_itsInt :: Int}
     | ItemScrollIntRange {_itsMax :: Int, _itsRangeInt :: Int}
 
-data ItemTargeting = NoItTargeting
+data ItemTargeting
+    = NoItTargeting
     | ItTargeting
         { _itTgPos :: Maybe Point2
         , _itTgID :: Maybe Int
@@ -61,11 +49,8 @@ data ItemTargeting = NoItTargeting
         }
 
 makeLenses ''ItemTargeting
---makeLenses ''Consumables
 makeLenses ''Item
 makeLenses ''ItemScroll
 deriveJSON defaultOptions ''ItemScroll
---deriveJSON defaultOptions ''Consumables
 deriveJSON defaultOptions ''ItemTargeting
-deriveJSON defaultOptions ''ItID
 deriveJSON defaultOptions ''Item

src/Dodge/Data/Item/Location.hs

@@ -5,17 +5,15 @@
 {-# LANGUAGE EmptyDataDeriving #-}
 module Dodge.Data.Item.Location where
 
+import NewInt
+import ShortShow
 import Dodge.Data.Equipment.Misc
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import NewInt
 
 -- it would be nice to have these as empty types, but I'm not sure how to get
 -- aeson to handle that
-data FloorInt = FloorInt
-  deriving (Eq,Ord,Show,Read)
--- should use these..
 data InvInt = InvInt
   deriving (Eq,Ord,Show,Read)
 data TurretInt
@@ -28,20 +26,29 @@ data ItmInt = ItmInt
 data ItemLocation
     = InInv 
         { _ilCrID :: Int
-        , _ilInvID :: Int
+        , _ilInvID :: NewInt InvInt
         , _ilIsRoot :: Bool -- of any item
         , _ilIsSelected :: Bool
         , _ilIsAttached :: Bool -- to selected item
         , _ilEquipSite :: Maybe EquipSite
         }
     | OnTurret {_ilTuID :: Int}
-    | OnFloor {_ilFlID :: NewInt FloorInt}
+    | OnFloor-- {_ilFlID :: NewInt FloorInt}
     | InVoid
     deriving (Eq, Show, Ord, Read) --Generic, Flat)
 
+instance ShortShow ItemLocation where
+    shortShow (InInv cid invid rootb selb attb esite)
+        = "InInv:cid" <> shortShow cid <> "invid"<> shortShow (_unNInt invid)
+            <>"root"<>shortShow rootb<>"sel"<>shortShow selb<>"att"<>shortShow attb<>
+            shortShow (fmap (SString . show) esite)
+    shortShow x = show x
+--    | OnTurret {_ilTuID :: Int}
+--    | OnFloor-- {_ilFlID :: NewInt FloorInt}
+--    | InVoid
+
 makeLenses ''ItemLocation
 deriveJSON defaultOptions ''InvInt
-deriveJSON defaultOptions ''FloorInt
 deriveJSON defaultOptions ''ItemLocation
 deriveJSON defaultOptions ''ItmInt
 deriveJSON defaultOptions ''CrInt

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

@@ -5,6 +5,8 @@
 
 module Dodge.Data.Item.Use.Consumption.LoadAction where
 
+import Dodge.Data.Item.Location
+import NewInt
 import qualified Data.IntSet as IS
 import Control.Lens
 import Data.Aeson
@@ -20,9 +22,9 @@ data Manipulation -- should be ManipulatedObject?
 data ManipulatedObject
     = SortInventory
     | SelectedItem
-        { _imSelectedItem :: Int
-        , _imRootSelectedItem :: Int
-        , _imAttachedItems :: IS.IntSet
+        { _imSelectedItem :: NewInt InvInt
+        , _imRootSelectedItem :: NewInt InvInt
+        , _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
         }    
     | SelNothing
     | SortCloseItem

src/Dodge/Data/LWorld.hs

@@ -99,7 +99,7 @@ import Picture.Data
 data LWorld = LWorld
     { _creatures :: IM.IntMap Creature
     , _creatureGroups :: IM.IntMap CrGroupParams
-    , _itemLocations :: IM.IntMap ItemLocation
+    , _items :: IM.IntMap Item
     , _clouds :: [Cloud]
     , _dusts :: [Dust]
     , _gusts :: IM.IntMap Gust
@@ -131,7 +131,7 @@ data LWorld = LWorld
     , _blocks :: IM.IntMap Block
     , _coordinates :: IM.IntMap Point2
     , _triggers :: IM.IntMap Bool
-    , _floorItems :: NewIntMap FloorInt FloorItem
+    , _floorItems :: IM.IntMap FloorItem
     , _modifications :: IM.IntMap Modification
     , _worldEvents :: [WdWd]
     , _delayedEvents :: [(Int, WdWd)]

src/Dodge/Data/Machine.hs

@@ -55,7 +55,7 @@ data MachineType
     --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data Turret = Turret
-    { _tuWeapon :: Item
+    { _tuWeapon :: Int
     , _tuTurnSpeed :: Float
     , _tuFireTime :: Int
     , _tuDir :: Float

src/Dodge/Data/Machine/Sensor.hs

@@ -36,7 +36,6 @@ data Sensor
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}
     | RequireEquipment {_proxReqEquipment :: ItemType}
-    | RequireImpossible
     deriving (Show)
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/RightButtonOptions.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
@@ -9,17 +9,16 @@ import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Dodge.Data.Equipment.Misc
+import Dodge.Data.Item.Location
+import NewInt
 
-data RightButtonOptions
-    = NoRightButtonOptions
+data RightButtonState
+    = NoRightButtonState
     | EquipOptions {_opSel :: Int}
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data EquipmentAllocation
     = DoNotMoveEquipment
-    | PutOnEquipment
-        { _allocNewPos :: EquipSite
-        }
+    | PutOnEquipment {_allocNewPos :: EquipSite}
     | MoveEquipment
         { _allocNewPos :: EquipSite
         , _allocOldPos :: EquipSite
@@ -27,18 +26,15 @@ data EquipmentAllocation
     | SwapEquipment
         { _allocNewPos :: EquipSite
         , _allocOldPos :: EquipSite
-        , _allocSwapID :: Int
+        , _allocSwapID :: NewInt ItmInt
         }
     | ReplaceEquipment
         { _allocNewPos :: EquipSite
-        , _allocRemoveID :: Int
+        , _allocRemoveID :: NewInt ItmInt
         }
-    | RemoveEquipment
-        { _allocOldPos :: EquipSite
-        }
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
+    | RemoveEquipment {_allocOldPos :: EquipSite}
 
-makeLenses ''RightButtonOptions
+makeLenses ''RightButtonState
 makeLenses ''EquipmentAllocation
 deriveJSON defaultOptions ''EquipmentAllocation
-deriveJSON defaultOptions ''RightButtonOptions
+deriveJSON defaultOptions ''RightButtonState

src/Dodge/Data/RoomCluster.hs

@@ -7,8 +7,7 @@ import Control.Lens
 import qualified Data.Set as S
 
 data ClusterStatus = ClusterStatus
-    { _csName :: String
-    , _csLinks :: S.Set ClusterLink
+    { _csLinks :: S.Set ClusterLink
     }
 
 data ClusterLink = OnwardCluster | SideCluster | LabelCluster Int

src/Dodge/Data/SelectionList.hs

@@ -36,27 +36,17 @@ data SelectionSection a = SelectionSection
 
 type IMSS a = IntMap (SelectionSection a)
 
-data SelectionWidth
-    = FixedSelectionWidth Int
-    | UseItemWidth
+data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
 
 data SelectionItem a
-    = SelectionItem
-        { _siPictures :: [String]
-        , _siHeight :: Int
-        , _siWidth :: Int
-        , _siIsSelectable :: Bool
-        , _siColor :: Color
-        , _siOffX :: Int
-        , _siPayload :: a
-        }
-    | SelectionInfo
+    = SelItem
         { _siPictures :: [String]
         , _siHeight :: Int
         , _siWidth :: Int
         , _siIsSelectable :: Bool
         , _siColor :: Color
         , _siOffX :: Int
+        , _siPayload :: Maybe a
         }
 
 makeLenses ''ListDisplayParams

src/Dodge/Data/SoundOrigin.hs

@@ -34,7 +34,7 @@ data SoundOrigin
     | GlassBreakSound Int
     | MaterialSound Material Int
     | TeleSound Int
-    | LeverSound Int
+    | ButtonSound Int
     | Explosion Int
     | Tap Int
     | EBSound Int

src/Dodge/Data/Terminal.hs

@@ -8,8 +8,6 @@ module Dodge.Data.Terminal (
     module Dodge.Data.Terminal.Status,
 ) where
 
-import Dodge.Data.Machine.Sensor.Type
-import Sound.Data
 import Color
 import Control.Lens
 import Data.Aeson
@@ -18,10 +16,7 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.BlBl
 import Dodge.Data.Terminal.Status
 import Dodge.Data.WorldEffect
-
---data TerminalInput = TerminalInput
---    { _tiSel :: (Int, Int)
---    }
+import Sound.Data
 
 data Terminal = Terminal
     { _tmID :: Int
@@ -36,7 +31,6 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
---    , _tmPartialCommand :: Maybe TerminalCommand
     }
 
 data TerminalLineString = TerminalLineConst String Color
@@ -52,59 +46,24 @@ data TerminalToggle = TerminalToggle
     , _ttDeathEffect :: BlBl
     }
 
-data EffectArguments
-    = NoArguments {_cmdEffect :: [TerminalLine]}
-    | OneArgument
-        { _argType :: String
-        , _argList :: M.Map String [TerminalLine]
-        }
-
-data TerminalCommandEffect
-    = TerminalCommandArguments EffectArguments
-    | TerminalCommandEffectDamageCoding
-    | TerminalCommandEffectSensorParameter
-    | TerminalCommandEffectLinkedObject
-    | TerminalCommandEffectHelp
-    | TerminalCommandEffectNoArgumentsStr String
-    | TerminalCommandEffectCommands
-    | TerminalCommandEffectSingleCommand WdWd [String]
-    | TerminalCommandEffectNone
-
---data TerminalCommand = TerminalCommand
---    { _tcString :: String
---    , _tcAlias :: [String]
---    , _tcHelp :: String
---    , _tcEffect :: TerminalCommandEffect -- Terminal -> World -> EffectArguments
---    }
-
-data TCom = TCInfo String String
+data TCom
+    = TCInfo String String -- this may not be necessary, to revisit
     | TCBase
     | TCDamageCommand
-    | TCSensorInfo
-    | TCToggles
-
---data TEff = TEff
---    { _teffHelp :: String
---    , _teffArgs :: PTE.TrieMap Char [TerminalLine]
---    }
 
 data TmWdWd
     = TmWdId
-    | TmWdWdDisconnectTerminal
+    | TmWdWdPowerDownTerminal
+    | TmWdWdDeactivateTerminal
     | TmWdWdfromWdWd WdWd
     | TmWdWdTermSound SoundID
     | TmWdWdDoDeathTriggers
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
-    | TmGetDamageCoding SensorType
-    | TmGetSensor String
---    | TmDisplayCommands
 
 makeLenses ''Terminal
 makeLenses ''TerminalLine
 makeLenses ''TerminalToggle
-makeLenses ''EffectArguments
---makeLenses ''TerminalCommand
 makeLenses ''TCom
 concat
     <$> mapM
@@ -112,9 +71,6 @@ concat
         [ ''TerminalLineString
         , ''TerminalLine
         , ''TerminalToggle
-        , ''EffectArguments
-        , ''TerminalCommandEffect
---        , ''TerminalCommand
         , ''TCom
         , ''TmWdWd
         , ''Terminal

src/Dodge/Data/Terminal/Status.hs

@@ -9,10 +9,12 @@ import Data.Aeson.TH
 
 data TerminalStatus
     = TerminalOff
-    | TerminalBusy
+    | TerminalDeactivated
+    | TerminalLineRead
     | TerminalTextInput {_tiText :: String}
     | TerminalPressTo {_tptString :: String}
-    deriving (Eq)
+    | TerminalWaiting
+    deriving (Eq,Show)
 
 makeLenses ''TerminalStatus
 deriveJSON defaultOptions ''TerminalStatus

src/Dodge/Data/Universe.hs

@@ -34,7 +34,7 @@ data Universe = Universe
     , _uvScreenLayers :: [ScreenLayer]
     , _uvIOEffects :: Universe -> IO Universe
     , _uvSideEffects :: Seq SideEffect
-    , _uvConfig :: Configuration
+    , _uvConfig :: Config
     , _uvTestString :: Universe -> [String]
     , _uvCanContinue :: Bool
     , _uvMSeed :: Maybe Int
@@ -49,8 +49,8 @@ data Universe = Universe
     }
 
 data DebugItem = DebugItem
-    { _debugPic :: Universe -> Picture
-    , _debugMessage :: Universe -> [String]
+    { _debugPic :: Picture
+    , _debugMessage :: [String]
     , _debugInfo :: DebugInfo
     }
 

src/Dodge/Data/World.hs

@@ -41,7 +41,7 @@ data World = World
     , _playingSounds :: M.Map SoundOrigin Sound
     , _input :: Input
     , _testFloat :: Float
-    , _rbOptions :: RightButtonOptions
+    , _rbState :: RightButtonState
     , _hud :: HUD
     , _worldEventFlags :: Set WorldEventFlag
     , _crZoning :: IntMap (IntMap IntSet)

src/Dodge/Data/WorldEffect.hs

@@ -5,6 +5,8 @@
 
 module Dodge.Data.WorldEffect where
 
+import Dodge.Data.Item.Location
+import NewInt
 import Dodge.Data.LightSource
 import Data.Aeson
 import Data.Aeson.TH
@@ -20,9 +22,9 @@ data ItCrWdWd = ItCrWdItemHeldEffect
 data WdWd
     = NoWorldEffect
     | SetTrigger Bool Int
-    | WorldEffects [WdWd]
+    | WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
     | SetLSCol Point3 Int
-    | AccessTerminal (Maybe Int)
+    | AccessTerminal Int
     | UnlockInv
     | SoundStart SoundOrigin Point2 SoundID (Maybe Int)
     | MakeStartCloudAt Point3
@@ -31,7 +33,7 @@ data WdWd
 --    | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
     | MakeTempLight LSParam Int
     | UseInvItem Int Int -- invid presstime
-    | WdWdBurstFireRepetition Int Int
+    | WdWdBurstFireRepetition Int (NewInt InvInt)
     --deriving (Eq, Show, Read) --, Generic)
     --h--deriving (Eq, Show, Read) --Generic, Flat)
 

src/Dodge/Debug.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-module Dodge.Debug where
+module Dodge.Debug (debugEvents) where
 
 import Data.Aeson.Types
 import AesonHelp
@@ -15,59 +15,61 @@ import Dodge.WorldEvent.ThingsHit
 import Geometry.Vector
 import qualified SDL
 import Data.Ord
+import Data.Foldable (fold)
 
 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Enable_debug of
     Nothing -> u
-    Just () -> S.foldr debugEvent u dbools
+    Just () -> S.foldr debugEvent (u & uvDebug .~ mempty) dbools
   where
     dbools = u ^. uvConfig . debug_booleans
 
 debugEvent :: DebugBool -> Universe -> Universe
-debugEvent db u = u & uvDebug . at db .~ debugEvent' u db
---  case db of
---    Collision_test -> u & uvDebug . at Collision_test ?~ collisionDebugItem u
---    Circ_collision_test -> u & uvDebug . at Circ_collision_test ?~ circCollisionDebugItem u
---    Select_creature -> u & uvDebug . at Select_creature ?~ selectCreatureDebugItem u
---    _ -> u
+debugEvent db u = u & uvDebug . at db .~ debugItem db u
 
-debugEvent' :: Universe -> DebugBool -> Maybe DebugItem
-debugEvent' u = \case
-    Collision_test -> Just $ collisionDebugItem u
-    Circ_collision_test -> Just $ circCollisionDebugItem u
-    Select_creature -> Just $ selectCreatureDebugItem u
-    Show_walls_near_point_cursor -> Just 
-        (DebugItem (const $ drawWallsNearCursor w) (const mempty) NoDebugInfo)
-    Show_walls_near_segment -> Just 
-        (DebugItem (const $ drawWallsNearSegment w) (const mempty) NoDebugInfo)
-    _ -> Nothing
-  where
-    w = u ^. uvWorld
+debugItem :: DebugBool -> Universe -> Maybe DebugItem
+debugItem = \case
+    Collision_test -> constDPic (drawCollisionTest . _uvWorld)
+    Circ_collision_test -> constDPic (drawCircCollisionTest . _uvWorld)
+    Select_creature -> Just . selectCreatureDebugItem
+    Show_walls_near_point_cursor -> constDPic (drawWallsNearCursor . _uvWorld)
+    Show_walls_near_segment -> constDPic (drawWallsNearSegment . _uvWorld)
+    Enable_debug -> const Nothing
+    Noclip -> const Nothing
+    Remove_LOS -> const Nothing
+    Cull_more_lights -> const Nothing
+    Close_shape_culling -> const Nothing
+    Bound_box_screen -> const Nothing
+    Show_ms_frame -> const Nothing
+    View_boundaries -> constDPic (viewBoundaries . _uvWorld)
+    Show_bound_box -> constDPic (drawBoundingBox . _uvWorld)
+    Show_wall_search_rays -> constDPic $ drawWallSearchRays . _uvWorld
+    Show_dda_test -> constDPic $ drawDDATest . _uvWorld
+    Show_far_wall_detect -> constDPic $ drawFarWallDetect . _uvWorld
+    Show_walls_near_point_you -> constDPic $ drawWallsNearYou . _uvWorld
+    Show_zone_near_point_cursor -> constDPic $ drawZoneNearPointCursor . _uvWorld
+    Show_zone_circ -> constDPic $ drawZoneCirc . _uvWorld
+    Inspect_wall -> constDPic $ drawInspectWalls . _uvWorld
+    Cr_awareness -> constDPic $ drawCreatureDisplayTexts . _uvWorld
+    Show_sound ->  constDPic $ \u -> 
+        fold (M.map (soundPic (u ^. uvConfig) (u ^. uvWorld)) $ u ^. uvWorld . playingSounds)
+    Cr_status -> constDPic $ \u -> drawCrInfo (u ^. uvConfig) (u ^. uvWorld)
+    Mouse_position -> constDPic $ drawMousePosition . _uvWorld
+    Walls_info -> constDPic $ drawWlIDs . _uvWorld
+    Pathing -> constDPic $ \u ->  drawPathing (u ^. uvConfig) (u ^. uvWorld)
+    Show_path_between -> constDPic $ drawPathBetween . _uvWorld
 
-collisionDebugItem :: Universe -> DebugItem
-collisionDebugItem u =
-    DebugItem
-        { _debugPic = const $ drawCollisionTest $ u ^. uvWorld
-        , _debugMessage = const []
-        , _debugInfo = NoDebugInfo
-        }
+constDPic :: (Universe -> Picture) -> Universe -> Maybe DebugItem
+constDPic p u = Just $ DebugItem (p u) mempty NoDebugInfo
 
 selectCreatureDebugItem :: Universe -> DebugItem
 selectCreatureDebugItem u =
     DebugItem
-        { _debugPic = const mempty
-        , _debugMessage = debugSelectCreatureMessage
+        { _debugPic = mempty
+        , _debugMessage = debugSelectCreatureMessage u
         , _debugInfo = scrollDebugInfoInt (length $ debugSelectCreatureList 0 u) u $ clickGetCreature u
         }
 
-circCollisionDebugItem :: Universe -> DebugItem
-circCollisionDebugItem _ =
-    DebugItem
-        { _debugPic = drawCircCollisionTest . (^. uvWorld)
-        , _debugMessage = const []
-        , _debugInfo = NoDebugInfo
-        }
-
 scrollDebugInfoInt :: Int -> Universe -> DebugInfo -> DebugInfo
 scrollDebugInfoInt i u
     | SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =

src/Dodge/Debug/Picture.hs

@@ -4,7 +4,6 @@ module Dodge.Debug.Picture where
 import Control.Lens
 import Data.Foldable
 import qualified Data.Graph.Inductive as FGL
-import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Set as S
 import Dodge.Base
@@ -41,7 +40,7 @@ printRotPoint r p =
         . uncurryV translate p
         $ fold [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
 
-outsideScreenPolygon :: Configuration -> Camera -> [Point2]
+outsideScreenPolygon :: Config -> Camera -> [Point2]
 outsideScreenPolygon cfig w = [tr, tl, bl, br]
   where
     scRot = rotateV (w ^. camRot)
@@ -57,7 +56,7 @@ outsideScreenPolygon cfig w = [tr, tl, bl, br]
 
 -- cannot only test if walls are on screen, but also if they are on the cone
 -- towards the center of sight
-lineOnScreenCone :: Configuration -> World -> Point2 -> Point2 -> Bool
+lineOnScreenCone :: Config -> World -> Point2 -> Point2 -> Bool
 lineOnScreenCone cfig w p1 p2 =
     pointInPolygon p1 sp
         || pointInPolygon p2 sp
@@ -70,7 +69,7 @@ lineOnScreenCone cfig w p1 p2 =
         | otherwise = orderPolygon ((w ^. wCam . camViewFrom) : sp')
     sps = zip sp (tail sp ++ [head sp])
 
-drawWallFace :: Configuration -> World -> Wall -> Picture
+drawWallFace :: Config -> World -> Wall -> Picture
 drawWallFace cfig w wall
     | isRHS sightFrom x y || not (wlIsOpaque wall) = blank
     | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
@@ -79,7 +78,7 @@ drawWallFace cfig w wall
     points = extendConeToScreenEdge cfig w sightFrom (x, y)
     sightFrom = w ^. wCam . camViewFrom
 
-extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
+extendConeToScreenEdge :: Config -> World -> Point2 -> (Point2, Point2) -> [Point2]
 extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
   where
     borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y]
@@ -93,7 +92,7 @@ extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [
 -- the following assumes that the point a is inside the screen
 -- it still works otherwise, but it might intersect two points:
 -- it is not obvious which will be returned
-intersectLinefromScreen :: Configuration -> World -> Point2 -> Point2 -> Maybe Point2
+intersectLinefromScreen :: Config -> World -> Point2 -> Point2 -> Maybe Point2
 intersectLinefromScreen cfig w a b =
     listToMaybe
         . mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
@@ -106,9 +105,11 @@ drawCollisionTest w = concat $ do
     b <- w ^. input . heldWorldPos . at ButtonRight
     return $
         setLayer DebugLayer (color orange $ line [a, b])
-            <> foldMap (drawCrossCol red 
+            <> foldMap
+                ( drawCrossCol red
                     --                  . xyV3
-                    . fst) 
+                    . fst
+                )
                 --                (collide3 (v2z a 0) (v2z b 0) w)
                 --                (collide3Floors (v2z a 10) (v2z b (-10)) $ w ^. cWorld . chasms)
                 (thingHit a b w)
@@ -151,48 +152,47 @@ drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p :
         zipWith (+.+) (square 1) $
             map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]
 
-debugDraw :: Configuration -> World -> Picture
-{-# INLINE debugDraw #-}
-debugDraw cfig w
+showEnabledDebugs :: Config -> Picture
+{-# INLINE showEnabledDebugs #-}
+showEnabledDebugs cfig
     | Enable_debug `S.member` _debug_booleans cfig =
-        pic
-            <> setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
+        setLayer FixedCoordLayer (toTopLeft cfig (translate (0.5 * halfWidth cfig) 0 $ drawList $ map text ts))
     | otherwise = mempty
   where
-    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
+    --    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
     ts = map show (S.toList $ _debug_booleans cfig)
 
-debugDraw' :: Configuration -> World -> DebugBool -> Picture
-{-# INLINE debugDraw' #-}
-debugDraw' cfig w bl = case bl of
-    Enable_debug -> mempty
-    Noclip -> mempty
-    Remove_LOS -> mempty
-    Cull_more_lights -> mempty
-    Close_shape_culling -> mempty
-    Bound_box_screen -> mempty
-    Show_ms_frame -> mempty
-    View_boundaries -> viewBoundaries w
-    Show_bound_box -> drawBoundingBox w
-    Show_wall_search_rays -> drawWallSearchRays w
-    Show_dda_test -> drawDDATest w
-    Show_far_wall_detect -> drawFarWallDetect w
-    Show_walls_near_point_cursor -> mempty
-    Show_walls_near_segment -> mempty
-    Show_walls_near_point_you -> drawWallsNearYou w
-    Show_zone_near_point_cursor -> drawZoneNearPointCursor w
-    Inspect_wall -> drawInspectWalls w
-    Cr_awareness -> drawCreatureDisplayTexts w
-    Show_sound -> fold $ M.map (soundPic cfig w) $ _playingSounds w
-    Cr_status -> drawCrInfo cfig w
-    Mouse_position -> drawMousePosition w
-    Walls_info -> drawWlIDs w
-    Pathing -> drawPathing cfig w
-    Show_nodes_near_select -> undefined --drawNodesNearSelect w
-    Show_path_between -> drawPathBetween w
-    Collision_test -> mempty
-    Circ_collision_test -> mempty
-    Select_creature -> mempty
+--debugDraw' :: Config -> World -> DebugBool -> Picture
+--{-# INLINE debugDraw' #-}
+--debugDraw' cfig w bl = case bl of
+--    Enable_debug -> mempty
+--    Noclip -> mempty
+--    Remove_LOS -> mempty
+--    Cull_more_lights -> mempty
+--    Close_shape_culling -> mempty
+--    Bound_box_screen -> mempty
+--    Show_ms_frame -> mempty
+--    View_boundaries -> mempty
+--    Show_bound_box -> mempty
+--    Show_wall_search_rays -> mempty
+--    Show_dda_test -> mempty
+--    Show_far_wall_detect -> mempty
+--    Show_walls_near_point_cursor -> mempty
+--    Show_walls_near_segment -> mempty
+--    Show_walls_near_point_you -> drawWallsNearYou w
+--    Show_zone_near_point_cursor -> drawZoneNearPointCursor w
+--    Show_zone_circ -> drawZoneCirc w
+--    Inspect_wall -> drawInspectWalls w
+--    Cr_awareness -> drawCreatureDisplayTexts w
+--    Show_sound -> fold $ M.map (soundPic cfig w) $ _playingSounds w
+--    Cr_status -> drawCrInfo cfig w
+--    Mouse_position -> drawMousePosition w
+--    Walls_info -> drawWlIDs w
+--    Pathing -> drawPathing cfig w
+--    Show_path_between -> drawPathBetween w
+--    Collision_test -> mempty
+--    Circ_collision_test -> mempty
+--    Select_creature -> mempty
 
 drawCreatureDisplayTexts :: World -> Picture
 drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)
@@ -288,6 +288,17 @@ drawZoneNearPointCursor w =
     mwp = mouseWorldPos (w ^. input) (w ^. wCam)
     ps = [zoneOfPoint 50 mwp]
 
+drawZoneCirc :: World -> Picture
+drawZoneCirc w = concat $ do
+    a <- w ^. input . clickWorldPos . at ButtonLeft
+    b <- w ^. input . heldWorldPos . at ButtonLeft
+    let r = dist a b
+        ps = zoneOfCirc 50 a r
+    return $
+        setLayer DebugLayer (uncurryV translate a $ color red $ circle r)
+            <> setLayer DebugLayer (color green $ line [a, b])
+            <> foldMap (drawZoneCol orange 50) ps
+
 drawDDATest :: World -> Picture
 drawDDATest w =
     foldMap (drawZoneCol orange 50) ps
@@ -315,7 +326,7 @@ viewBoundaries w =
     p = w ^. wCam . camViewFrom
     grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w)
 
-viewClipBounds :: Configuration -> World -> Picture
+viewClipBounds :: Config -> World -> Picture
 viewClipBounds cfig w
     | _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
         setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_cwgRoomClipping $ _cwGen (_cWorld w))
@@ -338,7 +349,7 @@ drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
   where
     (x : xs) = w ^. wCam . camBoundBox
 
-soundPic :: Configuration -> World -> Sound -> Picture
+soundPic :: Config -> World -> Sound -> Picture
 soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
   where
     p = _soundPos s
@@ -382,14 +393,14 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
       where
         p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
 
-drawCrInfo :: Configuration -> World -> Picture
+drawCrInfo :: Config -> World -> Picture
 drawCrInfo cfig w =
     setLayer FixedCoordLayer $
         renderInfoListsAt (2 * hw - 400) 0 cfig cam $
             mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
   where
     cam = w ^. wCam
-    --    drawPathing :: Configuration -> World -> Picture
+    --    drawPathing :: Config -> World -> Picture
     --    drawPathing cfig w =
     --        setLayer DebugLayer $
     --            foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
@@ -424,7 +435,7 @@ drawCrInfo cfig w =
     fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
     hw = halfWidth cfig
 
-drawPathing :: Configuration -> World -> Picture
+drawPathing :: Config -> World -> Picture
 drawPathing cfig w =
     setLayer DebugLayer $
         foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)

src/Dodge/Debug/Terminal.hs

@@ -1,9 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TupleSections #-}
 
-module Dodge.Debug.Console where
+module Dodge.Debug.Terminal where
 
+import Dodge.Inventory
 import Data.Foldable
-import Dodge.Item.Location.Initialize
+--import Dodge.Item.Location.Initialize
 import Control.Applicative
 import Control.Lens
 --import Control.Monad
@@ -13,37 +15,37 @@ import Dodge.Creature
 import Dodge.Data.Universe
 import Dodge.Inventory.Add
 import Dodge.Item
---import Dodge.Menu.PushPop
-import qualified IntMapHelp as IM
 import LensHelp
 import MaybeHelp
 import Text.Read (readMaybe)
 
-applyConsoleString :: [String] -> Universe -> Universe
-applyConsoleString ss = case ss of
+applyTerminalString :: [String] -> Universe -> Universe
+applyTerminalString = \case
     [] -> id
-    [s] -> applyConsoleCommand s
-    (s : ss') -> applyConsoleCommandArguments s ss'
+    [s] -> applyTerminalCommand s
+    (s : ss') -> applyTerminalCommandArguments s ss'
 
-applyConsoleCommand :: String -> Universe -> Universe
-applyConsoleCommand s = case s of
+applyTerminalCommand :: String -> Universe -> Universe
+applyTerminalCommand s = case s of
     "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
-    ['L', x] ->
-            (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
-        . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
---            . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
---    ['I','S',x,y] ->  uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y]
-    "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Crystal
-    "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Flesh
-    x -> fromMaybe id $ do
+    "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial 
+        .~ Crystal
+    "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial 
+        .~ Flesh
+    "CLEAR" -> \uv -> uv & uvWorld %~ destroyAllInvItems 
+        (uv ^?! uvWorld . cWorld . lWorld . creatures . ix 0)
+    x -> fromMaybe (g x) $ do
         (ibt, n) <- parseItem [x]
-        return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
+        return $ uvWorld 
+            %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
+  where
+    g xs = uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX xs)
 
-applyConsoleCommandArguments :: String -> [String] -> Universe -> Universe
-applyConsoleCommandArguments command args u = case command of
+applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
+applyTerminalCommandArguments command args u = case command of
     "IT" -> fromMaybe u $ do
         (ibt, n) <- parseItem args
-        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
+        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
     "DEX" -> fromMaybe u $ do
         x <- readMaybe =<< args ^? _head
         return $ u & ypoint . crType . avDexterity .~ x
@@ -68,40 +70,40 @@ parseItem (x : xs) =
         <|> (readMaybe ("HELD {_ibtHeld=(" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "})}") <&> (,1))
         <|> (readMaybe ("ATTACH (" ++ x ++ ")") <&> (,parseNum xs))
         <|> (readMaybe ("CONSUMABLE {_ibtConsumable=" ++ x ++ "}") <&> (,parseNum xs))
-        <|> (readMaybe ("AMMO {_ibtAmmo=" ++ x ++ "}") <&> (,parseNum xs))
+        <|> (readMaybe ("AMMOMAG {_ibtAmmoMag=" ++ x ++ "}") <&> (,parseNum xs))
         <|> parseItem (xs & ix 0 .++~ (x ++ " "))
 parseItem [] = Nothing
 
 parseNum :: [String] -> Int
 parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
 
-showConsoleError :: String -> String -> Universe -> Universe
-showConsoleError cmd s = uvScreenLayers .:~ InputScreen cmd s
+showTerminalError :: String -> String -> Universe -> Universe
+showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s
 
-applySetConsoleString :: String -> Universe -> Universe
-applySetConsoleString [] = id
-applySetConsoleString var = case key' of
-    "" -> showConsoleError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
+applySetTerminalString :: String -> Universe -> Universe
+applySetTerminalString [] = id
+applySetTerminalString var = case key' of
+    "" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
     "hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
 --    "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
 --    "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
 --    "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
     "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avMoveSpeed .~ fromJust val'
-    _ -> showConsoleError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
+    _ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
   where
     (key, val) = getSplitString var
     val' = readMaybe val :: Maybe Float
     key' = if isNothing val' then "" else key
 
---autoCompleteConsole :: String -> String -> Universe -> IO (Maybe Universe)
---autoCompleteConsole s _ =
+--autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
+--autoCompleteTerminal s _ =
 --    return
 --        . (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
 --  where
 --    (key, val) = getSplitString $ tail s
 --    command_options = case val of
---        "" -> filter (isInfixOf key) (validConsoleCommands "")
---        _ -> filter (isInfixOf val) (validConsoleCommands key)
+--        "" -> filter (isInfixOf key) (validTerminalCommands "")
+--        _ -> filter (isInfixOf val) (validTerminalCommands key)
 --    -- basic autocomplete if single option available (or as far as possible)
 --    input_str = case (key, val) of
 --        (_, "") ->
@@ -117,7 +119,7 @@ applySetConsoleString var = case key' of
 --                        else ">" ++ key ++ " " ++ longestCommonPrefix command_options
 --    command_options' =
 --        if not (null command_options) && head command_options == key
---            then validConsoleCommands key
+--            then validTerminalCommands key
 --            else command_options
 --
 --    --val' = Debug.Trace.trace key tail val
@@ -129,12 +131,12 @@ getSplitString str = case break (== ' ') str of
     (a, _) -> (a, "")
 
 isValidCommand :: String -> String -> Bool
-isValidCommand arg1 arg2 = arg2 `elem` validConsoleCommands arg1
-validConsoleCommands :: String -> [String]
-validConsoleCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
-validConsoleCommands "god" = ["on", "off"]
-validConsoleCommands _ = ["set", "spawn", "god"]
-validConsoleCommands _ = ["set", "spawn", "god"]
+isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
+
+validTerminalCommands :: String -> [String]
+validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
+validTerminalCommands "god" = ["on", "off"]
+validTerminalCommands _ = ["set", "spawn", "god"]
 
 loadme :: a
 loadme = undefined

src/Dodge/Default.hs

@@ -25,7 +25,7 @@ defaultEquipment :: Item
 defaultEquipment = defaultHeldItem & itUse .~ UseNothing
 
 defaultFlIt :: FloorItem
-defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0, _flItID = 0}
+defaultFlIt = FlIt{_flItRot = 0,  _flItPos = V2 0 0}
 
 defaultMachine :: Machine
 defaultMachine =
@@ -46,16 +46,11 @@ defaultMachine =
         }
 
 defaultButton :: Button
-defaultButton =
-    Button
-        { _btPos = V2 0 0
+defaultButton = Button
+        { _btPos = 0
         , _btRot = 0
         , _btEvent = ButtonPress False NoWorldEffect (dark red)
         , _btID = 0
---        , _btState = BtOff
-        , _btTermMID = Nothing
---        , _btName = ""
---        , _btColor = red
         }
 
 defaultPP :: PressPlate
@@ -74,6 +69,6 @@ defaultProximitySensor =
     ProximitySensor
         { _proxStatus = NotClose
         , _proxDist = 40
-        , _proxRequirement = RequireImpossible
+        , _proxRequirement = RequireHealth 0
         , _sensToggle = False
         }

src/Dodge/Default/Creature.hs

@@ -5,7 +5,7 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.Creature
 import Dodge.Data.FloatFunction
 import Geometry.Data
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import Picture
 --import MaybeHelp
 
@@ -25,7 +25,7 @@ defaultCreature =
 --        , _crRad = 10
         , _crHP = 100
 --        , _crMaxHP = 150
-        , _crInv = IM.empty
+        , _crInv = mempty
         , _crManipulation = Manipulator SelNothing
 --        , _crInvCapacity = 25
         , _crDamage = []

src/Dodge/Default/Room.hs

@@ -36,4 +36,4 @@ defaultRoom =
         }
 
 defaultClusterStatus :: ClusterStatus
-defaultClusterStatus = ClusterStatus "defRoomClust" S.empty
+defaultClusterStatus = ClusterStatus S.empty

src/Dodge/Default/Terminal.hs

@@ -16,7 +16,7 @@ defaultTerminal =
         , _tmMachineID = 0
         , _tmDisplayedLines = []
         , _tmFutureLines = []
-        , _tmCommands = [TCInfo "TESA" "text 2",TCInfo "TEST" "display text",TCBase]
+        , _tmCommands = [TCBase]
         , _tmDeathEffect = TmWdWdDoDeathTriggers
         , _tmStatus = TerminalOff
         , _tmCommandHistory = []

src/Dodge/Default/Wall.hs

@@ -79,7 +79,8 @@ defaultDirtWall =
         }
 
 dirtColor :: Color
-dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
+dirtColor = dark $ dark orange
+--dirtColor = V4 (150 / 256) (75 / 256) 0 (250 / 256)
 
 defaultWindow :: Wall
 defaultWindow =

src/Dodge/Default/World.hs

@@ -1,6 +1,4 @@
-module Dodge.Default.World (
-    defaultWorld,
-) where
+module Dodge.Default.World (defaultWorld) where
 
 import Data.Graph.Inductive.Graph hiding ((&))
 import qualified Data.Map as M
@@ -8,7 +6,6 @@ import Dodge.Data.World
 import Geometry.Data
 import Geometry.Polygon
 import qualified IntMapHelp as IM
-import NewInt
 import System.Random
 
 defaultInput :: Input
@@ -43,7 +40,7 @@ defaultWorld =
         , _playingSounds = M.empty
         , _randGen = mkStdGen 2
         , _testFloat = 0
-        , _rbOptions = NoRightButtonOptions
+        , _rbState = NoRightButtonState
         , _hud = defaultHUD
         , _worldEventFlags = mempty
         , _crZoning = mempty
@@ -87,7 +84,6 @@ defaultCWorld =
         { _lWorld = defaultLWorld
         , _cwGen = defaultCWGen
         , _cClock = 0
---        , _seenWalls = mempty
         , _pathGraph = Data.Graph.Inductive.Graph.empty
         , _cwTiles = mempty
         , _numberFloorVerxs = 0
@@ -106,7 +102,8 @@ defaultLWorld =
         , _clouds = mempty
         , _dusts = mempty
         , _gusts = IM.empty
-        , _itemLocations = IM.empty
+--        , _itemLocations = IM.empty
+        , _items = mempty
         , _props = IM.empty
         , _debris = mempty
         , _projectiles = IM.empty
@@ -133,7 +130,7 @@ defaultLWorld =
         , _doors = IM.empty
         , _coordinates = IM.empty
         , _triggers = IM.empty
-        , _floorItems = NIntMap IM.empty
+        , _floorItems = mempty
         , _worldEvents = []
         , _delayedEvents = []
         , _pressPlates = IM.empty
@@ -162,21 +159,14 @@ defaultLWorld =
 defaultHUD :: HUD
 defaultHUD =
     HUD
-        { _hudElement = defaultDisplayInventory
+        { _subInventory = NoSubInventory
+        , _diSections = mempty
+        , _diSelection = Just (Sel 1 0 mempty)
+        , _diInvFilter = mempty
+        , _diCloseFilter = mempty
         , _carteCenter = V2 0 0
         , _carteZoom = 0.5
         , _carteRot = 0
         , _closeItems = mempty
         , _closeButtons = mempty
         }
-
-defaultDisplayInventory :: HUDElement
-defaultDisplayInventory =
-    DisplayInventory
-        { _subInventory = NoSubInventory
-        , _diSections = mempty
-        , _diSelection = Just (1, 0, mempty)
---        , _diSelectionExtra = mempty
-        , _diInvFilter = mempty
-        , _diCloseFilter = mempty
-        }

src/Dodge/Default/World.hs.orig

@@ -1,140 +0,0 @@
-module Dodge.Default.World where
-import Dodge.Data.World
-import Dodge.Zone.Size
-import Dodge.Zone.Object
-import Dodge.Base
-import Geometry.Vector3D
-import Geometry.Zone
---import Dodge.Config.KeyConfig
---import Dodge.Menu
---import Picture
-import Geometry.Data
-import Geometry.Polygon
---import Picture.Texture
---import Data.Preload
-
-import Control.Lens
-import System.Random
-import qualified IntMapHelp as IM
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Data.Graph.Inductive.Graph hiding ((&))
---import Data.Graph.Inductive.NodeMap
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
-defaultWorld :: World
-defaultWorld = World
-    { _keys = S.empty
-    , _magnets = IM.empty
-    , _mouseButtons = mempty
-    , _cameraCenter = V2 0 0
-    , _cameraRot = 0
-    , _cameraZoom = 1
-    , _itemZoom     = 1
-    , _defaultZoom = 1
-    , _cameraViewFrom = V2 0 0
-    , _viewDistance = 1000
-    , _modifications    = IM.empty
-    , _creatures        = IM.empty
-    , _crZoning         = Zoning IM.empty crZoneSize zoneOfCreature
-    , _creatureGroups   = IM.empty
-    , _clouds           = mempty
-    , _clZoning         = Zoning IM.empty clZoneSize (zonePos (stripZ . _clPos))
-    , _gusts = IM.empty
-    , _gsZoning         = Zoning IM.empty clZoneSize (zonePos _guPos)
-    , _itemPositions = IM.empty
-    , _props = IM.empty
-    , _instantParticles = []
-    , _particles = []
-    , _newBeams = WorldBeams [] [] [] []
-    , _beams = WorldBeams [] [] [] []
-    , _walls = IM.empty
-    , _wallDamages = IM.empty
-    , _blocks = IM.empty
-    , _machines = IM.empty
-    , _terminals = IM.empty
-    , _doors = IM.empty
-    , _coordinates  = IM.empty
-    , _triggers     = IM.empty
-    , _wlZoning     = Zoning IM.empty wlZoneSize zoneOfWall
-    , _floorItems = IM.empty
-    , _floorTiles = []
-    , _randGen = mkStdGen 2
-    , _mousePos = V2 0 0
-    , _testString = const . const []
-    , _debugPicture = mempty
-    , _yourID = 0
-    , _worldEvents = id
-    , _delayedEvents = []
-    , _pressPlates = IM.empty
-    , _buttons = IM.empty
-    , _toPlaySounds = M.empty
-    , _playingSounds = M.empty
-    , _corpses = IM.empty
-    , _decorations = IM.empty
-    --, _savedWorlds = M.empty
---    , _menuLayers = []
-    , _clickMousePos = V2 0 0
-    , _pathGraph = PathGraph Data.Graph.Inductive.Graph.empty mempty 0 mempty
-    , _pathGraphP   = mempty
-<<<<<<< HEAD
-    , _pnZoning     = Zoning mempty pnZoneSize (zonePos snd)
-    , _peZoning     = Zoning mempty pnZoneSize (\x (_,_,PathEdge p q _) -> zoneOfSeg x p q)
-=======
-    , _pnZoning     = Zoning mempty wlZoneSize (zonePos snd)
-    , _peZoning     = Zoning mempty wlZoneSize (\x (_,_,e) -> zoneOfSeg x (_peStart e) (_peEnd e))
->>>>>>> efficientRuntime
-    , _hud = HUD
-        { _hudElement = DisplayInventory NoSubInventory
-        , _carteCenter = V2 0 0
-        , _carteZoom = 0.5
-        , _carteRot  = 0
-        }
-    , _lightSources = IM.empty
-    , _tempLightSources = [youLight]
-    , _closeObjects     = []
-    , _rbOptions        = NoRightButtonOptions
-    , _seenLocations        = IM.fromList 
-        [(0, (_crPos . you, "CURRENT POSITION"))
-        ,(1, (const (V2 0 0) , "START POSITION"))
-        ]
-    , _selLocation = 0
-    --, _keyConfig = defaultKeyConfigSDL
---    , _config       = defaultConfig
-    , _sideEffects  = return
-    , _shapes = mempty
-    , _distortions     = []
-    , _gameRooms = []
-    , _roomClipping = []
-    , _unpauseClock = 0
-    , _worldBounds = defaultBounds
-    , _maybeWorld = Nothing'
-    , _rewindWorlds = []
-    , _timeFlow = NormalTimeFlow
-    , _hammers = defaultWorldHammers
-    , _backspaceTimer = 0
-    , _genParams = GenParams M.empty
-    , _genPlacements = IM.empty
-    , _genRooms = IM.empty
-    , _deathDelay = Nothing
-    , _testFloat = 0
-    , _boundBox = square 100
-    , _boundDist = (100,-100,100,-100)
-    , _lLine  = (0,0)
-    , _rLine  = (0,0)
-    , _lSelect   = 0
-    , _rSelect   = 0
-    }
-defaultWorldHammers :: M.Map WorldHammer HammerPosition
-defaultWorldHammers = M.fromSet (const HammerUp) $ S.fromList [minBound.. maxBound]
-youLight :: TempLightSource
-youLight = TLS 
-    { _tlsParam = LSParam
-        {_lsPos = V3 0 0 0
-        ,_lsRad = 150
-        ,_lsCol = 0.1
-        }
-    ,_tlsUpdate = \w _ -> Just (youLight & tlsParam . lsPos .~ f (_crPos $ you w))
-    ,_tlsTime = 0
-    }
-  where
-    f (V2 x y) = V3 x y 100

src/Dodge/DisplayInventory.hs

@@ -9,12 +9,14 @@ module Dodge.DisplayInventory (
     toggleCombineInv,
 ) where
 
+import Dodge.Data.HUD
+import Dodge.Inventory.CheckSlots
+import NewInt
 import Control.Applicative
 import Control.Lens
 import Control.Monad
 import Data.IntMap.Merge.Strict
 import qualified Data.IntMap.Strict as IM
-import Data.IntSet (IntSet)
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base.You
@@ -37,40 +39,40 @@ import Picture.Base
 updateCombinePositioning :: Universe -> Universe
 updateCombinePositioning u =
     u
-        & uvWorld . hud . hudElement . subInventory . ciSections
+        & uvWorld . hud . subInventory . ciSections
             %~ updateCombineSections (_uvWorld u) (_uvConfig u)
-        & uvWorld . hud . hudElement . subInventory %~ checkCombineSelectionExists
+        & uvWorld . hud . subInventory %~ checkCombineSelectionExists
 
 updateCombineSections ::
     World ->
-    Configuration ->
+    Config ->
     IM.IntMap (SelectionSection CombinableItem) ->
     IM.IntMap (SelectionSection CombinableItem)
 updateCombineSections w cfig =
     updateSectionsPositioning
         (const 0)
-        (w ^? hud . hudElement . subInventory . ciSelection . _Just)
-        (getAvailableListLines secondColumnParams cfig)
+        (w ^? hud . subInventory . ciSelection . _Just)
+        (getAvailableListLines secondColumnLDP cfig)
         (IM.fromDistinctAscList [(-1, sfclose),(0, sclose')])
   where
-    filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
+    filtcurs = w ^? hud . subInventory . ciSelection . _Just . slSec == Just (-1)
     (sfclose, sclose) =
         filterSectionsPair
             filtcurs
             (flip . andOrRegex $ regexCombs invitms)
             (IM.fromDistinctAscList . zip [0 ..] $ combineList w)
             "COMBINATIONS"
-            $ w ^? hud . hudElement . subInventory . ciFilter . _Just
-    invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
+            $ w ^? hud . subInventory . ciFilter . _Just
+    invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
     sclose'
         | null sclose =
             IM.singleton 0 $
-                SelectionInfo ["No possible combinations"] 1 25 False white 0
+                SelItem ["No possible combinations"] 1 25 False white 0 Nothing
         | otherwise = sclose
 
 regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci = \case
-    '#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
+    '#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci)
     str -> (regexList str . _siPictures) ci
   where
     g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)
@@ -85,24 +87,24 @@ orRegex f x str = case words str of
 
 updateInventoryPositioning :: Universe -> Universe
 updateInventoryPositioning u =
-    u & uvWorld . hud . hudElement . diSections
+    u & uvWorld . hud . diSections
         %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
         & uvWorld
         %~ checkInventorySelectionExists
 
 checkInventorySelectionExists :: World -> World
 checkInventorySelectionExists w
-    | isJust $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j = w
+    | isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w
     | otherwise = scrollAugNextInSection w
   where
-    (i, j, _) = fromMaybe (1, -1, mempty) $ w ^? hud . hudElement . diSelection . _Just
+    Sel i j _ = fromMaybe (Sel 1 (-1) mempty) $ w ^? hud . diSelection . _Just
 
 checkCombineSelectionExists :: SubInventory -> SubInventory
 checkCombineSelectionExists si
     | Just sss <- si ^? ciSections
-      , Just (i, j, _) <- si ^? ciSelection . _Just <|> Just (0, 0, mempty)
+      , Sel i j _ <- fromMaybe (Sel 0 0 mempty) $ si ^? ciSelection . _Just
       , isNothing $ si ^? ciSections . ix i . ssItems . ix j =
-        si & ciSelection ?~ (0, -1, mempty)
+        si & ciSelection ?~ Sel 0 (-1) mempty
             & ciSelection
             %~ scrollSelectionSections (-1) sss
     | otherwise = si
@@ -113,11 +115,7 @@ displayIndents 3 = 2
 displayIndents 5 = 2
 displayIndents _ = 0
 
-updateDisplaySections ::
-    World ->
-    Configuration ->
-    IM.IntMap (SelectionSection ()) ->
-    IM.IntMap (SelectionSection ())
+updateDisplaySections :: World -> Config -> IMSS () -> IMSS ()
 updateDisplaySections w cfig =
     updateSectionsPositioning
         displayIndents
@@ -129,7 +127,7 @@ updateDisplaySections w cfig =
                 [ invhead
                 , sinv
                 , IM.singleton 0 
-                    $ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
+                    $ SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing
                 , nearbyhead
                 , sclose
                 , interfaceshead
@@ -137,15 +135,15 @@ updateDisplaySections w cfig =
                 ]
         )
   where
-    mselpos = w ^? hud . hudElement . diSelection . _Just
-    invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
+    mselpos = w ^? hud . diSelection . _Just
+    invfiltcurs = mselpos ^? _Just . slSec == Just (-1)
     (sfinv, sinv) =
         filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
-            w ^? hud . hudElement . diInvFilter . _Just
-    closefiltcurs = mselpos ^? _Just . _1 == Just 2
+            w ^? hud . diInvFilter . _Just
+    closefiltcurs = mselpos ^? _Just . slSec == Just 2
     (sfclose, sclose) =
         filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
-            w ^? hud . hudElement . diCloseFilter . _Just
+            w ^? hud . diCloseFilter . _Just
     nearbyhead 
         | null sfclose && not (null sclose) = makehead "NEARBY ITEMS"
         | otherwise = sfclose
@@ -153,16 +151,16 @@ updateDisplaySections w cfig =
     btitems =
         IM.fromDistinctAscList . zip [0 ..] $
             mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
-    makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
+    makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
     invhead = if null sfinv then makehead "INVENTORY" else sfinv
     cr = you w
     closeitms =
         IM.fromDistinctAscList . zip [0 ..] $
-            mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
+            mapMaybe (closeItemToSelectionItem w . _unNInt) (w ^. hud . closeItems)
     invitems =
         IM.map
             (uncurry (invSelectionItem w))
-            (invIndents $ _crInv cr)
+            (invIndents $ (\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
 
 filterSectionsPair ::
     Bool -> -- check for whether filter is in focus, changes string at the end
@@ -179,13 +177,14 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
         return $
             IM.singleton
                 0
-                $ SelectionInfo
+                $ SelItem
                     [filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
                     2
                     (length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
                     True
                     white
                     0
+                    Nothing
     itms' = maybe id (IM.filter . filtfn) mfilt itms
     numfiltitems = "  " ++ show (length itms - length itms') ++ " FILTERED"
 
@@ -242,7 +241,7 @@ doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do
 
 updateSectionsPositioning ::
     (Int -> Int) -> -- for determining each sections indent
-    Maybe (Int, Int, IntSet) ->
+    Maybe Selection ->
     Int ->
     IM.IntMap (IM.IntMap (SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
@@ -252,13 +251,13 @@ updateSectionsPositioning h mselpos allavailablelines lsss sss =
   where
     offsets = fmap _ssOffset sss
     m k = do
-        (k', i, _) <- mselpos
+        Sel k' i _ <- mselpos
         guard $ k == k'
         return i
     ls = lsss
     -- defaults non-existing offsets to 0
     g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
-    lk = mselpos ^.. _Just . _1
+    lk = mselpos ^.. _Just . slSec
     ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
 
 updateSection ::
@@ -316,16 +315,16 @@ regexList = any . List.isInfixOf
 
 toggleCombineInv :: Universe -> Universe
 toggleCombineInv uv =
-    uv & case uv ^? uvWorld . hud . hudElement . subInventory of
-        Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory
+    uv & case uv ^? uvWorld . hud . subInventory of
+        Just CombineInventory{} -> uvWorld . hud . subInventory .~ NoSubInventory
         _ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
-enterCombineInv :: Configuration -> World -> World
+enterCombineInv :: Config -> World -> World
 enterCombineInv cfig w =
-    w & hud . hudElement . subInventory
+    w & hud . subInventory
         .~ CombineInventory
             { _ciSections = updateCombineSections w cfig mempty
-            , _ciSelection = Just (0,0,mempty)
+            , _ciSelection = Just (Sel 0 0 mempty)
             , _ciFilter = Nothing
             }
-        & hud . hudElement . diInvFilter .~ Nothing
+        & hud . diInvFilter .~ Nothing

src/Dodge/DoubleTree.hs

@@ -165,6 +165,7 @@ dtToUpDownAdj f (DT x l r) =
 
 -- returns an adjacency map with oldest ancestor and direct parent if they exist
 -- and any left and right children
+-- this should be all involving invids
 dtToLRAdj :: (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
 dtToLRAdj f (DT x l r) =
     IM.insert i (Nothing, map g l, map g r)

src/Dodge/Equipment.hs

@@ -6,8 +6,6 @@ module Dodge.Equipment (
 import Control.Lens
 import Data.Maybe
 import Dodge.Creature.HandPos
-import Dodge.Creature.Test
-import Dodge.Data.Equipment.Misc
 import Dodge.Data.World
 import Dodge.Item.Location
 import Dodge.Wall.Delete
@@ -15,6 +13,7 @@ import Dodge.Wall.ForceField
 import Dodge.Wall.Move
 import Geometry
 import qualified IntMapHelp as IM
+import NewInt
 
 effectOnRemove :: Item -> Creature -> World -> World
 effectOnRemove itm = case itm ^. itType of
@@ -51,11 +50,14 @@ setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
   where
     i = _itParamID $ _itParams itm
     wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
-    invid = _ilInvID (_itLocation itm)
-    handtrans = case cr ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
-        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
-        _ -> translatePointToRightHand
-    g
-        | twists cr = (+.+.+ V3 (-5) 10 0)
-        | otherwise = id
-    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
+    handtrans = case w ^? cWorld . lWorld . items
+            . ix (itm ^. itID . unNInt)
+            . itLocation
+            . ilEquipSite
+            . _Just of
+        Just x -> translateToES cr x -- . g
+        _ -> undefined
+    --    g
+    --        | twists cr = (+.+.+ V3 (-5) 10 0)
+    --        | otherwise = id
+    f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans

src/Dodge/Equipment/Text.hs

@@ -9,6 +9,5 @@ eqPosText ep = case ep of
     OnBack -> "BACK"
     OnLeftWrist -> "L.WRIST"
     OnRightWrist -> "R.WRIST"
-    OnLegs -> "LEGS"
-    OnSpecial -> "EQUIPPED"
-
+    OnLeftLeg -> "L.LEG"
+    OnRightLeg -> "R.LEG"

src/Dodge/Euse.hs

@@ -53,9 +53,10 @@ setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
 --    _ -> w
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr =
+createHeadLamp _ cr w = w &
     cWorld . lWorld . lights
         .:~ LSParam
-            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) 
+    (translateToES cr OnHead (V3 5 0 3)))
             200
             0.7

src/Dodge/Event/Input.hs

@@ -44,7 +44,7 @@ scToTS = \case
     ScancodeDown -> Just TSdown
     _ -> Nothing
 
-handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
+handleMouseMotionEvent :: MouseMotionEventData -> Config -> Input -> Input
 handleMouseMotionEvent mmev cfig = set mousePos themousepos . set mouseMoving True
   where
     P (V2 x y) = mouseMotionEventPos mmev

src/Dodge/Floor.hs

@@ -1,8 +1,11 @@
 -- | The tree of rooms that make up a level.
 module Dodge.Floor (
     initialRoomTree,
+    tutRoomTree,
 ) where
 
+import Dodge.Room.Tutorial
+import Dodge.Annotation.Data
 import Data.List (intersperse)
 import Dodge.Annotation
 import Dodge.Cleat
@@ -16,10 +19,13 @@ import LensHelp
 import RandomHelp
 
 -- | A test level tree.
-initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
+initialRoomTree :: State LayoutVars (MetaTree Room String)
 initialRoomTree = annoToRoomTree initialAnoTree
 --initialRoomTree = annoToRoomTree startWorldTreeTest
 
+tutRoomTree :: State LayoutVars (MetaTree Room String)
+tutRoomTree = annoToRoomTree tutAnoTree
+
 --startWorldTreeTest :: Annotation
 --startWorldTreeTest  =
 --    OnwardList $
@@ -30,20 +36,20 @@ initialAnoTree :: Annotation
 initialAnoTree =
     OnwardList $
         intersperse
-            (AnTree corDoor)
-            [ IntAnno $ AnTree . startRoom
-            , IntAnno $
+            (AnTree $ zoom lyGen corDoor)
+            [ AnTree $ intAnno startRoom
+            , --IntAnno $
                 PassthroughLockKeyLists
                     [(sensorRoomRunPast ElectricSensor, takeOne 
                         [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
                         HELD SPARKGUN])]
                     itemRooms
-            , IntAnno $ AnTree . lasSensorTurretTest
+            , AnTree $ intAnno lasSensorTurretTest
             , --    , AnRoom $ tanksRoom [] [] <&> rmPmnts .~ []
               --    , AnRoom $ tanksRoom [] []
               --    , AnRoom $ roomCCrits 0
               --    , AnRoom $ return airlock0
-              AnRoom slowDoorRoom
+              anRoom slowDoorRoom
             , --    , AnRoom $ roomCCrits 10
               --    , AnTree firstBreather
               --    , AnTree $ telRoomLev 1 >>= rToOnward "telRoomLev" . pure . cleatOnward
@@ -57,8 +63,8 @@ initialAnoTree =
               --    , AnTree $ tToBTree "spawners" <$> spawnerRoom
               --    , AnRoom pistolerRoom
               --    , AnRoom doubleCorridorBarrels
-              IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
-            , IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD"
+              PassthroughLockKeyLists keyCardRunPastRand itemRooms
+            , AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
             , AnTree $
                 rToOnward "chaseCrit+armourChaseCrit rectRoom" $
                     return . cleatOnward $
@@ -66,11 +72,12 @@ initialAnoTree =
                             .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                  , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ]
-            , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
-            , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
-            , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms
+            , AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
+            , AnTree . zoom lyGen $ 
+                (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
+            ,  PassthroughLockKeyLists lockRoomKeyItems itemRooms
             , AnTree randomChallenges
-            , IntAnno $ AnTree . lasSensorTurretTest
+            , AnTree $ intAnno lasSensorTurretTest
             , --    ,[AnTree $ fmap pure roomCCrits]
               --    ,[AirlockAno]
               --    ,[Corridor]
@@ -113,3 +120,12 @@ initialAnoTree =
               --    ,[Corridor]
               AnTree $ randomFourCornerRoom [] >>= rToOnward "randomFourCornerRoom" . pure . cleatOnward
             ]
+
+intAnno :: (Int -> State StdGen MTRS) -> State LayoutVars MTRS
+intAnno f = do
+    LayVars g i <- get
+    put $ LayVars g (i+1)
+    zoom lyGen (f i)
+
+anRoom :: State StdGen Room -> Annotation
+anRoom t = AnTree $ zoom lyGen (tToBTree "anRoom" . return . cleatOnward <$> t)

src/Dodge/FloorItem.hs

@@ -1,52 +1,28 @@
-module Dodge.FloorItem (
-    copyItemToFloor,
-    copyItemToFloorID,
-) where
+module Dodge.FloorItem (copyItemToFloor) where
 
-import Dodge.Item.InvSize
-import NewInt
-import Control.Lens
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base
 import Dodge.Data.World
+import Dodge.Item.InvSize
 import Geometry
-import qualified IntMapHelp as IM
+import LensHelp
+import NewInt
 import System.Random
 
--- | Copy an item to the floor.
+-- | Copy an item to the floor
 copyItemToFloor :: Point2 -> Item -> World -> World
-copyItemToFloor pos it = snd . copyItemToFloorID pos it
-
--- | Copy an item to the floor, returns the floor item's id.
-copyItemToFloorID :: Point2 -> Item -> World -> (NewInt FloorInt, World)
-copyItemToFloorID pos it w =
-    (,) (NInt flid) $
+copyItemToFloor p it w =
     w'
-            & cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
-            & cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid)
-            & hud . closeItems %~ (NInt flid:) 
---            & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-                -- ensures dropped item is at the top of the close item selection list
+        & cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
+        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
+        & hud . closeItems .:~ _itID it -- puts item at top of close items
   where
-    (p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
-    rot = fst . randomR (- pi, pi) $ _randGen w
-    flid = IM.newKey . _unNIntMap . _floorItems . _lWorld $ _cWorld w
-    theflit =
-        FlIt
-            { _flIt = it & itLocation .~ OnFloor (NInt flid)
-            , _flItPos = p'
-            , _flItRot = rot
-            , _flItID = NInt flid
-            }
+    (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
+    r = fst . randomR (- pi, pi) $ _randGen w
 
 cardinalVectors :: [Point2]
-cardinalVectors =
-    [ V2 1 0
-    , V2 0 1
-    , V2 (-1) 0
-    , V2 0 (-1)
-    ]
+cardinalVectors = [ V2 1 0 , V2 0 1 , V2 (-1) 0 , V2 0 (-1) ]
 
 findWallFreeDropPoint :: Float -> Point2 -> World -> (Point2, World)
 findWallFreeDropPoint r p w =

src/Dodge/HeldUse.hs

@@ -1,6 +1,6 @@
-{-# LANGUAGE TupleSections #-}
 {-# OPTIONS -Wno-incomplete-uni-patterns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 
 module Dodge.HeldUse (
     gadgetEffect,
@@ -117,7 +117,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
     -- the following is unsafe, but if ilInvID isn't correctly set we probably
     -- will have problems elsewhere also
     invid = it ^?! itLocation . ilInvID
-    itmset = cWorld . lWorld . creatures . ix cid . crInv . ix invid
+    itmset = cWorld . lWorld . items . ix (it ^. itID . unNInt)
     setwarming = itmset . itParams . isWarming %~ const True
     timelastused = it ^. itTimeLastUsed
     g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
@@ -137,9 +137,9 @@ heldEffectMuzzles loc cr w =
     t = loc ^. locDT
     bw = foldl' (loadMuzzle loc cr) (False, w) (locMuzzles loc)
     setusetime =
-        cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
+        cWorld . lWorld . items . ix itid . itTimeLastUsed
             .~ w ^. cWorld . lWorld . lClock
-    itid = t ^?! dtValue . _1 . itLocation . ilInvID
+    itid = t ^?! dtValue . _1 . itID . unNInt
 
 locMuzzles :: LocationDT OItem -> [Muzzle]
 locMuzzles loc
@@ -160,14 +160,7 @@ locMuzzles loc
 
 itemMuzzles :: Item -> [Muzzle]
 itemMuzzles itm = case itm ^. itType of
-    HELD ALTERIFLE ->
-        dbwMuzzles & ix 0 . mzPos .~ V2 25 0
-            & ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm)) (UseExactly 1)
-    HELD (VOLLEYGUN i) -> fromMaybe [] $ do
-        j <- itm ^? itParams . unfiredBarrels . ix 0
-        x <- vgunMuzzles i ^? ix j
-        return [x]
-    HELD hit -> heldItemMuzzles hit
+    HELD hit -> heldItemMuzzles itm hit
     DETECTOR{} ->
         dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
             & ix 0 . mzAmmoSlot . aps .~ UseExactly 100
@@ -179,8 +172,15 @@ itemMuzzles itm = case itm ^. itType of
             & ix 0 . mzEffect .~ MuzzleLaser
     _ -> []
 
-heldItemMuzzles :: HeldItemType -> [Muzzle]
-heldItemMuzzles = \case
+heldItemMuzzles :: Item -> HeldItemType -> [Muzzle]
+heldItemMuzzles itm = \case
+    ALTERIFLE ->
+        dbwMuzzles & ix 0 . mzPos .~ V2 25 0
+            & ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm)) (UseExactly 1)
+    (VOLLEYGUN i) -> fromMaybe [] $ do
+        j <- itm ^? itParams . unfiredBarrels . ix 0
+        x <- vgunMuzzles i ^? ix j
+        return [x]
     BANGSTICK i ->
         [ Muzzle
             (V2 10 0)
@@ -201,6 +201,7 @@ heldItemMuzzles = \case
     AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
     SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
     RIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
+    AUTORIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
     BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
     MINIGUNX i ->
         replicate
@@ -235,7 +236,6 @@ heldItemMuzzles = \case
     BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
     GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet (12 + 4 * fromIntegral i)]
     TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
-    VOLLEYGUN{} -> error "should get volleygun muzzles earlier"
     FLAMETHROWER -> flameMuzzles
     FLAMESPITTER -> flameMuzzles & ix 0 . mzEffect . nzPressure .~ UniRandFloat 3 4
     RLAUNCHER ->
@@ -341,26 +341,20 @@ vgunMuzzles i =
         )
 
 doHeldUseEffect :: DTree OItem -> Creature -> World -> World
-doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of
+doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
     HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
         Just [_] -> fromMaybe w $ do
             let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen
-            i <- itm ^? itLocation . ilInvID
             return $
                 w
                     & randGen .~ g
-                    & crinvset . ix i . itParams . unfiredBarrels %~ const is
-        Just (_ : _ : _) -> fromMaybe w $ do
-            i <- itm ^? itLocation . ilInvID
-            return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
+                    & crinvset . itParams . unfiredBarrels %~ const is
+        Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
         _ -> w
-    HELD ALTERIFLE -> fromMaybe w $ do
-        i <- t ^? dtValue . _1 . itLocation . ilInvID
-        return $
-            w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
+    HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
     _ -> w
   where
-    crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
+    crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
     itm = t ^. dtValue . _1
 
 -- should probably unify failure with time use check in some way...
@@ -450,7 +444,7 @@ applySoundCME itm cr = fromMaybe id $ do
     return $
         if x > 0
             then soundContinue (CrWeaponSound cid 0) (_crPos cr) soundid (Just x)
-            else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
+            else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 16]] (_crPos cr) soundid Nothing
   where
     cid = _crID cr
 
@@ -626,26 +620,30 @@ heldTorqueAmount = \case
 
 -- fugly
 loadMuzzle :: LocationDT OItem -> Creature -> (Bool, World) -> Muzzle -> (Bool, World)
-loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
-    case mz ^. mzAmmoSlot of
+loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ case mz ^. mzAmmoSlot of
     NoAmmoRequired -> return (useLoadedAmmo loc cr mz Nothing w)
     as -> do
         mag <- case as of
-                MagBelow mi _ -> find (isAmmoIntLink mi . (^. dtValue . _2)) (loc ^. locDT . dtLeft)
+            MagBelow mi _ ->
+                find
+                    (isAmmoIntLink mi . (^. dtValue . _2))
+                    (loc ^. locDT . dtLeft)
             CapacitorSelf _ -> loc ^? locDT
             CapacitorBelow _ ->
                 find
                     ((== PulseBallSF) . (^. dtValue . _2))
                     (loc ^. locDT . dtLeft)
-            mid <- mag ^? dtValue . _1 . itLocation . ilInvID
-            availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
+        mid <- mag ^? dtValue . _1 . itID . unNInt
+        availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
         let usedammo = case as ^?! aps of
                 UseUpTo x -> min x availableammo
                 UseExactly x
                     | x <= availableammo -> x
                     | otherwise -> 0
         guard $ usedammo > 0
-            return $ useLoadedAmmo loc cr mz (Just (usedammo, mag)) w
+        return $
+            useLoadedAmmo loc cr mz (Just (usedammo, mag)) $
+                removeAmmoFromMag usedammo mid w
 
 makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
 makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
@@ -674,12 +672,11 @@ makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
 
 --{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w =
-    w & randGen .~ g
-        & cWorld . lWorld . flares <>~ thepic
+muzFlareAt col x dir w =
+    w & randGen .~ g & cWorld . lWorld . flares <>~ thepic
   where
     thepic =
-        setLayer BloomLayer . translate3 tranv . color col . rotate dir . polygon $
+        setLayer BloomLayer . translate3 x . color col . rotate dir . polygon $
             [ V2 0 0
             , V2 a (- b)
             , V2 c d
@@ -724,7 +721,7 @@ useLoadedAmmo ::
     World ->
     World
 useLoadedAmmo loc cr mz m w =
-    removeAmmoFromMag m cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
+    makeMuzzleFlare mz loc cr $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
         MuzzleLaser -> creatureShootLaser loc cr mz w
         MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
@@ -741,7 +738,7 @@ useLoadedAmmo loc cr mz m w =
                 mz
                 cr
                 w
-        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
+        MuzzleNozzle{} -> useGasParams mitid mz loc cr $ walkNozzle mz itm w
         MuzzleShatter -> shootShatter itm cr w
         MuzzleDetector ->
             itemDetectorEffect
@@ -757,7 +754,7 @@ useLoadedAmmo loc cr mz m w =
         MuzzleScroller -> useTimeScrollGun itm cr w
   where
     itmtree = loc ^. locDT
-    mid = magtree ^? dtValue . _1 . itLocation . ilInvID
+    mitid = magtree ^. dtValue . _1 . itID
     itm = itmtree ^. dtValue . _1
     (x, magtree) = fromJust m
 
@@ -782,16 +779,10 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
     f CREATUREDETECTOR = OTCreature
     f WALLDETECTOR = OTWall
 
-walkNozzle :: Muzzle -> Item -> Creature -> World -> World
-walkNozzle mz itm cr w = fromMaybe w $ do
-    invid <- itm ^? itLocation . ilInvID
-    return $
+walkNozzle :: Muzzle -> Item -> World -> World
+walkNozzle mz itm w =
     w
-            & cWorld . lWorld . creatures . ix (_crID cr) . crInv
-                . ix invid
-                . itParams
-                . nzAngle
-                %~ f
+        & cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itParams . nzAngle %~ f
         & randGen .~ g
   where
     nz = _mzEffect mz
@@ -926,19 +917,9 @@ shootPulseBall p dir w =
   where
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
---removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
-removeAmmoFromMag :: Maybe (Int, DTree OItem) -> Creature -> World -> World
-removeAmmoFromMag m cr = fromMaybe id $ do
-    (x, magtree) <- m
-    magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
-    return $
-        cWorld . lWorld . creatures
-            . ix (_crID cr)
-            . crInv
-            . ix magid
-            . itConsumables
-            . _Just
-            -~ x
+removeAmmoFromMag :: Int -> Int -> World -> World
+removeAmmoFromMag x magid =
+    cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
 
 getBulletType :: DTree OItem -> Maybe Bullet
 getBulletType magtree =
@@ -1128,8 +1109,14 @@ mcUseHeld hit = case hit of
     LASER -> mcShootLaser
     _ -> mcShootAuto
 
-useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
-useGasParams mmagid mz loc cr w =
+useGasParams ::
+    NewInt ItmInt ->
+    Muzzle ->
+    LocationDT OItem ->
+    Creature ->
+    World ->
+    World
+useGasParams (NInt magitid) mz loc cr w =
     w
         & createGas gastype pressure pos dir cr
         & randGen .~ g'
@@ -1137,9 +1124,8 @@ useGasParams mmagid mz loc cr w =
     itm = loc ^. locDT . dtValue . _1
     (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
     gastype = fromMaybe (error "cannot find gas ammo") $ do
-        magid <- mmagid
         hit <- itm ^? itType . ibtHeld
-        fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
+        fueltype <- w ^? cWorld . lWorld . items . ix magitid >>= magAmmoParams >>= (^? ampCreateGas)
         gasType hit fueltype
     (V3 x y _, q) =
         locOrient loc cr
@@ -1208,11 +1194,11 @@ mcShootLaser _ mc =
 
 mcShootAuto :: Item -> Machine -> World -> World
 mcShootAuto itm mc w
-    | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
+    | Just i <- mc ^? mcType . mctTurret . tuWeapon
+      , Just (AutoTrigger rate) <- baseItemTriggerType <$> w ^? cWorld . lWorld . items . ix i
       , w ^. cWorld . lWorld . lClock - rate > lastused =
         w
-            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
-                . itTimeLastUsed
+            & cWorld . lWorld . items . ix i . itTimeLastUsed
                 .~ w ^. cWorld . lWorld . lClock
             & makeBullet defaultBullet itm pos dir
     | otherwise = w
@@ -1224,11 +1210,11 @@ mcShootAuto itm mc w
 -- | assumes that the item is held
 shootTeslaArc :: LocationDT OItem -> Creature -> Muzzle -> World -> World
 shootTeslaArc loc cr mz w =
-    w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
+    w' & cWorld . lWorld . items . ix itid . itParams .~ ip
         & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
   where
     itm = loc ^. locDT . dtValue . _1
-    invid = itm ^?! itLocation . ilInvID
+    itid = itm ^. itID . unNInt
     (w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
     (V3 x y _, q) =
         locOrient loc cr
@@ -1328,22 +1314,17 @@ createProjectile ::
     Creature ->
     World ->
     World
-createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
-    magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
-    ammoitem <- cr ^? crInv . ix magid
+createProjectile x pjtype mtree stab muz cr w = fromMaybe (failsound w) $ do
+    magitid <- mtree ^? dtValue . _1 . itID . unNInt
+    ammoitem <- w ^? cWorld . lWorld . items . ix magitid
     let rdetonate =
-            (^. dtValue . _1 . itID)
-                <$> find isrdet (magtree ^. dtLeft)
+            (^. dtValue . _1 . itID) <$> find isrdet (mtree ^. dtLeft)
         rscreen =
-            (^. dtValue . _1 . itID)
-                <$> find isrscreen (magtree ^. dtLeft)
+            (^. dtValue . _1 . itID) <$> find isrscreen (mtree ^. dtLeft)
     aparams <-
-        ((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-            --            <|> ammoitem ^? itConsumables . magParams . ampPayload
+        ((mtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
             <|> magAmmoParams ammoitem ^? _Just . ampPayload
-    return $
-        createShell x rdetonate rscreen stab pjtype aparams muz cr
-            . startthesound
+    return . makesound $ createShell x rdetonate rscreen stab pjtype aparams muz cr w
   where
     isrdet :: DTree OItem -> Bool
     isrdet y = case y ^. dtValue . _2 of
@@ -1359,7 +1340,7 @@ createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
         _ -> False
 
     -- the sound should be moved to the projectile firing
-    startthesound =
+    makesound =
         soundMultiFrom
             [CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
             (_crPos cr)
@@ -1420,7 +1401,7 @@ dropInventoryPath ::
     World ->
     World
 dropInventoryPath i ip loc cr = fromMaybe id $ do
-    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
+    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
     j <- getInventoryPath i ip invid cr
     return $ dropItem cr j
 
@@ -1453,15 +1434,15 @@ useInventoryPath ::
     World
 useInventoryPath pt i ip loc cr w = case ip of
     ABSOLUTE -> fromMaybe w $ do
-        guard $ i `IM.member` (cr ^. crInv)
+        guard $ i `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
     RELCURS -> fromMaybe w $ do
-        j <- cr ^? crManipulation . manObject . imSelectedItem
-        guard $ (i + j) `IM.member` (cr ^. crInv)
+        j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
+        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
     RELITEM -> fromMaybe w $ do
-        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
-        guard $ (i + j) `IM.member` (cr ^. crInv)
+        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
 
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of

src/Dodge/InputFocus.hs

@@ -6,27 +6,22 @@ import Dodge.Data.World
 import LensHelp
 
 inTextInputFocus :: World -> Bool
-inTextInputFocus = isJust . inputFocusI
+inTextInputFocus = isJust . textInputFocus
 
-inputFocusI :: World -> Maybe ((String -> Identity String) -> World -> Identity World)
-inputFocusI = textInputFocus
-
-textInputFocus ::
-    Applicative f =>
-    World ->
-    Maybe ((String -> f String) -> World -> f World)
-textInputFocus w = case w ^? hud . hudElement . subInventory of
-    Just NoSubInventory{} -> case he ^? diSelection . _Just . _1 of
-        Just (-1) -> Just $ hud . hudElement . diInvFilter . _Just
-        Just 2 -> Just $ hud . hudElement . diCloseFilter . _Just
+textInputFocus :: World -> Maybe ((String -> Identity String) -> World -> Identity World)
+textInputFocus w = case w ^. hud . subInventory of
+    NoSubInventory{} -> case he ^? diSelection . _Just . slSec of
+        Just (-1) -> Just $ hud . diInvFilter . _Just
+        Just 2 -> Just $ hud . diCloseFilter . _Just
         _ -> Nothing
-    Just CombineInventory{} -> case he ^? subInventory . ciSelection . _Just . _1 of
-        Just (-1) -> Just $ hud . hudElement . subInventory . ciFilter . _Just
+    CombineInventory{} -> case he ^? subInventory . ciSelection . _Just . slSec of
+        Just (-1) -> Just $ hud . subInventory . ciFilter . _Just
         _ -> Nothing
-    Just DisplayTerminal{_termID = tmid} -> do
---        connectionstatus <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus
-        --        guard $ connectionstatus == TerminalTextInput
-        return $ cWorld . lWorld . terminals . ix tmid . tmStatus . tiText
+    DisplayTerminal{_termID = tmid} -> case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus . tiText of
+        Just _ -> return $ cWorld . lWorld . terminals . ix tmid . tmStatus . tiText 
+        Nothing -> Nothing
+--    DisplayTerminal{_termID = tmid} -> return 
+--        $ cWorld . lWorld . terminals . ix tmid . tmStatus . tiText
     _ -> Nothing
   where
-    he = w ^. hud . hudElement
+    he = w ^. hud

src/Dodge/Inventory.hs

@@ -7,7 +7,6 @@ module Dodge.Inventory (
     invSetSelection,
     invSetSelectionPos,
     scrollAugInvSel,
-    crNumFreeSlots,
     setInvPosFromSS,
     module Dodge.Inventory.RBList,
     swapInvItems,
@@ -17,17 +16,12 @@ module Dodge.Inventory (
     destroyAllInvItems,
 ) where
 
-import Dodge.Equipment
---import Dodge.Wall.Delete
---import Dodge.Item.Location
 import Data.Function
-import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
---import Dodge.Euse
-import Dodge.Inventory.CheckSlots
+import Dodge.Equipment
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap
@@ -42,51 +36,55 @@ import NewInt
 
 -- should consider never fully destroying items, but assigning a flag saying how
 -- they were moved from play
-destroyInvItem :: Int -> Int -> World -> World
-destroyInvItem cid invid w =
-    rmInvItem cid invid w & removeitloc
-        & removeithotkey
+destroyInvItem :: Int -> NewInt InvInt -> World -> World
+destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc & removeithotkey
   where
     removeitloc = fromMaybe id $ do
-        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
-        return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
+        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
+        return $ cWorld . lWorld . items . at itid .~ Nothing
     removeithotkey = fromMaybe id $ do
-        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
+        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
         hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
         return $
             (cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
                 . (cWorld . lWorld . hotkeys . at hk .~ Nothing)
 
 destroyAllInvItems :: Creature -> World -> World
-destroyAllInvItems cr w = foldl' (flip $ destroyInvItem (cr ^. crID)) w 
-    . reverse . IM.keys $ cr ^. crInv 
+destroyAllInvItems cr w =
+    foldl' (flip $ destroyInvItem (cr ^. crID)) w
+        . reverse
+        . fmap NInt
+        . IM.keys
+        . _unNIntMap
+        $ cr ^. crInv
 
 destroyItem :: Int -> World -> World
-destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
+destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
     Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
-    Just (InInv {_ilCrID = cid, _ilInvID = invid}) -> destroyInvItem cid invid w
-    Just (OnTurret{}) -> error "need to write code for destroying items on turrets"
-    Just (OnFloor (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
-        & cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
-    Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
+    Just InInv{_ilCrID = cid, _ilInvID = invid} -> destroyInvItem cid invid w
+    Just OnTurret{} -> error "need to write code for destroying items on turrets"
+    Just OnFloor ->
+        w & cWorld . lWorld . items . at itid .~ Nothing
+            & cWorld . lWorld . floorItems . at itid .~ Nothing
+    Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
 
 -- note rmInvItem does not fully destroy the item, other updates to the item
 -- location are required
-rmInvItem :: Int -> Int -> World -> World
+rmInvItem :: Int -> NewInt InvInt -> World -> World
 rmInvItem cid invid w =
     w
         & dounequipfunction --the ordering of these is
         & pointcid . crInv %~ f -- important
         & removeAnySlotEquipment
-        & pointcid . crEquipment . each %~ g
+        & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
         & updateselection
         & updateselectionextra
-        & pointcid %~ updateRootItemID
+        & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
         & worldEventFlags . at InventoryChange ?~ ()
   where
     pointcid = cWorld . lWorld . creatures . ix cid
     updateselectionextra
-        | cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ const mempty
+        | cid == 0 = hud . diSelection . _Just . slSet %~ const mempty
         | otherwise = id
     updateselection
         | cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
@@ -94,50 +92,43 @@ rmInvItem cid invid w =
         | otherwise =
             pointcid . crManipulation . manObject . imSelectedItem %~ g
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    itm = _crInv cr IM.! invid
+    itid = _crInv cr ^?! ix invid
+    itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
-    --  fromMaybe id $ do
-    --    rmf <- itm ^? itUse . uequipEffect . eeOnRemove
-    --    return $ doItmCrWdWd rmf itm cr
     removeAnySlotEquipment = fromMaybe id $ do
-        epos <-
-            w
-                ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
-                    . itLocation
+        epos <- itm ^?
+                     itLocation
                     . ilEquipSite
                     . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
-    maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
+--        return $ pointcid . crEquipment .~ mempty
+    maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
     f inv =
-        let (xs, ys) = IM.split invid inv
-         in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
+        let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
+         in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
     -- the following might not work if a non-player creature drops their last item
     g x
-        | x > invid || Just x == maxk = max 0 $ x - 1
+        | x > invid || Just x == fmap NInt maxk = max 0 $ x - 1
         | otherwise = x
 
-
--- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w
-        & hud . closeItems %~ f
-        & hud . closeButtons %~ g
+    w & hud . closeItems %~ h citems
+        & hud . closeButtons %~ h cbts
   where
-    g oldbts = intersect oldbts cbts `union` cbts
-    f olditems = intersect olditems citems `union` citems
-    cbts = _btID <$> filter (isclose . _btPos) activeButtons
-    citems =
-        fmap _flItID
-            . filter (isclose . _flItPos)
-            . IM.elems
-            $ w ^. cWorld . lWorld . floorItems . unNIntMap
-    isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
-    ypos = _crPos $ you w
-    activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
+    h a b = intersect b a `union` a
+    lw = w ^. cWorld . lWorld
+    citems = map NInt $ IM.keys $ IM.intersection (lw ^. items) 
+        $ IM.filter (isclose . _flItPos) (lw^.floorItems)
+    cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
     canpress bt = case bt ^. btEvent of
         ButtonPress{_btOn = t} -> not t
+        ButtonAccessTerminal tid -> fromMaybe False $ do
+            x <- lw ^? terminals . ix tid . tmStatus
+            return (x /= TerminalDeactivated)
         _ -> True
+    isclose x = dist y x < 40 && hasButtonLOS y x w
+    y = _crPos $ you w
 
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
@@ -154,7 +145,7 @@ changeSwapOther ::
     World ->
     World
 changeSwapOther manlens n f i w = fromMaybe w $ do
-    ss <- w ^? hud . hudElement . diSections . ix n . ssItems
+    ss <- w ^? hud . diSections . ix n . ssItems
     k <- f i ss
     let doswap j
             | j == i = k
@@ -166,7 +157,7 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
             & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
                 %~ doswap
             & hud . closeItems %~ swapIndices i k
-            & hud . hudElement . diSelection . _Just . _2 %~ doswap
+            & hud . diSelection . _Just . slInt %~ doswap
             & worldEventFlags . at InventoryChange ?~ ()
 
 swapItemWith ::
@@ -174,43 +165,33 @@ swapItemWith ::
     (Int, Int) ->
     World ->
     World
-swapItemWith f (j, i) w = case j of
-    0 -> w & swapInvItems f i
-    3 -> w & changeSwapOther ispCloseItem 3 f i
-    5 -> w & changeSwapOther ispCloseButton 5 f i
-    _ -> w
+swapItemWith f (j, i) = case j of
+    0 -> swapInvItems f i
+    3 -> changeSwapOther ispCloseItem 3 f i
+    5 -> changeSwapOther ispCloseButton 5 f i
+    _ -> id
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
-changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
-    Just (0, i, _) -> w & swapInvItems f i
-    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
-    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
-    _ -> w
+changeSwapWith f w 
+    | Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j,i) w
+    | otherwise = w
 
-invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
+invSetSelection :: Selection -> World -> World
 invSetSelection sel w =
     w
-        & hud . hudElement . diSelection ?~ sel
+        & hud . diSelection ?~ sel
         & worldEventFlags . at InventoryChange ?~ ()
         & setInvPosFromSS
         & cWorld . lWorld %~ crUpdateItemLocations 0
 
 invSetSelectionPos :: Int -> Int -> World -> World
-invSetSelectionPos i j w =
-    w
-        & hud . hudElement . diSelection %~ f
-        & worldEventFlags . at InventoryChange ?~ ()
-        & setInvPosFromSS
-        & cWorld . lWorld %~ crUpdateItemLocations 0
-  where
-    f Nothing = Just (i,j,mempty)
-    f (Just (_,_,s)) = Just (i,j,s)
+invSetSelectionPos i j = invSetSelection (Sel i j mempty)
 
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
     | yi == 0 = w
     | otherwise =
-        w & hud . hudElement %~ doscroll
+        w & hud %~ doscroll
             & worldEventFlags . at InventoryChange ?~ ()
             & setInvPosFromSS
             & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -221,7 +202,7 @@ scrollAugInvSel yi w
 
 scrollAugNextInSection :: World -> World
 scrollAugNextInSection w =
-    w & hud . hudElement %~ doscroll
+    w & hud %~ doscroll
         & worldEventFlags . at InventoryChange ?~ ()
         & setInvPosFromSS
         & cWorld . lWorld %~ crUpdateItemLocations 0

src/Dodge/Inventory/Add.hs

@@ -1,72 +1,30 @@
+{-# LANGUAGE TupleSections #-}
+
 module Dodge.Inventory.Add (
-    tryPutItemInInv,
-    --createPutItem,
-    --createAndSelectItem,
     createItemYou,
     pickUpItem,
     pickUpItemAt,
 ) where
 
-import Dodge.Inventory.Swap
-import Control.Monad
-import NewInt
-import Dodge.SoundLogic
-import Dodge.Inventory.Location
---import Dodge.Item.Grammar
+import qualified Data.IntSet as IS
 import Control.Lens
+import Control.Monad
 import Data.Maybe
---import Dodge.Base.You
---import Dodge.Combine.Module
---import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.FloorItem
 import Dodge.Inventory.CheckSlots
+import Dodge.Inventory.Location
+import Dodge.Inventory.Swap
+import Dodge.SoundLogic
 import qualified IntMapHelp as IM
+import NewInt
 
-tryPutFloorItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World)
-tryPutFloorItemIDInInv cid flitid w = do
-    flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid)
-    tryPutItemInInv cid flit w
-
--- not sure why we have the cid here, this will probably only work for cid == 0
-tryPutItemInInvAt :: Int -> Int -> FloorItem -> World -> Maybe World
-tryPutItemInInvAt i cid flit w = do
-    (j,w') <- tryPutItemInInv cid flit w
-    guard (i <= j)
-    return $ foldr f w' [i+1..j]
-  where
-    f j = swapInvItems (\_ _ -> Just (j-1)) j
-    
-
--- | Pick up a specific item.
-tryPutItemInInv :: Int -> FloorItem -> World -> Maybe (Int, World)
-tryPutItemInInv cid flit w = case maybeInvSlot of
-    Nothing -> Nothing
-    Just i ->
-        Just
-            ( i
-            , w
-                & cWorld . lWorld . floorItems . unNIntMap %~ IM.delete (_unNInt $ _flItID flit)
-                & cWorld . lWorld . creatures . ix cid . crInv %~ IM.insert i it
-                & updateItLocation i
-                -- I forget whether using "at" rather than "IM.insert" here caused problems
-                -- & cWorld . lWorld . creatures . ix cid . crInv . at i ?~ it
-                -- note item locations are updated twice: first for the ilInvID,
-                -- second for the root/selected item bools
-                & cWorld . lWorld %~ crUpdateItemLocations cid
-                & setInvPosFromSS
-                & updateselectionextra
-                & cWorld . lWorld %~ crUpdateItemLocations cid
-            )
-  where
-    updateselectionextra | cid == 0 
-            = hud . hudElement . diSelection . _Just . _3 %~ const mempty
-        | otherwise = id
-    it = _flIt flit
-    maybeInvSlot = checkInvSlotsYou it w
-    -- not sure if the following is necessary
-    updateItLocation invid w' = w' & cWorld . lWorld . itemLocations . ix (_unNInt $ _itID it) 
-        .~ InInv 
+-- this assumes that this item is currently on the floor
+tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt, World)
+tryPutItemInInv cid itid w = do
+    itm <- w ^? cWorld . lWorld . items . ix itid
+    invid <- checkInvSlotsYou itm w
+    let itloc = InInv
             { _ilCrID = cid
             , _ilInvID = invid
             , _ilIsRoot = False
@@ -74,43 +32,45 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
             , _ilIsAttached = False
             , _ilEquipSite = Nothing
             }
-
----- should select the item on the floor if no inventory space?
---createAndSelectItem :: Item -> World -> World
---createAndSelectItem itm w = case createPutItem itm w of
---    (Just i, w') ->
---        w'
---            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
---            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
---                .~  InInventory (SelectedItem i 
---                    $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
---    (Nothing, w') -> w'
-
---createPutItem :: Item -> World -> (Maybe Int, World)
---createPutItem it w = fromMaybe (Nothing,w) $ do
---    (i,w') <- uncurry (tryPutItemIDInInv 0) $
---        copyItemToFloorID (_crPos $ you w) (applyModules it) w
---    return (Just i, w')
-
-createItemYou :: Item -> World -> (ItemLocation, World)
-createItemYou itm w = fromMaybe (OnFloor flid, w') $ do
-    (invid, w'') <- tryPutFloorItemIDInInv 0 flid w'
-    itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
-    return (itloc, w'')
+    return $ (invid,) $
+            w
+                & cWorld . lWorld %~ crUpdateItemLocations cid
+                -- not sure about the order of these...
+                & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
+                & cWorld . lWorld . items . ix itid . itLocation .~ itloc
+                & cWorld . lWorld . floorItems . at itid .~ Nothing
+                & updateselectionextra invid
   where
-    itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
+    updateselectionextra i
+        | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
+            . (hud . diSelection . _Just . slInt %~ f i)
+        | otherwise = id
+    f j i | i >= _unNInt j = i + 1
+          | otherwise = i
+
+-- not sure why we have the cid here, this will probably only work for cid == 0
+tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
+tryPutItemInInvAt i cid itid w = do
+    (j, w') <- tryPutItemInInv cid itid w
+    guard (i <= _unNInt j)
+    return $ foldr f w' [i + 1 .. _unNInt j]
+  where
+    f j = swapInvItems (\_ _ -> Just (j -1)) j
+
+createItemYou :: Item -> World -> World
+createItemYou itm w = maybe w' snd $ tryPutItemInInv 0 itid w'
+  where
+    itid = IM.newKey $ w ^. cWorld . lWorld . items
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
-    (flid,w') = copyItemToFloorID pos (itm & itID .~ NInt itid) w
+    w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
 
+-- the duplication is annoying...
+pickUpItem :: Int -> Int -> World -> World
+pickUpItem cid itid w = fromMaybe w $ do
+    p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
+    soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv cid itid w
 
--- | Pick up a specific item.
-pickUpItem :: Int -> FloorItem -> World -> World
-pickUpItem cid flit w =
-    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
-        tryPutItemInInv cid flit w
-
--- | Pick up a specific item.
-pickUpItemAt :: Int -> Int -> FloorItem -> World -> World
-pickUpItemAt invid cid flit w =
-    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing) $
-        tryPutItemInInvAt invid cid flit w
+pickUpItemAt :: Int -> Int -> Int -> World -> World
+pickUpItemAt invid cid itid w = fromMaybe w $ do
+    p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
+    soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt invid cid itid w

src/Dodge/Inventory/CheckSlots.hs

@@ -4,6 +4,7 @@ module Dodge.Inventory.CheckSlots (
     maxInvSlots,
 ) where
 
+import NewInt
 import Control.Monad
 import Dodge.Item.InvSize
 import Control.Lens
@@ -14,18 +15,20 @@ import qualified IntMapHelp as IM
 {- | checks whether or not an item will fit in your inventory
  if so return Just the next slot to be used
 -}
-checkInvSlotsYou :: Item -> World -> Maybe Int
+checkInvSlotsYou :: Item -> World -> Maybe (NewInt InvInt)
 checkInvSlotsYou it w = do
     ycr <- w ^? cWorld . lWorld . creatures . ix 0
-    guard $ crNumFreeSlots ycr >= itInvHeight it
-    Just . IM.newKey $ _crInv ycr
+    guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
+    Just . NInt . IM.newKey . _unNIntMap $ _crInv ycr
 
-crNumFreeSlots :: Creature -> Int
---crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
-crNumFreeSlots cr = maxInvSlots - invSize (_crInv cr)
+-- the intmap should be _items
+crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
+crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
+  where
+    f i = m ^?! ix i
 
 maxInvSlots :: Int
-maxInvSlots = 25
+maxInvSlots = 250
 
-invSize :: IM.IntMap Item -> Int
+invSize :: NewIntMap InvInt Item -> Int
 invSize = alaf Sum foldMap itInvHeight

src/Dodge/Inventory/Location.hs

@@ -4,12 +4,14 @@ module Dodge.Inventory.Location (
     setInvPosFromSS,
 ) where
 
-import Control.Applicative
 import Control.Lens
-import Data.IntMap.Merge.Strict
+import Data.Foldable
+--import Data.IntMap.Merge.Strict
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base.You
+import Dodge.Data.ComposedItem
+import Dodge.Data.DoubleTree
 import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.World
 import Dodge.Item.Grammar
@@ -17,83 +19,95 @@ import qualified IntMapHelp as IM
 import NewInt
 
 -- assumes all item locations inside the items are correct
-tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
-tryGetRootAttachedFromInvID invid im = do
+tryGetRootAttachedFromInvID ::
+    NewInt InvInt ->
+    NewIntMap InvInt Item ->
+    Maybe (Int, IS.IntSet)
+tryGetRootAttachedFromInvID (NInt invid) im = do
     let imroots = invRootMap im
         theroot = fromMaybe invid $ imroots ^? ix invid . _1 . _Just
     t <- imroots ^? ix theroot . _2
-    return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
+    return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID . unNInt)) t)
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
-tryGetRootItemInvID :: Int -> Creature -> Maybe Int
-tryGetRootItemInvID i cr = do
-    let adj = invAdj (_crInv cr)
+-- note the item intmap is all items
+getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
+getRootItemInvID m i cr = fromMaybe i $ do
+    let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
     theroot <- adj ^? ix i
-    theroot ^? _1 . _Just . _1 <|> Just i
+    theroot ^? _1 . _Just . _1
 
-updateRootItemID :: Creature -> Creature
-updateRootItemID cr = fromMaybe cr $ do
-    i <- cr ^? crManipulation . manObject . imSelectedItem
-    j <- tryGetRootItemInvID i cr
-    return $ cr & crManipulation . manObject . imRootSelectedItem .~ j
+updateRootItemID :: IM.IntMap Item -> Creature -> Creature
+updateRootItemID m cr = fromMaybe cr $ do
+    i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
+    let j = getRootItemInvID m i cr
+    return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
 
 -- the following assumes that the crManipulation is correct
 crUpdateItemLocations :: Int -> LWorld -> LWorld
 crUpdateItemLocations crid lw = fromMaybe lw $ do
     mo <- lw ^? creatures . ix crid . crManipulation . manObject
-    crinv <- lw ^? creatures . ix crid . crInv
-    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw crinv
+    cinv <- lw ^? creatures . ix crid . crInv
+    let crinv = fmap (\k -> lw ^?! items . ix k) cinv
+    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
 
 crSetRoots :: Int -> LWorld -> LWorld
 crSetRoots cid w = fromMaybe w $ do
     inv <- w ^? creatures . ix cid . crInv
-    return $
-        w & creatures . ix cid . crInv
-            %~ merge
-                dropMissing
-                preserveMissing
-                (zipWithMatched f)
-                (invIMDT inv)
+    let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
+    return $ foldl' f (foldl' g w inv) cinv
   where
-    f _ _ = itLocation . ilIsRoot .~ True
+    g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
+    f :: LWorld -> DTree OItem -> LWorld
+    f w' x =
+        w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
 
-crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
+crUpdateInvidLocations ::
+    ManipulatedObject ->
+    Int ->
+    LWorld ->
+    Int ->
+    Item ->
+    LWorld
 crUpdateInvidLocations mo crid lw invid itm =
     lw
-        & creatures . ix crid . crInv . ix invid . itLocation .~ newloc
-        & itemLocations %~ IM.insert itid newloc
+        & creatures . ix crid . crInv . ix (NInt invid) .~ itid
+        & items . ix itid .~ (itm & itLocation .~ newloc)
   where
     itid = itm ^. itID . unNInt
     newloc =
         InInv
             { _ilCrID = crid
-            , _ilInvID = invid
-            , _ilIsRoot = Just invid == mo ^? imRootSelectedItem
-            , _ilIsSelected = Just invid == mo ^? imSelectedItem
+            , _ilInvID = NInt invid
+            , _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
+            , _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
             , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
-            , _ilEquipSite = lw ^? creatures . ix crid . crInv . ix invid 
-                . itLocation . ilEquipSite . _Just
+            , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
             }
 
 -- this should be looked at, as it is sometimes used in functions that need not
 -- concern the player creature
 -- this might not work if the selpos is in the inventory but too large
 setInvPosFromSS :: World -> World
-setInvPosFromSS w =
-    w
+setInvPosFromSS w = w
         & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
   where
     thesel = fromMaybe SelNothing $ do
-        (i, j, _) <- w ^? hud . hudElement . diSelection . _Just
+        Sel i j _ <- w ^? hud . diSelection . _Just
         case i of
             (-1) -> Just SortInventory
             0 -> do
-                (rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
+                (rootid, aset) <-
+                    tryGetRootAttachedFromInvID
+                        (NInt j)
+                        ( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
+                            you w ^. crInv
+                        )
                 return
                     SelectedItem
-                        { _imSelectedItem = j
-                        , _imRootSelectedItem = rootid
+                        { _imSelectedItem = NInt j
+                        , _imRootSelectedItem = NInt rootid
                         , _imAttachedItems = aset
                         }
             1 -> Just SelNothing

src/Dodge/Inventory/Path.hs

@@ -1,5 +1,6 @@
 module Dodge.Inventory.Path (getInventoryPath) where
 
+import NewInt
 import Dodge.Data.Creature
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -9,10 +10,10 @@ getInventoryPath :: Int -> InventoryPathing -> Int -> Creature -> Maybe Int
 getInventoryPath x ip itid cr = case ip of
     ABSOLUTE -> checkinvid x
     RELCURS -> do
-        selid <- cr ^? crManipulation . manObject . imSelectedItem
+        selid <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
         checkinvid (x + selid)
     RELITEM -> checkinvid (itid + x)
   where
     checkinvid y = do
-        guard $ y `IM.member` (cr ^. crInv)
+        guard $ y `IM.member` (cr ^. crInv . unNIntMap)
         return y

src/Dodge/Inventory/RBList.hs

@@ -1,83 +1,83 @@
+--{-# LANGUAGE TupleSections #-}
+
 module Dodge.Inventory.RBList (
     updateRBList,
-    getEquipmentAllocation,
-    eqSiteToPositions,
+    equipmentDesignation,
+    eqTypeToSites,
 ) where
 
-import Dodge.Data.Equipment.Misc
-import Dodge.Data.EquipType
-import Control.Applicative
+--import qualified Data.IntMap.Strict as IM
+
+--import Control.Applicative
 import Control.Lens
 import Data.List (elemIndex, findIndex)
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.You
+import Dodge.Data.EquipType
 import Dodge.Data.World
+import NewInt
 import qualified SDL
 
 updateRBList :: World -> World
-updateRBList w = case w ^. rbOptions of
-    _ | norightclick -> w & rbOptions .~ NoRightButtonOptions
+updateRBList w = case w ^. rbState of
+    _ | norightclick -> w & rbState .~ NoRightButtonState
     EquipOptions{} -> w
-    _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
+    _ -> fromMaybe (w & rbState .~ NoRightButtonState) $ do
         i <- cr ^? crManipulation . manObject . imSelectedItem
-        esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
+        itid <- cr ^? crInv . ix i
+        itm <- w ^? cWorld . lWorld . items . ix itid
+        etype <- equipType itm
         return $
-            w & rbOptions
-                .~ EquipOptions
-                    { _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
-                    }
+            w & rbState
+                .~ EquipOptions (chooseEquipPosition itm cr (eqTypeToSites etype))
   where
-    norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
+    --norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
+    norightclick = null $ w ^. input . mouseButtons . at SDL.ButtonRight
     cr = you w
 
 -- want to choose the current position if the item is equipped, otherwise try to
 -- find a free equipment slot
-chooseEquipPosition :: Creature -> [EquipSite] -> Int
-chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
-    i <- cr ^? crManipulation . manObject . imSelectedItem
-    ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
+chooseEquipPosition :: Item -> Creature -> [EquipSite] -> Int
+chooseEquipPosition itm cr eps = fromMaybe (chooseFreeSite cr eps) $ do
+    ep <- itm ^? itLocation . ilEquipSite . _Just
     elemIndex ep eps
+--    (elemIndex <$> (itm ^? itLocation . ilEquipSite . _Just)) ?? eps
 
 chooseFreeSite :: Creature -> [EquipSite] -> Int
 chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
   where
-    hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
+    hasnoequipment es = isNothing $ cr ^? crEquipment . ix es
 
-getEquipmentAllocation :: Int -> World -> EquipmentAllocation
-getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
-    esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
-    i <-
-        w ^? rbOptions . opSel
-            <|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
-    es <- eqSiteToPositions esite ^? ix i
-    return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
-        Just epos
-            | es == epos -> RemoveEquipment{_allocOldPos = epos}
-        Just epos
-            | isJust (you w ^? crEquipment . ix es) ->
+equipmentDesignation :: NewInt InvInt -> World -> EquipmentAllocation
+equipmentDesignation invid w = fromMaybe DoNotMoveEquipment $ do
+    itid <- you w ^? crInv . ix invid
+    etype <- w ^? cWorld . lWorld . items . ix itid >>= equipType
+    let mesite = w ^? cWorld . lWorld . items . ix itid . itLocation . ilEquipSite . _Just
+    i <- w ^? rbState . opSel
+    new <- eqTypeToSites etype ^? ix i
+    return $ case mesite of
+        Just old | new == old -> RemoveEquipment{_allocOldPos = old}
+        Just old
+            | isJust (you w ^? crEquipment . ix new) ->
                 SwapEquipment
-                    { _allocOldPos = epos
-                    , _allocNewPos = es
-                    , _allocSwapID = _crEquipment (you w) M.! es
-                    }
-        Just epos ->
-            MoveEquipment
-                { _allocOldPos = epos
-                , _allocNewPos = es
+                    { _allocOldPos = old
+                    , _allocNewPos = new
+                    , _allocSwapID = _crEquipment (you w) M.! new
                     }
+        Just old -> MoveEquipment{_allocOldPos = old, _allocNewPos = new}
         Nothing
-            | isJust (you w ^? crEquipment . ix es) ->
+            | isJust (you w ^? crEquipment . ix new) ->
                 ReplaceEquipment
-                    { _allocNewPos = es
-                    , _allocRemoveID = _crEquipment (you w) M.! es
+                    { _allocNewPos = new
+                    , _allocRemoveID = _crEquipment (you w) M.! new
                     }
-        Nothing -> PutOnEquipment{_allocNewPos = es}
+        Nothing -> PutOnEquipment{_allocNewPos = new}
 
-eqSiteToPositions :: EquipType -> [EquipSite]
-eqSiteToPositions es = case es of
+eqTypeToSites :: EquipType -> [EquipSite]
+eqTypeToSites es = case es of
     GoesOnHead -> [OnHead]
     GoesOnChest -> [OnChest]
     GoesOnBack -> [OnBack]
     GoesOnWrist -> [OnLeftWrist, OnRightWrist]
-    GoesOnLegs -> [OnLegs]
+    GoesOnLeg -> [OnLeftLeg,OnRightLeg]

src/Dodge/Inventory/SelectionList.hs

@@ -31,14 +31,14 @@ import Picture.Base
 
 invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
 invSelectionItem w indent loc =
-    SelectionItem
+    SelItem
         { _siPictures = itemDisplay w cr ci
         , _siHeight = itInvHeight $ ci ^. _1
         , _siWidth = 15
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
-        , _siPayload = ()
+        , _siPayload = Nothing
         }
   where
     ci = (a,b)
@@ -88,19 +88,22 @@ itemExternalValue itm w cr
         displayPulse $ cr ^?! crType . avatarPulse . pulseProgress
     | Just t <- itm ^? itType . ibtIntroScanType = Just $ introScanValue cr t
     | ITEMSCAN <- itm ^. itType
-    , Just ExamineInventory <- w ^? hud . hudElement . subInventory
+    , Just ExamineInventory <- w ^? hud . subInventory
         = Just (Right "ON")
     | BINGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID
-        litm <- cr ^? crInv . ix (invid -2)
-        ritm <- cr ^? crInv . ix (invid -1)
+        litid <- cr ^? crInv . ix (invid -2)
+        ritid <- cr ^? crInv . ix (invid -1)
+        litm <- w ^? cWorld . lWorld . items . ix litid
+        ritm <- w ^? cWorld . lWorld . items . ix ritid
         x <- itm ^? itScroll . itsRangeInt
         l <- getItemValue litm w cr ^? _Just . _Left
         r <- getItemValue ritm w cr ^? _Just . _Left
         Just . Left $ bgateCalc x l r
     | UNIGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID
-        itm' <- cr ^? crInv . ix (invid -1)
+        itid' <- cr ^? crInv . ix (invid -1)
+        itm' <- w ^? cWorld . lWorld . items . ix itid'
         x <- itm ^? itScroll . itsRangeInt
         y <- getItemValue itm' w cr ^? _Just . _Left
         Just . Left $ ugateCalc x y
@@ -202,42 +205,40 @@ hotkeyToChar = \case
     Hotkey9 -> '9'
     Hotkey0 -> '0'
 
-closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
-closeItemToSelectionItem w (NInt i) = do
-    e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
+closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
+closeItemToSelectionItem w i = do
+    e <- w ^? cWorld . lWorld . items . ix i
     let (pics, col) = closeItemToTextPictures e
     return
-        SelectionItem
+        SelItem
             { _siPictures = pics
             , _siHeight = length pics
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = col
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do
     bt <- w ^? cWorld . lWorld . buttons . ix i
     return
-        SelectionItem
+        SelItem
             { _siPictures = [btText bt]
             , _siHeight = 1
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = yellow
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 btText :: Button -> String
 btText bt = case _btEvent bt of
     ButtonPress {} -> "BUTTON"
     ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
-    ButtonAccessTerminal -> "TERMINAL"
+    ButtonAccessTerminal {} -> "TERMINAL"
 
-closeItemToTextPictures :: FloorItem -> ([String], Color)
-closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
-  where
-    it = _flIt flit
+closeItemToTextPictures :: Item -> ([String], Color)
+closeItemToTextPictures it = (basicItemDisplay it, itemInvColor $ baseCI it)

src/Dodge/Inventory/Swap.hs

@@ -3,6 +3,7 @@ module Dodge.Inventory.Swap (
     swapAnyExtraSelection
 ) where
 
+import NewInt
 import Dodge.SoundLogic
 import Dodge.Item.Grammar
 import Dodge.Base.You
@@ -23,11 +24,11 @@ swapInvItems ::
     World ->
     World
 swapInvItems f i w = fromMaybe w $ do
-    ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
+    ss <- w ^? hud . diSections . ix 0 . ssItems
     k <- f i ss
-    let updateselection = case w ^? hud . hudElement . diSelection . _Just of
-            Just (0, j,_) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
-            Just (0, j,_) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
+    let updateselection = case w ^? hud . diSelection . _Just of
+            Just (Sel 0 j _) | j == k -> hud . diSelection . _Just . slInt .~ i
+            Just (Sel 0 j _) | j == i -> hud . diSelection . _Just . slInt .~ k
             _ -> id
     return $
         w
@@ -43,28 +44,29 @@ swapInvItems f i w = fromMaybe w $ do
             & checkConnection InventoryConnectSound connectItemS i k
   where
     updatecreature k =
-        (crInv %~ IM.safeSwapKeys i k)
-            . (crManipulation . manObject . imSelectedItem .~ k)
+        (crInv . unNIntMap %~ IM.safeSwapKeys i k)
+            . (crManipulation . manObject . imSelectedItem .~ NInt k)
             . swapSite i k
             . swapSite k i
     cr = you w
-    swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
-        Just epos -> crEquipment . ix epos .~ b
+    swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
+        Just epos -> crEquipment . ix epos .~ NInt b
         Nothing -> id
 
 swapAnyExtraSelection :: Int -> Int -> World -> World
 swapAnyExtraSelection i k w = fromMaybe w $ do
-    is <- w ^? hud . hudElement . diSelection . _Just . _3
+    is <- w ^? hud . diSelection . _Just . slSet
     let f = if i `IS.member` is then IS.insert k else id
         g = if k `IS.member` is then IS.insert i else id
     return $
-        w & hud . hudElement . diSelection . _Just . _3
+        w & hud . diSelection . _Just . slSet
             %~ (f . g . IS.delete i . IS.delete k)
 
 checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
 checkConnection so s i j w = fromMaybe w $ do
-    inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
+    inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
     cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
+    let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
     let locs = invIndents inv  -- why indents?
     iit <- locs ^? ix i . _2
     jit <- locs ^? ix j . _2