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

-- | Instrument definitions for kendang Bali, shared between instruments.
module Cmd.Instrument.KendangBali where
import qualified Data.Set as Set

import qualified Cmd.Cmd as Cmd
import qualified Cmd.Instrument.CUtil as CUtil
import qualified Cmd.Instrument.Drums as Drums
import qualified Cmd.Instrument.MidiInst as MidiInst

import qualified Derive.Attrs as Attrs
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.Eval as Eval
import qualified Derive.Expr as Expr
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.Sig as Sig
import qualified Derive.Stream as Stream


-- * code

pasang_code :: MidiInst.Code
pasang_code :: Code
pasang_code =
    [(Symbol, Transformer Note)] -> Code
MidiInst.note_transformers [(Symbol
"realize", Transformer Note
c_realize_kendang)]
    forall a. Semigroup a => a -> a -> a
<> [(Symbol, Generator Note)] -> Code
MidiInst.note_generators [(Symbol, Generator Note)]
c_pasang_calls
    forall a. Semigroup a => a -> a -> a
<> HandlerId -> Code
MidiInst.cmd forall (m :: * -> *). M m => Handler m
pasang_cmd

-- * tunggal

-- TODO the kontakt one uses CUtil.resolve_strokes, which also takes a keymap
-- and checks for collisions... but I think I don't need it for im?
tunggal_strokes :: [Drums.Stroke]
tunggal_strokes :: [Stroke]
tunggal_strokes = do
    (Char
key, note :: Note
note@(Note Stroke
_ Attributes
attrs), Text
group) <- [(Char, Note, Text)]
tunggal_table
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Drums.Stroke
        { _name :: Symbol
_name = Note -> Symbol
to_call Note
note
        , _attributes :: Attributes
_attributes = Attributes
attrs
        , _char :: Char
_char = Char
key
        , _dynamic :: Y
_dynamic = if Attributes -> Attributes -> Bool
Attrs.contain Attributes
attrs Attributes
Attrs.soft then Y
soft_dyn else Y
1
        , _group :: Text
_group = Text
group
        }

soft_dyn :: Double
soft_dyn :: Y
soft_dyn = Y
0.4

tunggal_table :: [(Char, Note, Drums.Group)]
stops :: Drums.Stops
(Stops
stops, [(Char, Note, Text)]
tunggal_table) = (Stops
stops,) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a} {c}. (a, Stroke, Attributes, c) -> (a, Note, c)
to_note
    [ (Char
'b', Stroke
Plak, Attributes
plak,         Text
both)
    -- left
    , (Char
'1', Stroke
Pak, Attributes
pak forall a. Semigroup a => a -> a -> a
<> Attributes
soft,   Text
left_closed)
    , (Char
'q', Stroke
Pak, Attributes
pak,           Text
left_closed)
    , (Char
'w', Stroke
Pang, Attributes
pang,         Text
left_open)
    , (Char
'3', Stroke
TutL, Attributes
left forall a. Semigroup a => a -> a -> a
<> Attributes
tut forall a. Semigroup a => a -> a -> a
<> Attributes
soft,  Text
left_open)
    , (Char
'e', Stroke
TutL, Attributes
left forall a. Semigroup a => a -> a -> a
<> Attributes
tut,  Text
left_open)
    , (Char
'r', Stroke
DeL, Attributes
left forall a. Semigroup a => a -> a -> a
<> Attributes
de,    Text
left_open)
    -- right
    , (Char
'a', Stroke
De, Attributes
de forall a. Semigroup a => a -> a -> a
<> Attributes
soft,     Text
right_open)
    , (Char
'z', Stroke
De, Attributes
de,             Text
right_open)
    , (Char
's', Stroke
De, Attributes
de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.thumb,    Text
right_open)
    , (Char
'd', Stroke
De, Attributes
de forall a. Semigroup a => a -> a -> a
<> Attributes
Attrs.staccato, Text
right_open)
    , (Char
'x', Stroke
Tut, Attributes
tut,           Text
right_open)
    , (Char
'c', Stroke
Ka, Attributes
ka forall a. Semigroup a => a -> a -> a
<> Attributes
soft,     Text
right_closed)
    , (Char
'f', Stroke
Ka, Attributes
ka,             Text
right_closed)
    , (Char
'.', Stroke
Dag, Attributes
dag,           Text
right_open)
    , (Char
'l', Stroke
Dag, Attributes
dag forall a. Semigroup a => a -> a -> a
<> Attributes
soft,   Text
right_open)
    , (Char
'/', Stroke
Tek, Attributes
tek,           Text
right_closed)
    , (Char
';', Stroke
Tek, Attributes
tek forall a. Semigroup a => a -> a -> a
<> Attributes
soft,   Text
right_closed)
    ]
    where
    to_note :: (a, Stroke, Attributes, c) -> (a, Note, c)
to_note (a
key, Stroke
stroke, Attributes
attrs, c
group) = (a
key, Stroke -> Attributes -> Note
Note Stroke
stroke Attributes
attrs, c
group)
    left :: Attributes
left = Attributes
Attrs.left
    soft :: Attributes
soft = Attributes
Attrs.soft
    stops :: Stops
stops =
        [ (Text
both, [Text
left_open, Text
right_open])
        , (Text
left_closed, [Text
left_open])
        , (Text
right_closed, [Text
right_open])
        ]
    both :: Text
both = Text
"both"
    left_closed :: Text
left_closed = Text
"left-closed"
    left_open :: Text
left_open = Text
"left-open"
    right_closed :: Text
right_closed = Text
"right-closed"
    right_open :: Text
right_open = Text
"right-open"

to_call :: Note -> Expr.Symbol
to_call :: Note -> Symbol
to_call (Note Stroke
stroke Attributes
attrs) = Text -> Symbol
Expr.Symbol forall a b. (a -> b) -> a -> b
$ case Stroke
stroke of
    Stroke
Plak -> Text
"PL"
    -- left
    Stroke
Pak -> if Bool
soft then Text
"^" else Text
"P"
    Stroke
Pang -> Text
"T"
    Stroke
TutL -> if Bool
soft then Text
"ø" else Text
"Ø"
    Stroke
DeL -> Text
"`O+`"
    -- right
    Stroke
Ka -> if Bool
soft then Text
"." else Text
".."
    Stroke
Tut -> Text
"o"
    Stroke
De
        | Bool
soft -> Text
"-"
        | Attributes -> Bool
has Attributes
Attrs.thumb -> Text
"+."
        | Attributes -> Bool
has Attributes
Attrs.staccato -> Text
"+/"
        | Bool
otherwise -> Text
"+"
    Stroke
Dag -> if Bool
soft then Text
"-<" else Text
"<"
    Stroke
Tek -> if Bool
soft then Text
"-[" else Text
"["
    where
    has :: Attributes -> Bool
has = Attributes -> Attributes -> Bool
Attrs.contain Attributes
attrs
    soft :: Bool
soft = Attributes -> Attributes -> Bool
Attrs.contain Attributes
attrs Attributes
Attrs.soft

-- * pasang

data Pasang = Pasang { Pasang -> Instrument
wadon :: ScoreT.Instrument, Pasang -> Instrument
lanang :: ScoreT.Instrument }
    deriving (Int -> Pasang -> ShowS
[Pasang] -> ShowS
Pasang -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pasang] -> ShowS
$cshowList :: [Pasang] -> ShowS
show :: Pasang -> String
$cshow :: Pasang -> String
showsPrec :: Int -> Pasang -> ShowS
$cshowsPrec :: Int -> Pasang -> ShowS
Show)

pasang_env :: Sig.Parser Pasang
pasang_env :: Parser Pasang
pasang_env = Instrument -> Instrument -> Pasang
Pasang
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Typecheck a =>
ArgName -> EnvironDefault -> Doc -> Parser a
Sig.required_environ ArgName
"wadon" EnvironDefault
Sig.Unprefixed Doc
"Wadon instrument."
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
Typecheck a =>
ArgName -> EnvironDefault -> Doc -> Parser a
Sig.required_environ ArgName
"lanang" EnvironDefault
Sig.Unprefixed Doc
"Lanang instrument."

pasang_cmd :: Cmd.M m => Cmd.Handler m
pasang_cmd :: forall (m :: * -> *). M m => Handler m
pasang_cmd = forall (m :: * -> *). M m => Thru -> [(Char, Symbol)] -> Handler m
CUtil.insert_call Thru
CUtil.MidiThru
    [(Char
char, Symbol
name) | (Char
char, Symbol
name, PasangStroke
_) <- [(Char, Symbol, PasangStroke)]
pasang_calls]

c_pasang_calls :: [(Expr.Symbol, Derive.Generator Derive.Note)]
c_pasang_calls :: [(Symbol, Generator Note)]
c_pasang_calls =
    [ (Symbol
name, Symbol -> PasangStroke -> Generator Note
c_pasang_stroke Symbol
name PasangStroke
stroke)
    | (Symbol
name, PasangStroke
stroke) <- forall a b. (a -> b) -> [a] -> [b]
map (\(Char
_, Symbol
a, PasangStroke
b) -> (Symbol
a, PasangStroke
b)) [(Char, Symbol, PasangStroke)]
pasang_calls forall a. [a] -> [a] -> [a]
++ [(Symbol, PasangStroke)]
both_calls
    ]

c_pasang_stroke :: Expr.Symbol -> PasangStroke -> Derive.Generator Derive.Note
c_pasang_stroke :: Symbol -> PasangStroke -> Generator Note
c_pasang_stroke Symbol
sym PasangStroke
pstroke = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.instrument
    (Symbol -> CallName
Derive.sym_to_call_name Symbol
sym) Tags
Tags.inst Doc
"Dispatch to wadon or lanang." 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 Parser Pasang
pasang_env forall {d}.
(Semigroup (Deriver (Stream d)), Callable (Generator d)) =>
Pasang -> PassedArgs d -> Deriver (Stream d)
call
    where
    call :: Pasang -> PassedArgs d -> Deriver (Stream d)
call Pasang
pasang PassedArgs d
args = case PasangStroke
pstroke of
        Wadon Note
note -> (Pasang -> Instrument) -> Note -> Deriver (Stream d)
dispatch Pasang -> Instrument
wadon Note
note
        Lanang Note
note -> (Pasang -> Instrument) -> Note -> Deriver (Stream d)
dispatch Pasang -> Instrument
lanang Note
note
        Both Note
w Note
l -> (Pasang -> Instrument) -> Note -> Deriver (Stream d)
dispatch Pasang -> Instrument
wadon Note
w forall a. Semigroup a => a -> a -> a
<> (Pasang -> Instrument) -> Note -> Deriver (Stream d)
dispatch Pasang -> Instrument
lanang Note
l
        where
        dispatch :: (Pasang -> Instrument) -> Note -> Deriver (Stream d)
dispatch Pasang -> Instrument
inst Note
note = forall d. Instrument -> Deriver d -> Deriver d
Derive.with_instrument (Pasang -> Instrument
inst Pasang
pasang) forall a b. (a -> b) -> a -> b
$
            forall d.
Callable (Generator d) =>
PassedArgs d -> Symbol -> Deriver (Stream d)
Eval.reapply_generator PassedArgs d
args (Note -> Symbol
to_call Note
note)

both_calls :: [(Expr.Symbol, PasangStroke)]
both_calls :: [(Symbol, PasangStroke)]
both_calls =
    (Symbol
"PLPL", Note -> Note -> PasangStroke
Both (Stroke -> Attributes -> Note
Note Stroke
Plak forall a. Monoid a => a
mempty) (Stroke -> Attributes -> Note
Note Stroke
Plak forall a. Monoid a => a
mempty)) forall a. a -> [a] -> [a]
:
    [ (Symbol
wadon forall a. Semigroup a => a -> a -> a
<> Symbol
lanang, Note -> Note -> PasangStroke
Both Note
wnote Note
lnote)
    | (Char
_, Symbol
wadon, Wadon Note
wnote) <- [(Char, Symbol, PasangStroke)]
pasang_calls
    , (Char
_, Symbol
lanang, Lanang lnote :: Note
lnote@(Note Stroke
lstroke Attributes
_)) <- [(Char, Symbol, PasangStroke)]
pasang_calls
    , Stroke
lstroke forall a. Eq a => a -> a -> Bool
/= Stroke
Plak
    , Note -> Note -> PasangStroke
Both Note
wnote Note
lnote forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set PasangStroke
already_bound
    ]
    where
    already_bound :: Set PasangStroke
already_bound = forall a. Ord a => [a] -> Set a
Set.fromList [PasangStroke
stroke | (Char
_, Symbol
_, PasangStroke
stroke) <- [(Char, Symbol, PasangStroke)]
pasang_calls]

pasang_calls :: [(Char, Expr.Symbol, PasangStroke)]
pasang_calls :: [(Char, Symbol, PasangStroke)]
pasang_calls =
    [ (Char
'b', Symbol
"PL", Stroke -> PasangStroke
lanang Stroke
Plak)
    , (Char
't', Symbol
"Ø", Stroke -> PasangStroke
lanang Stroke
TutL)
    , (Char
'5', Symbol
"ø", Note -> PasangStroke
Lanang (Stroke -> Attributes -> Note
Note Stroke
TutL Attributes
soft))
    , (Char
'y', Symbol
"+Ø", Note -> Note -> PasangStroke
Both (Stroke -> Attributes -> Note
Note Stroke
De forall a. Monoid a => a
mempty) (Stroke -> Attributes -> Note
Note Stroke
TutL forall a. Monoid a => a
mempty))
    -- left
    , (Char
'q', Symbol
"k", Stroke -> PasangStroke
wadon Stroke
Pak) -- ka
    , (Char
'w', Symbol
"P", Stroke -> PasangStroke
lanang Stroke
Pak) -- pak
    , (Char
'e', Symbol
"t", Stroke -> PasangStroke
wadon Stroke
Pang) -- kam
    , (Char
'r', Symbol
"T", Stroke -> PasangStroke
lanang Stroke
Pang) -- pang
    -- right
    , (Char
'z', Symbol
"+", Stroke -> PasangStroke
wadon Stroke
De) -- de
    , (Char
'd', Symbol
"+/", Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
De Attributes
Attrs.staccato))
    , (Char
'a', Symbol
"-", Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
De Attributes
soft)) -- de
    , (Char
'x', Symbol
"o", Stroke -> PasangStroke
lanang Stroke
De) -- tut
    , (Char
'c', Symbol
"u", Stroke -> PasangStroke
wadon Stroke
Tut) -- kum
    , (Char
'v', Symbol
"U", Stroke -> PasangStroke
lanang Stroke
Tut) -- pung
    , (Char
'm', Symbol
"<", Stroke -> PasangStroke
wadon Stroke
Dag) -- dag
    , (Char
'j', Symbol
"-<", Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
Dag Attributes
soft)) -- dag
    , (Char
',', Symbol
">", Stroke -> PasangStroke
lanang Stroke
Dag) -- dug
    , (Char
'.', Symbol
"[", Stroke -> PasangStroke
wadon Stroke
Tek) -- tak
    , (Char
'/', Symbol
"]", Stroke -> PasangStroke
lanang Stroke
Tek) -- tek
    ]
    where
    soft :: Attributes
soft = Attributes
Attrs.soft
    wadon :: Stroke -> PasangStroke
wadon Stroke
stroke = Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
stroke forall a. Monoid a => a
mempty)
    lanang :: Stroke -> PasangStroke
lanang Stroke
stroke = Note -> PasangStroke
Lanang (Stroke -> Attributes -> Note
Note Stroke
stroke forall a. Monoid a => a
mempty)

-- | Unicode has some kendang notation, but it's harder to type and I'm not
-- sure if I'll wind up using it.
balinese_pasang_calls :: [(Char, Expr.Symbol, PasangStroke)]
balinese_pasang_calls :: [(Char, Symbol, PasangStroke)]
balinese_pasang_calls =
    [ (Char
'b', Symbol
"PL",           Stroke -> PasangStroke
wadon Stroke
Plak)
    , (Char
't', Symbol
open_ping,      Stroke -> PasangStroke
lanang Stroke
TutL)
    -- left
    , (Char
'q', Symbol
closed_plak,    Stroke -> PasangStroke
wadon Stroke
Pak) -- ka
    , (Char
'w', Symbol
closed_pluk,    Stroke -> PasangStroke
lanang Stroke
Pak) -- pak
    , (Char
'e', Symbol
open_pang,      Stroke -> PasangStroke
wadon Stroke
Pang) -- kam
    , (Char
'r', Symbol
open_pung,      Stroke -> PasangStroke
lanang Stroke
Pang) -- pang
    -- right
    , (Char
'z', Symbol
open_dag,       Stroke -> PasangStroke
wadon Stroke
De) -- de
    , (Char
'a', Symbol -> Symbol
quiet Symbol
open_dag, Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
De Attributes
soft)) -- de
    , (Char
'x', Symbol
open_dug,       Stroke -> PasangStroke
lanang Stroke
De) -- tut
    , (Char
'c', Symbol
closed_tak,     Stroke -> PasangStroke
wadon Stroke
Tut) -- kum
    , (Char
'v', Symbol
closed_tuk,     Stroke -> PasangStroke
lanang Stroke
Tut) -- pung
    -- TODO since I use the same symbols for with and without panggul, there
    -- needs to be a separate attribute.
    , (Char
'm', Symbol
open_dag,       Stroke -> PasangStroke
wadon Stroke
Dag) -- dag
    , (Char
'j', Symbol -> Symbol
quiet Symbol
open_dag, Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
Dag Attributes
soft)) -- dag
    , (Char
',', Symbol
open_dug,       Stroke -> PasangStroke
lanang Stroke
Dag) -- dug
    , (Char
'.', Symbol
closed_tak,     Stroke -> PasangStroke
wadon Stroke
Tek) -- tak
    , (Char
'/', Symbol
closed_tuk,     Stroke -> PasangStroke
lanang Stroke
Tek) -- tek
    ]
    where
    soft :: Attributes
soft = Attributes
Attrs.soft
    -- left
    open_pang :: Symbol
open_pang = Symbol
"᭸"     -- t kam
    open_pung :: Symbol
open_pung = Symbol
"᭹"     -- T pang
    closed_plak :: Symbol
closed_plak = Symbol
"᭺"   -- k ka
    closed_pluk :: Symbol
closed_pluk = Symbol
"᭻"   -- P pak
    open_ping :: Symbol
open_ping = Symbol
"᭼"     -- Ø pung
    -- right
    open_dag :: Symbol
open_dag = Symbol
"᭵"      -- < dag   + de
    open_dug :: Symbol
open_dug = Symbol
"᭴"      -- > dug   o tut
    closed_tak :: Symbol
closed_tak = Symbol
"᭷"    -- ] tek   u kum
    closed_tuk :: Symbol
closed_tuk = Symbol
"᭶"    -- [ tak   U pung
    quiet :: Symbol -> Symbol
quiet = (Symbol
"," <>)
    wadon :: Stroke -> PasangStroke
wadon Stroke
stroke = Note -> PasangStroke
Wadon (Stroke -> Attributes -> Note
Note Stroke
stroke forall a. Monoid a => a
mempty)
    lanang :: Stroke -> PasangStroke
lanang Stroke
stroke = Note -> PasangStroke
Lanang (Stroke -> Attributes -> Note
Note Stroke
stroke forall a. Monoid a => a
mempty)

c_realize_kendang :: Derive.Transformer Derive.Note
c_realize_kendang :: Transformer Note
c_realize_kendang = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.instrument CallName
"realize-kendang"
    (Tags
Tags.inst forall a. Semigroup a => a -> a -> a
<> Tags
Tags.postproc)
    Doc
"Realize a composite kendang score into separate lanang and wadon parts."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d)
Sig.callt Parser Pasang
pasang_env
    forall a b. (a -> b) -> a -> b
$ \Pasang
pasang PassedArgs Note
_args Deriver (Stream Note)
deriver -> Pasang -> Stream Note -> Stream Note
realize_kendang Pasang
pasang forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver (Stream Note)
deriver

{- | Given a composite part with lanang and wadon, fill in the secondary
    strokes.

    The realization is not correct because I don't yet fully understand how it
    works.

    > c kPtTtT+o+oo-+
    > l .P.TPTP+^++.^
    > w P.TPTP+.+.^-+

    > c kPktT t T T t T .kP.tT.tTØØØ
    > l .P.^T P T T P T .^P^.T .TØØØ
    > w P^.TP T P P T P .P^.TP.TP. .

    > c kP+otT kPkP+o+o kPuUtT+o
    > l P.+.T^ P.P.+.+. P.o.T^+.
    > w .P.+.T .P.P.+.+ .P.O.T^+

    > c kPtTtT
    > l .P.TPTP
    > w P.TPTP

    > tTkPtTkP
    > T.P.T.P
    > .T.P.T.P

    > tT+otT+o
    > TP+.TP+.
    > .TP+.TP+
-}
realize_kendang :: Pasang -> Stream.Stream Score.Event
    -> Stream.Stream Score.Event
realize_kendang :: Pasang -> Stream Note -> Stream Note
realize_kendang Pasang
_pasang Stream Note
events = Stream Note
events -- TODO


-- * attrs

-- Kendang tunggal strokes don't really have names so I made some up.
-- For composite it would be: de tut, kum pung, ka pak, kam pang
-- If I took the wadon or lanang names, it would be de, kum, ka, kam, or
-- tut, pung, pak, pang, which both sound weird.

-- both
plak :: Attributes
plak = Text -> Attributes
Attrs.attr Text
"plak"

-- right
de :: Attributes
de = Text -> Attributes
Attrs.attr Text
"de"
tut :: Attributes
tut = Text -> Attributes
Attrs.attr Text
"tut"
ka :: Attributes
ka = Text -> Attributes
Attrs.attr Text
"ka" -- neutral stroke
dag :: Attributes
dag = Text -> Attributes
Attrs.attr Text
"dag" -- de with panggul
tek :: Attributes
tek = Text -> Attributes
Attrs.attr Text
"tek"

-- left
pak :: Attributes
pak = Text -> Attributes
Attrs.attr Text
"pak"
pang :: Attributes
pang = Text -> Attributes
Attrs.attr Text
"pang" -- rim


-- * general

data PasangStroke = Wadon !Note | Lanang !Note | Both !Note !Note
    deriving (PasangStroke -> PasangStroke -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasangStroke -> PasangStroke -> Bool
$c/= :: PasangStroke -> PasangStroke -> Bool
== :: PasangStroke -> PasangStroke -> Bool
$c== :: PasangStroke -> PasangStroke -> Bool
Eq, Eq PasangStroke
PasangStroke -> PasangStroke -> Bool
PasangStroke -> PasangStroke -> Ordering
PasangStroke -> PasangStroke -> PasangStroke
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PasangStroke -> PasangStroke -> PasangStroke
$cmin :: PasangStroke -> PasangStroke -> PasangStroke
max :: PasangStroke -> PasangStroke -> PasangStroke
$cmax :: PasangStroke -> PasangStroke -> PasangStroke
>= :: PasangStroke -> PasangStroke -> Bool
$c>= :: PasangStroke -> PasangStroke -> Bool
> :: PasangStroke -> PasangStroke -> Bool
$c> :: PasangStroke -> PasangStroke -> Bool
<= :: PasangStroke -> PasangStroke -> Bool
$c<= :: PasangStroke -> PasangStroke -> Bool
< :: PasangStroke -> PasangStroke -> Bool
$c< :: PasangStroke -> PasangStroke -> Bool
compare :: PasangStroke -> PasangStroke -> Ordering
$ccompare :: PasangStroke -> PasangStroke -> Ordering
Ord, Int -> PasangStroke -> ShowS
[PasangStroke] -> ShowS
PasangStroke -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasangStroke] -> ShowS
$cshowList :: [PasangStroke] -> ShowS
show :: PasangStroke -> String
$cshow :: PasangStroke -> String
showsPrec :: Int -> PasangStroke -> ShowS
$cshowsPrec :: Int -> PasangStroke -> ShowS
Show)

-- | The attributes might have the stroke, or not, so it might be
-- Note Plak plak, or Note Play mempty.
data Note = Note !Stroke !Attrs.Attributes
    deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Eq Note
Note -> Note -> Bool
Note -> Note -> Ordering
Note -> Note -> Note
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Note -> Note -> Note
$cmin :: Note -> Note -> Note
max :: Note -> Note -> Note
$cmax :: Note -> Note -> Note
>= :: Note -> Note -> Bool
$c>= :: Note -> Note -> Bool
> :: Note -> Note -> Bool
$c> :: Note -> Note -> Bool
<= :: Note -> Note -> Bool
$c<= :: Note -> Note -> Bool
< :: Note -> Note -> Bool
$c< :: Note -> Note -> Bool
compare :: Note -> Note -> Ordering
$ccompare :: Note -> Note -> Ordering
Ord, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)

data Stroke =
    Plak -- both
    | Pak | Pang | TutL | DeL -- left
    | Ka | Tut | De | Dag | Tek -- right
    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, Eq Stroke
Stroke -> Stroke -> Bool
Stroke -> Stroke -> Ordering
Stroke -> Stroke -> Stroke
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Stroke -> Stroke -> Stroke
$cmin :: Stroke -> Stroke -> Stroke
max :: Stroke -> Stroke -> Stroke
$cmax :: Stroke -> Stroke -> Stroke
>= :: Stroke -> Stroke -> Bool
$c>= :: Stroke -> Stroke -> Bool
> :: Stroke -> Stroke -> Bool
$c> :: Stroke -> Stroke -> Bool
<= :: Stroke -> Stroke -> Bool
$c<= :: Stroke -> Stroke -> Bool
< :: Stroke -> Stroke -> Bool
$c< :: Stroke -> Stroke -> Bool
compare :: Stroke -> Stroke -> Ordering
$ccompare :: Stroke -> Stroke -> Ordering
Ord, 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)

notes_of :: PasangStroke -> [Note]
notes_of :: PasangStroke -> [Note]
notes_of PasangStroke
pstroke = case PasangStroke
pstroke of
    Wadon Note
note -> [Note
note]
    Lanang Note
note -> [Note
note]
    Both Note
w Note
l -> [Note
w, Note
l]