diff --git a/src/Dodge/Annotation.hs b/src/Dodge/Annotation.hs index 3d70dfe9b..cb720cd20 100644 --- a/src/Dodge/Annotation.hs +++ b/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 diff --git a/src/Dodge/Annotation/Data.hs b/src/Dodge/Annotation/Data.hs index 8a5d5ead6..98972e957 100644 --- a/src/Dodge/Annotation/Data.hs +++ b/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 diff --git a/src/Dodge/Creature/Perception.hs b/src/Dodge/Creature/Perception.hs index 2f555579c..879485f14 100644 --- a/src/Dodge/Creature/Perception.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 07583ae04..8a44bf614 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Data/SoundOrigin.hs b/src/Dodge/Data/SoundOrigin.hs index 7d5169e90..c71289bec 100644 --- a/src/Dodge/Data/SoundOrigin.hs +++ b/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 diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 01604976f..597716fd4 100644 --- a/src/Dodge/Event.hs +++ b/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 - | but == ButtonMiddle || _hudElement (_hud $ _uvWorld w) == DisplayCarte - = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) - | but == ButtonLeft = case _hudElement (_hud $ _uvWorld w) of - DisplayInventory (CombineInventory mi) +handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of + (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) + (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) + ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly i <- mi return $ over uvWorld (doCombine i) w - _ -> Just w - | otherwise = Just w + _ -> Just w -- note "sort" on the inventory indices; otherwise -- lower items may be shifted up and items below these removed instead diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 82227da02..3eab5182b 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/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 -toggleInv x y - | x == y = DisplayInventory NoSubInventory - | otherwise = x +toggleTweakInv :: HUDElement -> HUDElement +toggleTweakInv he = case he of + DisplayInventory TweakInventory -> DisplayInventory NoSubInventory + _ -> 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 diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index bc8a91a8d..b2ccea0e7 100644 --- a/src/Dodge/Floor.hs +++ b/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) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index f11679e93..2e1d55e26 100644 --- a/src/Dodge/Inventory.hs +++ b/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 - DisplayInventory dt@DisplayTerminal{} -> w & hud . hudElement %~ updateDisplayTerminal dt w - _ -> w +updateTerminal = checkTermDist . updateTerminalLine -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 +checkTermDist :: World -> World +checkTermDist w = case w ^? hud . hudElement . subInventory . termID of + Just btid -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) $ do + btpos <- w ^? buttons . ix btid . btPos + if dist btpos (_crPos $ you w) < 40 then Just w else Nothing + Nothing -> w +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 diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index c1ac634c3..740985b05 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/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 pst = Just . Placement (PS (V2 0 0) 0) pst Nothing . contToIDCont +jps0' :: PSType -> (Placement -> Maybe Placement) -> Maybe Placement +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 diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index cc3f9c4df..99f84b28c 100644 --- a/src/Dodge/LockAndKey.hs +++ b/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] ) - [(sensorRoomRunPast Electrical, return SPARKGUN ) - ,(sensorRoomRunPast Flaming, return FLAMESPITTER ) - ,(sensorRoomRunPast Lasering, return LASGUN ) --- ,(const slowDoorRoomRunPast, return MINIGUN) --- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) --- ,(const glassLessonRunPast, takeOne [LASGUN]) --- ,(const $ lasTunnelRunPast 400, return FLATSHIELD) + --[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] ) + --,(sensorRoomRunPast Electrical, return SPARKGUN ) + --,(sensorRoomRunPast Flaming, return FLAMESPITTER ) + --,(sensorRoomRunPast Lasering, return LASGUN ) + [(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))] diff --git a/src/Dodge/Placement/Instance.hs b/src/Dodge/Placement/Instance.hs index 3ad20cf48..dae2bbed6 100644 --- a/src/Dodge/Placement/Instance.hs +++ b/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 diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 61f99cf30..04faf9db0 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/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)) - -> (Int -> Maybe Placement) -> Placement -putLitButOnPos col f subpl - = plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) - $ \plmnt -> let lsid = fromJust $ _plMID plmnt - in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi}) + -> PlacementSpot + -> (Placement -> Maybe Placement) -> Placement +putLitButOnPos col theps subpl + = plSpot .~ theps $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) + $ \plmnt -> jps0' (PutButton (makeButton col (changeLight . fromJust $ _plMID plmnt)) {_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 - in jps0 (PutButton (makeButton col (changeLight lsid . oneff (trigid tp))) - {_btPos = V2 0 (-1), _btRot = pi}) - (const Nothing) <&> plSpot .~ _plSpot plmnt + $ \plmnt -> jps0' (PutButton + (makeButton col (changeLight (fromJust $ _plMID plmnt) . oneff (trigid tp))) + {_btPos = V2 0 (-1), _btRot = pi}) + (cnt tp plmnt) <&> plSpot .~ _plSpot plmnt where trigid tp = fromJust $ _plMID tp oneff tid = triggers . ix tid .~ const True diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index df52f6900..7a514c563 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/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)) - <> decorationToShape ds wdth wdth 25 col col - , mempty ) +sensorSPic wdth (pc,ds) _ = noPic + $ colorSH yellow (upperPrismPoly 25 (square wdth)) + <> decorationToShape ds wdth wdth 25 col col where col = paletteToColor pc diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 2c3811a9d..9b73546e5 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/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 diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 9420b9ed9..f912305e4 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/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 -isUnusedLinkType rlt rp = case _rpLinkStatus rp of - UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts +isUnusedLnkType :: RoomLinkType -> RoomPos -> Room -> Bool +isUnusedLnkType rlt rp _ = case _rpLinkStatus rp of + UnusedLink{_rplsType = rlts} -> rlt `S.member` rlts && _rpPlacementUse rp == 0 _ -> False unusedSpotNearInLink :: Float -> PlacementSpot diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 20243a09d..33a05861c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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)) - floorItemsColor - | _hudElement (_hud w) == DisplayInventory NoSubInventory = id - | otherwise = color invDimColor + ++ concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w) +-- ++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w)) +-- floorItemsColor = case _hudElement (_hud w) of +-- DisplayInventory NoSubInventory -> id +-- _ -> color invDimColor nfreeslots = crNumFreeSlots cr displayFreeSlots = case nfreeslots of 0 -> [color invDimColor . text $ " INVENTORY FULL"] diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index c238dbbd9..f0c70a889 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/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))) - $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight + $ \did -> jps0' (PutLS (lsColPos (V3 0.75 0 0) (V3 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 - $ \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2 + butDoor = putLitButOnPos col (psposAddLabel (RoomPosLab 0) $ rprBool $ isUnusedLnkType InLink) + $ \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 diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index c5f6c4223..27149d14d 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/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 diff --git a/src/Dodge/Room/Tanks.hs b/src/Dodge/Room/Tanks.hs index 417fc19dc..250bdf57b 100644 --- a/src/Dodge/Room/Tanks.hs +++ b/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)) - (const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 -> + foldr1 setFallback [ twoRoomPoss (isUnusedLnkType (FromSouth i)) + (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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 57e19e87c..8fbbded42 100644 --- a/src/Dodge/SoundLogic.hs +++ b/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 diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 98c4e1f78..c3eef6822 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/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 diff --git a/src/Sound.hs b/src/Sound.hs index 3378f2f52..9b16ec0fe 100644 --- a/src/Sound.hs +++ b/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 - = newOldChannel & soundStatus .~ _soundStatus oldS + | _soundChunkID newS == _soundChunkID oldS && _playStatus (_soundStatus newS) == ToContinueStart + = 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 diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 190cb1cc2..69a2466b1 100644 --- a/src/Sound/Data.hs +++ b/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