module Sound.MIDI.ALSA.CausalExample where
import qualified Sound.MIDI.ALSA.Causal as Causal
import qualified Sound.MIDI.ALSA.Common as Common
import qualified Sound.MIDI.ALSA.Training as Training
import Sound.MIDI.ALSA.Causal
(process, map, lift, guide, guideWithMode,
patternTempo, transpose, )
import Sound.MIDI.ALSA.Common
(channel, pitch, program, controller, velocity, )
import qualified Sound.MIDI.Controller as Ctrl
import qualified Sound.MIDI.Message.Channel.Mode as ModeMsg
import qualified System.Random as Random
import Data.Ord.HT (limit, )
import Data.Maybe (fromMaybe, )
import qualified Data.List as List
import Control.Category ((.), )
import Control.Monad.Trans.Reader (ReaderT, )
import Prelude hiding (init, map, filter, (.), id, reverse, )
defaultTempo :: Causal.TempoControl
defaultTempo =
(Common.defaultTempoCtrl, (0.25, 0.12, 0.05))
run :: ReaderT Common.Handle IO a -> IO a
run x = Common.with $ Common.connectLLVM >> x
pass,
reverse,
delay,
cycleUp,
cycleUpTempo,
cycleUpPoly,
sweep,
split,
splitPattern,
serialPattern,
serialLatch,
cyclePrograms,
cycleProgramsDefer,
binary,
crossSum,
bruijn,
latch,
groupLatch,
groupCycleUp,
groupBinary,
groupCrossSum,
groupBruijn,
groupRandom,
groupRandomInversions,
filterKey,
guitar,
sendProgram,
sendMode,
releaseAllKeys :: ReaderT Common.Handle IO ()
pass =
process (map (maybe [] Common.singletonBundle) . transpose 12)
reverse =
process (map (maybe [] Common.singletonBundle) . Causal.reverse)
delay =
process (Causal.delayAdd 50 1)
cycleUp =
process (Causal.patternMono (Common.cycleUp 4) 0.12)
cycleUpTempo =
process (patternTempo (Common.cycleUp 4) defaultTempo)
cycleUpPoly =
process (patternTempo
(Common.PatternPoly
Common.selectFromLimittedChord
Common.examplePatternPolyTempo1)
defaultTempo)
sweep =
process
(map Common.immediateBundle
.
Causal.sweep (channel 1)
0.01 (controller 16, (0.1, 1))
(controller 17) (controller 94)
(sin . (2*pi*)))
split =
process
(guideWithMode
(\e ->
(Common.checkChannel (channel 0 ==) e &&
Common.checkPitch (pitch 60 >) e) ||
Common.checkController (controller 94 ==) e ||
Common.checkController (controller 95 ==) e)
(map (maybe [] Common.singletonBundle)
.
transpose 12
.
map (Common.setChannel (channel 1)))
(map (maybe [] Common.singletonBundle)
.
transpose 0))
splitPattern =
process
(guideWithMode
(\e ->
Common.checkPitch (pitch 60 >) e ||
Common.checkController (snd Common.defaultTempoCtrl ==) e)
(map concat
.
lift (patternTempo (Common.cycleUp 4) defaultTempo)
.
map (fromMaybe [])
.
lift Causal.groupLatch
.
transpose 12)
(map Common.singletonBundle))
serialPattern =
process (Causal.patternSerialTempo 4 (Common.cycleUp 4) defaultTempo)
serialLatch =
process (map Common.immediateBundle . Causal.serialLatch 4)
cyclePrograms =
process
(map Common.immediateBundle .
Causal.cyclePrograms (List.map program [16..20]))
cycleProgramsDefer =
process
(map Common.immediateBundle .
Causal.cycleProgramsDefer 0.1
(List.map program [16..20]))
binary =
process (patternTempo Common.binaryLegato defaultTempo)
crossSum =
process (patternTempo (Common.crossSum 4) defaultTempo)
bruijn =
process (patternTempo (Common.bruijnPat 4 2) defaultTempo)
latch =
process (map (maybe [] Common.singletonBundle) . Causal.latch)
groupLatch =
process (map Common.immediateBundle . Causal.groupLatch)
withGroup ::
(Causal.Pattern pat) =>
pat -> ReaderT Common.Handle IO ()
withGroup f =
process
(map concat
.
lift (patternTempo f defaultTempo)
.
Causal.groupLatch)
groupBinary =
withGroup Common.binaryLegato
groupCrossSum =
withGroup (Common.crossSum 4)
groupBruijn =
withGroup (Common.bruijnPat 4 2)
groupCycleUp =
withGroup (Common.cycleUp 4)
groupRandom =
withGroup Common.random
groupRandomInversions =
withGroup Common.randomInversions
filterKey =
process
(map (maybe [] Common.singletonBundle)
.
guide
(Common.checkPitch (pitch 60 >))
(transpose 12)
(map (Common.controllerFromNote
(\p ->
limit (0,127) $ 2*(p69)+64)
(Ctrl.effect4Depth))))
guitar =
process (Causal.guitar 0.05 0.03)
trainer ::
(Random.RandomGen g) =>
g -> ReaderT Common.Handle IO ()
trainer g =
process (Causal.trainer (channel 0) 0.5 0.3 (Training.all g))
sendProgram =
Common.sendProgram (channel 0) (program 0) >>
process (map Common.singletonBundle)
sendMode =
Common.sendMode (channel 0) ModeMsg.AllNotesOff
releaseAllKeys =
mapM_
(Common.sendKey (channel 0) False (velocity 0))
[minBound..maxBound]