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

-- | Fire up the play-cache vst.
module Perform.Im.Play (
    play_cache_synth
    , encode_time, encode_play_config, decode_time, start, stop
) where
import qualified Data.Bits as Bits
import           Data.Bits ((.&.), (.|.))
import qualified Data.Char as Char
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Cmd.Cmd as Cmd
import qualified Derive.ScoreT as ScoreT
import qualified Instrument.Common as Common
import qualified Instrument.Inst as Inst
import qualified Instrument.InstT as InstT

import qualified Midi.Midi as Midi
import qualified Perform.Midi.Patch as Patch
import qualified Perform.RealTime as RealTime
import qualified Synth.Shared.Config as Shared.Config
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


play_cache_synth :: Inst.SynthDecl Cmd.InstrumentCode
play_cache_synth :: SynthDecl InstrumentCode
play_cache_synth = forall code. Text -> Text -> [(Text, Inst code)] -> SynthDecl code
Inst.SynthDecl (Qualified -> Text
InstT.synth Qualified
UiConfig.play_cache)
    Text
"play_cache VST, to play the output of offline synthesizers."
    [(Text
Patch.default_name, Inst InstrumentCode
inst)]
    where
    inst :: Inst InstrumentCode
inst = Inst.Inst
        { inst_backend :: Backend
inst_backend = Patch -> Backend
Inst.Midi forall a b. (a -> b) -> a -> b
$ PbRange -> Text -> Patch
Patch.patch (Int
0, Int
0) Text
Patch.default_name
        , inst_common :: Common InstrumentCode
inst_common = forall {code}. Common code :-> Doc
Common.doc forall f a. Lens f a -> a -> f -> f
#= Doc
doc forall a b. (a -> b) -> a -> b
$ forall code. code -> Common code
Common.common InstrumentCode
Cmd.empty_code
        }
    doc :: Doc
doc = Doc
"This dummy patch is just to give a way to configure the MIDI\
        \ channel of the play_cache VST. It's never actually played, and the\
        \ instrument should never be used in the score."

to_sample :: RealTime -> Int
to_sample :: RealTime -> Int
to_sample RealTime
t =
    forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ RealTime -> Double
RealTime.to_seconds RealTime
t forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
Shared.Config.samplingRate

-- | Emit MIDI messages that tell play_cache to get ready to start playing at
-- the given time.
--
-- This is encoded as 'Midi.Aftertouch' where the key is the index*7 and the
-- value is the 7 bits at that index.  At a 44100 sampling rate, this can
-- address 2^(7*4) / 44100 / 60 = 101 minutes, which is long enough for
-- anything I'm likely to write.  TODO since this can't represent negative
-- times, and the DAW likely doesn't like them either, I'll have to normalize
-- the output.
encode_time :: RealTime -> [Midi.ChannelMessage]
encode_time :: RealTime -> [ChannelMessage]
encode_time RealTime
t = [Int -> ChannelMessage
at Int
0, Int -> ChannelMessage
at Int
1, Int -> ChannelMessage
at Int
2, Int -> ChannelMessage
at Int
3]
    where
    at :: Int -> ChannelMessage
at Int
i = Key -> Velocity -> ChannelMessage
Midi.Aftertouch (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
Bits.shiftR Int
pos (Int
i forall a. Num a => a -> a -> a
* Int
7) forall a. Bits a => a -> a -> a
.&. Int
0x7f)
    pos :: Int
pos = RealTime -> Int
to_sample RealTime
t

-- | Send the block to play, along with muted instruments, if any.  Each
-- is separated by a \0.
encode_play_config :: FilePath -> BlockId -> Set ScoreT.Instrument
    -> [Midi.ChannelMessage]
encode_play_config :: FilePath -> BlockId -> Set Instrument -> [ChannelMessage]
encode_play_config FilePath
score_path BlockId
block_id Set Instrument
muted =
    Text -> [ChannelMessage]
encode_text forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"\0" forall a b. (a -> b) -> a -> b
$
        FilePath -> Text
txt (FilePath -> BlockId -> FilePath
Shared.Config.playFilename FilePath
score_path BlockId
block_id)
            forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Instrument -> Text
ScoreT.instrument_name (forall a. Set a -> [a]
Set.toList Set Instrument
muted)

-- | Encode text in MIDI.  This uses a PitchBend to encode a pair of
-- characters, with a leading '\DEL' to mark the start of the sequence, and
-- possibly padding with a ' ' at the end.
--
-- TODO this only works for ASCII, because the PitchBend encoding is 7-bit.
encode_text :: Text -> [Midi.ChannelMessage]
encode_text :: Text -> [ChannelMessage]
encode_text Text
text = [Velocity -> Velocity -> ChannelMessage
Midi.PitchBendInt (Char -> Velocity
ord Char
c1) (Char -> Velocity
ord Char
c2) | (Char
c1, Char
c2) <- [(Char, Char)]
name]
    where
    ord :: Char -> Velocity
ord = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Char.ord
    -- Prepend 0x7f to tell PlayCache to clear any accumulated junk.  It
    -- happens to be \DEL, which is a nice coincidence.
    name :: [(Char, Char)]
name = FilePath -> [(Char, Char)]
pairs (Char
'\DEL' forall a. a -> [a] -> [a]
: Text -> FilePath
Text.unpack Text
text)
    pairs :: FilePath -> [(Char, Char)]
pairs (Char
x:Char
y:FilePath
xs) = (Char
x, Char
y) forall a. a -> [a] -> [a]
: FilePath -> [(Char, Char)]
pairs FilePath
xs
    pairs [Char
x] = [(Char
x, Char
' ')]
    pairs [] = []

-- | Just to test 'encode_time'.  play_cache does this internally.
decode_time :: [Midi.ChannelMessage] -> Int
decode_time :: [ChannelMessage] -> Int
decode_time = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ChannelMessage -> Int -> Int
go Int
0
    where
    go :: ChannelMessage -> Int -> Int
go (Midi.Aftertouch Key
key Velocity
val) Int
frames =
        Int -> Int -> Int -> Int
set_offset (forall a. Num a => Key -> a
Midi.from_key Key
key) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Velocity
val) Int
frames
    go ChannelMessage
_ Int
frames = Int
frames

set_offset :: Int -> Int -> Int -> Int
set_offset :: Int -> Int -> Int -> Int
set_offset Int
key Int
val Int
frames = Int
cleared forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
Bits.shiftL Int
val Int
index
    where
    cleared :: Int
cleared = Int
frames forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
Bits.complement (forall a. Bits a => a -> Int -> a
Bits.shiftL Int
0x7f Int
index)
    index :: Int
index = Int
key forall a. Num a => a -> a -> a
* Int
7
    -- unsigned int index = int(data[1]) * 7;
    -- unsigned int val = data[2];
    -- this->offsetFrames &= ~(0x7f << index);
    -- this->offsetFrames |= val << index;

start :: Midi.ChannelMessage
start :: ChannelMessage
start = Key -> Velocity -> ChannelMessage
Midi.NoteOn Key
1 Velocity
1

stop :: Midi.ChannelMessage
stop :: ChannelMessage
stop = ChannelMessage
Midi.AllNotesOff