-- Copyright 2013 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

-- | Data for creating drum instruments.  It has few dependencies so it can
-- be imported by both Local.Instrument definitions and Derive.Call instrument
-- calls.
module Cmd.Instrument.Drums where
import qualified Util.Pretty as Pretty
import qualified Derive.Attrs as Attrs
import qualified Derive.Expr as Expr
import qualified Perform.Signal as Signal

import           Derive.Attrs
import           Global


-- | Description of a generic drum set.  There are many drum set instruments,
-- each of which probably use different MIDI keys, but at least I can
-- standardize call names, attributes, and keymap key.  Of course there will be
-- drum sets that don't fit in (e.g. have two or three snares), but at least
-- this provides a standard base.
data Stroke = Stroke {
    Stroke -> Symbol
_name :: !Expr.Symbol
    , Stroke -> Attributes
_attributes :: !Attributes
    -- | Bind the stroke to this key in insert mode.  If it is ' ', don't bind
    -- to a key at all.  This should be called "key", but that's sometimes
    -- already taken for midi key.
    , Stroke -> Char
_char :: !Char
    -- | Scale the dynamic by this value.  This is for drums that have
    -- different symbols for soft strokes.
    , Stroke -> Y
_dynamic :: !Signal.Y
    , Stroke -> Group
_group :: !Group
    } deriving (Stroke -> Stroke -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stroke -> Stroke -> Bool
$c/= :: Stroke -> Stroke -> Bool
== :: Stroke -> Stroke -> Bool
$c== :: Stroke -> Stroke -> Bool
Eq, Int -> Stroke -> ShowS
[Stroke] -> ShowS
Stroke -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stroke] -> ShowS
$cshowList :: [Stroke] -> ShowS
show :: Stroke -> String
$cshow :: Stroke -> String
showsPrec :: Int -> Stroke -> ShowS
$cshowsPrec :: Int -> Stroke -> ShowS
Show)

-- | An arbitrary symbol.  A group can stop other groups from sounding.
type Group = Text

-- | Pair each stopping group with the list of groups it stops.
type Stops = [(Group, [Group])]

stroke :: Char -> Expr.Symbol -> Attributes -> Stroke
stroke :: Char -> Symbol -> Attributes -> Stroke
stroke Char
char Symbol
name Attributes
attrs = Stroke
    { _name :: Symbol
_name = Symbol
name
    , _attributes :: Attributes
_attributes = Attributes
attrs
    , _char :: Char
_char = Char
char
    , _dynamic :: Y
_dynamic = Y
1
    , _group :: Group
_group = Group
""
    }

stroke_dyn :: Char -> Expr.Symbol -> Attributes -> Signal.Y -> Stroke
stroke_dyn :: Char -> Symbol -> Attributes -> Y -> Stroke
stroke_dyn Char
char Symbol
name Attributes
attrs Y
dyn = (Char -> Symbol -> Attributes -> Stroke
stroke Char
char Symbol
name Attributes
attrs) { _dynamic :: Y
_dynamic = Y
dyn }

instance Pretty Stroke where
    format :: Stroke -> Doc
format (Stroke Symbol
name Attributes
attrs Char
char Y
dyn Group
group) = Doc -> [(Group, Doc)] -> Doc
Pretty.record Doc
"Stroke"
        [ (Group
"name", forall a. Pretty a => a -> Doc
Pretty.format Symbol
name)
        , (Group
"attrs", forall a. Pretty a => a -> Doc
Pretty.format Attributes
attrs)
        , (Group
"char", forall a. Pretty a => a -> Doc
Pretty.format Char
char)
        , (Group
"dynamic", forall a. Pretty a => a -> Doc
Pretty.format Y
dyn)
        , (Group
"group", forall a. Pretty a => a -> Doc
Pretty.format Group
group)
        ]

c_bd2 :: Stroke
c_bd2   = Char -> Symbol -> Attributes -> Stroke
stroke Char
'a' Symbol
"bd2"    (Attributes
bd forall a. Semigroup a => a -> a -> a
<> Attributes
v2)
c_bd :: Stroke
c_bd    = Char -> Symbol -> Attributes -> Stroke
stroke Char
'z' Symbol
"bd"     Attributes
bd
c_sn2 :: Stroke
c_sn2   = Char -> Symbol -> Attributes -> Stroke
stroke Char
's' Symbol
"sn2"    (Attributes
snare forall a. Semigroup a => a -> a -> a
<> Attributes
v2)
c_sn :: Stroke
c_sn    = Char -> Symbol -> Attributes -> Stroke
stroke Char
'x' Symbol
"sn"     Attributes
snare
c_rim :: Stroke
c_rim   = Char -> Symbol -> Attributes -> Stroke
stroke Char
'v' Symbol
"rim"    Attributes
rim
c_ltom :: Stroke
c_ltom  = Char -> Symbol -> Attributes -> Stroke
stroke Char
'b' Symbol
"ltom"   (Attributes
tom forall a. Semigroup a => a -> a -> a
<> Attributes
low)
c_mtom :: Stroke
c_mtom  = Char -> Symbol -> Attributes -> Stroke
stroke Char
'n' Symbol
"mtom"   (Attributes
tom forall a. Semigroup a => a -> a -> a
<> Attributes
middle)
c_hmtom :: Stroke
c_hmtom = Char -> Symbol -> Attributes -> Stroke
stroke Char
'j' Symbol
"hmtom"  (Attributes
tom forall a. Semigroup a => a -> a -> a
<> Group -> Attributes
Attrs.attr Group
"high-mid")
c_htom :: Stroke
c_htom  = Char -> Symbol -> Attributes -> Stroke
stroke Char
'm' Symbol
"htom"   (Attributes
tom forall a. Semigroup a => a -> a -> a
<> Attributes
high)

-- Also doubles as closed hh, if both exist.
c_hh :: Stroke
c_hh    = Char -> Symbol -> Attributes -> Stroke
stroke Char
'q' Symbol
"hh"     Attributes
hh
c_ohh :: Stroke
c_ohh   = Char -> Symbol -> Attributes -> Stroke
stroke Char
'w' Symbol
"ohh"    (Attributes
open forall a. Semigroup a => a -> a -> a
<> Attributes
hh)
c_phh :: Stroke
c_phh   = Char -> Symbol -> Attributes -> Stroke
stroke Char
'e' Symbol
"phh"    (Attributes
pedal forall a. Semigroup a => a -> a -> a
<> Attributes
hh)

c_ride :: Stroke
c_ride  = Char -> Symbol -> Attributes -> Stroke
stroke Char
't' Symbol
"ride"   Attributes
ride
c_bell :: Stroke
c_bell  = Char -> Symbol -> Attributes -> Stroke
stroke Char
'5' Symbol
"bell"   (Group -> Attributes
Attrs.attr Group
"bell")
c_crash :: Stroke
c_crash = Char -> Symbol -> Attributes -> Stroke
stroke Char
'y' Symbol
"crash"  Attributes
crash

-- TODO other drum style ornaments like double strikes, rolls, etc.