UnicodeSyntax
#-}
module Main where
+import Control.Monad.IO.Class
import Control.Monad.Trans.Region
import Data.Int
+import qualified Data.StorableVector.Lazy as L
+import Prelude.Unicode
import Sound.EsounD.Player
+import Sound.EsounD.Streams
import Sound.EsounD.Types
main ∷ IO ()
main = runRegionT $
do pl ← openPlayer 44100 Nothing Nothing
- playMono16Sine pl
+ -- Let's play an 'A' note for 1 sec.
+ playMono16Sine pl 44100 1 440
-playMono16Sine ∷ Monad m ⇒ Player Int16 Mono m → m ()
-playMono16Sine pl
- = fail "FIXME"
+playMono16Sine ∷ ( AncestorRegion pr cr
+ , MonadIO cr
+ )
+ ⇒ Player Int16 Mono pr
+ → Int
+ → Double
+ → Double
+ → cr ()
+playMono16Sine pl sampleFreq sec noteFreq
+ = write pl buffer
+ where
+ buffer ∷ L.Vector Int16
+ buffer = L.pack L.defaultChunkSize frames
+
+ frames ∷ [Int16]
+ frames = let nFrames = round $ sec ⋅ realToFrac sampleFreq
+ in
+ map calcFrame [0 .. nFrames - 1]
+
+ calcFrame ∷ Int → Int16
+ calcFrame n = let frame = calcFrame' n
+ in
+ -- -1.0 ≤ frame ≤ 1.0
+ floor $ fromIntegral ((maxBound ∷ Int16) - 1) ⋅ frame
+
+ calcFrame' ∷ Int → Double
+ calcFrame' n
+ = sin $
+ 2
+ ⋅ π
+ ⋅ noteFreq
+ ⋅ (realToFrac n / realToFrac sampleFreq)