{-# LANGUAGE Arrows #-}
module Euterpea.IO.MUI.InstrumentBase where
import qualified Codec.Midi as Midi
import FRP.UISF
import Data.Maybe
import Control.Monad
import Euterpea.IO.MUI.MidiWidgets (musicToMsgs)
import Euterpea.IO.MIDI
import Euterpea.Music.Note.Music hiding (transpose)
import Euterpea.Music.Note.Performance

type EMM  = SEvent [MidiMessage]

-- The KeyData structure is maintained on a per-key basis in each instrument.
-- It is usually initialized by a call to getKeyData below
data KeyData = KeyData {
    pressed  :: Maybe Bool,
    notation :: Maybe String,
    offset   :: Int
} deriving (Show, Eq)

-- KeyState carries the information about whether the key is being pressed or not,
-- and carries the information regarding the velocity generated by the last event
data KeyState = KeyState {
    keypad:: Bool,
    mouse :: Bool,
    song :: Bool,
    vel  :: Midi.Velocity
} deriving (Show, Eq)

-- InstrumentData is a settings structure for the active instrument. It takes in
-- a bool that decides whether to show the pitch classes on the instrument, an
-- AbsPitch to decide by how much to transpose the instrument, a bool that indicates
-- whether a sustain pedal is being held down and a list describing the 
data InstrumentData = InstrumentData {
    showNotation::Bool,
    keyPairs :: Maybe [(AbsPitch, Bool)],
    transpose :: AbsPitch,
    pedal :: Bool
} deriving (Show, Eq)

-- A simple predicate to determine whether a given key should be displayed as pressed
isKeyDown :: KeyState -> Bool
isKeyDown (KeyState False False False _) = False
isKeyDown _ = True

-- A simple predicate to determine whether a given key is being pressed by the user
isKeyPlay :: KeyState -> Bool
isKeyPlay (KeyState False False _ _) = False
isKeyPlay _ = True

-- A neutral InstrumentData structure.
defaultInstrumentData :: InstrumentData
defaultInstrumentData = InstrumentData False Nothing 0 False

-----------------------------
-- INSTRUMENT DATA WIDGETS --
-----------------------------

-- Notation Widget
addNotation :: UISF InstrumentData InstrumentData
addNotation = proc inst -> do
    notA <- checkbox "Notation" False -< ()
    returnA -< inst { showNotation = notA }

-- Transpose Widget
addTranspose :: UISF InstrumentData InstrumentData
addTranspose = proc inst -> do
    tp <- withDisplay $ hiSlider 1 (-6,6) 0 -< ()
    returnA -< inst { transpose = tp }

-- Pedal Widget
addPedal :: UISF InstrumentData InstrumentData
addPedal = proc inst -> do
    ped <- checkbox "Pedal" False -< ()
    returnA -< inst { pedal = ped }

-----------------------------
--       ECHO WIDGET       --
-----------------------------

-- This is a widget that adds an echo to a MidiMessage signal

addEcho :: UISF EMM EMM
addEcho = title "Echo" $ leftRight $ proc m -> do
    r <- title "Decay Rate" $ withDisplay (hSlider (0,0.9) 0.5) -< ()
    f <- title "Echoing Frequency" $ withDisplay (hSlider (1,10) 10) -< ()
    rec let m' = removeNull $ m ~++ s
        s <- vdelay -< (1.0/f, fmap (mapMaybe (decay 0.1 r)) m')
    returnA -< m'

removeNull :: Maybe [MidiMessage] -> Maybe [MidiMessage]
removeNull Nothing = Nothing
removeNull (Just []) = Nothing
removeNull mm = mm

decay :: Time -> Double -> MidiMessage -> Maybe MidiMessage
decay dur r m =
    let f c k v d = if v > 0 
                    then Just (ANote c k (truncate (fromIntegral v * r)) d)
                    else Nothing
     in case m of
        ANote c k v d -> f c k v d
        Std (Midi.NoteOn c k v) -> f c k v dur
        _ -> Nothing

-----------------------------
--    INSTRUMENT SELECT    --
-----------------------------

-- Sets the midi instrument on a given channel. Takes the channel and a starting instrument as an argument

selectInstrument :: Midi.Channel -> Int -> UISF EMM EMM
selectInstrument chn i = title "Instrument" $ proc msg -> do
    instrNum <- hiSlider 1 (0,127) i -< ()
    display -< (toEnum :: Int -> InstrumentName) instrNum
    instrNum' <- unique -< instrNum
    returnA -< fmap (\x -> [Std $ Midi.ProgramChange chn x]) instrNum' ~++ msg

-----------------------------
--     SONG SELECTION      --
-----------------------------

-- Takes an array of tuples of song names and Music values and creates a player for them
-- Emits a midi signal that can be routed through other filters before being passed
-- on to a midiOut sink.

songPlayer :: [(String, Music Pitch)] -> UISF () EMM
songPlayer songList = proc _ -> do
    i <- pickSong songList -< ()
    let song = fmap (\x -> snd $ songList !! x) i
    let msgs = fmap (musicToMsgs False [] . toMusic1) song
    (out, _) <- eventBuffer -< maybe NoBOp MergeInBuffer  msgs
    returnA -< out

pickSong :: [(String, Music Pitch)] -> UISF () (SEvent Int)
pickSong [] = title "No Songs Imported" $ proc _ -> returnA -< Nothing
pickSong songList = title "Available Songs" $ leftRight $ proc _ -> do
    i <- topDown $ radio (fst $ unzip songList) 0 -< ()
    playBtn <- edge <<< button "Play" -< ()
    returnA -< fmap (const i) playBtn

-----------------------------
--     OTHER HELPERS       --
-----------------------------

-- Converts a set of midi messages to a set of pitch and state pairs to be used
-- in an InstrumentData structure

mmToPair :: [MidiMessage] -> [(AbsPitch, Bool)]
mmToPair [] = []
mmToPair (Std (Midi.NoteOn _ k _) : rest) = (k, True)  : mmToPair rest
mmToPair (Std (Midi.NoteOff _ k _) : rest)= (k, False) : mmToPair rest
mmToPair (ANote {} :_) = error "ANote not implemented"
mmToPair (_:rest) = mmToPair rest

-- Given a channel, converts a list of pitches, states and velocities to a string of
-- midi messages, the opposite of mmToPair

pairToMsg :: Midi.Channel -> [(AbsPitch, Bool, Midi.Velocity)] -> [MidiMessage]
pairToMsg ch = map f where
    f (ap, b, vel) | b     = Std (Midi.NoteOn  ch ap vel)
                   | not b = Std (Midi.NoteOff ch ap 0)

-- Given an absolute pitch, looks though the InstrumentData to create the related
-- KeyData structure containing the pressed information, the string to use for
-- pitch notation and the adjusted pitch
                   
getKeyData :: AbsPitch -> InstrumentData -> KeyData
getKeyData ap (InstrumentData isShow pairs trans _) =
    KeyData (if isNothing pairs then Nothing
             else Control.Monad.mplus (lookup ap (fromJust pairs)) Nothing)
            (if isShow then Just (show $ fst $ pitch ap) else Nothing)
            (ap + trans)

-- Looks through a string of midi messages and returns the first channel in a
-- command, if it finds one. Counter to setChannel
            
detectChannel :: [MidiMessage] -> Maybe Midi.Channel
detectChannel []                            = Nothing
detectChannel (ANote c _ _ _:_)             = Just c
detectChannel (Std (NoteOn c _ _):_)        = Just c
detectChannel (Std (NoteOff c _ _):_)       = Just c
detectChannel (Std (KeyPressure c _ _):_)   = Just c
detectChannel (Std (ControlChange c _ _):_) = Just c
detectChannel (Std (ProgramChange c _):_)   = Just c
detectChannel (Std (ChannelPressure c _):_) = Just c
detectChannel (Std (PitchWheel c _):_)      = Just c
detectChannel (_:as)                        = detectChannel as

-- Sets all midi messages to a single channel. This will destroy any custom commands.
-- Used inside the guitar and piano, which coerce their streams to their own channel.

setChannel :: Int -> [MidiMessage] -> [MidiMessage]
setChannel c (ANote _ k v d:as) = ANote c k v d : setChannel c as
setChannel c (Std (NoteOn _ k v):as) = Std (NoteOn c k v) : setChannel c as
setChannel c (Std (NoteOff _ k v):as) = Std (NoteOff c k v) : setChannel c as
setChannel c (Std (KeyPressure _ k p):as) = Std (KeyPressure c k p) : setChannel c as
setChannel c (Std (ControlChange _ cn cv):as) = Std (ControlChange c cn cv) : setChannel c as
setChannel c (Std (ProgramChange _ p):as) = Std (ProgramChange c p) : setChannel c as
setChannel c (Std (ChannelPressure _ p):as) = Std (ChannelPressure c p) : setChannel c as
setChannel c (Std (PitchWheel _ p):as) = Std (PitchWheel c p) : setChannel c as
setChannel _ x = x