Add files

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

.gitignore

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

ChangeLog.md

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

README.md

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

appDodge/Main.hs

@@ -2,6 +2,7 @@ module Main (
     main,
 ) where
 
+import Dodge.StartNewGame
 import Control.Lens
 import Control.Monad
 import Control.Parallel
@@ -9,13 +10,12 @@ import qualified Data.Map.Strict as M
 --import Data.Preload.Render
 import qualified Data.Text as T
 import Dodge.Concurrent
-import Dodge.Config.Load
+import Dodge.Config
-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 :: Configuration -> IO Universe
+firstWorldLoad :: Config -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     pdata <- doPreload >>= applyWorldConfig theConfig
@@ -100,7 +100,8 @@ firstWorldLoad theConfig = do
                 , _uvDebugMessageOffset = 0
                 , _uvSoundQueue = mempty
                 }
-    return $ u & uvScreenLayers .~ [splashMenu u]
+    --return $ u & uvScreenLayers .~ [splashMenu u]
+    return $ startNewGameInSlot 0 u
 
 theUpdateStep :: SDL.Window -> Universe -> IO Universe
 theUpdateStep win = doSideEffects <=< updateRenderSplit win

asdf

@@ -1,483 +0,0 @@
-{- |
-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,8 +1,7 @@
 {
   "_debug_booleans": [
     "Show_ms_frame",
-    "Mouse_position",
+    "Pathing"
-    "Collision_test"
   ],
   "_debug_view_clip_bounds": "NoRoomClipBoundaries",
   "_gameplay_rotate_to_wall": true,

graph/itemCombinations.gv

@@ -1,281 +0,0 @@
-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

@@ -1,145 +0,0 @@
-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

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

log/treeCluster

@@ -1,267 +0,0 @@
-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

@@ -1,37 +0,0 @@
---{-# 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

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

src/Dodge/Barreloid.hs

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

src/Dodge/Base/CardinalPoint.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Base.CardinalPoint where
 
 import Dodge.Data.Room
@@ -23,3 +24,10 @@ 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,5 +1,4 @@
 module Dodge.Base.Coordinate (
-    cartePosToScreen,
     worldPosToScreen,
     screenToWorldPos,
     mouseWorldPos,
@@ -7,18 +6,9 @@ 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.
@@ -31,33 +21,10 @@ 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)
+    (cam ^. camCenter) + (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) p
-        + (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,20 +4,13 @@ import LensHelp
 
 -- | generalised way of putting a new item into a lensed intmap, returning the
 -- new index as well
-plNewID :: ALens' b (IM.IntMap a)
+plNewID :: ALens' b (IM.IntMap a) -> a -> b -> (Int,b)
-    -> a
-    -> b
-    -> (Int,b)
 plNewID l x w = (i,w & l #%~ IM.insert i x)
   where
     i = IM.newKey $ w ^# l
 
 -- | place an new object into an intmap and update its id
-plNewUpID :: ALens' b (IM.IntMap a)
+plNewUpID :: ALens' b (IM.IntMap a) -> ALens' a Int -> a -> b -> (Int,b)
-    -> ALens' a Int
-    -> a
-    -> b
-    -> (Int,b)
 plNewUpID l li x w = (i,w & l #%~ IM.insert i (x & li #~ i))
   where
     i = IM.newKey $ w ^# l

src/Dodge/Base/Window.hs

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

src/Dodge/Base/You.hs

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

src/Dodge/BaseTriggerType.hs

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

src/Dodge/Bullet.hs

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

src/Dodge/Bullet/Draw.hs

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

src/Dodge/Button/Event.hs

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

src/Dodge/Cleat.hs

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

src/Dodge/Clock.hs

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

src/Dodge/Combine.hs

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

src/Dodge/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 TORCH, eq HAT] headLamp
+           , po [hd LED, 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 = NoEscapeMenuOption
+        , _scPositionedMenuOption = NoExtraMenuOption
         , _scOptionFlag = LoadingScreen
         , _scSelectionList = mempty
         , _scAvailableLines = 0

src/Dodge/Config.hs

@@ -1,33 +1,50 @@
 {- |
 IO actions that apply config side effects and save configuration settings to disk.
 -}
-module Dodge.Config.Update (
+module Dodge.Config (
     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 :: Configuration -> (a -> IO a) -> a -> IO a
+saveConfig :: Config -> (a -> IO a) -> a -> IO a
 saveConfig cfig f x = do
---    putStrLn "Saving config to data/dodge.config.json"
+    createDirectoryIfMissing True "generated"
-    BS.writeFile "data/dodge.config.json" $
+    BS.writeFile "generated/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 :: Configuration -> IO ()
+setVol :: Config -> IO ()
 setVol cfig = do
     setSoundVolume (_volume_master cfig * _volume_sound cfig)
     setMusicVolume (_volume_master cfig * _volume_music cfig)
@@ -36,7 +53,7 @@ setVol cfig = do
 Apply /all/ of the values in the world configuration to the running game.
 -}
 applyWorldConfig ::
-    Configuration ->
+    Config ->
     PreloadData ->
     IO PreloadData
 applyWorldConfig cfig pdata = do

src/Dodge/Config/Load.hs

@@ -1,22 +0,0 @@
-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/Corpse/Draw.hs

@@ -1,7 +0,0 @@
-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,43 +1,25 @@
 module Dodge.Corpse.Make (makeCorpse) where
 
-import Dodge.Creature.Radius
-import Dodge.Creature.Shape
 import Control.Lens
 import Dodge.Creature.Picture
-import Dodge.Data.Corpse
+import Dodge.Creature.Radius
+import Dodge.Creature.Shape
+--import Dodge.Data.Corpse
 import Dodge.Data.Creature
 import Geometry
 import Shape
 import ShapePicture
 
-makeCorpse :: Creature -> Corpse
+makeCorpse :: Creature -> SPic
-makeCorpse = makeDefaultCorpse
+makeCorpse cr =
-
+    noPic
-makeDefaultCorpse :: Creature -> Corpse
+        . scaleSH (V3 crsize crsize crsize)
-makeDefaultCorpse cr =
+        $ mconcat
-    defaultCorpse
+            [ colorSH (_skinHead cskin) $ deadScalp cr
-        & cpPos .~ _crPos cr
+            , colorSH (_skinUpper cskin) $ deadUpperBody cr
-        & cpDir .~ _crDir cr
+            , rotmdir $ colorSH (_skinLower cskin) $ deadFeet 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,7 +38,6 @@ import Dodge.Creature.Inanimate
 import Dodge.Creature.LauncherCrit
 import Dodge.Creature.LtAutoCrit
 import Dodge.Creature.Perception
-import Dodge.Creature.PistolCrit
 import Dodge.Creature.ReaderUpdate
 import Dodge.Creature.SentinelAI
 import Dodge.Creature.SpreadGunCrit
@@ -57,35 +56,35 @@ import Picture
 spawnerCrit :: Creature
 spawnerCrit =
     defaultCreature
-        & crHP .~ 300
+        & crHP .~ HP 300
-        & crInv .~ IM.empty
+--        & crInv .~ IM.empty
 --        & crType . skinUpper .~ lightx4 blue
 
 miniGunCrit :: Creature
 miniGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, miniGunX 3)]
+--        & crInv .~ IM.fromList [(0, miniGunX 3)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MiniGunAI
 
 longCrit :: Creature
 longCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, sniperRifle)]
+--        & crInv .~ IM.fromList [(0, sniperRifle)]
 --        & crType . humanoidAI .~ LongAI
 --        & crType . skinUpper .~ lightx4 red
 
 multGunCrit :: Creature
 multGunCrit =
     defaultCreature
-        & crInv .~ IM.fromList [(0, volleyGun 4)]
+--        & crInv .~ IM.fromList [(0, volleyGun 4)]
 --        & crType . skinUpper .~ lightx4 red
 --        & crType . humanoidAI .~ MultGunAI
 
 addArmour :: Creature -> Creature
 addArmour = over crInv insarmour
   where
-    insarmour xs = IM.insert (IM.newKey xs) frontArmour xs
+    insarmour xs = xs -- IM.insert (IM.newKey xs) frontArmour xs
 
 {- | The creature you control.
 ID 0.
@@ -98,8 +97,8 @@ startCr =
         & crDir .~ pi / 2
         & crMvDir .~ pi / 2
         & crID .~ 0
-        & crHP .~ 10000
+        & crHP .~ HP 10000
-        & crInv .~ startInventory
+        & crInv .~ mempty
         & crFaction .~ PlayerFaction
 --        & crMvType .~ MvWalking yourDefaultSpeed
         & crType .~ Avatar (PulseStatus 55 0) Flesh 50 50 50 3
@@ -111,9 +110,9 @@ startInvList = []
 startInventory :: IM.IntMap Item
 startInventory = IM.fromList $ zip [0 ..] startInvList
 
-inventoryX :: Char -> [Item]
+inventoryX :: String -> [Item]
 inventoryX c = case c of
-    'A' ->
+    "A" ->
         [introScan t | t <- [minBound..maxBound]] <>
         [ flameThrower
         , fuelPack
@@ -123,7 +122,7 @@ inventoryX c = case c of
         , unigate
         , bingate
         ]
-    'B' ->
+    "B" ->
         [ wristArmour
         , wristArmour
         , volleyGun 5
@@ -147,15 +146,16 @@ inventoryX c = case c of
         , makeTypeCraftNum 2 PIPE
         , makeTypeCraftNum 1 CREATURESENSOR
         ]
-    'C' -> map makeTypeCraft [minBound..maxBound]
+    "BB" -> [ wristArmour , wristArmour]
-    'D' ->
+    "C" -> map makeTypeCraft [minBound..maxBound]
+    "D" ->
         [ blinker
         , unsafeBlinker
         , pulseChecker
         , detector WALLDETECTOR
         , battery
         ]
-    'E' -> [alteRifle
+    "E" -> [alteRifle
         , tinMag
         , tinMag
         ] <>
@@ -166,7 +166,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 1 STEELDRUM
         , makeTypeCraftNum 1 MOTOR
         ]
-    'F' -> fold
+    "F" -> fold
         [ makeTypeCraftNum 3 PIPE
         , makeTypeCraftNum 3 TUBE
         , makeTypeCraftNum 3 HARDWARE
@@ -183,7 +183,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 3 LIGHTER
 --        , makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
         ]
-    'G' ->
+    "G" ->
         [ autoPistol
         , tinMag
         , pistol
@@ -197,19 +197,19 @@ inventoryX c = case c of
 --        , makeTypeCraftNum 5 (BULBODYCRAFT BounceBullet)
 --        , makeTypeCraftNum 5 (BULBODYCRAFT PenetrateBullet)
         ]
-    'H' -> [shatterGun]
+    "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]
+    "P" -> [burstRifle , tinMag, bulletSynthesizer, battery]
-    '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
-    , torch
+    , led
     , magShield MagnetRepulse
     , bangCone
     , megaTinMag 1000

src/Dodge/Creature/Action.hs

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

src/Dodge/Creature/AutoCrit.hs

@@ -2,18 +2,18 @@ module Dodge.Creature.AutoCrit (
     autoCrit,
 ) where
 
-import Dodge.Item.Held.Cane
+--import Dodge.Item.Held.Cane
 --import Control.Lens
 import Dodge.Data.Creature
 import Dodge.Default
-import qualified IntMapHelp as IM
+--import qualified IntMapHelp as IM
 --import Picture
 
 autoCrit :: Creature
 autoCrit =
     defaultCreature
-        { _crInv = IM.fromList [(0, autoRifle)]
+        { --_crInv = IM.fromList [(0, autoRifle)]
-        , _crHP = 300
+         _crHP = HP 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 = 1
+        { _crHP = HP 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 = 150
+        , _crHP = HP 150
         , _crInv = mempty
         , _crFaction = ColorFaction green
         , _crVocalization = chaseCritVocalization

src/Dodge/Creature/Damage.hs

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

src/Dodge/Creature/HandPos.hs

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

src/Dodge/Creature/Impulse.hs

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

src/Dodge/Creature/Impulse/Movement.hs

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

src/Dodge/Creature/Impulse/UseItem.hs

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

src/Dodge/Creature/LtAutoCrit.hs

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

src/Dodge/Creature/Picture.hs

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

src/Dodge/Creature/PistolCrit.hs

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

src/Dodge/Creature/SpreadGunCrit.hs

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

src/Dodge/Creature/State.hs

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

src/Dodge/Creature/Statistics.hs

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

src/Dodge/Creature/SwarmCrit.hs

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

src/Dodge/Creature/Test.hs

@@ -24,11 +24,11 @@ module Dodge.Creature.Test (
     crSafeDistFromTarg,
 ) where
 
-import Dodge.Item.Grammar
+import NewInt
+import qualified Data.IntMap.Strict as IM
 import Dodge.Creature.Radius
 import Dodge.Data.Equipment.Misc
 import Dodge.Data.AimStance
-import Dodge.Item.AimStance
 import Control.Lens
 import Data.List (find)
 import Data.Maybe
@@ -87,18 +87,8 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
     sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False
 
---crCanShoot :: Creature -> Bool
---crCanShoot cr = crIsAiming cr && crWeaponReady cr
-
 crInAimStance :: AimStance -> Creature -> Bool
-crInAimStance as cr = crIsAiming cr && mitstance == Just as
+crInAimStance as cr = cr ^? crStance . posture . aimStance == 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
@@ -112,20 +102,16 @@ twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
 -- Not sure if it is a good idea
-crIsArmouredFrom :: Point2 -> Creature -> Bool
+crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
-crIsArmouredFrom = hasFrontArmour
+crIsArmouredFrom m p cr = fromMaybe False $ do
-
+    NInt itid <- cr ^? crEquipment . ix OnChest
-hasFrontArmour :: Point2 -> Creature -> Bool
+    ittype <- m ^? ix itid . itType
-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,10 +1,11 @@
 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
@@ -29,7 +30,8 @@ import ShapePicture.Data
 -- allow for knockbacks etc to be determined as well as intended movements
 updateCreature :: Creature -> World -> World
 updateCreature cr
-    | _crZ cr < negate 100 = (tocr . crHP .~ negate 1) . destroyAllInvItems cr
+    | null (cr ^? crHP . _HP) = id
+    | _crZ cr < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
     | _crZ cr < 0 = (tocr . crZVel -~ 0.5) . (tocr . crZ +~ _crZVel cr)
     | otherwise = updateCreature' cr
   where
@@ -61,51 +63,59 @@ 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
+checkDeath' cr w = case cr ^. crHP of
-    | _crHP cr > 0 = w & tocr . crDamage .~ []
+    HP x | x > 0 -> w & tocr . crDamage .~ []
-    | _crHP cr <= -200 = w
+    HP x | x > -200 && _crDeathTimer cr < 5 -> w
-            & dropAll cr -- the order of
-            & destroyCreature cr -- these is important
-            & stopSoundFrom (CrWeaponSound (_crID cr) 0)
-            & addCrGibs cr
-    | _crHP cr > -200 && _crDeathTimer cr < 5 = w
             & tocr . crDamage .~ []
             & tocr . crDeathTimer +~ 1
-    | otherwise = w
+    HP x | x > -200 -> w
             & dropAll cr -- the order of
-            & removecr -- these is important
+--            & removecr -- 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 
+--    | otherwise = w
+--            & dropAll cr -- the order of
+--            & 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 = case cr ^? crDamage . to maxDamageType . _Just . _1 of
+corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
-    Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
+    Just CookingDamage -> sethp (CrIsCorpse $ scorchSPic thecorpse)
-    Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
+    Just PoisonDamage -> sethp (CrIsCorpse $ poisonSPic thecorpse)
     Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
-    _ -> addcorpse thecorpse
+         . sethp CrIsGibs
+    _ -> sethp (CrIsCorpse thecorpse)
   where
-    addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
+    sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
     thecorpse = makeCorpse cr
 
 scorchSPic :: SPic -> SPic
@@ -116,7 +126,7 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
 
 -- reverse keys, otherwise two or more inv items will cause errors
 dropAll :: Creature -> World -> World
-dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys $ _crInv cr
+dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
 
 chasmTest :: Creature -> World -> World
 chasmTest cr w

src/Dodge/Creature/Volition.hs

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

src/Dodge/Creature/YourControl.hs

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

src/Dodge/Data/AimStance.hs

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

src/Dodge/Data/Button.hs

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

src/Dodge/Data/CardinalPoint.hs

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

src/Dodge/Data/Corpse.hs

@@ -1,28 +0,0 @@
-{-# 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,6 +17,8 @@ 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
@@ -32,7 +34,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
@@ -44,10 +46,10 @@ data Creature = Creature
     , _crMvAim :: Float
     , _crType :: CreatureType
     , _crID :: Int
-    , _crHP :: Int
+    , _crHP :: CrHP
-    , _crInv :: IM.IntMap Item
+    , _crInv :: NewIntMap InvInt Int
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite Int
+    , _crEquipment :: M.Map EquipSite (NewInt ItmInt)
     , _crDamage :: [Damage]
     , _crPain :: Int
     , _crStance :: Stance
@@ -65,6 +67,12 @@ 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
@@ -75,10 +83,12 @@ data Intention = Intention
 
 makeLenses ''Creature
 makeLenses ''Intention
+makePrisms ''CrHP
 
 concat
     <$> mapM
         (deriveJSON defaultOptions)
         [ ''Creature
         , ''Intention
+        , ''CrHP
         ]

src/Dodge/Data/Creature/Stance.hs

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

src/Dodge/Data/EquipType.hs

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

src/Dodge/Data/Equipment/Misc.hs

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

src/Dodge/Data/FloorItem.hs

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

src/Dodge/Data/GenParams.hs

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

src/Dodge/Data/GenWorld.hs

@@ -8,6 +8,7 @@ module Dodge.Data.GenWorld (
     module Dodge.Data.World,
 ) where
 
+import ShortShow
 import Color
 import Control.Lens
 import Control.Monad.State
@@ -22,14 +23,20 @@ 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 {_putMachinePoly :: [Point2], _putMachineMachine :: Machine, _putMachineWall :: Wall}
+    | PutMachine
+        { _putMachinePoly :: [Point2]
+        , _putMachineMachine :: Machine
+        , _putMachineWall :: Wall
+        , _putMachineMaybeItem :: Maybe Item
+        }
     | PutLS LightSource
     | PutButton {_putButton :: Button}
     | PutProp Prop
@@ -51,11 +58,38 @@ data PSType
     | PutDoor Color EdgeObstacle WdBl [(Point2, Point2)]
     | RandPS (State StdGen PSType)
     | PutForeground ForegroundShape
-    | PutWorldUpdate (PlacementSpot -> World -> World)
+    | PutWorldUpdate (Int -> PlacementSpot -> GenWorld -> GenWorld)
     | 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?
@@ -73,17 +107,13 @@ data PlacementSpot
         }
 
 -- TODO attempt to unify/simplify this union type
-data Placement
+data Placement = Placement
-    = Placement
+    { _plSpot :: PlacementSpot
-        { _plOrder :: Int
+    , _plType :: PSType
-        , _plSpot :: PlacementSpot
+    , _plMID :: Maybe Int
-        , _plType :: PSType
+    , _plExternalID :: Maybe Int
-        , _plMID :: Maybe Int
+    , _plIDCont :: GenWorld -> Placement -> Maybe Placement
-        , _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;
@@ -106,8 +136,7 @@ data Room = Room
     , _rmPos :: [RoomPos]
     , _rmPath :: S.Set (Point2, Point2)
     , _rmPmnts :: [Placement]
-    , _rmInPmnt :: [InPlacement]
+    , _rmInPmnt :: [(Int,GenWorld -> Placement)]
-    , _rmOutPmnt :: [OutPlacement]
     , _rmBound :: [[Point2]]
     , _rmFloor :: Floor
     , _rmName :: String
@@ -124,16 +153,6 @@ 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,51 +5,41 @@
 
 module Dodge.Data.HUD where
 
-import qualified Data.IntSet as IS
-import Dodge.Data.Item.Location
-import NewInt
 import Control.Lens
-import Data.IntMap
+import qualified Data.IntSet as IS
-import Data.IntSet (IntSet)
 import Dodge.Data.Combine
+import Dodge.Data.Item.Location
 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 :: IntMap (SelectionSection CombinableItem)
+        { _ciSections :: IMSS CombItem
-        , _ciSelection :: Maybe (Int, Int, IS.IntSet)
+        , _ciSelection :: Maybe Selection
         , _ciFilter :: Maybe String
         }
---    | LockedInventory
     | DisplayTerminal {_termID :: Int}
 
 data HUD = HUD
-    { _hudElement :: HUDElement
+    { _subInventory :: SubInventory
-    , _carteCenter :: Point2
+    , _diSections :: IMSS ()
-    , _carteZoom :: Float
+    , _diSelection :: Maybe Selection
-    , _carteRot :: Float
+    , _diInvFilter :: Maybe String
-    , _closeItems :: [NewInt FloorInt]
+    , _diCloseFilter :: Maybe String
+    , _closeItems :: [NewInt ItmInt]
     , _closeButtons :: [Int]
     }
 
+data Selection = Sel {_slSec :: Int, _slInt :: Int, _slSet :: IS.IntSet}
+
 makeLenses ''HUD
-makeLenses ''HUDElement
+makeLenses ''Selection
 makeLenses ''SubInventory

src/Dodge/Data/Input.hs

@@ -5,6 +5,7 @@
 
 module Dodge.Data.Input where
 
+import Dodge.Data.Terminal.Status
 import Control.Lens
 import qualified Data.Map.Strict as M
 import Geometry.Data
@@ -16,20 +17,16 @@ data MouseContext
     | MouseInGame
     | MouseMenuClick {_mcoMenuClick :: Int}
     | MouseMenuCursor
-    | OverInvDrag {_mcoDragSection :: Int
+    | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
-        , _mcoMaybeSelect :: Maybe (Int,Int)
+    | OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe 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
-    | OverTerminalReturn {_mcoTermID :: Int}
+    | OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
-    | OverTerminalEscape
+    | OutsideTerminal
     | MouseGameRotate
     deriving (Show)
 

src/Dodge/Data/Item.hs

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

src/Dodge/Data/Item/Combine.hs

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

src/Dodge/Data/Item/Location.hs

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

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

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

src/Dodge/Data/LWorld.hs

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

src/Dodge/Data/MTRS.hs

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

src/Dodge/Data/Machine.hs

@@ -26,7 +26,6 @@ import Dodge.Data.Machine.Sensor
 import Dodge.Data.Material
 import Dodge.Data.ObjectType
 import Geometry.Data
-import Sound.Data
 
 data Machine = Machine
     { _mcID :: Int
@@ -39,29 +38,22 @@ 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
-    | McSensor Sensor
+    | McDamSensor DamageSensor
+    | McProxSensor ProximitySensor
     | McTurret {_mctTurret :: Turret}
-    --deriving (Eq, Show, Read) --, Generic)
-    --hderiving (Eq, Show, Read) --Generic, Flat)
 
 data Turret = Turret
-    { _tuWeapon :: Item
+    { _tuWeapon :: Int
     , _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,51 +3,52 @@
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Dodge.Data.Machine.Sensor (
+module Dodge.Data.Machine.Sensor where
-    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 Dodge.Data.Machine.Sensor.Type
+import Geometry.Data
 
-data Sensor
+data SensorType
-    = DamageSensor
+    = LaserSensor
-        { _sensToggle :: Bool
+    | ElectricSensor
-        , _sensAmount :: Int
+    | ThermalSensor
-        , _sensType :: SensorType
+    | PhysicalSensor
-        , _sensDraw :: (PaletteColor, DecorationShape)
+    deriving (Eq, Ord, Show, Read, Bounded, Enum)
-        , _sensThreshold :: Int
-        }
-    | ProximitySensor
-        { _proxStatus :: CloseToggle
-        , _proxDist :: Float
-        , _proxRequirement :: ProximityRequirement
-        , _sensToggle :: Bool
-        }
 
---deriving (Eq, Ord, Show, Read) --Generic, Flat)
+data DamageSensor = DamSensor
+    { _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}
-    | RequireImpossible
+    | RequireDeadCreatures {_proxReqDead :: [Int]}
     deriving (Show)
 
---deriving (Eq, Ord, Show, Read) --Generic, Flat)
+makeLenses ''DamageSensor
-
+makeLenses ''ProximitySensor
-data CloseToggle = NotClose | IsClose
+makeLenses ''ProximitySensorType
-    deriving (Show)
+makePrisms ''ProximityRequirement
-
+deriveJSON defaultOptions ''SensorType
---deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-makeLenses ''Sensor
-makeLenses ''ProximityRequirement
 deriveJSON defaultOptions ''ProximityRequirement
-deriveJSON defaultOptions ''CloseToggle
+deriveJSON defaultOptions ''ProximitySensorType
-deriveJSON defaultOptions ''Sensor
+deriveJSON defaultOptions ''ProximitySensor
+deriveJSON defaultOptions ''DamageSensor
+
+instance ToJSONKey SensorType
+
+instance FromJSONKey SensorType

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

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

src/Dodge/Data/Room.hs

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

src/Dodge/Data/RoomCluster.hs

@@ -6,9 +6,8 @@ module Dodge.Data.RoomCluster where
 import Control.Lens
 import qualified Data.Set as S
 
-data ClusterStatus = ClusterStatus
+newtype ClusterStatus = ClusterStatus
-    { _csName :: String
+    { _csLinks :: S.Set ClusterLink
-    , _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 {_cursSides :: [CardinalPoint]}
+    = BoundaryCursor [CardinalPoint]
     | BackdropCursor
 
 data SectionCursor = SectionCursor
@@ -26,7 +26,7 @@ data SectionCursor = SectionCursor
     , _scurColor :: Color
     }
 
-data SelectionSection a = SelectionSection
+data SelSection a = SelSection
     { _ssItems :: IntMap (SelectionItem a)
     , _ssOffset :: Int
     , _ssShownItems :: [Picture]
@@ -34,33 +34,23 @@ data SelectionSection a = SelectionSection
     , _ssIndent :: Int
     }
 
-type IMSS a = IntMap (SelectionSection a)
+type IMSS a = IntMap (SelSection a)
 
-data SelectionWidth
+data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
-    = FixedSelectionWidth Int
-    | UseItemWidth
 
 data SelectionItem a
-    = SelectionItem
+    = SelItem
-        { _siPictures :: [String]
-        , _siHeight :: Int
-        , _siWidth :: Int
-        , _siIsSelectable :: Bool
-        , _siColor :: Color
-        , _siOffX :: Int
-        , _siPayload :: a
-        }
-    | SelectionInfo
         { _siPictures :: [String]
         , _siHeight :: Int
         , _siWidth :: Int
         , _siIsSelectable :: Bool
         , _siColor :: Color
         , _siOffX :: Int
+        , _siPayload :: Maybe a
         }
 
 makeLenses ''ListDisplayParams
 makeLenses ''SelectionItem
-makeLenses ''SelectionSection
+makeLenses ''SelSection
 makeLenses ''SectionCursor
-makeLenses ''CursorDisplay
+makePrisms ''CursorDisplay

src/Dodge/Data/SoundOrigin.hs

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

src/Dodge/Data/Terminal.hs

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

src/Dodge/Data/Terminal/Status.hs

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

src/Dodge/Data/Universe.hs

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

src/Dodge/Data/World.hs

@@ -12,6 +12,7 @@ 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)
@@ -41,7 +42,7 @@ data World = World
     , _playingSounds :: M.Map SoundOrigin Sound
     , _input :: Input
     , _testFloat :: Float
-    , _rbOptions :: RightButtonOptions
+    , _rbState :: RightButtonState
     , _hud :: HUD
     , _worldEventFlags :: Set WorldEventFlag
     , _crZoning :: IntMap (IntMap IntSet)
@@ -53,6 +54,7 @@ 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,6 +5,8 @@
 
 module Dodge.Data.WorldEffect where
 
+import Dodge.Data.Item.Location
+import NewInt
 import Dodge.Data.LightSource
 import Data.Aeson
 import Data.Aeson.TH
@@ -20,9 +22,9 @@ data ItCrWdWd = ItCrWdItemHeldEffect
 data WdWd
     = NoWorldEffect
     | SetTrigger Bool Int
-    | WorldEffects [WdWd]
+    | WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
     | SetLSCol Point3 Int
-    | AccessTerminal (Maybe Int)
+    | AccessTerminal Int
     | UnlockInv
     | SoundStart SoundOrigin Point2 SoundID (Maybe Int)
     | MakeStartCloudAt Point3
@@ -31,7 +33,7 @@ data WdWd
 --    | WdWdFromItCrixWdWd (LabelDoubleTree ComposeLinkType Item) Int ItCrWdWd
     | MakeTempLight LSParam Int
     | UseInvItem Int Int -- invid presstime
-    | WdWdBurstFireRepetition Int Int
+    | WdWdBurstFireRepetition Int (NewInt InvInt)
     --deriving (Eq, Show, Read) --, Generic)
     --h--deriving (Eq, Show, Read) --Generic, Flat)