-- Copyright 2020 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
-- | This is like the @sample@ patch, but with special support for breaking up
-- beats and naming them.
module Synth.Sampler.Patch.Break (
    patches
#ifdef TESTING
    , module Synth.Sampler.Patch.Break
#endif
) where
import qualified Data.Map as Map
import qualified Data.Ratio as Ratio
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO

import qualified Util.Doc as Doc
import qualified Util.Lists as Lists
import qualified Util.Num as Num

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.ImInst as ImInst
import qualified Cmd.PhysicalKey as PhysicalKey

import qualified Derive.Args as Args
import qualified Derive.Call as Call
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Sub as Sub
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Expr as Expr
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Sig as Sig
import qualified Derive.Typecheck as Typecheck

import qualified Perform.Im.Patch as Im.Patch
import qualified Perform.Pitch as Pitch
import qualified Synth.Lib.AUtil as AUtil
import qualified Synth.Sampler.Patch as Patch
import qualified Synth.Sampler.Patch.Lib.Util as Util
import qualified Synth.Sampler.Sample as Sample
import qualified Synth.Shared.Config as Config
import qualified Synth.Shared.Control as Control
import qualified Synth.Shared.Note as Note
import qualified Synth.Shared.Signal as Signal

import           Global


patches :: [Patch.Patch]
patches :: [Patch]
patches = forall a b. (a -> b) -> [a] -> [b]
map Break -> Patch
make [Break]
allBreaks
    where
    make :: Break -> Patch
make Break
break = (Stroke -> Patch
Patch.patch (Stroke
"break-" forall a. Semigroup a => a -> a -> a
<> Break -> Stroke
_name Break
break))
        { _dir :: FilePath
Patch._dir = FilePath
dir
        , _convert :: Note -> ConvertM Sample
Patch._convert = FilePath -> NoteNumber -> Note -> ConvertM Sample
convert FilePath
sample (Break -> NoteNumber
_pitchAdjust Break
break)
        , _allFilenames :: Set FilePath
Patch._allFilenames = forall a. Ord a => [a] -> Set a
Set.fromList [FilePath
sample]
        , _effect :: Maybe EffectConfig
Patch._effect = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Stroke -> EffectConfig
Patch.effect Stroke
"comb")
            { _toEffectControl :: Map Control Control
Patch._toEffectControl = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (Control
"pitch", Control
"comb-pitch")
                , (Control
"feedback", Control
"comb-feedback")
                ]
            }
        , _karyaPatch :: Patch
Patch._karyaPatch =
            Lens Patch Doc
ImInst.doc forall f a. Lens f a -> a -> f -> f
#= Stroke -> Doc
Doc.Doc
                (Stroke
"Inferred BPM: " forall a. Semigroup a => a -> a -> a
<> forall a. RealFloat a => Int -> a -> Stroke
Num.showFloat Int
2 (Break -> Double
breakBpm Break
break)) forall a b. (a -> b) -> a -> b
$
            Lens Patch Code
ImInst.code forall f a. Lens f a -> a -> f -> f
#= (Code
call_code forall a. Semigroup a => a -> a -> a
<> Code
drum_code) forall a b. (a -> b) -> a -> b
$
            Patch -> Patch
ImInst.make_patch forall a b. (a -> b) -> a -> b
$ Patch
Im.Patch.patch
                { patch_controls :: Map Control Stroke
Im.Patch.patch_controls = forall a. Monoid a => [a] -> a
mconcat
                    [ Map Control Stroke
Control.supportDyn
                    , Map Control Stroke
Control.supportSampleStartOffset
                    , Control -> Stroke -> Map Control Stroke
Control.support Control
pitchOffset Stroke
"Pitch offset, in nn."
                    , Map Control Stroke
Control.supportSampleTimeStretch
                    , Map Control Stroke
Control.supportSamplePitchShift
                    ]
                }
        }
        where
        sample :: FilePath
sample = Stroke -> FilePath
untxt forall a b. (a -> b) -> a -> b
$ Break -> Stroke
_name Break
break forall a. Semigroup a => a -> a -> a
<> Stroke
".wav"
        call_code :: Code
call_code = [(Symbol, Generator Note)] -> Code
ImInst.note_generators forall a b. (a -> b) -> a -> b
$ (Symbol
"n", Maybe Int -> Generator Note
breakCall forall a. Maybe a
Nothing) forall a. a -> [a] -> [a]
:
            [ (Stroke -> Symbol
Expr.Symbol Stroke
stroke, Maybe Int -> Generator Note
breakCall (forall a. a -> Maybe a
Just Int
frame))
            | ((Int, Beat)
_, Stroke
stroke, Int
frame) <- Break -> [((Int, Beat), Stroke, Int)]
_beats Break
break
            ]
        drum_code :: Code
drum_code = HandlerId -> Code
ImInst.cmd forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). M m => Thru -> NoteEntryMap Expr -> Handler m
CUtil.insert_expr Thru
thru
            (Beat -> Beat -> Map (Int, Beat) Stroke -> NoteEntryMap Expr
lookupStroke (Break -> Beat
_increment Break
break) (Break -> Beat
_perMeasure Break
break) Map (Int, Beat) Stroke
strokeMap)
            where
            strokeMap :: Map (Int, Beat) Stroke
strokeMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [((Int, Beat)
beat, Stroke
stroke) | ((Int, Beat)
beat, Stroke
stroke, Int
_) <- Break -> [((Int, Beat), Stroke, Int)]
_beats Break
break]
        thru :: Thru
thru = FilePath -> (Note -> ConvertM Sample) -> Thru
Util.imThruFunction FilePath
dir (FilePath -> NoteNumber -> Note -> ConvertM Sample
convert FilePath
sample (Break -> NoteNumber
_pitchAdjust Break
break))
        beatMap :: Map Beat Int
beatMap = Break -> Map Beat Int
makeBeatMap Break
break
        breakCall :: Maybe Int -> Generator Note
breakCall = Double -> Map Beat Int -> Beat -> Maybe Int -> Generator Note
c_break (Break -> Double
breakBpm Break
break) Map Beat Int
beatMap (Break -> Beat
_perMeasure Break
break)
    dir :: FilePath
dir = FilePath
"break"

-- * cmd

-- | I can fit 8 per octave, and with black notes that's 16.
lookupStroke :: Beat -> Beat -> Map (Measure, Beat) Text
    -> Cmd.NoteEntryMap DeriveT.Expr
lookupStroke :: Beat -> Beat -> Map (Int, Beat) Stroke -> NoteEntryMap Expr
lookupStroke Beat
increment Beat
perMeasure Map (Int, Beat) Stroke
strokeMap
    | forall a b. (a, b) -> a
fst (Int, Beat)
maxBeat forall a. Ord a => a -> a -> Bool
> Int
2 = forall a. Map Int (Map Char a) -> NoteEntryMap a
Cmd.WithOctave forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Int
oct, forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (Int -> (Int, Beat) -> Maybe Expr
exprAtOctave Int
oct) Map Char (Int, Beat)
charToBeat)
        | Int
oct <- [Int
baseOctave forall a. Num a => a -> a -> a
- Int
1 .. Int
baseOctave forall a. Num a => a -> a -> a
+ forall a b. (a, b) -> a
fst (Int, Beat)
maxBeat forall a. Num a => a -> a -> a
- Int
1]
        ]
    | Bool
otherwise = forall a. Map Char a -> NoteEntryMap a
Cmd.WithoutOctave forall a b. (a -> b) -> a -> b
$ (Int, Beat) -> Expr
toExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Char (Int, Beat)
charToBeat
    where
    -- Octave shifts the measure of the beat returned by charToBeat.
    exprAtOctave :: Int -> (Int, Beat) -> Maybe Expr
exprAtOctave Int
octave (Int
measure, Beat
beat)
        | Int
adjusted forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. Maybe a
Nothing
        | (Int
adjusted, Beat
beat) forall a. Ord a => a -> a -> Bool
> (Int, Beat)
maxBeat = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Int, Beat) -> Expr
toExpr (Int
adjusted, Beat
beat)
        where
        -- I originally intended octave to move by 2 measures if 2 measures
        -- fit on a row, but I think I don't mind moving just 1 measure.
        adjusted :: Int
adjusted = (Int
octave forall a. Num a => a -> a -> a
- Int
baseOctave) forall a. Num a => a -> a -> a
+ Int
measure
    maxBeat :: (Int, Beat)
maxBeat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
1, Beat
1) forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map (Int, Beat) Stroke
strokeMap
    charToBeat :: Map Char (Int, Beat)
charToBeat = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Beat)] -> [(Char, (Int, Beat))]
physicalKeys Int
steps [(Int, Beat)]
allBeats
    steps :: Int
steps = forall a b. (RealFrac a, Integral b) => a -> b
floor (Beat
perMeasure forall a. Fractional a => a -> a -> a
/ Beat
increment)
    toExpr :: (Int, Beat) -> Expr
toExpr (Int, Beat)
mbeat = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Int, Beat) -> Expr
makeExpr (Int, Beat)
mbeat) (forall val. Symbol -> Expr val
Expr.generator0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stroke -> Symbol
Expr.Symbol) forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int, Beat)
mbeat Map (Int, Beat) Stroke
strokeMap
    inRange :: (Int, Beat) -> Bool
inRange = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
False) (\((Int, Beat)
m, Stroke
_) -> (forall a. Ord a => a -> a -> Bool
<=(Int, Beat)
m)) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map (Int, Beat) Stroke
strokeMap
    allBeats :: [(Int, Beat)]
allBeats = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int, Beat) -> Bool
inRange
        [ (Int
measure, Beat
beat)
        | Int
measure <- [Int
1..], Beat
beat <- forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' Beat
1 (Beat
perMeasureforall a. Num a => a -> a -> a
+Beat
1) Beat
increment
        ]
    baseOctave :: Int
baseOctave = EditState -> Int
Cmd.state_kbd_entry_octave EditState
Cmd.initial_edit_state

makeExpr :: (Measure, Beat) -> DeriveT.Expr
makeExpr :: (Int, Beat) -> Expr
makeExpr (Int
measure, Beat
beat) = forall val. Call val -> Expr val
Expr.generator forall a b. (a -> b) -> a -> b
$ forall val. Symbol -> [val] -> Call val
Expr.call Symbol
"n" [Double -> Val
DeriveT.num Double
num]
    where num :: Double
num = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
measure forall a. Num a => a -> a -> a
+ forall a b. (Real a, Fractional b) => a -> b
realToFrac (Beat
beat forall a. Fractional a => a -> a -> a
/ Beat
10)
    -- 1.25 -> 0.125

physicalKeys :: Int -> [(Measure, Beat)] -> [(Char, (Measure, Beat))]
physicalKeys :: Int -> [(Int, Beat)] -> [(Char, (Int, Beat))]
physicalKeys Int
steps [(Int, Beat)]
beats = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ forall a b. [a] -> [b] -> [(a, b)]
zip FilePath
keys (forall a b. (a -> b) -> [a] -> [b]
map (Int
measure,) NonNull Beat
beats)
    | (FilePath
keys, (Int
measure, NonNull Beat
beats)) <- forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [FilePath]
keysByMeasure Int
steps) [(Int, NonNull Beat)]
byMeasure
    ]
    where
    byMeasure :: [(Int, NonNull Beat)]
byMeasure = forall a b. Ord a => [(a, b)] -> [(a, NonNull b)]
Lists.groupFst [(Int, Beat)]
beats

-- | Get keys to map for each measure.  This fits an integral measure's worth
-- into the bottom and top rows.
keysByMeasure :: Int -> [[Char]]
keysByMeasure :: Int -> [FilePath]
keysByMeasure Int
steps = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [[a]]
equalDivisions Int
steps) forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall key a. Eq key => (a -> key) -> [a] -> [[a]]
Lists.groupAdjacent (Pitch -> Int
Pitch.pitch_octave forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
    -- '1' is a special case with -1 accidental.
    forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>=Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Int
Pitch.pitch_accidentals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList Map Char Pitch
PhysicalKey.pitch_map

equalDivisions :: Int -> [a] -> [[a]]
equalDivisions :: forall a. Int -> [a] -> [[a]]
equalDivisions Int
n [a]
xs
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
pre forall a. Eq a => a -> a -> Bool
== Int
n = [a]
pre forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [[a]]
equalDivisions Int
n [a]
post
    | Bool
otherwise = []
    where ([a]
pre, [a]
post) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
xs

-- * call

data BpmMode = Pitch | Stretch
    deriving (BpmMode -> BpmMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BpmMode -> BpmMode -> Bool
$c/= :: BpmMode -> BpmMode -> Bool
== :: BpmMode -> BpmMode -> Bool
$c== :: BpmMode -> BpmMode -> Bool
Eq, Int -> BpmMode
BpmMode -> Int
BpmMode -> [BpmMode]
BpmMode -> BpmMode
BpmMode -> BpmMode -> [BpmMode]
BpmMode -> BpmMode -> BpmMode -> [BpmMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BpmMode -> BpmMode -> BpmMode -> [BpmMode]
$cenumFromThenTo :: BpmMode -> BpmMode -> BpmMode -> [BpmMode]
enumFromTo :: BpmMode -> BpmMode -> [BpmMode]
$cenumFromTo :: BpmMode -> BpmMode -> [BpmMode]
enumFromThen :: BpmMode -> BpmMode -> [BpmMode]
$cenumFromThen :: BpmMode -> BpmMode -> [BpmMode]
enumFrom :: BpmMode -> [BpmMode]
$cenumFrom :: BpmMode -> [BpmMode]
fromEnum :: BpmMode -> Int
$cfromEnum :: BpmMode -> Int
toEnum :: Int -> BpmMode
$ctoEnum :: Int -> BpmMode
pred :: BpmMode -> BpmMode
$cpred :: BpmMode -> BpmMode
succ :: BpmMode -> BpmMode
$csucc :: BpmMode -> BpmMode
Enum, BpmMode
forall a. a -> a -> Bounded a
maxBound :: BpmMode
$cmaxBound :: BpmMode
minBound :: BpmMode
$cminBound :: BpmMode
Bounded, Int -> BpmMode -> ShowS
[BpmMode] -> ShowS
BpmMode -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BpmMode] -> ShowS
$cshowList :: [BpmMode] -> ShowS
show :: BpmMode -> FilePath
$cshow :: BpmMode -> FilePath
showsPrec :: Int -> BpmMode -> ShowS
$cshowsPrec :: Int -> BpmMode -> ShowS
Show, BpmMode -> Stroke
forall a. (a -> Stroke) -> ShowVal a
show_val :: BpmMode -> Stroke
$cshow_val :: BpmMode -> Stroke
ShowVal.ShowVal, Proxy BpmMode -> Type
Val -> Checked BpmMode
Track -> Maybe BpmMode
forall a.
(Val -> Checked a)
-> (Proxy a -> Type) -> (Track -> Maybe a) -> Typecheck a
from_subtrack :: Track -> Maybe BpmMode
$cfrom_subtrack :: Track -> Maybe BpmMode
to_type :: Proxy BpmMode -> Type
$cto_type :: Proxy BpmMode -> Type
from_val :: Val -> Checked BpmMode
$cfrom_val :: Val -> Checked BpmMode
Typecheck.Typecheck,
        BpmMode -> Val
forall a. (a -> Val) -> ToVal a
to_val :: BpmMode -> Val
$cto_val :: BpmMode -> Val
Typecheck.ToVal)

-- | Take a beat arg or named start time, and look up the corresponding start
-- offset.
c_break :: Double -> Map Beat Frame -> Beat -> Maybe Frame
    -> Derive.Generator Derive.Note
c_break :: Double -> Map Beat Int -> Beat -> Maybe Int -> Generator Note
c_break Double
naturalBpm Map Beat Int
beatMap Beat
perMeasure Maybe Int
mbFrame =
    forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.instrument CallName
"break" forall a. Monoid a => a
mempty Doc
doc forall a b. (a -> b) -> a -> b
$
    forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call ((,,,,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Beat
beat_arg) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Maybe Int
mbFrame
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"pre" (ScoreTime -> DefaultScore
Typecheck.score ScoreTime
0)
            Doc
"Move note start back by this much, along with the offset."
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"pitch" (Double
0 :: Double) Doc
"Pitch offset."
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"pitch-shift" (Double
0 :: Double)
            Doc
"Pitch offset, not affecting time."
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"bpm" Double
naturalBpm Doc
"Set BPM."
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> deflt -> Doc -> Parser a
Sig.defaulted ArgName
"bpm-mode" BpmMode
Pitch
            Doc
"How to adjust bpm, by changing pitch, or stretching time."
    ) forall a b. (a -> b) -> a -> b
$ \(Either Beat Int
beatOrFrame, Typecheck.DefaultScore Duration
pre, NoteNumber
pitch, Double
pitchShift, Double
bpm,
        BpmMode
bpmMode) ->
    forall d.
(PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver
Sub.inverting forall a b. (a -> b) -> a -> b
$ \PassedArgs Note
args -> do
        Int
frame <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Map Beat Int -> Beat -> Deriver Int
lookupBeat Map Beat Int
beatMap) forall (m :: * -> *) a. Monad m => a -> m a
return Either Beat Int
beatOrFrame
        let (ScoreTime
start, ScoreTime
dur) = forall a. PassedArgs a -> (ScoreTime, ScoreTime)
Args.extent PassedArgs Note
args
        ScoreTime
pre <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime
Call.score_duration ScoreTime
start Duration
pre
        RealTime
rpre <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
Call.real_duration ScoreTime
start ScoreTime
pre
        let (NoteNumber
bpmPitch, Deriver a -> Deriver a
bpmStretch) = forall a.
Double -> Double -> BpmMode -> (NoteNumber, Deriver a -> Deriver a)
adjustBpm Double
naturalBpm Double
bpm BpmMode
bpmMode
        forall a. Control -> Double -> Deriver a -> Deriver a
withControl Control
Control.sampleStartOffset
                (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frame forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (RealTime -> Frames
AUtil.toFrames RealTime
rpre)) forall a b. (a -> b) -> a -> b
$
            forall a. Control -> Double -> Deriver a -> Deriver a
withControl Control
pitchOffset (NoteNumber -> Double
Pitch.nn_to_double (NoteNumber
pitch forall a. Num a => a -> a -> a
+ NoteNumber
bpmPitch)) forall a b. (a -> b) -> a -> b
$
            forall {a}. Deriver a -> Deriver a
bpmStretch forall a b. (a -> b) -> a -> b
$
            forall a. Control -> Double -> Deriver a -> Deriver a
withControl Control
Control.samplePitchShift Double
pitchShift forall a b. (a -> b) -> a -> b
$
            forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a
Derive.place (ScoreTime
start forall a. Num a => a -> a -> a
- ScoreTime
pre) (ScoreTime
dur forall a. Num a => a -> a -> a
+ ScoreTime
pre) NoteDeriver
Call.note
    where
    beat_arg :: Parser Beat
beat_arg = forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"beat" Doc
"Offset measure.beat. This abuses\
        \ decimal notation: 4 -> (1, 4), 4.1 -> (4, 1), 4.15 -> (4, 1.5)."
    doc :: Doc
doc = Doc
"Play a sample at a certain offset."
    lookupBeat :: Map Beat Int -> Beat -> Deriver Int
lookupBeat Map Beat Int
beatMap Beat
beatFraction =
        forall a. HasCallStack => Stroke -> Maybe a -> Deriver a
Derive.require
            (forall a. Pretty a => a -> Stroke
pretty (Int
measure, Beat
beat) forall a. Semigroup a => a -> a -> a
<> Stroke
" out of range: " forall a. Semigroup a => a -> a -> a
<> Stroke
"(1, 1) -- "
                forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Stroke
pretty (forall frame. Map Beat frame -> Beat -> Int
maxBeat Map Beat Int
beatMap Beat
perMeasure, Beat
perMeasure)) forall a b. (a -> b) -> a -> b
$
            if Beat
beat forall a. Ord a => a -> a -> Bool
>= Beat
perMeasure forall a. Num a => a -> a -> a
+ Beat
1 then forall a. Maybe a
Nothing else Map Beat Int -> Beat -> Maybe Int
findFrame Map Beat Int
beatMap Beat
b
            -- beat > perMeasure would work, but it's confusing.
        where
        (Int
measure, Beat
beat) = Beat -> (Int, Beat)
decodeBeat Beat
beatFraction
        b :: Beat
b = forall a. Ord a => a -> a -> a
max Beat
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
measureforall a. Num a => a -> a -> a
-Int
1)) forall a. Num a => a -> a -> a
* Beat
perMeasure forall a. Num a => a -> a -> a
+ Beat
beat

withControl :: Control.Control -> Signal.Y -> Derive.Deriver a
    -> Derive.Deriver a
withControl :: forall a. Control -> Double -> Deriver a -> Deriver a
withControl Control
control =
    forall a. Control -> Double -> Deriver a -> Deriver a
Derive.with_constant_control (Control -> Control
Controls.from_shared Control
control)

adjustBpm :: Double -> Double -> BpmMode
    -> (Pitch.NoteNumber, Derive.Deriver a -> Derive.Deriver a)
adjustBpm :: forall a.
Double -> Double -> BpmMode -> (NoteNumber, Deriver a -> Deriver a)
adjustBpm Double
naturalBpm Double
bpm = \case
    BpmMode
Pitch -> (Double -> Double -> NoteNumber
bpmPitchAdjust Double
naturalBpm Double
bpm, forall a. a -> a
id)
    BpmMode
Stretch -> (NoteNumber
0,) forall a b. (a -> b) -> a -> b
$ forall a. Control -> Double -> Deriver a -> Deriver a
withControl Control
Control.sampleTimeStretch (Double
naturalBpm forall a. Fractional a => a -> a -> a
/ Double
bpm)

-- bpm to *2 means +12
-- bpm / naturalBpm = 2 => ratio
bpmPitchAdjust :: Double -> Double -> Pitch.NoteNumber
bpmPitchAdjust :: Double -> Double -> NoteNumber
bpmPitchAdjust Double
naturalBpm Double
bpm = Double -> NoteNumber
Sample.ratioToPitch forall a b. (a -> b) -> a -> b
$ Double
bpm forall a. Fractional a => a -> a -> a
/ Double
naturalBpm

maxBeat :: Map Beat frame -> Beat -> Int
maxBeat :: forall frame. Map Beat frame -> Beat -> Int
maxBeat Map Beat frame
beatMap Beat
perMeasure =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Beat
perMeasure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Beat frame
beatMap)

-- |
-- 6.0 -> (1, 6)
-- 1.6 -> (1, 6)
-- 6.1 -> (6, 1)
-- 6.125 -> (6, 1.25)
decodeBeat :: Beat -> (Measure, Beat)
decodeBeat :: Beat -> (Int, Beat)
decodeBeat Beat
beatFraction
    | Beat
beat forall a. Eq a => a -> a -> Bool
== Beat
0 = (Int
1, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
measure)
    | Bool
otherwise =
        ( if Int
measure forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int
measure
        , if Beat
beat forall a. Eq a => a -> a -> Bool
== Beat
0 then Beat
1 else Beat
beat forall a. Num a => a -> a -> a
* Beat
10
        )
    where
    (Int
measure, Beat
beat) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Beat
beatFraction

pitchOffset :: Control.Control
pitchOffset :: Control
pitchOffset = Control
"pitch-offset"

convert :: FilePath -> Pitch.NoteNumber -> Note.Note
    -> Patch.ConvertM Sample.Sample
convert :: FilePath -> NoteNumber -> Note -> ConvertM Sample
convert FilePath
filename NoteNumber
pitchAdjust Note
note = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (FilePath -> Sample
Sample.make FilePath
filename)
    { envelope :: Signal
Sample.envelope = Double -> RealTime -> Note -> Signal
Util.dynEnvelope Double
minDyn RealTime
0.15 Note
note
    , offset :: Frames
Sample.offset = Frames
offset
    , ratios :: Signal
Sample.ratios = forall {k} (kind :: k). Double -> Signal kind
Signal.constant forall a b. (a -> b) -> a -> b
$
        NoteNumber -> Double
Sample.relativePitchToRatio (forall a. Real a => a -> NoteNumber
Pitch.nn Double
pitch forall a. Num a => a -> a -> a
+ NoteNumber
pitchAdjust)
    , stretch :: Stretch
Sample.stretch = Sample.Stretch
        { stretchMode :: StretchMode
stretchMode = StretchMode
Sample.StretchPercussive
        , timeRatio :: Double
timeRatio = forall a. a -> Maybe a -> a
fromMaybe Double
1 forall a b. (a -> b) -> a -> b
$
            Control -> Note -> Maybe Double
Note.initial Control
Control.sampleTimeStretch Note
note
        , pitchRatio :: Double
pitchRatio =
            forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
1 (forall a. Fractional a => a -> a
recip forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoteNumber -> Double
Sample.relativePitchToRatio forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> NoteNumber
Pitch.nn) forall a b. (a -> b) -> a -> b
$
            Control -> Note -> Maybe Double
Note.initial Control
Control.samplePitchShift Note
note
        }
    }
    where
    offset :: Frames
offset = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Control -> Note -> Double
Note.initial0 Control
Control.sampleStartOffset Note
note
    pitch :: Double
pitch = Control -> Note -> Double
Note.initial0 Control
pitchOffset Note
note

minDyn :: Signal.Y
minDyn :: Double
minDyn = Double
0.5

findFrame :: Map Beat Frame -> Beat -> Maybe Frame
findFrame :: Map Beat Int -> Beat -> Maybe Int
findFrame Map Beat Int
beats Beat
beat = case Maybe Int
at of
    Just Int
frame -> forall a. a -> Maybe a
Just Int
frame
    Maybe Int
Nothing -> case (forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map Beat Int
below, forall k a. Map k a -> Maybe (k, a)
Map.lookupMin Map Beat Int
above) of
        (Just (Beat
beat0, Int
frame0), Just (Beat
beat1, Int
frame1)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Int -> Double
Num.i2d Int
frame0) (Int -> Double
Num.i2d Int
frame1) forall a b. (a -> b) -> a -> b
$
                forall a. (Eq a, Fractional a) => a -> a -> a -> a
Num.normalize (Beat -> Double
d Beat
beat0) (Beat -> Double
d Beat
beat1) (Beat -> Double
d Beat
beat)
        (Maybe (Beat, Int), Maybe (Beat, Int))
_ -> forall a. Maybe a
Nothing
    where
    (Map Beat Int
below, Maybe Int
at, Map Beat Int
above) = forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup Beat
beat Map Beat Int
beats
    d :: Beat -> Double
d = forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Beat -> Double


-- * implementation

type Measure = Int
type Beat = Ratio.Ratio Int
type Frame = Int
type Stroke = Text

addMeasures :: [(Beat, Stroke, Frame)] -> [((Measure, Beat), Stroke, Frame)]
addMeasures :: [(Beat, Stroke, Int)] -> [((Int, Beat), Stroke, Int)]
addMeasures = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall {a} {b} {b} {c}. (a, [(b, b, c)]) -> [((a, b), b, c)]
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
Lists.splitBetween (\(Beat
a, Stroke
_, Int
_) (Beat
b, Stroke
_, Int
_) -> Beat
b forall a. Ord a => a -> a -> Bool
< Beat
a)
    where
    add :: (a, [(b, b, c)]) -> [((a, b), b, c)]
add (a
m, [(b, b, c)]
beats) =
        [((a
m, b
beat), b
stroke, c
frame) | (b
beat, b
stroke, c
frame) <- [(b, b, c)]
beats]

-- | Make Strokes unique by labelling them according to position in the
-- measure.
labelStrokes :: [((Measure, Beat), Stroke, frame)]
    -> [((Measure, Beat), Stroke, frame)]
labelStrokes :: forall frame.
[((Int, Beat), Stroke, frame)] -> [((Int, Beat), Stroke, frame)]
labelStrokes = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \((Int
measure, Beat
beat), Stroke
stroke, frame
frame) ->
    ((Int
measure, Beat
beat), Stroke
stroke forall a. Semigroup a => a -> a -> a
<> forall {a}. Show a => a -> Beat -> Stroke
suffix Int
measure Beat
beat, frame
frame)
    where
    suffix :: a -> Beat -> Stroke
suffix a
measure Beat
beat = forall a. Show a => a -> Stroke
showt a
measure
        forall a. Semigroup a => a -> a -> a
<> if Beat
beat forall a. Eq a => a -> a -> Bool
== Beat
1 then Stroke
"" else Stroke
"-" forall a. Semigroup a => a -> a -> a
<> Beat -> Stroke
encode Beat
beat
    encode :: Beat -> Stroke
encode = (Char -> Bool) -> Stroke -> Stroke
Text.dropWhileEnd (forall a. Eq a => a -> a -> Bool
==Char
'0') forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Stroke -> Stroke -> Stroke -> Stroke
Text.replace Stroke
"." Stroke
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Stroke
showt
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Beat -> Double)

makeBeatMap :: Break -> Map Beat Frame
makeBeatMap :: Break -> Map Beat Int
makeBeatMap Break
break = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
measureforall a. Num a => a -> a -> a
-Int
1) forall a. Num a => a -> a -> a
* Break -> Beat
_perMeasure Break
break forall a. Num a => a -> a -> a
+ Beat
beat, Int
frame)
    | ((Int
measure, Beat
beat), Stroke
_, Int
frame) <- Break -> [((Int, Beat), Stroke, Int)]
_beats Break
break
    ]

-- * bpm

-- | For use from ghci.
_printBpms :: IO ()
_printBpms :: IO ()
_printBpms = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Break]
allBreaks forall a b. (a -> b) -> a -> b
$ \Break
break -> do
    Stroke -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Stroke
"---- " forall a. Semigroup a => a -> a -> a
<> Break -> Stroke
_name Break
break
    Stroke -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Break -> Stroke
showBpms Break
break

-- | Get inferred bpm from each stroke.
showBpms :: Break -> Text
showBpms :: Break -> Stroke
showBpms Break
break =
    [Stroke] -> Stroke
Text.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++[forall a. [a] -> a
last [Stroke]
strokes, Stroke
bpm]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. RealFloat a => (Stroke, a) -> Stroke
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Stroke]
strokes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Break -> [Double]
breakBpms forall a b. (a -> b) -> a -> b
$
        Break
break
    where
    bpm :: Stroke
bpm = Stroke
"Inferred BPM: " forall a. Semigroup a => a -> a -> a
<> forall a. RealFloat a => Int -> a -> Stroke
Num.showFloat Int
2 (Break -> Double
breakBpm Break
break)
    fmt :: (Stroke, a) -> Stroke
fmt (Stroke
stroke, a
bpm) =
        Int -> Char -> Stroke -> Stroke
Text.justifyLeft Int
8 Char
' ' Stroke
stroke forall a. Semigroup a => a -> a -> a
<> Stroke
" - " forall a. Semigroup a => a -> a -> a
<> forall a. RealFloat a => Int -> a -> Stroke
Num.showFloat Int
2 a
bpm
    strokes :: [Stroke]
strokes = [Stroke
stroke | ((Int, Beat)
_, Stroke
stroke, Int
_) <- Break -> [((Int, Beat), Stroke, Int)]
_beats Break
break]

breakBpm :: Break -> Double
breakBpm :: Break -> Double
breakBpm = [Double] -> Double
centralMean forall b c a. (b -> c) -> (a -> b) -> a -> c
. Break -> [Double]
breakBpms

-- | Try to get a good mean by discarding outliers.
centralMean :: [Double] -> Double
centralMean :: [Double] -> Double
centralMean [Double]
bpms = forall {a} {t :: * -> *}. (Fractional a, Foldable t) => t a -> a
mean forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool
outlier) [Double]
bpms
    where
    mean :: t a -> a
mean t a
xs = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum t a
xs forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs)
    outlier :: Double -> Bool
outlier Double
bpm = Double
bpm forall a. Ord a => a -> a -> Bool
< Double
low forall a. Num a => a -> a -> a
+ Double
quartile Bool -> Bool -> Bool
|| Double
bpm forall a. Ord a => a -> a -> Bool
> Double
high forall a. Num a => a -> a -> a
- Double
quartile
    quartile :: Double
quartile = (Double
high forall a. Num a => a -> a -> a
- Double
low) forall a. Fractional a => a -> a -> a
/ Double
4
    low :: Double
low = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
bpms
    high :: Double
high = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
bpms

breakBpms :: Break -> [Double]
breakBpms :: Break -> [Double]
breakBpms Break
break = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a}. (Integral a, Real a) => ((a, a), (a, a)) -> Double
guess forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [b] -> [(b, b)]
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Break -> Map Beat Int
makeBeatMap forall a b. (a -> b) -> a -> b
$ Break
break
    where
    guess :: ((a, a), (a, a)) -> Double
guess ((a
beat0, a
frame0), (a
beat1, a
frame1)) = (Double
60/) forall a b. (a -> b) -> a -> b
$
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
frame1 forall a. Num a => a -> a -> a
- a
frame0) forall a. Fractional a => a -> a -> a
/ forall a b. (Real a, Fractional b) => a -> b
realToFrac (a
beat1 forall a. Num a => a -> a -> a
- a
beat0))
            forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Config.samplingRate
            forall a. Num a => a -> a -> a
* Double
ratioAdjust
    ratioAdjust :: Double
ratioAdjust = NoteNumber -> Double
Sample.relativePitchToRatio (Break -> NoteNumber
_pitchAdjust Break
break)
    pairs :: [b] -> [(b, b)]
pairs [b]
xs = forall a b. [a] -> [b] -> [(a, b)]
zip [b]
xs (forall a. Int -> [a] -> [a]
drop Int
1 [b]
xs)

data Break = Break {
    Break -> Stroke
_name :: Text
    , Break -> [((Int, Beat), Stroke, Int)]
_beats :: ![((Measure, Beat), Stroke, Frame)]
    , Break -> Beat
_perMeasure :: !Beat
    , Break -> Beat
_increment :: !Beat
    , Break -> NoteNumber
_pitchAdjust :: !Pitch.NoteNumber
    } deriving (Int -> Break -> ShowS
[Break] -> ShowS
Break -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Break] -> ShowS
$cshowList :: [Break] -> ShowS
show :: Break -> FilePath
$cshow :: Break -> FilePath
showsPrec :: Int -> Break -> ShowS
$cshowsPrec :: Int -> Break -> ShowS
Show)

makeBreak :: Text -> Beat -> [(Beat, Stroke, Frame)] -> Break
makeBreak :: Stroke -> Beat -> [(Beat, Stroke, Int)] -> Break
makeBreak Stroke
name Beat
perMeasure [(Beat, Stroke, Int)]
beats = Break
    { _name :: Stroke
_name = Stroke
name
    , _beats :: [((Int, Beat), Stroke, Int)]
_beats = forall frame.
[((Int, Beat), Stroke, frame)] -> [((Int, Beat), Stroke, frame)]
labelStrokes ([(Beat, Stroke, Int)] -> [((Int, Beat), Stroke, Int)]
addMeasures [(Beat, Stroke, Int)]
beats)
    , _perMeasure :: Beat
_perMeasure = Beat
perMeasure
    , _increment :: Beat
_increment = Beat
1forall a. Fractional a => a -> a -> a
/Beat
2
    , _pitchAdjust :: NoteNumber
_pitchAdjust = NoteNumber
0
    }

pitchAdjust :: Pitch.NoteNumber -> Break -> Break
pitchAdjust :: NoteNumber -> Break -> Break
pitchAdjust NoteNumber
nn Break
break = Break
break { _pitchAdjust :: NoteNumber
_pitchAdjust = NoteNumber
nn }

bd, sn, hh :: Stroke
bd :: Stroke
bd = Stroke
"bd"
sn :: Stroke
sn = Stroke
"sn"
hh :: Stroke
hh = Stroke
"hh"

allBreaks :: [Break]
allBreaks :: [Break]
allBreaks = [Break
medeski, Break
amen, Break
massaker1, Break
massaker2]

medeski :: Break
medeski :: Break
medeski = Stroke -> Beat -> [(Beat, Stroke, Int)] -> Break
makeBreak Stroke
"medeski" Beat
8
    [ (Beat
1,   Stroke
bd, Int
0)
    , (Beat
2,   Stroke
sn, Int
20296)
    , (Beat
3.5, Stroke
bd, Int
49024)
    , (Beat
4.5, Stroke
sn, Int
68024)
    , (Beat
6,   Stroke
sn, Int
95982)
    , (Beat
7.5, Stroke
bd, Int
124482)
    , (Beat
8,   Stroke
sn, Int
133878)
    , (Beat
8.5, Stroke
bd, Int
143584)

    , (Beat
1,   Stroke
bd, Int
152834)
    , (Beat
2,   Stroke
sn, Int
172572)
    , (Beat
3.5, Stroke
bd, Int
201002)
    , (Beat
4.5, Stroke
sn, Int
220438)
    , (Beat
6,   Stroke
sn, Int
248210)
    , (Beat
7.5, Stroke
bd, Int
275986)

    , (Beat
1,   Stroke
bd, Int
303488)
    , (Beat
2,   Stroke
sn, Int
322988)
    , (Beat
3.5, Stroke
bd, Int
351232)
    , (Beat
4.5, Stroke
sn, Int
370402)
    , (Beat
6,   Stroke
sn, Int
398044)
    , (Beat
7.5, Stroke
bd, Int
426150)
    , (Beat
8,   Stroke
sn, Int
435612)
    , (Beat
8.5, Stroke
bd, Int
445314)

    , (Beat
1,   Stroke
bd, Int
454530)
    , (Beat
2,   Stroke
sn, Int
473836)
    , (Beat
3.5, Stroke
bd, Int
502050)
    , (Beat
4.5, Stroke
sn, Int
521034)
    , (Beat
5,   Stroke
bd, Int
529638)

    , (Beat
1,   Stroke
bd, Int
604380)
    ]

amen :: Break
amen :: Break
amen = Stroke -> Beat -> [(Beat, Stroke, Int)] -> Break
makeBreak Stroke
"amen" Beat
4
    [ (Beat
1,   Stroke
bd, Int
0)
    , (Beat
2,   Stroke
sn, Int
19594)
    , (Beat
3.5, Stroke
bd, Int
48536)
    , (Beat
4,   Stroke
sn, Int
57820)
    , (Beat
1,   Stroke
bd, Int
77630)
    , (Beat
2,   Stroke
sn, Int
97128)
    , (Beat
3.5, Stroke
bd, Int
125932)
    , (Beat
4,   Stroke
sn, Int
135294)
    , (Beat
1,   Stroke
bd, Int
154792)
    , (Beat
2,   Stroke
sn, Int
174050)
    , (Beat
3.5, Stroke
bd, Int
202312)
    , (Beat
4.5, Stroke
sn, Int
221422)
    , (Beat
2,   Stroke
sn, Int
249952)
    , (Beat
3.5, Stroke
bd, Int
278326)
    , (Beat
4.5, Stroke
sn, Int
297470)
    ]

massaker1 :: Break
massaker1 :: Break
massaker1 = NoteNumber -> Break -> Break
pitchAdjust (-NoteNumber
12) forall a b. (a -> b) -> a -> b
$ Stroke -> Beat -> [(Beat, Stroke, Int)] -> Break
makeBreak Stroke
"massaker1" Beat
4
    [ (Beat
1,   Stroke
bd, Int
0)
    , (Beat
2,   Stroke
sn, Int
7880)
    , (Beat
3.5, Stroke
bd, Int
19790)
    , (Beat
4,   Stroke
sn, Int
23704)
    , (Beat
1.5, Stroke
bd, Int
35640)
    , (Beat
2,   Stroke
sn, Int
39600)
    , (Beat
3.5, Stroke
bd, Int
51480)
    , (Beat
4,   Stroke
sn, Int
55348)
    ]

massaker2 :: Break
massaker2 :: Break
massaker2 = NoteNumber -> Break -> Break
pitchAdjust (-NoteNumber
12) forall a b. (a -> b) -> a -> b
$ Stroke -> Beat -> [(Beat, Stroke, Int)] -> Break
makeBreak Stroke
"massaker2" Beat
4
    [ (Beat
1,   Stroke
bd, Int
0)
    , (Beat
2,   Stroke
bd, Int
7682)
    , (Beat
3,   Stroke
sn, Int
15530)
    , (Beat
4.5, Stroke
sn, Int
27062)
    , (Beat
1,   Stroke
hh, Int
31070)
    , (Beat
2,   Stroke
sn, Int
38532)
    , (Beat
3,   Stroke
sn, Int
45738)
    , (Beat
4,   Stroke
hh, Int
53672)
    , (Beat
4.5, Stroke
sn, Int
57217)
    ]