From 7801920fd29eb3b219b7ec7708b05f0faee0acec Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 15:46:49 +0200 Subject: [PATCH 1/5] Add support for directional sound --- src/Dodge/Item/Weapon.hs | 2 +- src/Dodge/SoundLogic.hs | 19 +++++++++++++++++++ src/Sound.hs | 10 +++++++++- src/Sound/Preload.hs | 4 +++- 4 files changed, 32 insertions(+), 3 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 08a3ba7a4..f4c9bf074 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index a0d633eda..fa1b0578e 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -1,6 +1,7 @@ module Dodge.SoundLogic where import Dodge.Data import Sound.Preload (SoundStatus (..)) +import Geometry.Vector import Control.Lens import qualified Data.Map as M @@ -29,6 +30,24 @@ soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) , _soundPos = Nothing } +soundFromPos :: SoundOrigin -> Point2 -> Int -> Int -> Int -> 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 = round + . radToDeg + . normalizeAngle + . (+ pi) + $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w + soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w where diff --git a/src/Sound.hs b/src/Sound.hs index f158043a2..76ea03369 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -63,7 +63,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 +100,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 () diff --git a/src/Sound/Preload.hs b/src/Sound/Preload.hs index 7ba4d541c..42ae04603 100644 --- a/src/Sound/Preload.hs +++ b/src/Sound/Preload.hs @@ -6,6 +6,8 @@ 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) From 48ef0c0088472a7818cf46b5a96e56ea13a77e66 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 17:52:51 +0200 Subject: [PATCH 2/5] Add music support --- app/Main.hs | 12 ++++- data/music/undercity.mid | Bin 0 -> 44031 bytes src/Dodge/LoadSound.hs | 104 ++++++++++++++++++++------------------- src/Music.hs | 9 ++++ src/Preload.hs | 7 +-- src/Preload/Data.hs | 8 +-- src/Sound.hs | 29 ++++++++--- 7 files changed, 100 insertions(+), 69 deletions(-) create mode 100644 data/music/undercity.mid create mode 100644 src/Music.hs diff --git a/app/Main.hs b/app/Main.hs index df1793804..783540bc9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -20,6 +20,7 @@ import Picture.Preload import Sound import Preload import Sound.Preload +import Music import Control.Concurrent import Control.Lens @@ -30,6 +31,7 @@ import Control.Monad (when,void) import System.Random import qualified Data.Map as M +import qualified Data.IntMap as IM import qualified SDL import qualified SDL.Mixer as Mix import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) @@ -37,9 +39,17 @@ import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate) 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 diff --git a/data/music/undercity.mid b/data/music/undercity.mid new file mode 100644 index 0000000000000000000000000000000000000000..0100375a02d77d0e8ae574a1f7884a8091f1b77a GIT binary patch literal 44031 zcmeI5U2I&(b;rlFBHMD2x@oJr`Jh&^K4_9lEkDFBt;iL>r4^}_wEU*1B_-OTLy-ze zBQ=UZprkm7n3ta6a>Eb?>R?x+l+#O`jc~ zeFLVV>5V|g`0Uio`SHN1ks?K=1VU ztLJCcy@Flw^W!t3_WIc5*|7lW(Kl8qm4O{-ADbMT9+@3GC)r(7vtzwe)3fK_2sBS! zxHvU4Hm&aMd{~%>+wip*{>vxtMSl=|^R}>_ zemqhLKmKk$;|D+5k?}*m z`Ox>zL-CKl8}oN#AHi-l-)O++($?k?Y68UsKnQDRsR)4A)NLX!r(yNOVNW>LAf9iDuD} zM7#P%;(A;3P5vNiic+kJMC%ZFtt5_0LdqWrl654TfICqre?$~k*JDyqOd)9zBSf=J zjA)Sr|5`;Vi0zUP(;Pj?ZWTSratf@bJRkWt6_GZm>(S^OOd#R3C8`o+h`^nD>C(#F z>qjZqNjaw>om3P>&=pNwkCN_Emjf%yuZ_NTuD9+DAV)heqC>YTW0AX6jhNf0bEW@Q zv^jc!vIla?X3moDO3!5aBD2%K-b_bzh)DWhzz!p56Tx8^@qAReF{-}lkEP5=^Y*7d zmSk)ZHQM-C%3fM{e#}m3BxJ7 zm##+UIYgfyW;UAd555(dA67TjJdy1A^9_^9Gi3P_1fdb z_vU-~hipH?NPxK0ZNW__dowoHzLL|MC5byU(LflH$3uJ{z1hh)P(J*{ZG@-#V zemV(%(gD9h4N8Ecq%!r13hMc*v-J*$4wp-^Cb?k9k}k3K$FWTW#wNp`M4quFlW+Kw z(Ki(t0u!ApqUej+M2rP@J|=la+lv+hHAZbF-|)wgA4l%xyP}r^^Ic>d6G!ka;B1e7 zuAkcZV?%2G_)tPJC=OkP@6!2QdGfvGPiXxU=pWU1yfQfWtMQ%aOMd4D^#xz_1wRV@ zNqE*te7ZUx)A_MH`QGwztuLcxBluqZ9$mgim-q5+{gc?=jlK+&ZuD2KO6UjM(l2c)lvn=f`!fIw}MZY zXQ2svf=mky&<1E7_Sb>G+5Ds6Go3B8g1fSwVd^PZ*lhk0@QG_Jw1B^I91Sy$3Kkym ze4YZO5(^#S;e`$!=8e)e^xM$iDBURTgX(o*PZ#!lJhWgTUU)sW5LX|B{Mpbm${(%S za%^5l*S^@UppB5hYiI6^cLgM!7)}yxJ`C zdaxJ~rinA6#R$hsi%sfn6XIPgAG!i4I-#M&Vn`*jf(ir`2r5OR5{)VZRS0TCK=q5& z2&xfS3{#{^G^)_3M5A)GB6Xrshekab^(yhxpjh-jgz*+D!)h@cmIT>hh2BOaRg^j; zrKDP3Nxg+03|PER$y%}NfoiD1tVV$lfAPk-SdE}T1l2GNtGD-oYN`~_N&p#5nYZ=D za`qvZEw)qHK}j4WQ6~xUy>1(wDH5@;UJ^2DD#LH`M@E#4jp`bJ#Ng^0@+DCx2?s+G zGCFORO;pt+GJ^o>jGvmf#FDEKXW~$c!65KKik3*CghVN!vBgpn#gZsieBe(P^a}21K_Do#i4;s5C5=*;PA}iR7U@wAw zqOngZL{NmFLBmz<-K%!6*g}g}kqiw0kA8irObMWzuw(N}f6r(xwy@Y3D z<7dxK$y@Y~m=J%IJ0X5Q@=LA;{b=w~C^ZzFyO<&{n;MLUQhYffHNa7Cic{-UKLU== zQ+*=fR4UaQ38i|WJq;A;A<lrN}Yn9+>3z2#?*Q=;saWAR zLMcuIQ^$i}jirvO%l~)rcWgn{Zv|g6e%snM@%k()Ngl8LSLByRXni=8Y5ajq<4={D zHiw)hpDK(vKIkc$Ls^^=zWPaW3R1_ykrXH7sm?=%sZRLg4G~;{lOlyU3I6a~4G2i! zdCBPHupLd6ib{gR>C}UJ_E?X4yofDB)Dv z2;~(%6)Ae_1q8pi=)A}Jj@qE3vV-vX^JWk}*E}&YJw7=$JEMNlu0G%a{vh`O{)ucD z_%_N1YisM@ap2yG=QxXY9}kRt!bm(%qqn{JUf$atZ+;VaZQyZw#q&0Ld%gC0%X{rv zk3U3xhpCT{5I!Bfy`KJh^=;N(uRUIWd3mor-h3~=o_${Z&Ed~|eV0Es+cm??rTONn z)#sAznq$hFx!BA5bMxwJ^vbo(pPS8Ev);4q&G+Z#m1~7}uJrO=|9SJh{KK7_v+vtm zp0V%S@}q%{scC*P@bj?x9`D=V%YENoR>@i-@=2oZ$r=JbNlpfm<&xkmASnTPC(9<} z%qiKx=~A+u;C_-fg`^xfC3z)EHc7&sH{AfD@Ja@!q9l>zcqv&`j)3!tWMxAl$yrgd zrUijiS$!gr%dq4sVe<5jb|BQLpX-!U2n8NQB6q)82MTurW=xN`j4PvPBYX zER)TWU}KtW3(plL+tiE6Mh;n$Y)r*X0P#vh0wqc0mbY0p5eX-pN*kd(^LYI&vBDg% zBgvTigOWR_NDWD9NZqh{$WDvwvvfpJE2qb1LS$j3ZsW(L{tuLg1X ztAc2946@;krk8&eBtG|f$K)ISmEdJ{=M^C``Av+qf(@Ifxwe1+0z8EN1 zzbaFAnNjZM&M3c@j4LWV7***r(S|gqglWF7o*sZ7h97|E`^D*g_|x$H@O-B{-3LDe z&)H#`FW9Dg;RoS+;rT9kx(9v$oDr;!}q~+vIs^&`V@RGJSU7` z6r@kW_rP<|2u4Br1bjC<2aaGAq+{@Lc+MTcD0s~6|IeoMi69LNme~fLgztej4mbth z3vV36Cs5OU@Wz4NVH_KFIrt#?2VD-Xr+mH3!FAx*xg1!ruk{E*E|P{D2F; z5d1>nk9~k>Pao|u{ht{hE`0pigFnsqIYIw)(?9kBqQB$x zx5f9zk3W8b4?ceQ)Mt8-`Nu8*@B{F60q~A5_&)OO_=WF$`ovSl|0u-|hOq`rgO-Zl5pa z`(EaI`+Tv!_prX(=Zp1ykoDa@zpNJntQQua^}C<-+v2mn^s&BJeDC_qdfdZ$Z1GvI z23fBxKI`oO>#fCSeeGv`wfL-meXM^LpY^nt_0-zWdfLN!n!$H|vCEyAyOB#OT^%k= zSMyF-1Laq)=`fT#G&y_(Id^GnzTumYbC)LV<(rW=BRBbm??BF7nY5QbhMYSyX_IgG zF67*qNqhO@$hjhRm!Kbyb|FnKNNZWzl=1Rj48wctG`zNv{o_6Dt$J$Wx4P*DC^w93 zs}I8;hHry%Qz(5D%1t0^btgPG-O?wa+<;@UE~GQr89?QYz8}h)zSEjv(#|d-BeOcD zjKMINrWK}cV~gn#W2>?K0JsOJvkF=Tt$=#}u5(n7|Z zsi77bzYMoyDxbU&y+)UwDVI;*SZvC*P@a2TcFY;x^t0)$D0)%!Vo>g9tr%NcmNq); zl(l2h^ja^NvR4~~%APL)<^RY^4?$&5XyiuElrv-7TfgB={(AbRjrr_0a??JqzVVsy zsqwLyFHE24eohjHci6gzH(v89j&a7{3R%qsG)wja+83a%ef! z@Fw5XWXhYF$viiPH~H)7n{vi;N2vD*^_tnoJg2&coYB;cj_k-yp5X_O%g%ooD$l+i z9Zq{kkd0(zR>zbv7zWeSZ|qsmPNQeqVf2kZ?$?h7XFXi6pG`kKXnl5!FkVdGnKqa< z>Aql8DYS;d+x4@z-FYVa;AJ+BLuEaQL74|wSGLPq!)(4?uTk5bHLL|bGp}rS*18CM zW{uqLtf8ANUkjehk2O$Po2#HQV~3z2=z8_9UA}^~c4O_xhhytMsM}w!+h3Pye{HR{ zzed|%t?fS`_K&7JLc0F_+K*)#C#Z2sHBO1fDb_eI3(jadwp;hlOS*q{>HgWNaRVB6 zhsG_`xSz}5c6?UreMakjTI>C})_YOc|7W`X?YjOymHP4DAL;Th=<=V`<^MpJ-!>Ou zAO!9{qwXhkD4{|L9m=xsutSFuDwNQn?35lfbol7nPv|g4C`>|!rhyMTbQsg2LsNh3 zBMu$Lbm-9HKW3rBm<}CU`#<8)VN8b(E&gK`I`qd6TiZ24&rkaJ$q8)`n({-3CbYrX z8U9#tv~!=KyBPWsI<)fxydOGrg_iKglN@@^dA|J6p&vTT2J+12+63LqX4lL6p~Ka} zq$bE?w)!T3S4D_}jjbO#bixhZke&$%nh>EMI$RkxHlxZ99r~feObFP_FD49VLXF;V zpqah>(4jYUnJ?s*2|fCu!-p6;bZ#Ts?@oVi#@sgF>fBeXSmVCpzsfBWt|+pdu~!x0 zhvDs2MflV3_NpTM5WKyr2>)^3R9Ww)hS)Fmiv2RX@t=X_*e~|lcxfE_<1YK*2jT5W zI{W~mf3k8*_2&CRubZmwB; z_&#`x58n%K@x3?Q;JeAU`0#P~y!bo7-{Ha!fbYIZNBFCUn{(EFZVGgBQ^4ZC1pZ4d zeD6&?!f}1vk{qoQFwk<=p0?Q!5@X^L*vc`gjVam)CvY(21X3!kHJ`*3maB*aET>aC2^=-Zt z^X=Sk#mxOi-7GCEyvc7MZgPK-oT9cvW(!_H0)5OhS^y&*Y`C{D7AP_

*OViz&?$s1%N3U2@{Oj;#nuavR-;TUm(>hJVnl@_Mq-m?B9T{38hVccvnfCD26!{!yJlX4#hBsVwgiQ%%K?OPz-Y@hB*|&9ExEM#W06rm_sqlp%^B# zR17QS3uf7#+@ZaTh0f61sVSB^yy+DzUNJPW+~N0WN(&tRWld>`!a&C#NPO=ci^bjEql| Sot?U%-eIwQM;6=t>i+?#<^?SP literal 0 HcmV?d00001 diff --git a/src/Dodge/LoadSound.hs b/src/Dodge/LoadSound.hs index a825b8c98..51367a0e1 100644 --- a/src/Dodge/LoadSound.hs +++ b/src/Dodge/LoadSound.hs @@ -20,9 +20,9 @@ loadSounds = do reloadSound' <- Mix.load "./data/sound/reload1.wav" tone440 <- Mix.load "./data/sound/tone440.wav" pickupSound' <- Mix.load "./data/sound/pickUp.wav" - putdownSound' <- Mix.load "./data/sound/whiteNoiseFadeOut.wav" - fireSound' <- Mix.load "./data/sound/fire1.wav" - grenadeBang' <- Mix.load "./data/sound/grenade.wav" + putdownSound' <- Mix.load "./data/sound/whiteNoiseFadeOut.wav" + fireSound' <- Mix.load "./data/sound/fire1.wav" + grenadeBang' <- Mix.load "./data/sound/grenade.wav" tapQuiet' <- Mix.load "./data/sound/tapQuiet.wav" twoStep' <- Mix.load "./data/sound/twoStep.wav" healSound' <- Mix.load "./data/sound/heal.wav" @@ -57,52 +57,54 @@ 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 - , click - , reloadSound' - , tone440 - , pickupSound' - , putdownSound' - , fireSound' - , grenadeBang' - , tapQuiet' - , twoStep' - , healSound' - , doorSound' - , twoStepSlow' - , knifeSound' - , buzzSound' - , hitSound' --15 - , autoGunSound' - , shotgunSound' - , teleSound' - , longGunSound' - , launcherSound' - , smokeTrailSound' - , foot1Sound' - , foot2Sound' - , lasSound' - , teslaSound' --25 - , crankSlow' - , autoB' - , mini' - , impactA' - , impactB' --30 - , impactC' - , impactD' - , glassShat1' --33 - , glassShat2' - , glassShat3' - , glassShat4' - , glass1' --37 - , glass2' - , glass3' - , glass4' --40 - , foamSpray' - ] - - -soundOnce :: Int -> World -> World -soundOnce i = over soundQueue ((:) i) + return $ IM.fromList $ zip [0..] $ + [ pFireSound + , click + , reloadSound' + , tone440 + , pickupSound' + , putdownSound' + , fireSound' + , grenadeBang' + , tapQuiet' + , twoStep' + , healSound' + , doorSound' + , twoStepSlow' + , knifeSound' + , buzzSound' + , hitSound' --15 + , autoGunSound' + , shotgunSound' + , teleSound' + , longGunSound' + , launcherSound' + , smokeTrailSound' + , foot1Sound' + , foot2Sound' + , lasSound' + , teslaSound' --25 + , crankSlow' + , autoB' + , mini' + , impactA' + , impactB' --30 + , impactC' + , impactD' + , glassShat1' --33 + , glassShat2' + , glassShat3' + , glassShat4' + , glass1' --37 + , glass2' + , glass3' + , glass4' --40 + , foamSpray' + ] +loadMusic :: IO (IM.IntMap Mix.Music) +loadMusic = do + undercity <- Mix.load "./data/music/undercity.mid" + return $ IM.fromList $ zip [0..] $ + [ undercity + ] diff --git a/src/Music.hs b/src/Music.hs new file mode 100644 index 000000000..ad5d4e3e0 --- /dev/null +++ b/src/Music.hs @@ -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 + } diff --git a/src/Preload.hs b/src/Preload.hs index 3b893855e..45d516008 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -3,7 +3,7 @@ module Preload , module Preload.Data , module Preload.Update ) - where + where import Preload.Data import Preload.Update @@ -13,11 +13,6 @@ 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 diff --git a/src/Preload/Data.hs b/src/Preload/Data.hs index 6b6e22314..ad753939b 100644 --- a/src/Preload/Data.hs +++ b/src/Preload/Data.hs @@ -6,11 +6,13 @@ import GHC.Word (Word32) import Picture.Preload import Sound.Preload +import Music data PreloadData a = PreloadData - { _renderData :: RenderData - , _soundData :: SoundData a - , _frameTimer :: Word32 + { _renderData :: RenderData + , _soundData :: SoundData a + , _musicData :: MusicData + , _frameTimer :: Word32 } makeLenses ''PreloadData diff --git a/src/Sound.hs b/src/Sound.hs index 76ea03369..dcb61df61 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -11,6 +11,7 @@ Uses SDL.Mixer. module Sound ( -- * Simple (One-Shot) Playback playSoundQueue + , playPositionalSoundQueue -- * Complex Playback , playAndUpdate ) where @@ -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. @@ -120,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 From 47ac10452092941420f517dbadcd748ae5981e28 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 19:19:23 +0200 Subject: [PATCH 3/5] Further implementation of poitional sound --- app/Main.hs | 4 ++-- src/Dodge/Data.hs | 6 ++++-- src/Dodge/Item/Weapon/TriggerType.hs | 27 +++++++++++++++++---------- src/Dodge/SoundLogic.hs | 13 +++++++++++-- src/Dodge/WorldEvent/Explosion.hs | 12 ++++++------ src/Preload.hs | 2 +- src/Preload/Data.hs | 2 +- src/Sound.hs | 2 +- src/Sound/{Preload.hs => Data.hs} | 2 +- 9 files changed, 44 insertions(+), 26 deletions(-) rename src/Sound/{Preload.hs => Data.hs} (97%) diff --git a/app/Main.hs b/app/Main.hs index 783540bc9..3d050df53 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,7 +19,7 @@ import Picture.Render import Picture.Preload import Sound import Preload -import Sound.Preload +import Sound.Data import Music import Control.Concurrent @@ -63,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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fe2405e54..3d42315e7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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]) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 5b2a789d5..3883d8827 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -45,7 +45,7 @@ withWarmUp t f cid w w | t > 1 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 - $ soundFrom (CrWeaponSound cid) 26 1 0 + $ continueSound 26 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 @@ -54,18 +54,25 @@ withWarmUp t f cid w $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) 2 $ f cid - $ soundFrom (CrWeaponSound cid) 28 2 0 + $ continueSound 28 w - where cr = _creatures w IM.! cid - itRef = _crInvSel cr - item = _crInv cr IM.! itRef - pointerToItem = creatures . ix cid . crInv . ix itRef - fState = _wpFireState item - fRate = _wpFireRate item - reloadCondition = _wpLoadedAmmo item == 0 + where + cr = _creatures w IM.! cid + itRef = _crInvSel cr + item = _crInv cr IM.! itRef + pointerToItem = creatures . ix cid . crInv . ix itRef + fState = _wpFireState item + fRate = _wpFireRate item + reloadCondition = _wpLoadedAmmo item == 0 + continueSound soundID + | cid == 0 = soundFrom (CrWeaponSound cid) soundID 1 0 + | otherwise = soundFromPos (CrWeaponSound cid) (_crPos cr) soundID 1 0 withSound :: Int -> (Int -> World -> World) -> Int -> World -> World -withSound soundid f cid = soundOnce soundid . f cid +withSound soundid f 0 w = (soundOnce soundid . f 0) w +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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index fa1b0578e..e25bd79e0 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -1,6 +1,6 @@ module Dodge.SoundLogic where import Dodge.Data -import Sound.Preload (SoundStatus (..)) +import Sound.Data (SoundStatus (..)) import Geometry.Vector import Control.Lens @@ -16,7 +16,16 @@ resumeSound :: World -> World resumeSound w = w soundOnce :: Int -> World -> World -soundOnce i = over soundQueue ((:) i) +soundOnce i = over soundQueue ((:) (i,0)) + +soundOncePos :: Int -> Point2 -> World -> World +soundOncePos i pos w = over soundQueue ((:) (i,a)) w + where + a = round + . radToDeg + . normalizeAngle + . (+ pi) + $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w soundOnceOrigin :: Int -> SoundOrigin -> World -> World soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) diff --git a/src/Dodge/WorldEvent/Explosion.hs b/src/Dodge/WorldEvent/Explosion.hs index 66072012d..85e186393 100644 --- a/src/Dodge/WorldEvent/Explosion.hs +++ b/src/Dodge/WorldEvent/Explosion.hs @@ -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 diff --git a/src/Preload.hs b/src/Preload.hs index 45d516008..e642f3e64 100644 --- a/src/Preload.hs +++ b/src/Preload.hs @@ -8,7 +8,7 @@ import Preload.Data import Preload.Update import Picture.Preload -import Sound.Preload +import Sound.Data import Control.Lens import GHC.Word (Word32) diff --git a/src/Preload/Data.hs b/src/Preload/Data.hs index ad753939b..3df492e65 100644 --- a/src/Preload/Data.hs +++ b/src/Preload/Data.hs @@ -5,7 +5,7 @@ import Control.Lens import GHC.Word (Word32) import Picture.Preload -import Sound.Preload +import Sound.Data import Music data PreloadData a = PreloadData diff --git a/src/Sound.hs b/src/Sound.hs index dcb61df61..d22d67254 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -15,7 +15,7 @@ module Sound ( -- * Complex Playback , playAndUpdate ) where -import Sound.Preload +import Sound.Data import qualified SDL.Mixer as Mix import Data.Maybe diff --git a/src/Sound/Preload.hs b/src/Sound/Data.hs similarity index 97% rename from src/Sound/Preload.hs rename to src/Sound/Data.hs index 42ae04603..758a0cc7b 100644 --- a/src/Sound/Preload.hs +++ b/src/Sound/Data.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -module Sound.Preload +module Sound.Data where import qualified SDL.Mixer as Mix import qualified Data.IntMap as IM From be3c3339ecf99a82443adbb422035989df94cfa8 Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 20:25:25 +0200 Subject: [PATCH 4/5] Tweak sound positions --- src/Dodge/Item/Weapon.hs | 6 +- src/Dodge/Item/Weapon/TriggerType.hs | 10 +-- src/Dodge/LoadSound.hs | 2 +- src/Dodge/SoundLogic.hs | 113 ++++++++++++++++++++++++--- 4 files changed, 106 insertions(+), 25 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index f4c9bf074..d43799a3b 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 3883d8827..b6257936b 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -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 - $ continueSound 26 + $ soundFrom (CrWeaponSound cid) 26 2 0 w | t > 0 = set (pointerToItem . wpFire) (withWarmUp (t-1) f) $ set (pointerToItem . wpFireState) 2 @@ -54,7 +54,7 @@ withWarmUp t f cid w $ over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) $ set (pointerToItem . wpFireState) 2 $ f cid - $ continueSound 28 + $ soundFrom (CrWeaponSound cid) 28 2 0 w where cr = _creatures w IM.! cid @@ -64,12 +64,8 @@ withWarmUp t f cid w fState = _wpFireState item fRate = _wpFireRate item reloadCondition = _wpLoadedAmmo item == 0 - continueSound soundID - | cid == 0 = soundFrom (CrWeaponSound cid) soundID 1 0 - | otherwise = soundFromPos (CrWeaponSound cid) (_crPos cr) soundID 1 0 withSound :: Int -> (Int -> World -> World) -> Int -> World -> World -withSound soundid f 0 w = (soundOnce soundid . f 0) w withSound soundid f cid w = (soundOncePos soundid p . f cid) w where p = _crPos (_creatures w IM.! cid) diff --git a/src/Dodge/LoadSound.hs b/src/Dodge/LoadSound.hs index 51367a0e1..f38b5da4e 100644 --- a/src/Dodge/LoadSound.hs +++ b/src/Dodge/LoadSound.hs @@ -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" diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index e25bd79e0..7534b0228 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -1,33 +1,89 @@ -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.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. + -} soundOnce :: Int -> World -> World soundOnce i = over soundQueue ((:) (i,0)) +{-| 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 - a = round - . radToDeg - . normalizeAngle - . (+ pi) - $ argV (vNormal (pos -.- _cameraViewFrom w)) - _cameraRot w + a = soundAngle pos w -soundOnceOrigin :: Int -> SoundOrigin -> World -> World +{-| 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 + -> World -> World soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) where sound = Sound @@ -39,7 +95,13 @@ soundOnceOrigin sType so = over sounds (M.insertWith (flip const) so sound) , _soundPos = Nothing } -soundFromPos :: SoundOrigin -> Point2 -> 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 @@ -51,13 +113,29 @@ soundFromPos so pos sType time fadeTime w = over sounds (M.insertWith f so sound , _soundPos = Just (a,0) } f _ s = s {_soundTime = Just time, _soundFadeTime = fadeTime} - a = round + 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 (pos -.- _cameraViewFrom w)) - _cameraRot w + $ argV (vNormal (p -.- earPos)) - _cameraRot w + where + earPos = _cameraViewFrom w -soundFrom :: SoundOrigin -> Int -> Int -> Int -> World -> World +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 @@ -70,7 +148,15 @@ 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. +-} +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 @@ -85,7 +171,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) From 9a86d03fae9bf9793abacae298a440d2761832ab Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 6 Apr 2021 20:42:53 +0200 Subject: [PATCH 5/5] Add more positional sound --- src/Dodge/Creature/Inanimate.hs | 7 +++++-- src/Dodge/LevelGen/Block.hs | 7 +++---- src/Dodge/SoundLogic.hs | 10 +++++++--- src/Dodge/WorldEvent/Sound.hs | 9 +++++---- 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 4397a33d2..fe2108a85 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -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 diff --git a/src/Dodge/LevelGen/Block.hs b/src/Dodge/LevelGen/Block.hs index ee69fb2c7..9b48888c5 100644 --- a/src/Dodge/LevelGen/Block.hs +++ b/src/Dodge/LevelGen/Block.hs @@ -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 diff --git a/src/Dodge/SoundLogic.hs b/src/Dodge/SoundLogic.hs index 7534b0228..f6069cf7c 100644 --- a/src/Dodge/SoundLogic.hs +++ b/src/Dodge/SoundLogic.hs @@ -65,6 +65,7 @@ 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,0)) @@ -83,17 +84,19 @@ 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 = over sounds (M.insertWith (flip const) so sound) +soundOnceOrigin sType so p w = over sounds (M.insertWith (flip const) so theSound) w where - sound = Sound + theSound = Sound { _soundChunkID = sType , _soundTime = Nothing , _soundFadeTime = 0 , _soundStatus = ToStart , _soundChannel = Nothing - , _soundPos = Nothing + , _soundPos = Just (a,0) } + a = soundAngle p w soundFromPos :: SoundOrigin -- ^ \"Creator\" of sound @@ -150,6 +153,7 @@ soundFrom so sType time fadeTime w = over sounds (M.insertWith f so sound) w {-| Uses the first free origin from a list. Does nothing if all origins are already creating sounds. +TODO: add positional information. -} soundMultiFrom :: [SoundOrigin] diff --git a/src/Dodge/WorldEvent/Sound.hs b/src/Dodge/WorldEvent/Sound.hs index a44c1d8e2..5f0b22833 100644 --- a/src/Dodge/WorldEvent/Sound.hs +++ b/src/Dodge/WorldEvent/Sound.hs @@ -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)