Add looping sound, add sound to terminals

src/Dodge/Annotation.hs

@@ -45,12 +45,6 @@ roomThenCorridor theRoom = fmap
 anoToRoomTree :: RandomGen g => [Annotation g] -> State g (SubCompTree Room)
 anoToRoomTree anos = case anos of
     [AnoApplyInt i f] -> f i
---    [SetLabel i randrm] -> do
---        rm <- randrm
---        return . singleUseAll $ rm & rmLabel ?~ i
---    [UseLabel i randrm] -> do
---        rm <- randrm
---        return $ singleUseAll $ rm & rmTakeFrom ?~ i
     [ChainAnos ass] -> do
         rms <- mapM anoToRoomTree ass
         return $ chainUses rms
@@ -64,12 +58,10 @@ anoToRoomTree anos = case anos of
         a <- takeOne as
         anoToRoomTree a
     [Corridor] -> pure . UseAll <$> shuffleLinks corridor
-    [AirlockAno] -> airlock >>=  roomThenCorridor
     [FirstWeapon] -> do
         branchWP <- branchRectWith weaponRoom
         blockedC <- longBlockedCorridor 3
         join $ takeOne $ return (passUntilUseAll branchWP [blockedC]) : replicate 5 weaponRoom
-    [EndRoom] -> fmap (pure . UseAll) (telRoomLev 1)
     (SpecificRoom rt:_) -> rt
     (BossAno cr : _) -> do
         br <- bossRoom cr

src/Dodge/Annotation/Data.hs

@@ -13,7 +13,6 @@ data Annotation g
     | Corridor
     | AirlockAno
     | FirstWeapon
-    | EndRoom
     | OrAno [[Annotation g]]
     | SpecificRoom (State g (SubCompTree Room))
     | BossAno Creature

src/Dodge/Creature/Perception.hs

@@ -155,7 +155,7 @@ awakeLevelPerception cr = case _crAwakeLevel $ _crPerception cr of
 newSounds :: World -> [(Point2,Float)]
 newSounds = mapMaybe f . M.elems . _playingSounds
   where
-    f s = case _soundStatus s of
+    f s = case _playStatus $ _soundStatus s of
         JustStartedPlaying -> Just (_soundPos s, _soundVolume s)
         _ -> Nothing
 

src/Dodge/Data.hs

@@ -129,7 +129,7 @@ data World = World
 
 data HUDElement = DisplayInventory {_subInventory :: SubInventory}
     | DisplayCarte
-  deriving (Eq,Ord,Show)
+--  deriving (Eq,Ord,Show)
 
 data SubInventory 
     = NoSubInventory
@@ -141,7 +141,7 @@ data SubInventory
         {_termParams :: TerminalParams
         ,_termID :: Int
         }
-  deriving (Eq,Ord,Show)
+--  deriving (Eq,Ord,Show)
 
 data HUD = HUD
     { _hudElement   :: HUDElement
@@ -319,10 +319,19 @@ data Button = Button
     }
 data TerminalParams = NoTerminalParams | TerminalParams
     { _termDisplayedLines :: [(String,Color)]
-    , _termFutureLines :: [(Int,(String,Color))]
+    , _termFutureLines :: [TerminalLine]
     , _termMaxLines :: Int
     }
-  deriving (Eq,Ord,Show)
+data TerminalLine
+    = TerminalLineDisplay
+        {_tlPause :: Int
+        ,_tlString :: String
+        ,_tlColor  :: Color
+        }
+    | TerminalLineEffect
+        {_tlPause :: Int
+        ,_tlEffect :: SubInventory -> World -> World
+        }
 data ButtonState = BtOn | BtOff | BtNoLabel
   deriving (Eq, Show)
 data PressPlate = PressPlate 
@@ -1009,3 +1018,4 @@ makeLenses ''HUD
 makeLenses ''HUDElement
 makeLenses ''SubInventory
 makeLenses ''TerminalParams
+makeLenses ''TerminalLine

src/Dodge/Data/SoundOrigin.hs

@@ -7,6 +7,7 @@ data SoundOrigin = InventorySound
     | CrMouth Int
     | CrWeaponSound Int Int
     | MachineSound Int
+    | TerminalSound
     | WallSound Int
     | CrReloadSound Int
     | Flamer

src/Dodge/Event.hs

@@ -88,17 +88,15 @@ handleResizeEvent sev u = return . Just $ u
     divRes = resFactorNum $ u ^. config . resolution_factor
 
 handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
-handlePressedMouseButton but w
+handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of
-    | but == ButtonMiddle || _hudElement (_hud $ _uvWorld w) == DisplayCarte
+    (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
-                = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
+    (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
-    | but == ButtonLeft = case _hudElement (_hud $ _uvWorld w) of
+    ( DisplayInventory (CombineInventory mi) , ButtonLeft)
-        DisplayInventory (CombineInventory mi) 
                 -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) 
                     $ do -- ugly
             i <- mi
             return $ over uvWorld (doCombine i) w
-        _ -> Just w
+    _ -> Just w
-    | otherwise = Just w
 
 -- note "sort" on the inventory indices; otherwise
 -- lower items may be shifted up and items below these removed instead

src/Dodge/Event/Keyboard.hs

@@ -50,15 +50,20 @@ 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 & hud . hudElement %~ toggleInv (DisplayInventory TweakInventory)
+    ScancodeX   -> Just $ w & hud . hudElement %~ toggleTweakInv
     ScancodeC   -> Just $ toggleCombineInv w
-    ScancodeI   -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory InspectInventory)
+    ScancodeI   -> Just $ w & hud . hudElement %~ toggleInspectInv
     _           -> Just w
 
-toggleInv :: HUDElement -> HUDElement -> HUDElement
+toggleTweakInv :: HUDElement -> HUDElement
-toggleInv x y 
+toggleTweakInv he = case he of
-    | x == y = DisplayInventory NoSubInventory
+    DisplayInventory TweakInventory -> DisplayInventory NoSubInventory
-    | otherwise = x
+    _ -> DisplayInventory TweakInventory
+
+toggleInspectInv :: HUDElement -> HUDElement
+toggleInspectInv he = case he of
+    DisplayInventory InspectInventory -> DisplayInventory NoSubInventory
+    _ -> DisplayInventory InspectInventory
 
 gotoTerminal :: Universe -> Universe
 gotoTerminal w = case _menuLayers w of

src/Dodge/Floor.hs

@@ -94,7 +94,7 @@ initialAnoTree = padSucWithCorridors $ treeFromTrunk
 --    ,[TreasureAno [addArmour autoCrit,addArmour autoCrit] [launcher]]
     ] 
     $ treeFromPost [[Corridor,SpecificRoom $ pure . UseAll <$> randomFourCornerRoom []]] 
-                                [EndRoom]
+    [SpecificRoom $ fmap (pure . UseAll) (telRoomLev 1)]
 
 {- | A test level tree. -}
 initialRoomTree :: RandomGen g => State g (Tree Room)

src/Dodge/Inventory.hs

@@ -122,31 +122,26 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
         | otherwise = 1
 
 updateTerminal :: World -> World
-updateTerminal w = case _hudElement $ _hud w of
+updateTerminal = checkTermDist . updateTerminalLine
-    DisplayInventory dt@DisplayTerminal{} -> w & hud . hudElement %~ updateDisplayTerminal dt w
-    _ -> w
 
-updateDisplayTerminal :: SubInventory -> World -> HUDElement -> HUDElement
+checkTermDist :: World -> World
-updateDisplayTerminal sub w inv 
+checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
-    | closetest == Just True = inv & subInventory %~ tickDisplayTerminal
+    Just btid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do
-    | otherwise = DisplayInventory NoSubInventory
+        btpos <- w ^? buttons . ix btid . btPos 
-  where
+        if dist btpos (_crPos $ you w) < 40 then Just w else Nothing
-    closetest = do
+    Nothing -> w
-        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
 
+updateTerminalLine :: World -> World
+updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . termFutureLines . ix 0 of
+    Nothing -> w
+    Just tl | _tlPause tl > 0 -> w 
+        & hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1
+    Just (TerminalLineDisplay _ s c) -> w
+        & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
+        & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ (s,c)
+    Just (TerminalLineEffect _ eff) -> w
+        & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
+        & eff (_subInventory . _hudElement $ _hud w)
 
 -- this looks ugly...
 updateCloseObjects :: World -> World

src/Dodge/LevelGen/Data.hs

@@ -61,7 +61,7 @@ data Placement
         , _plIDCont :: Placement -> Maybe Placement 
         }
     | PlacementGenUpdate 
-        {_plGenUpdate :: (GenParams -> Placement -> (GenParams, Placement)) 
+        {_plGenUpdate :: GenParams -> Placement -> (GenParams, Placement)
         ,_plGenPL :: Placement
         }
     | PlacementUsingPos Point3 (Point3 -> Placement)  -- allows a placement to use a shifted position
@@ -159,6 +159,7 @@ data RoomPosType
     = RoomPosOnPath
     | RoomPosOffPath
     | RoomPosExLink
+    | RoomPosLab Int
   deriving (Eq,Ord,Show)
 data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration
     | ThreeLineDecoration
@@ -231,8 +232,8 @@ pt0 pst = Placement (PS (V2 0 0) 0) pst Nothing
 contToIDCont :: (Int -> Maybe Placement) -> Placement -> Maybe Placement
 contToIDCont f = f . fromJust . _plMID
 
-jps0 :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
+jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement
-jps0 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont
+jps0' pst = Just . Placement (PS (V2 0 0) 0) pst Nothing
 
 jps0PushPS :: PSType -> (Int -> Maybe Placement) -> Maybe Placement
 jps0PushPS pst f = Just . Placement (PSNoShiftCont (V2 0 0) 0) pst Nothing

src/Dodge/LockAndKey.hs

@@ -14,14 +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] )
-    [(sensorRoomRunPast Electrical, return SPARKGUN )
+    --,(sensorRoomRunPast Electrical, return SPARKGUN )
-    ,(sensorRoomRunPast Flaming, return FLAMESPITTER )
+    --,(sensorRoomRunPast Flaming, return FLAMESPITTER )
-    ,(sensorRoomRunPast Lasering, return LASGUN )
+    --,(sensorRoomRunPast Lasering, return LASGUN )
---    ,(const slowDoorRoomRunPast, return MINIGUN)
+    [(const slowDoorRoomRunPast, return MINIGUN)
---    ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
+    --,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
---    ,(const glassLessonRunPast, takeOne [LASGUN])
+    --,(const glassLessonRunPast, takeOne [LASGUN])
---    ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
+    --,(const $ lasTunnelRunPast 400, return FLATSHIELD)
     ]
 
 itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]

src/Dodge/Placement/Instance.hs

@@ -9,6 +9,7 @@ module Dodge.Placement.Instance
     , module Dodge.Placement.Instance.Sensor
     , module Dodge.Placement.Instance.Creature
     , module Dodge.Placement.Instance.LightSource.Flicker
+    , module Dodge.Placement.Instance.Terminal
     )
     where
 import Dodge.Placement.Instance.Door
@@ -21,3 +22,4 @@ import Dodge.Placement.Instance.Button
 import Dodge.Placement.Instance.Turret
 import Dodge.Placement.Instance.Sensor
 import Dodge.Placement.Instance.Creature
+import Dodge.Placement.Instance.Terminal

src/Dodge/Placement/Instance/Button.hs

@@ -46,30 +46,16 @@ triggerSwitch col ps = psPtCont ps (PutTrigger (const False))
     oneff  tid = triggers . ix tid .~ const True
     offeff tid = triggers . ix tid .~ const False
 
-putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
-putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
-    $ contToIDCont
-    $ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
-    subpl
-  where
-    p'  = p -.- 30 *.* vNormal (unitVectorAtAngle a)
-    p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a)
-    changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
-    ls = lsRadCol 75 (V3 0.5 0 0)
-
 putLitButOnPos :: Color 
-    -> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)) 
+    -> PlacementSpot 
-    -> (Int -> Maybe Placement) -> Placement
+    -> (Placement -> Maybe Placement) -> Placement
-putLitButOnPos col f subpl 
+putLitButOnPos col theps subpl 
-    = plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
+    = plSpot .~ theps $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
-    $ \plmnt -> let lsid = fromJust $ _plMID plmnt
+    $ \plmnt -> jps0' (PutButton (makeButton col (changeLight . fromJust $ _plMID plmnt)) {_btPos = V2 0 (-1), _btRot = pi})
-        in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
                 subpl <&> plSpot .~ _plSpot plmnt
   where
     changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
     ls = lsRadCol 75 (V3 0.5 0 0)
-    thePS = PSPos f (const id) Nothing
-
 
 -- creates a lit external trigger, passes the trigger placement forward
 extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
@@ -92,13 +78,19 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
 putLitButOnPosExtTrig :: Color 
    -> PlacementSpot 
    -> Placement
-putLitButOnPosExtTrig col thePS
+putLitButOnPosExtTrig col thePS = putLitButOnPosExtTrig' col thePS (const . const . const Nothing)
+
+putLitButOnPosExtTrig' :: Color 
+    -> PlacementSpot 
+    -> (Placement -> Placement -> Placement -> Maybe Placement)
+    -> Placement
+putLitButOnPosExtTrig' col thePS cnt
     = psPtCont thePS (PutTrigger (const False))
     $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
-    $ \plmnt -> let lsid = fromJust $ _plMID plmnt
+    $ \plmnt -> jps0' (PutButton 
-        in jps0 (PutButton (makeButton col (changeLight lsid . oneff (trigid tp))) 
+            (makeButton col (changeLight (fromJust $ _plMID plmnt) . oneff (trigid tp))) 
-                    {_btPos = V2 0 (-1), _btRot = pi})
+                {_btPos = V2 0 (-1), _btRot = pi})
-                (const Nothing) <&> plSpot .~ _plSpot plmnt
+            (cnt tp plmnt) <&> plSpot .~ _plSpot plmnt
   where
     trigid tp = fromJust $ _plMID tp
     oneff tid = triggers . ix tid .~ const True

src/Dodge/Placement/Instance/Sensor.hs

@@ -53,8 +53,8 @@ damageUsing dt dm
     | otherwise = Right 0
 
 sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic
-sensorSPic wdth (pc,ds) _ = ( (colorSH yellow $ upperPrismPoly 25 (square wdth))
+sensorSPic wdth (pc,ds) _ = noPic 
-    <> decorationToShape ds wdth wdth 25 col col
+    $ colorSH yellow (upperPrismPoly 25 (square wdth))
-    , mempty )
+        <> decorationToShape ds wdth wdth 25 col col
   where
     col = paletteToColor pc

src/Dodge/Placement/Instance/Terminal.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 module Dodge.Placement.Instance.Terminal 
     ( putTerminal
     ) where
@@ -17,7 +17,7 @@ import Shape
 import Data.Maybe
 
 putTerminal :: (GenParams -> TerminalParams) -> Placement
-putTerminal f = PlacementGenUpdate g $ ps0PushPS (PutButton $ thebutton)
+putTerminal f = PlacementGenUpdate g $ ps0PushPS (PutButton thebutton)
     $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
     { _mcDraw = drawTerminal
     , _mcHP = 100

src/Dodge/PlacementSpot.hs

@@ -8,7 +8,6 @@ module Dodge.PlacementSpot
     , anyUnusedSpot
     , unusedSpotAwayFromLink
     , isUnusedLnk
-    , isUnusedLnk'
     , isInLnk
     , unusedSpotNearInLink
     , randDirPS
@@ -20,11 +19,12 @@ module Dodge.PlacementSpot
     , unusedOffPathAwayFromLink
     , setFallback
     , twoRoomPoss
-    , isUnusedLinkType
+    , isUnusedLnkType
     , rprBoolShift 
     , rprBool
     , shiftInBy
     , resetPLUse
+    , psposAddLabel
     ) where
 import Dodge.LevelGen.Data
 import Geometry
@@ -53,14 +53,12 @@ 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 = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0 
 
+psposAddLabel :: RoomPosType -> PlacementSpot -> PlacementSpot
+psposAddLabel lab = psSelect %~ (\f rp r -> f rp r & _Just . _2 . rpType %~ S.insert lab)
+
 rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
 rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
 
@@ -141,9 +139,9 @@ useRoomPosRoomCond t rp r
     | t rp r = Just (PS (_rpPos rp) (_rpDir rp), rp & rpPlacementUse +~ 1)
     | otherwise = Nothing
 
-isUnusedLinkType :: RoomLinkType -> RoomPos -> Bool
+isUnusedLnkType :: RoomLinkType -> RoomPos -> Room -> Bool
-isUnusedLinkType rlt rp = case _rpLinkStatus rp of
+isUnusedLnkType rlt rp _ = case _rpLinkStatus rp of
-    UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts
+    UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts && _rpPlacementUse rp == 0
     _ -> False
 
 unusedSpotNearInLink :: Float -> PlacementSpot

src/Dodge/Render/HUD.hs

@@ -47,10 +47,11 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
     inv = _crInv cr
     invlist = concatMap itemText (IM.elems inv)
         ++ displayFreeSlots
-        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
+        ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)
-    floorItemsColor
+--        ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
-        | _hudElement (_hud w) == DisplayInventory NoSubInventory = id
+--    floorItemsColor = case _hudElement (_hud w) of
-        | otherwise = color invDimColor
+--        DisplayInventory NoSubInventory -> id
+--        _ -> color invDimColor
     nfreeslots = crNumFreeSlots cr
     displayFreeSlots = case nfreeslots of
         0 -> [color invDimColor . text $ "  INVENTORY FULL"]

src/Dodge/Room/LongDoor.hs

@@ -49,8 +49,8 @@ twinSlowDoorRoom w h x = defaultRoom
         [ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
             $ \btid -> jsps0J (PutSlideDr False col (cond' btid) 1 (V2 x 1) (V2 x h) wlSpeed)
             $ ps0 (PutSlideDr False col (cond' btid) 1 (V2 (-x) 1) (V2 (-x) h) wlSpeed)
-            $ \did -> jps0 (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
+            $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
-            $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
+            $ \lspl -> jsps0 $ PutProp $ addColorChange (fromJust $ _plMID lspl) did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
         ]
     , _rmBound  = ps
     , _rmName   = "twinSlowDoorRoom"
@@ -92,15 +92,12 @@ addSouthPillars x h r = do
 
 addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
 addButtonSlowDoor x h rm = do
-    (butPos,butRot) <- takeOne 
-       [( V2 (x/2-50) 5,0::Float)
-       ,( V2 (x/2+50) 5,0::Float)
-       ]
-    thePlacement <- takeOne [butDoor butPos butRot ]
     shuffleLinks $ setOutLinksPD aboveH $ setInLinksPD belowH $ rm 
-        & rmPmnts .:~ thePlacement
+        & rmPmnts .++~ [butDoor , theterminal]
         & rmBound .:~ openDoorBound
   where
+    theterminal = putTerminal (const NoTerminalParams) 
+        & plSpot .~ rprBoolShift (\rp _ -> RoomPosLab 0 `S.member` _rpType rp) (shiftInBy 20)
     openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
     belowH y = (sndV2 . fst) y < h - 40
     aboveH y = (sndV2 . fst) y > h + 40
@@ -108,8 +105,9 @@ addButtonSlowDoor x h rm = do
                 (V3 15 xoff 89) (aShape (V2 15 0) (V3 15 xoff 90)) . const . const
     -- TODO make the height of this light source and of other mounted lights
     -- be taken from a single consistent source
-    butDoor _ _ = putLitButOnPos col butPosCond
+    butDoor = putLitButOnPos col (psposAddLabel (RoomPosLab 0) $ rprBool $ isUnusedLnkType InLink)
-        $  \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2
+        $  \btplmnt -> Just $ putDoubleDoorThen False col (cond' $ fromJust $ _plMID btplmnt) 
+                            30 (V2 0 h) (V2 x h) 2
         $ \dr1 dr2 -> amountedlight dr1 50
         $ amountedlight dr1 (-50)
         $ amountedlight dr2   50
@@ -117,7 +115,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/SensorDoor.hs

@@ -14,6 +14,7 @@ import Dodge.Room.Link
 import Dodge.Room.Foreground
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
+import Dodge.SoundLogic
 --import Dodge.Default.Room
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.Utility
@@ -60,7 +61,7 @@ sensAboveDoor sensetype wth ps = extTrigLitPos
         | otherwise = w
 
 sensInsideDoor :: DamageType -> Int -> Room -> Room
-sensInsideDoor senseType outplid rm = rm 
+sensInsideDoor senseType outplid rm = rm
     & rmName .++~ take 4 (show senseType)
     & rmPmnts .++~ 
         [ psPt atFstLnkOut 
@@ -90,6 +91,11 @@ sensInsideDoor senseType outplid rm = rm
                 ]
         in TerminalParams
             {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
-            ,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white
+            ,_termFutureLines = TerminalLineEffect 0 termsound
+                : map totermline themessage
             ,_termMaxLines = 7
             }
+    totermline s = TerminalLineDisplay 0 s white
+    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+      where
+        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos

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 (const . isUnusedLinkType (FromSouth i)) 
+            foldr1 setFallback [ twoRoomPoss (isUnusedLnkType (FromSouth i)) 
-                (const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
+                (isUnusedLnkType (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/SoundLogic.hs

@@ -30,6 +30,7 @@ import Dodge.SoundLogic.LoadSound
 import Control.Lens
 import qualified Data.Map as M
 import Data.Int (Int16)
+import Data.Maybe
 
 {-| Placeholder...-}
 haltSound :: World -> World
@@ -44,7 +45,7 @@ resumeSound :: Universe -> Universe
 resumeSound w = w
 
 soundWithStatus
-    :: SoundStatus
+    :: PlayStatus
     -> SoundOrigin  -- ^ \"Creator\" of sound
     -> Point2       -- ^ Position of sound
     -> SoundID      -- ^ ID of sound to be played
@@ -56,7 +57,10 @@ soundWithStatus status so pos sType mtime w = over toPlaySounds (M.insertWith f
     sound = Sound 
         { _soundChunkID     = sType
         , _soundTime        = mtime
-        , _soundStatus      = status
+        , _soundStatus      = SoundStatus
+            {_playStatus = status
+            ,_isLooping  = isJust mtime
+            }
         , _soundChannel     = Nothing
         , _soundAngDist     = Just (a,0)
         , _soundPos         = pos
@@ -94,7 +98,10 @@ soundFromGeneral so fpos sType mtime w = over toPlaySounds (M.insertWith f so so
     sound = Sound 
         { _soundChunkID     = sType
         , _soundTime        = mtime
-        , _soundStatus      = ToStart
+        , _soundStatus      = SoundStatus
+            { _playStatus = ToStart
+            , _isLooping  = isJust mtime
+            }
         , _soundChannel     = Nothing
         , _soundAngDist     = Just (a,0)
         , _soundPos         = fpos w
@@ -134,7 +141,10 @@ soundMultiFrom [so] pos sType mtime w
     sound = Sound 
         { _soundChunkID     = sType
         , _soundTime        = mtime
-        , _soundStatus      = ToStart
+        , _soundStatus      = SoundStatus 
+            { _playStatus = ToStart
+            , _isLooping  = isJust mtime
+            }
         , _soundChannel     = Nothing
         , _soundAngDist     = Just (a,0)
         , _soundPos         = pos
@@ -148,7 +158,10 @@ soundMultiFrom (so:sos) pos sType mtime w
     sound = Sound 
         { _soundChunkID     = sType
         , _soundTime        = mtime
-        , _soundStatus      = ToStart
+        , _soundStatus      = SoundStatus 
+            { _playStatus = ToStart
+            , _isLooping  = isJust mtime
+            }
         , _soundChannel     = Nothing
         , _soundAngDist     = Just (a,0)
         , _soundPos         = pos

src/Dodge/Update/UsingInput.hs

@@ -26,7 +26,9 @@ updatePressedButtons pkeys w
         & cameraRot -~ rotation
     | otherwise = w
   where 
-    inTopInv  = _hudElement (_hud w) == DisplayInventory NoSubInventory
+    inTopInv  = case _hudElement (_hud w) of
+        DisplayInventory NoSubInventory -> True
+        _ -> False
     lbPressed = ButtonLeft `S.member` pkeys
     rbPressed = ButtonRight `S.member` pkeys
     mbPressed = ButtonMiddle `S.member` pkeys

src/Sound.hs

@@ -57,8 +57,8 @@ playSoundAndUpdate sData oldSounds newSounds
 
 mergeSound :: Sound -> Sound -> Sound
 mergeSound oldS newS
-    | _soundChunkID newS == _soundChunkID oldS && _soundStatus newS == ToContinueStart
+    | _soundChunkID newS == _soundChunkID oldS && _playStatus (_soundStatus newS) == ToContinueStart
-                = newOldChannel & soundStatus  .~ _soundStatus oldS
+                = newOldChannel & soundStatus . playStatus .~ _playStatus (_soundStatus oldS)
     | otherwise = newOldChannel
   where
     newOldChannel = newS & soundChannel .~ _soundChannel oldS
@@ -74,10 +74,10 @@ updateSound sd s = initialisePlaying sd s
     >>= cleanupHalted
 
 initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
-initialisePlaying sd s = case _soundStatus s of
+initialisePlaying sd s = case _playStatus $ _soundStatus s of
     ToStart -> tryPlay sd s
     ToContinueStart -> tryPlay sd s
-    JustStartedPlaying -> return $ s & soundStatus .~ Playing
+    JustStartedPlaying -> return $ s & soundStatus . playStatus .~ Playing
     _ -> return s
 
 tryPlay :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
@@ -85,10 +85,13 @@ tryPlay sd s = do
     i <- tryGetChannel s
     _ <- liftIO $ do
         Mix.halt i
-        Mix.playOn i Mix.Once (sd IM.! _getSoundID (_soundChunkID s))
+        Mix.playOn i timesToPlay (sd IM.! _getSoundID (_soundChunkID s))
     return $ s 
         & soundChannel  ?~ i
-        & soundStatus   .~ JustStartedPlaying
+        & soundStatus . playStatus .~ JustStartedPlaying
+  where
+    timesToPlay | _isLooping (_soundStatus s) = Mix.Forever
+        | otherwise = Mix.Once
 
 tryGetChannel :: Sound -> MaybeT IO Mix.Channel
 tryGetChannel s = case _soundChannel s of

src/Sound/Data.hs

@@ -8,7 +8,13 @@ import Control.Lens
 import Geometry.Data
 import Data.Word (Word8)
 import Data.Int (Int16)
-data SoundStatus 
+data SoundStatus = SoundStatus
+    {_playStatus :: PlayStatus
+    ,_isLooping  :: Bool
+    }
+  deriving (Eq,Ord,Show)
+-- TODO make this more sensible (use product rather than union in some cases)
+data PlayStatus 
     = JustStartedPlaying
     | Playing
     | ToStart
@@ -32,3 +38,4 @@ data Sound = Sound
   deriving (Eq,Ord,Show)
 makeLenses ''SoundData
 makeLenses ''Sound
+makeLenses ''SoundStatus