rename debug terminal to console

.gitignore

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

ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for loop
+
+## Unreleased changes

README.md

@@ -0,0 +1 @@
+# loop

appDodge/Main.hs

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

asdf

@@ -0,0 +1,483 @@
+{- |
+Weapon effects when pulling the trigger.  -}
+module Dodge.Item.Weapon.TriggerType
+    where
+import Dodge.Data
+import Dodge.SoundLogic
+import Dodge.Creature.Action (startReloadingWeapon)
+import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
+import Dodge.WorldEvent.Cloud
+import Dodge.RandomHelp
+import Dodge.Particle.Bullet.Spawn
+import Dodge.Item.Attachment.Data
+import Dodge.Item.Data
+import Geometry
+
+import System.Random
+import Control.Lens
+import Control.Monad.State
+import Data.Maybe
+import qualified Data.IntMap.Strict as IM
+import Data.Foldable
+
+withThinSmoke 
+    :: (Creature -> World -> World) -- ^ Underlying effect
+    -> Creature   
+    -> World 
+    -> World
+withThinSmoke eff cr w = eff cr $ foldl' (flip $ makeThinSmokeAt . (+.+ pos)) w ps
+  where
+    dir = _crDir cr
+    pos = _crPos cr +.+ (_crRad cr +0.5) *.* unitVectorAtAngle dir
+    ps = (replicateM 5 . randInCirc) 8 & evalState $ _randGen w
+
+withThickSmoke 
+    :: (Creature -> World -> World) -- ^ Underlying effect
+    -> Creature  
+    -> World 
+    -> World
+withThickSmoke eff cr w = eff cr $ foldl' (flip $ makeThickSmokeAt . (+.+ pos)) w ps
+  where
+    dir = _crDir cr
+    pos = _crPos cr +.+ (_crRad cr + 15) *.* unitVectorAtAngle dir
+    ps = (replicateM 20 . randInCirc) 8 & evalState $ _randGen w
+{- |
+Fires at an increasing rate.
+Has different effect after first fire.
+Applies ammo check and use cooldown check.  -}
+rateIncAB 
+    :: Int  -- ^ Start rate
+    -> Int  -- ^ End rate
+    -> (Creature -> World -> World)  -- ^ Effect on first fire
+    -> (Creature -> World -> World)  -- ^ Effect on continued fire
+    -> Creature  -- ^ Creature id
+    -> World 
+    -> World
+rateIncAB startRate fastRate shooteff1 shooteff2 cr w
+    | repeatFire = w
+        & pointItem %~ ( (itUseRate .~ max fastRate (currentRate - 1))
+            . (wpLoadedAmmo -~ 1)
+            . (itUseTime .~ currentRate) )
+        & shooteff2 cr
+    | firstFire = w
+        & pointItem %~ ( (itUseRate .~ startRate - 1)
+            . (wpLoadedAmmo -~ 1)
+            . (itUseTime .~ startRate) )
+        & shooteff1 cr
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointItem = creatures . ix cid . crInv . ix itRef
+    currentRate = _itUseRate item
+    repeatFire = _wpReloadState item == 0 
+        && _itUseTime item == 1 
+        && _wpLoadedAmmo item > 0
+    firstFire = _wpReloadState item == 0 
+        && _itUseTime item == 0 
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+{- |
+Shoot a weapon rapidly after a warm up.
+Applies ammo check as well.  -}
+withWarmUp 
+    :: Int  -- ^ Warm up time (in frames)
+    -> (Creature -> World -> World) 
+            -- ^ Shoot effect
+    -> Creature
+    -> World 
+    -> World
+withWarmUp t f cr w 
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | _wpReloadState item /= 0 = w
+    | fState == 0 = w
+        & pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp 100 f)) . (itUseTime .~ 2) )
+    | t > 2 = w 
+        & pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp (t-1) f)) . (itUseTime .~ 2) )
+        & soundFrom (CrWeaponSound cid) 26 2 0
+    | t > 0 = w 
+        & pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp (t-1) f)) . (itUseTime .~ 2) )
+    | otherwise = w 
+        & pointerToItem %~ ( (itUse .~ (\_ -> withWarmUp 1 f)) . (wpLoadedAmmo -~ 1) . (itUseTime .~ 2) )
+        & f cr
+        & soundFrom (CrWeaponSound cid) 28 2 0
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fState = _itUseTime item
+    reloadCondition = _wpLoadedAmmo item == 0
+{- | Adds a sound to a creature based world effect. 
+The sound is emitted from the creature's position. -}
+withSound 
+    :: Int -- ^ Sound id
+    -> (Creature -> World -> World) -- ^ Underlying effect
+    -> Creature 
+    -> World -> World
+withSound soundid f cr = soundOncePos soundid (_crPos cr) . f cr
+
+withRecoil 
+    :: Float    -- ^ Recoil amount
+    -> (Creature -> World -> World) 
+                -- ^ Underlying world effect, takes creature id as input
+    -> Creature 
+    -> World -> World
+withRecoil recoilAmount eff cr = eff cr . over (creatures . ix cid) pushback
+  where 
+    cid = _crID cr
+    pushback = over crPos (+.+ rotateV (_crDir cr) (V2 ((-recoilAmount) / _crMass cr ) 0))
+{- | Pushes a creature sideways by a random amount.
+Applied before the underlying effect.  -}
+withSidePush 
+    :: Float    -- ^ Maximal possible side push amount
+    -> (Creature -> World -> World)  
+                -- ^ Underlying world effect, takes creature id as input
+    -> Creature 
+    -> World -> World
+withSidePush maxSide eff cr w = eff cr . over (creatures . ix cid) push $ w
+  where 
+    cid = _crID cr
+    push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
+    (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
+-- consider unifying the pushes using a direction vector
+{- | Pushes a creature sideways by a random amount.
+Applied after the underlying effect.  -}
+withSidePushAfter
+    :: Float    -- ^ Maximal possible side push amount
+    -> (Creature -> World -> World)  
+                -- ^ Underlying world effect, takes creature id as input
+    -> Creature      -- ^ Creature id
+    -> World -> World
+withSidePushAfter maxSide eff cr w = over (creatures . ix cid) push . eff cr $ w
+  where 
+    cid = _crID cr
+    push = over crPos (+.+ rotateV (_crDir cr) (V2 0 (pushAmount / _crMass cr)))
+    (pushAmount, _) = randomR (-maxSide,maxSide) $ _randGen w
+{- | Applies a world effect and sound effect after an ammo check. -}
+shootWithSound 
+    :: Int  -- ^ Sound identifier
+    -> (Creature -> World -> World) 
+            -- ^ Shoot effect, takes creature id as input
+    -> Creature 
+    -> World 
+    -> World
+shootWithSound soundid f cr w
+    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+        $ soundOncePos soundid (_crPos cr)
+        $ set (pointerToItem . itUseTime) (_itUseRate item)
+        $ f cr w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fireCondition = _wpReloadState item == 0
+                      && _itUseTime item == 0
+                      && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+{- | Applies a world effect and sound effect after an ammo check. -}
+shootWithSoundI
+    :: Int  -- ^ Sound identifier
+    -> (Item -> Creature -> World -> World) 
+            -- ^ Shoot effect, takes creature id as input
+    -> Item 
+    -> Creature 
+    -> World 
+    -> World
+shootWithSoundI soundid f item cr w
+    | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
+        $ soundOncePos soundid (_crPos cr)
+        $ set (pointerToItem . itUseTime) (_itUseRate item)
+        $ f item cr w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fireCondition = _wpReloadState item == 0
+        && _itUseTime item == 0
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+{- | 
+Applies a world effect after an item use cooldown check. -}
+useTimeCheck
+    :: (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature 
+    -> World
+    -> World
+useTimeCheck f cr w = case theItem ^? itUseTime of
+    Just 0 -> f cr $ setUseTime w
+    _             -> w
+  where 
+    cid = _crID cr
+    setUseTime = creatures . ix cid . crInv . ix (_crInvSel cr) . itUseTime +~ useRate
+    theItem = _crInv cr IM.! _crInvSel cr
+    useRate = fromMaybe 0 $ theItem ^? itUseRate
+{- | Applies a world effect after a hammer position check. -}
+hammerCheck
+    :: (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature 
+    -> World
+    -> World
+hammerCheck f cr w = case (_crInv cr IM.! _crInvSel cr) ^? itHammer of
+    Just HammerUp -> f cr $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cid = _crID cr
+    setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+{- | Applies a world effect after a hammer position check. -}
+hammerCheckI
+    :: (Item -> Creature -> World -> World)  -- ^ Underlying effect
+    -> Item
+    -> Creature 
+    -> World
+    -> World
+hammerCheckI f it cr w = case it ^? itHammer of
+    Just HammerUp -> f it cr $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cid = _crID cr
+    setHammerDown = creatures . ix cid . crInv . ix (_crInvSel cr) . itHammer .~ HammerDown
+{- | Applies a world effect after an ammo check. -}
+shoot 
+    :: (Creature -> World -> World) 
+            -- ^ Underlying effect
+    -> Creature
+    -> World
+    -> World
+shoot f cr w 
+    | fireCondition = f cr w & pointerToItem %~
+        ( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    itRef = _crInvSel cr
+    item = _crInv cr IM.! itRef
+    pointerToItem = creatures . ix cid . crInv . ix itRef
+    fireCondition = _wpReloadState item == 0
+        && _itUseTime item == 0
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+{- | Applies a world effect after a hammer position check.
+Arbitrary inventory position. -}
+hammerCheckL
+    :: (Creature -> Int -> World -> World)  -- ^ Underlying effect
+    -> Creature 
+    -> Int
+    -> World
+    -> World
+hammerCheckL f cr invid w = case (_crInv cr IM.! invid) ^? itHammer of
+    Just HammerUp -> f cr invid $ setHammerDown w
+    _             -> setHammerDown w
+  where 
+    cid = _crID cr
+    setHammerDown = creatures . ix cid . crInv . ix invid . itHammer .~ HammerDown
+{- | Applies a world effect after an ammo check. 
+Arbitrary inventory position. -}
+shootL 
+    :: (Creature -> Int -> World -> World) 
+            -- ^ Underlying effect
+    -> Creature
+    -> Int -- ^ Inventory position
+    -> World
+    -> World
+shootL f cr invid w 
+    | fireCondition = f cr invid w & pointerToItem %~
+        ( (wpLoadedAmmo -~ 1) . (itUseTime .~ _itUseRate item) )
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cr w
+    | otherwise = w
+  where 
+    cid = _crID cr
+    item = _crInv cr IM.! invid
+    pointerToItem = creatures . ix cid . crInv . ix invid
+    fireCondition = _wpReloadState item == 0
+        && _itUseTime item == 0
+        && _wpLoadedAmmo item > 0
+    reloadCondition = _wpLoadedAmmo item == 0
+
+withMuzFlare 
+    :: (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature
+    -> World 
+    -> World
+withMuzFlare f cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f cr w
+  where 
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+    pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+
+withMuzFlareI
+    :: (Item -> Creature -> World -> World)  -- ^ Underlying effect
+    -> Item
+    -> Creature
+    -> World 
+    -> World
+withMuzFlareI f it cr w = tempLightForAt 3 pos . muzzleFlashAt pos2 $ f it cr w
+  where 
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+    pos2 = _crPos cr +.+ (2 * _crRad cr) *.* unitVectorAtAngle (_crDir cr)
+{- | Applies the effect to a randomly rotated creature.  -}
+withRandomDir 
+    :: Float    -- ^ Max possible rotation
+    -> (Creature -> World -> World) 
+                -- ^ Underlying effect
+    -> Creature
+    -> World 
+    -> World
+withRandomDir acc f cr w = f (cr & crDir +~ a) $ set randGen g w
+  where 
+    (a, g) = randomR (-acc,acc) $ _randGen w
+{- | Applies the effect to a randomly rotated creature.  -}
+withRandomDirI
+    :: Float    -- ^ Max possible rotation
+    -> (Item -> Creature -> World -> World) 
+                -- ^ Underlying effect
+    -> Item
+    -> Creature
+    -> World 
+    -> World
+withRandomDirI acc f it cr w = f it (cr & crDir +~ a) $ set randGen g w
+  where 
+    (a, g) = randomR (-acc,acc) $ _randGen w
+{- | Creates a bullet with a given velocity, width, and 'HitEffect' -}
+withVelWthHiteff 
+    :: Point2       -- ^ Velocity, x direction is forward with respect to the creature
+    -> Float        -- ^ Bullet width
+    -> HitEffect    -- ^ Bullet effect when hitting creature, wall etc
+    -> Creature          -- ^ Creature id
+    -> World 
+    -> World
+withVelWthHiteff vel width hiteff cr = over particles (newbul : ) 
+  where 
+    cid = _crID cr
+    newbul = aGenBulAt (Just cid) pos (rotateV dir vel) hiteff width
+    dir = _crDir cr
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
+{- | Apply the effect to a translated creature. -}
+withRandomOffset 
+    :: Float    -- ^ Max possible translate
+    -> (Creature -> World -> World)
+                -- ^ Underlying effect
+    -> Creature 
+    -> World 
+    -> World
+withRandomOffset offsetAmount f cr w = f (cr & crPos %~ (+.+ offV)) $ set randGen g w
+  where 
+    (offsetVal , g) = randomR (-offsetAmount,offsetAmount) $ _randGen w
+    offV = rotateV (_crDir cr) (V2 0 offsetVal)
+-- | Rotates a creature with minimum rotation at least 0.1.
+-- Rotates the player creature before applying the effect, other creatures after.
+torqueBeforeForced 
+    :: Float    -- ^ Max possible rotation (less the 0.1 forced rotation)
+    -> (Creature -> World -> World) 
+                -- ^ Underlying effect
+    -> Creature
+    -> World 
+    -> World
+torqueBeforeForced torque feff cr w 
+    | cid == 0  = feff (cr & crDir +~ rot') $ w
+        & randGen                    .~ g 
+        & creatures . ix cid . crDir +~ rot'
+        & cameraRot                  +~ rot'
+    | otherwise = feff cr $ set randGen g $ over (creatures . ix cid . crDir) (+rot') w
+  where 
+    cid = _crID cr
+    (rot, g) = randomR (-torque,torque) $ _randGen w
+    rot' | rot < 0   = rot - 0.1
+         | otherwise = rot + 0.1
+-- | Rotates the player creature before applying an effect.
+-- Note this currently (29/4/2021) rotates other creatures /after/ applying the effect.
+torqueBefore 
+    :: Float                     -- ^ Max possible rotation
+    -> (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature                      -- ^ Creature id
+    -> World 
+    -> World
+torqueBefore torque feff cr w 
+    | cid == 0  = feff (cr & crDir +~ rot) $ w
+        & randGen                    .~ g 
+        & creatures . ix cid . crDir +~ rot
+        & cameraRot                  +~ rot
+    | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
+  where 
+    cid = _crID cr
+    (rot, g) = randomR (-torque,torque) $ _randGen w
+-- | Rotate a randomly creature after applying an effect.
+torqueAfter
+    :: Float                    -- ^ Max possible rotation
+    -> (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature                      -- ^ Creature id
+    -> World 
+    -> World
+torqueAfter torque feff cr w 
+    | cid == 0  = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff cr w
+    | otherwise = set randGen g $ over (creatures . ix cid . crDir) (+rot) $ feff cr w
+  where 
+    cid = _crID cr
+    (rot, g) = randomR (-torque,torque) $ _randGen w
+    rotateScope = creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
+                          . itAttachment . _Just . scopePos %~ rotateV rot 
+{- | Create multiple bullets with a given spread, a given amount, given velocity,
+given width and given 'HitEffect'.  -}
+spreadNumVelWthHiteff 
+    :: Float    -- ^ Spread
+    -> Int      -- ^ Number of bullets
+    -> Point2   -- ^ Velocity, x is direction of creature
+    -> Float    -- ^ Bullet width
+    -> HitEffect -- ^ Effect when hitting creature, wall etc
+    -> Creature      -- ^ Creature id
+    -> World 
+    -> World
+spreadNumVelWthHiteff spread num vel wth eff cr w = over particles (newbuls ++) w
+  where 
+    cid = _crID cr
+    newbuls = zipWith
+        (\pos d -> aGenBulAt (Just cid) pos (rotateV d vel) eff wth) 
+        poss dirs
+    poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
+        $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
+    dirs = map (_crDir cr +) $ zipWith (+) 
+        [-spread,-spread+(2*spread/fromIntegral num)..]
+        (randomRs (0,spread/5) (_randGen w))
+{- | Create a number of bullets side by side with a given velocity,
+given width and given 'HitEffect'.  -}
+numVelWthHitEff 
+    :: Int      -- ^ Amount of bullets
+    -> Point2   -- ^ Velocity, x axis is direction of creature
+    -> Float    -- ^ Bullet width
+    -> HitEffect -- ^ Effect when hitting creature, wall etc
+    -> Creature  
+    -> World 
+    -> World
+numVelWthHitEff num vel wth eff cr = over particles (newbuls ++)
+  where 
+    cid = _crID cr
+    newbuls = map (\p -> aGenBulAt (Just cid) p (rotateV d vel) eff wth) poss 
+    d = _crDir cr
+    poss = map (+.+ pos) $ take num offsets
+    maxOffset = fromIntegral num * 2.5 - 2.5
+    offsets = map (rotateV d . V2 0) [-maxOffset,5-maxOffset..]
+    pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle d
+{- | Uses '_wpSpread' as a parameter for the current offset angle. -}
+randWalkAngle 
+    :: Float    -- ^ Max offset angle
+    -> Float    -- ^ Walk speed
+    -> (Creature -> World -> World)  -- ^ Underlying effect
+    -> Creature      -- ^ Creature id
+    -> World 
+    -> World
+randWalkAngle ma aspeed f cr w = w
+    & f (cr & crDir +~ a)
+    & creatures . ix cid . crInv . ix i . wpSpread .~ newa
+  where
+    cid = _crID cr
+    a = _wpSpread $ _crInv (_creatures w IM.! cid) IM.! i
+    (walka, _) = randomR (-aspeed,aspeed) (_randGen w)
+    newa = min ma $ max (negate ma) (a + walka)
+    i = _crInvSel $ _creatures w IM.! cid

data/dodge.config.json

@@ -1,7 +1,8 @@
 {
   "_debug_booleans": [
     "Show_ms_frame",
-    "Pathing"
+    "Mouse_position",
+    "Collision_test"
   ],
   "_debug_view_clip_bounds": "NoRoomClipBoundaries",
   "_gameplay_rotate_to_wall": true,

graph/itemCombinations.gv

@@ -0,0 +1,281 @@
+digraph {
+    graph [rankdir=LR];
+    subgraph 1 {
+        1 [shape=box
+          ,label="EQUIP {_ibtEquip = FUELPACK}"];
+        5 [shape=box
+          ,label="AMMOMAG {_ibtAmmoMag = TINMAG}"];
+        9 [shape=box
+          ,label="HELD {_ibtHeld = BANGSTICK {_xNum = 1}}"];
+        13 [shape=box
+           ,label="HELD {_ibtHeld = PISTOL}"];
+        15 [shape=box
+           ,label="HELD {_ibtHeld = AUTOPISTOL}"];
+        17 [shape=box
+           ,label="HELD {_ibtHeld = SMG}"];
+        20 [shape=box
+           ,label="HELD {_ibtHeld = MACHINEPISTOL}"];
+        22 [shape=box
+           ,label="HELD {_ibtHeld = BANGCONE}"];
+        25 [shape=box
+           ,label="HELD {_ibtHeld = BLUNDERBUSS}"];
+        27 [shape=box
+           ,label="HELD {_ibtHeld = GRAPECANNON {_xNum = 1}}"];
+        29 [shape=box
+           ,label="HELD {_ibtHeld = RIFLE}"];
+        31 [shape=box
+           ,label="HELD {_ibtHeld = VOLLEYGUN {_xNum = 3}}"];
+        33 [shape=box
+           ,label="HELD {_ibtHeld = AUTORIFLE}"];
+        35 [shape=box
+           ,label="HELD {_ibtHeld = BURSTRIFLE}"];
+        37 [shape=box
+           ,label="HELD {_ibtHeld = MINIGUNX {_xNum = 3}}"];
+        40 [shape=box
+           ,label="HELD {_ibtHeld = SNIPERRIFLE}"];
+        41 [shape=box
+           ,label="HELD {_ibtHeld = AMR}"];
+        44 [shape=box
+           ,label="HELD {_ibtHeld = AUTOAMR}"];
+        46 [shape=box
+           ,label="HELD {_ibtHeld = RLAUNCHER}"];
+        49 [shape=box
+           ,label="HELD {_ibtHeld = RLAUNCHERX {_xNum = 2}}"];
+        53 [shape=box
+           ,label="HELD {_ibtHeld = FLAMESPITTER}"];
+        57 [shape=box
+           ,label="HELD {_ibtHeld = BLOWTORCH}"];
+        59 [shape=box
+           ,label="HELD {_ibtHeld = FLAMETHROWER}"];
+        61 [shape=box
+           ,label="HELD {_ibtHeld = FLAMEWALL}"];
+        63 [shape=box
+           ,label="HELD {_ibtHeld = FLAMETORRENT}"];
+        65 [shape=box,label=LASER];
+        69 [shape=box
+           ,label="HELD {_ibtHeld = SPARKGUN}"];
+        71 [shape=box
+           ,label="HELD {_ibtHeld = TESLAGUN}"];
+        73 [shape=box
+           ,label="HELD {_ibtHeld = BLINKERUNSAFE}"];
+        74 [shape=box
+           ,label="HELD {_ibtHeld = BLINKER}"];
+        77 [shape=box
+           ,label="EQUIP {_ibtEquip = MAGSHIELD MagnetRepulse}"];
+        80 [shape=box
+           ,label="EQUIP {_ibtEquip = POWERLEGS}"];
+        86 [shape=box
+           ,label="HELD {_ibtHeld = FLATSHIELD}"];
+        96 [shape=box
+           ,label="DETECTOR {_ibtDetector = ITEMDETECTOR}"];
+        99 [shape=box
+           ,label="DETECTOR {_ibtDetector = WALLDETECTOR}"];
+        101 [shape=box
+            ,label="DETECTOR {_ibtDetector = CREATUREDETECTOR}"];
+        103 [shape=box
+            ,label="HELD {_ibtHeld = TORCH}"];
+        104 [shape=box
+            ,label="AMMOMAG {_ibtAmmoMag = BATTERY}"];
+        107 [shape=box
+            ,label="EQUIP {_ibtEquip = HEADLAMP}"];
+        108 [shape=box
+            ,label="EQUIP {_ibtEquip = HAT}"];
+        110 [shape=box
+            ,label="HELD {_ibtHeld = BANGSTICK {_xNum = 2}}"];
+    }
+    subgraph 2 {
+        0 [shape=point];
+        4 [shape=point];
+        8 [shape=point];
+        12 [shape=point];
+        14 [shape=point];
+        16 [shape=point];
+        19 [shape=point];
+        21 [shape=point];
+        24 [shape=point];
+        26 [shape=point];
+        28 [shape=point];
+        30 [shape=point];
+        32 [shape=point];
+        34 [shape=point];
+        36 [shape=point];
+        39 [shape=point];
+        42 [shape=point];
+        43 [shape=point];
+        45 [shape=point];
+        48 [shape=point];
+        50 [shape=point];
+        52 [shape=point];
+        56 [shape=point];
+        58 [shape=point];
+        60 [shape=point];
+        62 [shape=point];
+        64 [shape=point];
+        68 [shape=point];
+        70 [shape=point];
+        72 [shape=point];
+        76 [shape=point];
+        79 [shape=point];
+        82 [shape=point];
+        83 [shape=point];
+        84 [shape=point];
+        85 [shape=point];
+        87 [shape=point];
+        89 [shape=point];
+        92 [shape=point];
+        95 [shape=point];
+        98 [shape=point];
+        100 [shape=point];
+        102 [shape=point];
+        106 [shape=point];
+        109 [shape=point];
+        111 [shape=point];
+        113 [shape=point];
+        115 [shape=point];
+        117 [shape=point];
+    }
+    0 -> 1 [xlabel="",tailport=e];
+    4 -> 5 [xlabel="",tailport=e];
+    8 -> 9 [xlabel="",tailport=e];
+    9 -> 12 [xlabel=1
+            ,arrowhead=onone
+            ,headport=w];
+    9 -> 28 [xlabel=1
+            ,arrowhead=onone
+            ,headport=w];
+    9 -> 30 [xlabel=1
+            ,arrowhead=onone
+            ,headport=w];
+    9 -> 30 [xlabel=1
+            ,arrowhead=onone
+            ,headport=w];
+    9 -> 30 [xlabel=1
+            ,arrowhead=onone
+            ,headport=w];
+    9 -> 109 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    9 -> 113 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    9 -> 115 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    12 -> 13 [xlabel="",tailport=e];
+    13 -> 14 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    14 -> 15 [xlabel="",tailport=e];
+    15 -> 16 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    15 -> 19 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    16 -> 17 [xlabel="",tailport=e];
+    19 -> 20 [xlabel="",tailport=e];
+    21 -> 22 [xlabel="",tailport=e];
+    22 -> 24 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    24 -> 25 [xlabel="",tailport=e];
+    25 -> 26 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    26 -> 27 [xlabel="",tailport=e];
+    27 -> 117 [xlabel=1
+              ,arrowhead=onone
+              ,headport=w];
+    28 -> 29 [xlabel="",tailport=e];
+    29 -> 32 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    29 -> 34 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    29 -> 42 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    30 -> 31 [xlabel="",tailport=e];
+    31 -> 36 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    31 -> 113 [xlabel=1
+              ,arrowhead=onone
+              ,headport=w];
+    32 -> 33 [xlabel="",tailport=e];
+    34 -> 35 [xlabel="",tailport=e];
+    36 -> 37 [xlabel="",tailport=e];
+    37 -> 115 [xlabel=1
+              ,arrowhead=onone
+              ,headport=w];
+    39 -> 40 [xlabel="",tailport=e];
+    41 -> 39 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    41 -> 43 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    42 -> 41 [xlabel="",tailport=e];
+    43 -> 44 [xlabel="",tailport=e];
+    45 -> 46 [xlabel="",tailport=e];
+    46 -> 48 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    48 -> 49 [xlabel="",tailport=e];
+    49 -> 50 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    52 -> 53 [xlabel="",tailport=e];
+    53 -> 56 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    53 -> 58 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    56 -> 57 [xlabel="",tailport=e];
+    58 -> 59 [xlabel="",tailport=e];
+    59 -> 60 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    59 -> 62 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    60 -> 61 [xlabel="",tailport=e];
+    62 -> 63 [xlabel="",tailport=e];
+    64 -> 65 [xlabel="",tailport=e];
+    68 -> 69 [xlabel="",tailport=e];
+    69 -> 70 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    70 -> 71 [xlabel="",tailport=e];
+    72 -> 73 [xlabel="",tailport=e];
+    74 -> 72 [xlabel=1
+             ,arrowhead=onone
+             ,headport=w];
+    76 -> 77 [xlabel="",tailport=e];
+    79 -> 80 [xlabel="",tailport=e];
+    85 -> 86 [xlabel="",tailport=e];
+    95 -> 96 [xlabel="",tailport=e];
+    98 -> 99 [xlabel="",tailport=e];
+    100 -> 101 [xlabel=""
+               ,tailport=e];
+    102 -> 103 [xlabel=""
+               ,tailport=e];
+    103 -> 106 [xlabel=1
+               ,arrowhead=onone
+               ,headport=w];
+    104 -> 102 [xlabel=1
+               ,arrowhead=onone
+               ,headport=w];
+    106 -> 107 [xlabel=""
+               ,tailport=e];
+    108 -> 106 [xlabel=1
+               ,arrowhead=onone
+               ,headport=w];
+    109 -> 110 [xlabel=""
+               ,tailport=e];
+    110 -> 111 [xlabel=1
+               ,arrowhead=onone
+               ,headport=w];
+}

log/aGeneratedRoomLayout

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

log/attemptedSeeds

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

log/treeCluster

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

package.yaml

@@ -6,9 +6,9 @@ author:              "Author name here"
 maintainer:          "example@example.com"
 copyright:           "2021 Author name here"
 
-# extra-source-files:
+extra-source-files:
-# - README.md
+- README.md
-# - ChangeLog.md
+- ChangeLog.md
 
 # Metadata used when publishing your package
 # synopsis:            A basic game loop

src/Dodge/Annotation.hs

@@ -0,0 +1,37 @@
+--{-# 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
+import Data.Maybe
+
+annoToRoomTree :: Annotation -> State (StdGen,Int) MTRS
+annoToRoomTree an = case an of
+    AnTree t -> zoom _1 t 
+    AnRoom r -> MTree "SingleRoom" . NodeTree . pure . (rmClusterStatus . csLinks . at OnwardCluster ?~ ())  <$> zoom _1 r <*> return []
+    OnwardList ans -> do
+        mts <- mapM annoToRoomTree ans
+        return $ foldr1 attachOnward' mts
+    IntAnno f -> do 
+        (g,i) <- get
+        put (g,i+1)
+        annoToRoomTree (f i)
+    ModifyTree f a -> f <$> annoToRoomTree a
+    PassthroughLockKeyLists ls ks i -> zoom _1 $ do
+        (functionlockroom,randomitemidentity) <- takeOne ls
+        lr <- functionlockroom i
+        ii <- randomitemidentity
+        keyroom <- fromJust $ lookup ii ks
+        return $ MTree ("PassthroughLockKeyLists-"++show ii) 
+            (NodeMTree $ MTree "RassThroughLockKeyLists" (NodeMTree lr) [MBranch (toLabel i) keyroom])
+            []
+

src/Dodge/Annotation/Data.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Annotation.Data where
+
+import Control.Lens
+import Control.Monad.State
+import Dodge.Data.GenWorld
+import Dodge.Data.MetaTree
+import System.Random
+
+type MTRS = MetaTree Room String
+
+data Annotation
+    = ModifyTree (MetaTree Room String -> MetaTree Room String) Annotation
+    | OnwardList [Annotation]
+    | IntAnno (Int -> Annotation)
+    | AnRoom (State StdGen Room)
+    | AnTree (State StdGen (MetaTree Room String))
+    | PassthroughLockKeyLists
+        [(Int -> State StdGen (MetaTree Room String), State StdGen ItemType)]
+        [(ItemType, State StdGen (MetaTree Room String))]
+        Int
+
+makeLenses ''Annotation

src/Dodge/AssignHotkey.hs

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

src/Dodge/Barreloid.hs

@@ -18,33 +18,30 @@ updateBarreloid = \case
     PlainBarrel -> updateBarrel
 
 updateExpBarrel :: [Point2] -> Creature -> World -> World
-updateExpBarrel ps cr w = case cr ^. crHP of
+updateExpBarrel ps cr w
-    HP x | x > 0 ->
+    | cr ^. crHP > 0 =
         w
             & hiss
             & cWorld . lWorld . creatures . ix (_crID cr) %~ damsToExpBarrel damages
-            & cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP
+            & cWorld . lWorld . creatures . ix (_crID cr) . crHP
                 -~ length (_piercedPoints . _barrelType $ _crType cr)
             & cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ mempty
             & flip (foldl' f) ps
-    HP _ ->
+    | otherwise =
         w
             & makeExplosionAt ((cr ^. crPos) `v2z` 20) 0
-            & cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
+            & cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-    _ -> w
   where
     f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos) (argV p) w'
     damages = cr ^. crDamage
     hiss
         | null ps = id
-        | otherwise = soundContinue 
+        | otherwise = soundContinue (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1)
-            (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1)
 
 updateBarrel :: Creature -> World -> World
-updateBarrel cr = case cr ^. crHP of
+updateBarrel cr
-    HP x | x > 0 -> doDamage (cr ^. crID)
+    | _crHP cr > 0 = doDamage (cr ^. crID)
-    HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
+    | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-    _ -> id
 
 damsToExpBarrel :: [Damage] -> Creature -> Creature
 damsToExpBarrel = flip $ foldl' damToExpBarrel
@@ -52,8 +49,8 @@ damsToExpBarrel = flip $ foldl' damToExpBarrel
 damToExpBarrel :: Creature -> Damage -> Creature
 damToExpBarrel cr dm = case dm of
     Piercing x p _ ->
-        cr & crHP . _HP -~ div x 200
+        cr & crHP -~ div x 200
             & crType . barrelType . piercedPoints .:~ (p - _crPos cr)
     Poison{} -> cr
     Sparking{} -> cr
-    _ -> cr & crHP . _HP -~ fromMaybe 0 (dm ^? dmAmount)
+    _ -> cr & crHP -~ fromMaybe 0 (dm ^? dmAmount)

src/Dodge/Base/CardinalPoint.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 module Dodge.Base.CardinalPoint where
 
 import Dodge.Data.Room
@@ -24,10 +23,3 @@ cardEightVec cp = case cp of
     SouthWest8 -> V2 (-1) (-1)
     West8 -> V2 (-1) 0
     NorthWest8 -> V2 (-1) 1
-
-cardinalBetweenAdj :: CardinalPointBetween -> (CardinalPoint,CardinalPoint)
-cardinalBetweenAdj = \case
-    NorthEast -> (North,East)
-    SouthEast -> (South,East)
-    SouthWest -> (South,West)
-    NorthWest -> (North,West)

src/Dodge/Base/Collide.hs

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

src/Dodge/Base/Coordinate.hs

@@ -1,4 +1,5 @@
 module Dodge.Base.Coordinate (
+    cartePosToScreen,
     worldPosToScreen,
     screenToWorldPos,
     mouseWorldPos,
@@ -6,9 +7,18 @@ module Dodge.Base.Coordinate (
 
 import Control.Lens
 import Dodge.Data.Camera
+import Dodge.Data.HUD
 import Dodge.Data.Input
 import Geometry
 
+---- | Transform coordinates from world position to screen coordinates.
+--worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
+--worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
+--  where
+--    doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)
+--    doZoom p = (w ^. cWorld . lWorld . wCam . cwcZoom) *.* p
+--    doRotate p = rotateV (negate (w ^. cWorld . lWorld . wCam . cwcRot)) p
+
 {- | Transform world coordinates to scaled screen coordinates.
  - These have to be scaled according to the size of the window to get actual screen positions.
  - This allows for line thicknesses etc to correspond to pixel sizes.
@@ -21,10 +31,33 @@ worldPosToScreen cam =
         . ((cam ^. camZoom) *.*)
         . (-.- (cam ^. camCenter))
 
+{- | Transform coordinates from the map position to screen
+coordinates.
+-}
+cartePosToScreen :: HUD -> Point2 -> Point2
+cartePosToScreen thehud = doRotate . doZoom . doTranslate
+  where
+    doTranslate p = p - (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
+    doZoom p = (thehud ^. carteZoom) *.* p
+    doRotate p = rotateV (negate $ thehud ^. carteRot) p
+
+--crToMousePosOffset :: Creature -> World -> (Point2, Float)
+--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
+
 -- | The mouse position in world coordinates.
 mouseWorldPos :: Input -> Camera -> Point2
 mouseWorldPos inp cam = screenToWorldPos cam (inp ^. mousePos)
 
 screenToWorldPos :: Camera -> Point2 -> Point2
-screenToWorldPos cam p =
+screenToWorldPos cam p = 
-    (cam ^. camCenter) + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
+    (cam ^. camCenter)
+        + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
+
+---- | The mouse position in map coordinates
+--mouseCartePos :: World -> Point2
+--mouseCartePos w = (thehud ^. carteCenter)
+--        +.+
+--        (1 / (thehud ^. carteZoom))
+--            *.* rotateV (thehud ^. carteRot) (_mousePos w)
+--  where
+--    thehud = w ^. cWorld . lWorld . hud

src/Dodge/Base/NewID.hs

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

src/Dodge/Base/Window.hs

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

src/Dodge/Base/You.hs

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

src/Dodge/BaseTriggerType.hs

@@ -62,7 +62,7 @@ heldTriggerType = \case
     GLAUNCHER -> SemiAutoTrigger 20
     POISONSPRAYER -> NoTrigger
     SHATTERGUN -> SemiAutoTrigger 20
-    LED -> NoTrigger
+    TORCH -> NoTrigger
     FLATSHIELD -> NoTrigger
     KEYCARD{} -> NoTrigger
     BLINKER -> SemiAutoTrigger 20

src/Dodge/Bullet.hs

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

src/Dodge/Bullet/Draw.hs

@@ -0,0 +1,14 @@
+module Dodge.Bullet.Draw (
+    drawBullet,
+) where
+
+import Dodge.Data.Bullet
+import Linear
+import Picture
+
+drawBullet :: Bullet -> Picture
+drawBullet pt =
+    setLayer BloomLayer
+        . setDepth 20
+        . color (V4 200 200 200 2)
+        $ thickLine 2 [_buOldPos pt, _buPos pt]

src/Dodge/Button/Draw.hs

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

src/Dodge/Button/Event.hs

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

src/Dodge/Cleat.hs

@@ -1,25 +1,25 @@
 --{-# LANGUAGE TupleSections #-}
-module Dodge.Cleat (
+module Dodge.Cleat 
-    toLabel,
+    ( toLabel
-    cleatOnward,
+    , cleatOnward
-    cleatSide,
+    , cleatSide
-    rToOnward,
+    , rToOnward
-    cleatLabel,
+    , cleatLabel
-) where
+    ) where
-
-import Control.Lens
-import qualified Data.Set as S
-import Data.Tree
 import Dodge.Data.GenWorld
 import Dodge.Tree.Compose
 
+import Data.Tree
+import Control.Lens
+import qualified Data.Set as S
+
 toLabel :: Int -> Room -> Maybe Room
 toLabel i rm
     | LabelCluster i `elem` rm ^?! rmClusterStatus . csLinks = Just rm
     | otherwise = Nothing
 
 rToOnward :: Monad m => String -> Tree Room -> m (MetaTree Room String)
-rToOnward s = return . tToBTree s
+rToOnward s t = return $ tToBTree s t
 
 cleatOnward :: Room -> Room
 cleatOnward = rmClusterStatus . csLinks .~ S.singleton OnwardCluster

src/Dodge/Clock.hs

@@ -1,4 +1,6 @@
-module Dodge.Clock (clockCycle) where
+module Dodge.Clock (
+    clockCycle,
+) where
 
 import Control.Lens
 import qualified Data.Vector as V

src/Dodge/Combine.hs

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

src/Dodge/Combine/Combinations.hs

@@ -108,8 +108,8 @@ itemCombinations =
            , po [cr MICROCHIP, cr TRANSMITTER, cr LIGHTSENSOR] (detector ITEMDETECTOR)
            , po [cr MICROCHIP, cr TRANSMITTER, cr SOUNDSENSOR] (detector WALLDETECTOR)
            , po [cr MICROCHIP, cr TRANSMITTER, cr HEATSENSOR] (detector CREATUREDETECTOR)
---           , po [AMMOMAG BATTERY, cr LED] torch
+           , po [AMMOMAG BATTERY, cr LED] torch
-           , po [hd LED, eq HAT] headLamp
+           , po [hd TORCH, eq HAT] headLamp
 --           , po [cr LIGHTER, cr THERMOMETER, cr MICROCHIP] (energyBallCraft IncBall)
 --           , po [cr TRANSFORMER, AMMOMAG BATTERY, cr MICROCHIP] (energyBallCraft TeslaBall)
            ]

src/Dodge/Concurrent.hs

@@ -59,7 +59,7 @@ loadingScreen str =
         { _scTitle = str
         , _scOptions = mempty
         , _scOffset = 0
-        , _scPositionedMenuOption = NoExtraMenuOption
+        , _scPositionedMenuOption = NoEscapeMenuOption
         , _scOptionFlag = LoadingScreen
         , _scSelectionList = mempty
         , _scAvailableLines = 0

src/Dodge/Config/Load.hs

@@ -0,0 +1,22 @@
+module Dodge.Config.Load (
+    loadDodgeConfig,
+) where
+
+import Data.Aeson
+import Dodge.Data.Config
+import System.Directory
+
+loadDodgeConfig :: IO Configuration
+loadDodgeConfig = do
+    fExists <- doesFileExist "data/dodge.config.json"
+    if fExists
+        then do
+            mayConfig <- decodeFileStrict "data/dodge.config.json"
+            case mayConfig of
+                Just config -> return config
+                Nothing -> do
+                    putStrLn "invalid data/dodge.config.json, loading defaults"
+                    return defaultConfig
+        else do
+            putStrLn "No data/data/dodge.config.json found, loading defaults"
+            return defaultConfig

src/Dodge/Config/Update.hs

@@ -1,50 +1,33 @@
 {- |
 IO actions that apply config side effects and save configuration settings to disk.
 -}
-module Dodge.Config (
+module Dodge.Config.Update (
     saveConfig,
     applyWorldConfig,
     setVol,
-    loadDodgeConfig,
 ) where
 
-import Data.Aeson
 import qualified Data.Aeson.Encode.Pretty as AEP
 import qualified Data.ByteString.Lazy as BS
 import Data.Preload
 import Dodge.Data.Config
 import Preload.Update
 import Sound
-import System.Directory
 
 {- |
 Write the current world configuration to disk as a json file.
 -}
-saveConfig :: Config -> (a -> IO a) -> a -> IO a
+saveConfig :: Configuration -> (a -> IO a) -> a -> IO a
 saveConfig cfig f x = do
-    createDirectoryIfMissing True "generated"
+--    putStrLn "Saving config to data/dodge.config.json"
-    BS.writeFile "generated/config.json" $
+    BS.writeFile "data/dodge.config.json" $
         AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) cfig
     f x
 
-loadDodgeConfig :: IO Config
-loadDodgeConfig = do
-    fExists <- doesFileExist "generated/config.json"
-    if fExists
-        then do
-            mconfig <- decodeFileStrict "generated/config.json"
-            maybe
-                (failstr "invalid generate/config.json, loading defaults")
-                return
-                mconfig
-        else failstr "No generated/config.json found, loading defaults"
-  where
-    failstr s = putStrLn s >> return defaultConfig
-
 {- |
 Apply the volume settings from the world configuration to the running game.
 -}
-setVol :: Config -> IO ()
+setVol :: Configuration -> IO ()
 setVol cfig = do
     setSoundVolume (_volume_master cfig * _volume_sound cfig)
     setMusicVolume (_volume_master cfig * _volume_music cfig)
@@ -53,7 +36,7 @@ setVol cfig = do
 Apply /all/ of the values in the world configuration to the running game.
 -}
 applyWorldConfig ::
-    Config ->
+    Configuration ->
     PreloadData ->
     IO PreloadData
 applyWorldConfig cfig pdata = do

src/Dodge/Corpse/Draw.hs

@@ -0,0 +1,7 @@
+module Dodge.Corpse.Draw where
+import Dodge.Data.Corpse
+import ShapePicture
+
+-- not currently used, too simple
+drawCorpse :: Corpse -> SPic
+drawCorpse = _cpSPic

src/Dodge/Corpse/Make.hs

@@ -1,25 +1,43 @@
 module Dodge.Corpse.Make (makeCorpse) where
 
-import Control.Lens
-import Dodge.Creature.Picture
 import Dodge.Creature.Radius
 import Dodge.Creature.Shape
---import Dodge.Data.Corpse
+import Control.Lens
+import Dodge.Creature.Picture
+import Dodge.Data.Corpse
 import Dodge.Data.Creature
 import Geometry
 import Shape
 import ShapePicture
 
-makeCorpse :: Creature -> SPic
+makeCorpse :: Creature -> Corpse
-makeCorpse cr =
+makeCorpse = makeDefaultCorpse
-    noPic
+
-        . scaleSH (V3 crsize crsize crsize)
+makeDefaultCorpse :: Creature -> Corpse
-        $ mconcat
+makeDefaultCorpse cr =
-            [ colorSH (_skinHead cskin) $ deadScalp cr
+    defaultCorpse
-            , colorSH (_skinUpper cskin) $ deadUpperBody cr
+        & cpPos .~ _crPos cr
-            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+        & cpDir .~ _crDir cr
-            ]
+        & cpSPic
+            .~ noPic
+                ( scaleSH (V3 crsize crsize crsize) $
+                    mconcat
+                        [ colorSH (_skinHead cskin) $ deadScalp cr
+                        , colorSH (_skinUpper cskin) $ deadUpperBody cr
+                        , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
+                        ]
+                )
   where
     cskin = crShape $ _crType cr -- this should be fixed
     crsize = 0.1 * crRad (cr ^. crType)
     rotmdir = rotateSH (_crMvDir cr - _crDir cr)
+
+defaultCorpse :: Corpse
+defaultCorpse =
+    Corpse
+        { _cpID = 0
+        , _cpPos = 0
+        , _cpDir = 0
+        , _cpSPic = mempty
+        , _cpRes = NoResurrection
+        }

src/Dodge/Creature.hs

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

src/Dodge/Creature/Action.hs

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

src/Dodge/Creature/ArmourChase.hs

@@ -3,23 +3,23 @@ module Dodge.Creature.ArmourChase (
     flockArmourChaseCrit,
 ) where
 
---import Dodge.Data.Equipment.Misc
+import Dodge.Data.Equipment.Misc
---import Control.Lens
+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 = HP 300
+        , _crHP = 300
-        , _crInv = mempty
+        , _crInv =
---            IM.fromList
+            IM.fromList
---                [ --(0, frontArmour)
+                [ (0, frontArmour)
---                ]
+                ]
         , _crActionPlan =
             ActionPlan
                 { _apImpulse = []
@@ -36,11 +36,11 @@ armourChaseCrit :: Creature
 armourChaseCrit =
     chaseCrit
         { _crName = "armourChaseCrit"
---        , --, _crUpdate = defaultImpulsive []
+        , --, _crUpdate = defaultImpulsive []
---          _crInv =
+          _crInv =
---            IM.fromList
+            IM.fromList
---                [ --(0, frontArmour)
+                [ (0, frontArmour)
---                ]
+                ]
 --        , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
         }
---        & crEquipment . at OnChest ?~ 0
+        & 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 = HP 300
+        , _crHP = 300
 --        , _crMvType = defaultAimMvType
         }
 --        & crType . skinUpper .~ lightx4 red

src/Dodge/Creature/ChaseCrit.hs

@@ -4,31 +4,31 @@ 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
 smallChaseCrit =
     chaseCrit
-        { _crHP = HP 1
+        { _crHP = 1
         , _crInv = mempty
         }
 
 invisibleChaseCrit :: Creature
 invisibleChaseCrit =
     chaseCrit
---        & crInv . at 0 ?~ wristInvisibility
+        & crInv . at 0 ?~ wristInvisibility
---        & crEquipment . at OnLeftWrist ?~ 0
+        & crEquipment . at OnLeftWrist ?~ 0
 
 chaseCrit :: Creature
 chaseCrit =
     defaultCreature
         { _crName = "chaseCrit"
-        , _crHP = HP 150
+        , _crHP = 150
         , _crInv = mempty
         , _crFaction = ColorFaction green
         , _crVocalization = chaseCritVocalization

src/Dodge/Creature/Damage.hs

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

src/Dodge/Creature/HandPos.hs

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

src/Dodge/Creature/Impulse.hs

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

src/Dodge/Creature/Impulse/Movement.hs

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

src/Dodge/Creature/Impulse/UseItem.hs

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

src/Dodge/Creature/Inanimate.hs

@@ -11,22 +11,22 @@ 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
 barrel =
     defaultInanimate
-        { _crHP = HP 500
+        { _crHP = 500
         , _crType = BarrelCrit PlainBarrel
---        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 
 explosiveBarrel :: Creature
 explosiveBarrel =
     defaultInanimate
-        { _crHP = HP 400
+        { _crHP = 400
         , _crType = BarrelCrit (ExplosiveBarrel [])
---        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
+        , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
         }
 --        & crMaterial .~ Crystal

src/Dodge/Creature/Lamp.hs

@@ -13,7 +13,7 @@ colorLamp ::
     Creature
 colorLamp col h =
     defaultInanimate
-        { _crHP = HP 100
+        { _crHP = 100
         , _crType = LampCrit h col Nothing
 --        , _crRad = 3
         }

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 = HP 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 = HP 500
+        , _crHP = 500
         }
 --        & crType .~ LtAutoCrit
 --        & crType . humanoidAI .~ LtAutoAI

src/Dodge/Creature/Picture.hs

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

src/Dodge/Creature/PistolCrit.hs

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

src/Dodge/Creature/SpreadGunCrit.hs

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

src/Dodge/Creature/State.hs

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

src/Dodge/Creature/Statistics.hs

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

src/Dodge/Creature/SwarmCrit.hs

@@ -10,7 +10,7 @@ import Picture
 swarmCrit :: Creature
 swarmCrit =
     defaultCreature
-        { _crHP = HP 1
+        { _crHP = 1
 --        , _crRad = 2
         , _crFaction = ColorFaction yellow
         }

src/Dodge/Creature/Test.hs

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

src/Dodge/Creature/Update.hs

@@ -1,11 +1,10 @@
 module Dodge.Creature.Update (updateCreature) where
 
-import NewInt
 import Color
 import qualified Data.IntMap.Strict as IM
 import qualified Data.List as List
 import Dodge.Barreloid
---import Dodge.Base.NewID
+import Dodge.Base.NewID
 import Dodge.Corpse.Make
 import Dodge.Creature.Action
 import Dodge.Creature.Radius
@@ -30,8 +29,7 @@ import ShapePicture.Data
 -- allow for knockbacks etc to be determined as well as intended movements
 updateCreature :: Creature -> World -> World
 updateCreature cr
-    | null (cr ^? crHP . _HP) = id
+    | _crZ cr < negate 100 = (tocr . crHP .~ negate 1) . destroyAllInvItems cr
-    | _crZ cr < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
     | _crZ cr < 0 = (tocr . crZVel -~ 0.5) . (tocr . crZ +~ _crZVel cr)
     | otherwise = updateCreature' cr
   where
@@ -63,59 +61,51 @@ 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
 checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
 
 checkDeath' :: Creature -> World -> World
-checkDeath' cr w = case cr ^. crHP of
+checkDeath' cr w
-    HP x | x > 0 -> w & tocr . crDamage .~ []
+    | _crHP cr > 0 = w & tocr . crDamage .~ []
-    HP x | x > -200 && _crDeathTimer cr < 5 -> w
+    | _crHP cr <= -200 = w
-            & tocr . crDamage .~ []
-            & tocr . crDeathTimer +~ 1
-    HP x | x > -200 -> w
             & dropAll cr -- the order of
---            & removecr -- these is important
+            & destroyCreature cr -- these is important
-            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
-            & corpseOrGib cr
-    HP _ -> w
-            & dropAll cr -- the order of
-            & tocr . crHP .~ CrIsGibs
---            & destroyCreature cr -- these is important
             & stopSoundFrom (CrWeaponSound (_crID cr) 0)
             & addCrGibs cr
-    _ -> w 
+    | _crHP cr > -200 && _crDeathTimer cr < 5 = w
---    | otherwise = w
+            & tocr . crDamage .~ []
---            & dropAll cr -- the order of
+            & tocr . crDeathTimer +~ 1
---            & removecr -- these is important
+    | otherwise = w
---            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
+            & dropAll cr -- the order of
---            & corpseOrGib cr
+            & removecr -- these is important
+            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
+            & corpseOrGib cr
   where
     tocr = cWorld . lWorld . creatures . ix (_crID cr)
---    removecr
+    removecr
---        | _crID cr == 0 = id
+        | _crID cr == 0 = id
---        -- hack to get around player creature being killed but left with more than 0 hp
+        -- hack to get around player creature being killed but left with more than 0 hp
---        | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
+        | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
 
---destroyCreature :: Creature -> World -> World
+destroyCreature :: Creature -> World -> World
---destroyCreature cr
+destroyCreature cr
---    | _crID cr == 0 = id
+    | _crID cr == 0 = id
---    --                 cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
+    --                 cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
---    -- hack to get around player creature being killed but left with more than 0 hp
+    -- hack to get around player creature being killed but left with more than 0 hp
---    | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
+    | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
 
 -- could look at the amount of damage here (given by maxDamage) too
 corpseOrGib :: Creature -> World -> World
-corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
+corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
-    Just CookingDamage -> sethp (CrIsCorpse $ scorchSPic thecorpse)
+    Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
-    Just PoisonDamage -> sethp (CrIsCorpse $ poisonSPic thecorpse)
+    Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
     Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
-         . sethp CrIsGibs
+    _ -> addcorpse thecorpse
-    _ -> sethp (CrIsCorpse thecorpse)
   where
-    sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
+    addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
     thecorpse = makeCorpse cr
 
 scorchSPic :: SPic -> SPic
@@ -126,7 +116,7 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 
 -- reverse keys, otherwise two or more inv items will cause errors
 dropAll :: Creature -> World -> World
-dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
 
 chasmTest :: Creature -> World -> World
 chasmTest cr w

src/Dodge/Creature/Volition.hs

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

src/Dodge/Creature/YourControl.hs

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

src/Dodge/Data/AimStance.hs

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

src/Dodge/Data/Button.hs

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

src/Dodge/Data/CardinalPoint.hs

@@ -1,6 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
 module Dodge.Data.CardinalPoint where
-import Control.Lens
 
 data CardinalPoint
     = North
@@ -9,13 +7,6 @@ data CardinalPoint
     | West
     deriving (Eq, Ord, Show, Bounded, Enum)
 
-data CardinalPointBetween
-    = NorthEast
-    | SouthEast
-    | SouthWest
-    | NorthWest
-    deriving (Eq, Ord, Show, Bounded, Enum)
-
 data CardinalEightPoint
     = North8
     | NorthEast8
@@ -32,8 +23,3 @@ data CardinalCover
     | NSE
     | NSW
     | NS
-
-data XInfinity a = NegInf | NonInf {_nonInf :: a} | PosInf
-    deriving (Eq, Ord, Show)
-
-makeLenses ''XInfinity

src/Dodge/Data/Combine.hs

@@ -1,13 +1,9 @@
 {-# LANGUAGE TemplateHaskell #-}
-
 module Dodge.Data.Combine where
-
 import Control.Lens
 import Dodge.Data.Item
-
+data CombinableItem = CombinableItem
-data CombItem = CombItem
     { _ciInvIDs :: [Int]
     , _ciItem :: Item
     }
-
+makeLenses ''CombinableItem
-makeLenses ''CombItem

src/Dodge/Data/Config.hs

@@ -12,30 +12,30 @@ import qualified Data.Set as S
 {-# ANN module "HLint: ignore Use camelCase" #-}
 
 data NumShadowCasters
-    = NumLight0
+    = NumShadowCasters0
-    | NumLight1
+    | NumShadowCasters1
-    | NumLight2
+    | NumShadowCasters2
-    | NumLight3
+    | NumShadowCasters3
-    | NumLight4
+    | NumShadowCasters4
-    | NumLight5
+    | NumShadowCasters5
-    | NumLight6
+    | NumShadowCasters6
-    | NumLight7
+    | NumShadowCasters7
-    | NumLight8
+    | NumShadowCasters8
-    | NumLight9
+    | NumShadowCasters9
-    | NumLight10
+    | NumShadowCasters10
-    | NumLight11
+    | NumShadowCasters11
-    | NumLight12
+    | NumShadowCasters12
-    | NumLight13
+    | NumShadowCasters13
-    | NumLight14
+    | NumShadowCasters14
-    | NumLight15
+    | NumShadowCasters15
-    | NumLight16
+    | NumShadowCasters16
-    | NumLight17
+    | NumShadowCasters17
-    | NumLight18
+    | NumShadowCasters18
-    | NumLight19
+    | NumShadowCasters19
-    | NumLight20
+    | NumShadowCasters20
     deriving (Show,Eq,Bounded,Ord,Enum)
 
-data Config = Config
+data Configuration = Configuration
     { _volume_master :: Float
     , _volume_sound :: Float
     , _volume_music :: Float
@@ -58,9 +58,9 @@ data Config = Config
     }
     deriving (Show)
 
-windowXFloat :: Config -> Float
+windowXFloat :: Configuration -> Float
 windowXFloat = fromIntegral . _windowX
-windowYFloat :: Config -> Float
+windowYFloat :: Configuration -> Float
 windowYFloat = fromIntegral . _windowY
 
 data DebugBool
@@ -88,8 +88,8 @@ data DebugBool
     | Show_walls_near_point_you
     | Show_walls_near_segment
     | Show_zone_near_point_cursor
-    | Show_zone_circ
     | Inspect_wall
+    | Show_nodes_near_select
     | Show_path_between
     | Select_creature
     deriving (Eq, Ord, Bounded, Enum, Show)
@@ -124,9 +124,9 @@ applyResFactor  rf = case rf of
 --    EighthRes -> 8
 --    SixteenthRes -> 16
 
-defaultConfig :: Config
+defaultConfig :: Configuration
 defaultConfig =
-    Config
+    Configuration
         { _volume_master = 1
         , _volume_sound = 1
         , _volume_music = 0
@@ -148,13 +148,13 @@ defaultConfig =
         , _debug_view_clip_bounds = NoRoomClipBoundaries
         }
 
-debugOn :: DebugBool -> Config -> Bool
+debugOn :: DebugBool -> Configuration -> Bool
 debugOn db = S.member db . _debug_booleans
 
-makeLenses ''Config
+makeLenses ''Configuration
 deriveJSON defaultOptions ''NumShadowCasters
 deriveJSON defaultOptions ''ResFactor
 deriveJSON defaultOptions ''ShadowRendering
 deriveJSON defaultOptions ''RoomClipping
 deriveJSON defaultOptions ''DebugBool
-deriveJSON defaultOptions ''Config
+deriveJSON defaultOptions ''Configuration

src/Dodge/Data/Corpse.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Corpse where
+
+import Control.Lens
+import Data.Aeson
+import Data.Aeson.TH
+import Geometry.Data
+import ShapePicture.Data
+
+data CorpseResurrection = NoResurrection
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+data Corpse = Corpse
+    { _cpID :: Int
+    , _cpPos :: Point2
+    , _cpDir :: Float
+    , _cpSPic :: SPic
+    , _cpRes :: CorpseResurrection
+    }
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+makeLenses ''Corpse
+deriveJSON defaultOptions ''CorpseResurrection
+deriveJSON defaultOptions ''Corpse

src/Dodge/Data/Creature.hs

@@ -17,8 +17,6 @@ module Dodge.Data.Creature (
     module Dodge.Data.Item.Use.Consumption.LoadAction,
 ) where
 
-import ShapePicture.Data
-import NewInt
 import Dodge.Data.Item.Use.Consumption.LoadAction
 import Dodge.Data.Equipment.Misc
 import Control.Lens
@@ -34,7 +32,7 @@ import Dodge.Data.Creature.State
 import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
---import qualified IntMapHelp as IM
+import qualified IntMapHelp as IM
 
 data Creature = Creature
     { _crPos :: Point2
@@ -46,10 +44,10 @@ data Creature = Creature
     , _crMvAim :: Float
     , _crType :: CreatureType
     , _crID :: Int
-    , _crHP :: CrHP
+    , _crHP :: Int
-    , _crInv :: NewIntMap InvInt Int
+    , _crInv :: IM.IntMap Item
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite (NewInt ItmInt)
+    , _crEquipment :: M.Map EquipSite Int
     , _crDamage :: [Damage]
     , _crPain :: Int
     , _crStance :: Stance
@@ -67,12 +65,6 @@ data Creature = Creature
 
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data CrHP
-    = HP Int
-    | CrIsCorpse SPic
-    | CrIsGibs
-    | CrIsPitted
-
 data Intention = Intention
     { _targetCr :: Maybe Creature
     , _mvToPoint :: Maybe Point2
@@ -83,12 +75,10 @@ data Intention = Intention
 
 makeLenses ''Creature
 makeLenses ''Intention
-makePrisms ''CrHP
 
 concat
     <$> mapM
         (deriveJSON defaultOptions)
         [ ''Creature
         , ''Intention
-        , ''CrHP
         ]

src/Dodge/Data/Creature/Stance.hs

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

src/Dodge/Data/EquipType.hs

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

src/Dodge/Data/Equipment/Misc.hs

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

src/Dodge/Data/FloorItem.hs

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

src/Dodge/Data/GenParams.hs

@@ -5,7 +5,7 @@
 
 module Dodge.Data.GenParams where
 
-import Dodge.Data.Machine.Sensor
+import Dodge.Data.Machine.Sensor.Type
 import Color
 import Control.Lens
 import Data.Aeson

src/Dodge/Data/GenWorld.hs

@@ -8,7 +8,6 @@ module Dodge.Data.GenWorld (
     module Dodge.Data.World,
 ) where
 
-import ShortShow
 import Color
 import Control.Lens
 import Control.Monad.State
@@ -23,20 +22,14 @@ import System.Random
 
 data GenWorld = GenWorld
     { _gwWorld :: World
+    , _genPlacements :: IM.IntMap [(Placement, Int)]
     , _genRooms :: IM.IntMap Room
-    , _genPmnt :: IM.IntMap Placement
-    , _genInts :: IM.IntMap Int
     }
 
 ---- ROOM DATATYPES
 data PSType
     = PutCrit {_unPutCrit :: Creature}
-    | PutMachine
+    | PutMachine {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
-        { _putMachinePoly :: [Point2]
-        , _putMachineMachine :: Machine
-        , _putMachineWall :: Wall
-        , _putMachineMaybeItem :: Maybe Item
-        }
     | PutLS LightSource
     | PutButton {_putButton :: Button}
     | PutProp Prop
@@ -58,38 +51,11 @@ data PSType
     | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
     | RandPS (State StdGen PSType)
     | PutForeground ForegroundShape
-    | PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
+    | PutWorldUpdate (PlacementSpot -> World -> World)
     | PutNothing
+    | PutUsingGenParams (World -> (World, PSType))
     | PutID {_putID :: Int}
     | PutChasm {_putChasmPoly :: [Point2]}
-    | PutLabel {_putLabel :: String} -- currently not actually put anywhere
-        -- just used for later inspection as top level 
-        -- of a continuing placement in a room placement list
-
-instance ShortShow PSType where
-    shortShow PutCrit {} = "PutCrit"
-    shortShow PutMachine {} = "PutMachine"
-    shortShow PutLS {} = "PutLS"
-    shortShow PutButton {} = "PutButton"
-    shortShow PutProp {} = "PutProp"
-    shortShow PutTerminal {} = "PutTerminal"
-    shortShow PutFlIt {} = "PutFlIt"
-    shortShow PutPPlate {} = "PutPPlate"
-    shortShow PutBlock {} = "PutBlock"
-    shortShow PutCoord {} = "PutCoord"
-    shortShow PutMod {} = "PutMod"
-    shortShow PutTrigger {} = "PutTrigger"
-    shortShow PutLineBlock {} = "PutLineBlock"
-    shortShow PutWall {} = "PutWall"
-    shortShow PutSlideDr {} = "PutSlideDr"
-    shortShow PutDoor {} = "PutDoor"
-    shortShow RandPS {} = "RandPS"
-    shortShow PutForeground {} = "PutForeground"
-    shortShow PutWorldUpdate {} = "PutWorldUpdate"
-    shortShow PutNothing = "PutNothing"
-    shortShow PutID {} = "PutID"
-    shortShow PutChasm {} = "PutChasm"
-    shortShow PutLabel {} = "PutLabel"
 
 -- maybe there is a monadic implementation of this?
 -- add room effect for any placement spot?
@@ -107,13 +73,17 @@ data PlacementSpot
         }
 
 -- TODO attempt to unify/simplify this union type
-data Placement = Placement
+data Placement
-    { _plSpot :: PlacementSpot
+    = Placement
-    , _plType :: PSType
+        { _plOrder :: Int
-    , _plMID :: Maybe Int
+        , _plSpot :: PlacementSpot
-    , _plExternalID :: Maybe Int
+        , _plType :: PSType
-    , _plIDCont :: GenWorld -> Placement -> Maybe Placement
+        , _plMID :: Maybe Int
-    }
+        , _plIDCont :: World -> Placement -> Maybe Placement
+        }
+    | PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
+    | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
+    | PickOnePlacement Int Placement
 
 {- The '_rmPolys' lists which polygons should be cut out to form the indestructible walls of the room.
 Link pairs contain a position and rotation to attach to another room;
@@ -136,7 +106,8 @@ data Room = Room
     , _rmPos :: [RoomPos]
     , _rmPath :: S.Set (Point2, Point2)
     , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [(Int,GenWorld -> Placement)]
+    , _rmInPmnt :: [InPlacement]
+    , _rmOutPmnt :: [OutPlacement]
     , _rmBound :: [[Point2]]
     , _rmFloor :: Floor
     , _rmName :: String
@@ -153,6 +124,16 @@ data Room = Room
     , _rmClusterStatus :: ClusterStatus
     }
 
+data OutPlacement = OutPlacement
+    { _opPlacement :: Placement
+    , _opPlacementID :: Int
+    }
+
+data InPlacement = InPlacement
+    { _ipPlacement :: [Placement] -> Placement
+    , _ipPlacementID :: Int
+    }
+
 makeLenses ''GenWorld
 makeLenses ''Room
 makeLenses ''RoomType

src/Dodge/Data/HUD.hs

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

src/Dodge/Data/Input.hs

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

src/Dodge/Data/Item.hs

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

@@ -75,6 +75,7 @@ data CraftType
     | AIUNIT
     | CAMERA
     | MINIDISPLAY -- visual display unit
+    | LED
     | NAILBOX
     | IRONBAR
     | LIGHTSENSOR
@@ -172,7 +173,7 @@ data HeldItemType
     | GLAUNCHER
     | POISONSPRAYER
     | SHATTERGUN
-    | LED
+    | TORCH
     | FLATSHIELD
     | KEYCARD Int
     | BLINKER

src/Dodge/Data/Item/Location.hs

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

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

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

src/Dodge/Data/LWorld.hs

@@ -11,6 +11,7 @@ module Dodge.Data.LWorld (
     module Dodge.Data.Bullet,
     module Dodge.Data.Button,
     module Dodge.Data.Cloud,
+    module Dodge.Data.Corpse,
     module Dodge.Data.CrGroupParams,
     module Dodge.Data.Creature,
     module Dodge.Data.Damage,
@@ -59,6 +60,7 @@ import Dodge.Data.Bounds
 import Dodge.Data.Bullet
 import Dodge.Data.Button
 import Dodge.Data.Cloud
+import Dodge.Data.Corpse
 import Dodge.Data.CrGroupParams
 import Dodge.Data.Creature
 import Dodge.Data.Damage
@@ -97,7 +99,7 @@ import Picture.Data
 data LWorld = LWorld
     { _creatures :: IM.IntMap Creature
     , _creatureGroups :: IM.IntMap CrGroupParams
-    , _items :: IM.IntMap Item
+    , _itemLocations :: IM.IntMap ItemLocation
     , _clouds :: [Cloud]
     , _dusts :: [Dust]
     , _gusts :: IM.IntMap Gust
@@ -127,14 +129,16 @@ data LWorld = LWorld
     , _oldMagnets :: [Magnet]
     , _magnets :: [Magnet]
     , _blocks :: IM.IntMap Block
+    , _coordinates :: IM.IntMap Point2
     , _triggers :: IM.IntMap Bool
-    , _floorItems :: IM.IntMap FloorItem
+    , _floorItems :: NewIntMap FloorInt FloorItem
     , _modifications :: IM.IntMap Modification
     , _worldEvents :: [WdWd]
     , _delayedEvents :: [(Int, WdWd)]
     , _pressPlates :: IM.IntMap PressPlate
     , _buttons :: IM.IntMap Button
-    , _foreShapes :: IM.IntMap ForegroundShape
+    , _foregroundShapes :: IM.IntMap ForegroundShape
+    , _corpses :: IM.IntMap Corpse
     , _lightSources :: IM.IntMap LightSource
     , _lights :: [LSParam]
     , _seenLocations :: IM.IntMap (WdP2, String)

src/Dodge/Data/MTRS.hs

@@ -1,6 +0,0 @@
-module Dodge.Data.MTRS where
-
-import Dodge.Data.GenWorld
-import Dodge.Data.MetaTree
-
-type MTRS = MetaTree Room String

src/Dodge/Data/Machine.hs

@@ -26,6 +26,7 @@ import Dodge.Data.Machine.Sensor
 import Dodge.Data.Material
 import Dodge.Data.ObjectType
 import Geometry.Data
+import Sound.Data
 
 data Machine = Machine
     { _mcID :: Int
@@ -38,22 +39,29 @@ data Machine = Machine
     , _mcDamage :: [Damage]
     , _mcType :: MachineType
     , _mcMounts :: M.Map ObjectType Int
+    , _mcName :: String
+    , _mcCloseSound :: Maybe SoundID
     , _mcWidth :: Float
     }
+    --deriving (Eq, Show, Read) --, Generic)
+    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data MachineType
     = McStatic
     | McTerminal
-    | McDamSensor DamageSensor
+    | McSensor Sensor
-    | McProxSensor ProximitySensor
     | McTurret {_mctTurret :: Turret}
+    --deriving (Eq, Show, Read) --, Generic)
+    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data Turret = Turret
-    { _tuWeapon :: Int
+    { _tuWeapon :: Item
     , _tuTurnSpeed :: Float
     , _tuFireTime :: Int
     , _tuDir :: Float
     }
+    --deriving (Eq, Show, Read) --, Generic)
+    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 makeLenses ''MachineType
 makeLenses ''Machine

src/Dodge/Data/Machine/Sensor.hs

@@ -3,52 +3,51 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Machine.Sensor where
+module Dodge.Data.Machine.Sensor (
+    module Dodge.Data.Machine.Sensor,
+    module Dodge.Data.Machine.Sensor.Type,
+) where
 
+import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
+import Dodge.Data.GenParams
 import Dodge.Data.Item.Combine
-import Geometry.Data
+import Dodge.Data.Machine.Sensor.Type
 
-data SensorType
+data Sensor
-    = LaserSensor
+    = DamageSensor
-    | ElectricSensor
+        { _sensToggle :: Bool
-    | ThermalSensor
+        , _sensAmount :: Int
-    | PhysicalSensor
+        , _sensType :: SensorType
-    deriving (Eq, Ord, Show, Read, Bounded, Enum)
+        , _sensDraw :: (PaletteColor, DecorationShape)
+        , _sensThreshold :: Int
+        }
+    | ProximitySensor
+        { _proxStatus :: CloseToggle
+        , _proxDist :: Float
+        , _proxRequirement :: ProximityRequirement
+        , _sensToggle :: Bool
+        }
 
-data DamageSensor = DamSensor
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
-    { _sensAmount :: Int
-    , _sensType :: SensorType
-    , _sensThreshold :: Int
-    }
-
-data ProximitySensor = ProxSensor
-    { _proxSensorType :: ProximitySensorType
-    , _proxToggle :: Maybe Bool
-    }
-
-data ProximitySensorType
-    = SensorWithRequirement ProximityRequirement
-    | NoItemZone [Point2]
 
 data ProximityRequirement
     = RequireHealth {_proxReqMinHealth :: Int}
     | RequireEquipment {_proxReqEquipment :: ItemType}
-    | RequireDeadCreatures {_proxReqDead :: [Int]}
+    | RequireImpossible
     deriving (Show)
 
-makeLenses ''DamageSensor
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
-makeLenses ''ProximitySensor
+
-makeLenses ''ProximitySensorType
+data CloseToggle = NotClose | IsClose
-makePrisms ''ProximityRequirement
+    deriving (Show)
-deriveJSON defaultOptions ''SensorType
+
+--deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
+makeLenses ''Sensor
+makeLenses ''ProximityRequirement
 deriveJSON defaultOptions ''ProximityRequirement
-deriveJSON defaultOptions ''ProximitySensorType
+deriveJSON defaultOptions ''CloseToggle
-deriveJSON defaultOptions ''ProximitySensor
+deriveJSON defaultOptions ''Sensor
-deriveJSON defaultOptions ''DamageSensor
-
-instance ToJSONKey SensorType
-
-instance FromJSONKey SensorType

src/Dodge/Data/Machine/Sensor/Type.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Dodge.Data.Machine.Sensor.Type where
+
+import Data.Aeson
+import Data.Aeson.TH
+
+data SensorType
+    = LaserSensor
+    | ElectricSensor
+    | ThermalSensor
+    | PhysicalSensor
+    deriving (Eq, Ord, Show, Read, Bounded, Enum)
+
+deriveJSON defaultOptions ''SensorType
+
+instance ToJSONKey SensorType
+
+instance FromJSONKey SensorType

src/Dodge/Data/MetaTree.hs

@@ -5,8 +5,6 @@ module Dodge.Data.MetaTree where
 
 import Control.Lens
 import Data.Tree
-import System.Random
-import Control.Monad.State
 
 data MetaTree a b = MTree
     {_mtLabel :: b, _mtTree :: MetaNode a b, _mtBranches :: [MetaBranch a b]}
@@ -25,23 +23,3 @@ makeLenses ''MetaNode
 
 instance Functor (MetaTree a) where
     fmap f (MTree b mn bs) = MTree (f b) (mn & nodeMetaTree %~ fmap f) (map (mbTree %~ fmap f) bs)
-
-data LayoutVars = LayVars
-    { _lyGen :: StdGen
-    , _lyCounter :: Int
-    }
-
-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/Data/RightButtonOptions.hs

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

src/Dodge/Data/Room.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE LambdaCase #-}
 
 module Dodge.Data.Room (
     module Dodge.Data.Room,
@@ -15,9 +14,9 @@ import Geometry
 data RoomPos = RoomPos
     { _rpPos :: Point2
     , _rpDir :: Float
-    , _rpFlags :: S.Set RoomPosFlag
+    , _rpType :: S.Set RoomPosType
-    , _rpType :: RPLinkStatus
+    , _rpLinkStatus :: RPLinkStatus
-    , _rpPlacementUse :: S.Set UsedPos
+    , _rpPlacementUse :: Int
     }
     deriving (Eq, Ord, Show)
 
@@ -44,7 +43,6 @@ data RoomLinkType
     = OutLink
     | InLink
     | LabLink Int
-    | PolyEdge Int
     | OnEdge CardinalPoint
     | FromEdge CardinalPoint Int
     | BlockedLink
@@ -54,7 +52,6 @@ data RoomWire
     = --RoomWire Point2 Float
       WallWire Point2 Float Float
 
--- the link constructors should probably be combined in some way
 data RPLinkStatus
     = UsedOutLink
         { _rplsType :: S.Set RoomLinkType
@@ -66,30 +63,20 @@ data RPLinkStatus
         , _rplsInRoomID :: Int
         }
     | UnusedLink {_rplsType :: S.Set RoomLinkType}
-    | NotLink {_rpOnPath :: Bool}
+    | NotLink
     deriving (Eq, Ord, Show)
 
-notLink :: RPLinkStatus -> Bool
-notLink = \case
-    NotLink {} -> True
-    _ -> False
-
 data PathFromEdge = PathFromEdge CardinalPoint Int
     deriving (Eq, Ord, Show)
 
-data RoomPosFlag
+data RoomPosType
-    = RoomPosOnGrid {_onGridFromEdges :: S.Set PathFromEdge}
+    = RoomPosOnPath {_onPathFromEdges :: S.Set PathFromEdge}
-    | RoomPosOffGrid {_offGridFromEdges :: S.Set PathFromEdge}
+    | RoomPosOffPath {_offPathFromEdges :: S.Set PathFromEdge}
-    deriving (Eq, Ord, Show)
+    | RoomPosExLink
-
+    | RoomPosLab Int
-data UsedPos
-    = UsedPosLow
-    | UsedPosMid
-    | UsedPosHigh
-    | UsedPosFloor
     deriving (Eq, Ord, Show)
 
 makeLenses ''RoomLink
 makeLenses ''RoomPos
-makeLenses ''RoomPosFlag
+makeLenses ''RoomPosType
 makeLenses ''RPLinkStatus

src/Dodge/Data/RoomCluster.hs

@@ -6,8 +6,9 @@ module Dodge.Data.RoomCluster where
 import Control.Lens
 import qualified Data.Set as S
 
-newtype ClusterStatus = ClusterStatus
+data ClusterStatus = ClusterStatus
-    { _csLinks :: S.Set ClusterLink
+    { _csName :: String
+    , _csLinks :: S.Set ClusterLink
     }
 
 data ClusterLink = OnwardCluster | SideCluster | LabelCluster Int

src/Dodge/Data/SelectionList.hs

@@ -17,7 +17,7 @@ data ListDisplayParams = ListDisplayParams
     }
 
 data CursorDisplay
-    = BoundaryCursor [CardinalPoint]
+    = BoundaryCursor {_cursSides :: [CardinalPoint]}
     | BackdropCursor
 
 data SectionCursor = SectionCursor
@@ -26,7 +26,7 @@ data SectionCursor = SectionCursor
     , _scurColor :: Color
     }
 
-data SelSection a = SelSection
+data SelectionSection a = SelectionSection
     { _ssItems :: IntMap (SelectionItem a)
     , _ssOffset :: Int
     , _ssShownItems :: [Picture]
@@ -34,23 +34,33 @@ data SelSection a = SelSection
     , _ssIndent :: Int
     }
 
-type IMSS a = IntMap (SelSection a)
+type IMSS a = IntMap (SelectionSection a)
 
-data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
+data SelectionWidth
+    = FixedSelectionWidth Int
+    | UseItemWidth
 
 data SelectionItem a
-    = SelItem
+    = SelectionItem
+        { _siPictures :: [String]
+        , _siHeight :: Int
+        , _siWidth :: Int
+        , _siIsSelectable :: Bool
+        , _siColor :: Color
+        , _siOffX :: Int
+        , _siPayload :: a
+        }
+    | SelectionInfo
         { _siPictures :: [String]
         , _siHeight :: Int
         , _siWidth :: Int
         , _siIsSelectable :: Bool
         , _siColor :: Color
         , _siOffX :: Int
-        , _siPayload :: Maybe a
         }
 
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionItem
-makeLenses ''SelSection
+makeLenses ''SelectionSection
 makeLenses ''SectionCursor
-makePrisms ''CursorDisplay
+makeLenses ''CursorDisplay

src/Dodge/Data/SoundOrigin.hs

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

src/Dodge/Data/Terminal.hs

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

src/Dodge/Data/Terminal/Status.hs

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

src/Dodge/Data/Universe.hs

@@ -34,7 +34,7 @@ data Universe = Universe
     , _uvScreenLayers :: [ScreenLayer]
     , _uvIOEffects :: Universe -> IO Universe
     , _uvSideEffects :: Seq SideEffect
-    , _uvConfig :: Config
+    , _uvConfig :: Configuration
     , _uvTestString :: Universe -> [String]
     , _uvCanContinue :: Bool
     , _uvMSeed :: Maybe Int
@@ -49,8 +49,8 @@ data Universe = Universe
     }
 
 data DebugItem = DebugItem
-    { _debugPic :: Picture
+    { _debugPic :: Universe -> Picture
-    , _debugMessage :: [String]
+    , _debugMessage :: Universe -> [String]
     , _debugInfo :: DebugInfo
     }
 
@@ -73,23 +73,26 @@ data OptionScreenFlag = NormalOptions | GameOverOptions | SplashOptions
     | LoadingScreen
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data ExtraMenuOption
+data EscapeMenuOption
-    = BottomMenuOption { _emoMenuOption :: MenuOption }
+    = BottomEscapeMenuOption { _emoMenuOption :: MenuOption }
-    | TopMenuOption { _emoMenuOption :: MenuOption }
+    | TopEscapeMenuOption { _emoMenuOption :: MenuOption }
-    | NoExtraMenuOption
+    | NoEscapeMenuOption
 
 data ScreenLayer
     = OptionScreen
         { _scTitle :: String
         , _scOptions :: [MenuOption]
         , _scOffset :: Int
-        , _scPositionedMenuOption :: ExtraMenuOption
+        , _scPositionedMenuOption :: EscapeMenuOption
         , _scOptionFlag :: OptionScreenFlag
         , _scSelectionList :: [SelectionItem (Universe -> Universe,Universe->Universe)]
         , _scAvailableLines :: Int
         , _scDisplayTime :: Int
         }
-    | InputScreen { _scInput :: String }
+    | InputScreen
+        { _scInput :: String
+        , _scFooter :: String
+        }
 
 data MenuOptionDisplay
     = MODString {_modString :: String}
@@ -114,6 +117,6 @@ makeLenses ''ScreenLayer
 makeLenses ''SideEffect
 makeLenses ''MenuOptionDisplay
 makeLenses ''MenuOption
-makeLenses ''ExtraMenuOption
+makeLenses ''EscapeMenuOption
 makeLenses ''DebugItem
 makeLenses ''DebugInfo

src/Dodge/Data/World.hs

@@ -12,7 +12,6 @@ module Dodge.Data.World (
     module Dodge.Data.Input,
 ) where
 
-import qualified Data.IntMap.Strict as IM
 import NewInt
 import Control.Lens
 import Data.IntMap.Strict (IntMap)
@@ -42,7 +41,7 @@ data World = World
     , _playingSounds :: M.Map SoundOrigin Sound
     , _input :: Input
     , _testFloat :: Float
-    , _rbState :: RightButtonState
+    , _rbOptions :: RightButtonOptions
     , _hud :: HUD
     , _worldEventFlags :: Set WorldEventFlag
     , _crZoning :: IntMap (IntMap IntSet)
@@ -54,7 +53,6 @@ data World = World
     , _gsZoning :: IntMap (IntMap IntSet)
     , _wCam :: Camera
     , _unpauseClock :: Int
-    , _coordinates :: IM.IntMap Point2 -- temporary coordinates for world generation/placement
     }
 
 data TimeFlowStatus

src/Dodge/Data/WorldEffect.hs

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