justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Add looping sound, add sound to terminals

Browse Source
This commit is contained in:
justin
2022-03-16 09:23:17 +00:00
parent 5623747b01
commit 5aeb04ba05
24 changed files with 156 additions and 133 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Annotation.hs
-8
View File
@@ -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
-1
View File
@@ -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
+1 -1
View File
@@ -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
+14 -4
View File
@@ -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
+1
View File
@@ -7,6 +7,7 @@ data SoundOrigin = InventorySound
| CrMouth Int
| CrWeaponSound Int Int
| MachineSound Int
| TerminalSound
| WallSound Int
| CrReloadSound Int
| Flamer
src/Dodge/Event.hs
+5 -7
View File
@@ -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
src/Dodge/Event/Keyboard.hs
+11 -6
View File
@@ -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
src/Dodge/Floor.hs
+1 -1
View File
@@ -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
+18 -23
View File
@@ -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
src/Dodge/LevelGen/Data.hs
+4 -3
View File
@@ -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
src/Dodge/LockAndKey.hs
+8 -8
View File
@@ -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))]
src/Dodge/Placement/Instance.hs
+2
View File
@@ -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
+16 -24
View File
@@ -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
src/Dodge/Placement/Instance/Sensor.hs
+3 -3
View File
@@ -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
src/Dodge/Placement/Instance/Terminal.hs
+2 -2
View File
@@ -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 -10
View File
@@ -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
src/Dodge/Render/HUD.hs
+5 -4
View File
@@ -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"]
src/Dodge/Room/LongDoor.hs
+9 -11
View File
@@ -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
src/Dodge/Room/SensorDoor.hs
+8 -2
View File
@@ -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
+2 -2
View File
@@ -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
src/Dodge/SoundLogic.hs
+18 -5
View File
@@ -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
+3 -1
View File
@@ -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
+9 -6
View File
@@ -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
src/Sound/Data.hs
+8 -1
View File
@@ -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