rename debug terminal to console

appDodge/Main.hs

@@ -2,7 +2,6 @@ module Main (
     main,
 ) where
 
-import Dodge.StartNewGame
 import Control.Lens
 import Control.Monad
 import Control.Parallel
@@ -16,7 +15,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
@@ -101,8 +100,7 @@ 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

log/aGeneratedRoomLayout

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

log/attemptedSeeds

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

log/treeCluster

@@ -11,7 +11,7 @@ Seed: 7114951007332849727
 |
 5:corDoor
 |
-6:anRoom
+6:SingleRoom
 |
 7:corDoor
 |
@@ -35,7 +35,7 @@ Seed: 7114951007332849727
 |
 17:corDoor
 |
-18:PassthroughLockKeyLists-HELD {_ibtHeld = RLAUNCHER}
+18:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
 |
 19:corDoor
 |
@@ -87,7 +87,7 @@ Seed: 7114951007332849727
 |
 2:0:0:0:5:Corridor
 
-2:0:1:0:defaultRoom
+2:0:1:0:autoRect
 
 3:0:corDoor
 
@@ -111,7 +111,7 @@ Seed: 7114951007332849727
 |
 5:0:1:Corridor
 
-6:0:anRoom
+6:0:SingleRoom
 
 6:0:0:autoRect
 
@@ -125,7 +125,7 @@ Seed: 7114951007332849727
 
 8:0:0:RassThroughLockKeyLists
 |
-8:0:1:roomsContaining DEFAULTCRNAMEchaseCritchaseCritKEYCARD 0
+8:0:1:roomsContaining chaseCritchaseCritchaseCritKEYCARD 0
 
 8:0:0:0:keyCardRoomRunPast
 
@@ -153,7 +153,7 @@ Seed: 7114951007332849727
 
 10:0:0:autoDoor
 |
-10:0:1:doorToggle-8gon
+10:0:1:warningTerm-8gon
 |
 10:0:2:triggerDoorRoom
 |
@@ -203,27 +203,25 @@ Seed: 7114951007332849727
 |
 17:0:1:Corridor
 
-18:0:PassthroughLockKeyLists-HELD {_ibtHeld = RLAUNCHER}
+18:0:PassthroughLockKeyLists-HELD {_ibtHeld = SNIPERRIFLE}
 
 18:0:0:RassThroughLockKeyLists
 |
-18:0:1:roomsContaining chaseCritchaseCritTUBETUBEHARDWARE
+18:0:1:roomsContaining chaseCritchaseCritSNIPERRIFLE
 
-18:0:0:0:lasCenSensEdge
+18:0:0:0:longRoomRunPast
 
 18:0:0:0:0:autoDoor
 |
-18:0:0:0:1:8gon
+18:0:0:0:1:rect
 |
-+- 18:0:0:0:2:triggerDoorRoom
++- 18:0:0:0:2:autoDoor
-|  |
+|
-|  18:0:0:0:3:autoDoor
+18:0:0:0:3:Corridor
 |
 18:0:0:0:4:autoDoor
-|
-18:0:0:0:5:Corridor
 
-18:0:1:0:autoRect
+18:0:1:0:rectPillars
 
 19:0:corDoor
 

src/Dodge/Annotation.hs

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

src/Dodge/Annotation/Data.hs

@@ -11,33 +11,15 @@ import System.Random
 
 type MTRS = MetaTree Room String
 
-data LayoutVars = LayVars
-    { _lyGen :: StdGen
-    , _lyCounter :: Int
-    }
-
 data Annotation
-    = OnwardList [Annotation]
+    = ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation
---    | IntAnno (Int -> Annotation)
+    | OnwardList [Annotation]
---    | AnRoom (State StdGen Room)
+    | IntAnno (Int -> Annotation)
-    | AnTree (State LayoutVars (MetaTree Room String))
+    | AnRoom (State StdGen Room)
+    | AnTree (State StdGen (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,4 +1,6 @@
-module Dodge.AssignHotkey (assignHotkey) where
+module Dodge.AssignHotkey (
+    assignHotkey,
+) where
 
 import Dodge.Data.Equipment.Misc
 import Control.Lens
@@ -9,12 +11,11 @@ import NewInt
 -- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or
 -- World
 assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld
-assignHotkey i hk lw = lw
+assignHotkey (NInt itid) hk lw = lw
         & handleoldposition
-        & hotkeys . at hk ?~ i
+        & hotkeys . at hk ?~ NInt itid
-        -- & imHotkeys . unNIntMap . at itid ?~ hk
+        & imHotkeys . unNIntMap . at itid ?~ hk
-        & imHotkeys . at i ?~ hk
   where
     handleoldposition = fromMaybe id $ do
-        oldi <- lw ^? hotkeys . ix hk
+        olditid <- lw ^? hotkeys . ix hk . unNInt
-        return $ imHotkeys . at oldi .~ Nothing
+        return $ imHotkeys . unNIntMap . at olditid .~ 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/NewID.hs

@@ -4,13 +4,20 @@ 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/You.hs

@@ -5,9 +5,8 @@ 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
@@ -16,15 +15,13 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
 yourSelectedItem :: World -> Maybe Item
 yourSelectedItem w = do
     i <- you w ^? crManipulation . manObject . imSelectedItem
-    j <- _crInv (you w) ^? ix i
+    _crInv (you w) IM.!? i
-    w ^? cWorld . lWorld . items . ix j
 
 yourRootItem :: World -> Maybe Item
 yourRootItem w = do
     i <- you w ^? crManipulation . manObject . imRootSelectedItem
-    j <- _crInv (you w) ^? ix i
+    _crInv (you w) IM.!? i
-    w ^? cWorld . lWorld . items . ix j
 
-yourInv :: World -> NewIntMap InvInt Item
+yourInv :: World -> IM.IntMap Item
-yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
+yourInv = _crInv . you
 

src/Dodge/Bullet.hs

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

src/Dodge/Button/Draw.hs

@@ -11,7 +11,8 @@ 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
+    ButtonAccessTerminal -> mempty
+--    ButtonDoNothing -> mempty
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt

src/Dodge/Button/Event.hs

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

src/Dodge/Combine.hs

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

src/Dodge/Corpse/Make.hs

@@ -9,10 +9,12 @@ import Dodge.Data.Creature
 import Geometry
 import Shape
 import ShapePicture
-import qualified Data.IntMap.Strict as IM
 
-makeCorpse :: IM.IntMap Item -> Creature -> Corpse
+makeCorpse :: Creature -> Corpse
-makeCorpse m cr =
+makeCorpse = makeDefaultCorpse
+
+makeDefaultCorpse :: Creature -> Corpse
+makeDefaultCorpse cr =
     defaultCorpse
         & cpPos .~ _crPos cr
         & cpDir .~ _crDir cr
@@ -20,8 +22,8 @@ makeCorpse m cr =
             .~ noPic
                 ( scaleSH (V3 crsize crsize crsize) $
                     mconcat
-                        [ colorSH (_skinHead cskin) $ deadScalp m cr
+                        [ colorSH (_skinHead cskin) $ deadScalp cr
-                        , colorSH (_skinUpper cskin) $ deadUpperBody m cr
+                        , colorSH (_skinUpper cskin) $ deadUpperBody cr
                         , rotmdir $ colorSH (_skinLower cskin) $ deadFeet 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,6 +38,7 @@ 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
@@ -57,34 +58,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 = xs -- IM.insert (IM.newKey xs) frontArmour xs
+    insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
 
 {- | The creature you control.
 ID 0.
@@ -98,7 +99,7 @@ startCr =
         & crMvDir .~ pi / 2
         & crID .~ 0
         & crHP .~ 10000
-        & crInv .~ mempty
+        & crInv .~ startInventory
         & crFaction .~ PlayerFaction
 --        & crMvType .~ MvWalking yourDefaultSpeed
         & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
@@ -238,7 +239,7 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
-    'P' -> [burstRifle , tinMag, bulletSynthesizer, battery]
+    'P' -> [burstRifle , tinMag, bulletSynthesizer]
     'T' -> testInventory
     'U' ->
         [targetingScope tt | tt <- [minBound .. maxBound]]

src/Dodge/Creature/Action.hs

@@ -13,7 +13,6 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
-import NewInt
 import Dodge.Creature.MoveType
 import Dodge.Creature.Radius
 import Dodge.Item.BackgroundEffect
@@ -167,26 +166,22 @@ 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 w' =
+dropItem cr invid =
     doanyitemdropeffect
         . maybeshiftseldown
-        . rmInvItem (_crID cr) (NInt invid)
+        . rmInvItem (_crID cr) invid
         . copyItemToFloor (_crPos cr) itm -- . mayberemoveequip
         . 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") $ do
+    itm = fromMaybe (error "dropItem cannot find item") $ cr ^? crInv . ix invid
-        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
@@ -195,8 +190,8 @@ dropItem cr invid w' =
 youDropItem :: World -> World
 youDropItem w = fromMaybe w $ do
     curpos <-
-        cr ^? crManipulation . manObject . imSelectedItem . unNInt
+        cr ^? crManipulation . manObject . imSelectedItem
-            <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
+            <|> fmap fst (IM.lookupMax (cr ^. crInv))
     --guard $ not $ _crInvLock cr
     guard $ not $ w ^. cWorld . lWorld . lInvLock
     return $ case cr ^. crStance . posture of

src/Dodge/Creature/ArmourChase.hs

@@ -8,18 +8,18 @@ import Control.Lens
 import Dodge.Creature.ChaseCrit
 import Dodge.Data.Creature
 import Dodge.Default
---import Dodge.Item.Equipment
+import Dodge.Item.Equipment
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
 
 flockArmourChaseCrit :: Creature
 flockArmourChaseCrit =
     defaultCreature
         { _crName = "armourChaseCrit"
         , _crHP = 300
-        , _crInv = mempty
+        , _crInv =
---            IM.fromList
+            IM.fromList
---                [ --(0, frontArmour)
+                [ (0, frontArmour)
---                ]
+                ]
         , _crActionPlan =
             ActionPlan
                 { _apImpulse = []
@@ -36,11 +36,11 @@ armourChaseCrit :: Creature
 armourChaseCrit =
     chaseCrit
         { _crName = "armourChaseCrit"
---        , --, _crUpdate = defaultImpulsive []
+        , --, _crUpdate = defaultImpulsive []
---          _crInv =
+          _crInv =
---            IM.fromList
+            IM.fromList
---                [ --(0, frontArmour)
+                [ (0, frontArmour)
---                ]
+                ]
 --        , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
         }
         & 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)]
+        { _crInv = IM.fromList [(0, autoRifle)]
-         _crHP = 300
+        , _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 Dodge.Data.Equipment.Misc
---import Control.Lens
+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
+        & crInv . at 0 ?~ wristInvisibility
---        & crEquipment . at OnLeftWrist ?~ 0
+        & crEquipment . at OnLeftWrist ?~ 0
 
 chaseCrit :: Creature
 chaseCrit =

src/Dodge/Creature/Damage.hs

@@ -20,10 +20,9 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
     _ -> w & damageHP cr (_dmAmount dm)
 
 applyPiercingDamage :: Creature -> Damage -> World -> World
-applyPiercingDamage cr dm w
+applyPiercingDamage cr dm
-    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
+    | crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
-        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
+    | otherwise = f . damageHP cr (_dmAmount dm)
-    | 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,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.HandPos (
     translatePointToLeftHand,
     translatePointToRightHand,
@@ -15,8 +14,6 @@ module Dodge.Creature.HandPos (
     headPQ,
 ) where
 
---import Dodge.Data.Equipment.Misc
-import qualified Data.IntMap.Strict as IM
 import qualified Quaternion as Q
 import Control.Lens
 import Dodge.Creature.Test
@@ -24,22 +21,14 @@ import Dodge.Data.Creature
 import Geometry
 import ShapePicture
 
-translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
+translatePointToRightHand :: Creature -> Point3 -> Point3
-translatePointToRightHand m cr p =  fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
+translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
 
---equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
+rightHandPQ :: Creature -> Point3Q
---equipSitePQ = \case
+rightHandPQ cr
---    OnRightWrist -> rightHandPQ
+    | oneH cr = (V3 11 (-3) 20, Q.qID)
---    OnLeftWrist -> leftHandPQ
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
---    OnBack -> backPQ
+    | twoFlat cr = (V3 4 (-8) 10, Q.qID)
---    OnChest -> chestPQ
---    _ -> undefined
-
-rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
-rightHandPQ m cr
-    | oneH m cr = (V3 11 (-3) 20, Q.qID)
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
-    | twoFlat m cr = (V3 4 (-8) 10, Q.qID)
     | otherwise = case cr ^? crStance . carriage of
         Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
         Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
@@ -48,20 +37,20 @@ rightHandPQ m 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 :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToRightHand :: Creature -> SPic -> SPic
-translateToRightHand m = overPosSP . translatePointToRightHand m
+translateToRightHand = overPosSP . translatePointToRightHand
 
-translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToRightWrist :: Creature -> SPic -> SPic
-translateToRightWrist m cr =  overPosSP
+translateToRightWrist cr =  overPosSP
-    (\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
+    (\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
 
-leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
+leftHandPQ :: Creature -> Point3Q
-leftHandPQ m cr
+leftHandPQ cr
-    | oneH m cr = (V3 0 off 10, Q.qz 0.4)
+    | oneH cr = (V3 0 off 10, Q.qz 0.4)
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
-    | twoFlat m cr = (V3 4 8 10, Q.qID)
+    | twoFlat cr = (V3 4 8 10, Q.qID)
     | otherwise = case cr ^? crStance . carriage of
         Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
         Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
@@ -70,17 +59,17 @@ leftHandPQ m 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 :: IM.IntMap Item -> Creature -> Point3 -> Point3
+translatePointToLeftHand :: Creature -> Point3 -> Point3
-translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
+translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
 
-translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToLeftHand :: Creature -> SPic -> SPic
-translateToLeftHand m = overPosSP . translatePointToLeftHand m
+translateToLeftHand = overPosSP . translatePointToLeftHand
 
-translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToLeftWrist :: Creature -> SPic -> SPic
-translateToLeftWrist m cr = overPosSP 
+translateToLeftWrist cr = overPosSP 
-    (\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+    (\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
 
 leftLegPQ :: Creature -> Point3Q
 leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -113,26 +102,26 @@ 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 :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToHead :: Creature -> SPic -> SPic
-translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
+translateToHead cr = overPosSP (\p -> fst $ (headPQ cr `Q.comp` (p,Q.qID)))
 
-headPQ :: IM.IntMap Item -> Creature -> Point3Q
+headPQ :: Creature -> Point3Q
-headPQ m cr
+headPQ cr
-    | twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
+    | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
-    | oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
+    | 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 :: IM.IntMap Item -> Creature -> Point3 -> Point3
+translatePointToHead :: Creature -> Point3 -> Point3
-translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
+translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
 
-chestPQ :: IM.IntMap Item -> Creature -> Point3Q
+chestPQ :: Creature -> Point3Q
-chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
+chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
 
-translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToChest :: Creature -> SPic -> SPic
-translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
+translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
 
-backPQ :: IM.IntMap Item -> Creature -> Point3Q
+backPQ :: Creature -> Point3Q
-backPQ m cr
+backPQ cr
-    | oneH m cr = (V3 0 0 10, Q.qz 0.5)
+    | oneH cr = (V3 0 0 10, Q.qz 0.5)
-    | twists m cr = (V3 0 3 10, Q.qz (-1.5))
+    | twists cr = (V3 0 3 10, Q.qz (-1.5))
     | otherwise = (V3 0 0 10, Q.qz 0)

src/Dodge/Creature/Impulse.hs

@@ -4,7 +4,6 @@ module Dodge.Creature.Impulse (
     impulsiveAIBefore,
 ) where
 
-import NewInt
 import Dodge.Creature.MoveType
 import Data.Foldable
 import Control.Monad.State
@@ -43,8 +42,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 (w ^. cWorld . lWorld) cr
+    Move p -> crup $ crMvBy p cr
-    MoveForward x -> crup $ crMvForward x (w ^. cWorld . lWorld) cr
+    MoveForward x -> crup $ crMvForward x cr
     Turn a -> crup $ cr & crDir +~ a
     TurnToward p a -> crup $ creatureTurnToward p a cr
     TurnTo p -> crup $ creatureTurnTo p cr
@@ -52,10 +51,10 @@ followImpulse cr w imp = case imp of
     UseItem -> undefined
 --    UseItem -> (useSelectedItem $ _crID cr
 --        , cr)
-    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem (NInt i) (NInt i) mempty
+    SwitchToItem i -> crup $ cr & crManipulation . manObject .~ SelectedItem i i mempty
     Melee cid' ->
         ( hitCr cid'
-        , crMvAbsolute (w ^. cWorld . lWorld) (10 *.* normalizeV (posFromID cid' -.- cpos)) $ cr & crType . meleeCooldown .~ 20
+        , crMvAbsolute (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)
@@ -72,7 +71,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 (w ^. cWorld . lWorld) cr
+    MvForward -> crup $ crMvForward speed cr
     MvTurnToward p ->
         crup $
             creatureTurnToward p (turnRad $ safeAngleVV (p -.- cpos) (unitVectorAtAngle cdir)) cr

src/Dodge/Creature/Impulse/Movement.hs

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

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,7 +2,6 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
-import NewInt
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.ComposedItem
@@ -14,12 +13,12 @@ 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 (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr) ^? ix invid . _2
+    itmloc <- invIndents (_crInv cr) ^? ix invid . _2
     useItemLoc cr itmloc pt w
 
 useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -63,44 +62,40 @@ activateDetonator det = fromMaybe id $ do
     pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
 
-toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
+toggleEquipmentAt :: Int -> Creature -> World -> World
 toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
     DoNotMoveEquipment -> w
     PutOnEquipment{_allocNewPos = newp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
-            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
             & onequip itm cr
     MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp .~ Nothing
-            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
     SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp ?~ sid
-            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
-            & toitems . ix (invidtoitid sid) . itLocation . ilEquipSite ?~ oldp
+            & crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
     ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
-            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
+            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
-            & toitems . ix (invidtoitid rid) . itLocation . ilEquipSite .~ Nothing
+            & crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
     RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
-            & toitems . ix itid . itLocation . ilEquipSite .~ Nothing
+            & crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
             & onremove itm cr
   where
-    invidtoitid :: NewInt InvInt -> Int
-    invidtoitid i = cr ^?! crInv . ix i -- _crInv cr IM.! i
-    toitems = cWorld . lWorld . items
-    itid = invidtoitid invid
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
-    itmat i = w ^?! cWorld . lWorld . items . ix (invidtoitid i)
+    itmat i = _crInv cr IM.! i
     itm = itmat invid
     onequip itm' = effectOnEquip itm'
     onremove itm' = effectOnRemove 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)]
+        { _crInv = IM.fromList [(0, rLauncher)]
-         _crHP = 300
+        , _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 Dodge.Item.Held.Stick
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
 --import Picture
 
 ltAutoCrit :: Creature
 ltAutoCrit =
     defaultCreature
-        { --_crInv = IM.fromList [(0, autoPistol)]
+        { _crInv = IM.fromList [(0, autoPistol)]
-         _crHP = 500
+        , _crHP = 500
         }
 --        & crType .~ LtAutoCrit
 --        & crType . humanoidAI .~ LtAutoAI

src/Dodge/Creature/Picture.hs

@@ -10,7 +10,6 @@ module Dodge.Creature.Picture (
 ) where
 
 import Dodge.Creature.HandPos
-import qualified Data.IntMap.Strict as IM
 import Control.Lens
 import Dodge.Creature.Radius
 import Dodge.Creature.Shape
@@ -26,20 +25,20 @@ import Shape
 --import Shape
 import ShapePicture
 
-basicCrPict :: IM.IntMap Item -> Creature -> SPic
+basicCrPict :: Creature -> SPic
-basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
+basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
 
 crCamouflage :: Creature -> CamouflageStatus
 crCamouflage _ = FullyVisible
 
-basicCrShape :: IM.IntMap Item -> Creature -> Shape
+basicCrShape :: Creature -> Shape
-basicCrShape m cr
+basicCrShape cr
     | crCamouflage cr == Invisible = mempty
     | otherwise =
         scaleSH (V3 crsize crsize crsize) $
             mconcat
-                [ colorSH (_skinHead cskin) $ scalp m cr
+                [ colorSH (_skinHead cskin) $ scalp cr
-                , colorSH (_skinUpper cskin) $ upperBody m cr
+                , colorSH (_skinUpper cskin) $ upperBody cr
                 , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                 ]
   where
@@ -68,17 +67,17 @@ deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
 deadFeet = feet
 
-arms :: IM.IntMap Item -> Creature -> Shape
+arms :: Creature -> Shape
 {-# INLINE arms #-}
-arms m cr =
+arms cr =
     (^. _1) $
-        translateToRightHand m cr aHand
+        translateToRightHand cr aHand
-            <> translateToLeftHand m cr aHand
+            <> translateToLeftHand cr aHand
   where
     aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
 
-deadScalp :: IM.IntMap Item -> Creature -> Shape
+deadScalp :: Creature -> Shape
-deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
+deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
 
 deadRot :: Creature -> Shape -> Shape
 deadRot cr = overPosSH (Q.rotateToZ d)
@@ -89,18 +88,18 @@ deadRot cr = overPosSH (Q.rotateToZ d)
             (addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
             (damageDirection $ _crDamage cr)
 
-scalp :: IM.IntMap Item -> Creature -> Shape
+scalp :: Creature -> Shape
 {-# INLINE scalp #-}
-scalp m cr = overPosSH (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID))) fhead
+scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) 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
   where
     fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5
 
-torso :: IM.IntMap Item -> Creature -> Shape
+torso :: Creature -> Shape
 {-# INLINE torso #-}
-torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
+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
@@ -117,20 +116,20 @@ torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
             ]
     aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
-deadUpperBody :: IM.IntMap Item -> Creature -> Shape
+deadUpperBody :: Creature -> Shape
-deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
+deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
 baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 
-upperBody :: IM.IntMap Item -> Creature -> Shape
+upperBody :: Creature -> Shape
 {-# INLINE upperBody #-}
-upperBody m cr = arms m cr <> shoulderSH (torso m cr)
+upperBody cr = arms cr <> shoulderSH (torso cr)
 
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
 
-drawEquipment :: IM.IntMap Item -> Creature -> SPic
+drawEquipment :: Creature -> SPic
 {-# INLINE drawEquipment #-}
-drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
+drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)

src/Dodge/Creature/PistolCrit.hs

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

src/Dodge/Creature/State.hs

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

src/Dodge/Creature/Statistics.hs

@@ -6,9 +6,8 @@ module Dodge.Creature.Statistics (
     crIntelligence,
 ) where
 
-import NewInt
-import Dodge.Data.LWorld
 import Data.Maybe
+import Dodge.Data.Creature
 import qualified IntMapHelp as IM
 import LensHelp
 
@@ -43,11 +42,11 @@ crIntelligence  cr = case cr ^. crType of
     LampCrit {} -> 0
     
 
-getCrMoveSpeed :: LWorld -> Creature -> Int
+getCrMoveSpeed :: Creature -> Int
-getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
+getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
 
-strFromEquipment :: LWorld -> Creature -> Int
+strFromEquipment :: Creature -> Int
-strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
+strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
 
 equipmentStrValue :: Item -> Int
 equipmentStrValue itm = case _itType itm of
@@ -55,17 +54,14 @@ equipmentStrValue itm = case _itType itm of
     EQUIP POWERLEGS -> 3
     _ -> 0
 
-crCurrentEquipment :: LWorld -> Creature -> NewIntMap InvInt Item
+crCurrentEquipment :: Creature -> IM.IntMap Item
-crCurrentEquipment lw = over unNIntMap (IM.filter (isJust . (^? itLocation . ilEquipSite . _Just))) . fmap f . _crInv
+crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
-  where
-    f i = lw ^?! items . ix i
 
-strFromHeldItem :: LWorld -> Creature -> Int
+strFromHeldItem :: Creature -> Int
-strFromHeldItem lw cr = fromMaybe 0 $ do
+strFromHeldItem cr = fromMaybe 0 $ do
     Aiming <- cr ^? crStance . posture
     i <- cr ^? crManipulation . manObject . imRootSelectedItem
-    j <- cr ^? crInv . ix i
+    fmap (negate . itemWeight) $ cr ^? crInv . ix i
-    fmap (negate . itemWeight) $ lw ^? items . ix j
 
 itemWeight :: Item -> Int
 itemWeight it = case it ^. itType of

src/Dodge/Creature/Test.hs

@@ -24,8 +24,6 @@ module Dodge.Creature.Test (
     crSafeDistFromTarg,
 ) where
 
-import NewInt
-import qualified Data.IntMap.Strict as IM
 import Dodge.Item.Grammar
 import Dodge.Creature.Radius
 import Dodge.Data.Equipment.Misc
@@ -92,33 +90,35 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
 --crCanShoot :: Creature -> Bool
 --crCanShoot cr = crIsAiming cr && crWeaponReady cr
 
-crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
+crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as m cr = crIsAiming cr && mitstance == Just as
+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 (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
+        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
         return $ aimStance itm
         --cr ^? crInv . ix i . itUse . heldAim . aimStance
 
-oneH :: IM.IntMap Item -> Creature -> Bool
+oneH :: Creature -> Bool
 oneH = crInAimStance OneHand
 
-twoFlat :: IM.IntMap Item -> Creature -> Bool
+twoFlat :: Creature -> Bool
 twoFlat = crInAimStance TwoHandFlat
 
-twists :: IM.IntMap Item -> Creature -> Bool
+twists :: Creature -> Bool
-twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
+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 :: IM.IntMap Item -> Point2 -> Creature -> Bool
+crIsArmouredFrom :: Point2 -> Creature -> Bool
-crIsArmouredFrom m p cr = fromMaybe False $ do
+crIsArmouredFrom = hasFrontArmour
+
+hasFrontArmour :: Point2 -> Creature -> Bool
+hasFrontArmour p cr = fromMaybe False $ do
     invid <- cr ^? crEquipment . ix OnChest
-    itid <- cr ^? crInv . ix invid
+    ittype <- cr ^? crInv . ix invid . itType
-    ittype <- m ^? ix itid . itType
     return $
         EQUIP FRONTARMOUR == ittype
             && p /= _crOldPos cr
@@ -127,9 +127,9 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
     -- even though angleVV can generate NaN, the comparison seems to deal with it
 
     frontarmdirection
-        | crInAimStance OneHand m cr = 0.5
+        | crInAimStance OneHand cr = 0.5
-        | crInAimStance TwoHandUnder m cr = negate 1
+        | crInAimStance TwoHandUnder cr = negate 1
-        | crInAimStance TwoHandOver m cr = negate 1
+        | crInAimStance TwoHandOver cr = negate 1
         | otherwise = 0
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool

src/Dodge/Creature/Update.hs

@@ -1,6 +1,5 @@
 module Dodge.Creature.Update (updateCreature) where
 
-import NewInt
 import Color
 import qualified Data.IntMap.Strict as IM
 import qualified Data.List as List
@@ -62,7 +61,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
@@ -100,14 +99,14 @@ destroyCreature cr
 
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World
-corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
+corpseOrGib cr = 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
     _ -> addcorpse thecorpse
   where
     addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
-    thecorpse = makeCorpse (w ^. cWorld . lWorld . items) cr
+    thecorpse = makeCorpse cr
 
 scorchSPic :: SPic -> SPic
 scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)
@@ -117,7 +116,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 . _unNIntMap $ _crInv cr
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
 
 chasmTest :: Creature -> World -> World
 chasmTest cr w

src/Dodge/Creature/YourControl.hs

@@ -4,7 +4,6 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import qualified Data.IntMap.Strict as IM
 import Dodge.Creature.MoveType
 import Dodge.Data.Equipment.Misc
 import Control.Monad
@@ -49,15 +48,15 @@ handleHotkeys w
       , Just hk <-
             listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
       , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
+      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
-        w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
+        w & cWorld . lWorld %~ assignHotkey itid hk
     | ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
       , Just hk <-
             listToMaybe . mapMaybe scancodeToHotkey . M.keys $
                 w ^. input . pressedKeys
       , Just itid <- lw ^? hotkeys . ix hk . unNInt
-      , Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
+      , Just invid <- lw ^? itemLocations . ix itid . ilInvID =
-        w & invSetSelectionPos 0 (_unNInt invid)
+        w & invSetSelectionPos 0 invid
     | otherwise =
         M.foldl'
             useHotkey
@@ -70,7 +69,7 @@ handleHotkeys w
 
 useHotkey :: World -> (NewInt ItmInt, Int) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
-    invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
+    invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
     useItem invid pt w
 
 hotkeyToScancode :: Hotkey -> SDL.Scancode
@@ -118,7 +117,7 @@ scancodeToHotkey x = case x of
  within wasdMovement should probably be done first
 -}
 wasdWithAiming :: World -> Creature -> Creature
-wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
+wasdWithAiming w cr = wasdAim inp w $ wasdMovement inp cam speed cr
   where
     speed = _mvSpeed $ crMvType cr
     inp = w ^. input
@@ -128,34 +127,31 @@ wasdAim :: Input -> World -> Creature -> Creature
 wasdAim inp w cr
     | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
       , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
-        setAimPosture (w ^. cWorld . lWorld . items) cr
+        setAimPosture cr
-    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) 
+    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn mousedir cr
-        mousedir cr
+    | Aiming <- cr ^. crStance . posture = removeAimPosture cr
-    | Aiming <- cr ^. crStance . posture = removeAimPosture m cr
     | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
-    m = w ^. cWorld . lWorld . items
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
 
-setAimPosture :: IM.IntMap Item -> Creature -> Creature
+setAimPosture :: Creature -> Creature
-setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- twoHandTwistAmount)
+setAimPosture = (crStance . posture .~ Aiming) . doAimTwist (- twoHandTwistAmount)
 
-doAimTwist :: IM.IntMap Item -> Float -> Creature -> Creature
+doAimTwist :: Float -> Creature -> Creature
-doAimTwist m x cr = fromMaybe cr $ do
+doAimTwist x cr = fromMaybe cr $ do
     itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
-    itid <- cr ^? crInv . ix itRef
+    astance <- fmap itemBaseStance $ cr ^? crInv . ix itRef
-    astance <- fmap itemBaseStance $ m ^? ix itid
     guard $ astance == TwoHandOver || astance == TwoHandUnder
     return $ cr & crDir +~ x
 
-removeAimPosture :: IM.IntMap Item -> Creature -> Creature
+removeAimPosture :: Creature -> Creature
-removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
+removeAimPosture = (crStance . posture .~ AtEase) . doAimTwist twoHandTwistAmount
 
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi
 
-wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
+wasdMovement :: Input -> Camera -> Float -> Creature -> Creature
-wasdMovement lw inp cam speed = theMovement . setMvAim
+wasdMovement inp cam speed = theMovement . setMvAim
   where
     setMvAim = fromMaybe id $ do
         dir <- safeArgV movDir
@@ -164,14 +160,14 @@ wasdMovement lw inp cam speed = theMovement . setMvAim
     movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
     theMovement
         | movDir == V2 0 0 = id
-        | otherwise = crMvAbsolute lw (speed *.* movAbs)
+        | otherwise = crMvAbsolute (speed *.* movAbs)
 
-aimTurn :: LWorld -> Float -> Creature -> Creature
+aimTurn :: Float -> Creature -> Creature
-aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
+aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
   where
     x = fromMaybe 1 $ do
         itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
-        fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
+        fmap itemBulkiness $ cr ^? crInv . ix itRef . itType
 
 itemBulkiness :: ItemType -> Float
 itemBulkiness = \case
@@ -231,6 +227,6 @@ tryClickUse pkeys w = fromMaybe w $ do
         ^? cWorld . lWorld . creatures . ix 0
             . crManipulation
             . manObject
-            . imSelectedItem . unNInt of
+            . imSelectedItem of
         Just invid -> useItem invid ltime w
         Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w

src/Dodge/Data/Button.hs

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

src/Dodge/Data/CardinalPoint.hs

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

src/Dodge/Data/Creature.hs

@@ -17,7 +17,6 @@ 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
@@ -33,7 +32,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
@@ -46,9 +45,9 @@ data Creature = Creature
     , _crType :: CreatureType
     , _crID :: Int
     , _crHP :: Int
-    , _crInv :: NewIntMap InvInt Int
+    , _crInv :: IM.IntMap Item
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite (NewInt InvInt)
+    , _crEquipment :: M.Map EquipSite Int
     , _crDamage :: [Damage]
     , _crPain :: Int
     , _crStance :: Stance

src/Dodge/Data/Equipment/Misc.hs

@@ -25,7 +25,7 @@ data EquipSite
     | OnLeftWrist
     | OnRightWrist
     | OnLegs
---    | OnSpecial
+    | OnSpecial
     deriving (Eq, Ord, Show, Read)
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Data/FloorItem.hs

@@ -5,14 +5,15 @@
 
 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 {_flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
+data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: NewInt FloorInt}
     --deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''FloorItem

src/Dodge/Data/GenWorld.hs

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

src/Dodge/Data/HUD.hs

@@ -23,6 +23,7 @@ data HUDElement
         , _diInvFilter :: Maybe String
         , _diCloseFilter :: Maybe String
         }
+--    | DisplayCarte
 
 data SubInventory
     = NoSubInventory
@@ -37,6 +38,7 @@ data SubInventory
         , _ciSelection :: Maybe (Int, Int, IS.IntSet)
         , _ciFilter :: Maybe String
         }
+--    | LockedInventory
     | DisplayTerminal {_termID :: Int}
 
 data HUD = HUD
@@ -44,7 +46,7 @@ data HUD = HUD
     , _carteCenter :: Point2
     , _carteZoom :: Float
     , _carteRot :: Float
-    , _closeItems :: [NewInt ItmInt]
+    , _closeItems :: [NewInt FloorInt]
     , _closeButtons :: [Int]
     }
 

src/Dodge/Data/Input.hs

@@ -5,7 +5,6 @@
 
 module Dodge.Data.Input where
 
-import Dodge.Data.Terminal.Status
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Geometry.Data
@@ -22,16 +21,15 @@ data MouseContext
         , _mcoAboveSelect :: Maybe (Int,Int)
         , _mcoBelowSelect :: Maybe (Int,Int)
         }
---    | OverInvDragSelect { _mcoSecSelStart :: (Int,Int), _mcoSelEnd :: Maybe Int }
+    | OverInvDragSelect { _mcoSecSelStart :: (Int,Int), _mcoSelEnd :: Maybe 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
-    | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
+    | OverTerminalReturn {_mcoTermID :: Int}
-    | OutsideTerminal
+    | OverTerminalEscape
     | MouseGameRotate
     deriving (Show)
 

src/Dodge/Data/Item.hs

@@ -3,6 +3,7 @@
 
 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,
@@ -11,18 +12,30 @@ 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
@@ -40,8 +53,7 @@ data ItemScroll
     | ItemScrollInt {_itsInt :: Int}
     | ItemScrollIntRange {_itsMax :: Int, _itsRangeInt :: Int}
 
-data ItemTargeting
+data ItemTargeting = NoItTargeting
-    = NoItTargeting
     | ItTargeting
     { _itTgPos :: Maybe Point2
     , _itTgID :: Maybe Int
@@ -49,8 +61,11 @@ data ItemTargeting
     }
 
 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,15 +5,17 @@
 {-# 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
@@ -26,29 +28,20 @@ data ItmInt = ItmInt
 data ItemLocation
     = InInv 
         { _ilCrID :: Int
-        , _ilInvID :: NewInt InvInt
+        , _ilInvID :: Int
         , _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,8 +5,6 @@
 
 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
@@ -22,9 +20,9 @@ data Manipulation -- should be ManipulatedObject?
 data ManipulatedObject
     = SortInventory
     | SelectedItem
-        { _imSelectedItem :: NewInt InvInt
+        { _imSelectedItem :: Int
-        , _imRootSelectedItem :: NewInt InvInt
+        , _imRootSelectedItem :: Int
-        , _imAttachedItems :: IS.IntSet -- this should probably be NewIntSet InvInt also
+        , _imAttachedItems :: IS.IntSet
         }    
     | 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
-    , _items :: IM.IntMap Item
+    , _itemLocations :: IM.IntMap ItemLocation
     , _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 :: IM.IntMap FloorItem
+    , _floorItems :: NewIntMap FloorInt 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 :: Int
+    { _tuWeapon :: Item
     , _tuTurnSpeed :: Float
     , _tuFireTime :: Int
     , _tuDir :: Float

src/Dodge/Data/Machine/Sensor.hs

@@ -36,6 +36,7 @@ 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

@@ -5,8 +5,6 @@
 
 module Dodge.Data.RightButtonOptions where
 
-import Dodge.Data.Item.Location
-import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
@@ -29,11 +27,11 @@ data EquipmentAllocation
     | SwapEquipment
         { _allocNewPos :: EquipSite
         , _allocOldPos :: EquipSite
-        , _allocSwapID :: NewInt InvInt
+        , _allocSwapID :: Int
         }
     | ReplaceEquipment
         { _allocNewPos :: EquipSite
-        , _allocRemoveID :: NewInt InvInt
+        , _allocRemoveID :: Int
         }
     | RemoveEquipment
         { _allocOldPos :: EquipSite

src/Dodge/Data/RoomCluster.hs

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

src/Dodge/Data/SelectionList.hs

@@ -41,14 +41,22 @@ data SelectionWidth
     | UseItemWidth
 
 data SelectionItem a
-    = SelItem
+    = SelectionItem
+        { _siPictures :: [String]
+        , _siHeight :: Int
+        , _siWidth :: Int
+        , _siIsSelectable :: Bool
+        , _siColor :: Color
+        , _siOffX :: Int
+        , _siPayload :: a
+        }
+    | SelectionInfo
         { _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
-    | ButtonSound Int
+    | LeverSound Int
     | Explosion Int
     | Tap Int
     | EBSound Int

src/Dodge/Data/Terminal.hs

@@ -8,6 +8,8 @@ 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
@@ -16,7 +18,10 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.BlBl
 import Dodge.Data.Terminal.Status
 import Dodge.Data.WorldEffect
-import Sound.Data
+
+--data TerminalInput = TerminalInput
+--    { _tiSel :: (Int, Int)
+--    }
 
 data Terminal = Terminal
     { _tmID :: Int
@@ -31,6 +36,7 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
+--    , _tmPartialCommand :: Maybe TerminalCommand
     }
 
 data TerminalLineString = TerminalLineConst String Color
@@ -46,26 +52,59 @@ data TerminalToggle = TerminalToggle
     , _ttDeathEffect :: BlBl
     }
 
-data TCom
+data EffectArguments
-    = TCInfo String String -- this may not be necessary, to revisit
+    = 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
     | TCBase
     | TCDamageCommand
     | TCSensorInfo
+    | TCToggles
+
+--data TEff = TEff
+--    { _teffHelp :: String
+--    , _teffArgs :: PTE.TrieMap Char [TerminalLine]
+--    }
 
 data TmWdWd
     = TmWdId
-    | TmWdWdPowerDownTerminal
+    | TmWdWdDisconnectTerminal
-    | TmWdWdDeactivateTerminal
     | TmWdWdfromWdWd WdWd
     | TmWdWdTermSound SoundID
     | TmWdWdDoDeathTriggers
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
---    | TmGetSensor String
+    | TmGetDamageCoding SensorType
+    | TmGetSensor String
+--    | TmDisplayCommands
 
 makeLenses ''Terminal
 makeLenses ''TerminalLine
 makeLenses ''TerminalToggle
+makeLenses ''EffectArguments
+--makeLenses ''TerminalCommand
 makeLenses ''TCom
 concat
     <$> mapM
@@ -73,6 +112,9 @@ concat
         [ ''TerminalLineString
         , ''TerminalLine
         , ''TerminalToggle
+        , ''EffectArguments
+        , ''TerminalCommandEffect
+--        , ''TerminalCommand
         , ''TCom
         , ''TmWdWd
         , ''Terminal

src/Dodge/Data/Terminal/Status.hs

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

src/Dodge/Data/WorldEffect.hs

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

src/Dodge/Debug/Console.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE TupleSections #-}
 
-module Dodge.Debug.Terminal where
+module Dodge.Debug.Console where
 
 import Data.Foldable
---import Dodge.Item.Location.Initialize
+import Dodge.Item.Location.Initialize
 import Control.Applicative
 import Control.Lens
 --import Control.Monad
@@ -14,36 +14,36 @@ import Dodge.Data.Universe
 import Dodge.Inventory.Add
 import Dodge.Item
 --import Dodge.Menu.PushPop
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
 import LensHelp
 import MaybeHelp
 import Text.Read (readMaybe)
 
-applyTerminalString :: [String] -> Universe -> Universe
+applyConsoleString :: [String] -> Universe -> Universe
-applyTerminalString ss = case ss of
+applyConsoleString ss = case ss of
     [] -> id
-    [s] -> applyTerminalCommand s
+    [s] -> applyConsoleCommand s
-    (s : ss') -> applyTerminalCommandArguments s ss'
+    (s : ss') -> applyConsoleCommandArguments s ss'
 
-applyTerminalCommand :: String -> Universe -> Universe
+applyConsoleCommand :: String -> Universe -> Universe
-applyTerminalCommand s = case s of
+applyConsoleCommand s = case s of
     "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
-    ['L', x] -> uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX x)
+    ['L', x] ->
---            (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
+            (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
---        . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
+        . (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
         (ibt, n) <- parseItem [x]
-        return $ uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
+        return $ uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
 
-applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
+applyConsoleCommandArguments :: String -> [String] -> Universe -> Universe
-applyTerminalCommandArguments command args u = case command of
+applyConsoleCommandArguments command args u = case command of
     "IT" -> fromMaybe u $ do
         (ibt, n) <- parseItem args
-        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
+        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
     "DEX" -> fromMaybe u $ do
         x <- readMaybe =<< args ^? _head
         return $ u & ypoint . crType . avDexterity .~ x
@@ -75,33 +75,33 @@ parseItem [] = Nothing
 parseNum :: [String] -> Int
 parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe
 
-showTerminalError :: String -> String -> Universe -> Universe
+showConsoleError :: String -> String -> Universe -> Universe
-showTerminalError cmd s = uvScreenLayers .:~ InputScreen cmd s
+showConsoleError cmd s = uvScreenLayers .:~ InputScreen cmd s
 
-applySetTerminalString :: String -> Universe -> Universe
+applySetConsoleString :: String -> Universe -> Universe
-applySetTerminalString [] = id
+applySetConsoleString [] = id
-applySetTerminalString var = case key' of
+applySetConsoleString var = case key' of
-    "" -> showTerminalError ("set " ++ var) ("Unable to read as argument as float: " ++ val)
+    "" -> showConsoleError ("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'
-    _ -> showTerminalError ("set " ++ var) ("Invalid set command: " ++ key) -- never reached?
+    _ -> showConsoleError ("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
 
---autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
+--autoCompleteConsole :: String -> String -> Universe -> IO (Maybe Universe)
---autoCompleteTerminal s _ =
+--autoCompleteConsole 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) (validTerminalCommands "")
+--        "" -> filter (isInfixOf key) (validConsoleCommands "")
---        _ -> filter (isInfixOf val) (validTerminalCommands key)
+--        _ -> filter (isInfixOf val) (validConsoleCommands key)
 --    -- basic autocomplete if single option available (or as far as possible)
 --    input_str = case (key, val) of
 --        (_, "") ->
@@ -117,7 +117,7 @@ applySetTerminalString var = case key' of
 --                        else ">" ++ key ++ " " ++ longestCommonPrefix command_options
 --    command_options' =
 --        if not (null command_options) && head command_options == key
---            then validTerminalCommands key
+--            then validConsoleCommands key
 --            else command_options
 --
 --    --val' = Debug.Trace.trace key tail val
@@ -129,12 +129,12 @@ getSplitString str = case break (== ' ') str of
     (a, _) -> (a, "")
 
 isValidCommand :: String -> String -> Bool
-isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
+isValidCommand arg1 arg2 = arg2 `elem` validConsoleCommands arg1
-
+validConsoleCommands :: String -> [String]
-validTerminalCommands :: String -> [String]
+validConsoleCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
-validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
+validConsoleCommands "god" = ["on", "off"]
-validTerminalCommands "god" = ["on", "off"]
+validConsoleCommands _ = ["set", "spawn", "god"]
-validTerminalCommands _ = ["set", "spawn", "god"]
+validConsoleCommands _ = ["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,  _flItPos = V2 0 0}
+defaultFlIt = FlIt{_flItRot = 0, _flIt = defaultHeldItem, _flItPos = V2 0 0, _flItID = 0}
 
 defaultMachine :: Machine
 defaultMachine =
@@ -46,11 +46,16 @@ defaultMachine =
         }
 
 defaultButton :: Button
-defaultButton = Button
+defaultButton =
-        { _btPos = 0
+    Button
+        { _btPos = V2 0 0
         , _btRot = 0
         , _btEvent = ButtonPress False NoWorldEffect (dark red)
         , _btID = 0
+--        , _btState = BtOff
+        , _btTermMID = Nothing
+--        , _btName = ""
+--        , _btColor = red
         }
 
 defaultPP :: PressPlate
@@ -69,6 +74,6 @@ defaultProximitySensor =
     ProximitySensor
         { _proxStatus = NotClose
         , _proxDist = 40
-        , _proxRequirement = RequireHealth 0
+        , _proxRequirement = RequireImpossible
         , _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 = mempty
+        , _crInv = IM.empty
         , _crManipulation = Manipulator SelNothing
 --        , _crInvCapacity = 25
         , _crDamage = []

src/Dodge/Default/Room.hs

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

src/Dodge/Default/Terminal.hs

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

src/Dodge/Default/Wall.hs

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

src/Dodge/Default/World.hs

@@ -1,4 +1,6 @@
-module Dodge.Default.World (defaultWorld) where
+module Dodge.Default.World (
+    defaultWorld,
+) where
 
 import Data.Graph.Inductive.Graph hiding ((&))
 import qualified Data.Map as M
@@ -6,6 +8,7 @@ import Dodge.Data.World
 import Geometry.Data
 import Geometry.Polygon
 import qualified IntMapHelp as IM
+import NewInt
 import System.Random
 
 defaultInput :: Input
@@ -84,6 +87,7 @@ defaultCWorld =
         { _lWorld = defaultLWorld
         , _cwGen = defaultCWGen
         , _cClock = 0
+--        , _seenWalls = mempty
         , _pathGraph = Data.Graph.Inductive.Graph.empty
         , _cwTiles = mempty
         , _numberFloorVerxs = 0
@@ -102,8 +106,7 @@ defaultLWorld =
         , _clouds = mempty
         , _dusts = mempty
         , _gusts = IM.empty
---        , _itemLocations = IM.empty
+        , _itemLocations = IM.empty
-        , _items = mempty
         , _props = IM.empty
         , _debris = mempty
         , _projectiles = IM.empty
@@ -130,7 +133,7 @@ defaultLWorld =
         , _doors = IM.empty
         , _coordinates = IM.empty
         , _triggers = IM.empty
-        , _floorItems = mempty
+        , _floorItems = NIntMap IM.empty
         , _worldEvents = []
         , _delayedEvents = []
         , _pressPlates = IM.empty
@@ -153,7 +156,7 @@ defaultLWorld =
         , _imHotkeys = mempty
         , _lAimPos = 0
         , _lInvLock = False
-        , _respawnPos = (V2 20 20, pi / 2)
+        , _respawnPos = (V2 20 20, pi/2)
         }
 
 defaultHUD :: HUD
@@ -173,6 +176,7 @@ defaultDisplayInventory =
         { _subInventory = NoSubInventory
         , _diSections = mempty
         , _diSelection = Just (1, 0, mempty)
+--        , _diSelectionExtra = mempty
         , _diInvFilter = mempty
         , _diCloseFilter = mempty
         }

src/Dodge/DisplayInventory.hs

@@ -9,8 +9,6 @@ module Dodge.DisplayInventory (
     toggleCombineInv,
 ) where
 
-import Dodge.Inventory.CheckSlots
-import NewInt
 import Control.Applicative
 import Control.Lens
 import Control.Monad
@@ -63,16 +61,16 @@ updateCombineSections w cfig =
             (IM.fromDistinctAscList . zip [0 ..] $ combineList w)
             "COMBINATIONS"
             $ w ^? hud . hudElement . subInventory . ciFilter . _Just
-    invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
+    invitms = fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
     sclose'
         | null sclose =
             IM.singleton 0 $
-                SelItem ["No possible combinations"] 1 25 False white 0 Nothing
+                SelectionInfo ["No possible combinations"] 1 25 False white 0
         | otherwise = sclose
 
 regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
 regexCombs inv ci = \case
-    '#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci)
+    '#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
     str -> (regexList str . _siPictures) ci
   where
     g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)
@@ -115,7 +113,11 @@ displayIndents 3 = 2
 displayIndents 5 = 2
 displayIndents _ = 0
 
-updateDisplaySections :: World -> Configuration -> IMSS () -> IMSS ()
+updateDisplaySections ::
+    World ->
+    Configuration ->
+    IM.IntMap (SelectionSection ()) ->
+    IM.IntMap (SelectionSection ())
 updateDisplaySections w cfig =
     updateSectionsPositioning
         displayIndents
@@ -127,7 +129,7 @@ updateDisplaySections w cfig =
                 [ invhead
                 , sinv
                 , IM.singleton 0 
-                    $ SelItem [displayFreeSlots (crNumFreeSlots (w ^. cWorld . lWorld . items) cr)] 1 15 True invDimColor 2 Nothing
+                    $ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
                 , nearbyhead
                 , sclose
                 , interfaceshead
@@ -151,16 +153,16 @@ updateDisplaySections w cfig =
     btitems =
         IM.fromDistinctAscList . zip [0 ..] $
             mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
-    makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
+    makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
     invhead = if null sfinv then makehead "INVENTORY" else sfinv
     cr = you w
     closeitms =
         IM.fromDistinctAscList . zip [0 ..] $
-            mapMaybe (closeItemToSelectionItem w) (map _unNInt $ w ^. hud . closeItems)
+            mapMaybe (closeItemToSelectionItem w) (w ^. hud . closeItems)
     invitems =
         IM.map
             (uncurry (invSelectionItem w))
-            (invIndents $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
+            (invIndents $ _crInv cr)
 
 filterSectionsPair ::
     Bool -> -- check for whether filter is in focus, changes string at the end
@@ -177,14 +179,13 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
         return $
             IM.singleton
                 0
-                $ SelItem
+                $ SelectionInfo
                     [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"
 

src/Dodge/DoubleTree.hs

@@ -165,7 +165,6 @@ 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

@@ -50,13 +50,12 @@ setWristShieldPos :: Item -> Creature -> World -> World
 setWristShieldPos itm cr w = w & moveWallIDUnsafe i wlline
   where
     i = _itParamID $ _itParams itm
-    m = w ^. cWorld . lWorld . items
     wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
     invid = _ilInvID (_itLocation itm)
-    handtrans = case cr ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
+    handtrans = case cr ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
-        Just OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
+        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
-        _ -> translatePointToRightHand m
+        _ -> translatePointToRightHand
     g
-        | twists m cr = (+.+.+ V3 (-5) 10 0)
+        | twists cr = (+.+.+ V3 (-5) 10 0)
         | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr

src/Dodge/Equipment/Text.hs

@@ -10,5 +10,5 @@ eqPosText ep = case ep of
     OnLeftWrist -> "L.WRIST"
     OnRightWrist -> "R.WRIST"
     OnLegs -> "LEGS"
---    OnSpecial -> "EQUIPPED"
+    OnSpecial -> "EQUIPPED"
 

src/Dodge/Euse.hs

@@ -33,16 +33,15 @@ useMagShield mt _ cr w =
             }
 
 setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
-setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
+setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
   where
-    m = w ^. cWorld . lWorld . items
     i = _itParamID $ _itParams itm
     wlline = (f (V3 (-10) 7 0), f (V3 10 7 0))
     handtrans = case x of
-        OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
+        OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
-        _ -> translatePointToRightHand m
+        _ -> translatePointToRightHand
     g
-        | twists m cr = (+.+.+ V3 (-5) 10 0)
+        | twists cr = (+.+.+ V3 (-5) 10 0)
         | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
@@ -54,10 +53,9 @@ setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
 --    _ -> w
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr w = w &
+createHeadLamp _ cr =
     cWorld . lWorld . lights
         .:~ LSParam
-            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) 
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
-    (translatePointToHead (w ^. cWorld . lWorld . items) cr (V3 5 0 3)))
             200
             0.7

src/Dodge/Floor.hs

@@ -1,11 +1,8 @@
 -- | The tree of rooms that make up a level.
 module Dodge.Floor (
     initialRoomTree,
-    tutRoomTree,
 ) where
 
-import Dodge.Annotation.Data
---import Dodge.Room.Tutorial
 import Data.List (intersperse)
 import Dodge.Annotation
 import Dodge.Cleat
@@ -19,14 +16,10 @@ import LensHelp
 import RandomHelp
 
 -- | A test level tree.
-initialRoomTree :: State LayoutVars (MetaTree Room String)
+initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
 initialRoomTree = annoToRoomTree initialAnoTree
 --initialRoomTree = annoToRoomTree startWorldTreeTest
 
-tutRoomTree :: State LayoutVars (MetaTree Room String)
---tutRoomTree = annoToRoomTree tutAnoTree
-tutRoomTree = annoToRoomTree initialAnoTree
-
 --startWorldTreeTest :: Annotation
 --startWorldTreeTest  =
 --    OnwardList $
@@ -37,20 +30,20 @@ initialAnoTree :: Annotation
 initialAnoTree =
     OnwardList $
         intersperse
-            (AnTree $ zoom lyGen corDoor)
+            (AnTree corDoor)
-            [ AnTree $ intAnno startRoom
+            [ IntAnno $ AnTree . startRoom
-            , --IntAnno $
+            , IntAnno $
                 PassthroughLockKeyLists
                     [(sensorRoomRunPast ElectricSensor, takeOne 
                         [-- CRAFT (ENERGYBALLCRAFT TeslaBall) , 
                         HELD SPARKGUN])]
                     itemRooms
-            , AnTree $ intAnno lasSensorTurretTest
+            , IntAnno $ AnTree . 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
@@ -64,8 +57,8 @@ initialAnoTree =
               --    , AnTree $ tToBTree "spawners" <$> spawnerRoom
               --    , AnRoom pistolerRoom
               --    , AnRoom doubleCorridorBarrels
-              PassthroughLockKeyLists keyCardRunPastRand itemRooms
+              IntAnno $ PassthroughLockKeyLists keyCardRunPastRand itemRooms
-            , AnTree . intAnno $ warningRooms "INVISIBLE CREATURE AHEAD"
+            , IntAnno $ AnTree . warningRooms "INVISIBLE CREATURE AHEAD"
             , AnTree $
                 rToOnward "chaseCrit+armourChaseCrit rectRoom" $
                     return . cleatOnward $
@@ -73,12 +66,11 @@ initialAnoTree =
                             .++~ [ psPtPl anyUnusedSpot (PutCrit invisibleChaseCrit)
                                  , psPtPl anyUnusedSpot (PutCrit armourChaseCrit)
                                  ]
-            , AnTree . intAnno $ fmap (tToBTree "healthTest") . healthTest
+            , IntAnno $ AnTree . fmap (tToBTree "healthTest") . healthTest
-            , AnTree . zoom lyGen $ 
+            , AnTree (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
-                (tanksRoom [] [] >>= rToOnward "empty tanksRoom" . pure . cleatOnward)
+            , IntAnno $ PassthroughLockKeyLists lockRoomKeyItems itemRooms
-            ,  PassthroughLockKeyLists lockRoomKeyItems itemRooms
             , AnTree randomChallenges
-            , AnTree $ intAnno lasSensorTurretTest
+            , IntAnno $ AnTree . lasSensorTurretTest
             , --    ,[AnTree $ fmap pure roomCCrits]
               --    ,[AirlockAno]
               --    ,[Corridor]
@@ -121,12 +113,3 @@ 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,28 +1,52 @@
-module Dodge.FloorItem (copyItemToFloor) where
+module Dodge.FloorItem (
+    copyItemToFloor,
+    copyItemToFloorID,
+) 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 LensHelp
+import qualified IntMapHelp as IM
-import NewInt
 import System.Random
 
--- | Copy an item to the floor
+-- | Copy an item to the floor.
 copyItemToFloor :: Point2 -> Item -> World -> World
-copyItemToFloor p it w =
+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) $
         w'
-        & cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
+            & cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
-        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
+            & cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid)
-        & hud . closeItems .:~ _itID it -- puts item at top of close items
+            & hud . closeItems %~ (NInt flid:) 
+--            & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
+                -- ensures dropped item is at the top of the close item selection list
   where
-    (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
+    (p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
-    r = fst . randomR (- pi, pi) $ _randGen 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
+            }
 
 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,
@@ -102,7 +102,7 @@ hammerCheck f pt loc cr w = case itemTriggerType loc of
              in w & f loc cr
                     & cWorld . lWorld . delayedEvents .++~ map g is
                     & randGen .~ gen
-    HammerTrigger t | timetest t, pt == 0 -> f loc cr w
+    HammerTrigger t | timetest t , pt == 0 -> f loc cr w
     SemiAutoTrigger t
         | timetest t
           , pt < w ^. cWorld . lWorld . lClock - timelastused ->
@@ -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 . items . ix (it ^. itID . unNInt)
+    itmset = cWorld . lWorld . creatures . ix cid . crInv . ix invid
     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 . items . ix itid . itTimeLastUsed
+        cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
             .~ w ^. cWorld . lWorld . lClock
-    itid = t ^?! dtValue . _1 . itID . unNInt
+    itid = t ^?! dtValue . _1 . itLocation . ilInvID
 
 locMuzzles :: LocationDT OItem -> [Muzzle]
 locMuzzles loc
@@ -341,20 +341,26 @@ vgunMuzzles i =
         )
 
 doHeldUseEffect :: DTree OItem -> Creature -> World -> World
-doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
+doHeldUseEffect t cr 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 . itParams . unfiredBarrels %~ const is
+                    & crinvset . ix i . itParams . unfiredBarrels %~ const is
-        Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
+        Just (_ : _ : _) -> fromMaybe w $ do
+            i <- itm ^? itLocation . ilInvID
+            return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
         _ -> w
-    HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
+    HELD ALTERIFLE -> fromMaybe w $ do
+        i <- t ^? dtValue . _1 . itLocation . ilInvID
+        return $
+            w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
     _ -> w
   where
-    crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
+    crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
     itm = t ^. dtValue . _1
 
 -- should probably unify failure with time use check in some way...
@@ -631,8 +637,8 @@ loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
                     find
                         ((== PulseBallSF) . (^. dtValue . _2))
                         (loc ^. locDT . dtLeft)
-            mid <- mag ^? dtValue . _1 . itID . unNInt
+            mid <- mag ^? dtValue . _1 . itLocation . ilInvID
-            availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
+            availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
             let usedammo = case as ^?! aps of
                     UseUpTo x -> min x availableammo
                     UseExactly x
@@ -718,7 +724,7 @@ useLoadedAmmo ::
     World ->
     World
 useLoadedAmmo loc cr mz m w = 
-    removeAmmoFromMag m . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
+    removeAmmoFromMag m cr . 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
@@ -735,7 +741,7 @@ useLoadedAmmo loc cr mz m w =
                 mz
                 cr
                 w
-        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm w
+        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
         MuzzleShatter -> shootShatter itm cr w
         MuzzleDetector ->
             itemDetectorEffect
@@ -776,11 +782,13 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
     f CREATUREDETECTOR = OTCreature
     f WALLDETECTOR = OTWall
 
-walkNozzle :: Muzzle -> Item -> World -> World
+walkNozzle :: Muzzle -> Item -> Creature -> World -> World
-walkNozzle mz itm w =
+walkNozzle mz itm cr w = fromMaybe w $ do
+    invid <- itm ^? itLocation . ilInvID
+    return $
         w
-        & cWorld . lWorld . items
+            & cWorld . lWorld . creatures . ix (_crID cr) . crInv
-            . ix (itm ^. itID . unNInt)
+                . ix invid
                 . itParams
                 . nzAngle
                 %~ f
@@ -919,12 +927,14 @@ shootPulseBall p dir w =
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
 --removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
-removeAmmoFromMag :: Maybe (Int, DTree OItem) -> World -> World
+removeAmmoFromMag :: Maybe (Int, DTree OItem) -> Creature -> World -> World
-removeAmmoFromMag m = fromMaybe id $ do
+removeAmmoFromMag m cr = fromMaybe id $ do
     (x, magtree) <- m
-    magid <- magtree ^? dtValue . _1 . itID . unNInt
+    magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
     return $
-        cWorld . lWorld . items
+        cWorld . lWorld . creatures
+            . ix (_crID cr)
+            . crInv
             . ix magid
             . itConsumables
             . _Just
@@ -1118,8 +1128,7 @@ mcUseHeld hit = case hit of
     LASER -> mcShootLaser
     _ -> mcShootAuto
 
-useGasParams :: Maybe (NewInt InvInt) 
+useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
-    -> Muzzle -> LocationDT OItem -> Creature -> World -> World
 useGasParams mmagid mz loc cr w =
     w
         & createGas gastype pressure pos dir cr
@@ -1130,7 +1139,7 @@ useGasParams mmagid mz loc cr w =
     gastype = fromMaybe (error "cannot find gas ammo") $ do
         magid <- mmagid
         hit <- itm ^? itType . ibtHeld
-        fueltype <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= magAmmoParams >>= (^? ampCreateGas)
+        fueltype <- cr ^? crInv . ix magid >>= magAmmoParams >>= (^? ampCreateGas)
         gasType hit fueltype
     (V3 x y _, q) =
         locOrient loc cr
@@ -1199,11 +1208,11 @@ mcShootLaser _ mc =
 
 mcShootAuto :: Item -> Machine -> World -> World
 mcShootAuto itm mc w
-    | Just i <- mc ^? mcType . mctTurret . tuWeapon
+    | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
-      , Just (AutoTrigger rate) <- baseItemTriggerType <$> w ^? cWorld . lWorld . items . ix i
       , w ^. cWorld . lWorld . lClock - rate > lastused =
         w
-            & cWorld . lWorld . items . ix i . itTimeLastUsed
+            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
+                . itTimeLastUsed
                 .~ w ^. cWorld . lWorld . lClock
             & makeBullet defaultBullet itm pos dir
     | otherwise = w
@@ -1215,11 +1224,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 . items . ix itid . itParams .~ ip
+    w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
         & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
   where
     itm = loc ^. locDT . dtValue . _1
-    itid = itm ^. itID . unNInt
+    invid = itm ^?! itLocation . ilInvID
     (w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
     (V3 x y _, q) =
         locOrient loc cr
@@ -1319,11 +1328,9 @@ createProjectile ::
     Creature ->
     World ->
     World
-createProjectile x pjtype magtree stab muz cr w =
+createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
-    w
-        & ( fromMaybe failsound $ do
     magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
-                ammoitem <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k
+    ammoitem <- cr ^? crInv . ix magid
     let rdetonate =
             (^. dtValue . _1 . itID)
                 <$> find isrdet (magtree ^. dtLeft)
@@ -1337,7 +1344,6 @@ createProjectile x pjtype magtree stab muz cr w =
     return $
         createShell x rdetonate rscreen stab pjtype aparams muz cr
             . startthesound
-          )
   where
     isrdet :: DTree OItem -> Bool
     isrdet y = case y ^. dtValue . _2 of
@@ -1414,7 +1420,7 @@ dropInventoryPath ::
     World ->
     World
 dropInventoryPath i ip loc cr = fromMaybe id $ do
-    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
     j <- getInventoryPath i ip invid cr
     return $ dropItem cr j
 
@@ -1447,15 +1453,15 @@ useInventoryPath ::
     World
 useInventoryPath pt i ip loc cr w = case ip of
     ABSOLUTE -> fromMaybe w $ do
-        guard $ i `IM.member` (cr ^. crInv . unNIntMap)
+        guard $ i `IM.member` (cr ^. crInv)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
     RELCURS -> fromMaybe w $ do
-        j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
+        j <- cr ^? crManipulation . manObject . imSelectedItem
-        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
+        guard $ (i + j) `IM.member` (cr ^. crInv)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
     RELITEM -> fromMaybe w $ do
-        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
+        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
-        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
+        guard $ (i + j) `IM.member` (cr ^. crInv)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
 
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of

src/Dodge/Inventory.hs

@@ -7,6 +7,7 @@ module Dodge.Inventory (
     invSetSelection,
     invSetSelectionPos,
     scrollAugInvSel,
+    crNumFreeSlots,
     setInvPosFromSS,
     module Dodge.Inventory.RBList,
     swapInvItems,
@@ -16,13 +17,17 @@ 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.Equipment
+--import Dodge.Euse
+import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap
@@ -37,43 +42,37 @@ import NewInt
 
 -- should consider never fully destroying items, but assigning a flag saying how
 -- they were moved from play
-destroyInvItem :: Int -> NewInt InvInt -> World -> World
+destroyInvItem :: Int -> Int -> 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 <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
-        return $ cWorld . lWorld . items . at itid .~ Nothing
+        return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
     removeithotkey = fromMaybe id $ do
-        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
+        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
         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 =
+destroyAllInvItems cr w = foldl' (flip $ destroyInvItem (cr ^. crID)) w 
-    foldl' (flip $ destroyInvItem (cr ^. crID)) w
+    . reverse . IM.keys $ cr ^. crInv 
-        . reverse
-        . fmap NInt
-        . IM.keys
-        . _unNIntMap
-        $ cr ^. crInv
 
 destroyItem :: Int -> World -> World
-destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
+destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
-    Nothing -> error $ "Tried to destroy item that does not exist; item id: " ++ show itid
+    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 (InInv {_ilCrID = cid, _ilInvID = invid}) -> destroyInvItem cid invid w
-    Just OnTurret{} -> error "need to write code for destroying items on turrets"
+    Just (OnTurret{}) -> error "need to write code for destroying items on turrets"
-    Just OnFloor ->
+    Just (OnFloor (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
-        w & cWorld . lWorld . items . at itid .~ Nothing
+        & cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
-            & cWorld . lWorld . floorItems . at itid .~ Nothing
+    Just InVoid -> w & cWorld . lWorld . itemLocations . 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 -> NewInt InvInt -> World -> World
+rmInvItem :: Int -> Int -> World -> World
 rmInvItem cid invid w =
     w
         & dounequipfunction --the ordering of these is
@@ -82,7 +81,7 @@ rmInvItem cid invid w =
         & pointcid . crEquipment . each %~ g
         & updateselection
         & updateselectionextra
-        & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
+        & pointcid %~ updateRootItemID
         & worldEventFlags . at InventoryChange ?~ ()
   where
     pointcid = cWorld . lWorld . creatures . ix cid
@@ -95,8 +94,7 @@ rmInvItem cid invid w =
         | otherwise =
             pointcid . crManipulation . manObject . imSelectedItem %~ g
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    itid = _crInv cr ^?! ix invid
+    itm = _crInv cr IM.! invid
-    itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
     --  fromMaybe id $ do
     --    rmf <- itm ^? itUse . uequipEffect . eeOnRemove
@@ -105,38 +103,40 @@ rmInvItem cid invid w =
         epos <-
             w
                 ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
-                >>= \k -> w ^? cWorld . lWorld . items . ix k
                     . itLocation
                     . ilEquipSite
                     . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
-    maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
+    maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =
-        let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
+        let (xs, ys) = IM.split invid inv
-         in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
+         in 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 == fmap NInt maxk = max 0 $ x - 1
+        | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
 
+
+-- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w & hud . closeItems %~ f
+    w
+        & hud . closeItems %~ f
         & hud . closeButtons %~ g
   where
     g oldbts = intersect oldbts cbts `union` cbts
     f olditems = intersect olditems citems `union` citems
-    lw = w ^. cWorld . lWorld
+    cbts = _btID <$> filter (isclose . _btPos) activeButtons
-    citems = let is = IM.filter (isclose . _flItPos) (lw^.floorItems)
+    citems =
-        in map NInt $ IM.keys $ IM.intersection (lw ^. items) is
+        fmap _flItID
-    isclose x = dist y x < 40 && hasButtonLOS y x w
+            . filter (isclose . _flItPos)
-    y = _crPos $ you w
+            . IM.elems
-    cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
+            $ 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
     canpress bt = case bt ^. btEvent of
-        ButtonPress{_btOn = t} -> not t
+        ButtonPress {_btOn = t} -> not t
-        ButtonAccessTerminal tid -> fromMaybe False $ do
-            x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
-            return (x /= TerminalDeactivated)
         _ -> True
 
 changeSwapSel :: Int -> World -> World
@@ -174,23 +174,18 @@ swapItemWith ::
     (Int, Int) ->
     World ->
     World
-swapItemWith f (j, i) = case j of
+swapItemWith f (j, i) w = case j of
-    0 -> swapInvItems f i
+    0 -> w & swapInvItems f i
-    3 -> changeSwapOther ispCloseItem 3 f i
+    3 -> w & changeSwapOther ispCloseItem 3 f i
-    5 -> changeSwapOther ispCloseButton 5 f i
+    5 -> w & changeSwapOther ispCloseButton 5 f i
-    _ -> id
+    _ -> w
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
-changeSwapWith f w 
+changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
-    | Just (j,i,_) <- w ^. hud . hudElement . diSelection = swapItemWith f (j,i) w
+    Just (0, i, _) -> w & swapInvItems f i
-    | otherwise = w
+    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
-
+    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
---changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
+    _ -> w
---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
 
 invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
 invSetSelection sel w =
@@ -208,8 +203,8 @@ invSetSelectionPos i j w =
         & setInvPosFromSS
         & cWorld . lWorld %~ crUpdateItemLocations 0
   where
-    f Nothing = Just (i, j, mempty)
+    f Nothing = Just (i,j,mempty)
-    f (Just (_, _, s)) = Just (i, j, s)
+    f (Just (_,_,s)) = Just (i,j,s)
 
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w

src/Dodge/Inventory/Add.hs

@@ -1,76 +1,116 @@
-{-# LANGUAGE TupleSections #-}
-
 module Dodge.Inventory.Add (
+    tryPutItemInInv,
+    --createPutItem,
+    --createAndSelectItem,
     createItemYou,
     pickUpItem,
     pickUpItemAt,
 ) where
 
-import qualified Data.IntSet as IS
+import Dodge.Inventory.Swap
-import Control.Lens
 import Control.Monad
+import NewInt
+import Dodge.SoundLogic
+import Dodge.Inventory.Location
+--import Dodge.Item.Grammar
+import Control.Lens
 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
 
--- should check that the item is not already in your inventory
+tryPutFloorItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World)
--- this assumes that this item is currently on the floor
+tryPutFloorItemIDInInv cid flitid w = do
-tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt, World)
+    flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid)
-tryPutItemInInv cid itid w = do
+    tryPutItemInInv cid flit w
-    itm <- w ^? cWorld . lWorld . items . ix itid
+
-    invid <- checkInvSlotsYou itm w
+-- not sure why we have the cid here, this will probably only work for cid == 0
-    let itloc = InInv
+tryPutItemInInvAt :: Int -> Int -> FloorItem -> World -> Maybe World
-            { _ilCrID = cid
+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 
+            {_ilCrID = cid
             , _ilInvID = invid
             , _ilIsRoot = False
             , _ilIsSelected = False
             , _ilIsAttached = False
             , _ilEquipSite = Nothing
             }
-    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
-    updateselectionextra i
-        | cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ IS.map (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
+---- should select the item on the floor if no inventory space?
-tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
+--createAndSelectItem :: Item -> World -> World
-tryPutItemInInvAt i cid itid w = do
+--createAndSelectItem itm w = case createPutItem itm w of
-    (j, w') <- tryPutItemInInv cid itid w
+--    (Just i, w') ->
-    guard (i <= _unNInt j)
+--        w'
-    return $ foldr f w' [i + 1 .. _unNInt j]
+--            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
-  where
+--            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
-    f j = swapInvItems (\_ _ -> Just (j -1)) j
+--                .~  InInventory (SelectedItem i 
+--                    $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
+--    (Nothing, w') -> w'
 
-createItemYou :: Item -> World -> World
+--createPutItem :: Item -> World -> (Maybe Int, World)
-createItemYou itm w = maybe w' snd $ tryPutItemInInv 0 itid w'
+--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'')
   where
-    itid = IM.newKey $ w ^. cWorld . lWorld . items
+    itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
-    w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
+    (flid,w') = copyItemToFloorID 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
 
-pickUpItemAt :: Int -> Int -> Int -> World -> World
+-- | Pick up a specific item.
-pickUpItemAt invid cid itid w = fromMaybe w $ do
+pickUpItem :: Int -> FloorItem -> World -> World
-    p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
+pickUpItem cid flit w =
-    soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt invid cid itid 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

src/Dodge/Inventory/CheckSlots.hs

@@ -4,7 +4,6 @@ module Dodge.Inventory.CheckSlots (
     maxInvSlots,
 ) where
 
-import NewInt
 import Control.Monad
 import Dodge.Item.InvSize
 import Control.Lens
@@ -15,20 +14,18 @@ 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 (NewInt InvInt)
+checkInvSlotsYou :: Item -> World -> Maybe Int
 checkInvSlotsYou it w = do
     ycr <- w ^? cWorld . lWorld . creatures . ix 0
-    guard $ crNumFreeSlots (w ^. cWorld . lWorld . items) ycr >= itInvHeight it
+    guard $ crNumFreeSlots ycr >= itInvHeight it
-    Just . NInt . IM.newKey . _unNIntMap $ _crInv ycr
+    Just . IM.newKey $ _crInv ycr
 
--- the intmap should be _items
+crNumFreeSlots :: Creature -> Int
-crNumFreeSlots :: IM.IntMap Item -> Creature -> Int
+--crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
-crNumFreeSlots m cr = maxInvSlots - invSize (fmap f (_crInv cr))
+crNumFreeSlots cr = maxInvSlots - invSize (_crInv cr)
-  where
-    f i = m ^?! ix i
 
 maxInvSlots :: Int
-maxInvSlots = 250
+maxInvSlots = 25
 
-invSize :: NewIntMap InvInt Item -> Int
+invSize :: IM.IntMap Item -> Int
 invSize = alaf Sum foldMap itInvHeight

src/Dodge/Inventory/Location.hs

@@ -6,13 +6,10 @@ module Dodge.Inventory.Location (
 
 import Control.Applicative
 import Control.Lens
-import Data.Foldable
+import Data.IntMap.Merge.Strict
---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
@@ -20,80 +17,71 @@ import qualified IntMapHelp as IM
 import NewInt
 
 -- assumes all item locations inside the items are correct
-tryGetRootAttachedFromInvID ::
+tryGetRootAttachedFromInvID :: Int -> IM.IntMap Item -> Maybe (Int, IS.IntSet)
-    NewInt InvInt ->
+tryGetRootAttachedFromInvID invid im = do
-    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 . unNInt)) t)
+    return (theroot, foldMap (IS.singleton . (^?! itLocation . ilInvID)) t)
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
-tryGetRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Maybe Int
+tryGetRootItemInvID :: Int -> Creature -> Maybe Int
-tryGetRootItemInvID m i cr = do
+tryGetRootItemInvID i cr = do
-    let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
+    let adj = invAdj (_crInv cr)
     theroot <- adj ^? ix i
     theroot ^? _1 . _Just . _1 <|> Just i
 
-updateRootItemID :: IM.IntMap Item -> Creature -> Creature
+updateRootItemID :: Creature -> Creature
-updateRootItemID m cr = fromMaybe cr $ do
+updateRootItemID cr = fromMaybe cr $ do
-    i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
+    i <- cr ^? crManipulation . manObject . imSelectedItem
-    j <- tryGetRootItemInvID m i cr
+    j <- tryGetRootItemInvID i cr
-    return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
+    return $ cr & crManipulation . manObject . imRootSelectedItem .~ 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
-    cinv <- lw ^? creatures . ix crid . crInv
+    crinv <- lw ^? creatures . ix crid . crInv
-    --let crinv = IM.restrictKeys  (lw ^. items) (IS.fromList $ IM.elems itids)
+    return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw 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
-    let cinv = invIMDT $ fmap (\i -> w ^?! items . ix i) inv
+    return $
-    return $ foldl' f (foldl' g w inv) cinv
+        w & creatures . ix cid . crInv
+            %~ merge
+                dropMissing
+                preserveMissing
+                (zipWithMatched f)
+                (invIMDT inv)
   where
-    g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
+    f _ _ = itLocation . ilIsRoot .~ True
-    f :: LWorld -> DTree OItem -> LWorld
-    f w' x =
-        w'
-            & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
 
-crUpdateInvidLocations ::
+crUpdateInvidLocations :: ManipulatedObject -> Int -> LWorld -> Int -> Item -> LWorld
-    ManipulatedObject ->
-    Int ->
-    LWorld ->
-    Int ->
-    Item ->
-    LWorld
 crUpdateInvidLocations mo crid lw invid itm =
     lw
-        & creatures . ix crid . crInv . ix (NInt invid) .~ itid -- . itLocation .~ newloc
+        & creatures . ix crid . crInv . ix invid . itLocation .~ newloc
-        & items . ix itid .~ (itm & itLocation .~ newloc)
+        & itemLocations %~ IM.insert itid newloc
   where
     itid = itm ^. itID . unNInt
     newloc =
         InInv
             { _ilCrID = crid
-            , _ilInvID = NInt invid
+            , _ilInvID = invid
-            , _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
+            , _ilIsRoot = Just invid == mo ^? imRootSelectedItem
-            , _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
+            , _ilIsSelected = Just invid == mo ^? imSelectedItem
             , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
-            , _ilEquipSite = do
+            , _ilEquipSite = lw ^? creatures . ix crid . crInv . ix invid 
-                lw ^? items . ix itid . itLocation . ilEquipSite . _Just
+                . 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
@@ -101,16 +89,11 @@ setInvPosFromSS w = w
         case i of
             (-1) -> Just SortInventory
             0 -> do
-                (rootid, aset) <-
+                (rootid, aset) <- tryGetRootAttachedFromInvID j (you w ^. crInv)
-                    tryGetRootAttachedFromInvID
-                        (NInt j)
-                        ( fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $
-                            you w ^. crInv
-                        )
                 return
                     SelectedItem
-                        { _imSelectedItem = NInt j
+                        { _imSelectedItem = j
-                        , _imRootSelectedItem = NInt rootid
+                        , _imRootSelectedItem = rootid
                         , _imAttachedItems = aset
                         }
             1 -> Just SelNothing

src/Dodge/Inventory/Path.hs

@@ -1,6 +1,5 @@
 module Dodge.Inventory.Path (getInventoryPath) where
 
-import NewInt
 import Dodge.Data.Creature
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -10,10 +9,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 . unNInt
+        selid <- cr ^? crManipulation . manObject . imSelectedItem
         checkinvid (x + selid)
     RELITEM -> checkinvid (itid + x)
   where
     checkinvid y = do
-        guard $ y `IM.member` (cr ^. crInv . unNIntMap)
+        guard $ y `IM.member` (cr ^. crInv)
         return y

src/Dodge/Inventory/RBList.hs

@@ -4,8 +4,6 @@ module Dodge.Inventory.RBList (
     eqSiteToPositions,
 ) where
 
-import NewInt
-import qualified Data.IntMap.Strict as IM
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.EquipType
 import Control.Applicative
@@ -23,11 +21,11 @@ updateRBList w = case w ^. rbOptions of
     EquipOptions{} -> w
     _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
         i <- cr ^? crManipulation . manObject . imSelectedItem
-        esite <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
+        esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
         return $
             w & rbOptions
                 .~ EquipOptions
-                    { _opSel = chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqSiteToPositions esite)
+                    { _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
                     }
   where
     norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
@@ -35,11 +33,10 @@ updateRBList w = case w ^. rbOptions of
 
 -- want to choose the current position if the item is equipped, otherwise try to
 -- find a free equipment slot
-chooseEquipPosition :: IM.IntMap Item -> Creature -> [EquipSite] -> Int
+chooseEquipPosition :: Creature -> [EquipSite] -> Int
-chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do
+chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
     i <- cr ^? crManipulation . manObject . imSelectedItem
-    itid <- cr ^? crInv . ix i
+    ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
-    ep <- m ^? ix itid . itLocation . ilEquipSite . _Just
     elemIndex ep eps
 
 chooseFreeSite :: Creature -> [EquipSite] -> Int
@@ -47,14 +44,14 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
   where
     hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
 
-getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
+getEquipmentAllocation :: Int -> World -> EquipmentAllocation
 getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
-    esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
+    esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
     i <-
         w ^? rbOptions . opSel
-            <|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
+            <|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
     es <- eqSiteToPositions esite ^? ix i
-    return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
+    return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
         Just epos
             | es == epos -> RemoveEquipment{_allocOldPos = epos}
         Just epos

src/Dodge/Inventory/SelectionList.hs

@@ -31,14 +31,14 @@ import Picture.Base
 
 invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
 invSelectionItem w indent loc =
-    SelItem
+    SelectionItem
         { _siPictures = itemDisplay w cr ci
         , _siHeight = itInvHeight $ ci ^. _1
         , _siWidth = 15
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
-        , _siPayload = Nothing
+        , _siPayload = ()
         }
   where
     ci = (a,b)
@@ -92,18 +92,15 @@ itemExternalValue itm w cr
         = Just (Right "ON")
     | BINGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID
-        litid <- cr ^? crInv . ix (invid -2)
+        litm <- cr ^? crInv . ix (invid -2)
-        ritid <- cr ^? crInv . ix (invid -1)
+        ritm <- 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
-        itid' <- cr ^? crInv . ix (invid -1)
+        itm' <- 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
@@ -205,40 +202,42 @@ hotkeyToChar = \case
     Hotkey9 -> '9'
     Hotkey0 -> '0'
 
-closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
+closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
-closeItemToSelectionItem w i = do
+closeItemToSelectionItem w (NInt i) = do
-    e <- w ^? cWorld . lWorld . items . ix i
+    e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
     let (pics, col) = closeItemToTextPictures e
     return
-        SelItem
+        SelectionItem
             { _siPictures = pics
             , _siHeight = length pics
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = col
             , _siOffX = 0
-            , _siPayload = Nothing
+            , _siPayload = ()
             }
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do
     bt <- w ^? cWorld . lWorld . buttons . ix i
     return
-        SelItem
+        SelectionItem
             { _siPictures = [btText bt]
             , _siHeight = 1
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = yellow
             , _siOffX = 0
-            , _siPayload = Nothing
+            , _siPayload = ()
             }
 
 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 :: Item -> ([String], Color)
+closeItemToTextPictures :: FloorItem -> ([String], Color)
-closeItemToTextPictures it = (basicItemDisplay it, itemInvColor $ baseCI it)
+closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
+  where
+    it = _flIt flit

src/Dodge/Inventory/Swap.hs

@@ -3,7 +3,6 @@ module Dodge.Inventory.Swap (
     swapAnyExtraSelection
 ) where
 
-import NewInt
 import Dodge.SoundLogic
 import Dodge.Item.Grammar
 import Dodge.Base.You
@@ -44,13 +43,13 @@ swapInvItems f i w = fromMaybe w $ do
             & checkConnection InventoryConnectSound connectItemS i k
   where
     updatecreature k =
-        (crInv . unNIntMap %~ IM.safeSwapKeys i k)
+        (crInv %~ IM.safeSwapKeys i k)
-            . (crManipulation . manObject . imSelectedItem .~ NInt k)
+            . (crManipulation . manObject . imSelectedItem .~ k)
             . swapSite i k
             . swapSite k i
     cr = you w
-    swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
+    swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
-        Just epos -> crEquipment . ix epos .~ NInt b
+        Just epos -> crEquipment . ix epos .~ b
         Nothing -> id
 
 swapAnyExtraSelection :: Int -> Int -> World -> World
@@ -64,9 +63,8 @@ swapAnyExtraSelection i k w = fromMaybe w $ do
 
 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

src/Dodge/Item/Draw.hs

@@ -4,7 +4,6 @@ module Dodge.Item.Draw (
     itemEquipPict,
 ) where
 
-import qualified Data.IntMap.Strict as IM
 import qualified Quaternion as Q
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.ComposedItem
@@ -17,12 +16,12 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
+itemEquipPict :: Creature -> DTree CItem -> SPic
-itemEquipPict m cr itmtree
+itemEquipPict cr itmtree
-    | --Just i <- itm ^? itLocation . ilInvID
+    | Just i <- itm ^? itLocation . ilInvID
-     Just esite <- itm ^? itLocation . ilEquipSite . _Just
+    , Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
     , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
-        = equipPosition esite m cr attachpos (itemSPic itm)
+        = equipPosition esite cr attachpos (itemSPic itm)
     | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
         = overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
     | otherwise = mempty
@@ -38,15 +37,15 @@ equipAttachPos = \case
     BULLETBELTBRACER -> V3 (-9) 0 10
     _ -> 0
 
-equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
+equipPosition :: EquipSite -> Creature -> Point3 -> SPic -> SPic
-equipPosition epos m cr p sh = case epos of
+equipPosition epos cr p sh = case epos of
-    OnLeftWrist -> translateToLeftWrist m cr sh
+    OnLeftWrist -> translateToLeftWrist cr sh
-    OnRightWrist -> translateToRightWrist m cr sh
+    OnRightWrist -> translateToRightWrist cr sh
     OnLegs ->
         translateToLeftLeg cr sh
             <> translateToRightLeg cr sh-- (mirrorSPxz sh)
-    OnHead -> translateToHead m cr sh
+    OnHead -> translateToHead cr sh
-    OnChest -> translateToChest m cr sh
+    OnChest -> translateToChest cr sh
     --OnBack -> translateToBack cr p sh
-    OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
+    OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
---    OnSpecial -> sh
+    OnSpecial -> sh

src/Dodge/Item/Grammar.hs

@@ -9,7 +9,6 @@ module Dodge.Item.Grammar (
     invIndents,
 ) where
 
-import NewInt
 import Dodge.Item.Orientation
 import Dodge.ItemUseCondition
 import Dodge.Data.UseCondition
@@ -213,43 +212,47 @@ joinItemsInList f = fst . h . ([],)
         Just w -> h ( zs,w : ys)
 
 -- this puts the first elements in the intmap at the end of the list
-invDT :: NewIntMap InvInt Item -> [DTree CItem]
+invDT :: IM.IntMap Item -> [DTree CItem]
 invDT = 
-    joinItemsInList tryAttachItems . IM.elems . _unNIntMap
+    joinItemsInList tryAttachItems . IM.elems
         . fmap (singleDT . baseCI)
 
-invDT' :: NewIntMap InvInt Item -> [DTree OItem]
+invDT' :: IM.IntMap Item -> [DTree OItem]
 invDT' = fmap propagateOrientation' . invDT
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
-invRootMap :: NewIntMap InvInt Item -> IM.IntMap (Maybe Int, DTree Item)
+-- consider explicitly reseting the inventory ids (but this probably really
+-- should be done upstream anyway in the actually creature inventory)
+invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item)
 invRootMap =
     foldMap
-        (dtToIntMapWithRoot (^?! itLocation . ilInvID . unNInt) . fmap (^. _1) )
+        (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) )
         . invDT
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
+-- consider explicitly reseting the inventory ids (but this probably really
+-- should be done upstream anyway in the actually creature inventory)
 -- The first Int in the maybe is the root, the second the parent
-invAdj :: NewIntMap InvInt Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
+invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
 invAdj = IM.unions . map g . invDT
   where
     g = dtToLRAdj getid 
     getid (itm, _) =
         fromMaybe
             (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
-            $ itm ^? itLocation . ilInvID . unNInt
+            $ itm ^? itLocation . ilInvID
 
 ---- returns an intmap with trees for (only!) root items, indexed by inventory position
-invIMDT :: NewIntMap InvInt Item -> IM.IntMap (DTree OItem)
+invIMDT :: IM.IntMap Item -> IM.IntMap (DTree OItem)
 invIMDT = fmap propagateOrientation' . IM.fromDistinctAscList . reverse . map getid . invDT
   where
     getid :: DTree CItem -> (Int, DTree CItem)
-    getid t = (t ^?! dtValue . _1 . itLocation . ilInvID . unNInt, t)
+    getid t = (t ^?! dtValue . _1 . itLocation . ilInvID, t)
 
 ---- returns an intmap with indents and locations for all items
-invIndents :: NewIntMap InvInt Item -> IM.IntMap (Int, LocationDT OItem)
+invIndents :: IM.IntMap Item -> IM.IntMap (Int, LocationDT OItem)
 invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
   where
     f t = cdtPropagateFold h h g 0 t id
@@ -265,6 +268,6 @@ invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
     g x ldt =
         (.)
             ( IM.insert
-                (ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID . unNInt)
+                (ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID)
                 (x, ldt)
             )

src/Dodge/Item/Location.hs

@@ -1,6 +1,6 @@
 module Dodge.Item.Location (
     pointerToItemID,
-    --pointerToItemLocation,
+    pointerToItemLocation,
     pointerToItem,
     pointerYourSelectedItem,
     pointerYourRootItem,
@@ -11,33 +11,42 @@ import Control.Lens
 import Data.Maybe
 import Dodge.Data.World
 
---pointerToItemLocation ::
+pointerToItemLocation ::
---    Applicative f =>
+    Applicative f =>
---    ItemLocation ->
+    ItemLocation ->
---    (Item -> f Item) ->
+    (Item -> f Item) ->
---    World ->
+    World ->
---    f World
+    f World
---pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid} 
+pointerToItemLocation InInv {_ilCrID = cid, _ilInvID = invid} 
---        = cWorld . lWorld . creatures . ix cid . crInv . ix invid
+        = cWorld . lWorld . creatures . ix cid . crInv . ix invid
---pointerToItemLocation (OnFloor) = \f w -> 
+pointerToItemLocation (OnFloor flid) = cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flid) . flIt
-----    cWorld . lWorld . floorItems . ix (_unNInt flid) . flIt
+pointerToItemLocation _ = const pure
---pointerToItemLocation _ = const pure
 
 pointerYourSelectedItem :: Applicative a => (Item -> a Item) -> World -> a World
 pointerYourSelectedItem f w = fromMaybe (pure w) $ do
     itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
+    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
-    Just $ (cWorld . lWorld . items . ix itid) f w
     -- note the ilIsRoot/Selected/Attached booleans are irrelevant
 
 pointerYourRootItem :: Applicative a => (Item -> a Item) -> World -> a World
 pointerYourRootItem f w = fromMaybe (pure w) $ do
     itinvid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imRootSelectedItem
-    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
+    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
-    Just $ (cWorld . lWorld . items . ix itid) f w
 
-pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
+pointerToItem ::
-pointerToItem x = cWorld . lWorld . items . ix (x ^. itID . unNInt)
+    Applicative f =>
+    Item ->
+    (Item -> f Item) ->
+    World ->
+    f World
+pointerToItem = pointerToItemLocation . _itLocation
 
-pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
+pointerToItemID :: 
-pointerToItemID itid = cWorld . lWorld . items . ix (itid ^. unNInt)
+    Applicative f =>
+    NewInt ItmInt ->
+    (Item -> f Item) ->
+    World ->
+    f World
+pointerToItemID itid f w = fromMaybe (pure w) $ do
+    itloc <- w ^? cWorld . lWorld . itemLocations . ix (_unNInt itid)
+    return $ pointerToItemLocation itloc f w

src/Dodge/Item/Location/Initialize.hs

@@ -1,76 +1,75 @@
 module Dodge.Item.Location.Initialize
-    ( -- initSpecificCrItemLocations
+    ( initSpecificCrItemLocations
-    --, initItemLocations
+    , initItemLocations
     )
     where
---import NewInt
+import NewInt
---import Dodge.Data.LWorld
+import Dodge.Data.LWorld
---import Control.Lens
+import Control.Lens
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
---import Data.Traversable
+import Data.Traversable
 
---initItemLocations :: LWorld -> LWorld
+initItemLocations :: LWorld -> LWorld
-----initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
+initItemLocations = initCrsItemLocations . initFlItemsLocations . initTusItemLocations
---initItemLocations = initCrsItemLocations -- . initTusItemLocations
+
---
+initCrsItemLocations :: LWorld -> LWorld
---initCrsItemLocations :: LWorld -> LWorld
+initCrsItemLocations w = w' & creatures .~ newcreatures
---initCrsItemLocations w = w' & creatures .~ newcreatures
+  where
---  where
+    (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
---    (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
+
---
+initFlItemsLocations :: LWorld -> LWorld
-----initFlItemsLocations :: LWorld -> LWorld
+initFlItemsLocations w = w' & floorItems .~ NIntMap newfloorItems
-----initFlItemsLocations w = w' & floorItems .~ newfloorItems
+  where
-----  where
+    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems . unNIntMap)
-----    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
+
---
+initTusItemLocations :: LWorld -> LWorld
-----initTusItemLocations :: LWorld -> LWorld
+initTusItemLocations w = w' & machines .~ newmachines
-----initTusItemLocations w = w' & machines .~ newmachines
+  where
-----  where
+    (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
-----    (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
+
---
+initSpecificCrItemLocations :: Int -> LWorld -> LWorld
---initSpecificCrItemLocations :: Int -> LWorld -> LWorld
+initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
---initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
+  where
---  where
+    (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
---    (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
+
---
+initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
---initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
+initCrItemLocations w cr = (w', cr & crInv .~ newinv)
---initCrItemLocations w cr = (w', cr & crInv .~ newinv)
+  where
---  where
+    (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
---    (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
+
---
+-- does not worry about creature manipulation for now
----- does not worry about creature manipulation for now
+initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
---initCrItemLocation :: Creature -> Int -> LWorld -> Int -> (LWorld,Item)
+initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
---initCrItemLocation cr invid w itid = (w & itemLocations . at locid ?~ loc
+    ,it & itID .~ NInt locid
---    ,it & itID .~ NInt locid
+        & itLocation .~ loc)
---        & itLocation .~ loc)
+  where
---  where
+    locid = IM.newKey ( w ^. itemLocations)
---    locid = IM.newKey ( w ^. itemLocations)
+    loc = InInv
---    loc = InInv
+            { _ilCrID = _crID cr
---            { _ilCrID = _crID cr
+            , _ilInvID = invid
---            , _ilInvID = invid
+            , _ilIsRoot = False
---            , _ilIsRoot = False
+            , _ilIsSelected = False
---            , _ilIsSelected = False
+            , _ilIsAttached = False
---            , _ilIsAttached = False
+            , _ilEquipSite = Nothing
---            , _ilEquipSite = Nothing
+            }
---            }
+
---
+
---
+initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
-----initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
+initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
-----initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
+    , flit & flIt . itID .~ NInt locid
-----    , flit & flIt . itID .~ NInt locid
+        & flIt . itLocation .~ loc
-----        & flIt . itLocation .~ loc
+    )
-----    )
+  where
-----  where
+    locid = IM.newKey (w ^. itemLocations )
-----    locid = IM.newKey (w ^. itemLocations )
+    loc = OnFloor (_flItID flit)
-----    loc = OnFloor (_flItID flit)
+
---
+initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
-----initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
+initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
-----initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
+    Nothing -> (w, mc)
-----    Nothing -> (w, mc)
+    Just _ ->
-----    Just _ ->
+        let locid = IM.newKey ( w ^. itemLocations)
-----        let locid = IM.newKey ( w ^. itemLocations)
+            loc = OnTurret (_mcID mc)
-----            loc = OnTurret (_mcID mc)
+         in ( w & itemLocations . at locid ?~ loc
-----         in ( w & itemLocations . at locid ?~ loc
+            , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
-----            , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
+                & mcType . _McTurret . tuWeapon . itLocation .~ loc
-----                & mcType . _McTurret . tuWeapon . itLocation .~ loc
+            )
-----            )

src/Dodge/Layout.hs

@@ -17,7 +17,7 @@ import Data.Traversable
 import Dodge.Data.GenWorld
 import Dodge.Default.Wall
 import Dodge.GameRoom
---import Dodge.Item.Location.Initialize
+import Dodge.Item.Location.Initialize
 import Dodge.LevelGen.LevelStructure
 import Dodge.LevelGen.StaticWalls
 import Dodge.Path
@@ -36,7 +36,7 @@ generateLevelFromRoomList gr' w =
     over gwWorld initWallZoning
         . over gwWorld randomCompass
         . over gwWorld setupWorldBounds
---        . over (gwWorld . cWorld . lWorld) initItemLocations
+        . over (gwWorld . cWorld . lWorld) initItemLocations
         . doAfterPlacements
         . doInPlacements
         . doOutPlacements
@@ -97,7 +97,7 @@ doInPlacements (im, w) =
 doRoomInPlacements :: IM.IntMap [Placement] -> GenWorld -> Room -> (GenWorld, Room)
 doRoomInPlacements im w rm = foldr f (w, rm) $ _rmInPmnt rm
   where
-    f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w' ^. gwWorld) $ im IM.! i)
+    f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf $ im IM.! i)
 
 doOutPlacements :: GenWorld -> (IM.IntMap [Placement], GenWorld)
 doOutPlacements w =
@@ -108,9 +108,9 @@ doRoomOutPlacements ::
     (IM.IntMap [Placement], GenWorld) ->
     Room ->
     ((IM.IntMap [Placement], GenWorld), Room)
-doRoomOutPlacements imw r = foldr f (imw, r) $ IM.toList $ _rmOutPmnt r
+doRoomOutPlacements imw r = foldr f (imw, r) $ _rmOutPmnt r
   where
-    f (i, pl) ((im, w), rm) =
+    f (OutPlacement pl i) ((im, w), rm) =
         let ((neww, newrm), plmnts) = placeSpot (w, rm) pl
          in ((IM.insert i plmnts im, neww), newrm)
 

src/Dodge/LevelGen.hs

@@ -1,6 +1,5 @@
-module Dodge.LevelGen (generateWorldFromSeed) where
+module Dodge.LevelGen where
 
-import Dodge.Annotation.Data
 import Dodge.Layout
 import Data.Preload.Render
 import Control.Lens
@@ -51,17 +50,16 @@ layoutLevelFromSeed i seed = do
     putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
     appendFile "log/attemptedSeeds" "\n"
     let g = mkStdGen seed
-    let treecluster = evalState tutRoomTree (LayVars g 0)
+    let treecluster = evalState initialRoomTree (g, 0)
     let labts = decomposeSelfTree $ numSelfTree $ combineTree _rmName treecluster
     appendFile "log/treeCluster" ("Seed: " ++ show seed ++ "\n")
-    putStrLn "MetaTree clusters:"
     mapM_ (putStrLnAppend "log/treeCluster" . smallDrawTree . fmap showIntsString) labts
     let tc = composeTree treecluster
     let rmtree = inorderNumberTree tc
-    appendFile "log/aGeneratedRoomLayout" ("Seed: " ++ show seed ++ "\n")
+    putStrLn "Room layout (compact): "
-    putStrLnAppend "log/aGeneratedRoomLayout" "Room layout (compact): "
+    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
-    putStrLnAppend "log/aGeneratedRoomLayout" $ compactDrawTree $ fmap (show . snd) rmtree
     let nameshow (r, rid) = _rmName r ++ "-" ++ show rid
+    appendFile "log/aGeneratedRoomLayout" ("Seed: " ++ show seed)
     putStrLnAppend "log/aGeneratedRoomLayout" "Layout with room names:"
     putStrLnAppend "log/aGeneratedRoomLayout" $ smallDrawTree $ fmap nameshow rmtree
     mrs <- positionRoomsFromTree rmtree

src/Dodge/LockAndKey.hs

@@ -22,7 +22,7 @@ lockRoomMultiItems =
         )
     ]
 
-lockRoomKeyItems :: [(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
+lockRoomKeyItems :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
 lockRoomKeyItems =
     [ (lasCenSensEdge, takeOne [HELD RLAUNCHER, LASER, HELD SPARKGUN, HELD FLATSHIELD])
     , (sensorRoomRunPast LaserSensor, return LASER)
@@ -121,7 +121,7 @@ someCrits :: RandomGen g => State g [Creature]
 someCrits = do
     nCrits <- state $ randomR (1, 3)
     fmap (take nCrits) . shuffle $
-        [spreadGunCrit, autoCrit, armourChaseCrit]
+        [spreadGunCrit, pistolCrit, autoCrit, armourChaseCrit]
             ++ replicate 20 chaseCrit
 
 --addcrits :: RandomGen g => [Item] -> State g (Tree Room)

src/Dodge/Machine/Destroy.hs

@@ -20,11 +20,9 @@ destroyMachine mc =
         . destroyMcType (mc ^. mcType) mc
 
 destroyMcType :: MachineType -> Machine -> World -> World
-destroyMcType mt mc w = case mt of
+destroyMcType mt mc = case mt of
-    McTurret tu -> fromMaybe w $ do
+    McTurret tu -> copyItemToFloor (_mcPos mc) (_tuWeapon tu)
-        itm <- w ^? cWorld . lWorld . items . ix (tu ^. tuWeapon)
+    _ -> id
-        return $ copyItemToFloor (_mcPos mc) itm w
-    _ -> w
 
 mcKillTerm :: Machine -> World -> World
 mcKillTerm mc w = fromMaybe w $ do

src/Dodge/Machine/Draw.hs

@@ -1,4 +1,6 @@
-module Dodge.Machine.Draw ( drawMachine) where
+module Dodge.Machine.Draw (
+    drawMachine,
+) where
 
 import Dodge.Terminal.Color
 import Control.Lens
@@ -16,7 +18,7 @@ drawMachine :: LWorld -> Machine -> SPic
 drawMachine lw mc = case _mcType mc of
     McStatic -> mempty
     McTerminal -> terminalSPic lw mc
-    McTurret tu -> drawBaseMachine 20 mc <> drawTurret lw tu mc
+    McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
     McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
 
 drawSensor :: Sensor -> Machine -> SPic
@@ -60,10 +62,10 @@ drawBaseMachine h mc =
         . square
         $ _mcWidth mc
 
-drawTurret :: LWorld -> Turret -> Machine -> SPic
+drawTurret :: Turret -> Machine -> SPic
-drawTurret lw tu mc = fold $ do
+drawTurret tu mc = overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
-    itm <- lw ^? items . ix (tu ^. tuWeapon)
+  where
-    return $ overPosSP (turretItemOffset itm tu mc) (itemSPic itm)
+    itm = _tuWeapon tu
 
 sensorSPic :: (PaletteColor, DecorationShape) -> Machine -> SPic
 sensorSPic (pc, ds) mc =

src/Dodge/Machine/Update.hs

@@ -83,13 +83,12 @@ isElectrical dm = case dm of
     _ -> False
 
 mcUseItem :: Machine -> World -> World
-mcUseItem mc w = fromMaybe w $ do
+mcUseItem mc = fromMaybe id $ do
     tu <- mc ^? mcType . _McTurret
-    let i = tu ^. tuWeapon
+    let it = tu ^. tuWeapon
-    it <- w ^? cWorld . lWorld . items . ix i
     hit <- it ^? itType
     guard (_tuFireTime tu > 0)
-    return $ mcUseHeld hit it mc w
+    return $ mcUseHeld hit it mc
 
 mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
 mcSensorTriggerUpdate se mc = fromMaybe id $ do
@@ -153,8 +152,7 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
 mcProxTest :: Machine -> World -> Bool
 mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
     Just (RequireHealth x) -> _crHP cr >= x
-    Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) 
+    Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) (_crInv cr)
-        (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
     _ -> False
   where
     cr = you w

src/Dodge/Menu/Option.hs

@@ -96,14 +96,14 @@ menuOptionToSelectionItem ::
     MenuOption ->
     SelectionItem (Universe -> Universe, Universe -> Universe)
 menuOptionToSelectionItem w padAmount mo =
-    SelItem
+    SelectionItem
         { _siPictures = [optionText]
         , _siHeight = 1
         , _siWidth = 50
         , _siIsSelectable = isselectable
         , _siColor = thecol
         , _siOffX = 0
-        , _siPayload = Just (f, g)
+        , _siPayload = (f, g)
         }
   where
     isselectable = case _moString mo w of

src/Dodge/Placement/Instance/Analyser.hs

@@ -1,4 +1,6 @@
-module Dodge.Placement.Instance.Analyser (analyser) where
+module Dodge.Placement.Instance.Analyser (
+    analyser,
+) where
 
 import Color
 import Dodge.Data.GenWorld
@@ -7,7 +9,11 @@ import Dodge.Placement.Instance
 import Dodge.Terminal
 import LensHelp
 
-analyser :: ProximityRequirement -> PlacementSpot -> PlacementSpot -> Placement
+analyser ::
+    ProximityRequirement ->
+    PlacementSpot ->
+    PlacementSpot ->
+    Placement
 analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
     Just $
         plSpot .~ psmc $

src/Dodge/Placement/Instance/Sensor.hs

@@ -12,7 +12,12 @@ import Dodge.LevelGen.PlacementHelper
 import Dodge.LightSource
 import Geometry
 
-damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
+damageSensor ::
+    SensorType ->
+    Float ->
+    Maybe Int ->
+    PlacementSpot ->
+    Placement
 damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
     \lsid -> psPtJpl ps
         . PutUsingGenParams
@@ -35,7 +40,6 @@ damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $
                             )
                 )
                 defaultSensorWall
-                Nothing
             )
 
 damageTypeThreshold :: SensorType -> Int

src/Dodge/Placement/Instance/Terminal.hs

@@ -1,11 +1,9 @@
 module Dodge.Placement.Instance.Terminal (
     putMessageTerminal,
-    putImmediateMessageTerminal,
     putTerminal,
     terminalColor,
 ) where
 
-import Dodge.WorldEffect
 import Color
 import Data.Maybe
 import Dodge.Data.GenWorld
@@ -15,17 +13,11 @@ import Dodge.SoundLogic
 import Geometry
 import LensHelp
 
-putTerminalImediateAccess :: Color -> Machine -> Terminal -> Placement
+putTerminal :: Color -> Machine -> Terminal -> Placement
-putTerminalImediateAccess = putTerminalFull f
+putTerminal col mc tm =
-  where
-    f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ accessTerminal (tmpl ^?! plMID . _Just)
-
-putTerminalFull ::(Placement -> Placement -> Placement -> Maybe Placement) ->  Color -> Machine -> Terminal -> 
-    Placement
-putTerminalFull f col mc tm =
     ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
         \tmpl -> Just $
-            ps0PushPS (PutButton defaultButton) $
+            ps0PushPS (PutButton termButton) $
                 \btpl -> Just $
                     pt0
                         ( PutMachine
@@ -34,24 +26,20 @@ putTerminalFull f col mc tm =
                                 & mcCloseSound ?~ fridgeHumS
                             )
                             defaultSensorWall
-                            Nothing
                         )
-                        $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
+                        $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
   where
     setids tmpl btpl mcpl w =
         w
             & cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
             & cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
             & cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
-            & cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal tmid
+            & cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
       where
         tmid = fromJust (_plMID tmpl)
         btid = fromJust (_plMID btpl)
         mcid = fromJust (_plMID mcpl)
 
-putTerminal :: Color -> Machine -> Terminal -> Placement
-putTerminal = putTerminalFull (\_ _ _ -> Nothing)
-
 putMessageTerminal :: Color -> Terminal -> Placement
 putMessageTerminal col =
     putTerminal col $
@@ -60,13 +48,15 @@ putMessageTerminal col =
             & mcType .~ McTerminal
             & mcHP .~ 100
 
-putImmediateMessageTerminal :: Color -> Terminal -> Placement
+termButton :: Button
-putImmediateMessageTerminal col =
+termButton =
-    putTerminalImediateAccess col $
+    Button
-        defaultMachine
+        { _btPos = 0
-            & mcColor .~ col
+        , _btRot = 0
-            & mcType .~ McTerminal
+        , _btEvent = ButtonAccessTerminal
-            & mcHP .~ 100
+        , _btID = 0
+        , _btTermMID = Nothing
+        }
 
 terminalColor :: Color
 terminalColor = dark magenta

src/Dodge/Placement/Instance/Turret.hs

@@ -19,7 +19,6 @@ putTurret itm rotSpeed =
                 & mcHP .~ 50000
             )
             defaultMachineWall
-            (Just itm)
 
 putLasTurret :: Float -> Placement
 putLasTurret rotSpeed =
@@ -32,15 +31,14 @@ putLasTurret rotSpeed =
                 & mcHP .~ 50000
             )
             defaultMachineWall
-            (Just laser)
 
 turret :: Item -> MachineType
-turret _ = lasTurret
+turret wp = lasTurret & mctTurret . tuWeapon .~ wp
 
 lasTurret :: MachineType
 lasTurret = McTurret $
     Turret
-        { _tuWeapon = 0
+        { _tuWeapon = laser
         , _tuTurnSpeed = 0.1
         , _tuFireTime = 0
         , _tuDir = 0

src/Dodge/Placement/PlaceSpot.hs

@@ -2,9 +2,10 @@
 {- | deals with placement of objects within the world
  after they have had their coordinates set by the layout
 -}
-module Dodge.Placement.PlaceSpot (placeSpot) where
+module Dodge.Placement.PlaceSpot (
+    placeSpot,
+) where
 
-import NewInt
 import Color
 import LensHelp
 import Control.Monad.State
@@ -21,11 +22,11 @@ import Dodge.Placement.Shift
 import Dodge.ShiftPoint
 import Geometry
 import qualified IntMapHelp as IM
+import NewInt
 import System.Random
 
 -- when placing a placement, we update the world and the room and assign an id
--- to the placement. This id should be associated with the type of placement and
+-- to the placement
--- match up with the created id for the object (creature id, flitid id, etc)
 placeSpot :: (GenWorld, Room) -> Placement -> ((GenWorld, Room), [Placement])
 placeSpot (w, rm) plmnt = case plmnt of
     Placement{_plSpot = PSRoomRand i f} -> placeSpotRoomRand rm i f plmnt w
@@ -109,20 +110,15 @@ placeSpotID' ps pt w = case pt of
     PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
     PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
     PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
-    PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . items)
+    PutFlIt itm ->
-        in (i, w
+        plNewUpID
-            & cWorld . lWorld . floorItems . at i ?~ createFlIt p rot 
+            (cWorld . lWorld . floorItems . unNIntMap)
-            & cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i
+            (flItID . unNInt)
-                & itLocation .~ OnFloor)
+            (createFlIt p rot itm)
-            )
+            w
---        plNewUpID
---            (cWorld . lWorld . floorItems . unNIntMap)
---            (flItID . unNInt)
---            (createFlIt p rot itm)
---            w
     PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
-    PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
+    PutMachine pps mc wl -> plMachine (map doShift pps) mc wl p rot w
     PutLS ls -> plNewUpID (cWorld . lWorld . lightSources) lsID (mvLS p' rot ls) w
     PutPPlate pp -> plNewUpID (cWorld . lWorld . pressPlates) ppID (mvPP p rot pp) w
     RandPS rgn -> evaluateRandPS rgn ps w
@@ -182,8 +178,8 @@ mvButton :: Point2 -> Float -> Button -> Button
 mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
 
 {- Creates a floor item at a given point.-}
-createFlIt :: Point2 -> Float -> FloorItem
+createFlIt :: Point2 -> Float -> Item -> FloorItem
-createFlIt p rot = FlIt{_flItPos = p, _flItRot = rot}
+createFlIt p rot itm = FlIt{_flItPos = p, _flItRot = rot, _flItID = 0, _flIt = itm}
 
 mvPP :: Point2 -> Float -> PressPlate -> PressPlate
 mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
@@ -194,31 +190,8 @@ mvCr p rot cr = cr{_crPos = p, _crOldPos = p, _crDir = rot}
 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
 
-plMachine :: [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
+plMachine :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
-plMachine wallpoly mc wl mitm = case mitm of
+plMachine wallpoly mc wl p rot gw =
-    Nothing -> plMachine' wallpoly mc wl
-    Just itm -> plTurret wallpoly mc wl itm
-
-plTurret :: [Point2] -> Machine -> Wall -> Item -> Point2 -> Float -> World -> (Int, World)
-plTurret wallpoly mc wl itm p rot gw =
-    ( mcid
-    , gw & cWorld . lWorld . machines %~ addMc
-        & cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid
-        & cWorld . lWorld . items . at itid ?~ itm'
-    )
-  where
-    itm' = itm & itID .~ NInt itid
-        & itLocation .~ OnTurret mcid
-    itid = IM.newKey $ gw ^. cWorld . lWorld . items
-    col = _mcColor mc
-    mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
-    wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
-    wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
-    addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
-        & mcType . mctTurret . tuWeapon .~ itid)
-
-plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
-plMachine' wallpoly mc wl p rot gw =
     ( mcid
     , gw & cWorld . lWorld . machines %~ addMc
         & cWorld . lWorld . walls %~ placeMachineWalls wl col wallpoly mcid wlid

src/Dodge/PlacementSpot.hs

@@ -1,51 +1,50 @@
 --{-# LANGUAGE LambdaCase #-}
-module Dodge.PlacementSpot (
+module Dodge.PlacementSpot 
-    atFstLnkOut,
+    ( atFstLnkOut
-    atNthLnkOutShiftBy,
+    , rpIsOnPath
-    rpIsOnPath,
+    , rpIsOffPath
-    rpIsOffPath,
+    , rpOffPathFromEdge
-    rpOffPathFromEdge,
+    , rpOnPathFromEdge
-    rpOnPathFromEdge,
+    , useUnusedLnk
-    useUnusedLnk,
+    , psRandRanges
-    psRandRanges,
+    , useRoomPosCond
-    useRoomPosCond,
+    , isUsedLnkUnplaced
-    isUsedLnkUnplaced,
+    , anyUnusedSpot
-    anyUnusedSpot,
+    , unusedSpotAwayFromLink
-    unusedSpotAwayFromLink,
+    , isUnusedLnk
-    isUnusedLnk,
+    , isInLnk
-    isInLnk,
+    , isOutLnk
-    isOutLnk,
+    , unusedSpotNearInLink
-    unusedSpotNearInLink,
+    , randDirPS
-    randDirPS,
+    , unusedSpotAwayFromInLink
-    unusedSpotAwayFromInLink,
+    , useLnkRoomPos
-    useLnkRoomPos,
+    , atFstLnkOutShiftInward
-    atFstLnkOutShiftInward,
+    , atFstLnkOutShiftBy
-    atFstLnkOutShiftBy,
+    , atNthLnkOutShiftInward
-    atNthLnkOutShiftInward,
+    , unusedOffPathAwayFromLink
-    unusedOffPathAwayFromLink,
+    , setFallback
-    setFallback,
+    , twoRoomPoss
-    twoRoomPoss,
+    , isUnusedLnkType
-    isUnusedLnkType,
+    , rprBoolShift 
-    rprBoolShift,
+    , rprShift
-    rprShift,
+    , rprBool
-    rprBool,
+    , shiftInBy
-    shiftInBy,
+    , resetPLUse
-    resetPLUse,
+    , psposAddLabel
-    psposAddLabel,
+    , shiftByV2
-    shiftByV2,
+    , usedRoomLinkPoss
-    usedRoomLinkPoss,
+    , usedRoomInLinkPoss
-    usedRoomInLinkPoss,
+    ) where
-    atNthLinkOut,
-) where
 
-import Control.Lens
-import Control.Monad.State
-import Data.Bifunctor
-import Data.Maybe
-import qualified Data.Set as S
 import Dodge.Data.GenWorld
 import Geometry
+
+import Control.Lens
+import Data.Maybe
+import Data.Bifunctor
+import Control.Monad.State
 import System.Random
+import qualified Data.Set as S
 
 setDirPS :: Float -> PlacementSpot -> PlacementSpot
 setDirPS a ps = case ps of
@@ -56,12 +55,12 @@ setDirPS a ps = case ps of
 
 randDirPS :: RandomGen g => PlacementSpot -> State g PlacementSpot
 randDirPS ps = do
-    a <- state $ randomR (0, pi * 2)
+    a <- state $ randomR (0,pi*2)
     return $ setDirPS a ps
 
 isUnusedLnk :: RoomPos -> Room -> Bool
 isUnusedLnk rp _ = case _rpLinkStatus rp of
-    UnusedLink{} -> _rpPlacementUse rp == 0
+    UnusedLink {} -> _rpPlacementUse rp == 0
     _ -> False
 
 anyUnusedSpot :: PlacementSpot
@@ -76,15 +75,13 @@ rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
 rpIsOnPath :: RoomPos -> Bool
 rpIsOnPath = any f . _rpType
   where
-    f RoomPosOnPath{} = True
+    f RoomPosOnPath {} = True
     f _ = False
-
 rpIsOffPath :: RoomPos -> Bool
 rpIsOffPath = any f . _rpType
   where
-    f RoomPosOffPath{} = True
+    f RoomPosOffPath {} = True
     f _ = False
-
 rpOffPathFromEdge :: PathFromEdge -> RoomPos -> Bool
 rpOffPathFromEdge pe = any f . _rpType
   where
@@ -102,64 +99,58 @@ resetPLUse (PSPos f g fallback) = PSPos f' g fallback
     f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp
 resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement"
 
-rprShift ::
+rprShift
-    (RoomPos -> Room -> Maybe (Point2, Float)) ->
+    :: (RoomPos -> Room -> Maybe (Point2,Float)) 
-    PlacementSpot
+    -> PlacementSpot
 rprShift t = PSPos f (const id) Nothing
   where
     f rp r = case t rp r of
-        Just (p, a) -> Just (PS p a, rp & rpPlacementUse +~ 1)
+        Just (p,a)  -> Just (PS p a, rp & rpPlacementUse +~ 1)
         Nothing     -> Nothing
 
-rprBoolShift ::
+rprBoolShift :: (RoomPos -> Room -> Bool) 
-    (RoomPos -> Room -> Bool) ->
+    -> ((Point2,Float) -> (Point2,Float))
-    ((Point2, Float) -> (Point2, Float)) ->
+    -> PlacementSpot
-    PlacementSpot
 rprBoolShift t shift = PSPos f (const id) Nothing
   where
     f rp r
         | t rp r    = Just (PS p a, rp & rpPlacementUse +~ 1)
         | otherwise = Nothing
       where
-        (p, a) = shift (_rpPos rp, _rpDir rp)
+        (p,a) = shift (_rpPos rp, _rpDir rp)
 
 unusedSpotAwayFromLink :: Float -> PlacementSpot
-unusedSpotAwayFromLink x = rprBool $ \rp r ->
+unusedSpotAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
-    _rpLinkStatus rp == NotLink
     && _rpPlacementUse rp == 0 
-        && all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
 
 setFallback :: Placement -> Placement -> Placement
-setFallback fallback =
+setFallback fallback 
-    (plSpot . psFallback %~ maybe (Just fallback) Just)
+    = (plSpot . psFallback %~ maybe (Just fallback) Just)
-        . ( plIDCont %~ fmap (fmap (fmap $ setFallback fallback))
+    . (plIDCont %~ fmap (fmap (fmap $ setFallback fallback))
     )
 
 unusedOffPathAwayFromLink :: Float -> PlacementSpot
 --unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
-unusedOffPathAwayFromLink x = rprBool $ \rp r ->
+unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpPlacementUse rp == 0 
-    _rpPlacementUse rp == 0
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
-        && all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
     && rpIsOffPath rp
 
 unusedSpotAwayFromInLink :: Float -> PlacementSpot
-unusedSpotAwayFromInLink x = rprBool $ \rp r ->
+unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
-    _rpLinkStatus rp == NotLink
     && _rpPlacementUse rp == 0 
-        && all ((> x) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
+    && all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
 
 --twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
 --twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
 
-twoRoomPoss ::
+twoRoomPoss :: (RoomPos -> Room -> Bool)
-    (RoomPos -> Room -> Bool) ->
+    -> (RoomPos -> Room -> Bool)
-    (RoomPos -> Room -> Bool) ->
+    -> (PlacementSpot -> PlacementSpot -> Placement)
-    (PlacementSpot -> PlacementSpot -> Placement) ->
+    -> Placement
-    Placement
+twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing
-twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing $
+    $ \_ pl1 -> Just $ Placement 10 (rprBool cond2) PutNothing Nothing
-    \_ pl1 -> Just $
+    $ \_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
-        Placement 10 (rprBool cond2) PutNothing Nothing $
-            \_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
 --isUnusedLnk :: RoomPos -> Bool
 --isUnusedLnk rp = case _rpLinkStatus rp of
@@ -168,12 +159,11 @@ twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing $
 
 isInLnk :: RoomPos -> Bool
 isInLnk rp = case _rpLinkStatus rp of
-    UsedInLink{} -> _rpPlacementUse rp == 0
+    UsedInLink {} -> _rpPlacementUse rp == 0
     _ -> False
-
 isOutLnk :: RoomPos -> Bool
 isOutLnk rp = case _rpLinkStatus rp of
-    UsedOutLink{} -> _rpPlacementUse rp == 0
+    UsedOutLink {} -> _rpPlacementUse rp == 0
     _ -> False
 
 useUnusedLnk :: PlacementSpot
@@ -181,14 +171,14 @@ useUnusedLnk = rprBool isUnusedLnk
 
 isUsedLnkUnplaced :: RoomPos -> Bool
 isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
-    UsedOutLink{} -> _rpPlacementUse rp == 0
+    UsedOutLink {} -> _rpPlacementUse rp == 0
-    UsedInLink{} -> _rpPlacementUse rp == 0
+    UsedInLink  {} -> _rpPlacementUse rp == 0
     _ -> False
 
-useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
+useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosCond f = useRoomPosRoomCond $ \rp r -> f rp r
 
-useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
+useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosRoomCond t rp r
     | t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
@@ -199,36 +189,31 @@ isUnusedLnkType rlt rp _ = case _rpLinkStatus rp of
     _ -> False
 
 unusedSpotNearInLink :: Float -> PlacementSpot
-unusedSpotNearInLink x = rprBool $ \rp r ->
+unusedSpotNearInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
-    _rpLinkStatus rp == NotLink
     && _rpPlacementUse rp == 0 
-        && any ((< x) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
+    && any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
 
 usedRoomInLinkPoss :: Room -> [Point2]
 usedRoomInLinkPoss r = mapMaybe f $ _rmPos r
   where
     f rp = case _rpLinkStatus rp of
-        UsedInLink{} -> Just $ _rpPos rp
+        UsedInLink {} -> Just $ _rpPos rp
         _ -> Nothing
 
 usedRoomLinkPoss :: Room -> [Point2]
 usedRoomLinkPoss r = mapMaybe f $ _rmPos r
   where
     f rp = case _rpLinkStatus rp of
-        UsedInLink{} -> Just $ _rpPos rp
+        UsedInLink {} -> Just $ _rpPos rp
-        UsedOutLink{} -> Just $ _rpPos rp
+        UsedOutLink {} -> Just $ _rpPos rp
         _ -> Nothing
 
 atFstLnkOut :: PlacementSpot
-atFstLnkOut = atNthLinkOut 0
+atFstLnkOut = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just 0
-
-atNthLinkOut :: Int -> PlacementSpot
-atNthLinkOut n = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
-
-atNthLnkOutShiftBy :: Int -> ((Point2, Float) -> (Point2, Float)) -> PlacementSpot
-atNthLnkOutShiftBy n = rprBoolShift $
-    \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
 
+atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
+atNthLnkOutShiftBy n = rprBoolShift 
+    $ \ rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just n
 --atNthLnkOutShiftBy n theshift = PSPos f (const id) Nothing
 --  where
 --    f rp _ = case _rpLinkStatus rp of
@@ -238,32 +223,32 @@ atNthLnkOutShiftBy n = rprBoolShift $
 --      where
 --        (p,a) = theshift (_rpPos rp,_rpDir rp)
 
-atFstLnkOutShiftBy :: ((Point2, Float) -> (Point2, Float)) -> PlacementSpot
+atFstLnkOutShiftBy :: ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atFstLnkOutShiftBy = atNthLnkOutShiftBy 0
 
 atFstLnkOutShiftInward :: Float -> PlacementSpot
 atFstLnkOutShiftInward = atNthLnkOutShiftInward 0
 
 atNthLnkOutShiftInward :: Int -> Float -> PlacementSpot
-atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n $
+atNthLnkOutShiftInward n x = atNthLnkOutShiftBy n
-    \(p, a) -> (p +.+ rotateV a (V2 0 (negate x)), a)
+    $ \ (p,a) -> (p +.+ rotateV a (V2 0 (negate x)),a)
 
-shiftInBy :: Float -> (Point2, Float) -> (Point2, Float)
+shiftInBy :: Float -> (Point2,Float) -> (Point2,Float)
-shiftInBy x (p, a) = (p +.+ rotateV a (V2 0 (negate x)), a)
+shiftInBy x (p,a) = (p +.+ rotateV a (V2 0 (negate x)),a)
 
-shiftByV2 :: Point2 -> (Point2, Float) -> (Point2, Float)
+shiftByV2 :: Point2 -> (Point2,Float) -> (Point2,Float)
-shiftByV2 x (p, a) = (p +.+ rotateV a x, a)
+shiftByV2 x (p,a) = (p +.+ rotateV a x,a)
 
 -- this should probably check the placement use, but so should others: should
 -- unify these
-useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot, RoomPos)
+useLnkRoomPos :: RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useLnkRoomPos rp _ = case _rpLinkStatus rp of
-    UnusedLink{} -> Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
+    UnusedLink {} -> Just (PS (_rpPos rp) (_rpDir rp) , rp & rpPlacementUse +~ 1)
     _ -> Nothing
 
-psRandRanges :: (Float, Float) -> (Float, Float) -> (Float, Float) -> State StdGen (Point2, Float)
+psRandRanges :: (Float,Float) -> (Float,Float) -> (Float,Float) -> State StdGen (Point2,Float)
 psRandRanges xranges yranges aranges = do
     x <- state $ randomR xranges
     y <- state $ randomR yranges
     a <- state $ randomR aranges
-    return (V2 x y, a)
+    return (V2 x y,a)

src/Dodge/Projectile/Update.hs

@@ -1,4 +1,5 @@
---{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase #-}
+
 --{-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update (updateProjectile) where
 
@@ -73,7 +74,7 @@ shellHitWall p n wl pj w
       , abs (dot (pj ^. pjVel) (normalize n)) < x =
         w
             & topj . pjVel %~ reflectInNormal n
-            & topj . pjPos .~ p + normalize n
+            & topj . pjPos .~ p + (normalize n)
             & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
     | otherwise =
         w & topj . pjPos .~ p
@@ -163,9 +164,9 @@ destroyProjectile mitid pjid w =
         & removelink
   where
     removelink = fromMaybe id $ do
-        itid <- mitid
+        itid <- fmap _unNInt mitid
---        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
+        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
-        return $ pointerToItemID itid . itUse . uaParams . apProjectiles %~ delete pjid
+        return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
 
 trySpin :: Projectile -> World -> World
 trySpin pj = fromMaybe id $ do
@@ -228,7 +229,7 @@ pjRemoteSetDirection :: Maybe RocketHoming -> Projectile -> World -> World
 pjRemoteSetDirection ph pj w = case ph of
     Just (HomeUsingRemoteScreen screenid)
         | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
-            == lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
+            == lw ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
             w
                 & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
                     .~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)

src/Dodge/RadarSweep.hs

@@ -91,7 +91,7 @@ crBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _crPos . IM.filter g . _
     g cr = _crID cr /= 0
 
 itemBlips :: Point2 -> Float -> World -> ([Point2], S.Set (Point2, Point2))
-itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _floorItems . _lWorld . _cWorld
+itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _unNIntMap . _floorItems . _lWorld . _cWorld
   where
     f q = dist p q <= r && dist p q > r - 4