Merge branch 'master' of ssh://git.xkjq.uk:30001/justin/loop

This commit is contained in:
Ross
2021-04-06 21:55:47 +01:00
16 changed files with 288 additions and 125 deletions
+14 -7
View File
@@ -19,7 +19,8 @@ import Picture.Render
import Picture.Preload
import Sound
import Preload
import Sound.Preload
import Sound.Data
import Music
import Control.Concurrent
import Control.Lens
@@ -27,22 +28,28 @@ import Foreign (Word32)
import Control.Monad (when,void)
import System.Random
import System.Random
import qualified Data.Map as M
import Graphics.Rendering.OpenGL hiding (color, rotate, scale,
translate)
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified SDL
import qualified SDL.Mixer as Mix
doPreload' :: IO (PreloadData a)
doPreload' = do
lChunks <- loadSounds
lMusic <- loadMusic
let sData = SoundData {_loadedChunks = lChunks, _playingSounds = M.empty}
mData = MusicData {_loadedMusic = lMusic}
Mix.playMusic Mix.Forever (lMusic IM.! 0)
rData <- preloadRender
return $ PreloadData rData sData 0
return $ PreloadData
{ _renderData = rData
, _soundData = sData
, _musicData = mData
, _frameTimer = 0
}
main :: IO ()
main = do
@@ -56,7 +63,7 @@ main = do
( \preData w -> do
startTicks <- SDL.ticks
void $ doDrawing (_renderData preData) w
playSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
playPositionalSoundQueue (_loadedChunks $ _soundData preData) (_soundQueue w)
newPlayingSounds <- playAndUpdate (_soundData preData) (_sounds w)
endTicks <- SDL.ticks
Binary file not shown.
+5 -2
View File
@@ -35,8 +35,11 @@ updateLamp :: Int -> CRUpdate
updateLamp i = unrandUpdate handleLS internalUpdate
where
handleLS cr w
| _crHP cr < 0 = explosionFlashAt (_crPos cr) $ mkSoundBreakGlass w & lightSources %~ IM.delete i
| otherwise = w & lightSources . ix i . lsPos .~ _crPos cr
| _crHP cr < 0 = explosionFlashAt cPos
$ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
| otherwise = w & lightSources . ix i . lsPos .~ cPos
where
cPos = _crPos cr
internalUpdate cr
| _crHP cr < 0 = Nothing
| otherwise = Just $ doDamage cr
+4 -2
View File
@@ -10,7 +10,7 @@ module Dodge.Data
where
import Picture.Data
import Geometry.Data
import Sound.Preload
import Sound.Data
import Control.Lens
import Control.Monad.State
import System.Random
@@ -25,6 +25,8 @@ import Codec.Picture (Image,PixelRGBA8)
import qualified Data.DList as DL
import Dodge.LoadConfig
import Data.Int (Int16)
data World = World
{ _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton)
@@ -50,7 +52,7 @@ data World = World
, _worldEvents :: !(World -> World)
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _soundQueue :: [Int]
, _soundQueue :: [(Int,Int16)]
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
+3 -5
View File
@@ -810,7 +810,7 @@ moveShell time i cid rot accel w
$ set (projectiles . ix i . pjUpdate)
(moveShell (time-1) i cid rot (rotateV rot accel))
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
$ smokeGen
@@ -879,8 +879,7 @@ tractorBeamAt colID i pos dir = Projectile
aGasCloud :: Int -> World -> World
aGasCloud cid w
= -- soundFrom Flame fireSound 2 500
insertCloud $ set randGen g $
= insertCloud $ set randGen g $
w
where
(a,g) = randomR (-0.1,0.1) (_randGen w)
@@ -896,7 +895,6 @@ aGasCloud cid w
aFlame :: Float -> Int -> World -> World
aFlame a cid w
= shakeCr cid 2
-- $ soundFrom Flame fireSound 2 500
$ insertFlame $ resetAngle $ set randGen g $
w
where
@@ -1381,7 +1379,7 @@ moveRemoteShell time i cid itid dir w
$ set (projectiles . ix i . pjUpdate)
(moveRemoteShell (time-1) i cid itid newdir)
$ over (projectiles . ix i . pjVel) (\v -> accel +.+ frict *.* v)
$ soundFrom (ShellSound i) (fromIntegral smokeTrailSound) (1) 250
$ soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) (1) 250
$ smokeGen
$ makeFlameletTimed oldPos
(0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
+7 -4
View File
@@ -43,9 +43,9 @@ withWarmUp t f cid w
| fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f)
$ set (pointerToItem . wpFireState) 2
w
| t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
| t > 2 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
$ soundFrom (CrWeaponSound cid) 26 1 0
$ soundFrom (CrWeaponSound cid) 26 2 0
w
| t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f)
$ set (pointerToItem . wpFireState) 2
@@ -56,7 +56,8 @@ withWarmUp t f cid w
$ f cid
$ soundFrom (CrWeaponSound cid) 28 2 0
w
where cr = _creatures w IM.! cid
where
cr = _creatures w IM.! cid
itRef = _crInvSel cr
item = _crInv cr IM.! itRef
pointerToItem = creatures . ix cid . crInv . ix itRef
@@ -65,7 +66,9 @@ withWarmUp t f cid w
reloadCondition = _wpLoadedAmmo item == 0
withSound :: Int -> (Int -> World -> World) -> Int -> World -> World
withSound soundid f cid = soundOnce soundid . f cid
withSound soundid f cid w = (soundOncePos soundid p . f cid) w
where
p = _crPos (_creatures w IM.! cid)
withRecoil :: Float -> (Int -> World -> World) -> Int -> World -> World
withRecoil recoilAmount eff cid w = eff cid . over (creatures . ix cid) pushback $ w
+3 -4
View File
@@ -42,11 +42,10 @@ killBlock bl w = f bl .
where
f bl@(Block {_blDegrades = (x:xs)}) = degradeBlock bl . hitSound bl
f bl = hitSound' bl
hitSound bl | _wlIsSeeThrough bl = mkSoundBreakGlass
-- hitSound bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+8) 25 0
pos = _wlLine bl !! 0
hitSound bl | _wlIsSeeThrough bl = mkSoundBreakGlass pos
| otherwise = soundMultiFrom sos soundid 25 0
hitSound' bl | _wlIsSeeThrough bl = mkSoundSplinterGlass
-- hitSound' bl | _wlIsSeeThrough bl = soundMultiFrom sos (soundid+4) 25 0
hitSound' bl | _wlIsSeeThrough bl = mkSoundSplinterGlass pos
| otherwise = soundMultiFrom sos soundid 25 0
sos = [BlockDegradeSound 0,BlockDegradeSound 1]
(soundid,_) = randomR (29,32) $ _randGen w
+9 -7
View File
@@ -14,7 +14,7 @@ import qualified SDL.Mixer as Mix
-- }}}
loadSounds :: IO (IM.IntMap Mix.Chunk)
loadSounds = do
Mix.openAudio Mix.defaultAudio 256
Mix.openAudio Mix.defaultAudio 128
pFireSound <- Mix.load "./data/sound/tap3.wav"
click <- Mix.load "./data/sound/click1.wav"
reloadSound' <- Mix.load "./data/sound/reload1.wav"
@@ -57,8 +57,8 @@ loadSounds = do
glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav"
glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav"
foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav"
return $ IM.fromList $ zip [0..]
$ [ pFireSound
return $ IM.fromList $ zip [0..] $
[ pFireSound
, click
, reloadSound'
, tone440
@@ -102,7 +102,9 @@ loadSounds = do
, foamSpray'
]
soundOnce :: Int -> World -> World
soundOnce i = over soundQueue ((:) i)
loadMusic :: IO (IM.IntMap Mix.Music)
loadMusic = do
undercity <- Mix.load "./data/music/undercity.mid"
return $ IM.fromList $ zip [0..] $
[ undercity
]
+129 -10
View File
@@ -1,35 +1,144 @@
module Dodge.SoundLogic where
{-|
Module : Dodge.SoundLogic
Description : Messages to "Sound" backend
This module allows us to talk to the "Sound" module.
-}
module Dodge.SoundLogic (
-- * Manipulation of individual sounds
soundOnce
, soundOncePos
, soundOnceOrigin
, soundFromPos
, soundFrom
, soundMultiFrom
, stopSoundFrom
-- * Manipulation of all sounds
, haltSound
, resumeSound
, pauseSound
-- * Synonyms for sound identifiers
, clickSound
, reloadSound
, pickUpSound
, putDownSound
, fireSound
, grenadeBang
, tapQuiet
, twoStepSound
, healSound
, doorSound
, twoStepSlowSound
, knifeSound
, buzzSound
, hitSound
, autoGunSound
, shotgunSound
, teleSound
, longGunSound
, launcherSound
, smokeTrailSound
, foot1Sound
, foot2Sound
) where
import Dodge.Data
import Sound.Preload (SoundStatus (..))
import Sound.Data (SoundStatus (..))
import Geometry.Vector
import Geometry (dist)
import Control.Lens
import qualified Data.Map as M
import Data.Int (Int16)
{-| Placeholder...-}
haltSound :: World -> World
haltSound w = w
{-| Placeholder...-}
pauseSound :: World -> World
pauseSound w = w
{-| Placeholder...-}
resumeSound :: World -> World
resumeSound w = w
{-| Add a sound to the queue for playback.
Consider replacing with 'soundOncePos'.
-}
soundOnce :: Int -> World -> World
soundOnce i = over soundQueue ((:) i)
soundOnce i = over soundQueue ((:) (i,0))
soundOnceOrigin :: Int -> SoundOrigin -> World -> World
soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound)
{-| Play a sound with a given position in the world.
Uses the angle between the given position and '_cameraViewFrom', taking into account '_cameraRot'.
-}
soundOncePos :: Int -> Point2 -> World -> World
soundOncePos i pos w = over soundQueue ((:) (i,a)) w
where
sound = Sound
a = soundAngle pos w
{-| Play a sound once, with a given origin.
For each origin only one sound will play at a time.
-}
soundOnceOrigin
:: Int -- ^ ID of the sound to be played
-> SoundOrigin -- ^ The \"creator\" of the sound
-> Point2 -- ^ The position of the sound in the world
-> World -> World
soundOnceOrigin sType so p w = over sounds (M.insertWith (flip const) so theSound) w
where
theSound = Sound
{ _soundChunkID = sType
, _soundTime = Nothing
, _soundFadeTime = 0
, _soundStatus = ToStart
, _soundChannel = Nothing
, _soundPos = Nothing
, _soundPos = Just (a,0)
}
a = soundAngle p w
soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World
soundFromPos
:: SoundOrigin -- ^ \"Creator\" of sound
-> Point2 -- ^ Position of sound
-> Int -- ^ ID of sound to be played
-> Int -- ^ Frames to play sound for
-> Int -- ^ Time sound fades out after playing for the given number of frames (ms)
-> World -> World
soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound) w
where
sound = Sound
{ _soundChunkID = sType
, _soundTime = Just time
, _soundStatus = ToStart
, _soundFadeTime = fadeTime
, _soundChannel = Nothing
, _soundPos = Just (a,0)
}
f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
a = soundAngle pos w
{-| Calculates the angle of a sound with reference to '_cameraViewFrom'.
Within 10 units considers the sound to be directly in front.
-}
soundAngle :: Point2 -> World -> Int16
{-# INLINE soundAngle #-}
soundAngle p w
| dist p earPos < 10 = 0
| otherwise = round
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - _cameraRot w
where
earPos = _cameraViewFrom w
soundFrom
:: SoundOrigin
-> Int -- ^ Sound ID
-> Int -- ^ Frames to play
-> Int -- ^ Fade out time (ms)
-> World -> World
soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
where
sound = Sound
@@ -42,7 +151,16 @@ soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w
}
f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime}
soundMultiFrom :: [SoundOrigin] -> Int -> Int -> Int -> World -> World
{-| Uses the first free origin from a list.
Does nothing if all origins are already creating sounds.
TODO: add positional information.
-}
soundMultiFrom
:: [SoundOrigin]
-> Int -- ^ Sound ID
-> Int -- ^ Frames to play for
-> Int -- ^ Fade out time (ms)
-> World -> World
soundMultiFrom [] _ _ _ w = w
soundMultiFrom (so:sos) sType time fadeTime w
| so `M.member` _sounds w = soundMultiFrom sos sType time fadeTime w
@@ -57,7 +175,8 @@ soundMultiFrom (so:sos) sType time fadeTime w
, _soundPos = Nothing
}
{- | Sets '_soundTime' to 0.
-}
stopSoundFrom :: SoundOrigin -> World -> World
stopSoundFrom so = over (sounds . ix so . soundTime) (fmap $ min 0)
+6 -6
View File
@@ -20,7 +20,7 @@ import Control.Lens
-- The following should be improved.... I've made a first pass
makePoisonExplosionAt :: Point2 -> World -> World
makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vels
makePoisonExplosionAt p w = soundOncePos grenadeBang p $ foldr (makeGasCloud p) w vels
where
vels = evalState (sequence ( replicate 25 (randInCirc 2) )) (_randGen w)
-- just change the number after replicate to get more or less clouds
@@ -29,12 +29,12 @@ makePoisonExplosionAt p w = soundOnce grenadeBang $ foldr (makeGasCloud p) w vel
-- currently the clouds push away from each other rather hard if they are close
makeTeslaExplosionAt :: Point2 -> World -> World
makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions -- a bit shorter
makeTeslaExplosionAt pos w = soundOncePos grenadeBang pos $ foldr ($) w listOfFunctions -- a bit shorter
where
-- rad or 360? Radians (hopefully) everywhere
xs = randomRs (0, 2*pi) $ _randGen w
p = newProjectileKey w
pks = [p..]
j = newProjectileKey w
pks = [j..]
listOfFunctions = map
(\i -> over projectiles (IM.insert (pks!!i) (makeTeslaArcAt (pks!!i) pos (xs!!i))))
[1 .. 29]
@@ -43,7 +43,7 @@ makeTeslaExplosionAt pos w = soundOnce grenadeBang $ foldr ($) w listOfFunctions
-- times
-- the new flames are directly added to the list of particles
makeFlameExplosionAt :: Point2 -> World -> World
makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++ ) w
makeFlameExplosionAt p w = soundOncePos grenadeBang p $ over particles' (newFlames ++ ) w
where
newFlames = zipWith makeFlameWithVelAndTime velocities timers
makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
@@ -54,7 +54,7 @@ makeFlameExplosionAt p w = soundOnce grenadeBang $ over particles' (newFlames ++
makeExplosionAt :: Point2 -> World -> World
makeExplosionAt p w = soundOnce grenadeBang
makeExplosionAt p w = soundOncePos grenadeBang p
. addFlames
. explosionFlashAt p
$ makeShockwaveAt [] p 50 10 1 white
+5 -4
View File
@@ -1,18 +1,19 @@
module Dodge.WorldEvent.Sound
where
import Dodge.Data
import Geometry.Data (Point2)
import Dodge.SoundLogic
import System.Random
import Control.Lens
mkSoundBreakGlass :: World -> World
mkSoundBreakGlass w = soundOnceOrigin soundid (GlassBreakSound 0) $ set randGen g w
mkSoundBreakGlass :: Point2 -> World -> World
mkSoundBreakGlass p w = soundOnceOrigin soundid (GlassBreakSound 0) p $ set randGen g w
where
(soundid,g) = _randGen w & randomR (37,40)
mkSoundSplinterGlass :: World -> World
mkSoundSplinterGlass w = soundOnceOrigin soundid (GlassBreakSound 1) $ set randGen g w
mkSoundSplinterGlass :: Point2 -> World -> World
mkSoundSplinterGlass p w = soundOnceOrigin soundid (GlassBreakSound 1) p $ set randGen g w
where
(soundid,g) = _randGen w & randomR (33,36)
+9
View File
@@ -0,0 +1,9 @@
{-# LANGUAGE TemplateHaskell #-}
module Music
where
import qualified SDL.Mixer as Mix
import qualified Data.IntMap as IM
data MusicData = MusicData
{ _loadedMusic :: IM.IntMap Mix.Music
}
+1 -6
View File
@@ -8,16 +8,11 @@ import Preload.Data
import Preload.Update
import Picture.Preload
import Sound.Preload
import Sound.Data
import Control.Lens
import GHC.Word (Word32)
--doPreload :: IO (PreloadData a)
--doPreload = do
-- sData <- preloadSound
-- rData <- preloadRender
-- return $ PreloadData rData sData 0
cleanUpPreload :: PreloadData a -> IO ()
cleanUpPreload pd = do
+3 -1
View File
@@ -5,11 +5,13 @@ import Control.Lens
import GHC.Word (Word32)
import Picture.Preload
import Sound.Preload
import Sound.Data
import Music
data PreloadData a = PreloadData
{ _renderData :: RenderData
, _soundData :: SoundData a
, _musicData :: MusicData
, _frameTimer :: Word32
}
+31 -10
View File
@@ -11,10 +11,11 @@ Uses SDL.Mixer.
module Sound (
-- * Simple (One-Shot) Playback
playSoundQueue
, playPositionalSoundQueue
-- * Complex Playback
, playAndUpdate
) where
import Sound.Preload
import Sound.Data
import qualified SDL.Mixer as Mix
import Data.Maybe
@@ -24,6 +25,7 @@ import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Lens
import Data.Int (Int16)
{- | Start playing new sounds and update sound specifications.
A Map of new sound specifications is merged with a Map of already playing sounds,
then sounds in the merged Map are updated.
@@ -63,7 +65,9 @@ updateSounds sd ss = do
updateSound :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
updateSound sd s =
initialisePlaying sd s >>= liftIO . decrementTimer >>= cleanupHalted
initialisePlaying sd s
>>= liftIO . (decrementTimer >=> applyPosition)
>>= cleanupHalted
initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
initialisePlaying sd s = case _soundStatus s of
@@ -98,6 +102,12 @@ decrementTimer s = case _soundTime s of
& soundStatus .~ FadingOut)
Nothing -> return s
applyPosition :: Sound -> IO Sound
applyPosition s = case _soundPos s of
Nothing -> return s
Just (a,d) -> Mix.effectPosition (fromJust $ _soundChannel s) a d
>> return (s & soundPos .~ Nothing)
fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
fadeOutMaybe _ _ = return ()
@@ -112,18 +122,29 @@ cleanupHalted s = do
-----------------------------------------------------------------
{- | Play sounds from a list of indices.
Each sound starts playing (and will not repeat) if there is a free channel.
For each index, the corresponding sound starts playing if there is a free channel.
Use this if you don't care about timing, overlapping, fading, or sound positions.
-}
playSoundQueue :: IM.IntMap Mix.Chunk -> [Int] -> IO ()
playSoundQueue chunkMap ns = forM_ ns $ \n -> playIfFree (chunkMap IM.! n) Mix.Once
playSoundQueue chunkMap ns = forM_ ns $ \n -> runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once
{- | Given a chunk, attempt to play this on a free channel a given number of
times. Returns 'Just' the channel if succeeds.
-}
playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel)
playIfFree c times = do
mayChan <- Mix.getAvailable Mix.DefaultGroup
case mayChan of
Nothing -> return Nothing
Just i -> Just <$> Mix.playOn i times c
playIfFree :: Mix.Chunk -> Mix.Times -> MaybeT IO Mix.Channel
playIfFree c times = do
i <- MaybeT $ Mix.getAvailable Mix.DefaultGroup
liftIO $ Mix.playOn i times c
-----------------------------------------------------------------
{- | Play sounds from a list of index/position pairs.
As for 'playSoundQueue', but with positional information in the form of an Int16.
-}
playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO ()
playPositionalSoundQueue chunkMap ns = forM_ ns $ \(n,a) ->
runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a
setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel
setChannelPos a i = do
liftIO $ Mix.effectPosition i a 0
return i
+4 -2
View File
@@ -1,11 +1,13 @@
{-# LANGUAGE TemplateHaskell #-}
module Sound.Preload
module Sound.Data
where
import qualified SDL.Mixer as Mix
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Control.Lens
import Geometry
import Data.Word (Word8)
import Data.Int (Int16)
data SoundStatus
= Playing
@@ -22,7 +24,7 @@ data Sound = Sound
, _soundFadeTime :: Int
, _soundStatus :: SoundStatus
, _soundChannel :: Maybe Mix.Channel
, _soundPos :: Maybe Point2
, _soundPos :: Maybe (Int16,Word8)
, _soundChunkID :: Int
}
deriving (Eq,Ord,Show)