Add XInfinity datatype

More checks required

appDodge/Main.hs

@@ -2,6 +2,7 @@ module Main (
     main,
 ) where
 
+import Dodge.StartNewGame
 import Control.Lens
 import Control.Monad
 import Control.Parallel
@@ -15,7 +16,7 @@ import Dodge.Data
 import Dodge.Event
 import Dodge.Initialisation
 import Dodge.LoadSeed
-import Dodge.Menu
+--import Dodge.Menu
 import Dodge.Render
 import Dodge.SoundLogic.LoadSound
 import Dodge.TestString
@@ -100,7 +101,8 @@ firstWorldLoad theConfig = do
                 , _uvDebugMessageOffset = 0
                 , _uvSoundQueue = mempty
                 }
-    return $ u & uvScreenLayers .~ [splashMenu u]
+    --return $ u & uvScreenLayers .~ [splashMenu u]
+    return $ startNewGameInSlot 0 u
 
 theUpdateStep :: SDL.Window -> Universe -> IO Universe
 theUpdateStep win = doSideEffects <=< updateRenderSplit win

log/aGeneratedRoomLayout

@@ -1,4 +1,20 @@
-Seed: 7114951007332849727Layout with room names:
+Seed: 7114951007332849727
+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
@@ -53,7 +69,7 @@ ElecautoRect-6
 |  |  |
 |  |  autoDoor-26
 |  |  |
-|  |  warningTerm-8gon-27
+|  |  doorToggle-8gon-27
 |  |  |
 |  |  triggerDoorRoom-28
 |  |  |
@@ -91,55 +107,57 @@ ElecautoRect-6
 |  |  |
 |  |  autoDoor-45
 |  |  |
-|  |  rect-46
+|  |  8gon-46
 |  |  |
-|  |  +- autoDoor-47
+|  |  +- triggerDoorRoom-47
 |  |  |  |
 |  |  |  autoDoor-48
 |  |  |  |
-|  |  |  Corridor-49
+|  |  |  autoDoor-49
 |  |  |  |
-|  |  |  autoRect-50
+|  |  |  Corridor-50
 |  |  |  |
-|  |  |  defaultRoom-51
+|  |  |  autoRect-51
 |  |  |  |
-|  |  |  autoRect-52
+|  |  |  defaultRoom-52
 |  |  |  |
-|  |  |  defaultRoom-53
+|  |  |  autoRect-53
 |  |  |  |
-|  |  |  autoRect-54
+|  |  |  defaultRoom-54
 |  |  |  |
-|  |  |  autoDoor-55
+|  |  |  autoRect-55
 |  |  |  |
-|  |  |  Corridor-56
+|  |  |  autoDoor-56
 |  |  |  |
-|  |  |  autoDoor-57
+|  |  |  Corridor-57
 |  |  |  |
-|  |  |  8gon-58
+|  |  |  autoDoor-58
 |  |  |  |
-|  |  |  triggerDoorRoom-59
+|  |  |  8gon-59
 |  |  |  |
-|  |  |  autoDoor-60
+|  |  |  triggerDoorRoom-60
 |  |  |  |
 |  |  |  autoDoor-61
 |  |  |  |
-|  |  |  Corridor-62
+|  |  |  autoDoor-62
 |  |  |  |
-|  |  |  defaultRoom-63
+|  |  |  Corridor-63
-|  |  |
+|  |  |  |
-|  |  Corridor-64
+|  |  |  defaultRoom-64
 |  |  |
 |  |  autoDoor-65
+|  |  |
+|  |  Corridor-66
 |  |
-|  autoDoor-66
+|  autoDoor-67
 |  |
-|  Corridor-67
+|  Corridor-68
 |  |
-|  autoRect-68
+|  autoRect-69
 |
-autoDoor-69
+autoDoor-70
 |
-Corridor-70
+Corridor-71
 |
-autoRect-71
+defaultRoom-72
 

log/attemptedSeeds

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

log/treeCluster

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

src/Dodge/Annotation.hs

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

src/Dodge/Annotation/Data.hs

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

src/Dodge/Base/Collide.hs

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

src/Dodge/Base/NewID.hs

@@ -4,20 +4,13 @@ import LensHelp
 
 -- | generalised way of putting a new item into a lensed intmap, returning the
 -- new index as well
-plNewID :: ALens' b (IM.IntMap a)
+plNewID :: ALens' b (IM.IntMap a) -> a -> b -> (Int,b)
-    -> 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)
+plNewUpID :: ALens' b (IM.IntMap a) -> ALens' a Int -> a -> b -> (Int,b)
-    -> 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,8 +5,9 @@ module Dodge.Base.You
     , yourRootItem
     )where
 
+import NewInt
 import Dodge.Data.World
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 import Control.Lens
 
 you :: World -> Creature
@@ -15,13 +16,15 @@ you w = w ^?! cWorld . lWorld . creatures . ix 0
 yourSelectedItem :: World -> Maybe Item
 yourSelectedItem w = do
     i <- you w ^? crManipulation . manObject . imSelectedItem
-    _crInv (you w) IM.!? i
+    j <- _crInv (you w) ^? ix i
+    w ^? cWorld . lWorld . items . ix j
 
 yourRootItem :: World -> Maybe Item
 yourRootItem w = do
     i <- you w ^? crManipulation . manObject . imRootSelectedItem
-    _crInv (you w) IM.!? i
+    j <- _crInv (you w) ^? ix i
+    w ^? cWorld . lWorld . items . ix j
 
-yourInv :: World -> IM.IntMap Item
+yourInv :: World -> NewIntMap InvInt Item
-yourInv = _crInv . you
+yourInv w = fmap (\i -> w ^?! cWorld . lWorld . items . ix i) . _crInv . you $ w
 

src/Dodge/Bullet.hs

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

src/Dodge/Button/Draw.hs

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

src/Dodge/Button/Event.hs

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

src/Dodge/Combine.hs

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

src/Dodge/Corpse/Make.hs

@@ -9,12 +9,10 @@ import Dodge.Data.Creature
 import Geometry
 import Shape
 import ShapePicture
+import qualified Data.IntMap.Strict as IM
 
-makeCorpse :: Creature -> Corpse
+makeCorpse :: IM.IntMap Item -> Creature -> Corpse
-makeCorpse = makeDefaultCorpse
+makeCorpse m cr =
-
-makeDefaultCorpse :: Creature -> Corpse
-makeDefaultCorpse cr =
     defaultCorpse
         & cpPos .~ _crPos cr
         & cpDir .~ _crDir cr
@@ -22,8 +20,8 @@ makeDefaultCorpse cr =
             .~ noPic
                 ( scaleSH (V3 crsize crsize crsize) $
                     mconcat
-                        [ colorSH (_skinHead cskin) $ deadScalp cr
+                        [ colorSH (_skinHead cskin) $ deadScalp m cr
-                        , colorSH (_skinUpper cskin) $ deadUpperBody cr
+                        , colorSH (_skinUpper cskin) $ deadUpperBody m 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,7 +38,6 @@ import Dodge.Creature.Inanimate
 import Dodge.Creature.LauncherCrit
 import Dodge.Creature.LtAutoCrit
 import Dodge.Creature.Perception
-import Dodge.Creature.PistolCrit
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.SentinelAI
 import Dodge.Creature.SpreadGunCrit
@@ -58,34 +57,34 @@ spawnerCrit :: Creature
 spawnerCrit =
     defaultCreature
         & crHP .~ 300
-        & crInv .~ IM.empty
+--        & crInv .~ IM.empty
 --        & crType . skinUpper .~ lightx4 blue
 
 miniGunCrit :: Creature
 miniGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, miniGunX 3)]
+--        & crInv .~ IM.fromList [(0, miniGunX 3)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MiniGunAI
 
 longCrit :: Creature
 longCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, sniperRifle)]
+--        & crInv .~ IM.fromList [(0, sniperRifle)]
 --        & crType . humanoidAI .~ LongAI
 --        & crType . skinUpper .~ lightx4 red
 
 multGunCrit :: Creature
 multGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, volleyGun 4)]
+--        & crInv .~ IM.fromList [(0, volleyGun 4)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MultGunAI
 
 addArmour :: Creature -> Creature
 addArmour = over crInv insarmour
   where
-    insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
+    insarmour xs = xs -- IM.insert (IM.newKey xs) frontArmour xs
 
 {- | The creature you control.
 ID 0.
@@ -99,7 +98,7 @@ startCr =
         & crMvDir .~ pi / 2
         & crID .~ 0
         & crHP .~ 10000
-        & crInv .~ startInventory
+        & crInv .~ mempty
         & crFaction .~ PlayerFaction
 --        & crMvType .~ MvWalking yourDefaultSpeed
         & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
@@ -239,7 +238,7 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
-    'P' -> [burstRifle , tinMag, bulletSynthesizer]
+    'P' -> [burstRifle , tinMag, bulletSynthesizer, battery]
     'T' -> testInventory
     'U' ->
         [targetingScope tt | tt <- [minBound .. maxBound]]

src/Dodge/Creature/Action.hs

@@ -13,6 +13,7 @@ module Dodge.Creature.Action (
     youDropItem,
 ) where
 
+import NewInt
 import Dodge.Creature.MoveType
 import Dodge.Creature.Radius
 import Dodge.Item.BackgroundEffect
@@ -166,22 +167,26 @@ performAction cr w ac = case ac of
 dropExcept :: Creature -> Int -> World -> World
 dropExcept cr invid w =
     foldr (dropItem cr) w . IM.keys $
-        invid `IM.delete` _crInv cr
+--        invid `IM.delete` _crInv cr
+        invid `IM.delete` (_unNIntMap $ _crInv cr)
 
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
-dropItem cr invid =
+dropItem cr invid w' =
     doanyitemdropeffect
         . maybeshiftseldown
-        . rmInvItem (_crID cr) invid
+        . rmInvItem (_crID cr) (NInt 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") $ cr ^? crInv . ix invid
+    itm = fromMaybe (error "dropItem cannot find item") $ do
+        itid <- cr ^? crInv . ix (NInt invid)
+        w' ^? cWorld . lWorld . items . ix itid
     maybeshiftseldown w = fromMaybe w $ do
         3 <- w ^? hud . hudElement . diSelection . _Just . _1
         return $ w & hud . hudElement . diSelection . _Just . _2 +~ 1
@@ -190,8 +195,8 @@ dropItem cr invid =
 youDropItem :: World -> World
 youDropItem w = fromMaybe w $ do
     curpos <-
-        cr ^? crManipulation . manObject . imSelectedItem
+        cr ^? crManipulation . manObject . imSelectedItem . unNInt
-            <|> fmap fst (IM.lookupMax (cr ^. crInv))
+            <|> fmap fst (IM.lookupMax (cr ^. crInv . unNIntMap))
     --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 =
+        , _crInv = mempty
-            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,9 +20,10 @@ applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (L
     _ -> w & damageHP cr (_dmAmount dm)
 
 applyPiercingDamage :: Creature -> Damage -> World -> World
-applyPiercingDamage cr dm
+applyPiercingDamage cr dm w
-    | crIsArmouredFrom p cr = f . makeSpark NormalSpark p1 (argV (p1 - p))
+    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
-    | otherwise = f . damageHP cr (_dmAmount dm)
+        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
+    | otherwise = f . damageHP cr (_dmAmount dm) $ w
   where
     f = cWorld . lWorld . creatures . ix (_crID cr) . crPos +~ _dmVector dm
             / V2 x x

src/Dodge/Creature/HandPos.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Creature.HandPos (
     translatePointToLeftHand,
     translatePointToRightHand,
@@ -14,6 +15,8 @@ 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
@@ -21,14 +24,22 @@ import Dodge.Data.Creature
 import Geometry
 import ShapePicture
 
-translatePointToRightHand :: Creature -> Point3 -> Point3
+translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
+translatePointToRightHand m cr p =  fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
 
-rightHandPQ :: Creature -> Point3Q
+--equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
-rightHandPQ cr
+--equipSitePQ = \case
-    | oneH cr = (V3 11 (-3) 20, Q.qID)
+--    OnRightWrist -> rightHandPQ
-    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
+--    OnLeftWrist -> leftHandPQ
-    | twoFlat cr = (V3 4 (-8) 10, Q.qID)
+--    OnBack -> backPQ
+--    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)
@@ -37,20 +48,20 @@ rightHandPQ cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
-    g i = negate 2 + negate 6 * (i) / sLen
+    g i = negate 2 + negate 6 * i / sLen
 
-translateToRightHand :: Creature -> SPic -> SPic
+translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToRightHand = overPosSP . translatePointToRightHand
+translateToRightHand m = overPosSP . translatePointToRightHand m
 
-translateToRightWrist :: Creature -> SPic -> SPic
+translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToRightWrist cr =  overPosSP
+translateToRightWrist m cr =  overPosSP
-    (\p -> fst $ rightHandPQ cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
+    (\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
 
-leftHandPQ :: Creature -> Point3Q
+leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
-leftHandPQ cr
+leftHandPQ m cr
-    | oneH cr = (V3 0 off 10, Q.qz 0.4)
+    | oneH m cr = (V3 0 off 10, Q.qz 0.4)
-    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
+    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
-    | twoFlat cr = (V3 4 8 10, Q.qID)
+    | twoFlat m 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)
@@ -59,17 +70,17 @@ leftHandPQ cr
     off = 8
     sLen = _strideLength $ _crStance cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
-    g i = negate 2 + negate 6 * ( i) / sLen
+    g i = negate 2 + negate 6 * i / sLen
 
-translatePointToLeftHand :: Creature -> Point3 -> Point3
+translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
+translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
 
-translateToLeftHand :: Creature -> SPic -> SPic
+translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToLeftHand = overPosSP . translatePointToLeftHand
+translateToLeftHand m = overPosSP . translatePointToLeftHand m
 
-translateToLeftWrist :: Creature -> SPic -> SPic
+translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToLeftWrist cr = overPosSP 
+translateToLeftWrist m cr = overPosSP 
-    (\p -> fst $ leftHandPQ cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
+    (\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
 
 leftLegPQ :: Creature -> Point3Q
 leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -102,26 +113,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 :: Creature -> SPic -> SPic
+translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToHead cr = overPosSP (\p -> fst $ (headPQ cr `Q.comp` (p,Q.qID)))
+translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
 
-headPQ :: Creature -> Point3Q
+headPQ :: IM.IntMap Item -> Creature -> Point3Q
-headPQ cr
+headPQ m cr
-    | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
+    | twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
-    | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
+    | oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
     | otherwise = (V3 2.5 0 20, Q.qID)
 
-translatePointToHead :: Creature -> Point3 -> Point3
+translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToHead cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
+translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
 
-chestPQ :: Creature -> Point3Q
+chestPQ :: IM.IntMap Item -> Creature -> Point3Q
-chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
+chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
 
-translateToChest :: Creature -> SPic -> SPic
+translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
-translateToChest cr = overPosSP (\p -> fst $ chestPQ cr `Q.comp` (p,Q.qID))
+translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
 
-backPQ :: Creature -> Point3Q
+backPQ :: IM.IntMap Item -> Creature -> Point3Q
-backPQ cr
+backPQ m cr
-    | oneH cr = (V3 0 0 10, Q.qz 0.5)
+    | oneH m cr = (V3 0 0 10, Q.qz 0.5)
-    | twists cr = (V3 0 3 10, Q.qz (-1.5))
+    | twists m cr = (V3 0 3 10, Q.qz (-1.5))
     | otherwise = (V3 0 0 10, Q.qz 0)

src/Dodge/Creature/Impulse.hs

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

src/Dodge/Creature/Impulse/Movement.hs

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

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,6 +2,7 @@
 
 module Dodge.Creature.Impulse.UseItem (useItem) where
 
+import NewInt
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.ComposedItem
@@ -13,12 +14,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 (_crInv cr) ^? ix invid . _2
+    itmloc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr) ^? ix invid . _2
     useItemLoc cr itmloc pt w
 
 useItemLoc :: Creature -> LocationDT OItem -> Int -> World -> Maybe World
@@ -62,40 +63,44 @@ activateDetonator det = fromMaybe id $ do
     pjid <- det ^? dtValue . _1 . itUse . uaParams . apProjectiles . ix 0
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
 
-toggleEquipmentAt :: Int -> Creature -> World -> World
+toggleEquipmentAt :: NewInt InvInt -> Creature -> World -> World
 toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
     DoNotMoveEquipment -> w
     PutOnEquipment{_allocNewPos = newp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
             & onequip itm cr
     MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp .~ Nothing
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
     SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp ?~ sid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
-            & crpoint . crInv . ix sid . itLocation . ilEquipSite ?~ oldp
+            & toitems . ix (invidtoitid sid) . itLocation . ilEquipSite ?~ oldp
     ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
+            & toitems . ix itid . itLocation . ilEquipSite ?~ newp
-            & crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
+            & toitems . ix (invidtoitid rid) . itLocation . ilEquipSite .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
     RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
-            & crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
+            & toitems . ix itid . 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 = _crInv cr IM.! i
+    itmat i = w ^?! cWorld . lWorld . items . ix (invidtoitid 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,6 +10,7 @@ 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
@@ -25,20 +26,20 @@ import Shape
 --import Shape
 import ShapePicture
 
-basicCrPict :: Creature -> SPic
+basicCrPict :: IM.IntMap Item -> Creature -> SPic
-basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
+basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
 
 crCamouflage :: Creature -> CamouflageStatus
 crCamouflage _ = FullyVisible
 
-basicCrShape :: Creature -> Shape
+basicCrShape :: IM.IntMap Item -> Creature -> Shape
-basicCrShape cr
+basicCrShape m cr
     | crCamouflage cr == Invisible = mempty
     | otherwise =
         scaleSH (V3 crsize crsize crsize) $
             mconcat
-                [ colorSH (_skinHead cskin) $ scalp cr
+                [ colorSH (_skinHead cskin) $ scalp m cr
-                , colorSH (_skinUpper cskin) $ upperBody cr
+                , colorSH (_skinUpper cskin) $ upperBody m cr
                 , rotmdir $ colorSH (_skinLower cskin) $ feet cr
                 ]
   where
@@ -67,17 +68,17 @@ deadFeet :: Creature -> Shape
 {-# INLINE deadFeet #-}
 deadFeet = feet
 
-arms :: Creature -> Shape
+arms :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE arms #-}
-arms cr =
+arms m cr =
     (^. _1) $
-        translateToRightHand cr aHand
+        translateToRightHand m cr aHand
-            <> translateToLeftHand cr aHand
+            <> translateToLeftHand m cr aHand
   where
     aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
 
-deadScalp :: Creature -> Shape
+deadScalp :: IM.IntMap Item -> Creature -> Shape
-deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
+deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
 
 deadRot :: Creature -> Shape -> Shape
 deadRot cr = overPosSH (Q.rotateToZ d)
@@ -88,18 +89,18 @@ deadRot cr = overPosSH (Q.rotateToZ d)
             (addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
             (damageDirection $ _crDamage cr)
 
-scalp :: Creature -> Shape
+scalp :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE scalp #-}
-scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
+scalp m cr = overPosSH (\p -> fst (headPQ m 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 :: Creature -> Shape
+torso :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE torso #-}
-torso cr = overPosSH (\p -> fst $ (backPQ cr `Q.comp` (p,Q.qID))) tsh
+torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
 --    | oneH cr = rotateSH 0.5 tsh
 --    | twists cr =
 --        translateSHxy 0 3 . rotateSH (-1.3) $ tsh
@@ -116,20 +117,20 @@ torso cr = overPosSH (\p -> fst $ (backPQ cr `Q.comp` (p,Q.qID))) tsh
             ]
     aShoulder = scaleSH (V3 10 10 1) baseShoulder
 
-deadUpperBody :: Creature -> Shape
+deadUpperBody :: IM.IntMap Item -> Creature -> Shape
-deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
+deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
 
 baseShoulder :: Shape
 {-# INLINE baseShoulder #-}
 baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
 
-upperBody :: Creature -> Shape
+upperBody :: IM.IntMap Item -> Creature -> Shape
 {-# INLINE upperBody #-}
-upperBody cr = arms cr <> shoulderSH (torso cr)
+upperBody m cr = arms m cr <> shoulderSH (torso m cr)
 
 shoulderSH :: Shape -> Shape
 shoulderSH = translateSHz 20
 
-drawEquipment :: Creature -> SPic
+drawEquipment :: IM.IntMap Item -> Creature -> SPic
 {-# INLINE drawEquipment #-}
-drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
+drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)

src/Dodge/Creature/PistolCrit.hs

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

src/Dodge/Creature/SpreadGunCrit.hs

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

src/Dodge/Creature/State.hs

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

src/Dodge/Creature/Statistics.hs

@@ -6,8 +6,9 @@ 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
 
@@ -42,11 +43,11 @@ crIntelligence  cr = case cr ^. crType of
     LampCrit {} -> 0
     
 
-getCrMoveSpeed :: Creature -> Int
+getCrMoveSpeed :: LWorld -> Creature -> Int
-getCrMoveSpeed cr = strFromHeldItem cr + strFromEquipment cr + crStrength cr
+getCrMoveSpeed lw cr = strFromHeldItem lw cr + strFromEquipment lw cr + crStrength cr
 
-strFromEquipment :: Creature -> Int
+strFromEquipment :: LWorld -> Creature -> Int
-strFromEquipment = sum . fmap equipmentStrValue . crCurrentEquipment
+strFromEquipment lw = sum . fmap equipmentStrValue . crCurrentEquipment lw
 
 equipmentStrValue :: Item -> Int
 equipmentStrValue itm = case _itType itm of
@@ -54,14 +55,17 @@ equipmentStrValue itm = case _itType itm of
     EQUIP POWERLEGS -> 3
     _ -> 0
 
-crCurrentEquipment :: Creature -> IM.IntMap Item
+crCurrentEquipment :: LWorld -> Creature -> NewIntMap InvInt Item
-crCurrentEquipment = IM.filter (isJust . (^? itLocation . ilEquipSite . _Just)) . _crInv
+crCurrentEquipment lw = over unNIntMap (IM.filter (isJust . (^? itLocation . ilEquipSite . _Just))) . fmap f . _crInv
+  where
+    f i = lw ^?! items . ix i
 
-strFromHeldItem :: Creature -> Int
+strFromHeldItem :: LWorld -> Creature -> Int
-strFromHeldItem cr = fromMaybe 0 $ do
+strFromHeldItem lw cr = fromMaybe 0 $ do
     Aiming <- cr ^? crStance . posture
     i <- cr ^? crManipulation . manObject . imRootSelectedItem
-    fmap (negate . itemWeight) $ cr ^? crInv . ix i
+    j <- 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,6 +24,8 @@ 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
@@ -90,35 +92,33 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
 --crCanShoot :: Creature -> Bool
 --crCanShoot cr = crIsAiming cr && crWeaponReady cr
 
-crInAimStance :: AimStance -> Creature -> Bool
+crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
-crInAimStance as cr = crIsAiming cr && mitstance == Just as
+crInAimStance as m cr = crIsAiming cr && mitstance == Just as
   where
     mitstance = do
         i <- cr ^? crManipulation . manObject . imRootSelectedItem
         --itm <- invRootTrees' (cr ^. crInv) ^? ix i
-        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i
+        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
         return $ aimStance itm
         --cr ^? crInv . ix i . itUse . heldAim . aimStance
 
-oneH :: Creature -> Bool
+oneH :: IM.IntMap Item -> Creature -> Bool
 oneH = crInAimStance OneHand
 
-twoFlat :: Creature -> Bool
+twoFlat :: IM.IntMap Item -> Creature -> Bool
 twoFlat = crInAimStance TwoHandFlat
 
-twists :: Creature -> Bool
+twists :: IM.IntMap Item -> Creature -> Bool
-twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
+twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
 
 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
 -- Not sure if it is a good idea
-crIsArmouredFrom :: Point2 -> Creature -> Bool
+crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
-crIsArmouredFrom = hasFrontArmour
+crIsArmouredFrom m p cr = fromMaybe False $ do
-
-hasFrontArmour :: Point2 -> Creature -> Bool
-hasFrontArmour p cr = fromMaybe False $ do
     invid <- cr ^? crEquipment . ix OnChest
-    ittype <- cr ^? crInv . ix invid . itType
+    itid <- cr ^? crInv . ix invid
+    ittype <- m ^? ix itid . itType
     return $
         EQUIP FRONTARMOUR == ittype
             && p /= _crOldPos cr
@@ -127,9 +127,9 @@ hasFrontArmour p cr = fromMaybe False $ do
     -- even though angleVV can generate NaN, the comparison seems to deal with it
 
     frontarmdirection
-        | crInAimStance OneHand cr = 0.5
+        | crInAimStance OneHand m cr = 0.5
-        | crInAimStance TwoHandUnder cr = negate 1
+        | crInAimStance TwoHandUnder m cr = negate 1
-        | crInAimStance TwoHandOver cr = negate 1
+        | crInAimStance TwoHandOver m cr = negate 1
         | otherwise = 0
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool

src/Dodge/Creature/Update.hs

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

src/Dodge/Creature/YourControl.hs

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

src/Dodge/Data/Button.hs

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

src/Dodge/Data/CardinalPoint.hs

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

src/Dodge/Data/Creature.hs

@@ -17,6 +17,7 @@ module Dodge.Data.Creature (
     module Dodge.Data.Item.Use.Consumption.LoadAction,
 ) where
 
+import NewInt
 import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.Equipment.Misc
 import Control.Lens
@@ -32,7 +33,7 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 
 data Creature = Creature
     { _crPos :: Point2
@@ -45,9 +46,9 @@ data Creature = Creature
     , _crType :: CreatureType
     , _crID :: Int
     , _crHP :: Int
-    , _crInv :: IM.IntMap Item
+    , _crInv :: NewIntMap InvInt Int
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite Int
+    , _crEquipment :: M.Map EquipSite (NewInt InvInt)
     , _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,15 +5,14 @@
 
 module Dodge.Data.FloorItem where
 
-import NewInt
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Item
+--import Dodge.Data.Item
 import Geometry.Data
 
 
-data FloorItem = FlIt {_flIt :: Item, _flItPos :: Point2, _flItRot :: Float, _flItID :: NewInt FloorInt}
+data FloorItem = FlIt {_flItPos :: Point2, _flItRot :: Float}--, _flItID :: NewInt FloorInt}
     --deriving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''FloorItem

src/Dodge/Data/GenWorld.hs

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

src/Dodge/Data/HUD.hs

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

src/Dodge/Data/Input.hs

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

src/Dodge/Data/Item.hs

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

src/Dodge/Data/Item/Location.hs

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

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

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

src/Dodge/Data/LWorld.hs

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

src/Dodge/Data/Machine.hs

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

src/Dodge/Data/Machine/Sensor.hs

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

src/Dodge/Data/RightButtonOptions.hs

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

src/Dodge/Data/RoomCluster.hs

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

src/Dodge/Data/SelectionList.hs

@@ -41,22 +41,14 @@ data SelectionWidth
     | UseItemWidth
 
 data SelectionItem a
-    = SelectionItem
+    = SelItem
-        { _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
-    | LeverSound Int
+    | ButtonSound Int
     | Explosion Int
     | Tap Int
     | EBSound Int

src/Dodge/Data/Terminal.hs

@@ -8,8 +8,6 @@ module Dodge.Data.Terminal (
     module Dodge.Data.Terminal.Status,
 ) where
 
-import Dodge.Data.Machine.Sensor.Type
-import Sound.Data
 import Color
 import Control.Lens
 import Data.Aeson
@@ -18,10 +16,7 @@ import qualified Data.Map.Strict as M
 import Dodge.Data.BlBl
 import Dodge.Data.Terminal.Status
 import Dodge.Data.WorldEffect
-
+import Sound.Data
---data TerminalInput = TerminalInput
---    { _tiSel :: (Int, Int)
---    }
 
 data Terminal = Terminal
     { _tmID :: Int
@@ -36,75 +31,41 @@ data Terminal = Terminal
     , _tmStatus :: TerminalStatus
     , _tmCommandHistory :: [String]
     , _tmToggles :: M.Map String TerminalToggle
---    , _tmPartialCommand :: Maybe TerminalCommand
     }
 
 data TerminalLineString = TerminalLineConst String Color
 
 data TerminalLine = TLine
-        { _tlPause :: Int
+    { _tlPause :: Int
-        , _tlString :: [TerminalLineString] -- World -> (String, Color)
+    , _tlString :: [TerminalLineString] -- World -> (String, Color)
-        , _tlEffect :: TmWdWd --Terminal -> World -> World
+    , _tlEffect :: TmWdWd --Terminal -> World -> World
-        }
+    }
 
 data TerminalToggle = TerminalToggle
     { _ttTriggerID :: Int
     , _ttDeathEffect :: BlBl
     }
 
-data EffectArguments
+data TCom
-    = NoArguments {_cmdEffect :: [TerminalLine]}
+    = TCInfo String String -- this may not be necessary, to revisit
-    | 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
-    | TmWdWdDisconnectTerminal
+    | TmWdWdPowerDownTerminal
+    | TmWdWdDeactivateTerminal
     | TmWdWdfromWdWd WdWd
     | TmWdWdTermSound SoundID
     | TmWdWdDoDeathTriggers
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
-    | TmGetDamageCoding SensorType
+--    | TmGetSensor String
-    | TmGetSensor String
---    | TmDisplayCommands
 
 makeLenses ''Terminal
 makeLenses ''TerminalLine
 makeLenses ''TerminalToggle
-makeLenses ''EffectArguments
---makeLenses ''TerminalCommand
 makeLenses ''TCom
 concat
     <$> mapM
@@ -112,9 +73,6 @@ concat
         [ ''TerminalLineString
         , ''TerminalLine
         , ''TerminalToggle
-        , ''EffectArguments
-        , ''TerminalCommandEffect
---        , ''TerminalCommand
         , ''TCom
         , ''TmWdWd
         , ''Terminal

src/Dodge/Data/Terminal/Status.hs

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

src/Dodge/Data/WorldEffect.hs

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

src/Dodge/Debug/Terminal.hs

@@ -3,7 +3,7 @@
 module Dodge.Debug.Terminal where
 
 import Data.Foldable
-import Dodge.Item.Location.Initialize
+--import Dodge.Item.Location.Initialize
 import Control.Applicative
 import Control.Lens
 --import Control.Monad
@@ -14,7 +14,7 @@ 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)
@@ -28,22 +28,22 @@ applyTerminalString ss = case ss of
 applyTerminalCommand :: String -> Universe -> Universe
 applyTerminalCommand s = case s of
     "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
-    ['L', x] ->
+    ['L', x] -> uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX 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 (snd . createItemYou (itemFromBase ibt)))
+        return $ uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
 
 applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
 applyTerminalCommandArguments command args u = case command of
     "IT" -> fromMaybe u $ do
         (ibt, n) <- parseItem args
-        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n (snd . createItemYou (itemFromBase ibt)))
+        return $ u & uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
     "DEX" -> fromMaybe u $ do
         x <- readMaybe =<< args ^? _head
         return $ u & ypoint . crType . avDexterity .~ x

src/Dodge/Default.hs

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

src/Dodge/Default/Creature.hs

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

src/Dodge/Default/Room.hs

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

src/Dodge/Default/Terminal.hs

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

src/Dodge/Default/Wall.hs

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

src/Dodge/Default/World.hs

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

src/Dodge/DisplayInventory.hs

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

src/Dodge/DoubleTree.hs

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

src/Dodge/Equipment.hs

@@ -50,12 +50,13 @@ 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 . itLocation . ilEquipSite . _Just of
+    handtrans = case cr ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
-        Just OnLeftWrist -> \cr' -> translatePointToLeftHand cr' . g
+        Just OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
-        _ -> translatePointToRightHand
+        _ -> translatePointToRightHand m
     g
-        | twists cr = (+.+.+ V3 (-5) 10 0)
+        | twists m 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,15 +33,16 @@ useMagShield mt _ cr w =
             }
 
 setWristShieldPos :: Item -> Creature -> EquipSite -> World -> World
-setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
+setWristShieldPos itm cr x w = moveWallIDUnsafe i wlline w
   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 cr' . g
+        OnLeftWrist -> \cr' -> translatePointToLeftHand m cr' . g
-        _ -> translatePointToRightHand
+        _ -> translatePointToRightHand m
     g
-        | twists cr = (+.+.+ V3 (-5) 10 0)
+        | twists m cr = (+.+.+ V3 (-5) 10 0)
         | otherwise = id
     f = (+.+ _crPos cr) . stripZ . rotate3 (_crDir cr) . handtrans cr
 
@@ -53,9 +54,10 @@ setWristShieldPos itm cr x = moveWallIDUnsafe i wlline
 --    _ -> w
 
 createHeadLamp :: Item -> Creature -> World -> World
-createHeadLamp _ cr =
+createHeadLamp _ cr w = w &
     cWorld . lWorld . lights
         .:~ LSParam
-            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) (translatePointToHead cr (V3 5 0 3)))
+            ((_crPos cr `v2z` 0) +.+.+ rotate3 (_crDir cr) 
+    (translatePointToHead (w ^. cWorld . lWorld . items) cr (V3 5 0 3)))
             200
             0.7

src/Dodge/Floor.hs

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

src/Dodge/FloorItem.hs

@@ -1,52 +1,28 @@
-module Dodge.FloorItem (
+module Dodge.FloorItem (copyItemToFloor) where
-    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 qualified IntMapHelp as IM
+import LensHelp
+import NewInt
 import System.Random
 
--- | Copy an item to the floor.
+-- | Copy an item to the floor
 copyItemToFloor :: Point2 -> Item -> World -> World
-copyItemToFloor pos it = snd . copyItemToFloorID pos it
+copyItemToFloor p it w =
-
+    w'
--- | Copy an item to the floor, returns the floor item's id.
+        & cWorld . lWorld . floorItems . at (it ^. itID . unNInt) ?~ FlIt q r
-copyItemToFloorID :: Point2 -> Item -> World -> (NewInt FloorInt, World)
+        & cWorld . lWorld . items . at (it ^. itID . unNInt) ?~ (it & itLocation .~ OnFloor)
-copyItemToFloorID pos it w =
+        & hud . closeItems .:~ _itID it -- puts item at top of close items
-    (,) (NInt flid) $
-        w'
-            & cWorld . lWorld . floorItems . unNIntMap %~ IM.insert flid theflit
-            & cWorld . lWorld . itemLocations %~ IM.insert (_unNInt $ _itID it) (OnFloor $ NInt flid)
-            & hud . closeItems %~ (NInt flid:) 
---            & hud . hudElement . diSections . ix 3 . ssOffset .~ 0
-                -- ensures dropped item is at the top of the close item selection list
   where
-    (p', w') = findWallFreeDropPoint (_dimRad $ itDim it) pos w
+    (q, w') = findWallFreeDropPoint (_dimRad $ itDim it) p w
-    rot = fst . randomR (- pi, pi) $ _randGen w
+    r = 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 =
+cardinalVectors = [ V2 1 0 , V2 0 1 , V2 (-1) 0 , V2 0 (-1) ]
-    [ 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 . creatures . ix cid . crInv . ix invid
+    itmset = cWorld . lWorld . items . ix (it ^. itID . unNInt)
     setwarming = itmset . itParams . isWarming %~ const True
     timelastused = it ^. itTimeLastUsed
     g x = (x, WdWdBurstFireRepetition (_crID cr) invid)
@@ -129,7 +129,7 @@ getVolleyBurst i g =
 
 heldEffectMuzzles :: LocationDT OItem -> Creature -> World -> World
 heldEffectMuzzles loc cr w =
-    setusetime 
+    setusetime
         . doHeldUseEffect t cr
         . uncurry (applyCME loc cr)
         $ bw
@@ -137,9 +137,9 @@ heldEffectMuzzles loc cr w =
     t = loc ^. locDT
     bw = foldl' (loadMuzzle loc cr) (False, w) (locMuzzles loc)
     setusetime =
-        cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix itid . itTimeLastUsed
+        cWorld . lWorld . items . ix itid . itTimeLastUsed
             .~ w ^. cWorld . lWorld . lClock
-    itid = t ^?! dtValue . _1 . itLocation . ilInvID
+    itid = t ^?! dtValue . _1 . itID . unNInt
 
 locMuzzles :: LocationDT OItem -> [Muzzle]
 locMuzzles loc
@@ -196,7 +196,7 @@ heldItemMuzzles = \case
             & ix 0 . mzFlareType .~ NoLightFlare
             & ix (i `div` 2) . mzFlareType .~ BasicFlare
             & ix (i -1) . mzFlareType .~ NoLightFlare
-    PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet  0]
+    PISTOL -> [Muzzle (V2 10 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
     MACHINEPISTOL -> [Muzzle (V2 10 0) 0 0.3 maguse1 MiniGunFlare MuzzleShootBullet 0]
     AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
     SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
@@ -341,26 +341,20 @@ vgunMuzzles i =
         )
 
 doHeldUseEffect :: DTree OItem -> Creature -> World -> World
-doHeldUseEffect t cr w = case t ^. dtValue . _1 . itType of
+doHeldUseEffect t _ w = case t ^. dtValue . _1 . itType of
     HELD (VOLLEYGUN j) -> case itm ^? itParams . unfiredBarrels of
         Just [_] -> fromMaybe w $ do
             let (is, g) = runState (shuffle [0 .. j -1]) $ w ^. randGen
-            i <- itm ^? itLocation . ilInvID
             return $
                 w
                     & randGen .~ g
-                    & crinvset . ix i . itParams . unfiredBarrels %~ const is
+                    & crinvset . itParams . unfiredBarrels %~ const is
-        Just (_ : _ : _) -> fromMaybe w $ do
+        Just (_ : _ : _) -> w & crinvset . itParams . unfiredBarrels %~ tail
-            i <- itm ^? itLocation . ilInvID
-            return $ w & crinvset . ix i . itParams . unfiredBarrels %~ tail
         _ -> w
-    HELD ALTERIFLE -> fromMaybe w $ do
+    HELD ALTERIFLE -> w & crinvset . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
-        i <- t ^? dtValue . _1 . itLocation . ilInvID
-        return $
-            w & crinvset . ix i . itParams . alteRifleSwitch %~ ((`mod` 2) . (+ 1))
     _ -> w
   where
-    crinvset = cWorld . lWorld . creatures . ix (_crID cr) . crInv
+    crinvset = cWorld . lWorld . items . ix (itm ^. itID . unNInt)
     itm = t ^. dtValue . _1
 
 -- should probably unify failure with time use check in some way...
@@ -637,8 +631,8 @@ loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
                     find
                         ((== PulseBallSF) . (^. dtValue . _2))
                         (loc ^. locDT . dtLeft)
-            mid <- mag ^? dtValue . _1 . itLocation . ilInvID
+            mid <- mag ^? dtValue . _1 . itID . unNInt
-            availableammo <- w ^? cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix mid . itConsumables . _Just
+            availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
             let usedammo = case as ^?! aps of
                     UseUpTo x -> min x availableammo
                     UseExactly x
@@ -719,12 +713,12 @@ isAmmoIntLink i sf = Just i == sf ^? amsfLink
 useLoadedAmmo ::
     LocationDT OItem ->
     Creature ->
-    Muzzle -> 
+    Muzzle ->
     Maybe (Int, DTree OItem) ->
     World ->
     World
-useLoadedAmmo loc cr mz m w = 
+useLoadedAmmo loc cr mz m w =
-    removeAmmoFromMag m cr . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
+    removeAmmoFromMag m . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
         MuzzleLaser -> creatureShootLaser loc cr mz w
         MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
@@ -741,7 +735,7 @@ useLoadedAmmo loc cr mz m w =
                 mz
                 cr
                 w
-        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm cr w
+        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm w
         MuzzleShatter -> shootShatter itm cr w
         MuzzleDetector ->
             itemDetectorEffect
@@ -782,17 +776,15 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
     f CREATUREDETECTOR = OTCreature
     f WALLDETECTOR = OTWall
 
-walkNozzle :: Muzzle -> Item -> Creature -> World -> World
+walkNozzle :: Muzzle -> Item -> World -> World
-walkNozzle mz itm cr w = fromMaybe w $ do
+walkNozzle mz itm w =
-    invid <- itm ^? itLocation . ilInvID
+    w
-    return $
+        & cWorld . lWorld . items
-        w
+            . ix (itm ^. itID . unNInt)
-            & cWorld . lWorld . creatures . ix (_crID cr) . crInv
+            . itParams
-                . ix invid
+            . nzAngle
-                . itParams
+            %~ f
-                . nzAngle
+        & randGen .~ g
-                %~ f
-            & randGen .~ g
   where
     nz = _mzEffect mz
     (walkamount, g) = randomR (- aspeed, aspeed) (_randGen w)
@@ -927,14 +919,12 @@ shootPulseBall p dir w =
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
 --removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
-removeAmmoFromMag :: Maybe (Int, DTree OItem) -> Creature -> World -> World
+removeAmmoFromMag :: Maybe (Int, DTree OItem) -> World -> World
-removeAmmoFromMag m cr = fromMaybe id $ do
+removeAmmoFromMag m = fromMaybe id $ do
     (x, magtree) <- m
-    magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
+    magid <- magtree ^? dtValue . _1 . itID . unNInt
     return $
-        cWorld . lWorld . creatures
+        cWorld . lWorld . items
-            . ix (_crID cr)
-            . crInv
             . ix magid
             . itConsumables
             . _Just
@@ -1128,7 +1118,8 @@ mcUseHeld hit = case hit of
     LASER -> mcShootLaser
     _ -> mcShootAuto
 
-useGasParams :: Maybe Int -> Muzzle -> LocationDT OItem -> Creature -> World -> World
+useGasParams :: Maybe (NewInt InvInt) 
+    -> Muzzle -> LocationDT OItem -> Creature -> World -> World
 useGasParams mmagid mz loc cr w =
     w
         & createGas gastype pressure pos dir cr
@@ -1139,7 +1130,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 >>= magAmmoParams >>= (^? ampCreateGas)
+        fueltype <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= magAmmoParams >>= (^? ampCreateGas)
         gasType hit fueltype
     (V3 x y _, q) =
         locOrient loc cr
@@ -1208,11 +1199,11 @@ mcShootLaser _ mc =
 
 mcShootAuto :: Item -> Machine -> World -> World
 mcShootAuto itm mc w
-    | Just (AutoTrigger rate) <- baseItemTriggerType <$> mc ^? mcType . mctTurret . tuWeapon
+    | Just i <- mc ^? mcType . mctTurret . tuWeapon
+      , Just (AutoTrigger rate) <- baseItemTriggerType <$> w ^? cWorld . lWorld . items . ix i
       , w ^. cWorld . lWorld . lClock - rate > lastused =
         w
-            & cWorld . lWorld . machines . ix (_mcID mc) . mcType . mctTurret . tuWeapon
+            & cWorld . lWorld . items . ix i . itTimeLastUsed
-                . itTimeLastUsed
                 .~ w ^. cWorld . lWorld . lClock
             & makeBullet defaultBullet itm pos dir
     | otherwise = w
@@ -1224,11 +1215,11 @@ mcShootAuto itm mc w
 -- | assumes that the item is held
 shootTeslaArc :: LocationDT OItem -> Creature -> Muzzle -> World -> World
 shootTeslaArc loc cr mz w =
-    w' & cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itParams .~ ip
+    w' & cWorld . lWorld . items . ix itid . itParams .~ ip
         & soundContinue (CrWeaponSound (_crID cr) 0) pos elecCrackleS (Just 2)
   where
     itm = loc ^. locDT . dtValue . _1
-    invid = itm ^?! itLocation . ilInvID
+    itid = itm ^. itID . unNInt
     (w', ip) = makeTeslaArc (itm ^. itParams) pos dir w
     (V3 x y _, q) =
         locOrient loc cr
@@ -1328,22 +1319,25 @@ createProjectile ::
     Creature ->
     World ->
     World
-createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do
+createProjectile x pjtype magtree stab muz cr w =
-    magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
+    w
-    ammoitem <- cr ^? crInv . ix magid
+        & ( fromMaybe failsound $ do
-    let rdetonate =
+                magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
-            (^. dtValue . _1 . itID)
+                ammoitem <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k
-                <$> find isrdet (magtree ^. dtLeft)
+                let rdetonate =
-        rscreen =
+                        (^. dtValue . _1 . itID)
-            (^. dtValue . _1 . itID)
+                            <$> find isrdet (magtree ^. dtLeft)
-                <$> find isrscreen (magtree ^. dtLeft)
+                    rscreen =
-    aparams <-
+                        (^. dtValue . _1 . itID)
-        ((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
+                            <$> find isrscreen (magtree ^. dtLeft)
-            --            <|> ammoitem ^? itConsumables . magParams . ampPayload
+                aparams <-
-            <|> magAmmoParams ammoitem ^? _Just . ampPayload
+                    ((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-    return $
+                        --            <|> ammoitem ^? itConsumables . magParams . ampPayload
-        createShell x rdetonate rscreen stab pjtype aparams muz cr
+                        <|> magAmmoParams ammoitem ^? _Just . ampPayload
-            . startthesound
+                return $
+                    createShell x rdetonate rscreen stab pjtype aparams muz cr
+                        . startthesound
+          )
   where
     isrdet :: DTree OItem -> Bool
     isrdet y = case y ^. dtValue . _2 of
@@ -1420,7 +1414,7 @@ dropInventoryPath ::
     World ->
     World
 dropInventoryPath i ip loc cr = fromMaybe id $ do
-    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
+    invid <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
     j <- getInventoryPath i ip invid cr
     return $ dropItem cr j
 
@@ -1453,15 +1447,15 @@ useInventoryPath ::
     World
 useInventoryPath pt i ip loc cr w = case ip of
     ABSOLUTE -> fromMaybe w $ do
-        guard $ i `IM.member` (cr ^. crInv)
+        guard $ i `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem i pt)
     RELCURS -> fromMaybe w $ do
-        j <- cr ^? crManipulation . manObject . imSelectedItem
+        j <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
-        guard $ (i + j) `IM.member` (cr ^. crInv)
+        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
     RELITEM -> fromMaybe w $ do
-        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID
+        j <- loc ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
-        guard $ (i + j) `IM.member` (cr ^. crInv)
+        guard $ (i + j) `IM.member` (cr ^. crInv . unNIntMap)
         return $ w & cWorld . lWorld . delayedEvents .:~ (1, UseInvItem (i + j) pt)
 
 --useRewindGun _ _ w = case w ^. cwTime . rewindWorlds of

src/Dodge/Inventory.hs

@@ -7,7 +7,6 @@ module Dodge.Inventory (
     invSetSelection,
     invSetSelectionPos,
     scrollAugInvSel,
-    crNumFreeSlots,
     setInvPosFromSS,
     module Dodge.Inventory.RBList,
     swapInvItems,
@@ -17,17 +16,13 @@ module Dodge.Inventory (
     destroyAllInvItems,
 ) where
 
-import Dodge.Equipment
---import Dodge.Wall.Delete
---import Dodge.Item.Location
 import Data.Function
 import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
 import Dodge.Data.World
---import Dodge.Euse
+import Dodge.Equipment
-import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.Inventory.Swap
@@ -42,37 +37,43 @@ import NewInt
 
 -- should consider never fully destroying items, but assigning a flag saying how
 -- they were moved from play
-destroyInvItem :: Int -> Int -> World -> World
+destroyInvItem :: Int -> NewInt InvInt -> World -> World
 destroyInvItem cid invid w =
     rmInvItem cid invid w & removeitloc
         & removeithotkey
   where
     removeitloc = fromMaybe id $ do
-        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
+        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
-        return $ cWorld . lWorld . itemLocations . at itid .~ Nothing
+        return $ cWorld . lWorld . items . at itid .~ Nothing
     removeithotkey = fromMaybe id $ do
-        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid . itID . unNInt
+        itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
         hk <- w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid
         return $
             (cWorld . lWorld . imHotkeys . unNIntMap . at itid .~ Nothing)
                 . (cWorld . lWorld . hotkeys . at hk .~ Nothing)
 
 destroyAllInvItems :: Creature -> World -> World
-destroyAllInvItems cr w = foldl' (flip $ destroyInvItem (cr ^. crID)) w 
+destroyAllInvItems cr w =
-    . reverse . IM.keys $ cr ^. crInv 
+    foldl' (flip $ destroyInvItem (cr ^. crID)) w
+        . reverse
+        . fmap NInt
+        . IM.keys
+        . _unNIntMap
+        $ cr ^. crInv
 
 destroyItem :: Int -> World -> World
-destroyItem itid w = case w ^? cWorld . lWorld . itemLocations . ix itid of
+destroyItem itid w = case w ^? cWorld . lWorld . items . ix itid . itLocation of
-    Nothing -> error $ "Tried to destroy item that does not exist; item id: "++ show itid
+    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 (NInt i)) -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
+    Just OnFloor ->
-        & cWorld . lWorld . floorItems . unNIntMap . at i .~ Nothing
+        w & cWorld . lWorld . items . at itid .~ Nothing
-    Just InVoid -> w & cWorld . lWorld . itemLocations . at itid .~ Nothing
+            & cWorld . lWorld . floorItems . at itid .~ Nothing
-    
+    Just InVoid -> w & cWorld . lWorld . items . at itid .~ Nothing
+
 -- note rmInvItem does not fully destroy the item, other updates to the item
 -- location are required
-rmInvItem :: Int -> Int -> World -> World
+rmInvItem :: Int -> NewInt InvInt -> World -> World
 rmInvItem cid invid w =
     w
         & dounequipfunction --the ordering of these is
@@ -81,7 +82,7 @@ rmInvItem cid invid w =
         & pointcid . crEquipment . each %~ g
         & updateselection
         & updateselectionextra
-        & pointcid %~ updateRootItemID
+        & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
         & worldEventFlags . at InventoryChange ?~ ()
   where
     pointcid = cWorld . lWorld . creatures . ix cid
@@ -94,7 +95,8 @@ rmInvItem cid invid w =
         | otherwise =
             pointcid . crManipulation . manObject . imSelectedItem %~ g
     cr = w ^?! cWorld . lWorld . creatures . ix cid
-    itm = _crInv cr IM.! invid
+    itid = _crInv cr ^?! ix invid
+    itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
     --  fromMaybe id $ do
     --    rmf <- itm ^? itUse . uequipEffect . eeOnRemove
@@ -103,40 +105,38 @@ 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 $ cr ^. crInv
+    maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
     f inv =
-        let (xs, ys) = IM.split invid inv
+        let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
-         in xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
+         in NIntMap $ xs `IM.union` IM.mapKeysMonotonic (subtract 1) ys
     -- the following might not work if a non-player creature drops their last item
     g x
-        | x > invid || Just x == maxk = max 0 $ x - 1
+        | x > invid || Just x == fmap NInt maxk = max 0 $ x - 1
         | otherwise = x
 
-
--- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w
+    w & hud . closeItems %~ f
-        & hud . closeItems %~ f
         & hud . closeButtons %~ g
   where
     g oldbts = intersect oldbts cbts `union` cbts
     f olditems = intersect olditems citems `union` citems
-    cbts = _btID <$> filter (isclose . _btPos) activeButtons
+    lw = w ^. cWorld . lWorld
-    citems =
+    citems = let is = IM.filter (isclose . _flItPos) (lw^.floorItems)
-        fmap _flItID
+        in map NInt $ IM.keys $ IM.intersection (lw ^. items) is
-            . filter (isclose . _flItPos)
+    isclose x = dist y x < 40 && hasButtonLOS y x w
-            . IM.elems
+    y = _crPos $ you w
-            $ w ^. cWorld . lWorld . floorItems . unNIntMap
+    cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
-    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,18 +174,23 @@ swapItemWith ::
     (Int, Int) ->
     World ->
     World
-swapItemWith f (j, i) w = case j of
+swapItemWith f (j, i) = case j of
-    0 -> w & swapInvItems f i
+    0 -> swapInvItems f i
-    3 -> w & changeSwapOther ispCloseItem 3 f i
+    3 -> changeSwapOther ispCloseItem 3 f i
-    5 -> w & changeSwapOther ispCloseButton 5 f i
+    5 -> changeSwapOther ispCloseButton 5 f i
-    _ -> w
+    _ -> id
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
-changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
+changeSwapWith f w 
-    Just (0, i, _) -> w & swapInvItems f i
+    | Just (j,i,_) <- w ^. hud . hudElement . diSelection = swapItemWith f (j,i) w
-    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
+    | otherwise = w
-    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
+
-    _ -> w
+--changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
+--changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
+--    Just (0, i, _) -> w & swapInvItems f i
+--    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
+--    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
+--    _ -> w
 
 invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
 invSetSelection sel w =
@@ -203,8 +208,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,116 +1,76 @@
+{-# LANGUAGE TupleSections #-}
+
 module Dodge.Inventory.Add (
-    tryPutItemInInv,
-    --createPutItem,
-    --createAndSelectItem,
     createItemYou,
     pickUpItem,
     pickUpItemAt,
 ) where
 
-import Dodge.Inventory.Swap
+import qualified Data.IntSet as IS
-import Control.Monad
-import NewInt
-import Dodge.SoundLogic
-import Dodge.Inventory.Location
---import Dodge.Item.Grammar
 import Control.Lens
+import Control.Monad
 import Data.Maybe
---import Dodge.Base.You
---import Dodge.Combine.Module
---import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.FloorItem
 import Dodge.Inventory.CheckSlots
+import Dodge.Inventory.Location
+import Dodge.Inventory.Swap
+import Dodge.SoundLogic
 import qualified IntMapHelp as IM
+import NewInt
 
-tryPutFloorItemIDInInv :: Int -> NewInt FloorInt -> World -> Maybe (Int, World)
+-- should check that the item is not already in your inventory
-tryPutFloorItemIDInInv cid flitid w = do
+-- this assumes that this item is currently on the floor
-    flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flitid)
+tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt, World)
-    tryPutItemInInv cid flit w
+tryPutItemInInv cid itid w = do
-
+    itm <- w ^? cWorld . lWorld . items . ix itid
--- not sure why we have the cid here, this will probably only work for cid == 0
+    invid <- checkInvSlotsYou itm w
-tryPutItemInInvAt :: Int -> Int -> FloorItem -> World -> Maybe World
+    let itloc = InInv
-tryPutItemInInvAt i cid flit w = do
+            { _ilCrID = cid
-    (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,) $
----- should select the item on the floor if no inventory space?
+            w
---createAndSelectItem :: Item -> World -> World
+                & cWorld . lWorld %~ crUpdateItemLocations cid
---createAndSelectItem itm w = case createPutItem itm w of
+                -- not sure about the order of these...
---    (Just i, w') ->
+                & cWorld . lWorld . creatures . ix cid . crInv . at invid ?~ itid
---        w'
+                & cWorld . lWorld . items . ix itid . itLocation .~ itloc
---            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
+                & cWorld . lWorld . floorItems . at itid .~ Nothing
---            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+                & updateselectionextra invid
---                .~  InInventory (SelectedItem i 
---                    $ fromMaybe (error "no root item1!") $ tryGetRootItemInvID i (you w))
---    (Nothing, w') -> w'
-
---createPutItem :: Item -> World -> (Maybe Int, World)
---createPutItem it w = fromMaybe (Nothing,w) $ do
---    (i,w') <- uncurry (tryPutItemIDInInv 0) $
---        copyItemToFloorID (_crPos $ you w) (applyModules it) w
---    return (Just i, w')
-
-createItemYou :: Item -> World -> (ItemLocation, World)
-createItemYou itm w = fromMaybe (OnFloor flid, w') $ do
-    (invid, w'') <- tryPutFloorItemIDInInv 0 flid w'
-    itloc <- w'' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itLocation
-    return (itloc, w'')
   where
-    itid = IM.newKey $ w ^. cWorld . lWorld . itemLocations
+    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
+tryPutItemInInvAt :: Int -> Int -> Int -> World -> Maybe World
+tryPutItemInInvAt i cid itid w = do
+    (j, w') <- tryPutItemInInv cid itid w
+    guard (i <= _unNInt j)
+    return $ foldr f w' [i + 1 .. _unNInt j]
+  where
+    f j = swapInvItems (\_ _ -> Just (j -1)) j
+
+createItemYou :: Item -> World -> World
+createItemYou itm w = maybe w' snd $ tryPutItemInInv 0 itid w'
+  where
+    itid = IM.newKey $ w ^. cWorld . lWorld . items
     pos = w ^?! cWorld . lWorld . creatures . ix 0 . crPos
-    (flid,w') = copyItemToFloorID pos (itm & itID .~ NInt itid) w
+    w' = copyItemToFloor pos (itm & itID .~ NInt itid) w
-    
 
--- | Pick up a specific item.
+-- the duplication is annoying...
-pickUpItem :: Int -> FloorItem -> World -> World
+pickUpItem :: Int -> Int -> World -> World
-pickUpItem cid flit w =
+pickUpItem cid itid w = fromMaybe w $ do
-    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing . snd) $
+    p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-        tryPutItemInInv cid flit w
+    soundStart (CrSound cid) p pickUpS Nothing . snd <$> tryPutItemInInv cid itid w
 
--- | Pick up a specific item.
+pickUpItemAt :: Int -> Int -> Int -> World -> World
-pickUpItemAt :: Int -> Int -> FloorItem -> World -> World
+pickUpItemAt invid cid itid w = fromMaybe w $ do
-pickUpItemAt invid cid flit w =
+    p <- w ^? cWorld . lWorld . floorItems . ix itid . flItPos
-    maybe w (soundStart (CrSound cid) (_flItPos flit) pickUpS Nothing) $
+    soundStart (CrSound cid) p pickUpS Nothing <$> tryPutItemInInvAt invid cid itid w
-        tryPutItemInInvAt invid cid flit w

src/Dodge/Inventory/CheckSlots.hs

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

src/Dodge/Inventory/Location.hs

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

src/Dodge/Inventory/Path.hs

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

src/Dodge/Inventory/RBList.hs

@@ -4,6 +4,8 @@ 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
@@ -21,11 +23,11 @@ updateRBList w = case w ^. rbOptions of
     EquipOptions{} -> w
     _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
         i <- cr ^? crManipulation . manObject . imSelectedItem
-        esite <- cr ^? crInv . ix i >>= equipType -- . itUse . uequipEffect . eeType
+        esite <- cr ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
         return $
             w & rbOptions
                 .~ EquipOptions
-                    { _opSel = chooseEquipPosition cr (eqSiteToPositions esite)
+                    { _opSel = chooseEquipPosition (w ^. cWorld . lWorld . items) cr (eqSiteToPositions esite)
                     }
   where
     norightclick = not $ SDL.ButtonRight `M.member` (w ^. input . mouseButtons)
@@ -33,10 +35,11 @@ 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 :: Creature -> [EquipSite] -> Int
+chooseEquipPosition :: IM.IntMap Item -> Creature -> [EquipSite] -> Int
-chooseEquipPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
+chooseEquipPosition m cr eps = fromMaybe (chooseFreeSite cr eps) $ do
     i <- cr ^? crManipulation . manObject . imSelectedItem
-    ep <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
+    itid <- cr ^? crInv . ix i
+    ep <- m ^? ix itid . itLocation . ilEquipSite . _Just
     elemIndex ep eps
 
 chooseFreeSite :: Creature -> [EquipSite] -> Int
@@ -44,14 +47,14 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
   where
     hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
 
-getEquipmentAllocation :: Int -> World -> EquipmentAllocation
+getEquipmentAllocation :: NewInt InvInt -> World -> EquipmentAllocation
 getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
-    esite <- you w ^? crInv . ix invid >>= equipType-- . itUse . uequipEffect . eeType
+    esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType-- . itUse . uequipEffect . eeType
     i <-
         w ^? rbOptions . opSel
-            <|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
+            <|> Just (chooseEquipPosition (w ^. cWorld . lWorld . items) (you w) (eqSiteToPositions esite))
     es <- eqSiteToPositions esite ^? ix i
-    return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
+    return $ case you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k . 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 =
-    SelectionItem
+    SelItem
         { _siPictures = itemDisplay w cr ci
         , _siHeight = itInvHeight $ ci ^. _1
         , _siWidth = 15
         , _siIsSelectable = True
         , _siColor = itemInvColor ci
         , _siOffX = indent
-        , _siPayload = ()
+        , _siPayload = Nothing
         }
   where
     ci = (a,b)
@@ -92,15 +92,18 @@ itemExternalValue itm w cr
         = Just (Right "ON")
     | BINGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID
-        litm <- cr ^? crInv . ix (invid -2)
+        litid <- cr ^? crInv . ix (invid -2)
-        ritm <- cr ^? crInv . ix (invid -1)
+        ritid <- cr ^? crInv . ix (invid -1)
+        litm <- w ^? cWorld . lWorld . items . ix litid
+        ritm <- w ^? cWorld . lWorld . items . ix ritid
         x <- itm ^? itScroll . itsRangeInt
         l <- getItemValue litm w cr ^? _Just . _Left
         r <- getItemValue ritm w cr ^? _Just . _Left
         Just . Left $ bgateCalc x l r
     | UNIGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID
-        itm' <- cr ^? crInv . ix (invid -1)
+        itid' <- cr ^? crInv . ix (invid -1)
+        itm' <- w ^? cWorld . lWorld . items . ix itid'
         x <- itm ^? itScroll . itsRangeInt
         y <- getItemValue itm' w cr ^? _Just . _Left
         Just . Left $ ugateCalc x y
@@ -202,42 +205,40 @@ hotkeyToChar = \case
     Hotkey9 -> '9'
     Hotkey0 -> '0'
 
-closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
+closeItemToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
-closeItemToSelectionItem w (NInt i) = do
+closeItemToSelectionItem w i = do
-    e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
+    e <- w ^? cWorld . lWorld . items . ix i
     let (pics, col) = closeItemToTextPictures e
     return
-        SelectionItem
+        SelItem
             { _siPictures = pics
             , _siHeight = length pics
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = col
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
 closeButtonToSelectionItem w i = do
     bt <- w ^? cWorld . lWorld . buttons . ix i
     return
-        SelectionItem
+        SelItem
             { _siPictures = [btText bt]
             , _siHeight = 1
             , _siWidth = 15
             , _siIsSelectable = True
             , _siColor = yellow
             , _siOffX = 0
-            , _siPayload = ()
+            , _siPayload = Nothing
             }
 
 btText :: Button -> String
 btText bt = case _btEvent bt of
     ButtonPress {} -> "BUTTON"
     ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
-    ButtonAccessTerminal -> "TERMINAL"
+    ButtonAccessTerminal {} -> "TERMINAL"
 
-closeItemToTextPictures :: FloorItem -> ([String], Color)
+closeItemToTextPictures :: Item -> ([String], Color)
-closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
+closeItemToTextPictures it = (basicItemDisplay it, itemInvColor $ baseCI it)
-  where
-    it = _flIt flit

src/Dodge/Inventory/Swap.hs

@@ -3,6 +3,7 @@ module Dodge.Inventory.Swap (
     swapAnyExtraSelection
 ) where
 
+import NewInt
 import Dodge.SoundLogic
 import Dodge.Item.Grammar
 import Dodge.Base.You
@@ -43,13 +44,13 @@ swapInvItems f i w = fromMaybe w $ do
             & checkConnection InventoryConnectSound connectItemS i k
   where
     updatecreature k =
-        (crInv %~ IM.safeSwapKeys i k)
+        (crInv . unNIntMap %~ IM.safeSwapKeys i k)
-            . (crManipulation . manObject . imSelectedItem .~ k)
+            . (crManipulation . manObject . imSelectedItem .~ NInt k)
             . swapSite i k
             . swapSite k i
     cr = you w
-    swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
+    swapSite a b = case cr ^? crInv . ix (NInt a) >>= \k -> w ^? cWorld . lWorld . items . ix k . itLocation . ilEquipSite . _Just of
-        Just epos -> crEquipment . ix epos .~ b
+        Just epos -> crEquipment . ix epos .~ NInt b
         Nothing -> id
 
 swapAnyExtraSelection :: Int -> Int -> World -> World
@@ -63,8 +64,9 @@ 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,6 +4,7 @@ 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
@@ -16,12 +17,12 @@ import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
 import ShapePicture
 
-itemEquipPict :: Creature -> DTree CItem -> SPic
+itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
-itemEquipPict cr itmtree
+itemEquipPict m cr itmtree
-    | Just i <- itm ^? itLocation . ilInvID
+    | --Just i <- itm ^? itLocation . ilInvID
-    , Just esite <- cr ^? crInv . ix i . itLocation . ilEquipSite . _Just
+     Just esite <- itm ^? itLocation . ilEquipSite . _Just
     , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
-        = equipPosition esite cr attachpos (itemSPic itm)
+        = equipPosition esite m cr attachpos (itemSPic itm)
     | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
         = overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
     | otherwise = mempty
@@ -37,15 +38,15 @@ equipAttachPos = \case
     BULLETBELTBRACER -> V3 (-9) 0 10
     _ -> 0
 
-equipPosition :: EquipSite -> Creature -> Point3 -> SPic -> SPic
+equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
-equipPosition epos cr p sh = case epos of
+equipPosition epos m cr p sh = case epos of
-    OnLeftWrist -> translateToLeftWrist cr sh
+    OnLeftWrist -> translateToLeftWrist m cr sh
-    OnRightWrist -> translateToRightWrist cr sh
+    OnRightWrist -> translateToRightWrist m cr sh
     OnLegs ->
         translateToLeftLeg cr sh
             <> translateToRightLeg cr sh-- (mirrorSPxz sh)
-    OnHead -> translateToHead cr sh
+    OnHead -> translateToHead m cr sh
-    OnChest -> translateToChest cr sh
+    OnChest -> translateToChest m cr sh
     --OnBack -> translateToBack cr p sh
-    OnBack -> overPosSP (\x -> fst $ backPQ cr `Q.comp` (p + x,Q.qID)) sh
+    OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
-    OnSpecial -> sh
+--    OnSpecial -> sh

src/Dodge/Item/Grammar.hs

@@ -9,6 +9,7 @@ module Dodge.Item.Grammar (
     invIndents,
 ) where
 
+import NewInt
 import Dodge.Item.Orientation
 import Dodge.ItemUseCondition
 import Dodge.Data.UseCondition
@@ -212,47 +213,43 @@ 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 :: IM.IntMap Item -> [DTree CItem]
+invDT :: NewIntMap InvInt Item -> [DTree CItem]
 invDT = 
-    joinItemsInList tryAttachItems . IM.elems
+    joinItemsInList tryAttachItems . IM.elems . _unNIntMap
         . fmap (singleDT . baseCI)
 
-invDT' :: IM.IntMap Item -> [DTree OItem]
+invDT' :: NewIntMap InvInt Item -> [DTree OItem]
 invDT' = fmap propagateOrientation' . invDT
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
--- consider explicitly reseting the inventory ids (but this probably really
+invRootMap :: NewIntMap InvInt Item -> IM.IntMap (Maybe Int, DTree Item)
--- 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) . fmap (^. _1) )
+        (dtToIntMapWithRoot (^?! itLocation . ilInvID . unNInt) . 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 :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
+invAdj :: NewIntMap InvInt 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
+            $ itm ^? itLocation . ilInvID . unNInt
 
 ---- returns an intmap with trees for (only!) root items, indexed by inventory position
-invIMDT :: IM.IntMap Item -> IM.IntMap (DTree OItem)
+invIMDT :: NewIntMap InvInt 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, t)
+    getid t = (t ^?! dtValue . _1 . itLocation . ilInvID . unNInt, t)
 
 ---- returns an intmap with indents and locations for all items
-invIndents :: IM.IntMap Item -> IM.IntMap (Int, LocationDT OItem)
+invIndents :: NewIntMap InvInt 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
@@ -268,6 +265,6 @@ invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
     g x ldt =
         (.)
             ( IM.insert
-                (ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID)
+                (ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID . unNInt)
                 (x, ldt)
             )

src/Dodge/Item/Location.hs

@@ -1,6 +1,6 @@
 module Dodge.Item.Location (
     pointerToItemID,
-    pointerToItemLocation,
+    --pointerToItemLocation,
     pointerToItem,
     pointerYourSelectedItem,
     pointerYourRootItem,
@@ -11,42 +11,33 @@ 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 flid) = cWorld . lWorld . floorItems . unNIntMap . ix (_unNInt flid) . flIt
+--pointerToItemLocation (OnFloor) = \f w -> 
-pointerToItemLocation _ = const pure
+----    cWorld . lWorld . floorItems . ix (_unNInt flid) . flIt
+--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
-    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
+    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
+    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
-    Just $ pointerToItemLocation (InInv 0 itinvid True True True Nothing) f w
+    itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix itinvid
+    Just $ (cWorld . lWorld . items . ix itid) f w
 
-pointerToItem ::
+pointerToItem :: Applicative f => Item -> (Item -> f Item) -> World -> f World
-    Applicative f =>
+pointerToItem x = cWorld . lWorld . items . ix (x ^. itID . unNInt)
-    Item ->
-    (Item -> f Item) ->
-    World ->
-    f World
-pointerToItem = pointerToItemLocation . _itLocation
 
-pointerToItemID :: 
+pointerToItemID :: Applicative f => NewInt ItmInt -> (Item -> f Item) -> World -> f World
-    Applicative f =>
+pointerToItemID itid = cWorld . lWorld . items . ix (itid ^. unNInt)
-    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,75 +1,76 @@
 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 w = w' & creatures .~ newcreatures
+--initCrsItemLocations :: LWorld -> LWorld
-  where
+--initCrsItemLocations w = w' & creatures .~ newcreatures
-    (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
+--  where
-
+--    (w', newcreatures) = mapAccumR initCrItemLocations w (w ^. creatures)
-initFlItemsLocations :: LWorld -> LWorld
+--
-initFlItemsLocations w = w' & floorItems .~ NIntMap newfloorItems
+----initFlItemsLocations :: LWorld -> LWorld
-  where
+----initFlItemsLocations w = w' & floorItems .~ newfloorItems
-    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems . unNIntMap)
+----  where
-
+----    (w', newfloorItems) = mapAccumR initFlItemLocation w (w ^. floorItems)
-initTusItemLocations :: LWorld -> LWorld
+--
-initTusItemLocations w = w' & machines .~ newmachines
+----initTusItemLocations :: LWorld -> LWorld
-  where
+----initTusItemLocations w = w' & machines .~ newmachines
-    (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
+----  where
-
+----    (w', newmachines) = mapAccumR initTuItemLocation w (w ^. machines)
-initSpecificCrItemLocations :: Int -> LWorld -> LWorld
+--
-initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
+--initSpecificCrItemLocations :: Int -> LWorld -> LWorld
-  where
+--initSpecificCrItemLocations crid w = w' & creatures . ix crid .~ newcr
-    (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
+--  where
-
+--    (w',newcr) = initCrItemLocations w (w ^?! creatures . ix crid)
-initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
+--
-initCrItemLocations w cr = (w', cr & crInv .~ newinv)
+--initCrItemLocations :: LWorld -> Creature -> (LWorld, Creature)
-  where
+--initCrItemLocations w cr = (w', cr & crInv .~ newinv)
-    (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
+--  where
-
+--    (w',newinv) = imapAccumR (initCrItemLocation cr) w (_crInv cr)
--- does not worry about creature manipulation for now
+--
-initCrItemLocation :: Creature -> Int -> LWorld -> Item -> (LWorld,Item)
+---- does not worry about creature manipulation for now
-initCrItemLocation cr invid w it = (w & itemLocations . at locid ?~ loc
+--initCrItemLocation :: Creature -> Int -> LWorld -> Int -> (LWorld,Item)
-    ,it & itID .~ NInt locid
+--initCrItemLocation cr invid w itid = (w & itemLocations . at locid ?~ loc
-        & itLocation .~ loc)
+--    ,it & itID .~ NInt locid
-  where
+--        & itLocation .~ loc)
-    locid = IM.newKey ( w ^. itemLocations)
+--  where
-    loc = InInv
+--    locid = IM.newKey ( w ^. itemLocations)
-            { _ilCrID = _crID cr
+--    loc = InInv
-            , _ilInvID = invid
+--            { _ilCrID = _crID cr
-            , _ilIsRoot = False
+--            , _ilInvID = invid
-            , _ilIsSelected = False
+--            , _ilIsRoot = False
-            , _ilIsAttached = False
+--            , _ilIsSelected = False
-            , _ilEquipSite = Nothing
+--            , _ilIsAttached = False
-            }
+--            , _ilEquipSite = Nothing
-
+--            }
-
+--
-initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
+--
-initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
+----initFlItemLocation :: LWorld -> FloorItem -> (LWorld, FloorItem)
-    , flit & flIt . itID .~ NInt locid
+----initFlItemLocation w flit = (w & itemLocations . at locid ?~ loc
-        & flIt . itLocation .~ loc
+----    , flit & flIt . itID .~ NInt locid
-    )
+----        & flIt . itLocation .~ loc
-  where
+----    )
-    locid = IM.newKey (w ^. itemLocations )
+----  where
-    loc = OnFloor (_flItID flit)
+----    locid = IM.newKey (w ^. itemLocations )
-
+----    loc = OnFloor (_flItID flit)
-initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
+--
-initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
+----initTuItemLocation :: LWorld -> Machine -> (LWorld, Machine)
-    Nothing -> (w, mc)
+----initTuItemLocation w mc = case mc ^? mcType . _McTurret . tuWeapon of
-    Just _ ->
+----    Nothing -> (w, mc)
-        let locid = IM.newKey ( w ^. itemLocations)
+----    Just _ ->
-            loc = OnTurret (_mcID mc)
+----        let locid = IM.newKey ( w ^. itemLocations)
-         in ( w & itemLocations . at locid ?~ loc
+----            loc = OnTurret (_mcID mc)
-            , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
+----         in ( w & itemLocations . at locid ?~ loc
-                & mcType . _McTurret . tuWeapon . itLocation .~ loc
+----            , mc & mcType . _McTurret . tuWeapon . itID .~ NInt locid
-            )
+----                & 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 $ im IM.! i)
+    f (InPlacement plf i) (w', r') = fst $ placeSpot (w', r') (plf (w' ^. gwWorld) $ 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) $ _rmOutPmnt r
+doRoomOutPlacements imw r = foldr f (imw, r) $ IM.toList $ _rmOutPmnt r
   where
-    f (OutPlacement pl i) ((im, w), rm) =
+    f (i, pl) ((im, w), rm) =
         let ((neww, newrm), plmnts) = placeSpot (w, rm) pl
          in ((IM.insert i plmnts im, neww), newrm)
 

src/Dodge/LevelGen.hs

@@ -1,5 +1,6 @@
-module Dodge.LevelGen where
+module Dodge.LevelGen (generateWorldFromSeed) where
 
+import Dodge.Annotation.Data
 import Dodge.Layout
 import Data.Preload.Render
 import Control.Lens
@@ -50,16 +51,17 @@ layoutLevelFromSeed i seed = do
     putStrLnAppend "log/attemptedSeeds" $ "Generating level with seed " ++ show seed
     appendFile "log/attemptedSeeds" "\n"
     let g = mkStdGen seed
-    let treecluster = evalState initialRoomTree (g, 0)
+    let treecluster = evalState tutRoomTree (LayVars 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
-    putStrLn "Room layout (compact): "
+    appendFile "log/aGeneratedRoomLayout" ("Seed: " ++ show seed ++ "\n")
-    putStrLn $ compactDrawTree $ fmap (show . snd) rmtree
+    putStrLnAppend "log/aGeneratedRoomLayout" "Room layout (compact): "
+    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 :: RandomGen g => [(Int -> State g (MetaTree Room String), State g ItemType)]
+lockRoomKeyItems :: [(Int -> State StdGen (MetaTree Room String), State StdGen 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, pistolCrit, autoCrit, armourChaseCrit]
+        [spreadGunCrit, autoCrit, armourChaseCrit]
             ++ replicate 20 chaseCrit
 
 --addcrits :: RandomGen g => [Item] -> State g (Tree Room)

src/Dodge/Machine/Destroy.hs

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

src/Dodge/Machine/Draw.hs

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

src/Dodge/Machine/Update.hs

@@ -83,12 +83,13 @@ isElectrical dm = case dm of
     _ -> False
 
 mcUseItem :: Machine -> World -> World
-mcUseItem mc = fromMaybe id $ do
+mcUseItem mc w = fromMaybe w $ do
     tu <- mc ^? mcType . _McTurret
-    let it = tu ^. tuWeapon
+    let i = tu ^. tuWeapon
+    it <- w ^? cWorld . lWorld . items . ix i
     hit <- it ^? itType
     guard (_tuFireTime tu > 0)
-    return $ mcUseHeld hit it mc
+    return $ mcUseHeld hit it mc w
 
 mcSensorTriggerUpdate :: Sensor -> Machine -> World -> World
 mcSensorTriggerUpdate se mc = fromMaybe id $ do
@@ -152,7 +153,8 @@ 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) (_crInv cr)
+    Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) 
+        (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 =
-    SelectionItem
+    SelItem
         { _siPictures = [optionText]
         , _siHeight = 1
         , _siWidth = 50
         , _siIsSelectable = isselectable
         , _siColor = thecol
         , _siOffX = 0
-        , _siPayload = (f, g)
+        , _siPayload = Just (f, g)
         }
   where
     isselectable = case _moString mo w of

src/Dodge/Placement/Instance/Analyser.hs

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

src/Dodge/Placement/Instance/Sensor.hs

@@ -12,12 +12,7 @@ import Dodge.LevelGen.PlacementHelper
 import Dodge.LightSource
 import Geometry
 
-damageSensor ::
+damageSensor :: SensorType -> Float -> Maybe Int -> PlacementSpot -> Placement
-    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
@@ -40,6 +35,7 @@ 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,9 +1,11 @@
 module Dodge.Placement.Instance.Terminal (
     putMessageTerminal,
+    putImmediateMessageTerminal,
     putTerminal,
     terminalColor,
 ) where
 
+import Dodge.WorldEffect
 import Color
 import Data.Maybe
 import Dodge.Data.GenWorld
@@ -13,11 +15,17 @@ import Dodge.SoundLogic
 import Geometry
 import LensHelp
 
-putTerminal :: Color -> Machine -> Terminal -> Placement
+putTerminalImediateAccess :: Color -> Machine -> Terminal -> Placement
-putTerminal col mc tm =
+putTerminalImediateAccess = putTerminalFull f
+  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 termButton) $
+            ps0PushPS (PutButton defaultButton) $
                 \btpl -> Just $
                     pt0
                         ( PutMachine
@@ -26,20 +34,24 @@ putTerminal col mc tm =
                                 & mcCloseSound ?~ fridgeHumS
                             )
                             defaultSensorWall
+                            Nothing
                         )
-                        $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl)
+                        $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const (setids tmpl btpl mcpl)) (\_ -> f 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 . btTermMID ?~ tmid
+            & cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal 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 $
@@ -48,15 +60,13 @@ putMessageTerminal col =
             & mcType .~ McTerminal
             & mcHP .~ 100
 
-termButton :: Button
+putImmediateMessageTerminal :: Color -> Terminal -> Placement
-termButton =
+putImmediateMessageTerminal col =
-    Button
+    putTerminalImediateAccess col $
-        { _btPos = 0
+        defaultMachine
-        , _btRot = 0
+            & mcColor .~ col
-        , _btEvent = ButtonAccessTerminal
+            & mcType .~ McTerminal
-        , _btID = 0
+            & mcHP .~ 100
-        , _btTermMID = Nothing
-        }
 
 terminalColor :: Color
 terminalColor = dark magenta

src/Dodge/Placement/Instance/Turret.hs

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

src/Dodge/Placement/PlaceSpot.hs

@@ -2,10 +2,9 @@
 {- | deals with placement of objects within the world
  after they have had their coordinates set by the layout
 -}
-module Dodge.Placement.PlaceSpot (
+module Dodge.Placement.PlaceSpot (placeSpot) where
-    placeSpot,
-) where
 
+import NewInt
 import Color
 import LensHelp
 import Control.Monad.State
@@ -22,11 +21,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
+-- to the placement. This id should be associated with the type of placement and
+-- 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
@@ -110,15 +109,20 @@ 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 ->
+    PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . items)
-        plNewUpID
+        in (i, w
-            (cWorld . lWorld . floorItems . unNIntMap)
+            & cWorld . lWorld . floorItems . at i ?~ createFlIt p rot 
-            (flItID . unNInt)
+            & cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i
-            (createFlIt p rot itm)
+                & itLocation .~ OnFloor)
-            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 -> plMachine (map doShift pps) mc wl p rot w
+    PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm 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
@@ -178,8 +182,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 -> Item -> FloorItem
+createFlIt :: Point2 -> Float -> FloorItem
-createFlIt p rot itm = FlIt{_flItPos = p, _flItRot = rot, _flItID = 0, _flIt = itm}
+createFlIt p rot = FlIt{_flItPos = p, _flItRot = rot}
 
 mvPP :: Point2 -> Float -> PressPlate -> PressPlate
 mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
@@ -190,8 +194,31 @@ 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 -> Point2 -> Float -> World -> (Int, World)
+plMachine :: [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
-plMachine wallpoly mc wl p rot gw =
+plMachine wallpoly mc wl mitm = case mitm of
+    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,50 +1,51 @@
 --{-# LANGUAGE LambdaCase #-}
-module Dodge.PlacementSpot 
+module Dodge.PlacementSpot (
-    ( atFstLnkOut
+    atFstLnkOut,
-    , rpIsOnPath
+    atNthLnkOutShiftBy,
-    , rpIsOffPath
+    rpIsOnPath,
-    , rpOffPathFromEdge
+    rpIsOffPath,
-    , rpOnPathFromEdge
+    rpOffPathFromEdge,
-    , useUnusedLnk
+    rpOnPathFromEdge,
-    , psRandRanges
+    useUnusedLnk,
-    , useRoomPosCond
+    psRandRanges,
-    , isUsedLnkUnplaced
+    useRoomPosCond,
-    , anyUnusedSpot
+    isUsedLnkUnplaced,
-    , unusedSpotAwayFromLink
+    anyUnusedSpot,
-    , isUnusedLnk
+    unusedSpotAwayFromLink,
-    , isInLnk
+    isUnusedLnk,
-    , isOutLnk
+    isInLnk,
-    , unusedSpotNearInLink
+    isOutLnk,
-    , randDirPS
+    unusedSpotNearInLink,
-    , unusedSpotAwayFromInLink
+    randDirPS,
-    , useLnkRoomPos
+    unusedSpotAwayFromInLink,
-    , atFstLnkOutShiftInward
+    useLnkRoomPos,
-    , atFstLnkOutShiftBy
+    atFstLnkOutShiftInward,
-    , atNthLnkOutShiftInward
+    atFstLnkOutShiftBy,
-    , unusedOffPathAwayFromLink
+    atNthLnkOutShiftInward,
-    , setFallback
+    unusedOffPathAwayFromLink,
-    , twoRoomPoss
+    setFallback,
-    , isUnusedLnkType
+    twoRoomPoss,
-    , rprBoolShift 
+    isUnusedLnkType,
-    , rprShift
+    rprBoolShift,
-    , rprBool
+    rprShift,
-    , shiftInBy
+    rprBool,
-    , resetPLUse
+    shiftInBy,
-    , psposAddLabel
+    resetPLUse,
-    , shiftByV2
+    psposAddLabel,
-    , usedRoomLinkPoss
+    shiftByV2,
-    , usedRoomInLinkPoss
+    usedRoomLinkPoss,
-    ) where
+    usedRoomInLinkPoss,
-
+    atNthLinkOut,
-import Dodge.Data.GenWorld
+) where
-import Geometry
 
 import Control.Lens
-import Data.Maybe
-import Data.Bifunctor
 import Control.Monad.State
-import System.Random
+import Data.Bifunctor
+import Data.Maybe
 import qualified Data.Set as S
+import Dodge.Data.GenWorld
+import Geometry
+import System.Random
 
 setDirPS :: Float -> PlacementSpot -> PlacementSpot
 setDirPS a ps = case ps of
@@ -55,16 +56,16 @@ 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
-anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
+anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
 
 psposAddLabel :: RoomPosType -> PlacementSpot -> PlacementSpot
 psposAddLabel lab = psSelect %~ (\f rp r -> f rp r & _Just . _2 . rpType %~ S.insert lab)
@@ -75,23 +76,25 @@ 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
-    f rt = maybe False (pe `elem`) (rt ^? offPathFromEdges) 
+    f rt = maybe False (pe `elem`) (rt ^? offPathFromEdges)
 
 -- test whether a roomPos is on the path with a given from edge value
 rpOnPathFromEdge :: PathFromEdge -> RoomPos -> Bool
 rpOnPathFromEdge pe = any f . _rpType
   where
-    f rt = maybe False (pe `elem`) (rt ^? onPathFromEdges) 
+    f rt = maybe False (pe `elem`) (rt ^? onPathFromEdges)
 
 resetPLUse :: PlacementSpot -> PlacementSpot
 resetPLUse (PSPos f g fallback) = PSPos f' g fallback
@@ -99,58 +102,64 @@ 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
+        Nothing -> Nothing
 
-rprBoolShift :: (RoomPos -> Room -> Bool) 
+rprBoolShift ::
-    -> ((Point2,Float) -> (Point2,Float))
+    (RoomPos -> Room -> Bool) ->
-    -> PlacementSpot
+    ((Point2, Float) -> (Point2, Float)) ->
+    PlacementSpot
 rprBoolShift t shift = PSPos f (const id) Nothing
   where
     f rp r
-        | t rp r    = Just (PS p a, rp & rpPlacementUse +~ 1)
+        | 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 -> _rpLinkStatus rp == NotLink 
+unusedSpotAwayFromLink x = rprBool $ \rp r ->
-    && _rpPlacementUse rp == 0 
+    _rpLinkStatus rp == NotLink
-    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
+        && _rpPlacementUse rp == 0
+        && 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 -> _rpLinkStatus rp == NotLink
-unusedOffPathAwayFromLink x = rprBool $ \rp r -> _rpPlacementUse rp == 0 
+unusedOffPathAwayFromLink x = rprBool $ \rp r ->
-    && all ( (>x) . dist (_rpPos rp) ) (usedRoomLinkPoss r)
+    _rpPlacementUse rp == 0
-    && rpIsOffPath rp
+        && all ((> x) . dist (_rpPos rp)) (usedRoomLinkPoss r)
+        && rpIsOffPath rp
 
 unusedSpotAwayFromInLink :: Float -> PlacementSpot
-unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink 
+unusedSpotAwayFromInLink x = rprBool $ \rp r ->
-    && _rpPlacementUse rp == 0 
+    _rpLinkStatus rp == NotLink
-    && all ( (>x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
+        && _rpPlacementUse rp == 0
+        && all ((> x) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
 
 --twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
 --twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
 
-twoRoomPoss :: (RoomPos -> Room -> Bool)
+twoRoomPoss ::
-    -> (RoomPos -> Room -> Bool)
+    (RoomPos -> Room -> Bool) ->
-    -> (PlacementSpot -> PlacementSpot -> Placement)
+    (RoomPos -> Room -> Bool) ->
-    -> Placement
+    (PlacementSpot -> PlacementSpot -> Placement) ->
-twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing
+    Placement
-    $ \_ pl1 -> Just $ Placement 10 (rprBool cond2) PutNothing Nothing
+twoRoomPoss cond1 cond2 f = Placement 10 (rprBool cond1) PutNothing Nothing $
-    $ \_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
+    \_ pl1 -> Just $
+        Placement 10 (rprBool cond2) PutNothing Nothing $
+            \_ pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
 --isUnusedLnk :: RoomPos -> Bool
 --isUnusedLnk rp = case _rpLinkStatus rp of
@@ -159,26 +168,27 @@ 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
 useUnusedLnk = rprBool isUnusedLnk
 
 isUsedLnkUnplaced :: RoomPos -> Bool
-isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
+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
@@ -189,66 +199,71 @@ isUnusedLnkType rlt rp _ = case _rpLinkStatus rp of
     _ -> False
 
 unusedSpotNearInLink :: Float -> PlacementSpot
-unusedSpotNearInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
+unusedSpotNearInLink x = rprBool $ \rp r ->
-    && _rpPlacementUse rp == 0 
+    _rpLinkStatus rp == NotLink
-    && any ( (<x) . dist (_rpPos rp) ) (usedRoomInLinkPoss r)
+        && _rpPlacementUse rp == 0
+        && 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 = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just 0
+atFstLnkOut = atNthLinkOut 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
---        UsedOutLink {_rplsChildNum = i} | i == n 
+--        UsedOutLink {_rplsChildNum = i} | i == n
 --            -> Just (PS p a, rp & rpPlacementUse +~ 1)
 --        _   -> Nothing
 --      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,5 +1,4 @@
-{-# LANGUAGE LambdaCase #-}
+--{-# LANGUAGE LambdaCase #-}
-
 --{-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update (updateProjectile) where
 
@@ -74,7 +73,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
@@ -164,9 +163,9 @@ destroyProjectile mitid pjid w =
         & removelink
   where
     removelink = fromMaybe id $ do
-        itid <- fmap _unNInt mitid
+        itid <- mitid
-        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
+--        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
-        return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
+        return $ pointerToItemID itid . itUse . uaParams . apProjectiles %~ delete pjid
 
 trySpin :: Projectile -> World -> World
 trySpin pj = fromMaybe id $ do
@@ -229,7 +228,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 ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
+            == lw ^? items . ix (_unNInt screenid) . itLocation . 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 . _unNIntMap . _floorItems . _lWorld . _cWorld
+itemBlips p r = (,mempty) . IM.elems . IM.filter f . fmap _flItPos . _floorItems . _lWorld . _cWorld
   where
     f q = dist p q <= r && dist p q > r - 4