Allow movement when viewing terminals

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

.gitignore

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

appDodge/Main.hs

@@ -75,7 +75,7 @@ winConfig x y winpos =
 theCleanup :: Universe -> IO ()
 theCleanup uv = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData uv)
 
-firstWorldLoad :: Configuration -> IO Universe
+firstWorldLoad :: Config -> IO Universe
 firstWorldLoad theConfig = do
     SDL.cursorVisible $= False
     pdata <- doPreload >>= applyWorldConfig theConfig

data/dodge.config.json

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

log/aGeneratedRoomLayout

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

log/attemptedSeeds

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

log/treeCluster

@@ -1,269 +1,49 @@
 Seed: 7114951007332849727
-0:startThenWeaponRoom
+0:teststart
 |
-1:corDoor
+1:TutDrop
 |
-2:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
+2:corDoor
 |
-3:corDoor
+3:DoorTest
 |
-4:lasSensorTurretTest
+4:TutDrop
-|
-5:corDoor
-|
-6:anRoom
-|
-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 = RLAUNCHER}
-|
-19:corDoor
-|
-20:shootingRange
-|
-21:corDoor
-|
-22:lasSensorTurretTest
-|
-23:corDoor
-|
-24:randomFourCornerRoom
 
-0:0:startThenWeaponRoom
+0:0:teststart
+
+0:0:0:Corridor
+
+1:0:TutDrop
+
+1:0:0:6gon
 |
-0:1:weaponBetweenPillars_BANGSTICK4
+1:0:1:defaultRoom
-
-0:0:0:rezBox'
-
-0:0:0:0:rezBox
 |
-0:0:0:1:autoDoor
+1:0:2:autoRect
 
-0:1:0:rectPillars
+2:0:corDoor
 
-1:0:corDoor
+2:0:0:autoDoor
-
-1:0:0:autoDoor
 |
-1:0:1:Corridor
+2:0:1:Corridor
 
-2:0:PassthroughLockKeyLists-HELD {_ibtHeld = SPARKGUN}
+3:0:DoorTest
 
-2:0:0:RassThroughLockKeyLists
+3:0:0:doorToggle-6gon
 |
-2:0:1:roomsContaining chaseCritchaseCritTRANSFORMERCANCAN
++- 3:0:1:triggerDoorRoom
-
-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
+|  3:0:2:autoRect
 |
-2:0:0:0:4:autoDoor
++- 3:0:3:triggerDoorRoom
-|
-2:0:0:0:5:Corridor
-
-2:0:1:0:defaultRoom
-
-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:anRoom
-
-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 DEFAULTCRNAMEchaseCritchaseCritKEYCARD 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
+|  3:0:4:autoRect
 |
-8:0:0:0:4:autoDoor
+3:0:5:Corridor
+
+4:0:6gon
 |
-8:0:0:0:5:Corridor
+4:1:defaultRoom
-
-8:0:1:0:autoRect
-
-9:0:corDoor
-
-9:0:0:autoDoor
 |
-9:0:1:Corridor
+4:2:autoRect
-
-10:0:warningRooms
-
-10:0:0:autoDoor
-|
-10:0:1:doorToggle-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 = RLAUNCHER}
-
-18:0:0:RassThroughLockKeyLists
-|
-18:0:1:roomsContaining chaseCritchaseCritTUBETUBEHARDWARE
-
-18:0:0:0:lasCenSensEdge
-
-18:0:0:0:0:autoDoor
-|
-18:0:0:0:1:8gon
-|
-+- 18:0:0:0:2:triggerDoorRoom
-|  |
-|  18:0:0:0:3:autoDoor
-|
-18:0:0:0:4:autoDoor
-|
-18:0:0:0:5:Corridor
-
-18:0:1:0:autoRect
-
-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
 

src/Dodge/Annotation.hs

@@ -30,7 +30,7 @@ annoToRoomTree an = case an of
         i <- nextLayoutInt
         (functionlockroom, randomitemidentity) <- takeOne ls
         lr <- zoom lyGen $ functionlockroom i
-        ii <- zoom lyGen $ randomitemidentity
+        ii <- zoom lyGen randomitemidentity
         keyroom <- zoom lyGen . fromJust $ lookup ii ks
         return $
             MTree

src/Dodge/AssignHotkey.hs

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

src/Dodge/Base/Coordinate.hs

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

src/Dodge/Base/Window.hs

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

src/Dodge/Config/Load.hs

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

src/Dodge/Config/Update.hs

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

src/Dodge/Corpse/Make.hs

@@ -9,10 +9,9 @@ import Dodge.Data.Creature
 import Geometry
 import Shape
 import ShapePicture
-import qualified Data.IntMap.Strict as IM
 
-makeCorpse :: IM.IntMap Item -> Creature -> Corpse
+makeCorpse :: Creature -> Corpse
-makeCorpse m cr =
+makeCorpse cr =
     defaultCorpse
         & cpPos .~ _crPos cr
         & cpDir .~ _crDir cr
@@ -20,8 +19,8 @@ makeCorpse m cr =
             .~ noPic
                 ( scaleSH (V3 crsize crsize crsize) $
                     mconcat
-                        [ colorSH (_skinHead cskin) $ deadScalp m cr
+                        [ colorSH (_skinHead cskin) $ deadScalp cr
-                        , colorSH (_skinUpper cskin) $ deadUpperBody m cr
+                        , colorSH (_skinUpper cskin) $ deadUpperBody cr
                         , rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
                         ]
                 )

src/Dodge/Creature.hs

@@ -110,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
@@ -122,7 +122,7 @@ inventoryX c = case c of
         , unigate
         , bingate
         ]
-    'B' ->
+    "B" ->
         [ wristArmour
         , wristArmour
         , volleyGun 5
@@ -146,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
         ] <>
@@ -165,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
@@ -182,7 +183,7 @@ inventoryX c = case c of
         , makeTypeCraftNum 3 LIGHTER
 --        , makeTypeCraftNum 5 (ENERGYBALLCRAFT IncBall)
         ]
-    'G' ->
+    "G" ->
         [ autoPistol
         , tinMag
         , pistol
@@ -196,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
@@ -221,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
@@ -238,9 +239,9 @@ inventoryX c = case c of
             , rifle
             , shellMag
             ]
-    'P' -> [burstRifle , tinMag, bulletSynthesizer, battery]
+    "P" -> [burstRifle , tinMag, bulletSynthesizer, battery]
-    'T' -> testInventory
+    "T" -> testInventory
-    'U' ->
+    "U" ->
         [targetingScope tt | tt <- [minBound .. maxBound]]
         <>
         [ gyroscope 
@@ -266,7 +267,7 @@ inventoryX c = case c of
         , stickyMod
         ]
         <> [shellModule p | p <- [minBound .. maxBound]]
-    'V' -> 
+    "V" -> 
         [targetingScope tt | tt <- [minBound .. maxBound]]
         <>
         [ battery

src/Dodge/Creature/Action.hs

@@ -168,15 +168,16 @@ dropExcept :: Creature -> Int -> World -> World
 dropExcept cr invid w =
     foldr (dropItem cr) w . IM.keys $
 --        invid `IM.delete` _crInv cr
-        invid `IM.delete` (_unNIntMap $ _crInv cr)
+        invid `IM.delete` _unNIntMap (_crInv cr)
 
 -- why not a cid (Int)?
 dropItem :: Creature -> Int -> World -> World
 dropItem cr invid w' =
     doanyitemdropeffect
         . maybeshiftseldown
-        . rmInvItem (_crID cr) (NInt 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
@@ -188,8 +189,8 @@ dropItem cr invid w' =
         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
@@ -200,7 +201,7 @@ youDropItem w = fromMaybe w $ do
     --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,8 +3,8 @@ 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
@@ -43,4 +43,4 @@ armourChaseCrit =
 --                ]
 --        , _crMvType = defaultChaseMvType{_mvTurnRad = FloatConst 0.05}
         }
-        & crEquipment . at OnChest ?~ 0
+--        & crEquipment . at OnChest ?~ 0

src/Dodge/Creature/HandPos.hs

@@ -1,22 +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 Dodge.Data.Equipment.Misc
-import qualified Data.IntMap.Strict as IM
 import qualified Quaternion as Q
 import Control.Lens
 import Dodge.Creature.Test
@@ -24,22 +20,27 @@ import Dodge.Data.Creature
 import Geometry
 import ShapePicture
 
-translatePointToRightHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
+translateToES :: Creature -> EquipSite -> Point3 -> Point3
-translatePointToRightHand m cr p =  fst (rightHandPQ m cr `Q.comp` (p,Q.qID))
+translateToES cr es p = fst (equipSitePQ es cr `Q.comp` (p,Q.qID))
 
---equipSitePQ :: EquipSite -> IM.IntMap Item -> Creature -> Point3Q
+equipSitePQ :: EquipSite -> Creature -> Point3Q
---equipSitePQ = \case
+equipSitePQ = \case
---    OnRightWrist -> rightHandPQ
+    OnLeftWrist -> leftWristPQ
---    OnLeftWrist -> leftHandPQ
+    OnRightWrist -> rightWristPQ
---    OnBack -> backPQ
+    OnHead -> headPQ
---    OnChest -> chestPQ
+    OnChest -> chestPQ
---    _ -> undefined
+    OnBack -> backPQ
+    OnLeftLeg -> leftLegPQ
+    OnRightLeg -> rightLegPQ
 
-rightHandPQ :: IM.IntMap Item -> Creature -> Point3Q
+translatePointToRightHand :: Creature -> Point3 -> Point3
-rightHandPQ m cr
+translatePointToRightHand cr p =  fst (rightHandPQ cr `Q.comp` (p,Q.qID))
-    | oneH m cr = (V3 11 (-3) 20, Q.qID)
+
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
+rightHandPQ :: Creature -> Point3Q
-    | twoFlat m cr = (V3 4 (-8) 10, Q.qID)
+rightHandPQ cr
+    | oneH cr = (V3 11 (-3) 20, Q.qID)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 4 (-10) 0,Q.qID)
+    | twoFlat cr = (V3 4 (-8) 10, Q.qID)
     | otherwise = case cr ^? crStance . carriage of
         Just (Walking sa LeftForward) -> (V3 (- f sa) (- off) 10, Q.qID)
         Just (Walking sa RightForward) -> (V3 (- g sa) (- off) 10, Q.qID)
@@ -50,18 +51,17 @@ rightHandPQ m cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
     g i = negate 2 + negate 6 * i / sLen
 
-translateToRightHand :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToRightHand :: Creature -> SPic -> SPic
-translateToRightHand m = overPosSP . translatePointToRightHand m
+translateToRightHand = overPosSP . translatePointToRightHand
 
-translateToRightWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
+rightWristPQ :: Creature -> Point3Q
-translateToRightWrist m cr =  overPosSP
+rightWristPQ cr = rightHandPQ cr `Q.comp` (V3 0 (-4) (-4), Q.qID)
-    (\p -> fst $ rightHandPQ m cr `Q.comp` (V3 0 (-4) (-4)+p, Q.qID))
 
-leftHandPQ :: IM.IntMap Item -> Creature -> Point3Q
+leftHandPQ :: Creature -> Point3Q
-leftHandPQ m cr
+leftHandPQ cr
-    | oneH m cr = (V3 0 off 10, Q.qz 0.4)
+    | oneH cr = (V3 0 off 10, Q.qz 0.4)
-    | twists m cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
+    | twists cr = (V3 0 5 20, Q.qz (-1)) `Q.comp` (V3 12 4 0, Q.qz 0.4)
-    | twoFlat m cr = (V3 4 8 10, Q.qID)
+    | twoFlat cr = (V3 4 8 10, Q.qID)
     | otherwise = case cr ^? crStance . carriage of
         Just (Walking sa RightForward) -> (V3 (- f sa) off 10 , Q.qID)
         Just (Walking sa LeftForward) -> (V3 (- g sa) off 10 , Q.qID)
@@ -72,15 +72,14 @@ leftHandPQ m cr
     f i = negate 2 + negate 6 * (sLen - i) / sLen
     g i = negate 2 + negate 6 * i / sLen
 
-translatePointToLeftHand :: IM.IntMap Item -> Creature -> Point3 -> Point3
+translatePointToLeftHand :: Creature -> Point3 -> Point3
-translatePointToLeftHand m cr p = fst (leftHandPQ m cr `Q.comp` (p,Q.qID))
+translatePointToLeftHand cr p = fst (leftHandPQ cr `Q.comp` (p,Q.qID))
 
-translateToLeftHand :: IM.IntMap Item -> Creature -> SPic -> SPic
+translateToLeftHand :: Creature -> SPic -> SPic
-translateToLeftHand m = overPosSP . translatePointToLeftHand m
+translateToLeftHand = overPosSP . translatePointToLeftHand
 
-translateToLeftWrist :: IM.IntMap Item -> Creature -> SPic -> SPic
+leftWristPQ :: Creature -> Point3Q
-translateToLeftWrist m cr = overPosSP 
+leftWristPQ cr = leftHandPQ cr `Q.comp` (V3 0 4 (-4), Q.qID)
-    (\p -> fst $ leftHandPQ m cr `Q.comp` (V3 0 4 (-4)+p, Q.qID))
 
 leftLegPQ :: Creature -> Point3Q
 leftLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
@@ -113,26 +112,20 @@ rightLegPQ cr = Q.comp (0,Q.qz (_crMvDir cr - _crDir cr))
 translateToRightLeg :: Creature -> SPic -> SPic
 translateToRightLeg cr = overPosSP (\p -> fst (rightLegPQ cr `Q.comp` (p,Q.qID)))
 
-translateToHead :: IM.IntMap Item -> Creature -> SPic -> SPic
+headPQ :: Creature -> Point3Q
-translateToHead m cr = overPosSP (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID)))
+headPQ cr
-
+    | twists cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
-headPQ :: IM.IntMap Item -> Creature -> Point3Q
+    | oneH cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
-headPQ m cr
-    | twists m cr = (V3 0 2 20, Q.qz (-1)) `Q.comp` (V3 (negate 2.5) 0.25 0, Q.qz 1)
-    | oneH m cr = (V3 0 0 20, Q.qz 0.5) `Q.comp` (V3 2.5 0 0, Q.qz (-0.5))
     | otherwise = (V3 2.5 0 20, Q.qID)
 
-translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
+--translatePointToHead :: IM.IntMap Item -> Creature -> Point3 -> Point3
-translatePointToHead m cr p = fst (headPQ m cr `Q.comp` (p,Q.qID))
+--translatePointToHead m cr p = fst (headPQ cr `Q.comp` (p,Q.qID))
 
-chestPQ :: IM.IntMap Item -> Creature -> Point3Q
+chestPQ :: Creature -> Point3Q
-chestPQ m cr = backPQ m cr `Q.comp` (0,Q.qz pi)
+chestPQ cr = backPQ cr `Q.comp` (0,Q.qz pi)
 
-translateToChest :: IM.IntMap Item -> Creature -> SPic -> SPic
+backPQ :: Creature -> Point3Q
-translateToChest m cr = overPosSP (\p -> fst $ chestPQ m cr `Q.comp` (p,Q.qID))
+backPQ cr
-
+    | oneH cr = (V3 0 0 10, Q.qz 0.5)
-backPQ :: IM.IntMap Item -> Creature -> Point3Q
+    | twists cr = (V3 0 3 10, Q.qz (-1.5))
-backPQ m cr
-    | oneH m cr = (V3 0 0 10, Q.qz 0.5)
-    | twists m cr = (V3 0 3 10, Q.qz (-1.5))
     | otherwise = (V3 0 0 10, Q.qz 0)

src/Dodge/Creature/Impulse/UseItem.hs

@@ -19,7 +19,8 @@ import Dodge.Item.Location
 useItem :: Int -> Int -> World -> Maybe World
 useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
-    itmloc <- invIndents (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr) ^? ix invid . _2
+    itmloc <- invIndents ((\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
@@ -44,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 
@@ -64,53 +65,49 @@ activateDetonator det = fromMaybe id $ do
     return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
 
 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
             & 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
             & 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
             & toitems . ix itid . itLocation . ilEquipSite ?~ newp
-            & toitems . ix (invidtoitid 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
             & toitems . ix itid . itLocation . ilEquipSite ?~ newp
-            & toitems . ix (invidtoitid 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
             & toitems . ix itid . itLocation . ilEquipSite .~ Nothing
-            & onremove itm cr
+            & effectOnRemove itm cr
   where
-    invidtoitid :: NewInt InvInt -> Int
-    invidtoitid i = cr ^?! crInv . ix i -- _crInv cr IM.! i
     toitems = cWorld . lWorld . items
-    itid = invidtoitid invid
+    itid = cr ^?! crInv . ix invid
-    crpoint = cWorld . lWorld . creatures . ix (_crID cr)
+    toequipment = cWorld . lWorld . creatures . ix (_crID cr) . crEquipment
-    itmat i = w ^?! cWorld . lWorld . items . ix (invidtoitid i)
+    itmat i = w ^?! cWorld . lWorld . items . ix (_unNInt i)
-    itm = itmat invid
+    itm = w ^?! cWorld . lWorld . items . ix itid
-    onequip itm' = effectOnEquip itm'
-    onremove itm' = effectOnRemove itm'
 
 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/Picture.hs

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

src/Dodge/Creature/Statistics.hs

@@ -6,11 +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 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
@@ -55,17 +59,17 @@ equipmentStrValue itm = case _itType itm of
     EQUIP POWERLEGS -> 3
     _ -> 0
 
-crCurrentEquipment :: LWorld -> Creature -> NewIntMap InvInt Item
+crCurrentEquipment :: LWorld -> Creature -> M.Map EquipSite Item
-crCurrentEquipment lw = over unNIntMap (IM.filter (isJust . (^? itLocation . ilEquipSite . _Just))) . fmap f . _crInv
+crCurrentEquipment lw = fmap f . _crEquipment
   where
-    f i = lw ^?! items . ix i
+    f i = lw ^?! items . ix (_unNInt i)
 
 strFromHeldItem :: LWorld -> Creature -> Int
 strFromHeldItem lw cr = fromMaybe 0 $ do
-    Aiming <- cr ^? crStance . posture
+    Aiming {} <- cr ^? crStance . posture
-    i <- cr ^? crManipulation . manObject . imRootSelectedItem
+    is <- cr ^? crManipulation . manObject . imAttachedItems
-    j <- cr ^? crInv . ix i
+    let js = IM.elems $ IM.restrictKeys  (cr ^. crInv . unNIntMap) is
-    fmap (negate . itemWeight) $ lw ^? items . ix j
+    return . negate . sum . fmap itemWeight $ IM.restrictKeys (lw ^. items) $ IS.fromList js
 
 itemWeight :: Item -> Int
 itemWeight it = case it ^. itType of

src/Dodge/Creature/Test.hs

@@ -26,11 +26,9 @@ module Dodge.Creature.Test (
 
 import NewInt
 import qualified Data.IntMap.Strict as IM
-import Dodge.Item.Grammar
 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
@@ -89,35 +87,24 @@ crAwayFromPost cr = case find sentinelGoal . _apGoal $ _crActionPlan cr of
     sentinelGoal (SentinelAt _ _) = True
     sentinelGoal _ = False
 
---crCanShoot :: Creature -> Bool
+crInAimStance :: AimStance -> Creature -> Bool
---crCanShoot cr = crIsAiming cr && crWeaponReady cr
+crInAimStance as cr = cr ^? crStance . posture . aimStance == Just as
 
-crInAimStance :: AimStance -> IM.IntMap Item -> Creature -> Bool
+oneH :: Creature -> Bool
-crInAimStance as m cr = crIsAiming cr && mitstance == Just as
-  where
-    mitstance = do
-        i <- cr ^? crManipulation . manObject . imRootSelectedItem
-        --itm <- invRootTrees' (cr ^. crInv) ^? ix i
-        itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (fmap (\k -> m ^?! ix k) (cr ^. crInv)) ^? ix (_unNInt i)
-        return $ aimStance itm
-        --cr ^? crInv . ix i . itUse . heldAim . aimStance
-
-oneH :: IM.IntMap Item -> Creature -> Bool
 oneH = crInAimStance OneHand
 
-twoFlat :: IM.IntMap Item -> Creature -> Bool
+twoFlat :: Creature -> Bool
 twoFlat = crInAimStance TwoHandFlat
 
-twists :: IM.IntMap Item -> Creature -> Bool
+twists :: Creature -> Bool
-twists m cr = crInAimStance TwoHandUnder m cr || crInAimStance TwoHandOver m cr
+twists cr = crInAimStance TwoHandUnder cr || crInAimStance TwoHandOver cr
 
 -- the use of crOldPos is because the damage position is calculated on the
 -- previous frame
 -- Not sure if it is a good idea
 crIsArmouredFrom :: IM.IntMap Item -> Point2 -> Creature -> Bool
 crIsArmouredFrom m p cr = fromMaybe False $ do
-    invid <- cr ^? crEquipment . ix OnChest
+    NInt itid <- cr ^? crEquipment . ix OnChest
-    itid <- cr ^? crInv . ix invid
     ittype <- m ^? ix itid . itType
     return $
         EQUIP FRONTARMOUR == ittype
@@ -125,11 +112,10 @@ crIsArmouredFrom m p cr = fromMaybe False $ do
             && 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 m cr = 0.5
+        | crInAimStance OneHand cr = 0.5
-        | crInAimStance TwoHandUnder m cr = negate 1
+        | crInAimStance TwoHandUnder cr = negate 1
-        | crInAimStance TwoHandOver m cr = negate 1
+        | crInAimStance TwoHandOver cr = negate 1
         | otherwise = 0
 
 --crOnSeg :: Point2 -> Point2 -> Creature -> Bool

src/Dodge/Creature/Update.hs

@@ -107,7 +107,7 @@ corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
     _ -> addcorpse thecorpse
   where
     addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
-    thecorpse = makeCorpse (w ^. cWorld . lWorld . items) cr
+    thecorpse = makeCorpse cr
 
 scorchSPic :: SPic -> SPic
 scorchSPic = _1 %~ overColSH (mixColors 0.9 0.1 black . normalizeColor)

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,20 +1,18 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Dodge.Creature.YourControl (
+module Dodge.Creature.YourControl (yourControl) where
-    yourControl,
-) where
 
-import qualified Data.IntMap.Strict as IM
-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
@@ -29,32 +27,30 @@ 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 =
         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 ^? items . ix itid . itLocation . ilInvID =
         w & invSetSelectionPos 0 (_unNInt invid)
@@ -64,17 +60,26 @@ handleHotkeys w
             w
             (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
   where
+    pkeys = w ^. input . pressedKeys
     ispressed k = k `M.member` _pressedKeys (_input w)
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
     lw = w ^. cWorld . lWorld
 
+--modifierKeys :: S.Set SDL.Scancode
+--modifierKeys = S.fromList 
+--    [ SDL.ScancodeLShift
+--    , SDL.ScancodeRShift
+--    , SDL.ScancodeRCtrl
+--    , SDL.ScancodeLCtrl
+--    ]
+
 useHotkey :: World -> (NewInt ItmInt, Int) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
     invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
     useItem invid pt w
 
 hotkeyToScancode :: Hotkey -> SDL.Scancode
-hotkeyToScancode x = case x of
+hotkeyToScancode = \case
     HotkeyQ -> SDL.ScancodeQ
     HotkeyE -> SDL.ScancodeE
     HotkeyR -> SDL.ScancodeE
@@ -94,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
@@ -129,27 +134,33 @@ wasdAim inp w cr
     | Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
       , Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
         setAimPosture (w ^. cWorld . lWorld . items) cr
-    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn (w ^. cWorld . lWorld) 
+    | SDL.ButtonRight `M.member` _mouseButtons inp =
-        mousedir cr
+        aimTurn (w ^. cWorld . lWorld) mousedir cr
-    | Aiming <- cr ^. crStance . posture = removeAimPosture m cr
+    | Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
     | otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
   where
-    m = w ^. cWorld . lWorld . items
     mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos)
 
 setAimPosture :: IM.IntMap Item -> Creature -> Creature
-setAimPosture m = (crStance . posture .~ Aiming) . doAimTwist m (- 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 :: IM.IntMap Item -> Float -> Creature -> Creature
+doAimTwist :: AimStance -> Float -> Creature -> Creature
-doAimTwist m x cr = fromMaybe cr $ do
+doAimTwist as x
-    itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
+    | as == TwoHandOver || as == TwoHandUnder = crDir +~ x
-    itid <- cr ^? crInv . ix itRef
+    | otherwise = id
-    astance <- fmap itemBaseStance $ m ^? ix itid
-    guard $ astance == TwoHandOver || astance == TwoHandUnder
-    return $ cr & crDir +~ x
 
-removeAimPosture :: IM.IntMap Item -> Creature -> Creature
+removeAimPosture :: Creature -> Creature
-removeAimPosture m = (crStance . posture .~ AtEase) . doAimTwist m twoHandTwistAmount
+removeAimPosture cr = fromMaybe cr $ do
+    as <- cr ^? crStance . posture . aimStance
+    return $ cr
+        & crStance . posture .~ AtEase
+        & doAimTwist as twoHandTwistAmount
 
 twoHandTwistAmount :: Float
 twoHandTwistAmount = 1.6 * pi
@@ -231,6 +242,7 @@ tryClickUse pkeys w = fromMaybe w $ do
         ^? cWorld . lWorld . creatures . ix 0
             . crManipulation
             . manObject
-            . imSelectedItem . unNInt 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/CardinalPoint.hs

@@ -26,7 +26,7 @@ data CardinalCover
     | NSW
     | NS
 
-data XInfinity a = NegInf | NonInf a | PosInf
+data XInfinity a = NegInf | NonInf {_nonInf :: a} | PosInf
     deriving (Eq, Ord, Show)
 
 makeLenses ''XInfinity

src/Dodge/Data/Config.hs

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

src/Dodge/Data/Creature.hs

@@ -48,7 +48,7 @@ data Creature = Creature
     , _crHP :: Int
     , _crInv :: NewIntMap InvInt Int
     , _crManipulation :: Manipulation
-    , _crEquipment :: M.Map EquipSite (NewInt InvInt)
+    , _crEquipment :: M.Map EquipSite (NewInt ItmInt)
     , _crDamage :: [Damage]
     , _crPain :: Int
     , _crStance :: Stance

src/Dodge/Data/Creature/Stance.hs

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

src/Dodge/Data/EquipType.hs

@@ -22,9 +22,9 @@ eitType = \case
     BRAINHAT -> GoesOnHead
     HAT -> GoesOnHead
     HEADLAMP -> GoesOnHead
-    POWERLEGS -> GoesOnLegs
+    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,7 +24,8 @@ data EquipSite
     | OnBack
     | OnLeftWrist
     | OnRightWrist
-    | OnLegs
+    | OnLeftLeg
+    | OnRightLeg
 --    | OnSpecial
     deriving (Eq, Ord, Show, Read)
 

src/Dodge/Data/HUD.hs

@@ -5,42 +5,35 @@
 
 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
-        }
 
 data SubInventory
     = NoSubInventory
     | ExamineInventory
-    | MapperInventory 
+    | MapperInventory
-        {_mapInvOffset :: Point2
+        { _mapInvOffset :: Point2
         , _mapInvZoom :: Float
         , _mapInvItmID :: NewInt ItmInt
         }
     | CombineInventory
-        { _ciSections :: IntMap (SelectionSection CombinableItem)
+        { _ciSections :: IMSS CombinableItem
-        , _ciSelection :: Maybe (Int, Int, IS.IntSet)
+        , _ciSelection :: Maybe Selection
         , _ciFilter :: Maybe String
         }
     | DisplayTerminal {_termID :: Int}
 
 data HUD = HUD
-    { _hudElement :: HUDElement
+    { _subInventory :: SubInventory
+    , _diSections :: IMSS ()
+    , _diSelection :: Maybe Selection
+    , _diInvFilter :: Maybe String
+    , _diCloseFilter :: Maybe String
     , _carteCenter :: Point2
     , _carteZoom :: Float
     , _carteRot :: Float
@@ -48,6 +41,8 @@ data HUD = HUD
     , _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

@@ -17,12 +17,7 @@ data MouseContext
     | MouseInGame
     | MouseMenuClick {_mcoMenuClick :: Int}
     | MouseMenuCursor
-    | OverInvDrag {_mcoDragSection :: Int
+    | OverInvDrag {_mcoDragSection :: Int , _mcoMaybeSelect :: Maybe (Int,Int) }
-        , _mcoMaybeSelect :: Maybe (Int,Int)
-        , _mcoAboveSelect :: Maybe (Int,Int)
-        , _mcoBelowSelect :: Maybe (Int,Int)
-        }
---    | OverInvDragSelect { _mcoSecSelStart :: (Int,Int), _mcoSelEnd :: Maybe Int }
     | OverInvDragSelect { _mcoSecSelStart :: Maybe (Int,Int), _mcoSelEnd :: Maybe Int }
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverCombFiltInv { _mcoInvFilt :: (Int,Int)}

src/Dodge/Data/RightButtonOptions.hs

@@ -1,27 +1,24 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.RightButtonOptions where
 
-import Dodge.Data.Item.Location
-import NewInt
 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
@@ -29,18 +26,15 @@ data EquipmentAllocation
     | SwapEquipment
         { _allocNewPos :: EquipSite
         , _allocOldPos :: EquipSite
-        , _allocSwapID :: NewInt InvInt
+        , _allocSwapID :: NewInt ItmInt
         }
     | ReplaceEquipment
         { _allocNewPos :: EquipSite
-        , _allocRemoveID :: NewInt InvInt
+        , _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/SelectionList.hs

@@ -36,9 +36,7 @@ data SelectionSection a = SelectionSection
 
 type IMSS a = IntMap (SelectionSection a)
 
-data SelectionWidth
+data SelectionWidth = FixedSelectionWidth Int | UseItemWidth
-    = FixedSelectionWidth Int
-    | UseItemWidth
 
 data SelectionItem a
     = SelItem

src/Dodge/Data/Terminal.hs

@@ -50,7 +50,6 @@ data TCom
     = TCInfo String String -- this may not be necessary, to revisit
     | TCBase
     | TCDamageCommand
-    | TCSensorInfo
 
 data TmWdWd
     = TmWdId
@@ -61,7 +60,6 @@ data TmWdWd
     | TmWdWdDoDeathTriggers
     | TmTmClearDisplayedLines
     | TmTmSetStatus TerminalStatus
---    | TmGetSensor String
 
 makeLenses ''Terminal
 makeLenses ''TerminalLine

src/Dodge/Data/Terminal/Status.hs

@@ -13,6 +13,7 @@ data TerminalStatus
     | TerminalLineRead
     | TerminalTextInput {_tiText :: String}
     | TerminalPressTo {_tptString :: String}
+    | TerminalWaiting
     deriving (Eq,Show)
 
 makeLenses ''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
     }
 

src/Dodge/Data/World.hs

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

src/Dodge/Debug.hs

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

src/Dodge/Debug/Picture.hs

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

src/Dodge/Debug/Terminal.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TupleSections #-}
 
 module Dodge.Debug.Terminal where
 
+import Dodge.Inventory
 import Data.Foldable
 --import Dodge.Item.Location.Initialize
 import Control.Applicative
@@ -13,14 +15,12 @@ import Dodge.Creature
 import Dodge.Data.Universe
 import Dodge.Inventory.Add
 import Dodge.Item
---import Dodge.Menu.PushPop
---import qualified IntMapHelp as IM
 import LensHelp
 import MaybeHelp
 import Text.Read (readMaybe)
 
 applyTerminalString :: [String] -> Universe -> Universe
-applyTerminalString ss = case ss of
+applyTerminalString = \case
     [] -> id
     [s] -> applyTerminalCommand s
     (s : ss') -> applyTerminalCommandArguments s ss'
@@ -28,16 +28,18 @@ applyTerminalString ss = case ss of
 applyTerminalCommand :: String -> Universe -> Universe
 applyTerminalCommand s = case s of
     "NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
-    ['L', x] -> uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX x)
+    "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial 
---            (uvWorld . cWorld . lWorld %~ initSpecificCrItemLocations 0)
+        .~ Crystal
---        . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0 ..] $ inventoryX x))
+    "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial 
---            . (uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ 50)
+        .~ Flesh
---    ['I','S',x,y] ->  uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ read [x,y]
+    "CLEAR" -> \uv -> uv & uvWorld %~ destroyAllInvItems 
-    "GODON" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Crystal
+        (uv ^?! uvWorld . cWorld . lWorld . creatures . ix 0)
-    "GODOFF" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crType . avatarMaterial .~ Flesh
+    x -> fromMaybe (g x) $ do
-    x -> fromMaybe id $ do
         (ibt, n) <- parseItem [x]
-        return $ uvWorld %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
+        return $ uvWorld 
+            %~ flip (foldl' (&)) (replicate n ( createItemYou (itemFromBase ibt)))
+  where
+    g xs = uvWorld %~ \w -> foldl' (flip createItemYou) w (inventoryX xs)
 
 applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
 applyTerminalCommandArguments command args u = case command of
@@ -68,7 +70,7 @@ parseItem (x : xs) =
         <|> (readMaybe ("HELD {_ibtHeld=(" ++ x ++ " {_xNum=" ++ show (parseNum xs) ++ "})}") <&> (,1))
         <|> (readMaybe ("ATTACH (" ++ x ++ ")") <&> (,parseNum xs))
         <|> (readMaybe ("CONSUMABLE {_ibtConsumable=" ++ x ++ "}") <&> (,parseNum xs))
-        <|> (readMaybe ("AMMO {_ibtAmmo=" ++ x ++ "}") <&> (,parseNum xs))
+        <|> (readMaybe ("AMMOMAG {_ibtAmmoMag=" ++ x ++ "}") <&> (,parseNum xs))
         <|> parseItem (xs & ix 0 .++~ (x ++ " "))
 parseItem [] = Nothing
 

src/Dodge/Default/World.hs

@@ -40,7 +40,7 @@ defaultWorld =
         , _playingSounds = M.empty
         , _randGen = mkStdGen 2
         , _testFloat = 0
-        , _rbOptions = NoRightButtonOptions
+        , _rbState = NoRightButtonState
         , _hud = defaultHUD
         , _worldEventFlags = mempty
         , _crZoning = mempty
@@ -159,20 +159,14 @@ defaultLWorld =
 defaultHUD :: HUD
 defaultHUD =
     HUD
-        { _hudElement = defaultDisplayInventory
+        { _subInventory = NoSubInventory
+        , _diSections = mempty
+        , _diSelection = Just (Sel 1 0 mempty)
+        , _diInvFilter = mempty
+        , _diCloseFilter = mempty
         , _carteCenter = V2 0 0
         , _carteZoom = 0.5
         , _carteRot = 0
         , _closeItems = mempty
         , _closeButtons = mempty
         }
-
-defaultDisplayInventory :: HUDElement
-defaultDisplayInventory =
-    DisplayInventory
-        { _subInventory = NoSubInventory
-        , _diSections = mempty
-        , _diSelection = Just (1, 0, mempty)
-        , _diInvFilter = mempty
-        , _diCloseFilter = mempty
-        }

src/Dodge/Default/World.hs.orig

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

src/Dodge/DisplayInventory.hs

@@ -9,6 +9,7 @@ module Dodge.DisplayInventory (
     toggleCombineInv,
 ) where
 
+import Dodge.Data.HUD
 import Dodge.Inventory.CheckSlots
 import NewInt
 import Control.Applicative
@@ -16,7 +17,6 @@ import Control.Lens
 import Control.Monad
 import Data.IntMap.Merge.Strict
 import qualified Data.IntMap.Strict as IM
-import Data.IntSet (IntSet)
 import Data.Maybe
 import Data.Monoid
 import Dodge.Base.You
@@ -39,30 +39,30 @@ import Picture.Base
 updateCombinePositioning :: Universe -> Universe
 updateCombinePositioning u =
     u
-        & uvWorld . hud . hudElement . subInventory . ciSections
+        & uvWorld . hud . subInventory . ciSections
             %~ updateCombineSections (_uvWorld u) (_uvConfig u)
-        & uvWorld . hud . hudElement . subInventory %~ checkCombineSelectionExists
+        & uvWorld . hud . subInventory %~ checkCombineSelectionExists
 
 updateCombineSections ::
     World ->
-    Configuration ->
+    Config ->
     IM.IntMap (SelectionSection CombinableItem) ->
     IM.IntMap (SelectionSection CombinableItem)
 updateCombineSections w cfig =
     updateSectionsPositioning
         (const 0)
-        (w ^? hud . hudElement . subInventory . ciSelection . _Just)
+        (w ^? hud . subInventory . ciSelection . _Just)
-        (getAvailableListLines secondColumnParams cfig)
+        (getAvailableListLines secondColumnLDP cfig)
         (IM.fromDistinctAscList [(-1, sfclose),(0, sclose')])
   where
-    filtcurs = w ^? hud . hudElement . subInventory . ciSelection . _Just . _1 == Just (-1)
+    filtcurs = w ^? hud . subInventory . ciSelection . _Just . slSec == Just (-1)
     (sfclose, sclose) =
         filterSectionsPair
             filtcurs
             (flip . andOrRegex $ regexCombs invitms)
             (IM.fromDistinctAscList . zip [0 ..] $ combineList w)
             "COMBINATIONS"
-            $ w ^? hud . hudElement . subInventory . ciFilter . _Just
+            $ w ^? hud . subInventory . ciFilter . _Just
     invitms = _unNIntMap $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ fold $ w ^? cWorld . lWorld . creatures . ix 0 . crInv
     sclose'
         | null sclose =
@@ -87,24 +87,24 @@ orRegex f x str = case words str of
 
 updateInventoryPositioning :: Universe -> Universe
 updateInventoryPositioning u =
-    u & uvWorld . hud . hudElement . diSections
+    u & uvWorld . hud . diSections
         %~ updateDisplaySections (_uvWorld u) (_uvConfig u)
         & uvWorld
         %~ checkInventorySelectionExists
 
 checkInventorySelectionExists :: World -> World
 checkInventorySelectionExists w
-    | isJust $ w ^? hud . hudElement . diSections . ix i . ssItems . ix j = w
+    | isJust $ w ^? hud . diSections . ix i . ssItems . ix j = w
     | otherwise = scrollAugNextInSection w
   where
-    (i, j, _) = fromMaybe (1, -1, mempty) $ w ^? hud . hudElement . diSelection . _Just
+    Sel i j _ = fromMaybe (Sel 1 (-1) mempty) $ w ^? hud . diSelection . _Just
 
 checkCombineSelectionExists :: SubInventory -> SubInventory
 checkCombineSelectionExists si
     | Just sss <- si ^? ciSections
-      , Just (i, j, _) <- si ^? ciSelection . _Just <|> Just (0, 0, mempty)
+      , Sel i j _ <- fromMaybe (Sel 0 0 mempty) $ si ^? ciSelection . _Just
       , isNothing $ si ^? ciSections . ix i . ssItems . ix j =
-        si & ciSelection ?~ (0, -1, mempty)
+        si & ciSelection ?~ Sel 0 (-1) mempty
             & ciSelection
             %~ scrollSelectionSections (-1) sss
     | otherwise = si
@@ -115,7 +115,7 @@ displayIndents 3 = 2
 displayIndents 5 = 2
 displayIndents _ = 0
 
-updateDisplaySections :: World -> Configuration -> IMSS () -> IMSS ()
+updateDisplaySections :: World -> Config -> IMSS () -> IMSS ()
 updateDisplaySections w cfig =
     updateSectionsPositioning
         displayIndents
@@ -135,15 +135,15 @@ updateDisplaySections w cfig =
                 ]
         )
   where
-    mselpos = w ^? hud . hudElement . diSelection . _Just
+    mselpos = w ^? hud . diSelection . _Just
-    invfiltcurs = mselpos ^? _Just . _1 == Just (-1)
+    invfiltcurs = mselpos ^? _Just . slSec == Just (-1)
     (sfinv, sinv) =
         filterSectionsPair invfiltcurs plainRegex invitems "INVENTORY" $
-            w ^? hud . hudElement . diInvFilter . _Just
+            w ^? hud . diInvFilter . _Just
-    closefiltcurs = mselpos ^? _Just . _1 == Just 2
+    closefiltcurs = mselpos ^? _Just . slSec == Just 2
     (sfclose, sclose) =
         filterSectionsPair closefiltcurs plainRegex closeitms "NEARBY ITEMS" $
-            w ^? hud . hudElement . diCloseFilter . _Just
+            w ^? hud . diCloseFilter . _Just
     nearbyhead 
         | null sfclose && not (null sclose) = makehead "NEARBY ITEMS"
         | otherwise = sfclose
@@ -156,11 +156,11 @@ updateDisplaySections w cfig =
     cr = you w
     closeitms =
         IM.fromDistinctAscList . zip [0 ..] $
-            mapMaybe (closeItemToSelectionItem w) (map _unNInt $ w ^. hud . closeItems)
+            mapMaybe (closeItemToSelectionItem w . _unNInt) (w ^. hud . closeItems)
     invitems =
         IM.map
             (uncurry (invSelectionItem w))
-            (invIndents $ fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
+            (invIndents $ (\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
 
 filterSectionsPair ::
     Bool -> -- check for whether filter is in focus, changes string at the end
@@ -241,7 +241,7 @@ doSectionSize extraavailable mintaken is sss done = fromMaybe done $ do
 
 updateSectionsPositioning ::
     (Int -> Int) -> -- for determining each sections indent
-    Maybe (Int, Int, IntSet) ->
+    Maybe Selection ->
     Int ->
     IM.IntMap (IM.IntMap (SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
@@ -251,13 +251,13 @@ updateSectionsPositioning h mselpos allavailablelines lsss sss =
   where
     offsets = fmap _ssOffset sss
     m k = do
-        (k', i, _) <- mselpos
+        Sel k' i _ <- mselpos
         guard $ k == k'
         return i
     ls = lsss
     -- defaults non-existing offsets to 0
     g = merge (mapMissing (const ($ 0))) dropMissing (zipWithMatched (const ($)))
-    lk = mselpos ^.. _Just . _1
+    lk = mselpos ^.. _Just . slSec
     ssizes = sectionsSizes allavailablelines lk $ sectionsDesiredLines ls
 
 updateSection ::
@@ -315,16 +315,16 @@ regexList = any . List.isInfixOf
 
 toggleCombineInv :: Universe -> Universe
 toggleCombineInv uv =
-    uv & case uv ^? uvWorld . hud . hudElement . subInventory of
+    uv & case uv ^? uvWorld . hud . subInventory of
-        Just CombineInventory{} -> uvWorld . hud . hudElement . subInventory .~ NoSubInventory
+        Just CombineInventory{} -> uvWorld . hud . subInventory .~ NoSubInventory
         _ -> uvWorld %~ enterCombineInv (uv ^. uvConfig)
 
-enterCombineInv :: Configuration -> World -> World
+enterCombineInv :: Config -> World -> World
 enterCombineInv cfig w =
-    w & hud . hudElement . subInventory
+    w & hud . subInventory
         .~ CombineInventory
             { _ciSections = updateCombineSections w cfig mempty
-            , _ciSelection = Just (0,0,mempty)
+            , _ciSelection = Just (Sel 0 0 mempty)
             , _ciFilter = Nothing
             }
-        & hud . hudElement . diInvFilter .~ Nothing
+        & hud . diInvFilter .~ Nothing

src/Dodge/Equipment.hs

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

src/Dodge/Equipment/Text.hs

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

src/Dodge/Euse.hs

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

src/Dodge/Event/Input.hs

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

src/Dodge/Floor.hs

@@ -4,8 +4,8 @@ module Dodge.Floor (
     tutRoomTree,
 ) where
 
+import Dodge.Room.Tutorial
 import Dodge.Annotation.Data
---import Dodge.Room.Tutorial
 import Data.List (intersperse)
 import Dodge.Annotation
 import Dodge.Cleat
@@ -24,8 +24,7 @@ initialRoomTree = annoToRoomTree initialAnoTree
 --initialRoomTree = annoToRoomTree startWorldTreeTest
 
 tutRoomTree :: State LayoutVars (MetaTree Room String)
---tutRoomTree = annoToRoomTree tutAnoTree
+tutRoomTree = annoToRoomTree tutAnoTree
-tutRoomTree = annoToRoomTree initialAnoTree
 
 --startWorldTreeTest :: Annotation
 --startWorldTreeTest  =
@@ -129,4 +128,4 @@ intAnno f = do
     zoom lyGen (f i)
 
 anRoom :: State StdGen Room -> Annotation
-anRoom t = AnTree $ zoom lyGen $ (tToBTree "anRoom" . return . cleatOnward <$> t)
+anRoom t = AnTree $ zoom lyGen (tToBTree "anRoom" . return . cleatOnward <$> t)

src/Dodge/HeldUse.hs

@@ -160,14 +160,7 @@ locMuzzles loc
 
 itemMuzzles :: Item -> [Muzzle]
 itemMuzzles itm = case itm ^. itType of
-    HELD ALTERIFLE ->
+    HELD hit -> heldItemMuzzles itm hit
-        dbwMuzzles & ix 0 . mzPos .~ V2 25 0
-            & ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm)) (UseExactly 1)
-    HELD (VOLLEYGUN i) -> fromMaybe [] $ do
-        j <- itm ^? itParams . unfiredBarrels . ix 0
-        x <- vgunMuzzles i ^? ix j
-        return [x]
-    HELD hit -> heldItemMuzzles hit
     DETECTOR{} ->
         dbwMuzzles & ix 0 . mzEffect .~ MuzzleDetector
             & ix 0 . mzAmmoSlot . aps .~ UseExactly 100
@@ -179,8 +172,15 @@ itemMuzzles itm = case itm ^. itType of
             & ix 0 . mzEffect .~ MuzzleLaser
     _ -> []
 
-heldItemMuzzles :: HeldItemType -> [Muzzle]
+heldItemMuzzles :: Item -> HeldItemType -> [Muzzle]
-heldItemMuzzles = \case
+heldItemMuzzles itm = \case
+    ALTERIFLE ->
+        dbwMuzzles & ix 0 . mzPos .~ V2 25 0
+            & ix 0 . mzAmmoSlot .~ MagBelow (_alteRifleSwitch (_itParams itm)) (UseExactly 1)
+    (VOLLEYGUN i) -> fromMaybe [] $ do
+        j <- itm ^? itParams . unfiredBarrels . ix 0
+        x <- vgunMuzzles i ^? ix j
+        return [x]
     BANGSTICK i ->
         [ Muzzle
             (V2 10 0)
@@ -201,6 +201,7 @@ heldItemMuzzles = \case
     AUTOPISTOL -> [Muzzle (V2 10 0) 0 0 maguse1 BasicFlare MuzzleShootBullet 0]
     SMG -> [Muzzle (V2 20 0) 0 0.05 maguse1 BasicFlare MuzzleShootBullet 0]
     RIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
+    AUTORIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0
     BURSTRIFLE -> dbwMuzzles & ix 0 . mzPos .~ V2 25 0 & ix 0 . mzInaccuracy .~ 0.05
     MINIGUNX i ->
         replicate
@@ -235,7 +236,6 @@ heldItemMuzzles = \case
     BLUNDERBUSS -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet 12]
     GRAPECANNON i -> [Muzzle (V2 30 0) 0 0.5 magupto15 BasicFlare MuzzleShootBullet (12 + 4 * fromIntegral i)]
     TORCH -> dbwMuzzles & ix 0 . mzPos .~ V2 10 0
-    VOLLEYGUN{} -> error "should get volleygun muzzles earlier"
     FLAMETHROWER -> flameMuzzles
     FLAMESPITTER -> flameMuzzles & ix 0 . mzEffect . nzPressure .~ UniRandFloat 3 4
     RLAUNCHER ->
@@ -444,7 +444,7 @@ applySoundCME itm cr = fromMaybe id $ do
     return $
         if x > 0
             then soundContinue (CrWeaponSound cid 0) (_crPos cr) soundid (Just x)
-            else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 5]] (_crPos cr) soundid Nothing
+            else soundMultiFrom [CrWeaponSound cid j | j <- [0 .. 16]] (_crPos cr) soundid Nothing
   where
     cid = _crID cr
 
@@ -620,26 +620,30 @@ heldTorqueAmount = \case
 
 -- fugly
 loadMuzzle :: LocationDT OItem -> Creature -> (Bool, World) -> Muzzle -> (Bool, World)
-loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ do
+loadMuzzle loc cr (b, w) mz = maybe (b, w) (True,) $ case mz ^. mzAmmoSlot of
-    case mz ^. mzAmmoSlot of
+    NoAmmoRequired -> return (useLoadedAmmo loc cr mz Nothing w)
-        NoAmmoRequired -> return (useLoadedAmmo loc cr mz Nothing w)
+    as -> do
-        as -> do
+        mag <- case as of
-            mag <- case as of
+            MagBelow mi _ ->
-                MagBelow mi _ -> find (isAmmoIntLink mi . (^. dtValue . _2)) (loc ^. locDT . dtLeft)
+                find
-                CapacitorSelf _ -> loc ^? locDT
+                    (isAmmoIntLink mi . (^. dtValue . _2))
-                CapacitorBelow _ ->
+                    (loc ^. locDT . dtLeft)
-                    find
+            CapacitorSelf _ -> loc ^? locDT
-                        ((== PulseBallSF) . (^. dtValue . _2))
+            CapacitorBelow _ ->
-                        (loc ^. locDT . dtLeft)
+                find
-            mid <- mag ^? dtValue . _1 . itID . unNInt
+                    ((== PulseBallSF) . (^. dtValue . _2))
-            availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
+                    (loc ^. locDT . dtLeft)
-            let usedammo = case as ^?! aps of
+        mid <- mag ^? dtValue . _1 . itID . unNInt
-                    UseUpTo x -> min x availableammo
+        availableammo <- w ^? cWorld . lWorld . items . ix mid . itConsumables . _Just
-                    UseExactly x
+        let usedammo = case as ^?! aps of
-                        | x <= availableammo -> x
+                UseUpTo x -> min x availableammo
-                        | otherwise -> 0
+                UseExactly x
-            guard $ usedammo > 0
+                    | x <= availableammo -> x
-            return $ useLoadedAmmo loc cr mz (Just (usedammo, mag)) w
+                    | otherwise -> 0
+        guard $ usedammo > 0
+        return $
+            useLoadedAmmo loc cr mz (Just (usedammo, mag)) $
+                removeAmmoFromMag usedammo mid w
 
 makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World
 makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
@@ -668,12 +672,11 @@ makeMuzzleFlare mz loc cr = case mz ^. mzFlareType of
 
 --{-# OPTIONS -Wno-incomplete-uni-patterns #-}
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w =
+muzFlareAt col x dir w =
-    w & randGen .~ g
+    w & randGen .~ g & cWorld . lWorld . flares <>~ thepic
-        & cWorld . lWorld . flares <>~ thepic
   where
     thepic =
-        setLayer BloomLayer . translate3 tranv . color col . rotate dir . polygon $
+        setLayer BloomLayer . translate3 x . color col . rotate dir . polygon $
             [ V2 0 0
             , V2 a (- b)
             , V2 c d
@@ -718,7 +721,7 @@ useLoadedAmmo ::
     World ->
     World
 useLoadedAmmo loc cr mz m w =
-    removeAmmoFromMag m . makeMuzzleFlare mz loc cr $ case _mzEffect mz of
+    makeMuzzleFlare mz loc cr $ case _mzEffect mz of
         MuzzleShootBullet -> shootBullets loc cr (mz, x, magtree) w
         MuzzleLaser -> creatureShootLaser loc cr mz w
         MuzzlePulseLaser -> creatureShootPulseLaser loc cr mz w
@@ -735,7 +738,7 @@ useLoadedAmmo loc cr mz m w =
                 mz
                 cr
                 w
-        MuzzleNozzle{} -> useGasParams mid mz loc cr $ walkNozzle mz itm w
+        MuzzleNozzle{} -> useGasParams mitid mz loc cr $ walkNozzle mz itm w
         MuzzleShatter -> shootShatter itm cr w
         MuzzleDetector ->
             itemDetectorEffect
@@ -751,7 +754,7 @@ useLoadedAmmo loc cr mz m w =
         MuzzleScroller -> useTimeScrollGun itm cr w
   where
     itmtree = loc ^. locDT
-    mid = magtree ^? dtValue . _1 . itLocation . ilInvID
+    mitid = magtree ^. dtValue . _1 . itID
     itm = itmtree ^. dtValue . _1
     (x, magtree) = fromJust m
 
@@ -779,11 +782,7 @@ itemDetectorEffect itm mitid armitid cr w = fromMaybe w $ do
 walkNozzle :: Muzzle -> Item -> World -> World
 walkNozzle mz itm w =
     w
-        & cWorld . lWorld . items
+        & cWorld . lWorld . items . ix (itm ^. itID . unNInt) . itParams . nzAngle %~ f
-            . ix (itm ^. itID . unNInt)
-            . itParams
-            . nzAngle
-            %~ f
         & randGen .~ g
   where
     nz = _mzEffect mz
@@ -918,17 +917,9 @@ shootPulseBall p dir w =
   where
     i = IM.newKey $ w ^. cWorld . lWorld . pulseBalls
 
---removeAmmoFromMag :: Int -> Maybe Int -> Creature -> World -> World
+removeAmmoFromMag :: Int -> Int -> World -> World
-removeAmmoFromMag :: Maybe (Int, DTree OItem) -> World -> World
+removeAmmoFromMag x magid =
-removeAmmoFromMag m = fromMaybe id $ do
+    cWorld . lWorld . items . ix magid . itConsumables . _Just -~ x
-    (x, magtree) <- m
-    magid <- magtree ^? dtValue . _1 . itID . unNInt
-    return $
-        cWorld . lWorld . items
-            . ix magid
-            . itConsumables
-            . _Just
-            -~ x
 
 getBulletType :: DTree OItem -> Maybe Bullet
 getBulletType magtree =
@@ -1118,9 +1109,14 @@ mcUseHeld hit = case hit of
     LASER -> mcShootLaser
     _ -> mcShootAuto
 
-useGasParams :: Maybe (NewInt InvInt) 
+useGasParams ::
-    -> Muzzle -> LocationDT OItem -> Creature -> World -> World
+    NewInt ItmInt ->
-useGasParams mmagid mz loc cr w =
+    Muzzle ->
+    LocationDT OItem ->
+    Creature ->
+    World ->
+    World
+useGasParams (NInt magitid) mz loc cr w =
     w
         & createGas gastype pressure pos dir cr
         & randGen .~ g'
@@ -1128,9 +1124,8 @@ useGasParams mmagid mz loc cr w =
     itm = loc ^. locDT . dtValue . _1
     (pressure, g) = doGenFloat (_nzPressure $ _mzEffect mz) (_randGen w)
     gastype = fromMaybe (error "cannot find gas ammo") $ do
-        magid <- mmagid
         hit <- itm ^? itType . ibtHeld
-        fueltype <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= magAmmoParams >>= (^? ampCreateGas)
+        fueltype <- w ^? cWorld . lWorld . items . ix magitid >>= magAmmoParams >>= (^? ampCreateGas)
         gasType hit fueltype
     (V3 x y _, q) =
         locOrient loc cr
@@ -1319,25 +1314,17 @@ createProjectile ::
     Creature ->
     World ->
     World
-createProjectile x pjtype magtree stab muz cr w =
+createProjectile x pjtype mtree stab muz cr w = fromMaybe (failsound w) $ do
-    w
+    magitid <- mtree ^? dtValue . _1 . itID . unNInt
-        & ( fromMaybe failsound $ do
+    ammoitem <- w ^? cWorld . lWorld . items . ix magitid
-                magid <- magtree ^? dtValue . _1 . itLocation . ilInvID
+    let rdetonate =
-                ammoitem <- cr ^? crInv . ix magid >>= \k -> w ^? cWorld . lWorld . items . ix k
+            (^. dtValue . _1 . itID) <$> find isrdet (mtree ^. dtLeft)
-                let rdetonate =
+        rscreen =
-                        (^. dtValue . _1 . itID)
+            (^. dtValue . _1 . itID) <$> find isrscreen (mtree ^. dtLeft)
-                            <$> find isrdet (magtree ^. dtLeft)
+    aparams <-
-                    rscreen =
+        ((mtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-                        (^. dtValue . _1 . itID)
+            <|> magAmmoParams ammoitem ^? _Just . ampPayload
-                            <$> find isrscreen (magtree ^. dtLeft)
+    return . makesound $ createShell x rdetonate rscreen stab pjtype aparams muz cr w
-                aparams <-
-                    ((magtree ^? dtLeft) >>= find isampay >>= (^? dtValue . _1 . itType . ibtAttach . shellPayload))
-                        --            <|> ammoitem ^? itConsumables . magParams . ampPayload
-                        <|> magAmmoParams ammoitem ^? _Just . ampPayload
-                return $
-                    createShell x rdetonate rscreen stab pjtype aparams muz cr
-                        . startthesound
-          )
   where
     isrdet :: DTree OItem -> Bool
     isrdet y = case y ^. dtValue . _2 of
@@ -1353,7 +1340,7 @@ createProjectile x pjtype magtree stab muz cr w =
         _ -> False
 
     -- the sound should be moved to the projectile firing
-    startthesound =
+    makesound =
         soundMultiFrom
             [CrWeaponSound (_crID cr) j | j <- [0 .. 3]]
             (_crPos cr)

src/Dodge/InputFocus.hs

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

src/Dodge/Inventory.hs

@@ -17,7 +17,6 @@ module Dodge.Inventory (
 ) where
 
 import Data.Function
-import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
@@ -38,9 +37,7 @@ import NewInt
 -- should consider never fully destroying items, but assigning a flag saying how
 -- they were moved from play
 destroyInvItem :: Int -> NewInt InvInt -> World -> World
-destroyInvItem cid invid w =
+destroyInvItem cid invid w = rmInvItem cid invid w & removeitloc & removeithotkey
-    rmInvItem cid invid w & removeitloc
-        & removeithotkey
   where
     removeitloc = fromMaybe id $ do
         itid <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
@@ -79,7 +76,7 @@ rmInvItem cid invid w =
         & dounequipfunction --the ordering of these is
         & pointcid . crInv %~ f -- important
         & removeAnySlotEquipment
-        & pointcid . crEquipment . each %~ g
+        & cWorld . lWorld . items . ix itid . itLocation . ilEquipSite .~ Nothing
         & updateselection
         & updateselectionextra
         & pointcid %~ updateRootItemID (w ^. cWorld . lWorld . items)
@@ -87,7 +84,7 @@ rmInvItem cid invid w =
   where
     pointcid = cWorld . lWorld . creatures . ix cid
     updateselectionextra
-        | cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ const mempty
+        | cid == 0 = hud . diSelection . _Just . slSet %~ const mempty
         | otherwise = id
     updateselection
         | cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
@@ -98,18 +95,13 @@ rmInvItem cid invid w =
     itid = _crInv cr ^?! ix invid
     itm = w ^?! cWorld . lWorld . items . ix itid
     dounequipfunction = effectOnRemove itm cr
-    --  fromMaybe id $ do
-    --    rmf <- itm ^? itUse . uequipEffect . eeOnRemove
-    --    return $ doItmCrWdWd rmf itm cr
     removeAnySlotEquipment = fromMaybe id $ do
-        epos <-
+        epos <- itm ^?
-            w
+                     itLocation
-                ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
-                >>= \k -> w ^? cWorld . lWorld . items . ix k
-                    . itLocation
                     . ilEquipSite
                     . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
+--        return $ pointcid . crEquipment .~ mempty
     maxk = fmap fst $ IM.lookupMax $ _unNIntMap $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split (_unNInt invid) $ _unNIntMap inv
@@ -121,23 +113,22 @@ rmInvItem cid invid w =
 
 updateCloseObjects :: World -> World
 updateCloseObjects w =
-    w & hud . closeItems %~ f
+    w & hud . closeItems %~ h citems
-        & hud . closeButtons %~ g
+        & hud . closeButtons %~ h cbts
   where
-    g oldbts = intersect oldbts cbts `union` cbts
+    h a b = intersect b a `union` a
-    f olditems = intersect olditems citems `union` citems
     lw = w ^. cWorld . lWorld
-    citems = let is = IM.filter (isclose . _flItPos) (lw^.floorItems)
+    citems = map NInt $ IM.keys $ IM.intersection (lw ^. items) 
-        in map NInt $ IM.keys $ IM.intersection (lw ^. items) is
+        $ IM.filter (isclose . _flItPos) (lw^.floorItems)
-    isclose x = dist y x < 40 && hasButtonLOS y x w
-    y = _crPos $ you w
     cbts = lw^..buttons . each . filtered canpress . filtered (isclose . _btPos) . to _btID
     canpress bt = case bt ^. btEvent of
         ButtonPress{_btOn = t} -> not t
         ButtonAccessTerminal tid -> fromMaybe False $ do
-            x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
+            x <- lw ^? terminals . ix tid . tmStatus
             return (x /= TerminalDeactivated)
         _ -> True
+    isclose x = dist y x < 40 && hasButtonLOS y x w
+    y = _crPos $ you w
 
 changeSwapSel :: Int -> World -> World
 changeSwapSel yi w
@@ -154,7 +145,7 @@ changeSwapOther ::
     World ->
     World
 changeSwapOther manlens n f i w = fromMaybe w $ do
-    ss <- w ^? hud . hudElement . diSections . ix n . ssItems
+    ss <- w ^? hud . diSections . ix n . ssItems
     k <- f i ss
     let doswap j
             | j == i = k
@@ -166,7 +157,7 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
             & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . manlens
                 %~ doswap
             & hud . closeItems %~ swapIndices i k
-            & hud . hudElement . diSelection . _Just . _2 %~ doswap
+            & hud . diSelection . _Just . slInt %~ doswap
             & worldEventFlags . at InventoryChange ?~ ()
 
 swapItemWith ::
@@ -182,40 +173,25 @@ swapItemWith f (j, i) = case j of
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w 
-    | Just (j,i,_) <- w ^. hud . hudElement . diSelection = swapItemWith f (j,i) w
+    | Just (Sel j i _) <- w ^. hud . diSelection = swapItemWith f (j,i) w
     | otherwise = w
 
---changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
+invSetSelection :: Selection -> World -> World
---changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
---    Just (0, i, _) -> w & swapInvItems f i
---    Just (3, i, _) -> w & changeSwapOther ispCloseItem 3 f i
---    Just (5, i, _) -> w & changeSwapOther ispCloseButton 5 f i
---    _ -> w
-
-invSetSelection :: (Int, Int, IS.IntSet) -> World -> World
 invSetSelection sel w =
     w
-        & hud . hudElement . diSelection ?~ sel
+        & hud . diSelection ?~ sel
         & worldEventFlags . at InventoryChange ?~ ()
         & setInvPosFromSS
         & cWorld . lWorld %~ crUpdateItemLocations 0
 
 invSetSelectionPos :: Int -> Int -> World -> World
-invSetSelectionPos i j w =
+invSetSelectionPos i j = invSetSelection (Sel i j mempty)
-    w
-        & hud . hudElement . diSelection %~ f
-        & worldEventFlags . at InventoryChange ?~ ()
-        & setInvPosFromSS
-        & cWorld . lWorld %~ crUpdateItemLocations 0
-  where
-    f Nothing = Just (i, j, mempty)
-    f (Just (_, _, s)) = Just (i, j, s)
 
 scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
     | yi == 0 = w
     | otherwise =
-        w & hud . hudElement %~ doscroll
+        w & hud %~ doscroll
             & worldEventFlags . at InventoryChange ?~ ()
             & setInvPosFromSS
             & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -226,7 +202,7 @@ scrollAugInvSel yi w
 
 scrollAugNextInSection :: World -> World
 scrollAugNextInSection w =
-    w & hud . hudElement %~ doscroll
+    w & hud %~ doscroll
         & worldEventFlags . at InventoryChange ?~ ()
         & setInvPosFromSS
         & cWorld . lWorld %~ crUpdateItemLocations 0

src/Dodge/Inventory/Add.hs

@@ -19,7 +19,6 @@ import Dodge.SoundLogic
 import qualified IntMapHelp as IM
 import NewInt
 
--- should check that the item is not already in your inventory
 -- this assumes that this item is currently on the floor
 tryPutItemInInv :: Int -> Int -> World -> Maybe (NewInt InvInt, World)
 tryPutItemInInv cid itid w = do
@@ -43,7 +42,8 @@ tryPutItemInInv cid itid w = do
                 & updateselectionextra invid
   where
     updateselectionextra i
-        | cid == 0 = hud . hudElement . diSelection . _Just . _3 %~ IS.map (f i)
+        | cid == 0 = (hud . diSelection . _Just . slSet %~ IS.map (f i))
+            . (hud . diSelection . _Just . slInt %~ f i)
         | otherwise = id
     f j i | i >= _unNInt j = i + 1
           | otherwise = i

src/Dodge/Inventory/Location.hs

@@ -4,7 +4,6 @@ module Dodge.Inventory.Location (
     setInvPosFromSS,
 ) where
 
-import Control.Applicative
 import Control.Lens
 import Data.Foldable
 --import Data.IntMap.Merge.Strict
@@ -32,16 +31,17 @@ tryGetRootAttachedFromInvID (NInt invid) im = do
 
 -- this assumes the creature inventory is well formed, specifically the
 -- location ids
-tryGetRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Maybe Int
+-- note the item intmap is all items
-tryGetRootItemInvID m i cr = do
+getRootItemInvID :: IM.IntMap Item -> Int -> Creature -> Int
+getRootItemInvID m i cr = fromMaybe i $ do
     let adj = invAdj $ fmap (\k -> m ^?! ix k) (_crInv cr)
     theroot <- adj ^? ix i
-    theroot ^? _1 . _Just . _1 <|> Just i
+    theroot ^? _1 . _Just . _1
 
 updateRootItemID :: IM.IntMap Item -> Creature -> Creature
 updateRootItemID m cr = fromMaybe cr $ do
     i <- cr ^? crManipulation . manObject . imSelectedItem . unNInt
-    j <- tryGetRootItemInvID m i cr
+    let j = getRootItemInvID m i cr
     return $ cr & crManipulation . manObject . imRootSelectedItem .~ NInt j
 
 -- the following assumes that the crManipulation is correct
@@ -49,7 +49,6 @@ crUpdateItemLocations :: Int -> LWorld -> LWorld
 crUpdateItemLocations crid lw = fromMaybe lw $ do
     mo <- lw ^? creatures . ix crid . crManipulation . manObject
     cinv <- lw ^? creatures . ix crid . crInv
-    --let crinv = IM.restrictKeys  (lw ^. items) (IS.fromList $ IM.elems itids)
     let crinv = fmap (\k -> lw ^?! items . ix k) cinv
     return $ crSetRoots crid $ IM.foldlWithKey' (crUpdateInvidLocations mo crid) lw $ _unNIntMap crinv
 
@@ -62,8 +61,7 @@ crSetRoots cid w = fromMaybe w $ do
     g w' i = w' & items . ix i . itLocation . ilIsRoot .~ False
     f :: LWorld -> DTree OItem -> LWorld
     f w' x =
-        w'
+        w' & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
-            & items . ix (x ^. dtValue . _1 . itID . unNInt) . itLocation . ilIsRoot .~ True
 
 crUpdateInvidLocations ::
     ManipulatedObject ->
@@ -74,7 +72,7 @@ crUpdateInvidLocations ::
     LWorld
 crUpdateInvidLocations mo crid lw invid itm =
     lw
-        & creatures . ix crid . crInv . ix (NInt invid) .~ itid -- . itLocation .~ newloc
+        & creatures . ix crid . crInv . ix (NInt invid) .~ itid
         & items . ix itid .~ (itm & itLocation .~ newloc)
   where
     itid = itm ^. itID . unNInt
@@ -85,8 +83,7 @@ crUpdateInvidLocations mo crid lw invid itm =
             , _ilIsRoot = Just (NInt invid) == mo ^? imRootSelectedItem
             , _ilIsSelected = Just (NInt invid) == mo ^? imSelectedItem
             , _ilIsAttached = invid `IS.member` (mo ^. imAttachedItems)
-            , _ilEquipSite = do
+            , _ilEquipSite = lw ^? items . ix itid . itLocation . ilEquipSite . _Just
-                lw ^? items . ix itid . itLocation . ilEquipSite . _Just
             }
 
 -- this should be looked at, as it is sometimes used in functions that need not
@@ -97,7 +94,7 @@ setInvPosFromSS w = w
         & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject .~ thesel
   where
     thesel = fromMaybe SelNothing $ do
-        (i, j, _) <- w ^? hud . hudElement . diSelection . _Just
+        Sel i j _ <- w ^? hud . diSelection . _Just
         case i of
             (-1) -> Just SortInventory
             0 -> do

src/Dodge/Inventory/RBList.hs

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

src/Dodge/Inventory/SelectionList.hs

@@ -88,7 +88,7 @@ itemExternalValue itm w cr
         displayPulse $ cr ^?! crType . avatarPulse . pulseProgress
     | Just t <- itm ^? itType . ibtIntroScanType = Just $ introScanValue cr t
     | ITEMSCAN <- itm ^. itType
-    , Just ExamineInventory <- w ^? hud . hudElement . subInventory
+    , Just ExamineInventory <- w ^? hud . subInventory
         = Just (Right "ON")
     | BINGATE <- itm ^. itType = do
         invid <- itm ^? itLocation . ilInvID

src/Dodge/Inventory/Swap.hs

@@ -24,11 +24,11 @@ swapInvItems ::
     World ->
     World
 swapInvItems f i w = fromMaybe w $ do
-    ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
+    ss <- w ^? hud . diSections . ix 0 . ssItems
     k <- f i ss
-    let updateselection = case w ^? hud . hudElement . diSelection . _Just of
+    let updateselection = case w ^? hud . diSelection . _Just of
-            Just (0, j,_) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
+            Just (Sel 0 j _) | j == k -> hud . diSelection . _Just . slInt .~ i
-            Just (0, j,_) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
+            Just (Sel 0 j _) | j == i -> hud . diSelection . _Just . slInt .~ k
             _ -> id
     return $
         w
@@ -55,11 +55,11 @@ swapInvItems f i w = fromMaybe w $ do
 
 swapAnyExtraSelection :: Int -> Int -> World -> World
 swapAnyExtraSelection i k w = fromMaybe w $ do
-    is <- w ^? hud . hudElement . diSelection . _Just . _3
+    is <- w ^? hud . diSelection . _Just . slSet
     let f = if i `IS.member` is then IS.insert k else id
         g = if k `IS.member` is then IS.insert i else id
     return $
-        w & hud . hudElement . diSelection . _Just . _3
+        w & hud . diSelection . _Just . slSet
             %~ (f . g . IS.delete i . IS.delete k)
 
 checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World

src/Dodge/Item/AimStance.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
-module Dodge.Item.AimStance (aimStance,itemBaseStance) where
+module Dodge.Item.AimStance (itemAimStance,itemBaseStance) where
 
 import Dodge.Data.Item
 import Dodge.Data.ComposedItem
@@ -7,8 +7,8 @@ import Dodge.Data.DoubleTree
 import Control.Lens
 import Dodge.Data.AimStance
 
-aimStance :: DTree CItem -> AimStance
+itemAimStance :: DTree CItem -> AimStance
-aimStance dt 
+itemAimStance dt 
     | islasweapon = TwoHandFlat
     | otherwise = itemBaseStance $ dt ^. dtValue . _1
   where

src/Dodge/Item/BackgroundEffect.hs

@@ -20,7 +20,7 @@ import Dodge.Wall.Move
 import Geometry.Vector
 
 cancelExamineInventory :: World -> World
-cancelExamineInventory = hud . hudElement . subInventory %~ f
+cancelExamineInventory = hud . subInventory %~ f
   where
     f ExamineInventory = NoSubInventory
     f x = x

src/Dodge/Item/Draw.hs

@@ -1,52 +1,40 @@
 {-# LANGUAGE LambdaCase #-}
-module Dodge.Item.Draw (
-    itemSPic,
-    itemEquipPict,
-) where
 
-import qualified Data.IntMap.Strict as IM
+module Dodge.Item.Draw (itemEquipPict) where
-import qualified Quaternion as Q
+
-import Dodge.Data.Equipment.Misc
-import Dodge.Data.ComposedItem
-import Dodge.Data.DoubleTree
-import Geometry.Data
 import Control.Lens
 import Dodge.Creature.HandPos
+import Dodge.Data.ComposedItem
 import Dodge.Data.Creature
+import Dodge.Data.DoubleTree
+import Dodge.Data.Equipment.Misc
 import Dodge.Item.Draw.SPic
 import Dodge.Item.HeldOffset
+import Geometry.Data
+import qualified Quaternion as Q
 import ShapePicture
 
-itemEquipPict :: IM.IntMap Item -> Creature -> DTree CItem -> SPic
+itemEquipPict :: Creature -> DTree CItem -> SPic
-itemEquipPict m cr itmtree
+itemEquipPict cr itmtree
-    | --Just i <- itm ^? itLocation . ilInvID
+    | Just esite <- itm ^? itLocation . ilEquipSite . _Just
-     Just esite <- itm ^? itLocation . ilEquipSite . _Just
+      , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip =
-    , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip
+        equipPosition esite cr attachpos (itemSPic itm)
-        = equipPosition esite m cr attachpos (itemSPic itm)
+    | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem =
-    | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem
+        overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
-        = overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree)
     | otherwise = mempty
   where
     itm = itmtree ^. dtValue . _1
     loc = LocDT TopDT itmtree
 
-equipAttachPos :: EquipItemType -> Point3
+equipAttachPos :: EquipItemType -> Point3Q
 equipAttachPos = \case
-    BATTERYPACK ->  V3 (-8) 0 10
+    BATTERYPACK -> (V3 (-8) 0 10, Q.qID)
-    FUELPACK -> V3 (-9) 0 10
+    FUELPACK -> (V3 (-9) 0 10, Q.qID)
-    BULLETBELTPACK -> V3 (-9) 0 10
+    BULLETBELTPACK -> (V3 (-9) 0 10, Q.qID)
-    BULLETBELTBRACER -> V3 (-9) 0 10
+    BULLETBELTBRACER -> (V3 (-9) 0 10, Q.qID)
-    _ -> 0
+    _ -> (0, Q.qID)
 
-equipPosition :: EquipSite -> IM.IntMap Item -> Creature -> Point3 -> SPic -> SPic
+equipPosition :: EquipSite -> Creature -> Point3Q -> SPic -> SPic
-equipPosition epos m cr p sh = case epos of
+equipPosition es cr q =
-    OnLeftWrist -> translateToLeftWrist m cr sh
+    overPosSP
-    OnRightWrist -> translateToRightWrist m cr sh
+        (\x -> fst $ equipSitePQ es cr `Q.comp` q `Q.comp` (x, Q.qID))
-    OnLegs ->
-        translateToLeftLeg cr sh
-            <> translateToRightLeg cr sh-- (mirrorSPxz sh)
-    OnHead -> translateToHead m cr sh
-    OnChest -> translateToChest m cr sh
-    --OnBack -> translateToBack cr p sh
-    OnBack -> overPosSP (\x -> fst $ backPQ m cr `Q.comp` (p + x,Q.qID)) sh
---    OnSpecial -> sh

src/Dodge/Item/HeldOffset.hs

@@ -34,9 +34,10 @@ handleOrient loc = case loc ^. locDT . dtValue . _1 . itType of
     _ -> (V3 (-3) 0 0, Q.qID)
 
 -- note this is relative to the creature
+-- the aimstance here should match any aimstance in Aiming
 handOrient :: Creature -> AimStance -> Point3Q
 handOrient cr = case cr ^. crStance . posture of
-    Aiming -> \case
+    Aiming {} -> \case
         TwoHandUnder -> (V3 (-3) 0 shoulderHeight, Q.qID)
         TwoHandOver -> (V3 0 0 shoulderHeight, Q.qID)
         OneHand -> (V3 13 (-2) shoulderHeight, Q.qID)
@@ -60,7 +61,7 @@ locOrient loc cr =
 
 handHandleOrient :: LocationDT CItem -> Creature -> Point3Q
 handHandleOrient loc cr =
-    handOrient cr (aimStance (loc' ^. locDT))
+    handOrient cr (itemAimStance (loc' ^. locDT))
         `Q.comp` handleOrient loc'
   where
     loc' = locToTop loc

src/Dodge/Item/Info.hs

@@ -257,7 +257,7 @@ equipSiteInfo es = case es of
     GoesOnChest -> " on the chest"
     GoesOnBack -> " on the back"
     GoesOnWrist -> " on a wrist"
-    GoesOnLegs -> " on both legs"
+    GoesOnLeg -> " on a leg"
 
 --makeCommaList :: [String] -> String
 --makeCommaList [] = ""

src/Dodge/Item/Location/Initialize.hs

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

src/Dodge/ListDisplayParams.hs

@@ -1,9 +1,9 @@
 module Dodge.ListDisplayParams (
     invDP,
     invCursorParams,
-    secondColumnParams,
+    secondColumnLDP,
     subInvX,
-    menuDisplayParams,
+    menuLDP,
 ) where
 
 import Control.Lens
@@ -34,14 +34,14 @@ invDP =
         & ldpPos . spPixelOff .~ V2 6 0
 
 invCursorParams :: World -> CursorDisplay
-invCursorParams w = BoundaryCursor $ case w ^? hud . hudElement . subInventory of
+invCursorParams w = BoundaryCursor $ case w ^? hud . subInventory of
 --    Just ExamineInventory{} -> [North, South, East, West]
     Just CombineInventory{} -> []
     _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
     _ -> [North, South, West]
 
-secondColumnParams :: ListDisplayParams
+secondColumnLDP :: ListDisplayParams
-secondColumnParams =
+secondColumnLDP =
     defaultListDisplayParams
         & ldpPos . spPixelOff .~ V2 subInvX (-81)
 
@@ -51,8 +51,8 @@ subInvX = 10 * fromIntegral topInvW + 70
 topInvW :: Int
 topInvW = 15
 
-menuDisplayParams :: ListDisplayParams
+menuLDP :: ListDisplayParams
-menuDisplayParams =
+menuLDP =
     defaultListDisplayParams
         & ldpPos . spPixelOff .~ V2 11 (-70)
         & ldpScale .~ 2

src/Dodge/Machine/Update.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
-module Dodge.Machine.Update (
-    updateMachine,
-) where
 
-import Dodge.Terminal.Color
+module Dodge.Machine.Update (updateMachine) where
+
 import Control.Monad
 import Data.List (partition)
 import Data.Maybe
@@ -11,9 +9,12 @@ import Dodge.Base.Collide
 import Dodge.Base.You
 import Dodge.Data.World
 import Dodge.HeldUse
+import Dodge.Item.Display
 import Dodge.Machine.Destroy
 import Dodge.Movement.Turn
 import Dodge.SoundLogic
+import Dodge.Terminal
+import Dodge.Terminal.Color
 import Geometry
 import LensHelp
 
@@ -40,6 +41,7 @@ terminalScreenGlow mc w = fromMaybe w $ do
     return $
         w & cWorld . lWorld . lights
             .:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
+
 --        w & cWorld . lWorld . tempLightSources
 --            .:~ TLS
 --                { _tlsParam = LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
@@ -140,21 +142,32 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
             & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
             & playsound dedaS
             & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
+            & cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal) . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS!"
     (NotClose, _, False, True) ->
         w & playsound dedumS
             & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
-    (_, _, _, False) -> w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
+            & cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal) . tmFutureLines
+            .:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString (mc ^?! mcType . _McSensor . proxRequirement))
+    (_, _, _, False) ->
+        w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
     _ -> w
   where
     playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
     ycr = you w
     sens = mc ^?! mcType . _McSensor
 
+sensorReqToString :: ProximityRequirement -> String
+sensorReqToString = \case
+    RequireHealth x -> "HEALTH ABOVE " ++ show x
+    RequireEquipment x -> itemBaseName x
+
 mcProxTest :: Machine -> World -> Bool
 mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
     Just (RequireHealth x) -> _crHP cr >= x
-    Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct) 
+    Just (RequireEquipment ct) ->
-        (fmap (\k -> w ^?! cWorld . lWorld . items . ix k) $ _crInv cr)
+        any
+            (\itm -> _itType itm == ct)
+            ((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
     _ -> False
   where
     cr = you w
@@ -179,24 +192,23 @@ senseDamage threshold dt mc =
 
 sensorTypeDamages :: SensorType -> Damage -> Bool
 sensorTypeDamages = \case
-    LaserSensor -> \case 
+    LaserSensor -> \case
         Lasering{} -> True
         _ -> False
     ElectricSensor -> \case
-        Electrical {} -> True
+        Electrical{} -> True
         _ -> False
     ThermalSensor -> \case
-        Flaming {} -> True
+        Flaming{} -> True
-        Sparking {} -> True
+        Sparking{} -> True
-        Explosive {} -> True
+        Explosive{} -> True
         _ -> False
     PhysicalSensor -> \case
-        Piercing {} -> True
+        Piercing{} -> True
-        Blunt {} -> True
+        Blunt{} -> True
-        Crushing {} -> True
+        Crushing{} -> True
-        Explosive {} -> True
+        Explosive{} -> True
         _ -> False
-    
 
 --damageUsing :: DamageType -> Damage -> Either Int Int
 --damageUsing dt dm

src/Dodge/Menu/Option.hs

@@ -24,7 +24,7 @@ initializeOptionMenu title ops pmo u =
         , _scPositionedMenuOption = pmo
         , _scOptionFlag = NormalOptions
         , _scSelectionList = optionsToSelections 10 u ops pmo
-        , _scAvailableLines = getAvailableListLines menuDisplayParams (u ^. uvConfig)
+        , _scAvailableLines = getAvailableListLines menuLDP (u ^. uvConfig)
         , _scDisplayTime = 0
         }
 

src/Dodge/Picture/SizeInvariant.hs

@@ -34,7 +34,7 @@ import Picture
 --    Int ->
 --    Picture ->
 --    Point2 ->
---    Configuration ->
+--    Config ->
 --    Camera ->
 --    Picture
 --fixedSizePicClamp xbord ybord pic p cfig w =
@@ -61,7 +61,7 @@ fixedSizePicClampArrow ::
     Float ->
     Picture ->
     Point2 ->
-    Configuration ->
+    Config ->
     World ->
     Picture
 fixedSizePicClampArrow xbord ybord pic p cfig w =

src/Dodge/Placement/Instance/Analyser.hs

@@ -4,7 +4,7 @@ import Color
 import Dodge.Data.GenWorld
 import Dodge.Default
 import Dodge.Placement.Instance
-import Dodge.Terminal
+--import Dodge.Terminal
 import LensHelp
 
 analyser :: ProximityRequirement -> PlacementSpot -> PlacementSpot -> Placement
@@ -13,14 +13,11 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
         plSpot .~ psmc $
             putTerminal (dark magenta)
                 (themachine & mcMounts . at OTTrigger .~ _plMID tp)
-                tparams -- (linksensortotrigger tp)
+                tparams
   where
-    tparams = textTerminal & tmCommands .:~ TCSensorInfo
+    tparams = defaultTerminal & tmStatus .~ TerminalLineRead
-    --    linksensortotrigger tp _ mc
-    --        = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
     themachine =
         defaultMachine & mcColor .~ aquamarine
-            --        & mcUpdate .~ mcProximitySensorUpdate
             & mcType .~ McTerminal
             & mcHP .~ 100
             & mcType .~ McSensor (defaultProximitySensor{_proxRequirement = proxreq})

src/Dodge/Placement/Instance/Terminal.hs

@@ -5,13 +5,13 @@ module Dodge.Placement.Instance.Terminal (
     terminalColor,
 ) where
 
-import Dodge.WorldEffect
 import Color
 import Data.Maybe
 import Dodge.Data.GenWorld
 import Dodge.Default
 import Dodge.LevelGen.PlacementHelper
 import Dodge.SoundLogic
+import Dodge.WorldEffect
 import Geometry
 import LensHelp
 
@@ -20,7 +20,11 @@ putTerminalImediateAccess = putTerminalFull f
   where
     f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ accessTerminal (tmpl ^?! plMID . _Just)
 
-putTerminalFull ::(Placement -> Placement -> Placement -> Maybe Placement) ->  Color -> Machine -> Terminal -> 
+putTerminalFull ::
+    (Placement -> Placement -> Placement -> Maybe Placement) ->
+    Color ->
+    Machine ->
+    Terminal ->
     Placement
 putTerminalFull f col mc tm =
     ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
@@ -31,6 +35,7 @@ putTerminalFull f col mc tm =
                         ( PutMachine
                             (reverse $ square 10)
                             ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
+                                & mcMounts . at OTTerminal .~ _plMID tmpl
                                 & mcCloseSound ?~ fridgeHumS
                             )
                             defaultSensorWall

src/Dodge/Placement/PlaceSpot.hs

@@ -1,12 +1,12 @@
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
 {- | deals with placement of objects within the world
  after they have had their coordinates set by the layout
 -}
 module Dodge.Placement.PlaceSpot (placeSpot) where
 
-import NewInt
 import Color
-import LensHelp
 import Control.Monad.State
 import Data.Bifunctor
 import Data.Foldable
@@ -21,6 +21,8 @@ import Dodge.Placement.Shift
 import Dodge.ShiftPoint
 import Geometry
 import qualified IntMapHelp as IM
+import LensHelp
+import NewInt
 import System.Random
 
 -- when placing a placement, we update the world and the room and assign an id
@@ -109,17 +111,21 @@ placeSpotID' ps pt w = case pt of
     PutProp prp -> plNewUpID (cWorld . lWorld . props) prID (mvProp p rot prp) w
     PutButton bt -> plNewUpID (cWorld . lWorld . buttons) btID (mvButton p rot bt) w
     PutTerminal tm -> plNewUpID (cWorld . lWorld . terminals) tmID tm w
-    PutFlIt itm -> let i = IM.newKey (w ^. cWorld . lWorld . items)
+    PutFlIt itm ->
-        in (i, w
+        let i = IM.newKey (w ^. cWorld . lWorld . items)
-            & cWorld . lWorld . floorItems . at i ?~ createFlIt p rot 
+         in ( i
-            & cWorld . lWorld . items . at i ?~ (itm & itID .~ NInt i
+            , w
-                & itLocation .~ OnFloor)
+                & cWorld . lWorld . floorItems . at i ?~ FlIt p rot
+                & cWorld . lWorld . items . at i
+                    ?~ ( itm & itID .~ NInt i
+                            & itLocation .~ OnFloor
+                       )
             )
---        plNewUpID
+    --        plNewUpID
---            (cWorld . lWorld . floorItems . unNIntMap)
+    --            (cWorld . lWorld . floorItems . unNIntMap)
---            (flItID . unNInt)
+    --            (flItID . unNInt)
---            (createFlIt p rot itm)
+    --            (createFlIt p rot itm)
---            w
+    --            w
     PutCrit cr -> plNewUpID (cWorld . lWorld . creatures) crID (mvCr p rot cr) w
     PutForeground fs -> plNewUpID (cWorld . lWorld . foregroundShapes) fsID (mvFS p rot fs) w
     PutMachine pps mc wl mitm -> plMachine (map doShift pps) mc wl mitm p rot w
@@ -181,10 +187,6 @@ mvProp p a = (prRot +~ a) . (prPos %~ ((p +.+) . rotateV a))
 mvButton :: Point2 -> Float -> Button -> Button
 mvButton p a = (btRot +~ a) . (btPos %~ ((p +.+) . rotateV a))
 
-{- Creates a floor item at a given point.-}
-createFlIt :: Point2 -> Float -> FloorItem
-createFlIt p rot = FlIt{_flItPos = p, _flItRot = rot}
-
 mvPP :: Point2 -> Float -> PressPlate -> PressPlate
 mvPP p rot pp = pp{_ppPos = p, _ppRot = rot}
 
@@ -194,8 +196,9 @@ mvCr p rot cr = cr{_crPos = p, _crOldPos = p, _crDir = rot}
 mvFS :: Point2 -> Float -> ForegroundShape -> ForegroundShape
 mvFS p a = (fsDir +~ a) . (fsPos %~ ((p +.+) . rotateV a))
 
-plMachine :: [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
+plMachine ::
-plMachine wallpoly mc wl mitm = case mitm of
+    [Point2] -> Machine -> Wall -> Maybe Item -> Point2 -> Float -> World -> (Int, World)
+plMachine wallpoly mc wl = \case
     Nothing -> plMachine' wallpoly mc wl
     Just itm -> plTurret wallpoly mc wl itm
 
@@ -207,15 +210,20 @@ plTurret wallpoly mc wl itm p rot gw =
         & cWorld . lWorld . items . at itid ?~ itm'
     )
   where
-    itm' = itm & itID .~ NInt itid
+    itm' =
-        & itLocation .~ OnTurret mcid
+        itm & itID .~ NInt itid
+            & itLocation .~ OnTurret mcid
     itid = IM.newKey $ gw ^. cWorld . lWorld . items
     col = _mcColor mc
     mcid = IM.newKey $ gw ^. cWorld . lWorld . machines
     wlid = IM.newKey $ gw ^. cWorld . lWorld . walls
     wlids = IS.fromList [wlid .. wlid + length wallpoly - 1]
-    addMc = IM.insert mcid (mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
+    addMc =
-        & mcType . mctTurret . tuWeapon .~ itid)
+        IM.insert
+            mcid
+            ( mc{_mcPos = p, _mcDir = rot, _mcID = mcid, _mcWallIDs = wlids}
+                & mcType . mctTurret . tuWeapon .~ itid
+            )
 
 plMachine' :: [Point2] -> Machine -> Wall -> Point2 -> Float -> World -> (Int, World)
 plMachine' wallpoly mc wl p rot gw =

src/Dodge/Projectile/Create.hs

@@ -43,8 +43,6 @@ createShell (p,q) mdetonator mscreen stab pjtype payload muz cr w =
                 , _pjPayload = payload
                 , _pjTimer = lifespan
                 , _pjBarrelSpin = bs
---                , _pjUpdates =
---                    anyspin
                 , _pjType = pjtype
                 , _pjDetonatorID = mdetonator
                 , _pjScreenID = mscreen

src/Dodge/Projectile/Update.hs

@@ -209,8 +209,6 @@ doThrust pj smoke w =
     (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
     r1 = randInCirc 10 & evalState $ _randGen w
 
--- there doesn't seem to be a more sensible way to filter the first occurence of
--- a list than deleteBy
 doBarrelSpin :: Int -> Float -> Projectile -> World -> World
 doBarrelSpin cid i pj w =
     w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin

src/Dodge/Render.hs

@@ -432,10 +432,10 @@ doDrawing' win pdata u = do
     renderLayer FixedCoordLayer shadV pokeCounts
     SDL.glSwapWindow win
 
-getDistortions :: Configuration -> World -> [Distortion]
+getDistortions :: Config -> World -> [Distortion]
 getDistortions cfig w
     | cfig ^. graphics_distortions = w ^. cWorld . lWorld . distortions
     | otherwise = []
 
-setViewport :: (Configuration -> ResFactor) -> Configuration -> IO ()
+setViewport :: (Config -> ResFactor) -> Config -> IO ()
 setViewport f = uncurry (glViewport 0 0) . getWindowSize f

src/Dodge/Render/HUD.hs

@@ -45,27 +45,27 @@ import NewInt
 import Picture
 import SDL (MouseButton (..))
 
-drawHUD :: Configuration -> World -> Picture
+drawHUD :: Config -> World -> Picture
-drawHUD cfig w = case w ^. hud . hudElement of
+drawHUD cfig w = case w ^. hud of
     --    DisplayCarte -> drawCarte cfig w
-    DisplayInventory{_diSections = sections, _subInventory = subinv} ->
+    HUD {_diSections = sections, _subInventory = subinv} ->
         drawInventory sections w cfig
             <> drawSubInventory subinv cfig w
 
-drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Configuration -> Picture
+drawInventory :: IM.IntMap (SelectionSection ()) -> World -> Config -> Picture
 drawInventory sss w cfig =
     drawSelectionSections sss invDP cfig
-        <> drawSSCursor sss invDP curs cfig (f $ w ^? hud . hudElement . diSelection . _Just)
+        <> drawSSCursor sss invDP curs cfig (f $ w ^? hud . diSelection . _Just)
-        <> drawRootCursor w sss (f $ w ^? hud . hudElement . diSelection . _Just) invDP cfig
+        <> drawRootCursor w sss (f $ w ^? hud . diSelection . _Just) invDP cfig
         <> itemconnections
         <> drawMouseOver cfig w
   where
-    f = fmap (\(x, y, _) -> (x, y))
+    f = fmap (\(Sel x y _) -> (x, y))
     curs = invCursorParams w
     itemconnections = fromMaybe mempty $ do
         inv' <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
         let inv = fmap (\k -> w ^?! cWorld . lWorld . items . ix k) inv'
-        case w ^? hud . hudElement . diInvFilter . _Just of
+        case w ^? hud . diInvFilter . _Just of
             Just (_ : _) -> Nothing
             _ -> return . drawItemConnections sss cfig $ invAdj inv
 
@@ -74,7 +74,7 @@ drawRootCursor ::
     IM.IntMap (SelectionSection ()) ->
     Maybe (Int, Int) ->
     ListDisplayParams ->
-    Configuration ->
+    Config ->
     Picture
 drawRootCursor w sss msel ldp cfig = fromMaybe mempty $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
@@ -102,7 +102,7 @@ getRootItemBounds i inv = do
     y <- locDTLeftmost root ^? locDT . dtValue . _1 . itLocation . ilInvID . unNInt
     return (x, y)
 
-drawMouseOver :: Configuration -> World -> Picture
+drawMouseOver :: Config -> World -> Picture
 drawMouseOver cfig w =
     concat
         (invsel <|> combinvsel <|> drawDragSelecting cfig w)
@@ -112,7 +112,7 @@ drawMouseOver cfig w =
         (j, i) <-
             w ^? input . mouseContext . mcoInvSelect
                 <|> w ^? input . mouseContext . mcoInvFilt
-        sss <- w ^? hud . hudElement . diSections
+        sss <- w ^? hud . diSections
         return . translateScreenPos cfig (invDP ^. ldpPos)
             . color (withAlpha 0.1 white)
             --            . color white
@@ -123,40 +123,40 @@ drawMouseOver cfig w =
         (j, i) <-
             (w ^? input . mouseContext . mcoCombSelect)
                 <|> (w ^? input . mouseContext . mcoCombCombine)
-        sss <- w ^? hud . hudElement . subInventory . ciSections
+        sss <- w ^? hud . subInventory . ciSections
-        let idp = secondColumnParams
+        let idp = secondColumnLDP
         return . translateScreenPos cfig (idp ^. ldpPos)
             . color (withAlpha 0.2 white)
             $ selSecDrawCursorAt idp curs sss (j, i)
 
-drawDragSelected :: Configuration -> World -> Maybe Picture
+drawDragSelected :: Config -> World -> Maybe Picture
 drawDragSelected cfig w = do
-    ys <- w ^? hud . hudElement . diSelection . _Just . _3
+    ys <- w ^? hud . diSelection . _Just . slSet
     guard $
         not (IS.null ys)
-            && ( case w ^? hud . hudElement . subInventory of
+            && ( case w ^? hud . subInventory of
                     Just NoSubInventory -> True
                     _ -> False
                )
-    (i, _, _) <- w ^? hud . hudElement . diSelection . _Just
+    Sel i _ _ <- w ^? hud . diSelection . _Just
-    sss <- w ^? hud . hudElement . diSections
+    sss <- w ^? hud . diSections
     let f x = (selSecDrawCursorAt invDP BackdropCursor sss (i, x) <>)
     return . translateScreenPos cfig (invDP ^. ldpPos)
         . color (withAlpha 0.2 white)
         . IS.foldr f mempty
         $ ys
 
-drawDragSelecting :: Configuration -> World -> Maybe Picture
+drawDragSelecting :: Config -> World -> Maybe Picture
 drawDragSelecting cfig w = do
     OverInvDragSelect (Just (i, j)) (Just b) <- w ^? input . mouseContext
-    sss <- w ^? hud . hudElement . diSections
+    sss <- w ^? hud . diSections
     let f x = selSecDrawCursorAt invDP BackdropCursor sss (i, x)
     return . translateScreenPos cfig (invDP ^. ldpPos)
         . color (withAlpha 0.2 white)
         . foldMap f
         $ [min j b .. max j b]
 
-drawSubInventory :: SubInventory -> Configuration -> World -> Picture
+drawSubInventory :: SubInventory -> Config -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
     --    LockedInventory -> mempty -- topInvCursor col cursPos cfig w
     NoSubInventory{} -> drawRBOptions cfig w
@@ -176,26 +176,26 @@ drawMapperInventory itid w = fold $ do
     f = worldPosToScreen (w ^. wCam)
 
 drawCombineInventory ::
-    Configuration ->
+    Config ->
     IM.IntMap (SelectionSection CombinableItem) ->
     World ->
     Picture
 drawCombineInventory cfig sss w =
     invHead cfig "COMBINE"
-        <> drawSelectionSections sss secondColumnParams cfig
+        <> drawSelectionSections sss secondColumnLDP cfig
-        <> drawSSCursor sss secondColumnParams curs cfig msel
+        <> drawSSCursor sss secondColumnLDP curs cfig msel
         <> combineInventoryExtra sss msel cfig w
   where
     curs = BoundaryCursor [North, South, West]
     msel =
-        fmap (\(x, y, _) -> (x, y)) $
+        fmap (\(Sel x y _) -> (x, y)) $
-            w ^? hud . hudElement . subInventory . ciSelection . _Just
+            w ^? hud . subInventory . ciSelection . _Just
 
-drawExamineInventory :: Configuration -> World -> Picture
+drawExamineInventory :: Config -> World -> Picture
 drawExamineInventory cfig w =
     invHead cfig "EXAMINE"
         <> drawSelectionList
-            secondColumnParams
+            secondColumnLDP
             cfig
             ( map
                 f
@@ -244,17 +244,18 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
         return . g $ Right but
     _ -> x
 
-drawRBOptions :: Configuration -> World -> Picture
+drawRBOptions :: Config -> World -> Picture
 drawRBOptions cfig w = fold $ do
     guard $ ButtonRight `M.member` _mouseButtons (_input w)
     invid <- you w ^? crManipulation . manObject . imSelectedItem
+    itid <- you w ^? crInv . ix invid
     eslist <-
-        fmap eqSiteToPositions $
+        fmap eqTypeToSites $
-            you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
+            w ^? cWorld . lWorld . items . ix itid >>= equipType
-    i <- w ^? rbOptions . opSel
+    i <- w ^? rbState . opSel
-    let ae = getEquipmentAllocation invid w
+    let ae = equipmentDesignation invid w
-    sss <- w ^? hud . hudElement . diSections
+    sss <- w ^? hud . diSections
-    (i', j, _) <- w ^? hud . hudElement . diSelection . _Just
+    Sel i' j _ <- w ^? hud . diSelection . _Just
     curpos <- selSecYint i' j sss
     let ytext = drawListElement 0 1 0 curpos . text
         midstr = equipAllocString ae
@@ -298,9 +299,8 @@ drawRBOptions cfig w = fold $ do
     maybebottomborder a b curpos
         | a == b - 1 = listCursorChooseBorderScale 0 1 (bc South) curpos 0 white 7 1
         | otherwise = mempty
-    otheritem j = fromMaybe "" $ do
+    otheritem (NInt j) = fromMaybe "" $ do
-        itid <- you w ^? crInv . ix j
+        itype <- w ^? cWorld . lWorld . items . ix j . itType
-        itype <- w ^? cWorld . lWorld . items . ix itid . itType
         return $ itemBaseName itype
 
 equipAllocString :: EquipmentAllocation -> String
@@ -314,7 +314,7 @@ equipAllocString = \case
 
 drawItemConnections ::
     IM.IntMap (SelectionSection ()) ->
-    Configuration ->
+    Config ->
     IM.IntMap (Maybe (Int, Int), [Int], [Int]) ->
     Picture
 drawItemConnections sss cfig =
@@ -324,7 +324,7 @@ drawItemConnections sss cfig =
 
 drawItemChildrenConnect ::
     IM.IntMap (SelectionSection ()) ->
-    Configuration ->
+    Config ->
     Int ->
     [Int] ->
     Picture
@@ -338,7 +338,7 @@ drawItemChildrenConnect sss cfig i is = fromMaybe mempty $ do
 combineInventoryExtra ::
     IM.IntMap (SelectionSection CombinableItem) ->
     Maybe (Int, Int) ->
-    Configuration ->
+    Config ->
     World ->
     Picture
 combineInventoryExtra sss msel cfig w = fold $ do
@@ -349,7 +349,7 @@ combineInventoryExtra sss msel cfig w = fold $ do
     return (lnkMidPosInvSelsCol cfig w j col lnks) <> foldMap invcursor lnks
   where
     invcursor i = do
-        sss' <- w ^? hud . hudElement . diSections
+        sss' <- w ^? hud . diSections
         return $
             translateScreenPos cfig (invDP ^. ldpPos) $
                 selSecDrawCursor
@@ -358,13 +358,13 @@ combineInventoryExtra sss msel cfig w = fold $ do
                     sss'
                     (Just (0, i))
 
-drawTerminalDisplay :: Configuration -> Terminal -> Picture
+drawTerminalDisplay :: Config -> Terminal -> Picture
 drawTerminalDisplay cfig tm =
     invHead cfig ("T-" ++ show tid)
-        <> drawSelectionList secondColumnParams cfig f
+        <> drawSelectionList secondColumnLDP cfig f
         <> color
             (withAlpha 0.5 green) -- consider integrating termScreenColor somehow
-            (drawSelectionListBackground secondColumnParams cfig tsize)
+            (drawSelectionListBackground secondColumnLDP cfig tsize)
         <> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
   where
     tid = tm ^. tmID
@@ -380,6 +380,7 @@ drawTerminalDisplay cfig tm =
         TerminalOff -> id
         TerminalDeactivated -> id
         TerminalLineRead -> id
+        TerminalWaiting -> (++ [("...",white)])
         TerminalTextInput s ->
             (++ [(getPromptTM ++ s ++ [cFilledRect], white)])
         TerminalPressTo s ->
@@ -387,18 +388,18 @@ drawTerminalDisplay cfig tm =
 
 --        | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
 
-lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
+lnkMidPosInvSelsCol :: Config -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
   where
     f j = do
-        sss <- w ^? hud . hudElement . diSections
+        sss <- w ^? hud . diSections
-        combinesss <- w ^? hud . hudElement . subInventory . ciSections
+        combinesss <- w ^? hud . subInventory . ciSections
         lp <- selNumPos cfig invDP sss 0 j
-        rp <- selNumPos cfig secondColumnParams combinesss 0 i
+        rp <- selNumPos cfig secondColumnLDP combinesss 0 i
         invcol <- selSecSelCol 0 j sss
         return $ zConnectColMidX (rp - V2 5 0) (lp + V2 155 0) (rp ^. _1 - 20) col col col invcol
 
-invHead :: Configuration -> String -> Picture
+invHead :: Config -> String -> Picture
 invHead cfig =
     translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
         . dShadCol white
@@ -408,7 +409,7 @@ invHead cfig =
 --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
 --locTexts = map fst locs
 
---displayListEndCoords :: Configuration -> [String] -> [Point2]
+--displayListEndCoords :: Config -> [String] -> [Point2]
 --displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [1 ..]
 --  where
 --    f :: Int -> Point2
@@ -416,7 +417,7 @@ invHead cfig =
 --    h :: String -> Point2 -> Point2
 --    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
---closeObjectTexts :: Configuration -> World -> Picture
+--closeObjectTexts :: Config -> World -> Picture
 --closeObjectTexts cfig w = pictures $
 --    renderListAt pushout (negate 20 * fromIntegral invPos) cfig (map colAndText $ _closeObjects w)
 --    : maybeToList maybeLine
@@ -448,9 +449,9 @@ invHead cfig =
 
 -- would be nice to add parameter to orient this with NSEW, cf cursor
 selNumPos ::
-    Configuration ->
+    Config ->
     ListDisplayParams ->
-    IM.IntMap (SelectionSection a) ->
+    IMSS a ->
     Int ->
     Int ->
     Maybe Point2
@@ -472,7 +473,7 @@ selNumPos = selNumPosCardinal West8
 -- need to be able to determine a selection item's width for this
 selNumPosCardinal ::
     CardinalEightPoint ->
-    Configuration ->
+    Config ->
     ListDisplayParams ->
     IM.IntMap (SelectionSection a) ->
     Int ->

src/Dodge/Render/HUD/Carte.hs

@@ -11,7 +11,7 @@ module Dodge.Render.HUD.Carte (
 --import qualified IntMapHelp as IM
 --import Picture
 --
-----drawCarte :: Configuration -> World -> Picture
+----drawCarte :: Config -> World -> Picture
 ----drawCarte cfig w =
 ----    fold $
 ----        toTopLeft cfig (renderListAt 0 0 locs) :
@@ -38,7 +38,7 @@ module Dodge.Render.HUD.Carte (
 --    (x, y) = _wlLine wl
 --    c = _wlColor wl
 --
-----mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
+----mapWall :: Config -> HUD -> Wall -> Maybe Picture
 ----mapWall cfig thehud wl
 ----    | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
 ----    | otherwise  = Nothing
@@ -48,7 +48,7 @@ module Dodge.Render.HUD.Carte (
 ----    (x, y) = _wlLine wl
 ----    c = _wlColor wl
 --
---mainListCursor :: Color -> Int -> Configuration -> Picture
+--mainListCursor :: Color -> Int -> Config -> Picture
 --mainListCursor c = openCursorAt 120 c 5 0
 --
 --openCursorAt ::
@@ -61,7 +61,7 @@ module Dodge.Render.HUD.Carte (
 --    Float ->
 --    -- | y offset (discrete)
 --    Int ->
---    Configuration ->
+--    Config ->
 --    Picture
 --openCursorAt wth col xoff yoff yint w =
 --    translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $

src/Dodge/Render/InfoBox.hs

@@ -17,7 +17,7 @@ import Picture
 renderInfoListAt ::
     Float ->
     Float ->
-    Configuration ->
+    Config ->
     Camera ->
     (Point2, [String]) ->
     Picture
@@ -41,7 +41,7 @@ renderInfoListAt x y cfig cam (p, ss) =
     hw = halfWidth cfig
     hh = halfHeight cfig
 
-renderInfoListsAt :: Float -> Float -> Configuration -> Camera -> [(Point2, [String])] -> Picture
+renderInfoListsAt :: Float -> Float -> Config -> Camera -> [(Point2, [String])] -> Picture
 renderInfoListsAt x y cfig w =
     fst . foldr f (mempty, 0)
   where

src/Dodge/Render/Lights.hs

@@ -11,7 +11,7 @@ import Geometry
 import qualified IntMapHelp as IM
 import Control.Lens
 
-lightsToRender :: Configuration -> Camera -> LWorld -> [(Point3, Float, Point3)]
+lightsToRender :: Config -> Camera -> LWorld -> [(Point3, Float, Point3)]
 {-# INLINE lightsToRender #-}
 lightsToRender cfig campos w =  take (fromEnum $ cfig ^. graphics_num_shadow_casters) $
     sortOn (\(_,x,_) -> negate x) $

src/Dodge/Render/List.hs

@@ -32,7 +32,7 @@ import LensHelp
 import ListHelp
 import Picture
 
-drawSelectionList :: ListDisplayParams -> Configuration -> [SelectionItem a] -> Picture
+drawSelectionList :: ListDisplayParams -> Config -> [SelectionItem a] -> Picture
 drawSelectionList ldps cfig sl =
     translateScreenPos cfig (ldps ^. ldpPos) $
         drawListYgapScaleYoff
@@ -41,7 +41,7 @@ drawSelectionList ldps cfig sl =
             0
             (makeSelectionListPictures sl)
 
-drawTitleBackground :: Configuration -> Picture
+drawTitleBackground :: Config -> Picture
 drawTitleBackground cfig =
     translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 75))
         . polygon
@@ -50,7 +50,7 @@ drawTitleBackground cfig =
 
 drawSelectionListBackground ::
     ListDisplayParams ->
-    Configuration ->
+    Config ->
     Int -> -- list length
     Picture
 drawSelectionListBackground ldp cfig l =
@@ -164,7 +164,7 @@ chooseCursorBorders w h = \case
     toLine South = [V2 w h', V2 0 h']
     toLine West = [V2 0 h', V2 0 0]
 
---fillScreenText :: Configuration -> String -> Picture
+--fillScreenText :: Config -> String -> Picture
 --fillScreenText cfig str =
 --    scale wscale hscale
 --        . centerText
@@ -175,7 +175,7 @@ chooseCursorBorders w h = \case
 --    hw = halfWidth cfig
 --    hh = halfHeight cfig
 
---fillWidthText :: Configuration -> String -> Picture
+--fillWidthText :: Config -> String -> Picture
 --fillWidthText cfig str =
 --    scale thescale thescale
 --        . centerText
@@ -216,5 +216,5 @@ dShadCol :: Color -> Picture -> Picture
 {-# INLINE dShadCol #-}
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
 
-toTopLeft :: Configuration -> Picture -> Picture
+toTopLeft :: Config -> Picture -> Picture
 toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)

src/Dodge/Render/MenuScreen.hs

@@ -13,14 +13,14 @@ import Dodge.Render.List
 import Dodge.ScreenPos
 import Picture
 
-drawMenuScreen :: Configuration -> Maybe Int -> ScreenLayer -> Picture
+drawMenuScreen :: Config -> Maybe Int -> ScreenLayer -> Picture
 drawMenuScreen cfig spos screen = case screen of
     OptionScreen{_scTitle = titf, _scSelectionList = slist} ->
         drawOptions cfig titf spos slist
     InputScreen inputstr help -> drawInputMenu cfig ('>' : inputstr) help
 
 drawInputMenu ::
-    Configuration ->
+    Config ->
     -- | Title
     String ->
     -- | Help Text
@@ -33,26 +33,26 @@ drawInputMenu cfig title footer =
         , drawFooterText cfig red footer
         ]
 
-drawOptions :: Configuration -> String -> Maybe Int -> [SelectionItem a] -> Picture
+drawOptions :: Config -> String -> Maybe Int -> [SelectionItem a] -> Picture
 drawOptions cfig title msel sl =
     darkenBackground cfig
         <> drawTitle cfig title
-        <> drawSelectionList menuDisplayParams cfig sl
+        <> drawSelectionList menuLDP cfig sl
         <> translateScreenPos
             cfig
-            (menuDisplayParams ^. ldpPos)
+            (menuLDP ^. ldpPos)
             ( drawCursorAt
                 msel
                 sl
-                menuDisplayParams
+                menuLDP
                 50
                 (BoundaryCursor [North, South])
             )
 
-darkenBackground :: Configuration -> Picture
+darkenBackground :: Config -> Picture
 darkenBackground = color (withAlpha 0.5 black) . polygon . reverse . screenBox
 
-drawTitle :: Configuration -> String -> Picture
+drawTitle :: Config -> String -> Picture
 drawTitle cfig = translate (- hw) (hh -80) . scale 0.4 0.4 . text
   where
     hh = halfHeight cfig
@@ -69,7 +69,7 @@ placeString ::
     Picture
 placeString x y sc = color white . translate x y . scale sc sc . text
 
-drawFooterText :: Configuration -> Color -> String -> Picture
+drawFooterText :: Config -> Color -> String -> Picture
 drawFooterText cfig col = color col . placeString (- hw + 30) (- hh + 10) 0.1
   where
     hh = halfHeight cfig

src/Dodge/Render/Picture.hs

@@ -35,7 +35,7 @@ fixedCoordPictures u =
                 . take 50
                 . drop (u ^. uvDebugMessageOffset)
                 . map text
-                $ foldMap (`_debugMessage` u) (_uvDebug u) -- other debug pics in extraPics
+                $ foldMap _debugMessage (_uvDebug u) -- other debug pics in extraPics
            )
   where
     cfig = _uvConfig u
@@ -61,7 +61,7 @@ fpsText x = color col . text $ "ms/frame " ++ show x
         | x < 50 = orange
         | otherwise = red
 
-drawMenuOrHUD :: Configuration -> Universe -> Picture
+drawMenuOrHUD :: Config -> Universe -> Picture
 drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
     [] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
     (x : _) -> drawMenuScreen cfig (u ^? uvWorld . input . mouseContext . mcoMenuClick) x
@@ -91,15 +91,15 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     MouseMenuClick{} -> drawMenuClick 5
     MouseMenuCursor -> drawMenuCursor 5
     MouseInGame -> drawPlus 5
-    OverInvDrag 0 (Just (3, _)) _ _ -> drawDragDrop 5
+    OverInvDrag 0 (Just (3, _)) -> drawDragDrop 5
-    OverInvDrag 0 Nothing _ _ -> drawDragDrop 5
+    OverInvDrag 0 Nothing -> drawDragDrop 5
-    OverInvDrag 0 (Just (0, _)) _ _ -> drawDrag 5
+    OverInvDrag 0 (Just (0, _)) -> drawDrag 5
-    OverInvDrag 0 _ _ _ -> drawEmptySet 5
+    OverInvDrag 0 _ -> drawEmptySet 5
-    OverInvDrag 3 (Just (3, _)) _ _ -> drawDrag 5
+    OverInvDrag 3 (Just (3, _)) -> drawDrag 5
-    OverInvDrag 3 (Just (0, _)) _ _ -> drawDragPickup 5
+    OverInvDrag 3 (Just (0, _)) -> drawDragPickup 5
-    OverInvDrag 3 (Just (1, _)) _ _ -> drawDragPickup 5
+    OverInvDrag 3 (Just (1, _)) -> drawDragPickup 5
-    OverInvDrag 3 Nothing _ _ -> drawDragPickup 5
+    OverInvDrag 3 Nothing -> drawDragPickup 5
-    OverInvDrag 3 _ _ _ -> drawEmptySet 5
+    OverInvDrag 3 _ -> drawEmptySet 5
     OverInvDrag{} -> drawEmptySet 5
     OverInvDragSelect{} -> drawDragSelect 5
     OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
@@ -115,7 +115,7 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
   where
     w = u ^. uvWorld
-    selsec = u ^? uvWorld . hud . hudElement . diSelection . _Just . _1
+    selsec = u ^? uvWorld . hud . diSelection . _Just . slSec
     a = fromMaybe 0 $ do
         cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
         return . toClosestMultiple (pi / 32) $

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import Dodge.Item.Draw.SPic
 import Control.Lens
 import Data.Foldable
 import Data.Strict.Tuple
@@ -18,7 +19,7 @@ import Shape
 import ShapePicture
 import Linear.V3
 
-worldSPic :: Configuration -> Universe -> SPic
+worldSPic :: Config -> Universe -> SPic
 worldSPic cfig u =
     (mempty :!: extraPics cfig u)
         <> foldup propSPic (filtOn _prPos _props)
@@ -30,7 +31,7 @@ worldSPic cfig u =
         <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
         <> foldup (drawCreature (u ^. uvWorld . cWorld . lWorld . items)) 
                 (filtOn _crPos _creatures)
-        <> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos (_floorItems)))
+        <> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos _floorItems))
         <> foldup btSPic (filtOn _btPos _buttons)
         <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
         <> foldMap' drawChasm (u ^. uvWorld . cWorld . chasms)
@@ -87,12 +88,12 @@ shiftDraw' fpos fdir fdraw x =
         . rotateSP (fdir x)
         $ fdraw x
 
-cullPoint :: Configuration -> World -> Point2 -> Bool
+cullPoint :: Config -> World -> Point2 -> Bool
 cullPoint cfig w p
     | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. wCam . camBoundBox)
     | otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance)
 
-extraPics :: Configuration -> Universe -> Picture
+extraPics :: Config -> Universe -> Picture
 extraPics cfig u =
     setLayer FixedCoordLayer (fixedCoordPictures u)
         <> foldMap drawTractorBeam (_tractorBeams lw)
@@ -109,8 +110,8 @@ extraPics cfig u =
         <> foldMap drawLightSource (_lightSources lw)
         <> foldMap ppDraw (_pressPlates lw)
         <> viewClipBounds cfig w
-        <> debugDraw cfig w
+        <> showEnabledDebugs cfig
-        <> foldMap (`_debugPic` u) (_uvDebug u) -- debug messages are in fixed coord pics
+        <> foldMap _debugPic (_uvDebug u) -- debug messages are in fixed coord pics
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
@@ -123,7 +124,7 @@ floorItemSPic itm flit =
     uncurryV translateSPxy (_flItPos flit) $
         rotateSP
             (_flItRot flit)
-            (itemSPic $ itm)
+            (itemSPic itm)
 
 btSPic :: Button -> SPic
 btSPic bt =

src/Dodge/Room/Airlock.hs

@@ -3,6 +3,7 @@
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where
 
+import Dodge.Placement.Instance.Analyser
 import Dodge.Annotation.Data
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
@@ -35,6 +36,7 @@ decontamRoom = do
                         \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
             , invisibleWall $ rectNSWE 60 40 (-40) (-30)
             , spanLightI (V2 (-2) 30) (V2 (-2) 70)
+            , analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
             ]
         & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
   where

src/Dodge/Room/LasTurret.hs

@@ -42,7 +42,7 @@ lightSensInsideDoor i rm =
                  , psPt atFstLnkOut (PutForeground $ floorWire (V2 0 (-100)) (V2 20 (-100)))
                  , psPt atFstLnkOut (PutForeground $ verticalWire (V2 20 0) 0 80)
                  ]
-        & rmOutPmnt . at i ?~ (sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100))
+        & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 10 (atFstLnkOutShiftInward 100)
 
 lightSensByDoor :: Int -> Room -> Room
 lightSensByDoor i rm =
@@ -52,7 +52,7 @@ lightSensByDoor i rm =
                  , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape
                  , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape
                  ]
-        & rmOutPmnt . at i ?~ (sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift))
+        & rmOutPmnt . at i ?~ sensAboveDoor LaserSensor 20 (atFstLnkOutShiftBy sensorshift)
   where
     covershape = rectNSWE 10 (-10) (-20) 20
     sensorshift (p, a) = (p +.+ rotateV a (V2 60 (-20)), a)
@@ -82,11 +82,10 @@ analyserByNthLink n proxreq i rm =
             .++~ [ psPt (atNthLinkOut n) $ PutForeground $ verticalWire (V2 20 0) 0 80
                  ]
         & rmOutPmnt . at i ?~ 
-                    ( analyser
+                     analyser
                         proxreq
                         (atNthLnkOutShiftBy n (\(p, a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
                         (atNthLnkOutShiftBy n sensorshift)
-                    )
   where
     sensorshift (p, a) = (p +.+ rotateV a (V2 (-30) (-10)), a)
 

src/Dodge/Room/SensorDoor.hs

@@ -66,4 +66,4 @@ sensInsideDoor senseType i rm = rm
                 (textTerminal & tmCommands .:~ TCDamageCommand)
                 & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
              ]
-    & rmOutPmnt . at i ?~ (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100))
+    & rmOutPmnt . at i ?~ sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)

src/Dodge/Room/Tutorial.hs

@@ -1,9 +1,9 @@
-module Dodge.Room.Tutorial (tutAnoTree,tutRezBox) where
+module Dodge.Room.Tutorial where
 
+import Dodge.Room.Room
 import Dodge.Room.Corridor
 import Dodge.Room.Airlock
 import Dodge.Room.RoadBlock
-import Dodge.Room.Room
 import Dodge.Item.Held.Cane
 import Dodge.Item.Ammo
 import Dodge.Annotation.Data
@@ -42,15 +42,15 @@ import TreeHelp
 
 tutAnoTree :: Annotation
 tutAnoTree =
-    OnwardList $
+    OnwardList 
         [ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
         , AnTree $ tutDrop
---        , AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
+--        [ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , AnTree corDoor
         , AnTree $ tutRooms
         , AnTree $ tutDrop
---        , AnTree $ pickupTut
+----        , AnTree $ pickupTut
---        , AnTree $ weaponTut
+----        , AnTree $ weaponTut
         ]
 
 tutDrop :: State LayoutVars (MetaTree Room String)

src/Dodge/Room/Warning.hs

@@ -52,10 +52,11 @@ addDoorAtNthLinkToggleTerminal j xs i = (rmName .++~ "doorToggle-")
 
 
 addWarningTerminal :: String -> Int -> Room -> Room
-addWarningTerminal str = addDoorToggleTerminal (makeColorTermLine red "WARNING" : makeTermPara str)
+addWarningTerminal str = addDoorToggleTerminal 
+    (makeColorTermLine red "WARNING" : makeTermPara str)
 
 lineOutputTerminal :: [TerminalLine] -> Terminal
-lineOutputTerminal tls = defaultTerminal & tmBootLines .~ connectionBlurbLines tls
+lineOutputTerminal tls = defaultTerminal & tmBootLines .~ textInputBlurb tls
 
 moveToSideNthOutLink :: Int -> RoomPos -> Room -> Maybe (Point2, Float)
 moveToSideNthOutLink i rp rm = do

src/Dodge/ScreenPos.hs

@@ -9,10 +9,10 @@ import Picture.Base
 fromTopLeft :: Point2 -> ScreenPos
 fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y))
 
-translateScreenPos :: Configuration -> ScreenPos -> Picture -> Picture
+translateScreenPos :: Config -> ScreenPos -> Picture -> Picture
 translateScreenPos cfig = uncurryV translate . screenPosAbs cfig
 
-screenPosAbs :: Configuration -> ScreenPos -> Point2
+screenPosAbs :: Config -> ScreenPos -> Point2
 screenPosAbs cfig sp = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff
   where
     w = fromIntegral $ cfig ^. windowX

src/Dodge/SelectedClose.hs

@@ -13,7 +13,7 @@ interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e o
 
 getSelectedCloseObj :: World -> Maybe (Either (NewInt ItmInt) Button)
 getSelectedCloseObj w = do
-    (i, j, _) <- w ^? hud . hudElement . diSelection . _Just
+    Sel i j _ <- w ^? hud . diSelection . _Just
     case i of
         3 -> Left <$> w ^? hud . closeItems . ix j
         5 -> do

src/Dodge/SelectionList.hs

@@ -7,7 +7,7 @@ import Dodge.Data.Universe
 import LensHelp
 import Linear
 
-getAvailableListLines :: ListDisplayParams -> Configuration -> Int
+getAvailableListLines :: ListDisplayParams -> Config -> Int
 getAvailableListLines ldps cfig = floor ((dToBot - vgap) / itmHeight)
   where
     vgap = ldps ^. ldpVerticalGap

src/Dodge/SelectionSections.hs

@@ -10,6 +10,8 @@ module Dodge.SelectionSections (
     inverseSelNumPos,
 ) where
 
+import Dodge.Data.HUD
+import Dodge.Data.CardinalPoint
 import qualified Data.IntSet as IS
 import Control.Applicative
 import qualified Control.Foldl as L
@@ -23,170 +25,131 @@ import Dodge.Data.SelectionList
 import Dodge.ScreenPos
 import Geometry.Data
 
-scrollSelectionSections ::
+scrollSelectionSections :: Int -> IMSS a -> Maybe Selection -> Maybe Selection
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int,IS.IntSet) ->
-    Maybe (Int, Int,IS.IntSet)
 scrollSelectionSections yi sss msel
     | yi == 0 = msel
     | yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
     | otherwise = foldl' (&) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
 
-nextInSectionSS :: 
+nextInSectionSS :: IMSS a -> Maybe Selection -> Maybe Selection
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, IS.IntSet) ->
-    Maybe (Int, Int, IS.IntSet)
 nextInSectionSS = ssScrollUsing ssLookupNextMax
 
---setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
---setFirstPosSelectionSections sss = fromMaybe sss $ do
---    (i, j, _) <- ssLookupMin sss
---    return $ sss & sssExtra . sssSelPos ?~ (i, j)
-
 ssScrollUsing ::
-    (Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
+    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
-    IM.IntMap (SelectionSection a) ->
+    IMSS a ->
-    Maybe (Int, Int, IS.IntSet) ->
+    Maybe Selection ->
-    Maybe (Int, Int, IS.IntSet)
+    Maybe Selection
-ssScrollUsing g =
+ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)
-    ssScrollMinOnFail
-        g
-        . fmap (ssItems %~ IM.filter _siIsSelectable)
 
 ssScrollMinOnFail ::
-    (Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
+    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
-    IM.IntMap (SelectionSection a) ->
+    IMSS a ->
-    Maybe (Int, Int, IS.IntSet) ->
+    Maybe Selection ->
-    Maybe (Int, Int, IS.IntSet)
+    Maybe Selection
-ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j, q i j)) $ l <|> ssLookupMin sss
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
   where
     q i j = fromMaybe mempty $ do
-        (k,_,xs) <- msel ^? _Just
+        Sel k _ xs <- msel ^? _Just
         guard $ j `IS.member` xs && i == k
         return xs
     l = do
-        (i, j, _) <- msel
+        Sel i j _ <- msel
         f i j sss
 
 ssSetCursor ::
-    (IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
+    (IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
-    IM.IntMap (SelectionSection a) ->
+    IMSS a ->
-    Maybe (Int, Int, IS.IntSet) ->
+    Maybe Selection ->
-    Maybe (Int, Int, IS.IntSet)
+    Maybe Selection
 ssSetCursor f sss msel = fromMaybe msel $ do
     (i, j, _) <- f sss
     let newxs = fromMaybe mempty $ do
-            (k,_,xs) <- msel
+            Sel k _ xs <- msel
             guard $ k == i && j `IS.member` xs
             return xs
-    return $ Just (i, j,newxs)
+    return $ Just (Sel i j newxs)
 
-ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
+ssLookupMax :: IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupMax sss = do
     (i, _) <- IM.lookupMax sss
     ssLookupLE' i sss
 
-ssLookupUp ::
+ssLookupUp :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupUp i j sss = case ssLookupLT i j sss of
     Nothing -> ssLookupMax sss
     x -> x
 
-ssLookupDown ::
+ssLookupDown :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupDown i j sss = case ssLookupGT i j sss of
     Nothing -> ssLookupMin sss
     x -> x
 
-ssLookupNextMax ::
+ssLookupNextMax :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupNextMax i j sss = case ssLookupGT i j sss of
     Just x@(i',j',_) | i' == i && j' > j -> Just x
     _ -> ssLookupMaxInSection i sss <|> ssLookupDown i j sss
 
-ssLookupMaxInSection :: Int -> IM.IntMap (SelectionSection a) ->
+ssLookupMaxInSection :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Maybe (Int, Int, SelectionItem a)
 ssLookupMaxInSection i sss = do
     ss <- sss ^? ix i . ssItems
     (j,s) <- IM.lookupMax ss
     return (i,j,s)
 
-ssLookupLT ::
+ssLookupLT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupLT i j sss = fromMaybe (ssLookupLT' i sss) $ do
     ss <- sss ^? ix i
     (j', si) <- IM.lookupLT j (ss ^. ssItems)
     return $ Just (i, j', si)
 
-ssLookupLT' ::
+ssLookupLT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupLT' i sss = do
     (i', ss) <- IM.lookupLT i sss
     case IM.lookupMax (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
         Nothing -> ssLookupLT' i' sss
 
-ssLookupLE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
+ssLookupLE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupLE' i sss = do
     (i', ss) <- IM.lookupLE i sss
     case IM.lookupMax (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
         Nothing -> ssLookupLT' i' sss
 
-ssLookupMin :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
+ssLookupMin :: IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupMin sss = do
     (i, _) <- IM.lookupMin sss
     ssLookupGE' i sss
 
-ssLookupGT ::
+ssLookupGT :: Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
-    Int ->
-    Int ->
-    IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int, SelectionItem a)
 ssLookupGT i j sss = fromMaybe (ssLookupGT' i sss) $ do
     ss <- sss ^? ix i
     (j', si) <- IM.lookupGT j (ss ^. ssItems)
     return $ Just (i, j', si)
 
-ssLookupGT' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
+ssLookupGT' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupGT' i sss = do
     (i', ss) <- IM.lookupGT i sss
     case IM.lookupMin (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
         Nothing -> ssLookupGT' i' sss
 
-ssLookupGE' :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
+ssLookupGE' :: Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)
 ssLookupGE' i sss = do
     (i', ss) <- IM.lookupGE i sss
     case IM.lookupMin (ss ^. ssItems) of
         Just (j', si) -> return (i', j', si)
         Nothing -> ssLookupGT' i' sss
 
-selSecSelSize :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
+selSecSelSize :: Int -> Int -> IMSS a -> Maybe Int
 selSecSelSize i j = (^? ix i . ssItems . ix j . siHeight)
 
 -- need to check that the vertical gap is correctly put in here
-posSelSecYint :: Configuration -> ListDisplayParams -> Float -> Int
+posSelSecYint :: Config -> ListDisplayParams -> Float -> Int
 posSelSecYint cfig ldp y = floor $ (y0 - y) / (20 / ldp ^. ldpScale + ldp ^. ldpVerticalGap)
   where
     V2 _ y0 = screenPosAbs cfig (ldp ^. ldpPos)
 
-selSecYint :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Int
+selSecYint :: Int -> Int -> IMSS a -> Maybe Int
 selSecYint i j sss = do
     ss <- sss ^? ix i
     return . (secpos +)
@@ -198,26 +161,28 @@ selSecYint i j sss = do
   where
     secpos = sum . fmap _ssShownLength . fst $ IM.split i sss
 
-inverseSelSecYint :: Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int)
+inverseSelSecYint :: Int -> IMSS a -> XInfinity (Int, Int)
-inverseSelSecYint yint sss = do
+inverseSelSecYint yint sss 
-    ((i, ss), othersss) <- IM.minViewWithKey sss
+    | yint < 0 = NegInf
-    let l = _ssShownLength ss
+    | otherwise = fromMaybe PosInf $ do
-    if l <= yint
+        ((i, ss), othersss) <- IM.minViewWithKey sss
-        then inverseSelSecYint (yint - l) othersss
+        let l = _ssShownLength ss
-        else do
+        if l <= yint
-            let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
+            then return $ inverseSelSecYint (yint - l) othersss
-            (j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls
+            else do
-            return (i, j)
+                let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
+                (j,_) <- L.fold (L.find (\(_,x) -> x - _ssOffset ss > yint)) $ IM.toList ls
+                return $ NonInf (i, j)
 
 inverseSelSecYintXPosCheck  :: 
-    Configuration ->
+    Config ->
     ListDisplayParams ->
     Float ->
     Int ->
-    IM.IntMap (SelectionSection a) ->
+    IMSS a ->
     Maybe (Int,Int)
-inverseSelSecYintXPosCheck   cfig ldp x yint sss = do
+inverseSelSecYintXPosCheck cfig ldp x yint sss = do
-    (i,j) <- inverseSelSecYint yint sss
+    (i,j) <- inverseSelSecYint yint sss ^? nonInf
     let V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
     sindent <- sss ^? ix i . ssIndent
     itindent <- sss ^? ix i . ssItems . ix j . siOffX
@@ -225,14 +190,6 @@ inverseSelSecYintXPosCheck   cfig ldp x yint sss = do
     guard $ x - x1 < 160 && x > x1
     return (i,j)
 
-inverseSelNumPos ::
+inverseSelNumPos :: Config -> ListDisplayParams -> Point2 -> IMSS a -> Maybe (Int, Int)
-    Configuration ->
+inverseSelNumPos cfig ldp (V2 x y) =
-    ListDisplayParams ->
+    inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y)
-    IM.IntMap (SelectionSection a) ->
-    Point2 ->
-    Maybe (Int, Int)
-inverseSelNumPos cfig ldp sss (V2 x y) =
-    inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss
-
---getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
---getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm

src/Dodge/SelectionSections/Draw.hs

@@ -16,7 +16,7 @@ import Picture.Base
 drawSelectionSections ::
     IM.IntMap (SelectionSection a) ->
     ListDisplayParams ->
-    Configuration ->
+    Config ->
     Picture
 drawSelectionSections sss ldp cfig =
     translateScreenPos cfig (ldp ^. ldpPos) $
@@ -36,7 +36,7 @@ drawSSCursor ::
     IM.IntMap (SelectionSection a) ->
     ListDisplayParams ->
     CursorDisplay ->
-    Configuration ->
+    Config ->
     Maybe (Int, Int) ->
     Picture
 drawSSCursor sss ldp curs cfig =
@@ -49,7 +49,7 @@ drawSSMultiCursor ::
     Maybe Int ->
     ListDisplayParams ->
     CursorDisplay ->
-    Configuration ->
+    Config ->
     Picture
 drawSSMultiCursor sss msel mextra ldp curs cfig = translateScreenPos cfig (ldp ^. ldpPos)
     . fold

src/Dodge/SoundLogic/LoadSound.hs

@@ -25,7 +25,7 @@ loadSounds = do
     putStrLn $ show y <> " channels assigned to group 1"
     fmap IM.fromList $ mapM loadSound $ zip [0..] soundPathList
   where
-    nchans = 64::Int
+    nchans = 128::Int
 
 loadMusic :: IO (IM.IntMap Mix.Music)
 loadMusic = do

src/Dodge/Terminal.hs

@@ -2,11 +2,10 @@
 
 module Dodge.Terminal (
     makeTermLine,
-    connectionBlurbLines,
+    textInputBlurb,
     textTerminal,
     simpleTermMessage,
     damageCodeCommand,
-    sensorCommand,
     makeColorTermLine,
     makeTermPara,
     terminalReturnEffect,
@@ -16,7 +15,6 @@ module Dodge.Terminal (
     tlDoEffect,
 ) where
 
-import Dodge.Item.Display
 import Color
 import Data.Char
 import qualified Data.List as List
@@ -33,19 +31,16 @@ import LensHelp
 import Sound.Data
 
 textTerminal :: Terminal
-textTerminal = defaultTerminal{_tmBootLines = connectionBlurb}
+textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}
 
-connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
+textInputBlurb :: [TerminalLine] -> [TerminalLine]
-connectionBlurbLines tls =
+textInputBlurb tls =
     [ termSoundLine computerBeepingS
     , TLine 0 [TerminalLineConst "LOADING TEXT INTERFACE..." termTextColor] TmWdId
     ]
         ++ tls
         ++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
 
-connectionBlurb :: [TerminalLine]
-connectionBlurb = connectionBlurbLines []
-
 termSoundLine :: SoundID -> TerminalLine
 termSoundLine sid = TLine 0 [] (TmWdWdTermSound sid)
 
@@ -61,7 +56,6 @@ getCommand w tm = \case
     TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
     TCBase -> quitCommand <> toggleCommands tm
     TCDamageCommand -> damageCodeCommand w tm
-    TCSensorInfo -> sensorCommand w tm
 
 damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 damageCodeCommand w _ 
@@ -81,22 +75,6 @@ decodeSensorType st w = fromMaybe [] $ do
     x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
     return [makeTermLine $ show x]
 
--- ugly
-sensorCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
-sensorCommand w tm = PTE.singleton "SENSOR" $ fromMaybe mempty $ do
-    ProximitySensor _ _ r b <- w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor
-    return $ PTE.fromList
-            [ ("", makeTermPara $ sensorReqToString r b)
-            ]
-
-sensorReqToString :: ProximityRequirement -> Bool -> String
-sensorReqToString pr = \case
-    True -> "SENSOR TEST PASSED."
-    False -> "SENSOR REQUIRES: " ++ case pr of
-        RequireHealth x -> "HEALTH ABOVE " ++ show x
-        RequireEquipment x -> itemBaseName x
-    
-
 toggleCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
 toggleCommands tm 
     | null ts = mempty

src/Dodge/Terminal/Color.hs

@@ -1,6 +1,4 @@
-module Dodge.Terminal.Color (
+module Dodge.Terminal.Color (termScreenColor) where
-    termScreenColor,
-) where
 
 import Dodge.Data.Terminal.Status
 import Dodge.Data.Terminal
@@ -14,3 +12,4 @@ termScreenColor tm = case tm ^. tmStatus of
     TerminalTextInput _ -> Just green
     TerminalPressTo{} -> Just green
     TerminalLineRead -> Just white
+    TerminalWaiting -> Just green

src/Dodge/Terminal/Type.hs

@@ -1,7 +1,4 @@
-module Dodge.Terminal.Type (
+module Dodge.Terminal.Type ( getPromptTM, getMaxLinesTM) where
-    getPromptTM,
-    getMaxLinesTM,
-) where
 
 getPromptTM :: String
 getPromptTM = "> "

src/Dodge/Update.hs

@@ -333,24 +333,22 @@ updateMagnets lw =
 
 checkTermDist :: World -> World
 checkTermDist w = fromMaybe w $ do
-    tmid <- w ^? hud . hudElement . subInventory . termID
+    tmid <- w ^? hud . subInventory . termID
     btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
     btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
     guard $ dist btpos (_crPos $ you w) > 40
-    return $ w & hud . hudElement . subInventory .~ NoSubInventory
+    return $ w & hud . subInventory .~ NoSubInventory
 
-updateMouseContext :: Configuration -> Universe -> Universe
+updateMouseContext :: Config -> Universe -> Universe
 updateMouseContext cfig u = case u ^? uvScreenLayers . ix 0 of
     Just screen -> u & uvWorld . input . mouseContext .~ getMenuMouseContext screen u
-    Nothing -> updateMouseContextGame cfig u
+    Nothing -> u & uvWorld . input . mouseContext %~ updateMouseContextGame cfig u
 
-updateMouseContextGame :: Configuration -> Universe -> Universe
+updateMouseContextGame :: Config -> Universe -> MouseContext -> MouseContext
-updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
+updateMouseContextGame cfig u = \case
-    OverInvDrag i _ _ _ -> u & uvWorld . input . mouseContext .~ invdrag i
+    OverInvDrag i _ ->  OverInvDrag i (inverseSelNumPos cfig invDP mpos disss)
-    OverInvDragSelect{} -> u
+    x@OverInvDragSelect{} -> x
-    _ ->
+    _ -> fromMaybe aimcontext (isrotatedrag <|> overinv <|> overcomb <|> overterm)
-        u & uvWorld . input . mouseContext
-            .~ fromMaybe aimcontext (isrotatedrag <|> overinv <|> overcomb <|> overterm)
   where
     w = u ^. uvWorld
     isrotatedrag = do
@@ -359,41 +357,31 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
         guard $ t1 > t2
         return MouseGameRotate
     aimcontext
-        --        | Just t1 <- w ^. input . mouseButtons . at ButtonLeft
-        --        , Just t2 <- w ^. input . mouseButtons . at ButtonRight
-        --        , t1 > t2 = MouseGameRotate
         | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
         | otherwise = MouseInGame
     mpos = w ^. input . mousePos
-    invdrag i' = fromMaybe (OverInvDrag i' Nothing Nothing Nothing) $ do
+    disss = w ^. hud . diSections
-        sss <- w ^? hud . hudElement . diSections
-        let yint = posSelSecYint cfig invDP (mpos ^. _y)
-        (i, j) <- inverseSelNumPos cfig invDP sss mpos
-        let above = inverseSelSecYint (yint - 1) sss
-            bneath = inverseSelSecYint (yint + 1) sss
-        return $ OverInvDrag i' (Just (i, j)) above bneath
     overinv = do
-        sss <- w ^? hud . hudElement . diSections
+        selpos@(i, j) <- inverseSelNumPos cfig invDP mpos disss
-        selpos@(i, j) <- inverseSelNumPos cfig invDP sss mpos
+        case w ^? hud . subInventory . ciSelection of
-        case w ^? hud . hudElement . subInventory . ciSelection of
             Just _ | i == 0 -> return $ OverCombFiltInv selpos
             Just _ -> Nothing
             _ -> do
                 guard $ ButtonRight `M.notMember` (w ^. input . mouseButtons)
-                guard =<< sss ^? ix i . ssItems . ix j . siIsSelectable
+                guard =<< disss ^? ix i . ssItems . ix j . siIsSelectable
                 return $ OverInvSelect selpos
     overcomb = do
-        sss <- w ^? hud . hudElement . subInventory . ciSections
+        sss <- w ^? hud . subInventory . ciSections
-        (xl, xr, _) <- w ^? hud . hudElement . subInventory . ciSelection . _Just
+        Sel xl xr _ <- w ^? hud . subInventory . ciSelection . _Just
         let msel = (xl, xr)
-        let mpossel = inverseSelNumPos cfig secondColumnParams sss (w ^. input . mousePos)
+        let mpossel = inverseSelNumPos cfig secondColumnLDP (w ^. input . mousePos) sss
         return $ case mpossel of
             Nothing -> OverCombEscape
             Just (-1, i) | (-1, i) == msel -> OverCombFilter
             Just x | x == msel -> OverCombCombine x
             Just x -> OverCombSelect x
     overterm = do
-        tmid <- w ^? hud . hudElement . subInventory . termID
+        tmid <- w ^? hud . subInventory . termID
         tm <- w ^? cWorld . lWorld . terminals . ix tmid
         return $
             if isOverTerminalScreen cfig mpos
@@ -405,20 +393,20 @@ getMenuMouseContext screen u = case screen ^. scOptions of
     [] -> NoMouseContext
     _ -> fromMaybe MouseMenuCursor $ do
         ymax <- length <$> screen ^? scSelectionList
-        yi <- ldpVerticalSelection (u ^. uvConfig) menuDisplayParams (u ^. uvWorld . input . mousePos)
+        yi <- ldpSelection (u ^. uvConfig) menuLDP (u ^. uvWorld . input . mousePos)
         guard (yi >= 0 && yi < ymax)
-        return $ case u ^? uvScreenLayers . _head . scSelectionList . ix yi . siIsSelectable of
+        return $ case screen ^? scSelectionList . ix yi . siIsSelectable of
             Just True -> MouseMenuClick yi
             _ -> NoMouseContext
 
-isOverTerminalScreen :: Configuration -> Point2 -> Bool
+isOverTerminalScreen :: Config -> Point2 -> Bool
 isOverTerminalScreen cfig (V2 x y) =
     x <= xmax
         && x >= xmin - 5
         && y <= ymax + 5
         && y >= ymin
   where
-    ldp = secondColumnParams
+    ldp = secondColumnLDP
     V2 xmin ymax = screenPosAbs cfig (ldp ^. ldpPos)
     tsize = fromIntegral $ getMaxLinesTM + 1
     s = 5 + tsize * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap)
@@ -437,8 +425,7 @@ advanceScrollAmount =
 
 updatePastWorlds :: World -> World
 updatePastWorlds w =
-    w
+    w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
-        & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
 
 doWorldEvents :: World -> World
 doWorldEvents w =
@@ -490,6 +477,7 @@ pbFlicker pt =
 
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
+
 zoneDusts :: World -> World
 zoneDusts w = w & dsZoning .~ foldl' (flip zoneDust) mempty (w ^. cWorld . lWorld . dusts)
 
@@ -506,7 +494,7 @@ tmUpdate tm w = fromMaybe w $ do
             w & pointTermParams
                 %~ ( (tmFutureLines %~ tail)
                         . (tmDisplayedLines %~ take getMaxLinesTM . (map displayTerminalLineString tls ++))
---                        . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
+                        --                        . (tmDisplayedLines %~ (map displayTerminalLineString tls ++))
                    )
                 & doTmWdWd g tm
   where
@@ -632,10 +620,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
     5 -> (Endo f, [pz & pzTimer -~ 1])
     _ -> (Endo g, [pz & pzTimer -~ 1])
   where
-    f w =
+    f w = dodam thHit w
-        dodam
-            thHit
-            w
             & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
       where
         (thHit, ps) = reflectPulseLaserAlong phasev sp xp w
@@ -657,7 +642,7 @@ updatePulseLaser pz = case pz ^. pzTimer of
     xp = sp +.+ 800 *.* unitVectorAtAngle dir
     g w = w & cWorld . lWorld . flares <>~ drawLaser cyan (sp : ps)
       where
-        (_, ps) = reflectLaserAlong phasev sp xp w
+        (_, ps) = reflectPulseLaserAlong phasev sp xp w
 
 randWallReflect :: RandomGen g => Float -> Wall -> State g Float
 randWallReflect a wl = randPeaked a1 outa a2

src/Dodge/Update/Camera.hs

@@ -27,12 +27,12 @@ import SDL (MouseButton (..))
 
 {- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
 update where your avatar's view is from.  -}
-updateCamera :: Configuration -> World -> World
+updateCamera :: Config -> World -> World
 updateCamera cfig w = case w ^. wCam . camControl of
     CamInGame{} -> updateInGameCamera cfig w
     CamFloat -> updateFloatingCamera cfig w
 
-updateFloatingCamera :: Configuration -> World -> World
+updateFloatingCamera :: Config -> World -> World
 updateFloatingCamera cfig w =
     w
         & updateBounds cfig
@@ -76,7 +76,7 @@ zoomFloatingCamera theinput
 
 -- the 39/40 is taken from zoomSpeed
 
-updateInGameCamera :: Configuration -> World -> World
+updateInGameCamera :: Config -> World -> World
 updateInGameCamera cfig w =
     w
         & updateBounds cfig
@@ -84,7 +84,7 @@ updateInGameCamera cfig w =
         & rotateCamera cfig
         & over wCam (setViewDistance cfig) -- I think this should be updated after the zoom?
 
-moveZoomCamera :: Configuration -> Input -> Creature -> World -> Camera -> Camera
+moveZoomCamera :: Config -> Input -> Creature -> World -> Camera -> Camera
 moveZoomCamera cfig theinput cr w campos =
     campos
         & camCenter .~ fromMaybe (_crPos cr +.+ offset) mremotepos
@@ -127,7 +127,9 @@ moveZoomCamera cfig theinput cr w campos =
         | curZoom > idealZoom + 0.01 = ((zoomOutSpeed -1) * curZoom + idealZoom) / zoomOutSpeed
         | curZoom < idealZoom - 0.01 = ((zoomInSpeed -1) * curZoom + idealZoom) / zoomInSpeed
         | otherwise = idealZoom
-    wallZoom = min4 (campos ^. camBoundDist)
+    wallZoom = min4 (f (campos ^. camBoundDist))
+    f (a,b,c,d) = (a+bordersize,b-bordersize,c+bordersize,d-bordersize)
+    bordersize = 20
     min4 (a, b, c, d) = minimum [hh / maxd a, hh / maxd (- b), hw / maxd c, hw / maxd (- d)]
     maxd = max distFromEqmnt
     distFromEqmnt = viewDistanceFromItems cr
@@ -192,7 +194,7 @@ heldAimZoom = \case
 viewDistanceFromItems :: Creature -> Float
 viewDistanceFromItems _ = 1
 
-rotateCamera :: Configuration -> World -> World
+rotateCamera :: Config -> World -> World
 rotateCamera cfig w
     | MouseGameRotate <- w ^. input . mouseContext
       , Just rotation <-
@@ -231,7 +233,7 @@ clipZoom ::
     Float
 clipZoom = min 20 . max 0.2
 
-setViewDistance :: Configuration -> Camera -> Camera
+setViewDistance :: Config -> Camera -> Camera
 setViewDistance cfig w =
     w & camViewDistance
         .~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
@@ -243,7 +245,7 @@ farWallDistDirection p w = boundPoints $ map f $ getViewpoints p (_cWorld w)
     wls q = filter wlIsOpaque $ wlsNearSeg p q w
     findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
 
-findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
+findBoundDists :: Config -> World -> (Float, Float, Float, Float)
 findBoundDists cfig w
     | debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
     | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
@@ -253,7 +255,7 @@ findBoundDists cfig w
 
 -- this probably doesn't need to be updated every frame,
 -- though I'm not sure how often it should be updated
-updateBounds :: Configuration -> World -> World
+updateBounds :: Config -> World -> World
 updateBounds cfig w = case (w ^. cWorld . cClock) `mod` 5 of
     0 ->
         w