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

-- | Functions to convert instrument-specific strokes to karya score.
module Solkattu.Instrument.ToScore where
import qualified Derive.Expr as Expr
import qualified Derive.ShowVal as ShowVal
import qualified Solkattu.Realize as Realize
import qualified Solkattu.S as S
import qualified Solkattu.Solkattu as Solkattu

import Global


-- * ToScore

-- | Convert instrument-specific strokes into tracks.  This is a simple
-- intermediate data structure to bridge the solkattu types and the karya
-- types.
type ToScore stroke = [(S.Duration, Realize.Note stroke)]
    -> ([Event], [(Text, [Event])])
    -- ^ (noteEvents, [(control, controlEvents)]).  A control named "*"
    -- becomes a pitch track.

type Event = (S.Duration, S.Duration, Text)

fromStrokes :: ToScore stroke -> [S.Flat g (Realize.Note stroke)]
    -> ([Event], [(Text, [Event])])
fromStrokes :: forall stroke g.
ToScore stroke
-> [Flat g (Note stroke)] -> ([Event], [(Text, [Event])])
fromStrokes ToScore stroke
toScore = ToScore stroke
toScore forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall g a. [Flat g a] -> [a]
S.flattenedNotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a g. HasMatras a => [Flat g a] -> [Flat g (Duration, a)]
S.withDurations

-- | A standard ToScore for simple percussion, with 0 duration and no control
-- tracks.
toScore :: (Expr.ToExpr (Realize.Stroke stroke)) => ToScore stroke
toScore :: forall stroke. ToExpr (Stroke stroke) => ToScore stroke
toScore [(Duration, Note stroke)]
strokes = ([Event]
events, [])
    where
    events :: [Event]
events = do
        (Duration
start, Duration
dur, Note stroke
note) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Duration]
starts [Duration]
durs [Note stroke]
notes
        Just Expr MiniVal
expr <- [forall stroke.
ToExpr (Stroke stroke) =>
Note stroke -> Maybe (Expr MiniVal)
toExpr Note stroke
note]
        -- Debug.traceM "s, d, n" (start, dur, note)
        -- Debug.tracepM "expr" expr
        let d :: Duration
d = if forall a. HasMatras a => a -> Bool
S.hasSustain Note stroke
note then Duration
dur else Duration
0
        forall (m :: * -> *) a. Monad m => a -> m a
return (Duration
start, Duration
d, forall a. ShowVal a => a -> Text
ShowVal.show_val Expr MiniVal
expr)
    starts :: [Duration]
starts = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Duration
0 [Duration]
durs
    ([Duration]
durs, [Note stroke]
notes) = forall a b. [(a, b)] -> ([a], [b])
unzip [(Duration, Note stroke)]
strokes

toExpr :: Expr.ToExpr (Realize.Stroke stroke) => Realize.Note stroke
    -> Maybe (Expr.Expr Expr.MiniVal)
toExpr :: forall stroke.
ToExpr (Stroke stroke) =>
Note stroke -> Maybe (Expr MiniVal)
toExpr Note stroke
s = case Note stroke
s of
    Realize.Note Stroke stroke
stroke -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToExpr a => a -> Expr MiniVal
Expr.to_expr Stroke stroke
stroke
    Realize.Abstract Meta
meta -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall val. Call val -> Expr val
Expr.generator forall a b. (a -> b) -> a -> b
$ Meta -> Call MiniVal
metaExpr Meta
meta
    Realize.Space Space
Solkattu.Rest -> forall a. Maybe a
Nothing
    Realize.Space Space
Solkattu.Offset -> forall a. Maybe a
Nothing
    Realize.Alignment {} -> forall a. Maybe a
Nothing

metaExpr :: Solkattu.Meta -> Expr.Call Expr.MiniVal
metaExpr :: Meta -> Call MiniVal
metaExpr (Solkattu.Meta Maybe Matra
matras Maybe Text
name GroupType
gtype) =
    forall val. Symbol -> [val] -> Call val
Expr.call Symbol
call forall a b. (a -> b) -> a -> b
$ case GroupType
gtype of
        GroupType
Solkattu.GSarva -> []
        GroupType
_ -> case Maybe Matra
matras of
            Maybe Matra
Nothing -> []
            Just Matra
matras -> [forall a. ToVal a => a -> MiniVal
Expr.to_val Matra
matras]

    where
    call :: Symbol
call = Text -> Symbol
Expr.Symbol forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (GroupType -> Text
Realize.typeName GroupType
gtype) Maybe Text
name