definitive-sound (empty) → 1.0
raw patch · 3 files changed
+167/−0 lines, 3 filesdep +alsa-coredep +alsa-pcmdep +array
Dependencies added: alsa-core, alsa-pcm, array, base, bytestring, clock, containers, deepseq, definitive-base, primitive, sample-frame, storable-record, vector
Files
- Data/Music.hs +79/−0
- LICENSE +69/−0
- definitive-sound.cabal +19/−0
+ Data/Music.hs view
@@ -0,0 +1,79 @@+module Data.Music (+ Note(..),Wave(..),+ frequency,gain,wave,duration,playTune,+ defaultFmt,+ -- * Notes+ la,si,do',re,mi,fa,sol,sharp,flat,high,low+ ) where++import Algebra hiding (splitAt,take,drop)+import Algebra.Time+import Data.Tree+import Sound.ALSA.PCM+import Data.IORef+import Foreign.Marshal.Array+import Data.Containers+import Data.Containers.Sequence+import Foreign.Marshal.Array (copyArray)++data Wave = Wave { _frequency :: Seconds, _gain :: Double }+ deriving Show+data Note = Note Wave Seconds+ deriving Show+type Melody = Forest Note++frequency :: Lens' Wave Seconds+frequency = lens _frequency (\w t -> w { _frequency = t})+gain :: Lens' Wave Double+gain = lens _gain (\w t -> w { _gain = t})+wave :: Lens' Note Wave+wave = lens (\(Note w _) -> w) (\(Note _ t) w -> Note w t)+duration :: Lens' Note Seconds+duration = lens (\(Note _ d) -> d) (\(Note w _) d -> Note w d)++factor = 2**(1/12)+la, si, do', re,mi,fa,sol :: Seconds -> Note+(la:_:si:do':_:re:_:mi:fa:_:sol:_) =+ f<$>iterate (*factor) 1+ where f m = Note (Wave (440*m) 40)++sharp :: Note -> Note+sharp = wave.frequency %~ (*factor)+flat :: Note -> Note+flat = wave.frequency %~ (/factor)+high :: Note -> Note+high = wave.frequency %~ (*2)+low :: Note -> Note+low = wave.frequency %~ (/2)++playTune :: SoundFmt Seconds -> [Note] -> IO ()+playTune f mel = copySound (tuneSource f mel) (alsaSoundSink "plughw" f) (sampleFreq f*2)++period = cached $ \density -> take (round density) [sin (pi*2*x)*0.75 | x <- iterate (+recip density) 0]^.slice++newtype TH t = TH (IORef (Slices t))+tuneSource :: SoundFmt Seconds -> [Note] -> SoundSource TH Seconds+tuneSource (SoundFmt sfreq) mel = SoundSource {+ soundSourceOpen = open,+ soundSourceClose = close,+ soundSourceStart = start,+ soundSourceStop = stop,+ soundSourceRead = readn+ }+ where open = TH<$>newIORef (toSamples mel)+ close _ = return ()+ start _ = return ()+ stop _ = return ()+ toSamples = foldMap note2Samples+ where note2Samples (Note (Wave freq _) t) =+ take (round (t*freq*density)) (repeat (period density)^._Slices)+ where density = fromIntegral sfreq/freq+ readn (TH r) p s = do+ rem <- readIORef r+ let (h,t) = splitAt s rem+ size = if empty (t^.._Slices) then breadth h else s+ unsafeWith (h^..slices) $ \p' -> (p `copyArray` p') size+ writeIORef r t+ return size++defaultFmt = SoundFmt 48000
+ LICENSE view
@@ -0,0 +1,69 @@+Bill and Ted's Public License+=============================++Everyone is permitted to copy and distribute verbatim or modified+copies of this license document, and changing it is allowed as long as+the name of the license is changed.++PREAMBLE+--------++The “Greater Lunduke License” is inspired, in part, by the wisdom of+the Two Great Ones, Bill S. Preston, Esq. and Ted “Theodore” Logan.+Namely that we should all “be excellent to each other”, that being+“bogus” is “most non-triumphant” and that all dudes should “party on”.++This license applies those concepts in such a way that it is+applicable to all forms of content, including, but not limited to:+software, books, music, movies and various works of art.++TERMS AND CONDITIONS+--------------------++### 1. Be Excellent To Each Other.++The consumer of this work is granted the right to utilize this work in+conjunction with any mechanism that is capable of utilizing it, in the+form supplied by the content creator, without limitation as to+specific hardware or software.++The consumer of this work may make copies of this work (physical or+otherwise) for backup purposes.++The consumer of this work may lend this work to another individual+provided that the following two conditions are met :+ + 1. the lender no longer utilizes or possesses the work+ 2. the work is not presently lent to another individual++The consumer of this work may sell this work to another individual+provided that the following two conditions are met :++ 1. the seller no longer utilizes or possesses the work + 2. once the work is sold, the seller relinquishes all rights and+ copies of the work to the buyer.++### 2. Don’t Be Bogus.++The consumer of this work shall not redistribute modified, or+unmodified, copies of this work without explicit written permission+from the creator of this work. The only exceptions allowed to this+rule are the provisions outlined in section 1 of this license++The consumer of this work shall not hold the creator of this work+liable for anything the consumer does, or does not, do, or the results+of utilizing this work.++### 3. Party On, Dudes!++The creator of this work provides the work in a form that contains no+mechanism to disable the utilization of the work after a specific+date, period of time or number of uses.++If additional works, which are created and wholly owned by the work’s+creator, are required to utilize this work, those additional works+must also be made available to the consumer so long as the following+conditions are met :+ + 1. doing so is possible+ 2. doing so does not cause harm to the creator of the work.
+ definitive-sound.cabal view
@@ -0,0 +1,19 @@+name: definitive-sound+version: 1.0++synopsis: A definitive package to handle sound and play it back+description: +author: Marc Coiffier+maintainer: marc.coiffier@gmail.com+license: OtherLicense+license-file: LICENSE++build-type: Simple+cabal-version: >=1.10++library+ exposed-modules: Data.Music+ build-depends: base (== 4.6.*), definitive-base (== 1.0.*), containers (== 0.5.*), deepseq (== 1.3.*), array (== 0.5.*), bytestring (== 0.10.*), clock (== 0.4.*), alsa-pcm (== 0.6.*), alsa-core (== 0.5.*), storable-record (== 0.0.*), sample-frame (== 0.0.*), vector (== 0.10.*), primitive (== 0.5.*)+ default-extensions: RebindableSyntax+ ghc-options: + default-language: Haskell2010