{-# LANGUAGE
    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

main ∷ IO ()
main = runRegionT $
       do pl ← openPlayer 44100 Nothing Nothing
          -- Let's play an 'A' note for 1 sec.
          playMono16Sine pl 44100 1 440

playMono16Sine ∷ ( AncestorRegion pr cr
                  , MonadIO cr
                  )
               ⇒ Player Int16 Mono pr
               → Int
               → Double
               → Double
               → cr ()
playMono16Sine pl sampleFreq sec noteFreq
    = writeFrames 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)