launchpad-control-0.0.1.0: System/MIDI/Launchpad/Apps/MonoSeq.hs
-- | A monophonic sequencer app.
--
-- Each note can have a velocity, length, offset (small delay relative to
-- the grid position), and 5 custom CC commands.
-- The parameters can be set up using the 8 triangle buttons (top one is
-- velocity, second is length, etc).
--
-- When there are more than 8 step, you can scroll with the left/right buttons
-- (jumping 8 steps).
--
-- Example usage:
--
-- > main = runPureApp defaultGlobalConfig $ monoSequencer defaultCfg
--
{-# LANGUAGE BangPatterns #-}
module System.MIDI.Launchpad.Apps.MonoSeq where
--------------------------------------------------------------------------------
import Data.List
import Control.Monad
import System.MIDI
import Data.Array.Unboxed
import Data.Array.IArray
import System.MIDI.Launchpad.Control
import System.MIDI.Launchpad.AppFramework
--------------------------------------------------------------------------------
data Scale
= Chromatic
| Pentatonic
| CMinor
| CMajor
deriving (Eq,Show)
data Cfg = Cfg
{ seqSteps :: !Int -- ^ How many steps we have (it can be more than 8!)
, stepResolution :: !Int -- ^ Length of a step. 24 is quarter note, 12 is 1/8th, etc.
, midiFrom :: !Int -- ^ which note should be the lowest (MIDI notes, for example 36 or 48 or 60 are C notes)
, midiScale :: !Scale
, ccFrom :: !Int -- ^ where to start to 5 consecutive CC commands
}
deriving Show
-- | 8 steps by default, and 1/8th note per step
defaultCfg :: Cfg
defaultCfg = Cfg
{ seqSteps = 8
, stepResolution = 12
, midiFrom = 48
, midiScale = Pentatonic
, ccFrom = 90
}
--------------------------------------------------------------------------------
data Mode
= Notes
| Params !Int
deriving (Eq,Ord,Show)
data State = State
{ _playing :: !Bool
, _screenPos :: !Int
, _notes :: !(UArray Int Int)
, _params :: !(UArray (Int,Int) Int)
, _playNotes :: [PlayNote]
}
deriving (Eq,Ord,Show)
-- | Notes played at the moment
data PlayNote = PlayNote
{ _note :: !Int
, _stopAt :: !Int
}
deriving (Eq,Ord,Show)
-- | A monophonic sequencer app.
monoSequencer :: Cfg -> PureApp Cfg Mode State
monoSequencer cfg = PureApp
{ pAppConfig = cfg
, pAppIniState = (Notes, initialState cfg)
, pAppStartStop = startStop
, pAppRender = render
, pAppButton = button
, pAppSync = sync
}
--------------------------------------------------------------------------------
initialState :: Cfg -> State
initialState cfg@(Cfg seqSteps stepResolution _ _ _) = State
{ _playing = False
, _screenPos = 0
, _notes = listArray (0,seqSteps+7) (repeat (-1))
, _params = listArray ((0,0),(seqSteps+7,7))
$ concat $ transpose $
[ rep 5 , rep 3 , rep 0 , rep 4
, rep 4 , rep 4 , rep 4 , rep 4 ]
, _playNotes = []
}
where
rep = replicate seqSteps
startStop :: Cfg -> Bool -> State -> State
startStop cfg playing state = state { _playing = playing }
--------------------------------------------------------------------------------
button :: Cfg -> ButtonPress -> (Mode,State) -> ((Mode,State),[MidiMessage'])
button cfg@(Cfg seqSteps stepResolution _ _ _) (Release _) old = (old,[])
button cfg@(Cfg seqSteps stepResolution _ _ _) (Press but) (mode,state) =
case but of
Dir d -> case d of
L -> ((mode, state { _screenPos = max (pos-8) 0 }) , [])
R -> ((mode, state { _screenPos = min (pos+8) lastScreenPos }) , [])
_ -> ((mode,state),[])
Side k -> case mode of
Notes -> ( ( Params k , state ) , [] )
Params u -> ( ( if u/=k then Params k else Notes , state )
, if _playing state then [] else [CC (ccNumber cfg k) 64] )
Pad x y -> case mode of
Notes -> ( ( mode, state { _notes = notes // [(pos+x, new)] } ) , [] ) where
new = if old==y then -1 else y
old = notes!(pos+x)
Params u -> ( ( mode, state { _params = params // [((pos+x,u), 7-y)] } ) , [] ) where
old = params!(pos+x,u)
_ -> ((mode,state),[])
where
lastScreenPos = 8 * div (seqSteps - 1) 8
pos = _screenPos state
notes = _notes state
params = _params state
--------------------------------------------------------------------------------
counterStep :: Cfg -> Int -> Int
counterStep (Cfg seqSteps stepResolution _ _ _) cnt = ((div cnt stepResolution) `mod` seqSteps)
invCounterStep :: Cfg -> Int -> Int
invCounterStep (Cfg seqSteps stepResolution _ _ _) step = step*stepResolution
totalTicks :: Cfg -> Int
totalTicks (Cfg seqSteps stepResolution _ _ _) = stepResolution * seqSteps
ccNumber :: Cfg -> Int -> Int
ccNumber (Cfg _ _ _ _ ccFrom) y = ccFrom + y - 3
noteNumber :: Cfg -> Int -> Int
noteNumber (Cfg _ _ midiFrom midiScale _) y =
case midiScale of
Chromatic -> midiFrom + y
Pentatonic -> midiFrom + penta !! y
CMajor -> midiFrom + cmajor !! y
CMinor -> midiFrom + cminor !! y
where
penta = [ 0,2,4, 7,9, 12,14,16, 19,21 ]
cmajor = [ 0,2,4,5,7,9,11, 12,14,16,17,19,21,23]
cminor = [ 0,2,3,5,7,8,10, 12,14,15,17,19,20,22]
--------------------------------------------------------------------------------
sync :: Cfg -> Mode -> State -> Int -> (State,[MidiMessage'])
sync cfg@(Cfg seqSteps stepResolution midiFrom midiScale ccFrom) mode state counter = (state',msgs) where
state' = state { _playNotes = newNotes ++ contNotes }
newNotes = [ PlayNote note (counter + 2*(len+1))
| x <- newIdx, let len = (div stepResolution 4) * (1+params!(x,1))
, let note = notes!x, note>=0 ]
newIdx = [ x | x <- [0..seqSteps-1], let y = notes!x, y>=0
, invCounterStep cfg x + delay x == mod counter (totalTicks cfg) ]
(stopNotes, contNotes) = partition (\(PlayNote note stop) -> stop == counter) (_playNotes state)
notes = _notes state
params = _params state
delay x = params!(x,2) -- 0 is velocity, 1 is length, 2 is delay
msgs = [ NoteOff (toNote stop) 64 | PlayNote stop _ <- stopNotes ]
++ [ CC (ccNumber cfg y) value | x <- newIdx, let start = notes!x
, y <-[3..7] , let value = (params!(x,y))*16 ]
++ [ NoteOn (toNote start) vel | x <- newIdx, let start = notes!x
, let vel = (params!(x,0)+1)*16-1 ]
toNote y = if y>=0 then noteNumber cfg (7-y) else error "MonoSeq/sync/toNote: shouldn't happen"
--------------------------------------------------------------------------------
renderArrows :: Cfg -> State -> [(Button,Color)]
renderArrows cfg@(Cfg seqSteps _ _ _ _) state = concat
[ if _screenPos state > 0 then [(Dir L, green)] else []
, if _screenPos state < seqSteps-8 then [(Dir R, green)] else []
]
render :: Cfg -> Mode -> State -> Maybe Int -> [(Button,Color)]
render cfg mode state msync = renderArrows cfg state ++ stuff where
pos = _screenPos state
notes = _notes state
params = _params state
steps = seqSteps cfg
column = case msync of
Nothing -> (-1)
Just cnt -> counterStep cfg cnt - pos
stuff = case mode of
Notes -> time ++ note where
time = if column >= 0 && column < 8 then [ (Pad column y, amber) | y<-[0..7] ] else []
note = [ (Pad x y, color) | x<-[0..7], let y = notes!(pos+x), pos+x<steps, y>=0
, let color = if column==x then orange else red ]
Params u -> time ++ par ++ side where
time = if column >= 0 && column < 8 then [ (Pad column 0, amber) ] else []
par = [ (Pad x y, color) | x<-[0..7], let p = params!(pos+x,u), pos+x<steps, p>0, y<-[7-p..7]
, let color = if column==x && y==0 then yellow else green ]
side = [ (Side u, green) ]
--------------------------------------------------------------------------------