djembe (empty) → 0.1.0.0

raw patch · 8 files changed

+363/−0 lines, 8 filesdep +QuickCheckdep +basedep +djembesetup-changed

Dependencies added: QuickCheck, base, djembe, hmidi, hspec, lens, mtl, random

Files

LICENSE +20/−0
Setup.hs +2/−0
djembe.cabal +44/−0
src/Drum.hs +81/−0
src/Interpret.hs +36/−0
src/Play.hs +57/−0
src/Types.hs +122/−0
test/Spec.hs +1/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Reed Rosenbluth++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ djembe.cabal view

@@ -0,0 +1,44 @@+-- Initial djembe.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                djembe+version:             0.1.0.0+synopsis:            Hit drums with haskell           +description:+  A simple DSL for composing drum beats in haskell.+  Djembe uses the system MIDI device to play these beats.+license:             MIT+license-file:        LICENSE+author:              Reed Rosenbluth+maintainer:          Reed.Rosenbluth@gmail.com+copyright:           2015 Reed Rosenbluth+category:            Sound+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Types, +                       Play,+                       Interpret,+                       Drum+  build-depends:       base >=4.6 && <4.9+                      ,lens >=4.7 && <4.14+                      ,hmidi >= 0.2.1 && <3.0+                      ,random >=1.0 && <1.2+                      ,QuickCheck >=2.7 && <2.9+                      ,hspec >=2.1 && <2.3+                      ,mtl+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite djembe-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                      ,hspec+                      ,QuickCheck+                      ,djembe+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010

+ src/Drum.hs view

@@ -0,0 +1,81 @@+module Drum where++import Types+import Control.Lens++-- | default volume+volume :: Rational+volume = 127++-- | set the duration for each `Hit` in a `Song`+-- where the first argument represents the duration as a+-- fraction of a whole note.+note :: Rational -> Song -> Song+note n = cmap (\h -> h & dur .~ 4 / n)++-- | replicate a song a number of times+clone :: Rational -> Song -> Song+clone 1 s = s+clone n s = s >> clone (n-1) s++-- | modify the duration for each `Hit` in a `Song` to be+-- 1.5 times as long+dot :: Song -> Song+dot = cmap (\h -> h & dur %~ (* 1.5))++-- | quarter note rest+rest :: Rational -> Song+rest n = note n $ hsong (Hit BassDrum1 0 0)++-- | notes of various durations+n1, n2, n4, n8, n16, n32, n64 :: Song -> Song+n1  = note 1+n2  = note 2+n4  = note 4+n8  = note 8+n16 = note 16+n32 = note 32+n64 = note 64++-- | rests of various durations+r1, r2, r4, r8, r16, r32, r64 :: Song+r1  = rest 1+r2  = rest 2+r4  = rest 4+r8  = rest 8+r16 = rest 16+r32 = rest 32+r64 = rest 64+++-- | create an infinite loop of a `Song`+loop :: Song -> Song+loop s = s >> loop s++-- | transform a `Beat` to a `Song`+song :: Beat -> Song+song b = Composition (b, ())++-- | transform a `Hit` to a `Song`+hsong :: Hit -> Song+hsong = song . Single++-- | change the velocity (volume) for each `Hit` in a `Song`+velocity :: Rational -> Song -> Song+velocity v = cmap (\h -> h & vol .~ max 0 (min 127 v))++-- | bass drum `Hit`+bd :: Song+bd = n4 $ hsong (Hit BassDrum1 0 volume)++-- | snare drum `Hit`+sn :: Song+sn = n4 $ hsong (Hit SnareDrum2 0 volume)++-- | hihat drum `Hit`+hi :: Song+hi = n4 $ hsong (Hit ClosedHihat 0 volume)++-- | rest `Hit`+rt :: Song+rt = n4 $ hsong (Hit BassDrum1 0 0)

+ src/Interpret.hs view

@@ -0,0 +1,36 @@+module Interpret where++import Types+import Control.Lens++-- | calculates the total duration of a `Beat`+totalDur :: Beat -> Rational+totalDur (Single hit)     = hit ^. dur+totalDur (Series c1 c2)   = totalDur c1 + totalDur c2+totalDur (Parallel c1 c2) = max (totalDur c1) (totalDur c2)+totalDur None             = 0++-- | merge two sorted lists of `Hit`s+mergeHits :: [Hit] -> [Hit] -> [Hit]+mergeHits [] ys = ys+mergeHits xs [] = xs+mergeHits (x:xs) (y:ys)+  | x <= y    = x : mergeHits xs (y:ys)+  | otherwise = y : mergeHits (x:xs) ys++-- | apply a tempo to a composition+applyTempo :: Rational -> Composition a -> Composition a+applyTempo n = cmap (\h -> h & dur *~ (60000 / n))++-- | convert a `Composition` to a list of `Hit`s+toHits :: Composition a -> [Hit]+toHits (Composition (beat, _)) = go 0 beat+  where+    go d (Single hit)     = [hit & dur .~ d]+    go d (Series b1 b2)   = go d b1 ++ go (d + totalDur b1) b2+    go d (Parallel b1 b2) = mergeHits (go d b1) (go d b2)+    go _ None             = []++-- | interpret a `Composition` with a given tempo+interpret :: Rational -> Composition a -> [Hit]+interpret n c = toHits $ applyTempo n c

+ src/Play.hs view

@@ -0,0 +1,57 @@+module Play (play, play', loop') where++import Data.Ratio+import Control.Monad+import Control.Monad.State+import Control.Lens+import Control.Concurrent+import System.MIDI++import Types+import Drum+import Interpret++-- | convert a `Hit` to a `MidiEvent`+hitToMidiEvent :: Hit -> MidiEvent+hitToMidiEvent h = MidiEvent d (MidiMessage 1 (NoteOn t v))+  where+    t  = 35 + fromEnum (h ^. tone)+    d  = fromR $ h ^. dur+    v  = fromR $ h ^. vol+    fromR r = fromIntegral $ numerator r `div` denominator r++getConnection :: IO Connection+getConnection = do+    dstlist <- enumerateDestinations+    case dstlist of+      [] -> error "No MIDI Devices found."+      (dst:_) -> openDestination dst++-- | play a composition at a given tempo+play :: Composition a -> Rational -> IO ()+play comp n = do+    conn <- getConnection+    start conn+    evalStateT runComposition (conn, interpret n comp)+    close conn++play' :: Composition a -> IO ()+play' = flip play 120++-- | loop a composition at a given tempo+loop' :: Song -> Rational -> IO ()+loop' s = play (loop s)++runComposition :: StateT (Connection, [Hit]) IO ()+runComposition = do+  (conn, comp) <- get+  t <- lift $ currentTime conn+  case comp of+    []     -> return ()+    (h:hs) -> do+      let (MidiEvent s ev) = hitToMidiEvent h+      when (s < t) $ do+        put (conn, hs)+        lift $ send conn ev+      lift $ threadDelay 250+      runComposition

+ src/Types.hs view

@@ -0,0 +1,122 @@+{-# LANGUAGE TemplateHaskell, FlexibleInstances #-}++module Types where++import Data.Monoid+import Data.Ratio+import Control.Applicative+import Control.Monad+import Control.Lens hiding (elements)+import System.Random+import Test.QuickCheck++-- | Types of drum sounds+data Sound =+     BassDrum2     | BassDrum1     | SideStick    | SnareDrum1+   | HandClap      | SnareDrum2    | LowTom2      | ClosedHihat+   | LowTom1       | PedalHihat    | MidTom2      | OpenHihat+   | MidTom1       | HighTom2      | CrashCymbal1 | HighTom1+   | RideCymbal1   | ChineseCymbal | RideBell     | Tambourine+   | SplashCymbal  | Cowbell       | CrashCymbal2 | VibraSlap+   | RideCymbal2   | HighBongo     | LowBongo     | MuteHighConga+   | OpenHighConga | LowConga      | HighTimbale  | LowTimbale+   | HighAgogo     | LowAgogo      | Cabasa       | Maracas+   | ShortWhistle  | LongWhistle   | ShortGuiro   | LongGuiro+   | Claves        | HighWoodBlock | LowWoodBlock | MuteCuica+   | OpenCuica     | MuteTriangle  | OpenTriangle+   deriving (Show, Eq, Ord, Enum, Bounded)++instance Arbitrary Sound where+  arbitrary = toEnum <$> choose+    (fromEnum (minBound :: Sound),+     fromEnum (maxBound :: Sound))++-- | A drum `Hit` with a tone, duration, and volume+data Hit = Hit+    { _tone :: Sound+    , _dur  :: Rational+    , _vol  :: Rational+    } deriving (Show, Eq)++instance Arbitrary Hit where+  arbitrary = do+    tone <- arbitrary+    dur  <- toRational <$> choose (1 :: Int, 64)+    vol  <- toRational <$> choose (0 :: Int, 127)+    return $ Hit tone dur vol++makeLenses ''Hit++cmpToneVol :: Hit -> Hit -> Bool+cmpToneVol x y+  | xTone  < yTone = True+  | xTone == yTone = x ^. vol < y ^. vol+  | otherwise = False+  where xTone = x ^. tone+        yTone = y ^. tone++instance Ord Hit where+  x <= y+    | xDur  < yDur = True+    | xDur == yDur = cmpToneVol x y+    | otherwise    = False+    where xDur = x ^. dur+          yDur = y ^. dur++-- | Used for combining Hits and Beats+data Beat =+    None+  | Single   Hit+  | Series   Beat Beat+  | Parallel Beat Beat+  deriving (Show, Eq)++instance Arbitrary Beat where+  arbitrary = sized arbnB++arbnB :: Int -> Gen Beat+arbnB n = frequency [+    (1, return None),+    (3, liftM  Single arbitrary),+    (n, liftM2 Series (arbnB (n `div` 2)) (arbnB (n `div` 2))),+    (n, liftM2 Parallel (arbnB (n `div` 8)) (arbnB (n `div` 8))) ]++-- | We wrap a `Beat` in the `Composition` data structure in order+-- create a monad instance for it.+data Composition a = Composition (Beat, a) deriving (Show)++type Song = Composition ()++instance Arbitrary Song where+  arbitrary = do+    b <- arbitrary :: Gen Beat+    return $ Composition (b, ())++instance Functor Composition where+  fmap = liftM++instance Applicative Composition where+  pure  = return+  (<*>) = ap++-- | This is basically a specialized instance of the writer monad+-- for composing compositions in series.+instance Monad Composition where+  return a = Composition (None, a)+  Composition (b, a) >>= k =+    let (Composition (b', a')) = k a+    in Composition (Series b b', a')++instance Monoid (Composition ()) where+  mempty = Composition (None, ())+  mappend (Composition (b1, _)) (Composition (b2, _))+    = Composition (Parallel b1 b2, ())++-- | Lift a function on `Hit`s over a `Composition`+cmap :: (Hit -> Hit) -> Composition a -> Composition a+cmap f (Composition (c,a)) = Composition (hmap f c, a)+  where+    hmap g (Single h)       = Single (g h)+    hmap g (Series b1 b2)   = Series (hmap g b1) (hmap g b2)+    hmap g (Parallel b1 b2) = Parallel (hmap g b1) (hmap g b2)+    hmap _ b                = b

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}