Implement terminals

src/Dodge/Base.hs

@@ -428,9 +428,9 @@ coordinates.  -}
 cartePosToScreen :: Configuration -> World -> Point2 -> Point2
 cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
   where
-    doTranslate p       = p -.- _carteCenter w
+    doTranslate p       = p -.- _carteCenter (_hud w)
-    doZoom p            = _carteZoom w *.* p
+    doZoom p            = _carteZoom (_hud w) *.* p
-    doRotate p          = rotateV (negate $ _carteRot w) p
+    doRotate p          = rotateV (negate $ _carteRot (_hud w)) p
 crToMousePosOffset :: Creature -> World -> (Point2,Float)
 crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0)
 {- | The mouse position in world coordinates.  -}
@@ -438,7 +438,8 @@ mouseWorldPos :: World -> Point2
 mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
 {- | The mouse position in map coordinates -}
 mouseCartePos :: World -> Point2
-mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w)
+mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w)) 
+    *.* rotateV (_carteRot (_hud w)) (_mousePos w)
 {- | Create a logistic function given three parameters.  -}
 logistic :: Float -> Float -> Float -> (Float -> Float)
 logistic x0 l k x = l / (1 + exp (k*(x0 - x)))

src/Dodge/Base/Collide.hs

@@ -2,6 +2,7 @@
 {- | Basic collision detection for a moving point -}
 module Dodge.Base.Collide
     ( hasLOS
+    , hasButtonLOS
     , reflectPointWalls
     , ssfold
     , collidePointUpToIndirectMinDist
@@ -25,6 +26,12 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2
 
+hasButtonLOS :: Point2 -> Point2 -> World -> Bool
+{-# INLINE hasButtonLOS #-}
+hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2
+    . IM.filter (not . _wlTouchThrough) 
+    . wallsAlongLine p1 p2
+
 --hitPointLines
 --    :: Point2
 --    -> Point2

src/Dodge/Combine.hs

@@ -104,12 +104,12 @@ combineModules = mergeA
     h _ im _ = ([],im)
 
 toggleCombineInv :: World -> World
-toggleCombineInv w = case _inventoryMode w of
+toggleCombineInv w = case _hudElement (_hud w) of
-    CombineInventory _ -> w & inventoryMode .~ TopInventory
+    DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
     _ -> w & enterCombineInv
 
 enterCombineInv :: World -> World
-enterCombineInv w = w & inventoryMode .~ CombineInventory mi
+enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi)
   where
     mi = 0 <$ listToMaybe (combineItemListYou w)
 

src/Dodge/Combine/Combinations.hs

@@ -59,13 +59,13 @@ itemCombinations =
     , p [p 2 TUBE,o LAUNCHER] (launcherX 2)
     ] ++ [ p [p 2 TUBE,o $ LAUNCHERX i] (launcherX (i+1)) | i <- [2..9]]
     ++
-    [ po [LIGHTER,PIPE,CAN]  flameStick
+    [ po [LIGHTER,PUMP,CAN]  flameStick
     , po [FLAMESTICK,CAN,PUMP] blowTorch
     , po [FLAMESTICK,DRUM] flameThrower
     , po [FLAMETHROWER,DRUM] flameWall
     , po [FLAMETHROWER,PUMP] flameTorrent
 
-    , p [o PRISM,p 2 PIPE,o HARDWARE] lasGun
+    , p [o PRISM,o TRANSFORMER,o PIPE] lasGun
 
     , p [o TRANSFORMER,p 2 CAN] sparkGun
     , p [o SPARKGUN,p 2 PIPE] teslaGun

src/Dodge/Data.hs

@@ -110,17 +110,13 @@ data World = World
     , _pathGraph            :: ~(Gr Point2 Float)
     , _pathGraphP           :: ~[(Point2,Point2)]
     , _pathPoints           :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
-    , _carteDisplay         :: Bool
+    , _hud                  :: HUD
-    , _carteCenter          :: Point2
-    , _carteZoom            :: Float
-    , _carteRot             :: Float
     , _lightSources         :: IM.IntMap LightSource
     , _tempLightSources     :: [TempLightSource]
     , _closeObjects         :: [Either FloorItem Button]
     , _seenLocations        :: IM.IntMap (World -> Point2,String)
     , _selLocation          :: Int
     , _sideEffects          :: Universe -> IO Universe
-    , _inventoryMode        :: InventoryMode
     , _distortions          :: [Distortion]
     , _worldBounds          :: Bounds
     , _gameRooms            :: [GameRoom] -- consider using an IntMap
@@ -129,10 +125,30 @@ data World = World
     , _timeFlow             :: TimeFlowStatus
     , _worldClock           :: Int
     , _youHammerPosition    :: HammerPosition
-    , _worldTerminal        :: Maybe' WorldTerminal
     }
-data WorldTerminal = WorldTerminal Int [(Int,String)]
 
+data HUDElement = DisplayInventory {_subInventory :: SubInventory}
+    | DisplayCarte
+  deriving (Eq,Ord,Show)
+
+data SubInventory 
+    = NoSubInventory
+    | TweakInventory
+    | CombineInventory {_combineInvSel :: Maybe Int}
+    | InspectInventory
+    | LockedInventory
+    | DisplayTerminal 
+        {_termParams :: TerminalParams
+        ,_termID :: Int
+        }
+  deriving (Eq,Ord,Show)
+
+data HUD = HUD
+    { _hudElement   :: HUDElement
+    , _carteCenter  :: Point2
+    , _carteZoom    :: Float
+    , _carteRot     :: Float
+    }
 data TimeFlowStatus
     = RewindingNow
     | RewindingLastFrame
@@ -183,13 +199,6 @@ data MenuOption
         { _moKey    :: Scancode
         , _moEff    :: Universe -> IO (Maybe Universe)
         }
-data InventoryMode
-    = TopInventory
-    | TweakInventory
-    | CombineInventory {_combineInvSel :: Maybe Int}
-    | InspectInventory
-    | LockedInventory
-  deriving (Eq, Ord, Show)
 data CrGroupParams = CrGroupParams
     { _crGroupParamID   :: Int
     , _crGroupIDs       :: IS.IntSet
@@ -306,7 +315,14 @@ data Button = Button
     , _btID :: Int
     , _btText :: String
     , _btState :: ButtonState
+    , _btTerminalParams :: TerminalParams
     }
+data TerminalParams = NoTerminalParams | TerminalParams
+    { _termDisplayedLines :: [(String,Color)]
+    , _termFutureLines :: [(Int,(String,Color))]
+    , _termMaxLines :: Int
+    }
+  deriving (Eq,Ord,Show)
 data ButtonState = BtOn | BtOff | BtNoLabel
   deriving (Eq, Show)
 data PressPlate = PressPlate 
@@ -754,6 +770,7 @@ data Wall = Wall
     , _wlOpacity    :: Opacity
     , _wlPathable   :: Bool
     , _wlWalkable   :: Bool
+    , _wlTouchThrough :: Bool
     , _wlFireThrough :: Bool
     , _wlReflect    :: Bool
     , _wlDraw       :: Bool
@@ -981,7 +998,6 @@ makeLenses ''LSParam
 makeLenses ''ItemParams
 makeLenses ''ItemTweaks
 makeLenses ''Maybe'
-makeLenses ''InventoryMode
 makeLenses ''ItemPortage
 makeLenses ''Magnet
 makeLenses ''Gust
@@ -989,3 +1005,7 @@ makeLenses ''GunBarrels
 makeLenses ''ItemModule
 makeLenses ''Targeting
 makeLenses ''Nozzle
+makeLenses ''HUD
+makeLenses ''HUDElement
+makeLenses ''SubInventory
+makeLenses ''TerminalParams

src/Dodge/Default.hs

@@ -260,6 +260,7 @@ defaultButton = Button
     , _btID = 0
     , _btText = "Button"
     , _btState = BtOff
+    , _btTerminalParams = NoTerminalParams
     }
 defaultPT :: Prop
 defaultPT = Projectile

src/Dodge/Default/Wall.hs

@@ -13,6 +13,7 @@ defaultWall = Wall
     , _wlOpacity    = Opaque
     , _wlPathable   = False
     , _wlFireThrough = False
+    , _wlTouchThrough = False
     , _wlReflect = False
     , _wlDraw = True
     , _wlRotateTo = True

src/Dodge/Default/World.hs

@@ -65,10 +65,12 @@ defaultWorld = World
     , _pathGraph = Data.Graph.Inductive.Graph.empty
     , _pathGraphP = []
     , _pathPoints = IM.empty
-    , _carteDisplay = False
+    , _hud = HUD
-    , _carteCenter = V2 0 0
+        { _hudElement = DisplayInventory NoSubInventory
-    , _carteZoom = 0.5
+        , _carteCenter = V2 0 0
-    , _carteRot  = 0
+        , _carteZoom = 0.5
+        , _carteRot  = 0
+        }
     , _lightSources = IM.empty
     , _tempLightSources = [youLight]
     , _closeObjects     = []
@@ -80,7 +82,6 @@ defaultWorld = World
     --, _keyConfig = defaultKeyConfigSDL
 --    , _config       = defaultConfig
     , _sideEffects  = return
-    , _inventoryMode = TopInventory
     , _foregroundShape = mempty
     , _distortions     = []
     , _gameRooms = []
@@ -90,7 +91,6 @@ defaultWorld = World
     , _rewindWorlds = []
     , _timeFlow = NormalTimeFlow
     , _youHammerPosition = HammerUp
-    , _worldTerminal = Nothing'
     }
 youLight :: TempLightSource
 youLight = 

src/Dodge/Event.hs

@@ -89,10 +89,12 @@ handleResizeEvent sev u = return . Just $ u
 
 handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
 handlePressedMouseButton but w
-    | but == ButtonMiddle || _carteDisplay (_uvWorld w) 
+    | but == ButtonMiddle || _hudElement (_hud $ _uvWorld w) == DisplayCarte
                 = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
-    | but == ButtonLeft = case _inventoryMode (_uvWorld w) of
+    | but == ButtonLeft = case _hudElement (_hud $ _uvWorld w) of
-        CombineInventory mi -> Just $ fromMaybe (w & uvWorld . inventoryMode .~ TopInventory) $ do -- ugly
+        DisplayInventory (CombineInventory mi) 
+                -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) 
+                    $ do -- ugly
             i <- mi
             return $ over uvWorld (doCombine i) w
         _ -> Just w
@@ -117,11 +119,11 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
     _ -> Just w
 
 wheelEvent :: Float -> World -> World
-wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
+wheelEvent y w = case _hudElement $ _hud w of
-    (True, _)
+    DisplayCarte
-        | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
+        | rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
         | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
-    (_, TopInventory)
+    DisplayInventory NoSubInventory
             -- functions that modify the inventory should be centralised so that
             -- this lock can be sensibly applied, perhaps
         | _crInvLock (_creatures w IM.! _yourID w) -> w
@@ -131,14 +133,14 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
         | lbDown -> w & cameraZoom +~ y
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
         | otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
-    (_, TweakInventory)
+    DisplayInventory TweakInventory
         | invKeyDown && rbDown -> w & moveTweakSel yi
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
         | rbDown ->     w & changeTweakParam yi
         | otherwise ->  w & moveTweakSel yi
-    (_, CombineInventory _) -> w 
+    DisplayInventory (CombineInventory _) -> w 
-        & inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
+        & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
-    (_, _) -> w
+    _ -> w
   where
     numcombs = length $ combineItemListYou w
     yi = round $ signum y

src/Dodge/Event/Keyboard.hs

@@ -50,14 +50,14 @@ handlePressedKeyInGame scode w = case scode of
     ScancodeM   -> Just $ toggleMap w
     ScancodeR   -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
     ScancodeT   -> Just $ testEvent w
-    ScancodeX   -> Just $ w & inventoryMode %~ toggleInv TweakInventory
+    ScancodeX   -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory TweakInventory)
     ScancodeC   -> Just $ toggleCombineInv w
-    ScancodeI   -> Just $ w & inventoryMode %~ toggleInv InspectInventory
+    ScancodeI   -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory InspectInventory)
     _           -> Just w
 
-toggleInv :: InventoryMode -> InventoryMode -> InventoryMode
+toggleInv :: HUDElement -> HUDElement -> HUDElement
 toggleInv x y 
-    | x == y = TopInventory
+    | x == y = DisplayInventory NoSubInventory
     | otherwise = x
 
 gotoTerminal :: Universe -> Universe
@@ -66,13 +66,14 @@ gotoTerminal w = case _menuLayers w of
     _ -> w & menuLayers %~ (InputScreen [] :)
 
 spaceAction :: World -> World
-spaceAction w = if _carteDisplay w
+spaceAction w = case _hudElement $ _hud w of
-    then w & carteCenter .~ theLoc
+    DisplayCarte -> w & hud . carteCenter .~ theLoc
-    else case (_inventoryMode w, selectedCloseObject w) of
+    DisplayInventory NoSubInventory -> case selectedCloseObject w of
-        (TopInventory,Just (_,Left flit)) -> pickUpItem 0 flit w
+        Just (_,Left flit) -> pickUpItem 0 flit w
-        --(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w
+        Just (_,Right but) -> _btEvent but but w
-        (TopInventory,Just (_,Right but)) -> _btEvent but but w
+        _ -> w
-        _ -> w & inventoryMode .~ TopInventory
+    DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
+    _ -> w & hud . hudElement .~ DisplayInventory NoSubInventory
   where
     theLoc = fst (_seenLocations w IM.! _selLocation w) w
 --    updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail 
@@ -81,6 +82,10 @@ pauseGame :: World -> World
 pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu]))
 
 toggleMap :: World -> World
-toggleMap w = w & carteDisplay %~ not
+toggleMap w = case _hudElement $ _hud w of
+    DisplayCarte    -> w & hud . hudElement .~ DisplayInventory NoSubInventory
+    _               -> w & hud . hudElement .~ DisplayCarte
 escapeMap :: World -> World
-escapeMap w = w & carteDisplay .~ False
+escapeMap w = case _hudElement $ _hud w of
+    DisplayCarte    -> w & hud . hudElement .~ DisplayInventory NoSubInventory
+    _               -> w

src/Dodge/Floor.hs

@@ -8,7 +8,7 @@ module Dodge.Floor
 import Dodge.LockAndKey
 --import Dodge.Creature.State.Data
 import Dodge.Room
-import Dodge.Data.DamageType
+--import Dodge.Data.DamageType
 --import Dodge.Placement.Instance.Button
 import Dodge.Tree
 import Dodge.Annotation
@@ -36,7 +36,7 @@ import System.Random
 initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithCorridors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
-    , [SpecificRoom $ sensorRoom Flaming 50]
+--    , [SpecificRoom $ sensorRoom Flaming 50]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
     , [SpecificRoom randomChallenges]
     , [AnoApplyInt 1 lasSensorTurretTest]

src/Dodge/Inventory.hs

@@ -12,6 +12,7 @@ module Dodge.Inventory
     , augmentedInvSizes
     , rmInvItem
     , updateCloseObjects
+    , updateTerminal
     , closeObjScrollDir
     , closeObjectCol
 --    , swapInvDir
@@ -33,15 +34,15 @@ import Dodge.Base.Collide
 import Geometry
 --import FoldableHelp
 import Padding
+import Color
 import qualified IntMapHelp as IM
 import ListHelp
-import Color
+import LensHelp
 
 import qualified Data.IntSet as IS
 import Data.Maybe
 --import Data.List
 --import System.Random
-import Control.Lens
 
 -- | after this the item at the inventory position will no longer exist
 rmInvItem :: Int      -- ^ Creature id
@@ -120,6 +121,33 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
         | yourInvSel w < length (yourInv w) = 0
         | otherwise = 1
 
+updateTerminal :: World -> World
+updateTerminal w = case _hudElement $ _hud w of
+    DisplayInventory dt@DisplayTerminal{} -> w & hud . hudElement %~ updateDisplayTerminal dt w
+    _ -> w
+
+updateDisplayTerminal :: SubInventory -> World -> HUDElement -> HUDElement
+updateDisplayTerminal sub w inv 
+    | closetest == Just True = inv & subInventory %~ tickDisplayTerminal
+    | otherwise = DisplayInventory NoSubInventory
+  where
+    closetest = do
+        btpos <- w ^? buttons . ix (_termID sub) . btPos
+        return $ dist btpos (_crPos $ you w) < 40
+
+tickDisplayTerminal :: SubInventory -> SubInventory
+tickDisplayTerminal dt = case dt of
+    DisplayTerminal{} -> dt & termParams . termDisplayedLines .++~ maybeToList ml
+        & termParams . termFutureLines .~ newtfl
+      where
+        tfl = _termFutureLines $ _termParams dt
+        (ml,newtfl) = tickFutureLines tfl
+        tickFutureLines ((0,sc):xs) = (Just sc,xs)
+        tickFutureLines ((i,sc):xs) = (Nothing,(i-1,sc):xs)
+        tickFutureLines [] = (Nothing,[])
+    _ -> dt
+
+
 -- this looks ugly...
 updateCloseObjects :: World -> World
 updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
@@ -128,7 +156,7 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c
     updateinvsel curinvsel
         | length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
         | otherwise = curinvsel
-    filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
+    filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
     ypos = _crPos $ you w
     activeButtons = map Right
         . filter ( (/=) BtNoLabel . _btState) 

src/Dodge/Inventory/CloseObject.hs

@@ -2,7 +2,6 @@ module Dodge.Inventory.CloseObject where
 import Dodge.Data
 import Geometry
 
-
 closeObjPos :: Either FloorItem Button -> Point2
 closeObjPos e = case e of
     Right x -> _btPos x

src/Dodge/LevelGen/Data.hs

@@ -20,7 +20,7 @@ import qualified Data.IntMap.Strict as IM
 data PSType = PutCrit {_unPutCrit :: Creature}
     | PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine }
     | PutLS LightSource
-    | PutButton Button
+    | PutButton {_pstPutButton :: Button}
     | PutProp Prop
     | PutFlIt Item
     | PutPPlate PressPlate
@@ -52,6 +52,7 @@ data PlacementSpot
         { _psRoomRandPointNum :: Int 
         , _psRandShift :: (Point2,Float) -> PlacementSpot
         }
+-- TODO attempt to unify/simplify this union type
 data Placement 
     = Placement
         { _plSpot   :: PlacementSpot
@@ -59,7 +60,10 @@ data Placement
         , _plMID    :: Maybe Int
         , _plIDCont :: Placement -> Maybe Placement 
         }
-    | PlacementGenUpdate (GenParams -> Placement -> (GenParams, Placement)) Placement
+    | PlacementGenUpdate 
+        {_plGenUpdate :: (GenParams -> Placement -> (GenParams, Placement)) 
+        ,_plGenPL :: Placement
+        }
     | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
     | RandomPlacement {_unRandomPlacement :: State StdGen Placement}
     | PickOnePlacement Int Placement

src/Dodge/LevelGen/Switch.hs

@@ -28,6 +28,7 @@ makeButton col eff = Button
     , _btID = 0
     , _btText = "Button"
     , _btState = BtOff
+    , _btTerminalParams = NoTerminalParams
     }
   where
     turnOn bt = bt {_btState = BtNoLabel, _btEvent = const id}
@@ -68,6 +69,7 @@ makeSwitchSPic dswitch effOn effOff = Button
     , _btID = 0
     , _btText = "SWITCH/"
     , _btState = BtOff
+    , _btTerminalParams = NoTerminalParams
     }
   where 
     flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w
@@ -102,6 +104,7 @@ makeSwitch col1 col2 effOn effOff = Button
     , _btID = 0
     , _btText = "SWITCH/"
     , _btState = BtOff
+    , _btTerminalParams = NoTerminalParams
     }
   where 
     flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w

src/Dodge/LockAndKey.hs

@@ -14,11 +14,14 @@ import Control.Monad.State
 
 lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ]
 lockRoomKeyItems = 
-    [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
+    --[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
-    ,(const slowDoorRoomRunPast, return MINIGUN)
+    --,(sensorRoomRunPast Electrical, return SPARKGUN )
-    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+    [(sensorRoomRunPast Flaming, return FLAMESTICK )
-    ,(const glassLessonRunPast, takeOne [LASGUN])
+--    ,(sensorRoomRunPast Lasering, return LASGUN )
-    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
+--    ,(const slowDoorRoomRunPast, return MINIGUN)
+--    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+--    ,(const glassLessonRunPast, takeOne [LASGUN])
+--    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
     ]
 
 itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]
@@ -30,13 +33,17 @@ itemRooms =
       )
     , (MINIGUN  , join $ takeOne [roomMiniIntro, minigunFakeout] )
     , (LASGUN   , join $ takeOne 
-        [rc $ map makeTypeCraft [PRISM,PIPE,PIPE,HARDWARE]
+        [rc $ map makeTypeCraft [PRISM,TRANSFORMER,PIPE]
         ]
       )
     , (SPARKGUN   , join $ takeOne 
         [rc $ map makeTypeCraft [TRANSFORMER,CAN,CAN]
         ]
       )
+    , (FLAMESTICK   , join $ takeOne 
+        [rc $ map makeTypeCraft [LIGHTER,PUMP,CAN]
+        ]
+      )
     , (FLATSHIELD   , join $ takeOne 
         [rc $ map makeTypeCraft [PLATE,PLATE]
         ,rc $ map makeTypeCraft [DRUM,DRUM,PLATE]

src/Dodge/Placement/Instance/Terminal.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE TupleSections #-}
+module Dodge.Placement.Instance.Terminal where
+import Dodge.Data
+import Dodge.LevelGen.Data
+import Dodge.Default
+import Color
+import Geometry
+import ShapePicture
+import LensHelp
+import Shape
+
+import Data.Maybe
+
+putTerminal :: (GenParams -> TerminalParams) -> Placement
+putTerminal f = PlacementGenUpdate g $ ps0jPushPS (PutButton $ thebutton)
+    $ pt0 (PutMachine (dark magenta) (reverse $ square 10) defaultMachine
+    { _mcDraw = drawTerminal
+    , _mcHP = 100
+    })
+    $ const Nothing
+  where
+    g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp)
+    thebutton = Button
+        { _btPict = const mempty
+        , _btPos = 0
+        , _btRot = 0
+        , _btEvent = displayTerminalMessage . _btID
+        , _btID = 0
+        , _btText = "TERMINAL"
+        , _btState = BtOff
+        , _btTerminalParams = TerminalParams [] [] 10
+        }
+
+drawTerminal :: Machine -> SPic
+drawTerminal _ = noPic $ colorSH (dark green) $ upperPrismPoly 15 $ square 10
+
+displayTerminalMessage :: Int -> World -> World
+displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
+    { _termID = btid
+    , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
+    }

src/Dodge/Placement/PlaceSpot.hs

@@ -201,6 +201,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs
     baseWall = defaultMachineWall 
         & wlColor .~ col
         & wlStructure . wlStMachine .~ mcid
+        & wlTouchThrough .~ True
 
 mvLS :: Point3 -> Float -> LightSource -> LightSource
 mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos

src/Dodge/PlacementSpot.hs

@@ -8,6 +8,7 @@ module Dodge.PlacementSpot
     , anyUnusedSpot
     , unusedSpotAwayFromLink
     , isUnusedLnk
+    , isUnusedLnk'
     , isInLnk
     , unusedSpotNearInLink
     , randDirPS
@@ -21,7 +22,7 @@ module Dodge.PlacementSpot
     , twoRoomPoss
     , isUnusedLinkType
     , rprBoolShift 
-    , rpBool
+    , rprBool
     , shiftInBy
     , resetPLUse
     ) where
@@ -47,11 +48,18 @@ randDirPS ps = do
     a <- state $ randomR (0,pi*2)
     return $ setDirPS a ps
 
-rpBool :: (RoomPos -> Bool) -> PlacementSpot
+isUnusedLnk :: RoomPos -> Room -> Bool
-rpBool t = PSPos (useRoomPosCond t) (const id) Nothing
+isUnusedLnk rp _ = case _rpLinkStatus rp of
+    UnusedLink {} -> _rpPlacementUse rp == 0
+    _ -> False
+
+isUnusedLnk' :: RoomPos -> Bool
+isUnusedLnk' rp = case _rpLinkStatus rp of
+    UnusedLink {} -> _rpPlacementUse rp == 0
+    _ -> False
 
 anyUnusedSpot :: PlacementSpot
-anyUnusedSpot = rpBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
+anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
 
 rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
 rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
@@ -98,18 +106,18 @@ unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
 --twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
 --twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
 
-twoRoomPoss :: (RoomPos -> Bool)
+twoRoomPoss :: (RoomPos -> Room -> Bool)
-    -> (RoomPos -> Bool)
+    -> (RoomPos -> Room -> Bool)
     -> (PlacementSpot -> PlacementSpot -> Placement)
     -> Placement
-twoRoomPoss cond1 cond2 f = Placement (rpBool cond1) PutNothing Nothing
+twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing
-    $ \pl1 -> Just $ Placement (rpBool cond2) PutNothing Nothing
+    $ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing
     $ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
 
-isUnusedLnk :: RoomPos -> Bool
+--isUnusedLnk :: RoomPos -> Bool
-isUnusedLnk rp = case _rpLinkStatus rp of
+--isUnusedLnk rp = case _rpLinkStatus rp of
-    UnusedLink {} -> _rpPlacementUse rp == 0
+--    UnusedLink {} -> _rpPlacementUse rp == 0
-    _ -> False
+--    _ -> False
 
 isInLnk :: RoomPos -> Bool
 isInLnk rp = case _rpLinkStatus rp of
@@ -117,7 +125,7 @@ isInLnk rp = case _rpLinkStatus rp of
     _ -> False
 
 useUnusedLnk :: PlacementSpot
-useUnusedLnk = rpBool isUnusedLnk
+useUnusedLnk = rprBool isUnusedLnk
 
 isUsedLnkUnplaced :: RoomPos -> Bool
 isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
@@ -125,8 +133,8 @@ isUsedLnkUnplaced  rp = case _rpLinkStatus rp of
     UsedInLink  {} -> _rpPlacementUse rp == 0
     _ -> False
 
-useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
+useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
-useRoomPosCond f = useRoomPosRoomCond $ \rp _ -> f rp
+useRoomPosCond f = useRoomPosRoomCond $ \rp r -> f rp r
 
 useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
 useRoomPosRoomCond t rp r
@@ -159,7 +167,7 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
         _ -> Nothing
 
 atFstLnkOut :: PlacementSpot
-atFstLnkOut = rpBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
+atFstLnkOut = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just 0
 
 atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
 atNthLnkOutShiftBy n = rprBoolShift 

src/Dodge/Render/HUD.hs

@@ -28,16 +28,16 @@ import SDL (MouseButton (..))
 --import Data.Bifunctor
 
 hudDrawings :: Configuration -> World -> Picture
-hudDrawings cfig w = if _carteDisplay w
+hudDrawings cfig w = case _hudElement $ _hud w of
-    then drawCarte cfig w
+    DisplayCarte -> drawCarte cfig w
-    else drawInGameHUD cfig w
+    DisplayInventory subinv -> drawInGameHUD cfig w
+        <> subInventoryDisplay subinv cfig w
 
 drawInGameHUD :: Configuration -> World -> Picture
 drawInGameHUD cfig w = pictures
     [ winScale cfig . dShadCol white $ displayHP 0 cfig w
     , listTextPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w)
     , inventoryDisplay cfig w
-    , subInventoryDisplay cfig w
     ]
 
 inventoryDisplay :: Configuration -> World -> Picture
@@ -49,7 +49,7 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
         ++ displayFreeSlots
         ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
     floorItemsColor
-        | _inventoryMode w == TopInventory = id
+        | _hudElement (_hud w) == DisplayInventory NoSubInventory = id
         | otherwise = color invDimColor
     nfreeslots = crNumFreeSlots cr
     displayFreeSlots = case nfreeslots of
@@ -57,10 +57,10 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
         1 -> [color invDimColor . text $ "  +1 FREE SLOT"]
         x -> [color invDimColor . text $ "  +" ++ show x ++ " FREE SLOTS"]
 
-subInventoryDisplay :: Configuration -> World -> Picture
+subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
-subInventoryDisplay cfig w = case _inventoryMode w of
+subInventoryDisplay subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-    TopInventory -> pictures
+    NoSubInventory -> pictures
         [ selcursor
         , closeobjectcursor
         , equipcursor
@@ -81,6 +81,10 @@ subInventoryDisplay cfig w = case _inventoryMode w of
         , invHead cfig "TWEAK"
         , listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
         ]
+    DisplayTerminal {_termParams = tp} -> pictures
+        [ invHead cfig "TERMINAL"
+        , renderListAt subInvX 60 cfig . reverse $ take (_termMaxLines tp) (_termDisplayedLines tp)
+        ]
     CombineInventory mi -> pictures
         [ invHead cfig "COMBINE"
         , listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w

src/Dodge/Render/List.hs

@@ -61,7 +61,7 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig
     hh = halfHeight cfig
 
 renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
-renderListAt tx ty cfig = listTextPicturesAt tx (negate ty) cfig . map (\(str,col) -> color col $ text str)
+renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str)
 --    concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
 
 --TODO put the following functions in an appropriate place

src/Dodge/Room/LasTurret.hs

@@ -34,7 +34,7 @@ cenLasTur :: Room
 cenLasTur = roomNgon 8 200 & rmPmnts .~
     [ putLasTurret 0.02
     , heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
-    , mntLightLnkCond $ rpBool isInLnk
+    , mntLightLnkCond $ rprBool $ const . isInLnk
     ]
   where
     covershape = rectNSEW 10 (-10) 20 (-20)

src/Dodge/Room/LongDoor.hs

@@ -117,7 +117,7 @@ addButtonSlowDoor x h rm = do
          Nothing
     getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
         in (b, argV (a-.-b))
-    butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h 
+    butPosCond = useRoomPosCond $ \rp _ -> isUnusedLnk' rp && yV2 (_rpPos rp) < 0.5 * h 
     --butPosCond _ = True -- y < h
     col = dim $ light red
     cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff

src/Dodge/Room/Procedural.hs

@@ -51,6 +51,7 @@ roomRect
 roomRect x y xn yn = defaultRoom
     { _rmPolys = [rectNSWE  y 0 0 x ]
     , _rmLinks = lnks
+    , _rmName  = "rect"
     , _rmPath  = concatMap doublePair pth
     , _rmPos   = map (roomposat RoomPosOnPath) posps
         ++ map (roomposat RoomPosOffPath) interposps
@@ -77,7 +78,7 @@ roomRect x y xn yn = defaultRoom
         ++ m East FromSouth FromNorth elnks
         ++ m West FromSouth FromNorth wlnks
         ++ m South FromWest FromEast slnks
-    m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..]
+    m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
         . zipCountDown
     pth  = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
     posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
@@ -86,10 +87,10 @@ roomRect x y xn yn = defaultRoom
 zipCountDown :: [a] -> [(Int,a)]
 zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
 
-lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType) 
+lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType) 
     -> (Int -> RoomLinkType)
     -> Int -> (Int,(Point2,Float)) -> RoomLink
-lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink 
+lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink 
     {_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
     ,_rlPos = p 
     , _rlDir = a
@@ -98,10 +99,13 @@ lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
 -- it is not clear to me that this works for very small rooms (but it does seem
 -- to do so)
 roomRectAutoLinks :: Float -> Float -> Room
-roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts}
+roomRectAutoLinks x y = (roomRect x y (f x) (f y)) 
+    {_rmPmnts = plmnts
+    ,_rmName = "autoRect"
+    }
   where
     f z = max 1 $ (ceiling z - 40) `div` 60
-    plmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
+    plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
 {- Combines two rooms into one room.
  - will have to work out exactly what to do with combining links
 Mostly involves concatenation.  -}

src/Dodge/Room/Room.hs

@@ -185,9 +185,9 @@ roomOctogon = defaultRoom
 roomNgon :: Int -> Float -> Room
 roomNgon n x = defaultRoom
     { _rmPolys = [poly]
-    , _rmLinks = muout (init lnks) ++ muin[last lnks]
+    , _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
     , _rmPath  = [] -- TODO
-    , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
+    , _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
     , _rmBound = [poly]
     , _rmFloor = Tiled [makeTileFromPoly poly 9]
     , _rmName = show n ++ "gon"

src/Dodge/Room/SensorDoor.hs

@@ -1,13 +1,14 @@
 module Dodge.Room.SensorDoor where
 import Dodge.LevelGen.Data
 import Dodge.PlacementSpot
+import Dodge.Placement.Instance.Terminal
 import Dodge.Data
 import Dodge.Tree
 --import Dodge.RoomLink
 import Dodge.Room.Door
 import Dodge.Room.Procedural
 import Dodge.Room.Room
---import Dodge.Room.Corridor
+import Dodge.Room.Corridor
 import Dodge.Room.Link
 --import Dodge.Room.Procedural
 import Dodge.Room.Foreground
@@ -22,11 +23,13 @@ import Geometry
 --import Padding
 import Color
 import Shape
+--import Lorem
 import LensHelp
 import Dodge.RandomHelp
 
---import qualified Data.Set as S
+import qualified Data.Set as S
 import Data.Maybe
+import Data.Char
 --import Data.Tree
 import Control.Monad.State
 import System.Random
@@ -38,6 +41,16 @@ sensorRoom senseType n = do
     let doorroom = triggerDoorRoom n
     return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
+sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
+sensorRoomRunPast dt n = do
+    t <- sensorRoom dt n
+    return $ applyToSubforest [0] (++
+        [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
+            & rmName .~ "test"
+        ] (UseLabel 0 corridor)]
+        ) t
+        --[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
+
 sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
 sensAboveDoor sensetype wth ps = extTrigLitPos 
     (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
@@ -48,9 +61,35 @@ sensAboveDoor sensetype wth ps = extTrigLitPos
 
 sensInsideDoor :: DamageType -> Int -> Room -> Room
 sensInsideDoor senseType outplid rm = rm 
-    & rmPmnts .:~ psPt atFstLnkOut 
+    & rmName .++~ take 4 (show senseType)
-        (PutShape $ colorSH yellow $
+    & rmPmnts .++~ 
-        thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
+        [ psPt atFstLnkOut 
-        <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
+            (PutShape $ colorSH yellow $
-        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+            thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
+            <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
+            <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+        , putTerminal messagef 
+            & plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
+        ]
     & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
+  where
+    mtoup = map toUpper
+    horline = "-----------------"
+    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]]
+    messagef gp = 
+        let Just (pc,ds) = gp ^? sensorCoding . ix senseType
+            themessage =
+                topflush ++
+                [horline
+                ,"SENSOR ATTRIBUTES"
+                ,horline
+                ,mtoup $ show senseType
+                ,"COLOR:"++ mtoup (show pc)
+                ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
+                ,horline
+                ]
+        in TerminalParams
+            {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
+            ,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white
+            ,_termMaxLines = 7
+            }

src/Dodge/Room/Tanks.hs

@@ -41,8 +41,8 @@ tanksRoom crs its = do
     girderPosOrder <- shuffle [1 .. nwestlnks - 2]
     let plmnts = 
             --ok, this has become complicated
-            foldr1 setFallback [ twoRoomPoss (isUnusedLinkType (FromSouth i)) 
+            foldr1 setFallback [ twoRoomPoss (const . isUnusedLinkType (FromSouth i)) 
-                (isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
+                (const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
                 sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2) 
                 | i <- girderPosOrder]
             : map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its

src/Dodge/Tree/Polymorphic.hs

@@ -9,6 +9,8 @@ the nodes in the trunk are [a,b] (note that d is not the first child of b).
  -}
 module Dodge.Tree.Polymorphic
     ( applyToRoot
+    , applyToSubtree
+    , applyToSubforest
     , treeFromPost
     , treeFromTrunk
     , splitTrunk
@@ -56,6 +58,22 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
   where
     (ys, z:zs) = splitAt i xs
 
+{- | Applies a function to a specific subtree determined by a list of indices.
+Unsafe (partial function).  -}
+applyToSubtree :: [Int] -> (Tree a -> Tree a) -> Tree a -> Tree a
+applyToSubtree [] f t = f t
+applyToSubtree (i:is) f (Node x xs) = Node x (ys ++ [applyToSubtree is f z] ++ zs)
+  where
+    (ys, z:zs) = splitAt i xs
+
+{- | Applies a function to a specific subforest determined by a list of indices.
+Unsafe (partial function).  -}
+applyToSubforest :: [Int] -> ([Tree a] -> [Tree a]) -> Tree a -> Tree a
+applyToSubforest [] f (Node p cs) = Node p (f cs)
+applyToSubforest (i:is) f (Node x xs) = Node x (ys ++ [applyToSubforest is f z] ++ zs)
+  where
+    (ys, z:zs) = splitAt i xs
+
 -- do not delete: find use for
 --{- |
 --Applies a function to the first node along a trunk that satisfies a given property.

src/Dodge/Update.hs

@@ -73,6 +73,7 @@ functionalUpdate cfig w = checkEndGame
     . updateBlocks
     . updateSeenWalls 
     . (youHammerPosition %~ moveHammerUp)
+    . updateTerminal
     $ updateCloseObjects w
   where 
     --updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w

src/Dodge/Update/UsingInput.hs

@@ -12,9 +12,9 @@ import qualified Data.Set as S
 import Control.Lens
 
 updateUsingInput :: World -> World
-updateUsingInput w = if _carteDisplay w
+updateUsingInput w = case _hudElement $ _hud w of
-    then updatePressedButtonsCarte (_mouseButtons w) w
+    DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w
-    else updatePressedButtons (_mouseButtons w) w
+    DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w
 
 updatePressedButtons :: S.Set MouseButton -> World -> World
 updatePressedButtons pkeys w 
@@ -26,7 +26,7 @@ updatePressedButtons pkeys w
         & cameraRot -~ rotation
     | otherwise = w
   where 
-    inTopInv  = _inventoryMode w == TopInventory
+    inTopInv  = _hudElement (_hud w) == DisplayInventory NoSubInventory
     lbPressed = ButtonLeft `S.member` pkeys
     rbPressed = ButtonRight `S.member` pkeys
     mbPressed = ButtonMiddle `S.member` pkeys
@@ -35,10 +35,10 @@ updatePressedButtons pkeys w
 updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
 updatePressedButtonsCarte pkeys w 
     | rbPressed = w & clickMousePos .~ _mousePos w 
-                    & carteCenter   %~ (-.- trans)
+                    & hud . carteCenter   %~ (-.- trans)
     | lbPressed = w & clickMousePos .~ _mousePos w 
-                    & carteRot      -~ rot
+                    & hud . carteRot      -~ rot
-                    & carteZoom     *~ czoom
+                    & hud . carteZoom     *~ czoom
     | otherwise = w
   where 
     lbPressed = ButtonLeft `S.member` pkeys
@@ -46,4 +46,4 @@ updatePressedButtonsCarte pkeys w
     --mbPressed = ButtonMiddle `S.member` pkeys
     rot     = angleBetween (_mousePos w) (_clickMousePos w)
     czoom    = magV (_mousePos w) / magV (_clickMousePos w)
-    trans   = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w)
+    trans   = rotateV (_carteRot (_hud w)) $ (1 / _carteZoom (_hud w)) *.* (_mousePos w -.- _clickMousePos w)